9 (define (codegen-add xs si env)
12 (emit "movq ~a(%rsp), %rax" si)
16 (emit "addq $~a, ~a(%rsp)" y si)
18 (codegen-expr y (- si wordsize) env)
19 (emit "addq %rax, ~a(%rsp)" si))))
22 ; use si(%rsp) as the accumulator
23 (emit "movq $0, ~a(%rsp)" si)
26 (define (codegen-binop opcode)
28 (codegen-expr b si env)
29 (emit "movq %rax, ~a(%rsp)" si)
30 (codegen-expr a (- si wordsize) env)
31 (emit "~a ~a(%rsp), %rax" opcode si)))
33 (define codegen-sub (codegen-binop "sub"))
34 (define codegen-mul (codegen-binop "imul"))
36 (define (codegen-not x si env)
37 (codegen-expr x si env)
38 (emit "xorq $-1, %rax")
39 (emit "andq $1, %rax"))
43 (append (range s (- n 1))
44 (list (+ s (- n 1))))))
48 (define (codegen-let bindings body si env)
49 (let* ((stack-offsets (map (lambda (x) (- si (* x wordsize)))
50 (range 0 (length bindings))))
51 (inner-si (- si (* (length bindings) wordsize)))
52 (names (map car bindings))
53 (exprs (map cadr bindings))
54 (inner-env (append (map cons names stack-offsets) env)))
55 (for-each (lambda (expr offset)
56 (codegen-expr expr inner-si env)
57 (emit "movq %rax, ~a(%rsp)" offset))
59 (for-each (lambda (form) (codegen-expr form inner-si inner-env)) body)))
61 (define (codegen-var name si env)
62 (let ((offset (cdr (assoc name env))))
63 (emit "movq ~a(%rsp), %rax" offset)))
65 (define (codegen-expr e si env)
68 ('+ (codegen-add (cdr e) si env))
69 ('- (codegen-sub (cadr e) (caddr e) si env))
70 ('* (codegen-mul (cadr e) (caddr e) si env))
71 ('! (codegen-not (cadr e) si env))
72 ('bool->int (codegen-expr (cadr e) si env))
73 (else (error #f "can't handle anything else yet"))))
74 ((let? e) (codegen-let
79 ((var? e) (codegen-var e si env))
80 ((boolean? e) (emit "movq $~a, %rax" (if e 1 0)))
81 (else (emit "movq $~a, %rax" e))))
83 (define (codegen program)
85 (emit ".p2align 4,,15")
86 (emit ".globl _scheme_entry")
87 (emit "_scheme_entry:")
89 ; handle incoming call from C
99 (codegen-expr program 0 '())
101 ; restore preserved registers
102 (for-each (lambda (i)
105 (number->string i))))
112 (define (compile-to-binary program)
113 (when (not (eq? (typecheck program) 'int)) (error #f "not an int"))
114 (let ([tmp-path "/tmp/a.s"])
115 (when (file-exists? tmp-path) (delete-file tmp-path))
116 (with-output-to-file tmp-path
117 (lambda () (codegen program)))
118 (system "clang -fomit-frame-pointer /tmp/a.s rts.c")))