diff options
Diffstat (limited to 'csc')
| -rw-r--r-- | csc/codegen-test.csc | 27 | ||||
| -rw-r--r-- | csc/codegen.csc | 6 | ||||
| -rw-r--r-- | csc/linker-test.csc | 38 | ||||
| -rw-r--r-- | csc/linker.csc | 16 |
4 files changed, 55 insertions, 32 deletions
diff --git a/csc/codegen-test.csc b/csc/codegen-test.csc index 01eda04..03f6b11 100644 --- a/csc/codegen-test.csc +++ b/csc/codegen-test.csc @@ -34,7 +34,8 @@ (test codegen-apply (define p (test-var)) (assert-equal - '((peek (local 1) (local 0) (const 5)) + '((label init) + (peek (local 1) (local 0) (const 5)) (mov (local 2) (local 1)) (mov (local 1) (const 10)) (jmp (local 2))) @@ -47,7 +48,8 @@ (test codegen-call-global (define p (test-var)) (assert-equal - '((peek (local 1) (local 0) (global cons (csc based))) + '((label init) + (peek (local 1) (local 0) (global cons (csc based))) (mov (local 3) (local 1)) (mov (local 1) (const 5)) (mov (local 2) (const ())) @@ -62,11 +64,12 @@ (define f (test-label)) (define ret (test-var)) (assert-equal - '((mov (local 1) (label 0)) - (jmp (label 0)) - (label 0) + '((label 0) (mov (local 2) (local 1)) - (jmp (local 2))) + (jmp (local 2)) + (label init) + (mov (local 1) (label 0)) + (jmp (label 0))) (ir2->ir3 (make-fix (list (make-closure f (list ret) @@ -83,10 +86,7 @@ (define g2 (test-var)) (define g3 (test-var)) (assert-equal - '((mov (local 1) (const 0)) - (mov (local 2) (const 1)) - (jmp (label 0)) - (label 0) + '((label 0) (mov (local 127) (local 1)) (mov (local 1) (local 2)) (mov (local 2) (local 127)) @@ -95,6 +95,10 @@ (label 1) (mov (local 2) (local 1)) (mov (local 1) (local 3)) + (jmp (label 0)) + (label init) + (mov (local 1) (const 0)) + (mov (local 2) (const 1)) (jmp (label 0))) (ir2->ir3 (make-fix @@ -108,7 +112,8 @@ (test codegen-branch (define p (test-var)) (assert-equal - '((peek (local 1) (local 0) (const 1)) + '((label init) + (peek (local 1) (local 0) (const 1)) (jmpif (const #t) (label 0)) (mov (local 2) (local 1)) (mov (local 1) (const 10)) diff --git a/csc/codegen.csc b/csc/codegen.csc index f97beec..1fd7099 100644 --- a/csc/codegen.csc +++ b/csc/codegen.csc @@ -248,7 +248,9 @@ (set! locals-map (insert locals-map x local-count)) local-count))))) (append - (ir2->bytecode (fix-body expr) (make-locals-map '())) (loop for func in (fix-functions expr) collect (list 'label (translate-label (closure-name func))) - append (ir2->bytecode (closure-body func) (make-locals-map (closure-arguments func)))))))) + append (ir2->bytecode (closure-body func) (make-locals-map (closure-arguments func)))) + (list + (list 'label 'init)) + (ir2->bytecode (fix-body expr) (make-locals-map '())))))) diff --git a/csc/linker-test.csc b/csc/linker-test.csc index cc07a74..d3481a9 100644 --- a/csc/linker-test.csc +++ b/csc/linker-test.csc @@ -27,37 +27,45 @@ (test link-labels (assert-equal - '((jmp (const 1)) - (jmp (const 0))) + '((jmp (const 3)) + (jmp (const 2)) + (jmp (const 1)) + (jmp (const 1))) (link '(((label 0) (jmp (label 1)) (label 1) + (jmp (label 0)) + (label init) (jmp (label 0)))) (make-map compare-globals)))) (test link-labels-are-unique-per-program (assert-equal - '((jmp (const 1)) - (jmp (const 0)) - (jmp (const 3)) - (jmp (const 2))) + '((jmp (const 2)) + (jmp (const 1)) + (jmp (const 1)) + (jmp (const 5)) + (jmp (const 4)) + (jmp (const 4))) (link '(((label 0) - (jmp (label 1)) - (label 1) - (jmp (label 0))) - ((label 0) - (jmp (label 1)) - (label 1) - (jmp (label 0)))) + (jmp (label 0)) + (label init) + (jmp (label 0))) + ((label 0) + (jmp (label 0)) + (label init) + (jmp (label 0)))) (make-map compare-globals)))) (test link-globals (assert-equal - '((peek (local 0) (const 10))) + '((jmp (const 1)) + (peek (local 0) (const 10))) (link - '(((peek (local 0) (global cons (csc based))))) + '(((label init) + (peek (local 0) (global cons (csc based))))) (alist->map compare-globals '(((global cons (csc based)) . 10)))))) diff --git a/csc/linker.csc b/csc/linker.csc index 238fbc5..dc738b7 100644 --- a/csc/linker.csc +++ b/csc/linker.csc @@ -29,6 +29,8 @@ unless (symbol=? op 'label) collect (cons op (loop for arg in args collect (match arg + (('label 'init) + (list 'const (lookup label-map -1))) (('label x) (list 'const (lookup label-map x))) (_ arg)))))) @@ -39,9 +41,12 @@ for i from offset with m = (make-map compare-numbers) do (match op + (('label 'init) + (set! m (insert m -1 i)) + (set! i (- i 1))) ; Labels will be removed later. (('label id) (set! m (insert m id i)) - (set! i (- i 1)))) ; Labels will be removed later. + (set! i (- i 1)))) finally (return m))) @@ -71,8 +76,11 @@ (translate-globals (loop for prog in programs for off = 0 then (+ off (length converted-prog)) - for converted-prog = (translate-labels - prog - (make-label-map off prog)) + for converted-prog = (let ((prog-prelude (cons + (list 'jmp '(label init)) + prog))) + (translate-labels + prog-prelude + (make-label-map off prog-prelude))) append converted-prog) environment)))) |