From 9072e32820055419070d6cbdc3f14312a225f73f Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Wed, 6 Apr 2011 16:28:37 -0400
Subject: [PATCH] maintaining proc across tail calls.

---
 NOTES                 | 50 ++++++++++++++++++++++++++++++++++++++++++-
 assemble.rkt          |  7 +++++-
 compile.rkt           |  6 +++++-
 il-structs.rkt        |  7 ++++++
 simulator-structs.rkt |  4 +++-
 simulator.rkt         | 16 +++++++++++++-
 6 files changed, 85 insertions(+), 5 deletions(-)

diff --git a/NOTES b/NOTES
index 42d3186..6b49d7a 100644
--- a/NOTES
+++ b/NOTES
@@ -70,4 +70,52 @@ Is this completely unrealistic?  I have to see how Rabbit and Orbit do this.
 ----------------------------------------------------------------------
 
 Runtime values and types are in in the plt.runtime namespace.  I need
-to move types from WeScheme into here.
\ No newline at end of file
+to move types from WeScheme into here.
+
+
+----------------------------------------------------------------------
+
+
+Frames and environments.
+
+
+A CallFrame consists of:
+
+   A return address back to the caller.
+   A procedure (the callee).
+   A stack.
+   A set of continuation marks.
+
+
+A PromptFrame consists of:
+
+   A return address back to the caller.
+   A tag.
+   A set of continuation marks.
+
+
+
+On exit from a CallFrame,
+
+    MACHINE.env = frame.env
+
+
+
+On a regular, generic function call:
+
+    The operator and operands are computed and placed in MACHINE.env's
+    scratch space.
+
+    A new call frame is constructed.  The frame remembers the environment.
+    
+    The machine jumps into the procedure entry.
+
+
+On a tail call,
+
+    The operator and operands are computed and placed in MACHINE.env's
+    scratch space.
+
+    The existing call frame is reused.
+        The frame's environment consumes those elements from MACHINE.env
+        MACHINE.env = the new stack segment
\ No newline at end of file
diff --git a/assemble.rkt b/assemble.rkt
index 6a324d2..6611f05 100644
--- a/assemble.rkt
+++ b/assemble.rkt
@@ -164,6 +164,8 @@ EOF
        empty]
       [(RestoreControl!? op)
        empty]
+      [(SetFrameCallee!? op)
+       empty]
       [(FixClosureShellMap!? op)
        empty]))
   
@@ -450,7 +452,10 @@ EOF
                                ;; the environment (which is also in reversed order)
                                ;; during install-closure-values.
                                (reverse (FixClosureShellMap!-closed-vals op)))
-                          ", "))]))
+                          ", "))]
+    [(SetFrameCallee!? op)
+     (format "MACHINE.control[MACHINE.control.length-1].proc = ~a;"
+             (assemble-oparg (SetFrameCallee!-proc op)))]))
 
 
 
diff --git a/compile.rkt b/compile.rkt
index d851f3f..5afc06b 100644
--- a/compile.rkt
+++ b/compile.rkt
@@ -859,7 +859,11 @@
                        (make-instruction-sequence `(,(make-PopEnvironment num-slots-to-delete n)))
                        empty-instruction-sequence)
                    (make-instruction-sequence
-                    `(,(make-GotoStatement entry-point)))))]
+                    `(;; Assign the proc value of the existing call frame
+                      ,(make-PerformStatement 
+                        (make-SetFrameCallee! (make-Reg 'proc)))
+                      
+                      ,(make-GotoStatement entry-point)))))]
            
            [else
             ;; This case should be impossible: return linkage should only
diff --git a/il-structs.rkt b/il-structs.rkt
index 97c83e4..ef1ad03 100644
--- a/il-structs.rkt
+++ b/il-structs.rkt
@@ -244,6 +244,11 @@
 (define-struct: InstallClosureValues! ()
   #:transparent)
 
+
+(define-struct: SetFrameCallee! ([proc : OpArg])
+  #:transparent)
+
+
 (define-struct: FixClosureShellMap! (;; depth: where the closure shell is located in the environment
                                      [depth : Natural] 
                                      
@@ -265,6 +270,8 @@
                                InstallClosureValues!
                                FixClosureShellMap!
                                
+                               SetFrameCallee!
+                               
                                RestoreEnvironment!
                                RestoreControl!))
 
diff --git a/simulator-structs.rkt b/simulator-structs.rkt
index e0825da..380bd2e 100644
--- a/simulator-structs.rkt
+++ b/simulator-structs.rkt
@@ -62,7 +62,9 @@
                            [proc : (U closure #f)]
                            ;; TODO: add continuation marks
                            )
-  #:transparent)
+  #:transparent
+  #:mutable)
+
 (define-struct: PromptFrame ([tag : ContinuationPromptTagValue]
                              [return : Symbol])
   #:transparent)
diff --git a/simulator.rkt b/simulator.rkt
index eeddfca..6dc6dc2 100644
--- a/simulator.rkt
+++ b/simulator.rkt
@@ -245,7 +245,7 @@
                                                          [(eq? name #f)
                                                           (make-undefined)]))
                                           (ExtendEnvironment/Prefix!-names op))))]
-          
+
           [(InstallClosureValues!? op)
            (let: ([a-proc : SlotValue (machine-proc m)])
                  (cond
@@ -261,6 +261,14 @@
                                     (map (lambda: ([d : Natural]) (env-ref m d))
                                          (FixClosureShellMap!-closed-vals op)))
                  'ok)]
+
+          
+          [(SetFrameCallee!? op)
+           (let* ([proc-value (ensure-closure (evaluate-oparg m (SetFrameCallee!-proc op)))]
+                  [frame (ensure-CallFrame (control-top m))])
+             (set-CallFrame-proc! frame proc-value)
+             'ok)]
+
           
           [(RestoreControl!? op)
            (let: ([tag-value : ContinuationPromptTagValue
@@ -746,6 +754,12 @@
      (set-machine-control! m (rest control))
      'ok]))
 
+(: control-top (machine -> frame))
+(define (control-top m)
+  (match m
+    [(struct machine (val proc env control pc text stack-size jump-table))
+     (first control)]))
+
 
 
 (: increment-pc! (machine -> 'ok))