X-Git-Url: http://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=codegen.scm;fp=codegen.scm;h=78ebbad84bbbed8cab7cc3c013ad395d53f91eec;hp=571f1ef8498c0a662f3dfa7254b0cf2f535e4374;hb=5d4aafc1235538212989893f15006acc5d7d8f03;hpb=a006c661a194672c2d8f5730d3c207dd083ddbf0 diff --git a/codegen.scm b/codegen.scm index 571f1ef..78ebbad 100644 --- a/codegen.scm +++ b/codegen.scm @@ -1,6 +1,8 @@ (load "typecheck.scm") (load "ast.scm") +(define target 'darwin) + (define (emit . s) (begin (apply printf s) @@ -47,6 +49,8 @@ (emit "not %rax") (emit "andq $1, %rax")) +; 'write file handle addr-string num-bytes + (define (codegen-print x si env) (codegen-expr x si env) ; x should be a static-string, producing a label @@ -63,10 +67,17 @@ (emit "not %rcx") ; -%rcx = strlen + 1 (emit "dec %rcx") - (emit "mov %rcx, %rdx") ; number of bytes - (emit "mov %rbx, %rsi") ; addr of string - (emit "mov $1, %rax") ; file handle 1 (stdout) - (emit "mov $1, %rdi") ; syscall 1 (write) + (case target + ('darwin + (emit "movq %rbx, %rsi") ; string addr + (emit "movq %rcx, %rdx") ; num bytes + (emit "movq $1, %rdi") ; file handle (stdout) + (emit "movq $0x2000004, %rax")) ; syscall 4 (write) + ('linux + (emit "mov %rbx, %rsi") ; string addr + (emit "mov %rcx, %rdx") ; num bytes + (emit "mov $1, %rax") ; file handle (stdout) + (emit "mov $1, %rdi"))) ; syscall 1 (write) (emit "syscall")) (define (range s n) @@ -108,6 +119,7 @@ ; a closure on the heap looks like: ; 0-x x+0 x+4 x+12 x+20 ; label #vars var1.... var2.... var3.... + (define (codegen-closure label captured si env) (let* ((heap-offsets (range 4 (length captured))) ; 4, 12, 20, etc. (inner-si (- si (* (length captured) wordsize)))) @@ -120,7 +132,7 @@ (emit "add $8, (heap_start)") captured stack-offsets) -) +))) ; for now we can only call closures (define (codegen-call closure args si env) ; (codegen-expr closure si env) @@ -187,6 +199,11 @@ (emit "pop %rbp") ; restore caller's base pointer (emit "ret"))) +(define (codegen-string label) + (case target + ('darwin (emit "movq ~a@GOTPCREL(%rip), %rax" label)) + ('linux (emit "lea $~a, %rax" label)))) + (define cur-label 0) (define (fresh-label) (set! cur-label (+ 1 cur-label)) @@ -232,7 +249,7 @@ ('bool-literal (emit "movq $~a, %rax" (if e 1 0))) ('int-literal (emit "movq $~a, %rax" e)) - ('static-string (emit "lea ~a, %rax" (cadr e))) ; move label + ('static-string (codegen-string (cadr e))) (else (error #f "don't know how to codegen this")))) @@ -379,7 +396,9 @@ ; exit syscall (emit "mov %rax, %rdi") - (emit "mov $60, %rax") + (case target + ('darwin (emit "movq $0x2000001, %rax")) + ('linux (emit "mov $60, %rax"))) (emit "syscall") (emit ".data") @@ -389,13 +408,21 @@ (for-each emit-string-data strings))) -(define (compile-to-binary program output) +(define (compile-to-binary program output t) + (set! target t) (when (not (eq? (typecheck program) 'int)) (error #f "not an int")) (let ([tmp-path "/tmp/a.s"]) (when (file-exists? tmp-path) (delete-file tmp-path)) (with-output-to-file tmp-path (lambda () (codegen program))) - (system (format "clang -nostdlib /tmp/a.s -o ~a" output)))) + + (case target + ('darwin + (system "as /tmp/a.s -o /tmp/a.o") + (system (format "ld /tmp/a.o -e _start -macosx_version_min 10.14 -static -o ~a" output))) + ('linux + (system "as /tmp/a.s -o /tmp/a.o") + (system (format "ld /tmp/a.o -o ~a" output)))))) ; NOTES ; syscalls in linux use the following arguments for syscall instruction: