9 (define (codegen-add xs si env)
12 (emit "movq %rbx, %rax")
16 (emit "addq $~a, %rbx" y)
18 (codegen-expr y si env)
19 (emit "addq %rax, %rbx"))))
22 (emit "movq $0, %rbx")
27 (append (range s (- n 1))
28 (list (+ s (- n 1))))))
32 (define (codegen-let bindings body si env)
33 (let* ((stack-offsets (map (lambda (x) (- si (* x wordsize)))
34 (range 0 (length bindings))))
35 (inner-si (- si (* (length bindings) wordsize)))
36 (names (map car bindings))
37 (exprs (map cadr bindings))
38 (inner-env (append (map cons names stack-offsets) env)))
39 (for-each (lambda (expr offset)
40 (codegen-expr expr inner-si env)
41 (emit "movq %rax, ~a(%rsp)" offset))
43 (for-each (lambda (form) (codegen-expr form inner-si inner-env)) body)))
45 (define (codegen-var name si env)
46 (let ((offset (cdr (assoc name env))))
47 (emit "movq ~a(%rsp), %rax" offset)))
49 (define (codegen-expr e si env)
50 (cond ((and (list? e) (eq? (car e) '+))
51 (codegen-add (cdr e) si env))
52 ((let? e) (codegen-let
57 ((var? e) (codegen-var e si env))
58 (else (emit "movq $~a, %rax" e))))
60 (define (codegen program)
62 (emit ".p2align 4,,15")
63 (emit ".globl _scheme_entry")
64 (emit "_scheme_entry:")
66 ; handle incoming call from C
76 (codegen-expr program 0 '())
78 ; restore preserved registers
89 (define (compile-to-binary program)
90 (when (not (eq? (typecheck program) 'int)) (error #f "not an int"))
91 (let ([tmp-path "/tmp/a.s"])
92 (when (file-exists? tmp-path) (delete-file tmp-path))
93 (with-output-to-file tmp-path
94 (lambda () (codegen program)))
95 (system "clang -fomit-frame-pointer /tmp/a.s rts.c")))