diff options
| -rw-r--r-- | lib/csc/cps.csc | 21 | ||||
| -rw-r--r-- | lib/csc/ir1.csc | 1 |
2 files changed, 21 insertions, 1 deletions
diff --git a/lib/csc/cps.csc b/lib/csc/cps.csc index 3c1e820..a3e829b 100644 --- a/lib/csc/cps.csc +++ b/lib/csc/cps.csc @@ -274,7 +274,26 @@ (make-primitive 'poke (list return-address argvec (make-constant 2)) '() (to-cps proc (lambda (f) - (make-apply f (list argvec)))))))))) + (make-apply f (list return-address argvec)))))))))) + ((% %call-builtin 'call-with-values (producer consumer)) + (define return-address (new-ref)) + (define consumer-func (new-ref)) + (define result (new-ref)) + (define results (new-ref)) + (define argvec (new-ref)) + (make-fix + (list (make-closure return-address (list result) + (continuation result)) + (make-closure consumer-func (list results) + (to-cps consumer + (lambda (c) + (make-apply c (list return-address results)))))) + (make-primitive 'alloc (list (make-constant 2)) (list argvec) + (make-primitive 'poke (list (make-constant 0) argvec (make-constant 0)) '() + (make-primitive 'poke (list (make-constant 0) argvec (make-constant 1)) '() + (to-cps producer + (lambda (p) + (make-apply p (list consumer-func argvec))))))))) ((% %call-builtin op args) (define returns-value? (not (memq op '(poke exit)))) (loop for arg in (reverse args) diff --git a/lib/csc/ir1.csc b/lib/csc/ir1.csc index 7674d49..efcd22f 100644 --- a/lib/csc/ir1.csc +++ b/lib/csc/ir1.csc @@ -170,6 +170,7 @@ ; - poke: word * pointer * offset -> () ; - int<?: int * int -> bool ; - call-with-current-continuation: proc -> result + ; - call-with-values: producer * consumer -> result (define-match-record-type <call-builtin> (make-call-builtin operation arguments) call-builtin? |