broke something

assemble-helpers.rkt

@@ -12,7 +12,6 @@
          assemble-whole-prefix-reference
          assemble-reg
          assemble-label
-         assemble-input
          assemble-listof-assembled-values)
 
 
@@ -30,7 +29,9 @@
     [(EnvPrefixReference? v)
      (assemble-prefix-reference v)]
     [(EnvWholePrefixReference? v)
-     (assemble-whole-prefix-reference v)]))
+     (assemble-whole-prefix-reference v)]
+    [(SubtractArg? v)
+     (assemble-subtractarg v)]))
 
 
 
@@ -116,20 +117,8 @@
 (define (assemble-label a-label)
   (symbol->string (Label-name a-label)))
 
-
-
-(: assemble-input (OpArg -> String))
-(define (assemble-input an-input)
-  (cond
-    [(Reg? an-input)
-     (assemble-reg an-input)]
-    [(Const? an-input)
-     (assemble-const an-input)]
-    [(Label? an-input)
-     (assemble-label an-input)]
-    [(EnvLexicalReference? an-input)
-     (assemble-lexical-reference an-input)]
-    [(EnvPrefixReference? an-input)
-     (assemble-prefix-reference an-input)]
-    [(EnvWholePrefixReference? an-input)
-     (assemble-whole-prefix-reference an-input)]))
+(: assemble-subtractarg (SubtractArg -> String))
+(define (assemble-subtractarg s)
+  (format "(~a - ~a)"
+          (assemble-oparg (SubtractArg-lhs s))
+          (assemble-oparg (SubtractArg-rhs s))))

assemble-open-coded.rkt

@@ -14,7 +14,7 @@
 (: open-code-kernel-primitive-procedure (CallKernelPrimitiveProcedure -> String))
 (define (open-code-kernel-primitive-procedure op)
   (let*: ([operator : KernelPrimitiveName (CallKernelPrimitiveProcedure-operator op)]
-          [operands : (Listof String) (map assemble-input (CallKernelPrimitiveProcedure-operands op))]
+          [operands : (Listof String) (map assemble-oparg (CallKernelPrimitiveProcedure-operands op))]
           [checked-operands : (Listof String)
                             (map maybe-typecheck-operand
                                  (CallKernelPrimitiveProcedure-expected-operand-types op)

assemble.rkt

@@ -117,7 +117,10 @@ EOF
       [(EnvPrefixReference? an-input)
        empty]
       [(EnvWholePrefixReference? an-input)
-       empty]))
+       empty]
+      [(SubtractArg? an-input)
+       (append (collect-input (SubtractArg-lhs an-input))
+               (collect-input (SubtractArg-rhs an-input)))]))
   
   (: collect-location ((U Reg Label) -> (Listof Symbol)))
   (define (collect-location a-location)
@@ -182,19 +185,7 @@ EOF
                              empty]
                             [(AssignImmediateStatement? stmt)
                              (let: ([v : OpArg (AssignImmediateStatement-value stmt)])
-                                   (cond 
-                                     [(Reg? v)
-                                      empty]
-                                     [(Label? v)
-                                      (list (Label-name v))]
-                                     [(Const? v)
-                                      empty]
-                                     [(EnvLexicalReference? v)
-                                      empty]
-                                     [(EnvPrefixReference? v)
-                                      empty] 
-                                     [(EnvWholePrefixReference? v)
-                                      empty]))]
+                                   (collect-input v))]
                             [(AssignPrimOpStatement? stmt)
                              (collect-primitive-operator (AssignPrimOpStatement-op stmt))]
                             [(PerformStatement? stmt)

compile.rkt

@@ -872,7 +872,7 @@
                     `(,(make-AssignPrimOpStatement 'val 
                                                    (make-GetCompiledProcedureEntry))))
                    (make-instruction-sequence `(,(make-PopEnvironment (make-Const num-slots-to-delete) 
-                                                                      (make-Const n))))
+                                                                      (make-Reg 'argcount))))
                    (make-instruction-sequence
                     `(;; Assign the proc value of the existing call frame
                       ,(make-PerformStatement 

il-structs.rkt

@@ -26,6 +26,7 @@
                       EnvLexicalReference ;; a reference into the stack
                       EnvPrefixReference  ;; a reference into an element in the toplevel.
                       EnvWholePrefixReference ;; a reference into a toplevel prefix in the stack.
+                      SubtractArg
                       ))
 
 
@@ -44,6 +45,11 @@
 (define-struct: Const ([const : Any])
   #:transparent)
 
+;; Limited arithmetic on OpArgs
+(define-struct: SubtractArg ([lhs : OpArg]
+                             [rhs : OpArg])
+  #:transparent)
+
 
 
 (define-struct: PrimitivesReference ([name : Symbol])

simulator.rkt

@@ -608,7 +608,11 @@
              [else
               (error 'evaluate-oparg "Internal error: not a toplevel at depth ~s: ~s"
                      (EnvWholePrefixReference-depth an-oparg)
-                     v)]))]))
+                     v)]))]
+
+    [(SubtractArg? an-oparg)
+     (- (ensure-number (evaluate-oparg m (SubtractArg-lhs an-oparg)))
+        (ensure-number (evaluate-oparg m (SubtractArg-rhs an-oparg))))]))
 
 
 (: ensure-closure-or-false (SlotValue -> (U closure #f)))