From c458c02f3cbf24770a18e4e0e3ee2854b7bc0377 Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Fri, 5 Aug 2022 17:32:22 -0700 Subject: Add call-with-values. --- lib/csc/cps.csc | 21 ++++++++++++++++++++- lib/csc/ir1.csc | 1 + 2 files changed, 21 insertions(+), 1 deletion(-) 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 bool ; - call-with-current-continuation: proc -> result + ; - call-with-values: producer * consumer -> result (define-match-record-type (make-call-builtin operation arguments) call-builtin? -- cgit v1.3.1