Merge branch 'master' of lukelau.me:/srv/git/scheme

[scheme.git] / codegen.scm

diff --git a/codegen.scm b/codegen.scm
index 941dc158e89e61a4a30027b00641f942a80da0ef..10e005f8ad90e840aad396da4a0cdb5032163f6c 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -76,11 +76,6 @@
     ('linux  (emit "mov $1, %rax"))) ; syscall 1 (write)
   (emit "syscall"))
 
-(define (range s n)
-  (if (= 0 n) '()
-      (append (range s (- n 1))
-             (list (+ s (- n 1))))))
-
 (define wordsize 8)
 
 (define (codegen-let bindings body si env)
@@ -167,16 +162,16 @@
     (emit "## storing captives")
                                        ; store the captured vars
     (for-each
-     (lambda (var-name new-offset)
-       (let ([orig-offset (cdr (assoc var-name env))])
+     (lambda (var-name heap-offset)
+       (let ([stack-offset (cdr (assoc var-name env))])
         (emit "### captive ~a" var-name)
-        (if (eqv? orig-offset 'self-captive)
+        (if (eqv? stack-offset 'self-captive)
                                        ; captive refers to this closure:
                                        ; move heap addr of this closure to stack! 
-            (emit "movq %rax, ~a(%rax)" new-offset)
+            (emit "movq %rax, ~a(%rax)" heap-offset)
             (begin
-              (emit "movq ~a(%rbp), %rbx" orig-offset)
-              (emit "movq %rbx, ~a(%rax)" new-offset)))))
+              (emit "movq ~a(%rbp), %rbx" stack-offset)
+              (emit "movq %rbx, ~a(%rax)" heap-offset)))))
      captured
      heap-offsets)))
 
@@ -240,7 +235,7 @@
         (params (append captives args))
 
         (stack-offsets (map (lambda (i)
-                              (* (- wordsize) i))
+                              (* (- wordsize) (+ 1 i)))
                             (range 0 (length params))))
 
         (env (map cons params stack-offsets)))
@@ -259,7 +254,6 @@
     (emit "push %rbp") ; preserve caller's base pointer
     
     (emit "movq %rsp, %rbp") ; set up our own base pointer
-    (emit "subq $8, %rbp")   
 
                                        ; load the captured vars onto the stack
     (for-each
@@ -267,7 +261,7 @@
        (begin
         (emit "# loading captive ~a" (list-ref captives i))
         (emit "movq ~a(~a), %rbx" (* wordsize i) (param-register 0))
-        (emit "movq %rbx, ~a(%rbp)" (* (- wordsize) i))))
+        (emit "movq %rbx, ~a(%rbp)" (* (- wordsize) (+ 1 i)))))
      (range 0 (length captives)))
 
                                        ; load the args onto the stack
@@ -277,7 +271,7 @@
         (emit "movq ~a, %rbx" (param-register (+ 1 i)))
         (emit "movq %rbx, ~a(%rbp)"
               (* (- wordsize)
-                 (+ (length captives) i)))))
+                 (+ 1 (length captives) i)))))
      (range 0 (length args)))
     
     (codegen-expr body (* (- wordsize) (+ 1 (length params))) env)
@@ -350,15 +344,15 @@
            (set! bound (append (lambda-args e) bound))
            (collect (lambda-body e))))
 
-      ('app (fold-map collect e))
-      ('if (fold-map collect (cdr e)))
+      ('app (flat-map collect e))
+      ('if (flat-map collect (cdr e)))
       ('let
-         (let ([bind-fvs (fold-map (lambda (a)
+         (let ([bind-fvs (flat-map (lambda (a)
                                      (begin
                                        (set! bound (cons (car a) bound))
                                        (collect (cdr a))))
                                    (let-bindings e))])
-           (append bind-fvs (fold-map collect (let-body e)))))
+           (append bind-fvs (flat-map collect (let-body e)))))
       (else '())))
   (collect prog))
 
@@ -524,7 +518,9 @@
 (define (codegen program)
   (set! cur-label 0)
   (set! cur-lambda 0)
-  (let* ((extract-res-0 (extract-strings program))
+  (let* ([body (program-body program)] 
+        
+        (extract-res-0 (extract-strings body))
         (strings (car extract-res-0))
         (extract-res-1 (extract-lambdas (cdr extract-res-0)))
         (lambdas (car extract-res-1))
@@ -541,7 +537,8 @@
     (initialize-heap)
 
     (emit "movq %rsp, %rbp")            ; set up the base pointer
-    (codegen-expr xform-prog 0 '())
+    
+    (codegen-expr xform-prog (- wordsize) '())
 
                                        ; exit syscall
     (emit "mov %rax, %rdi")
@@ -559,7 +556,7 @@
 
 (define (compile-to-binary program output t)
   (set! target t)
-  (when (not (eq? (typecheck program) 'int)) (error #f "not an int"))
+  (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