From b9dfd90851f76652f01f0167b1ccedb268829b56 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Fri, 11 Mar 2011 18:26:34 -0500
Subject: [PATCH] trying to get call/cc

---
 compile.rkt    | 41 +++++++++++++++++++++++++++++++++--------
 il-structs.rkt | 27 +++++++++++++++++++++++++--
 runtime.js     |  6 ++++++
 3 files changed, 64 insertions(+), 10 deletions(-)

diff --git a/compile.rkt b/compile.rkt
index dea0202..91cb098 100644
--- a/compile.rkt
+++ b/compile.rkt
@@ -552,18 +552,19 @@
 
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 ;; The primitive code necessary to do call/cc
 
 (: call/cc-label Symbol)
 (define call/cc-label 'callCCEntry)
+(define call/cc-closure-entry 'callCCClosureEntry)
+
 
 ;; (call/cc f)
 ;; Tail-calls f, providing it a special object that knows how to do the low-level
-;; manipulations.
-
+;; manipulation of the environment and control stack.
 (define (make-call/cc-code)
   (append-instruction-sequences
    (make-instruction-sequence 
@@ -573,15 +574,39 @@
       ;; First, move f to the proc register
       ,(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0))
       
-      ;; Next, capture the current continuation closure and target it into env[0].
+      
+      ;; Next, capture the envrionment and the current continuation closure,
+      ;; targetting env[0].
       ;; FIXME!
-      ,(make-AssignImmediateStatement (make-EnvLexicalReference 0) (make-Const "I should be a continuation"))))
+      ,(make-PushEnvironment 2)
+      ,(make-AssignPrimOpStatement (make-EnvLexicalReference 0) 
+                                   ;; 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-MakeCompiledProcedure call/cc-closure-entry
+                                                               1  ;; the continuation consumes a single value
+                                                               (list (make-EnvLexicalReference 0)
+                                                                     (make-EnvLexicalReference 1))))
+      ,(make-PopEnvironment 2 0)))
+                                   
 
    ;; Finally, tail call into f.
    (compile-procedure-call (extend-lexical-environment/placeholders '() 1)
                            (extend-lexical-environment/placeholders '() 1)
                            1 
                            'val
-                           'return)))
-
-
+                           'return)
+   
+   
+   ;; The code for the continuation
+   (make-instruction-sequence `(,call/cc-closure-entry
+                                ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0))
+                                
+                                ,(make-PerformStatement (make-RestoreControl!))
+                                ,(make-PerformStatement (make-RestoreEnvironment!))
+                                
+                                ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+                                ,(make-PopControlFrame)
+                                ,(make-GotoStatement (make-Reg 'proc))))))
diff --git a/il-structs.rkt b/il-structs.rkt
index 859efd4..91c08a0 100644
--- a/il-structs.rkt
+++ b/il-structs.rkt
@@ -119,7 +119,11 @@
 (define-type PrimitiveOperator (U GetCompiledProcedureEntry
                                   MakeCompiledProcedure
                                   ApplyPrimitiveProcedure
-                                  GetControlStackLabel))
+                                  GetControlStackLabel
+
+                                  CaptureEnvironment
+                                  CaptureControl
+                                  ))
 
 ;; Gets the label from the closure stored in the 'proc register and returns it.
 (define-struct: GetCompiledProcedureEntry ()
@@ -148,6 +152,13 @@
 (define-struct: GetControlStackLabel ()
   #:transparent)
 
+;; Capture the current environment, skipping skip frames.
+(define-struct: CaptureEnvironment ([skip : Natural]))
+
+;; Capture the control stack, skipping skip frames.
+(define-struct: CaptureControl ([skip : Natural]))
+
+
 
 
 ;; The following is used with TestStatement: each is passed the register-rand and
@@ -186,11 +197,23 @@
 (define-struct: InstallClosureValues! ()
   #:transparent)
 
+
+;; Changes over the control located at the given argument from the structure in env[1]
+(define-struct: RestoreControl! ())
+
+;; Changes over the environment located at the given argument from the structure in env[0]
+(define-struct: RestoreEnvironment! ())
+
+
+
 (define-type PrimitiveCommand (U                                
                                CheckToplevelBound!
                                CheckClosureArity!
                                ExtendEnvironment/Prefix!
-                               InstallClosureValues!))
+                               InstallClosureValues!
+                               
+                               RestoreEnvironment!
+                               RestoreControl!))
 
 
 
diff --git a/runtime.js b/runtime.js
index 2a20f53..0d5e3b8 100644
--- a/runtime.js
+++ b/runtime.js
@@ -128,6 +128,12 @@ var Primitives = (function() {
 	    var firstArg = MACHINE.env[MACHINE.env.length-1];
 	    return firstArg - 1;
 	}
+// 	,
+// 	'call/cc': new Closure(callCCEntry,
+// 			       1,
+// 			       [],
+// 			       "call/cc")
+
     };
 })();