From 94d1c48d51bfe32aa1e14d4fb012b283ec9352ef Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 23 Jul 2019 17:12:18 +0100 Subject: [PATCH] Make the ABI respect stack etc. --- ast.scm | 9 +++-- codegen.scm | 102 +++++++++++++++++++++++++++------------------------- tests.scm | 16 +++++++-- 3 files changed, 73 insertions(+), 54 deletions(-) diff --git a/ast.scm b/ast.scm index c81bc2b..a089919 100644 --- a/ast.scm +++ b/ast.scm @@ -7,6 +7,7 @@ ('! #t) ('= #t) ('bool->int #t) + ('print #t) (else #f))) (cond ((list? x) @@ -15,19 +16,21 @@ ('let 'let) ('lambda 'lambda) ('closure 'closure) ; only available in codegen + ('static-string 'static-string) ; only available in codegen (else 'app))) ((builtin? x) 'builtin) ((symbol? x) 'var) ((integer? x) 'int-literal) - ((boolean? x) 'bool-literal))) + ((boolean? x) 'bool-literal) + ((string? x) 'string-literal))) (define (ast-traverse f x) (case (ast-type x) ('let `(let ,(map (lambda (x) (list (car x) (f (cadr x)))) (let-bindings x)) - ,@(map f (let-body e)))) + ,@(map f (let-body x)))) ('app (map f x)) - ('lambda `(lambda ,(lambda-args x) ,(f lambda-body))) + ('lambda `(lambda ,(lambda-args x) ,(f (lambda-body x)))) ('if `(if ,@(map f (cdr x)))) (else x))) diff --git a/codegen.scm b/codegen.scm index a1a0aa7..5303b49 100644 --- a/codegen.scm +++ b/codegen.scm @@ -9,28 +9,29 @@ (define (codegen-add xs si env) (define (go ys) (if (null? ys) - (emit "movq ~a(%rsp), %rax" si) + (emit "movq ~a(%rbp), %rax" si) (begin (let ((y (car ys))) (if (integer? y) - (emit "addq $~a, ~a(%rsp)" y si) + (emit "addq $~a, ~a(%rbp)" y si) (begin (codegen-expr y (- si wordsize) env) - (emit "addq %rax, ~a(%rsp)" si)))) + (emit "addq %rax, ~a(%rbp)" si)))) (go (cdr ys))))) (begin - ; use si(%rsp) as the accumulator - (emit "movq $0, ~a(%rsp)" si) + ; use si(%rbp) as the accumulator + (emit "movq $0, ~a(%rbp)" si) (go xs))) (define (codegen-binop opcode) (lambda (a b si env) (codegen-expr b si env) - (emit "movq %rax, ~a(%rsp)" si) + (emit "movq %rax, ~a(%rbp)" si) (codegen-expr a (- si wordsize) env) - (emit "~a ~a(%rsp), %rax" opcode si))) + (emit "~a ~a(%rbp), %rax" opcode si))) (define codegen-sub (codegen-binop "sub")) + (define codegen-mul (codegen-binop "imul")) (define (codegen-not x si env) @@ -40,9 +41,9 @@ (define (codegen-eq a b si env) (codegen-expr a si env) - (emit "movq %rax, ~a(%rsp)" si) + (emit "movq %rax, ~a(%rbp)" si) (codegen-expr b (- si wordsize) env) - (emit "subq ~a(%rsp), %rax" si) + (emit "subq ~a(%rbp), %rax" si) (emit "not %rax") (emit "andq $1, %rax")) @@ -83,7 +84,7 @@ (inner-env (fold-left (lambda (env name expr offset) (codegen-expr expr inner-si env) - (emit "movq %rax, ~a(%rsp)" offset) + (emit "movq %rax, ~a(%rbp)" offset) (cons (cons name offset) env)) env names exprs stack-offsets))) (for-each (lambda (form) @@ -94,7 +95,7 @@ (when (not (assoc name env)) (error #f (format "Variable ~a is not bound" name))) (let ((offset (cdr (assoc name env)))) - (emit "movq ~a(%rsp), %rax" offset))) + (emit "movq ~a(%rbp), %rax" offset))) (define cur-lambda 0) (define (fresh-lambda) @@ -112,7 +113,7 @@ ; first move the captured variables into param registers (for-each (lambda (e i) - (emit "movq ~a(%rsp), ~a" + (emit "movq ~a(%rbp), ~a" (cdr (assoc e env)) ; offset of the var (param-register i))) captured (range 0 (length captured))) @@ -127,30 +128,29 @@ (emit "movq %rax, ~a" (param-register i)))) args (range argument-start (length args))) - ; now call - (emit "callq ~a" label))) - + (emit "addq $~a, %rsp" si) ; adjust the stack pointer to account all the stuff we put in the env + (emit "callq ~a" label) + (emit "subq $~a, %rsp" si))) (define (codegen-lambda l) (let* ((label (car l)) (args (cadr l)) (captured (caddr l)) (body (cadddr l)) - ; captured, then args - (vars (append captured args)) +; params = what actually gets passed + (params (append captured args)) (param-registers (map param-register - (range 0 (length vars)))) + (range 0 (length params)))) (stack-offsets (map (lambda (i) (* (- wordsize) i)) - (range 0 (length vars)))) + (range 1 (length params)))) (copy-insts (map (lambda (r o) - (format "movq ~a, ~a(%rsp)" - r o)) + (format "movq ~a, ~a(%rbp)" r o)) param-registers stack-offsets)) - (env (map cons vars stack-offsets))) + (env (map cons params stack-offsets))) (emit "~a:" label) (display "## lambda body: ") (display body) @@ -158,11 +158,15 @@ (display "## environment: ") (display env) (newline) - (amd64-abi - (lambda () + + (emit "push %rbp") ; preserve caller's base pointer + (emit "movq %rsp, %rbp") ; set up our own base pointer + (for-each emit copy-insts) - (codegen-expr body (* (- wordsize) (length vars)) env) - )))) ; move args and capture vars to stack + (codegen-expr body (* (- wordsize) (+ 1 (length params))) env) + + (emit "pop %rbp") ; restore caller's base pointer + (emit "ret"))) (define cur-label 0) (define (fresh-label) @@ -279,26 +283,28 @@ (emit "~a:" (car s)) (emit "\t.string \"~a\"" (cdr s))) -(define (amd64-abi f) - ; preserve registers - (emit "push %rbp") - (emit "push %rbx") - (for-each (lambda (i) - (emit (string-append - "push %r" - (number->string i)))) - '(12 13 14 15)) - - (f) ; call stuff - ; restore preserved registers - (for-each (lambda (i) - (emit (string-append - "pop %r" - (number->string i)))) - '(15 14 13 12)) - (emit "pop %rbx") - (emit "pop %rbp") - (emit "ret")) +;; (define (amd64-abi f) +;; ; preserve registers +;; (emit "push %rbp") +;; ;; (emit "push %rbx") +;; ;; (for-each (lambda (i) +;; ;; (emit (string-append +;; ;; "push %r" +;; ;; (number->string i)))) +;; ;; '(12 13 14 15)) + +;; (emit "movq %rsp, %rbp") ; set up the base pointer + +;; (f) ; call stuff +;; ; restore preserved registers +;; ;; (for-each (lambda (i) +;; ;; (emit (string-append +;; ;; "pop %r" +;; ;; (number->string i)))) +;; ;; '(15 14 13 12)) +;; ;; (emit "pop %rbx") +;; (emit "pop %rbp") +;; (emit "ret")) ; 24(%rbp) mem arg 1 ; 16(%rbp) mem arg 0 prev frame @@ -327,14 +333,14 @@ (lambdas (car extract-res-1)) (xform-prog (cdr extract-res-1))) - (emit "\t.globl _start") + (emit "\t.global _start") (emit "\t.text") ; (emit ".p2align 4,,15") is this needed? (for-each codegen-lambda lambdas) - (emit "_start:") + (emit "movq %rsp, %rbp") ; set up the base pointer (codegen-expr xform-prog 0 '()) ; exit syscall diff --git a/tests.scm b/tests.scm index 7c73433..bfd9124 100644 --- a/tests.scm +++ b/tests.scm @@ -17,10 +17,14 @@ (loop (read-char p) (string-append result (string next)))))))) (define (test-prog prog exit-code) + (display prog) + (newline) (compile-to-binary prog "/tmp/test-prog") - (system "/tmp/test-prog")) + (test (system "/tmp/test-prog") exit-code)) (define (test-prog-stdout prog output) + (display prog) + (newline) (compile-to-binary prog "/tmp/test-prog") (system "/tmp/test-prog > /tmp/test-output.txt") (let ((str (read-file "/tmp/test-output.txt"))) @@ -31,10 +35,16 @@ (test-prog '(+ 1 2) 3) (test-prog '((lambda (x) ((lambda (y) (+ x y)) 42)) 100) 142) + +(test-prog '(* 10 5) 50) + (test-prog '(let ((x (+ 1 32)) (y x)) - ((lambda (z) (+ 1 z)) (* y x))) - 1090) + ((lambda (z) (+ 2 z)) (* y x))) + 67) ; exit code modulos at 256 (test-prog '(if ((lambda (x) (= x 2)) 1) 0 (- 32 1)) 31) + (test-prog-stdout '(if (= 3 2) 1 (let () (print "hello world!") 0)) "hello world!") +(test-prog '((lambda (x y) (+ x y)) 1 2) 3) +(test-prog '((lambda (x) (+ ((lambda (y) (+ y 1)) 3) x)) 2) 6) -- 2.30.2