test case for assembling make-CompiledProcedureClosureReference

assemble-helpers.rkt

@@ -181,7 +181,8 @@
 
 (: assemble-compiled-procedure-closure-reference (CompiledProcedureClosureReference -> String))
 (define (assemble-compiled-procedure-closure-reference a-ref)
-  (format "(~a).closedVals[~a]"
+  (format "(~a).closedVals[(~a).closedVals.length - 1 - ~a]"
+          (assemble-oparg (CompiledProcedureClosureReference-proc a-ref))
           (assemble-oparg (CompiledProcedureClosureReference-proc a-ref))
           (CompiledProcedureClosureReference-n a-ref)))
 

assemble-perform-statement.rkt

@@ -58,8 +58,10 @@
     
     [(InstallClosureValues!? op)
      "MACHINE.env.splice.apply(MACHINE.env, [MACHINE.env.length, 0].concat(MACHINE.proc.closedVals));"]
+    
     [(RestoreEnvironment!? op)
      "MACHINE.env = MACHINE.env[MACHINE.env.length - 2].slice(0);"]
+    
     [(RestoreControl!? op)
      (format "RUNTIME.restoreControl(MACHINE, ~a);"
              (let: ([tag : (U DefaultContinuationPromptTag OpArg)
@@ -69,6 +71,7 @@
                   (assemble-default-continuation-prompt-tag)]
                  [(OpArg? tag)
                   (assemble-oparg tag)])))]
+    
     [(FixClosureShellMap!? op)
      (format "MACHINE.env[MACHINE.env.length - 1 - ~a].closedVals = [~a]"
              (FixClosureShellMap!-depth op)
@@ -80,9 +83,11 @@
 			    ;; 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)))]
+    
     [(SpliceListIntoStack!? op)
      (format "RUNTIME.spliceListIntoStack(MACHINE, ~a);"
              (assemble-oparg (SpliceListIntoStack!-depth op)))]

test-assemble.rkt

@@ -493,3 +493,33 @@
                         end)
               "MACHINE.val")
       "ok")
+
+
+
+
+;; Let's test closure value lookup.
+(test (E-many `(,(make-PushImmediateOntoEnvironment (make-Const 3) #f)
+                ,(make-PushImmediateOntoEnvironment (make-Const 4) #f)
+                procedure-entry
+                ;; doesn't matter about the procedure entry...
+                ,(make-AssignPrimOpStatement 
+                          'proc
+                          (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry))
+                ,(make-AssignImmediateStatement 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 0)))
+              "MACHINE.val")
+      "4")
+
+(test (E-many `(,(make-PushImmediateOntoEnvironment (make-Const 3) #f)
+                ,(make-PushImmediateOntoEnvironment (make-Const 4) #f)
+                procedure-entry
+                ;; doesn't matter about the procedure entry...
+                ,(make-AssignPrimOpStatement 
+                          'proc
+                          (make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list 0 1) 'procedure-entry))
+                ,(make-AssignImmediateStatement 'val (make-CompiledProcedureClosureReference (make-Reg 'proc) 1)))
+              "MACHINE.val")
+      "3")
+
+
+
+