61 lines
1.8 KiB
Scheme
61 lines
1.8 KiB
Scheme
(define-module (scmvm language assembly)
|
|
#:use-module (scmvm vm)
|
|
#:use-module (scmvm assembler)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module ((scheme base) #:select (write-bytevector))
|
|
#:export (assemble assemble-instructions))
|
|
|
|
(define *aliases*
|
|
'((if . branch)))
|
|
|
|
(define (or-alias inst)
|
|
(or (assq-ref *aliases* inst) inst))
|
|
|
|
(define (lookup-instruction inst)
|
|
(define inst-obj (assq (or-alias inst) *instruction-set*))
|
|
(if inst-obj
|
|
inst-obj
|
|
(error (format #f "could not find instruction ~a" inst))))
|
|
|
|
(define label? (negate 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 (push? x)
|
|
(and (pair? x) (eq? (car x) 'push)))
|
|
|
|
(define (emit-push asm v)
|
|
(emit-instruction asm 'push)
|
|
(if (number? v)
|
|
(emit-literal asm v)
|
|
(emit-reference asm v)))
|
|
|
|
(define (assemble-instructions asm inst-seq)
|
|
(when (pair? inst-seq)
|
|
(cond
|
|
[(label? (car inst-seq))
|
|
(emit-label asm (car inst-seq))]
|
|
[(variable? (car inst-seq))
|
|
(emit-label asm (second (car inst-seq)))
|
|
(emit-literal asm (third (car inst-seq)))]
|
|
[(ref? (car inst-seq))
|
|
(emit-push asm (second (car inst-seq)))
|
|
(emit-instruction asm '@)]
|
|
[(set!? (car inst-seq))
|
|
(emit-push asm (second (car inst-seq)))
|
|
(emit-instruction asm '!)]
|
|
[(push? (car inst-seq))
|
|
(emit-push asm (second (car inst-seq)))]
|
|
[else
|
|
(emit-instruction asm (instruction-name (lookup-instruction (first (car inst-seq)))))])
|
|
(assemble-instructions asm (cdr inst-seq))))
|
|
|
|
(define (assemble instructions port)
|
|
(define asm (make-assembler))
|
|
(assemble-instructions asm instructions)
|
|
(finalize-references asm)
|
|
(assembler-dump-program asm port))
|