(load "typecheck.scm")
+(load "ast.scm")
(define (emit . s)
(begin
(apply printf s)
(display "\n")))
-(define (compile-add xs)
+(define (codegen-add xs)
(define (go ys)
(if (null? ys)
(emit "movq %rbx, %rax")
(emit "movq $0, %rbx")
(go xs)))
-(define (compile-expr e)
- (if (and (list? e) (eq? (car e) '+))
- (compile-add (cdr e))
- (emit "movq $~a, %rax" e)))
+(define (range s n)
+ (if (= 0 n) '()
+ (append (range s (- n 1))
+ (list (+ s (- n 1))))))
-(define (compile-program program)
+(define wordsize 8)
+
+(define (codegen-let bindings body si env)
+ (let* ((stack-offsets (map (lambda (x) (- si (* x wordsize)))
+ (range 0 (length bindings))))
+ (inner-si (- si (* (length bindings) wordsize)))
+ (names (map car bindings))
+ (exprs (map cadr bindings))
+ (inner-env (append (map cons names stack-offsets) env)))
+ (for-each (lambda (expr offset)
+ (codegen-expr expr inner-si env)
+ (emit "movq %rax, ~a(%rsp)" offset))
+ exprs stack-offsets)
+ (for-each (lambda (form) (codegen-expr form inner-si inner-env)) body)))
+
+(define (codegen-var name si env)
+ (let ((offset (cdr (assoc name env))))
+ (emit "movq ~a(%rsp), %rax" offset)))
+
+(define (codegen-expr e si env)
+ (cond ((and (list? e) (eq? (car e) '+))
+ (codegen-add (cdr e)))
+ ((let? e) (codegen-let
+ (let-bindings e)
+ (let-body e)
+ si
+ env))
+ ((var? e) (codegen-var e si env))
+ (else (emit "movq $~a, %rax" e))))
+
+(define (codegen program)
(emit ".text")
(emit ".p2align 4,,15")
(emit ".globl _scheme_entry")
'(12 13 14 15))
; our code goes here
- (compile-expr program)
+ (codegen-expr program 0 '())
; restore preserved registers
(for-each (lambda (i)
(let ([tmp-path "/tmp/a.s"])
(when (file-exists? tmp-path) (delete-file tmp-path))
(with-output-to-file tmp-path
- (lambda () (compile-program program)))
+ (lambda () (codegen program)))
(system "clang -fomit-frame-pointer /tmp/a.s rts.c")))