getting closer.

compile.rkt

@@ -574,37 +574,31 @@
       ;; First, move f to the proc register
       ,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0))
       
-      
-      ;; Next, capture the envrionment and the current continuation closure,
-      ;; targetting env[0].
-      ;; FIXME!
+      ;; Next, capture the envrionment and the current continuation closure,.
       ,(make-PushEnvironment 2)
       ,(make-AssignPrimOpStatement (make-EnvLexicalReference 0) 
+                                   (make-CaptureControl 0))
+      ,(make-AssignPrimOpStatement (make-EnvLexicalReference 1)
                                    ;; When capturing, skip over f and the two slots we just added.
                                    (make-CaptureEnvironment 3))
-      ,(make-AssignPrimOpStatement (make-EnvLexicalReference 1) 
-                                   (make-CaptureControl 0))
-      ,(make-AssignPrimOpStatement (make-EnvLexicalReference 0)                                       
+      ,(make-AssignPrimOpStatement (adjust-target-depth (make-EnvLexicalReference 0) 2)
                                    (make-MakeCompiledProcedure call/cc-closure-entry
                                                                1 ;; the continuation consumes a single value
                                                                (list (make-EnvLexicalReference 0)
                                                                      (make-EnvLexicalReference 1))))
       ,(make-PopEnvironment 2 0)))
                                    
-
    ;; Finally, do a tail call into f.
-   (compile-procedure-call (extend-lexical-environment/placeholders '() 1)
+   (compile-procedure-call '()
                            (extend-lexical-environment/placeholders '() 1)
                            1 
                            'val
                            'return)
    
-   
    ;; The code for the continuation coe follows.  It's supposed to
    ;; abandon the current continuation, initialize the control and environment, and then jump.
    (make-instruction-sequence `(,call/cc-closure-entry
                                 ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0))
-                                
                                 ,(make-PerformStatement (make-RestoreControl!))
                                 ,(make-PerformStatement (make-RestoreEnvironment!))
                                 

simulator-structs.rkt

@@ -14,8 +14,14 @@
 
                                                    (Pairof PrimitiveValue PrimitiveValue)
                                                    )))
-(define-type SlotValue (U PrimitiveValue toplevel))
+(define-type SlotValue (U PrimitiveValue 
+                          toplevel
+                          CapturedControl
+                          CapturedEnvironment))
 
+;; For continuation capture:
+(define-struct: CapturedControl ([frames : (Listof frame)]))
+(define-struct: CapturedEnvironment ([vals : (Listof SlotValue)]))
 
 
 (define-struct: machine ([val : SlotValue]

simulator.rkt

@@ -176,7 +176,7 @@
                         'ok
                         (error 'check-closure-arity "arity mismatch"))]
                    [else
-                    (error 'check-closure-arity "not a closure")]))]
+                    (error 'check-closure-arity "not a closure: ~s" clos)]))]
           
           [(ExtendEnvironment/Prefix!? op)
            (env-push! m 
@@ -193,9 +193,13 @@
                            a-proc)]))]
           
           [(RestoreControl!? op)
-           (error 'fixme)]
+           (set-machine-control! m (CapturedControl-frames (ensure-CapturedControl (env-ref m 0))))
+           'ok]
+
           [(RestoreEnvironment!? op)
-           (error 'fixme)])))
+           (set-machine-env! m (CapturedEnvironment-vals (ensure-CapturedEnvironment (env-ref m 1))))
+           'ok])))
+
 
 (: get-target-updater (Target -> (machine SlotValue -> 'ok)))
 (define (get-target-updater t)
@@ -252,9 +256,12 @@
           [(GetControlStackLabel? op)
            (target-updater! m (frame-return (first (machine-control m))))]
           [(CaptureEnvironment? op)
-           (error 'fixme)]
+           (target-updater! m (make-CapturedEnvironment (drop (machine-env m)
+                                                              (CaptureEnvironment-skip op))))]
           [(CaptureControl? op)
-           (error 'fixme)])))
+           (target-updater! m (make-CapturedControl (drop (machine-control m)
+                                                          (CaptureControl-skip op))))])))
+
 
 
 
@@ -369,6 +376,19 @@
       x
       (error 'ensure-natural)))
 
+(: ensure-CapturedControl (Any -> CapturedControl))
+(define (ensure-CapturedControl x)
+  (if (CapturedControl? x)
+      x
+      (error 'ensure-CapturedControl "~s" x)))
+
+
+(: ensure-CapturedEnvironment (Any -> CapturedEnvironment))
+(define (ensure-CapturedEnvironment x)
+  (if (CapturedEnvironment? x)
+      x
+      (error 'ensure-CapturedEnvironment "~s" x)))
+
 
 (: current-instruction (machine -> Statement))
 (define (current-instruction m)

test-compiler.rkt

@@ -535,5 +535,13 @@
         (call/cc (lambda (k) (+ x x))))
       32)
 
+
+(test (let ([x 16])
+        (call/cc (lambda (k) 
+                   (k "escape!")
+                   (+ x x))))
+      "escape!")
+
+
 ;(simulate (compile (parse '42) 'val 'next))
 ;(compile (parse '(+ 3 4)) 'val 'next)