Assembler refactor

scmvm/assembler.scm

@@ -20,39 +20,41 @@
   (and (not (label? x))
        (not (variable? x))))
 
-(define (find-labels inst-seq n)
+(define (label-pass instructions address)
   (cond
-   [(null? inst-seq) '()]
+   [(null? instructions) '()]
-   [(label? (car inst-seq))
+   [(label? (car instructions))
-    (acons (car inst-seq) n (find-labels (cdr inst-seq) n))]
+    (acons (car instructions) address (label-pass (cdr instructions) address))]
-   [(variable? (car inst-seq))
+   [(variable? (car instructions))
-    (acons (cadar inst-seq) n (find-labels (cdr inst-seq) (+ n 4)))]
+    (acons (cadar instructions) address (label-pass (cdr instructions) (+ address 4)))]
    [else
-    (find-labels (cdr inst-seq) (if (eq? (caar inst-seq) 'push) (+ n 5) (+ n 1)))]))
+    (label-pass (cdr instructions) (if (eq? (caar instructions) 'push)
+                                       (+ address 5)
+                                       (+ address 1)))]))
 
 (define (write-word word)
   (define bv (make-bytevector 4))
   (bytevector-s32-native-set! bv 0 word)
   (write-bytevector bv))
 
-(define (assemble inst-seq port)
+(define (assembly-pass seq labels)
-  (define labels (find-labels inst-seq 1))
+  (cond
-  (with-output-to-port port
+   [(null? seq) '()]
-    (lambda ()
+   [(label? (car seq)) (assembly-pass (cdr seq) labels)]
-      (let loop ([seq inst-seq])
+   [(variable? (car seq))
-        (cond
+    (write-word (caddar seq))
-         [(null? seq) '()]
+    (assembly-pass (cdr seq) labels)]
-         [(label? (car seq)) (loop (cdr seq))]
+   [else
-         [(variable? (car seq))
+    (let* [(inst (car seq))
-          (write-word (caddar seq))
+           (inst-obj (lookup-instruction (car inst)))]
-          (loop (cdr seq))]
+      (write-u8 (instruction-code inst-obj))
-         [else
+      (when (eq? (car inst) 'push)
-          (let* [(inst (car seq))
+        (if (number? (cadr inst))
-                 (inst-obj (lookup-instruction (car inst)))]
+            (write-word (cadr inst))
-            (write-u8 (instruction-code inst-obj))
+            (write-word (assq-ref labels (cadr inst)))))
-            (when (eq? (car inst) 'push)
+      (assembly-pass (cdr seq) labels))]))
-              (if (number? (cadr inst))
+
-                  (write-word (cadr inst))
+(define (assemble instructions port)
-                  (write-word (assq-ref labels (cadr inst)))))
+  (define labels (label-pass instructions 1))
-            (loop (cdr seq)))]))))
+  (with-output-to-port port (lambda () (assembly-pass instructions labels)))
   labels)