diff options
Diffstat (limited to 'csc')
| -rw-r--r-- | csc/cps-test.csc | 21 | ||||
| -rw-r--r-- | csc/cps.csc | 38 | ||||
| -rw-r--r-- | csc/ir2.csc | 21 |
3 files changed, 56 insertions, 24 deletions
diff --git a/csc/cps-test.csc b/csc/cps-test.csc index 84b8b9a..5283c2b 100644 --- a/csc/cps-test.csc +++ b/csc/cps-test.csc @@ -25,12 +25,15 @@ %branch %closure %fix + %globals %primitive %variable + *globals* apply? branch? closure? fix? + globals? make-apply make-atom make-branch @@ -56,6 +59,7 @@ (cons lexical-ref? %lexical-ref) (cons library-ref? %library-ref) (cons variable? %variable) + (cons globals? %globals) (cons primitive? %primitive) (cons branch? %branch) (cons apply? %apply) @@ -88,8 +92,7 @@ (test atom-library-ref (assert-equal - (make-primitive 'peek (list (make-library-ref 'var '(csc builtins)) (make-constant 0)) - (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'var '(csc builtins))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'tail) (list (test-ref 'generated-symbol)))) (ir1->ir2 (make-library-ref 'var '(csc builtins)) tail) transform-ir2)) @@ -209,7 +212,7 @@ (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))) (make-fix (list (make-closure (test-ref 'generated-symbol) @@ -230,7 +233,7 @@ (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-primitive 'peek (list (make-library-ref 'vector->list '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'vector->list '(csc based))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))) (make-primitive 'alloc (list (make-constant 4)) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol)))))))))))))) @@ -267,7 +270,7 @@ (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))) (make-fix (list @@ -326,7 +329,7 @@ (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))) (make-apply (test-ref 'tail) (list (make-constant 10)))) (ir1->ir2 @@ -362,7 +365,7 @@ (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))) (make-fix (list @@ -418,7 +421,7 @@ (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))) (make-apply (test-ref 'tail) (list (make-constant 5)))) (ir1->ir2 (make-letrec @@ -447,7 +450,7 @@ (make-fix (list (make-closure (test-ref 'generated-symbol) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol))))) - (make-primitive 'peek (list (make-library-ref 'wrong-number-of-arguments '(csc based)) (make-constant 0)) (list (test-ref 'generated-symbol)) + (make-primitive 'peek (list *globals* (make-library-ref 'wrong-number-of-arguments '(csc based))) (list (test-ref 'generated-symbol)) (make-apply (test-ref 'generated-symbol) (list (test-ref 'generated-symbol) (test-ref 'generated-symbol))))))))))) (make-primitive 'poke (list (test-ref 'generated-symbol) (test-ref 'f) (make-constant 0)) '() (make-primitive 'poke (list (make-constant 5) (test-ref 'f) (make-constant 0)) '() diff --git a/csc/cps.csc b/csc/cps.csc index 1f58287..230a1c4 100644 --- a/csc/cps.csc +++ b/csc/cps.csc @@ -23,6 +23,7 @@ %lexical-ref %lexical-set %library-define + %library-ref %sequence call? constant? @@ -54,6 +55,8 @@ %branch %fix %primitive + *globals* + branch-atom closure-arguments closure-body closure-name @@ -205,9 +208,14 @@ (define (to-cps expr continuation) (match expr (_ when (or (constant? expr) - (lexical-ref? expr) - (library-ref? expr)) + (lexical-ref? expr)) (continuation expr)) + ((% %library-ref . _) + (unless (library-ref? expr) + (error "wtf")) + (define temp (new-ref)) + (make-primitive 'peek (list *globals* expr) (list temp) + (continuation temp))) ((% %lexical-set ref arg) (to-cps arg @@ -343,10 +351,9 @@ (define (box-conversion expr) (define boxed-refs (get-boxed expr)) (define (boxed? ref) - (or (library-ref? ref) ; globals are always boxed - (and (lexical-ref? ref) - (guard (e ((key-not-found-error? e) #f)) - (lookup boxed-refs ref))))) + (and (lexical-ref? ref) + (guard (e ((key-not-found-error? e) #f)) + (lookup boxed-refs ref)))) (define (convert-arg-list args) (define boxed-args (loop for arg in args if (boxed? arg) @@ -363,7 +370,10 @@ (values new-args boxed-args vars)) (let convert ((expr expr)) (match expr - ((% %update ref atom continuation) + ((% %update ref atom continuation) when (library-ref? ref) + (make-primitive 'poke (list atom *globals* ref) '() + (convert continuation))) + ((% %update ref atom continuation) when (lexical-ref? ref) (make-primitive 'poke (list atom ref (make-constant 0)) '() (convert continuation))) ((% %primitive op args res continuation) ; Note that no reference in res can be boxed. @@ -374,12 +384,16 @@ do (set! new-expr (make-primitive 'peek (list arg (make-constant 0)) (list var) new-expr)) finally (return new-expr))) + ((% %branch atom true false) when (boxed? atom) + (define temp (new-ref)) + (make-primitive 'peek (list atom (make-constant 0)) (list temp) + (make-branch temp + (convert true) + (convert false)))) ((% %branch atom true false) - (if (boxed? atom) - (let ((var (new-ref))) - (make-primitive 'peek (list atom (make-constant 0)) (list var) - (make-branch var (convert true) (convert false)))) - (make-branch atom (convert true) (convert false)))) + (make-branch atom + (convert true) + (convert false))) ((% %apply proc args) (define-values (new-params boxed-params vars) (convert-arg-list (cons proc args))) (define new-expr (make-apply (car new-params) (cdr new-params))) diff --git a/csc/ir2.csc b/csc/ir2.csc index 331aa4c..30fb5a3 100644 --- a/csc/ir2.csc +++ b/csc/ir2.csc @@ -4,8 +4,10 @@ %branch %closure %fix + %globals %primitive %variable + *globals* apply-arguments apply-procedure apply? @@ -27,6 +29,7 @@ fix-body fix-functions fix? + globals? kargs-expression kargs-refs kargs? @@ -101,10 +104,10 @@ ; Atoms consist of ; - constant, ; - lexical-ref, - ; - or library-ref + ; - library-ref, + ; - or globals. ; After closure conversion, there are no more lexical refs. - ; Each lexical ref will be converted to one of the following - ; data types. + ; Each lexical ref will be converted to a <variable>. ; A function argument or local variable. @@ -115,6 +118,18 @@ (gensym variable-gensym)) + ; The globals array. This will eventually be stored in register 0. + (define-match-record-type <globals> + (make-globals) + globals? + %globals) + + + ; A global instance of <globals>. + ; Considered equal to calling (make-globals). + (define *globals* (make-globals)) + + ; CPS expressions: ; CPS expressions are similar to IR1 expressions, ; but constrained not to have any subexpressions except atoms. |