test cases running

bootstrapped-primitives.rkt

@@ -61,7 +61,7 @@
                                  ,(make-PerformStatement 
                                    (make-RestoreControl! default-continuation-prompt-tag))
                                  ,(make-PerformStatement (make-RestoreEnvironment!))
-                                 ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+                                 ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
                                  ,(make-PopControlFrame)
                                  ,(make-GotoStatement (make-Reg 'proc)))))))
 
@@ -174,11 +174,11 @@
        ,(make-TestAndBranchStatement 'one? 'argcount on-single-value)
        ;; values simply keeps the values on the stack, preserves the argcount, and does a return
        ;; to the multiple-value-return address.
-       ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel/MultipleValueReturn))
+       ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
        ,(make-PopControlFrame)
        ,(make-GotoStatement (make-Reg 'proc))
        ,on-single-value
-       ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+       ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
        ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
        ,(make-PopEnvironment (make-Const 1) (make-Const 0))
        ,(make-PopControlFrame)

simulator-structs.rkt

@@ -66,7 +66,7 @@
   #:transparent)
 
 
-(define-struct: CallFrame ([return : (U Symbol LinkedLabel)]
+(define-struct: CallFrame ([return : LinkedLabel]
                            ;; The procedure being called.  Used to optimize self-application
                            [proc : (U closure #f)]
                            ;; TODO: add continuation marks
@@ -76,7 +76,7 @@
   #:mutable)  ;; mutable because we want to allow mutation of proc.
 
 (define-struct: PromptFrame ([tag : ContinuationPromptTagValue]
-                             [return : (U Symbol LinkedLabel)]
+                             [return : LinkedLabel]
                              [env-depth : Natural]
                              [temps : (HashTable Symbol PrimitiveValue)]
                              [marks : (HashTable PrimitiveValue PrimitiveValue)])

simulator.rkt

@@ -516,46 +516,6 @@
                    [else
                     (error 'apply-primitive-procedure)]))]
           
-          [(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
-                                       [(symbol? label)
-                                        label]
-                                       [(LinkedLabel? label)
-                                        (LinkedLabel-label label)]))]
-                                  [(CallFrame? frame)
-                                   (let ([label (CallFrame-return frame)])
-                                     (cond
-                                       [(symbol? label)
-                                        label]
-                                       [(LinkedLabel? label)
-                                        (LinkedLabel-label label)]))])))]
-          
-          [(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
-                                       [(symbol? label) 
-                                        (error 'GetControlStackLabel/MultipleValueReturn)]
-                                       [(LinkedLabel? label)
-                                        (LinkedLabel-linked-to label)]))]
-                                  [(CallFrame? frame)
-                                   (let ([label (CallFrame-return frame)])
-                                     (cond
-                                       [(symbol? label) 
-                                        (error 'GetControlStackLabel/MultipleValueReturn)]
-                                       [(LinkedLabel? label)
-                                        (LinkedLabel-linked-to label)]))])))]
-          
           [(CaptureEnvironment? op)
            (target-updater! m (make-CapturedEnvironment (drop (machine-env m)
                                                               (CaptureEnvironment-skip op))))]
@@ -755,7 +715,33 @@
 
     [(SubtractArg? an-oparg)
      (- (ensure-number (evaluate-oparg m (SubtractArg-lhs an-oparg)))
-        (ensure-number (evaluate-oparg m (SubtractArg-rhs an-oparg))))]))
+        (ensure-number (evaluate-oparg m (SubtractArg-rhs an-oparg))))]
+
+
+
+    [(ControlStackLabel? an-oparg)
+     (let ([frame (ensure-frame (first (machine-control m)))])
+       (cond
+	[(GenericFrame? frame)
+	 (error 'GetControlStackLabel)]
+	[(PromptFrame? frame)
+	 (let ([label (PromptFrame-return frame)])
+	   (LinkedLabel-label label))]
+	[(CallFrame? frame)
+	 (let ([label (CallFrame-return frame)])
+	   (LinkedLabel-label label))]))]
+    
+    [(ControlStackLabel/MultipleValueReturn? an-oparg)
+     (let ([frame (ensure-frame (first (machine-control m)))])
+       (cond
+	[(GenericFrame? frame)
+	 (error 'GetControlStackLabel/MultipleValueReturn)]
+	[(PromptFrame? frame)
+	 (let ([label (PromptFrame-return frame)])
+	   (LinkedLabel-linked-to label))]
+	[(CallFrame? frame)
+	 (let ([label (CallFrame-return frame)])
+	   (LinkedLabel-linked-to label))]))]))
 
 
 (: ensure-closure-or-false (SlotValue -> (U closure #f)))

test-simulator.rkt

@@ -485,19 +485,19 @@
         (list 126389 42 (make-toplevel '(+) (list (lookup-primitive '+))))))
 
 
-;; GetControlStackLabel
+;; ControlStackLabel
 (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
                         foo
                         ,(make-PushControlFrame/Call (make-LinkedLabel 'foo 'foo))
-                        ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))))])
+                        ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))))])
   (test (machine-proc (run! m))
         'foo))
 
 
-;; GetControlStackLabel
+;; ControlStackLabel
 (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
                         ,(make-PushControlFrame/Call (make-LinkedLabel 'foo-single 'foo-multiple))
-                        ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+                        ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
                         ,(make-GotoStatement (make-Reg 'proc))
                         foo-single
                         ,(make-AssignImmediateStatement 'val (make-Const "single"))
@@ -510,7 +510,7 @@
         "single"))
 (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
                         ,(make-PushControlFrame/Call (make-LinkedLabel 'foo-single 'foo-multiple))
-                        ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel/MultipleValueReturn))
+                        ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
                         ,(make-GotoStatement (make-Reg 'proc))
                         foo-single
                         ,(make-AssignImmediateStatement 'val (make-Const "single"))
@@ -526,7 +526,7 @@
 (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
                         ,(make-PushControlFrame/Prompt default-continuation-prompt-tag
                                                        (make-LinkedLabel 'foo-single 'foo-multiple))
-                        ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+                        ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
                         ,(make-GotoStatement (make-Reg 'proc))
                         foo-single
                         ,(make-AssignImmediateStatement 'val (make-Const "single"))
@@ -540,7 +540,7 @@
 (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
                         ,(make-PushControlFrame/Prompt default-continuation-prompt-tag
                                                        (make-LinkedLabel 'foo-single 'foo-multiple))
-                        ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel/MultipleValueReturn))
+                        ,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
                         ,(make-GotoStatement (make-Reg 'proc))
                         foo-single
                         ,(make-AssignImmediateStatement 'val (make-Const "single"))