Add more binary ops

[scheme.git] / codegen.scm

diff --git a/codegen.scm b/codegen.scm
index 76fa6717c46d9d1ae69a4dd28d9fcbb135739d05..3a01dff778e94f79f675bd26c6f19a39509a9e64 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -9,19 +9,35 @@
 (define (codegen-add xs si env)
   (define (go ys)
     (if (null? ys)
-      (emit "movq %rbx, %rax")
+      (emit "movq ~a(%rsp), %rax" si)
       (begin
        (let ((y (car ys)))
             (if (integer? y)
-                (emit "addq $~a, %rbx" y)
+                (emit "addq $~a, ~a(%rsp)" y si)
                 (begin
-                  (codegen-expr y si env)
-                  (emit "addq %rax, %rbx"))))
+                  (codegen-expr y (- si wordsize) env)
+                  (emit "addq %rax, ~a(%rsp)" si))))
        (go (cdr ys)))))
   (begin
-    (emit "movq $0, %rbx")
+                                       ; use si(%rsp) as the accumulator
+    (emit "movq $0, ~a(%rsp)" si)
     (go xs)))
 
+(define (codegen-binop opcode)
+  (lambda (a b si env)
+    (codegen-expr b si env)
+    (emit "movq %rax, ~a(%rsp)" si)
+    (codegen-expr a (- si wordsize) env)
+    (emit "~a ~a(%rsp), %rax" opcode si)))
+
+(define codegen-sub (codegen-binop "sub"))
+(define codegen-mul (codegen-binop "imul"))
+
+(define (codegen-not x si env)
+  (codegen-expr x si env)
+  (emit "xorq $-1, %rax")
+  (emit "andq $1, %rax"))
+
 (define (range s n)
   (if (= 0 n) '()
       (append (range s (- n 1))
@@ -47,14 +63,21 @@
     (emit "movq ~a(%rsp), %rax" offset)))
 
 (define (codegen-expr e si env)
-  (cond ((and (list? e) (eq? (car e) '+))
-        (codegen-add (cdr e) si env))
+  (cond ((app? e)
+        (case (car e)
+          ('+ (codegen-add (cdr e) si env))
+          ('- (codegen-sub (cadr e) (caddr e) si env))
+          ('* (codegen-mul (cadr e) (caddr e) si env))
+          ('! (codegen-not (cadr e) si env))
+          ('bool->int (codegen-expr (cadr e) si env))
+          (else (error #f "can't handle anything else yet"))))
        ((let? e) (codegen-let
                   (let-bindings e)
                   (let-body e)
                   si
                   env))
        ((var? e) (codegen-var e si env))
+       ((boolean? e) (emit "movq $~a, %rax" (if e 1 0)))
        (else (emit "movq $~a, %rax" e))))
 
 (define (codegen program)