projects
/
scheme.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Start work on ADTs
[scheme.git]
/
codegen.scm
diff --git
a/codegen.scm
b/codegen.scm
index 941dc158e89e61a4a30027b00641f942a80da0ef..fb856a54a7da63314890bc6c739ce9cc03c69a01 100644
(file)
--- a/
codegen.scm
+++ b/
codegen.scm
@@
-167,16
+167,16
@@
(emit "## storing captives")
; store the captured vars
(for-each
(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)
(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!
; 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
(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)))
captured
heap-offsets)))
@@
-240,7
+240,7
@@
(params (append captives args))
(stack-offsets (map (lambda (i)
(params (append captives args))
(stack-offsets (map (lambda (i)
- (* (- wordsize)
i
))
+ (* (- wordsize)
(+ 1 i)
))
(range 0 (length params))))
(env (map cons params stack-offsets)))
(range 0 (length params))))
(env (map cons params stack-offsets)))
@@
-259,7
+259,6
@@
(emit "push %rbp") ; preserve caller's base pointer
(emit "movq %rsp, %rbp") ; set up our own base pointer
(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
; load the captured vars onto the stack
(for-each
@@
-267,7
+266,7
@@
(begin
(emit "# loading captive ~a" (list-ref captives i))
(emit "movq ~a(~a), %rbx" (* wordsize i) (param-register 0))
(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
(range 0 (length captives)))
; load the args onto the stack
@@
-277,7
+276,7
@@
(emit "movq ~a, %rbx" (param-register (+ 1 i)))
(emit "movq %rbx, ~a(%rbp)"
(* (- wordsize)
(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)
(range 0 (length args)))
(codegen-expr body (* (- wordsize) (+ 1 (length params))) env)
@@
-350,15
+349,15
@@
(set! bound (append (lambda-args e) bound))
(collect (lambda-body e))))
(set! bound (append (lambda-args e) bound))
(collect (lambda-body e))))
- ('app (f
old
-map collect e))
- ('if (f
old
-map collect (cdr e)))
+ ('app (f
lat
-map collect e))
+ ('if (f
lat
-map collect (cdr e)))
('let
('let
- (let ([bind-fvs (f
old
-map (lambda (a)
+ (let ([bind-fvs (f
lat
-map (lambda (a)
(begin
(set! bound (cons (car a) bound))
(collect (cdr a))))
(let-bindings e))])
(begin
(set! bound (cons (car a) bound))
(collect (cdr a))))
(let-bindings e))])
- (append bind-fvs (f
old
-map collect (let-body e)))))
+ (append bind-fvs (f
lat
-map collect (let-body e)))))
(else '())))
(collect prog))
(else '())))
(collect prog))
@@
-524,7
+523,9
@@
(define (codegen program)
(set! cur-label 0)
(set! cur-lambda 0)
(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))
(strings (car extract-res-0))
(extract-res-1 (extract-lambdas (cdr extract-res-0)))
(lambdas (car extract-res-1))
@@
-541,7
+542,8
@@
(initialize-heap)
(emit "movq %rsp, %rbp") ; set up the base pointer
(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")
; exit syscall
(emit "mov %rax, %rdi")
@@
-559,7
+561,7
@@
(define (compile-to-binary program output t)
(set! target t)
(define (compile-to-binary program output t)
(set! target t)
- (when (not (eq? (typecheck program) '
int)) (error #f "not an i
nt"))
+ (when (not (eq? (typecheck program) '
Int)) (error #f "not an I
nt"))
(let ([tmp-path "/tmp/a.s"])
(when (file-exists? tmp-path) (delete-file tmp-path))
(with-output-to-file tmp-path
(let ([tmp-path "/tmp/a.s"])
(when (file-exists? tmp-path) (delete-file tmp-path))
(with-output-to-file tmp-path