diff options
Diffstat (limited to 'lib/csc/cps.csc')
| -rw-r--r-- | lib/csc/cps.csc | 14 |
1 files changed, 14 insertions, 0 deletions
diff --git a/lib/csc/cps.csc b/lib/csc/cps.csc index f2a9c90..3c1e820 100644 --- a/lib/csc/cps.csc +++ b/lib/csc/cps.csc @@ -261,6 +261,20 @@ arg (lambda (v) (make-apply f (list return-address v)))))))) + ((% %call-builtin 'call-with-current-continuation (proc)) + (define return-address (new-ref)) + (define result (new-ref)) + (define argvec (new-ref)) + (make-fix + (list (make-closure return-address (list result) + (continuation result))) + (make-primitive 'alloc (list (make-constant 3)) (list argvec) + (make-primitive 'poke (list (make-constant 0) argvec (make-constant 0)) '() + (make-primitive 'poke (list (make-constant 1) argvec (make-constant 1)) '() + (make-primitive 'poke (list return-address argvec (make-constant 2)) '() + (to-cps proc + (lambda (f) + (make-apply f (list argvec)))))))))) ((% %call-builtin op args) (define returns-value? (not (memq op '(poke exit)))) (loop for arg in (reverse args) |