From 227dcc662ea33caf6e44e5fdbf82882146f217c5 Mon Sep 17 00:00:00 2001 From: Dane Johnson Date: Fri, 20 Jun 2025 13:18:40 -0500 Subject: [PATCH] Add meta assembly commands for dealing with variables --- asm/fib.scm | 6 ++---- scmvm/assembler.scm | 31 +++++++++++++++++++++++++------ tests.scm | 6 ++---- 3 files changed, 29 insertions(+), 14 deletions(-) diff --git a/asm/fib.scm b/asm/fib.scm index 73a43f8..da6aeaa 100644 --- a/asm/fib.scm +++ b/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) diff --git a/scmvm/assembler.scm b/scmvm/assembler.scm index fac8fec..a479d55 100644 --- a/scmvm/assembler.scm +++ b/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) - (+ address 5) - (+ address 1)))])) + (label-pass (cdr instructions) (+ address (instruction-size (car instructions))))])) (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)) - (inst-obj (lookup-instruction (car inst)))] + (let* ([inst (car seq)] + [inst-obj (lookup-instruction (car inst))]) (write-u8 (instruction-code inst-obj)) (when (eq? (car inst) 'push) (if (number? (cadr inst)) diff --git a/tests.scm b/tests.scm index 456a660..bb112e1 100644 --- a/tests.scm +++ b/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