Compare commits

...

2 Commits

Author SHA1 Message Date
227dcc662e Add meta assembly commands for dealing with variables 2025-06-20 13:18:40 -05:00
bfe6db57b6 Assembler refactor 2025-06-17 15:03:10 -05:00
3 changed files with 53 additions and 36 deletions

View File

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

View File

@ -16,43 +16,64 @@
(define label? (compose not pair?)) (define label? (compose not pair?))
(define (variable? x) (define (variable? x)
(and (pair? x) (eq? (car x) 'variable))) (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) (define (instruction? x)
(and (not (label? 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 (find-labels inst-seq n) (define (label-pass instructions address)
(cond (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 [else
(find-labels (cdr inst-seq) (if (eq? (caar inst-seq) 'push) (+ n 5) (+ n 1)))])) (label-pass (cdr instructions) (+ address (instruction-size (car instructions))))]))
(define (write-word word) (define (write-word word)
(define bv (make-bytevector 4)) (define bv (make-bytevector 4))
(bytevector-s32-native-set! bv 0 word) (bytevector-s32-native-set! bv 0 word)
(write-bytevector bv)) (write-bytevector bv))
(define (assemble inst-seq port) (define (assembly-pass seq labels)
(define labels (find-labels inst-seq 1))
(with-output-to-port port
(lambda ()
(let loop ([seq inst-seq])
(cond (cond
[(null? seq) '()] [(null? seq) '()]
[(label? (car seq)) (loop (cdr seq))] [(label? (car seq)) (assembly-pass (cdr seq) labels)]
[(variable? (car seq)) [(variable? (car seq))
(write-word (caddar seq)) (write-word (caddar seq))
(loop (cdr 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 [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)) (write-u8 (instruction-code inst-obj))
(when (eq? (car inst) 'push) (when (eq? (car inst) 'push)
(if (number? (cadr inst)) (if (number? (cadr inst))
(write-word (cadr inst)) (write-word (cadr inst))
(write-word (assq-ref labels (cadr inst))))) (write-word (assq-ref labels (cadr inst)))))
(loop (cdr seq)))])))) (assembly-pass (cdr seq) labels))]))
(define (assemble instructions port)
(define labels (label-pass instructions 1))
(with-output-to-port port (lambda () (assembly-pass instructions labels)))
labels) labels)

View File

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