added generic frames

assemble.rkt

@@ -139,6 +139,8 @@ EOF
           (next)]
          [(PushImmediateOntoEnvironment? stmt)
           (next)]
+         [(PushControlFrame/Generic? stmt)
+          (next)]
          [(PushControlFrame/Call? stmt)
           (next)]
          [(PushControlFrame/Prompt? stmt)
@@ -259,6 +261,8 @@ EOF
                              empty]
                             [(PushImmediateOntoEnvironment? stmt)
                              (collect-input (PushImmediateOntoEnvironment-value stmt))]
+                            [(PushControlFrame/Generic? stmt)
+                             empty]
                             [(PushControlFrame/Call? stmt)
                              (label->labels (PushControlFrame/Call-label stmt))]
                             [(PushControlFrame/Prompt? stmt)
@@ -330,6 +334,9 @@ EOF
      [(GotoStatement? stmt)
       (assemble-jump (GotoStatement-target stmt))]
 
+     [(PushControlFrame/Generic? stmt)
+      "MACHINE.control.push(new RUNTIME.Frame());"]
+     
      [(PushControlFrame/Call? stmt)
       (format "MACHINE.control.push(new RUNTIME.CallFrame(~a, MACHINE.proc));" 
               (let ([label (PushControlFrame/Call-label stmt)])

compiler.rkt

@@ -1284,50 +1284,23 @@
     
     [(or (NextLinkage? linkage)
          (LabelLinkage? linkage))
-     (let* (;[after-key-multiple (make-label 'afterKeyMultiple)]
+     (end-with-linkage 
-            ;[after-key (make-LinkedLabel (make-label 'afterKey) after-key-multiple)]
+      linkage cenv
-            ;[after-value-multiple (make-label 'afterValueMultiple)]
+      (append-instruction-sequences
-            ;[after-value (make-LinkedLabel (make-label 'afterValue) after-value-multiple)]
+       ;; Making a continuation frame; isn't really used for anything
-            [after-body-multiple (make-label 'afterBody)]
+       ;; but recording the key/value data.
-            [after-body (make-LinkedLabel (make-label 'afterBody) after-body-multiple)])
+       (make-instruction-sequence 
-       (end-with-linkage 
+        `(,(make-PushControlFrame/Generic)))
-        linkage cenv
+       (compile (WithContMark-key exp) cenv 'val next-linkage)
-        (append-instruction-sequences
+       (make-instruction-sequence `(,(make-AssignImmediateStatement
-         ;; Making a continuation frame; isn't really used for anything else but recording the key/value data.
+                                      (make-ControlFrameTemporary 'pendingContinuationMarkKey)
-         ;; FIXME: create separate frame structure here, and don't try to reuse.
+                                      (make-Reg 'val))))
-         (make-instruction-sequence 
+       (compile (WithContMark-value exp) cenv 'val next-linkage)
-          `(,(make-AssignImmediateStatement 'proc (make-Const #f))
+       (make-instruction-sequence `(,(make-PerformStatement
-            ,(make-PushControlFrame/Call after-body)))
+                                      (make-InstallContinuationMarkEntry!))))
-
+       (compile (WithContMark-body exp) cenv target next-linkage)
-         ;(make-instruction-sequence 
+       (make-instruction-sequence
-         ; `(,(make-AssignImmediateStatement 'proc (make-Const #f))
+        `(,(make-PopControlFrame)))))]))
-         ;   ,(make-PushControlFrame after-key)))
-         (compile (WithContMark-key exp) cenv 'val next-linkage)
-         ;after-key-multiple
-         ;; Fixme: we should error out here instead
-         ;(make-instruction-sequence 
-         ; `(,(make-PopEnvironment (make-Reg 'argcount) (make-Const 0))))
-         ;after-key
-         (make-instruction-sequence `(,(make-AssignImmediateStatement
-                                        (make-ControlFrameTemporary 'pendingContinuationMarkKey)
-                                        (make-Reg 'val))))
-         ;(make-instruction-sequence 
-         ; `(,(make-AssignImmediateStatement 'proc (make-Const #f))
-         ;   ,(make-PushControlFrame after-value)))
-         (compile (WithContMark-value exp) cenv 'val next-linkage)
-         ;after-value-multiple
-         ;; Fixme: we should error out here instead
-         ;(make-instruction-sequence 
-         ; `(,(make-PopEnvironment (make-Reg 'argcount) (make-Const 0))))
-         ;after-value
-         (make-instruction-sequence `(,(make-PerformStatement
-                                        (make-InstallContinuationMarkEntry!))))
-         (compile (WithContMark-body exp) cenv target next-linkage)
-         after-body-multiple
-         after-body
-         (make-instruction-sequence
-          `(,(make-PopControlFrame))))))]))
-
 
 
 

il-structs.rkt

@@ -80,6 +80,7 @@
                                  
                                  PushImmediateOntoEnvironment
                                  
+                                 PushControlFrame/Generic
                                  PushControlFrame/Call
                                  PushControlFrame/Prompt
 
@@ -124,6 +125,10 @@
   #:transparent)
 
 
+;; A generic control frame only holds marks and other temporary variables.
+(define-struct: PushControlFrame/Generic ()
+  #:transparent)
+
 ;; Adding a frame for getting back after procedure application.
 ;; The 'proc register must hold either #f or a closure at the time of
 ;; this call, as the control frame will hold onto the called procedure record.

simulator-structs.rkt

@@ -57,7 +57,14 @@
   #:mutable)
 
 
-(define-type frame (U CallFrame PromptFrame))
+
+(define-type frame (U GenericFrame CallFrame PromptFrame))
+
+
+(define-struct: GenericFrame ([temps : (HashTable Symbol PrimitiveValue)]
+                              [marks : (HashTable PrimitiveValue PrimitiveValue)])
+  #:transparent)
+
 
 (define-struct: CallFrame ([return : (U Symbol LinkedLabel)]
                            ;; The procedure being called.  Used to optimize self-application
@@ -66,7 +73,7 @@
                            [temps : (HashTable Symbol PrimitiveValue)]
                            [marks : (HashTable PrimitiveValue PrimitiveValue)])
   #:transparent
-  #:mutable)
+  #:mutable)  ;; mutable because we want to allow mutation of proc.
 
 (define-struct: PromptFrame ([tag : ContinuationPromptTagValue]
                              [return : (U Symbol LinkedLabel)]
@@ -79,6 +86,8 @@
 (: frame-temps (frame -> (HashTable Symbol PrimitiveValue)))
 (define (frame-temps a-frame)
   (cond
+    [(GenericFrame? a-frame)
+     (GenericFrame-temps a-frame)]
     [(CallFrame? a-frame)
      (CallFrame-temps a-frame)]
     [(PromptFrame? a-frame)
@@ -88,14 +97,19 @@
 (: frame-marks (frame -> (HashTable PrimitiveValue PrimitiveValue)))
 (define (frame-marks a-frame)
   (cond
+    [(GenericFrame? a-frame)
+     (GenericFrame-marks a-frame)]
     [(CallFrame? a-frame)
      (CallFrame-marks a-frame)]
     [(PromptFrame? a-frame)
      (PromptFrame-marks a-frame)]))
 
+
 (: frame-tag (frame -> (U ContinuationPromptTagValue #f)))
 (define (frame-tag a-frame)
   (cond
+    [(GenericFrame? a-frame)
+     #f]
     [(CallFrame? a-frame)
      #f]
     [(PromptFrame? a-frame)

simulator.rkt

@@ -109,6 +109,8 @@
                      (step-push-environment! m i)]
                     [(PushImmediateOntoEnvironment? i)
                      (step-push-immediate-onto-environment! m i)]
+                    [(PushControlFrame/Generic? i)
+                     (step-push-control-frame/generic! m i)]
                     [(PushControlFrame/Call? i)
                      (step-push-control-frame! m i)]
                     [(PushControlFrame/Prompt? i)
@@ -168,6 +170,14 @@
     (step-push-environment! m (make-PushEnvironment 1 (PushImmediateOntoEnvironment-box? stmt)))
     ((get-target-updater t) m v)))
 
+
+
+(: step-push-control-frame/generic! (machine PushControlFrame/Generic -> 'ok))
+(define (step-push-control-frame/generic! m stmt)
+  (control-push! m (make-GenericFrame (make-hasheq)
+                                      (make-hasheq))))
+
+
 (: step-push-control-frame! (machine PushControlFrame/Call -> 'ok))
 (define (step-push-control-frame! m stmt)
   (control-push! m (make-CallFrame (PushControlFrame/Call-label stmt)
@@ -504,6 +514,8 @@
           [(GetControlStackLabel? op)
            (target-updater! m (let ([frame (ensure-frame (first (machine-control m)))])
                                 (cond
+                                  [(GenericFrame? frame)
+                                   (error 'GetControlStackLabel)]
                                   [(PromptFrame? frame)
                                    (let ([label (PromptFrame-return frame)])
                                      (cond
@@ -522,6 +534,8 @@
           [(GetControlStackLabel/MultipleValueReturn? op)
            (target-updater! m (let ([frame (ensure-frame (first (machine-control m)))])
                                 (cond
+                                  [(GenericFrame? frame)
+                                   (error 'GetControlStackLabel/MultipleValueReturn)]
                                   [(PromptFrame? frame)
                                    (let ([label (PromptFrame-return frame)])
                                      (cond
@@ -573,6 +587,8 @@
     [else
      (let ([a-frame (first frames)])
        (cond
+         [(GenericFrame? a-frame)
+          (cons a-frame (take-continuation-to-tag (rest frames) tag))]
          [(CallFrame? a-frame)
           (cons a-frame (take-continuation-to-tag (rest frames) tag))]
          [(PromptFrame? a-frame)
@@ -592,6 +608,8 @@
     [else
      (let ([a-frame (first frames)])
        (cond
+         [(GenericFrame? a-frame)
+          (drop-continuation-to-tag (rest frames) tag)]
          [(CallFrame? a-frame)
           (drop-continuation-to-tag (rest frames) tag)]
          [(PromptFrame? a-frame)