Add meta assembly commands for dealing with variables

asm/fib.scm

@@ -1,6 +1,5 @@
   (variable result 0)
-  (push result)
+  (ref result)
-  (@)
   (push fib)
   (call)
   (push cleanup)
@@ -31,6 +30,5 @@ recur
   (nip)
   (return)
 cleanup
-  (push result)
+  (set! result)
-  (!)
   (bye)

scmvm/assembler.scm

@@ -16,9 +16,20 @@
 (define label? (compose not pair?))
 (define (variable? x)
   (and (pair? x) (eq? (car x) 'variable)))
+(define (ref? x)
+  (and (pair? x) (eq? (car x) 'ref)))
+(define (set!? x)
+  (and (pair? x) (eq? (car x) 'set!)))
 (define (instruction? x)
   (and (not (label? x))
-       (not (variable? x))))
+       (not (variable? x))
+       (not (ref? x))
+       (not (set!? x))))
+(define (instruction-size inst)
+  (case (car inst)
+    [(push) 5]
+    [(ref set!) 6]
+    [else 1]))
 
 (define (label-pass instructions address)
   (cond
@@ -28,9 +39,7 @@
    [(variable? (car instructions))
     (acons (cadar instructions) address (label-pass (cdr instructions) (+ address 4)))]
    [else
-    (label-pass (cdr instructions) (if (eq? (caar instructions) 'push)
+    (label-pass (cdr instructions) (+ address (instruction-size (car instructions))))]))
-                                       (+ address 5)
-                                       (+ address 1)))]))
 
 (define (write-word word)
   (define bv (make-bytevector 4))
@@ -44,9 +53,19 @@
    [(variable? (car seq))
     (write-word (caddar seq))
     (assembly-pass (cdr seq) labels)]
+   [(ref? (car seq))
+    (write-u8 (cadr (lookup-instruction 'push)))
+    (write-word (assq-ref labels (cadar seq)))
+    (write-u8 (cadr (lookup-instruction '@)))
+    (assembly-pass (cdr seq) labels)]
+   [(set!? (car seq))
+    (write-u8 (cadr (lookup-instruction 'push)))
+    (write-word (assq-ref labels (cadar seq)))
+    (write-u8 (cadr (lookup-instruction '!)))
+    (assembly-pass (cdr seq) labels)]
    [else
-    (let* [(inst (car seq))
+    (let* ([inst (car seq)]
-           (inst-obj (lookup-instruction (car inst)))]
+           [inst-obj (lookup-instruction (car inst))])
       (write-u8 (instruction-code inst-obj))
       (when (eq? (car inst) 'push)
         (if (number? (cadr inst))

tests.scm

@@ -18,8 +18,7 @@
 
 (define fib-program-asm
   '(  (variable result 0)
-      (push result)
+      (ref result)
-      (@)
       (push fib)
       (call)
       (push cleanup)
@@ -50,8 +49,7 @@
       (nip)
       (return)
     cleanup
-      (push result)
+      (set! result)
-      (!)
       (bye)))
 
 (define adder-program-bytecode