9 (define (codegen-add xs)
12 (emit "movq %rbx, %rax")
14 (emit "addq $~a, %rbx" (car ys))
17 (emit "movq $0, %rbx")
22 (append (range s (- n 1))
23 (list (+ s (- n 1))))))
27 (define (codegen-let bindings body si env)
28 (let* ((stack-offsets (map (lambda (x) (- si (* x wordsize)))
29 (range 0 (length bindings))))
30 (inner-si (- si (* (length bindings) wordsize)))
31 (names (map car bindings))
32 (exprs (map cadr bindings))
33 (inner-env (append (map cons names stack-offsets) env)))
34 (for-each (lambda (expr offset)
35 (codegen-expr expr inner-si env)
36 (emit "movq %rax, ~a(%rsp)" offset))
38 (for-each (lambda (form) (codegen-expr form inner-si inner-env)) body)))
40 (define (codegen-var name si env)
41 (let ((offset (cdr (assoc name env))))
42 (emit "movq ~a(%rsp), %rax" offset)))
44 (define (codegen-expr e si env)
45 (cond ((and (list? e) (eq? (car e) '+))
46 (codegen-add (cdr e)))
47 ((let? e) (codegen-let
52 ((var? e) (codegen-var e si env))
53 (else (emit "movq $~a, %rax" e))))
55 (define (codegen program)
57 (emit ".p2align 4,,15")
58 (emit ".globl _scheme_entry")
59 (emit "_scheme_entry:")
61 ; handle incoming call from C
71 (codegen-expr program 0 '())
73 ; restore preserved registers
84 (define (compile-to-binary program)
85 (when (not (eq? (typecheck program) 'int)) (error #f "not an int"))
86 (let ([tmp-path "/tmp/a.s"])
87 (when (file-exists? tmp-path) (delete-file tmp-path))
88 (with-output-to-file tmp-path
89 (lambda () (codegen program)))
90 (system "clang -fomit-frame-pointer /tmp/a.s rts.c")))