From: Luke Lau Date: Wed, 24 Jul 2019 23:59:30 +0000 (+0100) Subject: Merge branch 'master' of lukelau.me:/srv/git/scheme X-Git-Url: https://git.lukelau.me/?p=scheme.git;a=commitdiff_plain;h=5d4aafc1235538212989893f15006acc5d7d8f03 Merge branch 'master' of lukelau.me:/srv/git/scheme --- 5d4aafc1235538212989893f15006acc5d7d8f03 diff --cc .gitignore index e4e5f6c,e4e5f6c..02cfc43 --- a/.gitignore +++ b/.gitignore @@@ -1,1 -1,1 +1,2 @@@ *~ ++TAGS diff --cc codegen.scm index 04a03fa,571f1ef..78ebbad --- a/codegen.scm +++ b/codegen.scm @@@ -64,17 -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 %rax, %rsi") ; string addr ++ (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 %rax, %rsi") ; string addr ++ (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) @@@ -113,8 -105,25 +116,26 @@@ (set! cur-lambda (+ 1 cur-lambda)) (format "_lambda~a" (- cur-lambda 1))) + ; 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)))) + (emit "movl $~a, (heap_start)") + (emit "add $4, (heap_start)") + (for-each (lambda (var-name new-offset) + (emit "movq ~a(%rbp), ~a(heap_start)" ; todo: do we need to copy this? + (cdr (assoc var-name env)) + new-offset) + (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) (when (not (eq? (ast-type closure) 'closure)) (error #f (format "~a is not a closure" closure))) (let* ((captured (caddr closure)) @@@ -179,11 -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 "movq $~a, %rax" label)))) ++ ('linux (emit "lea $~a, %rax" label)))) + (define cur-label 0) (define (fresh-label) (set! cur-label (+ 1 cur-label)) @@@ -361,27 -379,30 +396,40 @@@ ; 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 "\t.data") + (emit ".data") - (for-each codegen-string-data strings))) + (emit "heap_start:") + (emit "\t.quad 0") + + (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: + ; %rax = syscall # + ; %rdi = 1st arg + ; %rsi = 2nd arg + ; %rdx = 3rd arg + ; %r10 = 4th arg + ; %r8 = 5th arg + ; %r9 = 6th arg