in the middle of moving getControlStackLabel as an oparg, so we don't need to write into val register before jumping

assemble-helpers.rkt

@@ -31,7 +31,11 @@
     [(EnvWholePrefixReference? v)
      (assemble-whole-prefix-reference v)]
     [(SubtractArg? v)
-     (assemble-subtractarg v)]))
+     (assemble-subtractarg v)]
+    [(ControlStackLabel? v)
+     (assemble-control-stack-label v)]
+    [(ControlStackLabel/MultipleValueReturn? v)
+     (assemble-control-stack-label/multiple-value-return v)]))
 
 
 
@@ -125,3 +129,14 @@
   (format "(~a - ~a)"
           (assemble-oparg (SubtractArg-lhs s))
           (assemble-oparg (SubtractArg-rhs s))))
+
+
+(: assemble-control-stack-label (ControlStackLabel -> String))
+(define (assemble-control-stack-label a-csl)
+  "MACHINE.control[MACHINE.control.length-1].label")
+
+
+(: assemble-control-stack-label/multiple-value-return (ControlStackLabel/MultipleValueReturn -> String))
+(define (assemble-control-stack-label/multiple-value-return a-csl)
+  "MACHINE.control[MACHINE.control.length-1].label.multipleValueReturn")
+

assemble-structs.rkt

@@ -0,0 +1,15 @@
+#lang typed/racket/base
+
+(provide (all-defined-out))
+
+
+(require "il-structs.rkt")
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Assembly
+
+(define-struct: BasicBlock ([name : Symbol] 
+                            [stmts : (Listof UnlabeledStatement)]) 
+  #:transparent)

assemble.rkt

@@ -2,6 +2,7 @@
 (require "il-structs.rkt"
          "lexical-structs.rkt"
          "helpers.rkt"
+	 "assemble-structs.rkt"
          "assemble-helpers.rkt"
          "assemble-open-coded.rkt"
          racket/string
@@ -170,7 +171,11 @@ EOF
        empty]
       [(SubtractArg? an-input)
        (append (collect-input (SubtractArg-lhs an-input))
-               (collect-input (SubtractArg-rhs an-input)))]))
+               (collect-input (SubtractArg-rhs an-input)))]
+      [(ControlStackLabel? an-input)
+       empty]
+      [(ControlStackLabel/MultipleValueReturn? an-input)
+       empty]))
   
   (: collect-location ((U Reg Label) -> (Listof Symbol)))
   (define (collect-location a-location)
@@ -191,10 +196,6 @@ EOF
        (list (MakeCompiledProcedureShell-label op))]
       [(ApplyPrimitiveProcedure? op)
        empty]
-      [(GetControlStackLabel? op)
-       empty]
-      [(GetControlStackLabel/MultipleValueReturn? op)
-       empty]
       [(CaptureEnvironment? op)
        empty]
       [(CaptureControl? op)
@@ -457,12 +458,6 @@ EOF
     [(ApplyPrimitiveProcedure? op)
      (format "MACHINE.proc(MACHINE)")]
     
-    [(GetControlStackLabel? op)
-     (format "MACHINE.control[MACHINE.control.length-1].label")]
-
-    [(GetControlStackLabel/MultipleValueReturn? op)
-     (format "MACHINE.control[MACHINE.control.length-1].label.multipleValueReturn")]
-  
     [(CaptureEnvironment? op)
      (format "MACHINE.env.slice(0, MACHINE.env.length - ~a)"
              (CaptureEnvironment-skip op))]

compiler.rkt

@@ -205,13 +205,13 @@
 (define (compile-linkage cenv linkage)
   (cond
     [(ReturnLinkage? linkage)
-     (make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+     (make-instruction-sequence `(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
                                   ,(make-PopEnvironment (make-Const (length cenv)) 
                                                         (make-Const 0))
                                   ,(make-PopControlFrame)
                                   ,(make-GotoStatement (make-Reg 'proc))))]
     [(ReturnLinkage/NonTail? linkage)
-     (make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+     (make-instruction-sequence `(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
                                   ,(make-PopControlFrame)
                                   ,(make-GotoStatement (make-Reg 'proc))))]
     [(NextLinkage? linkage)

il-structs.rkt

@@ -27,6 +27,8 @@
                       EnvPrefixReference  ;; a reference into an element in the toplevel.
                       EnvWholePrefixReference ;; a reference into a toplevel prefix in the stack.
                       SubtractArg
+		      ControlStackLabel
+		      ControlStackLabel/MultipleValueReturn
                       ))
 
 
@@ -57,6 +59,21 @@
   #:transparent)
 
 
+;; Gets the return address embedded at the top of the control stack.
+(define-struct: ControlStackLabel ()
+  #:transparent)
+
+;; Gets the secondary (mulitple-value-return) return address embedded
+;; at the top of the control stack.
+(define-struct: ControlStackLabel/MultipleValueReturn ()
+  #:transparent)
+
+
+
+
+
+
+
 
 (define-struct: PrimitivesReference ([name : Symbol])
   #:transparent)
@@ -172,11 +189,6 @@
                                   MakeCompiledProcedureShell
                                   ApplyPrimitiveProcedure
 
-                                  ;; Gets at the single-value-return address.
-                                  GetControlStackLabel
-                                  ;; Gets at the multiple-value-return address.
-                                  GetControlStackLabel/MultipleValueReturn
-                                  
                                   MakeBoxedEnvironmentValue
 
                                   CaptureEnvironment
@@ -227,12 +239,6 @@
 
 
 
-;; Gets the return address embedded at the top of the control stack.
-(define-struct: GetControlStackLabel ()
-  #:transparent)
-(define-struct: GetControlStackLabel/MultipleValueReturn ()
-  #:transparent)
-
 
 (define-struct: MakeBoxedEnvironmentValue ([depth : Natural])
   #:transparent)
@@ -437,16 +443,6 @@
 
 
 
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Assembly
-
-(define-struct: BasicBlock ([name : Symbol] 
-                            [stmts : (Listof UnlabeledStatement)]) 
-  #:transparent)
-
-
-
 (define-type Arity (U Natural ArityAtLeast (Listof (U Natural ArityAtLeast))))
 (define-struct: ArityAtLeast ([value : Natural])
   #:transparent)

optimize-il.rkt

@@ -65,7 +65,11 @@
      (make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth oparg))))]
     [(SubtractArg? oparg)
      (make-SubtractArg (adjust-oparg-depth (SubtractArg-lhs oparg) n)
-                       (adjust-oparg-depth (SubtractArg-rhs oparg) n))]))
+                       (adjust-oparg-depth (SubtractArg-rhs oparg) n))]
+    [(ControlStackLabel? oparg)
+     oparg]
+    [(ControlStackLabel/MultipleValueReturn? oparg)
+     oparg]))
 
 
 (define-predicate natural? Natural)