summaryrefslogtreecommitdiff
path: root/module/language/cps/compile-bytecode.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/cps/compile-bytecode.scm')
-rw-r--r--module/language/cps/compile-bytecode.scm21
1 files changed, 13 insertions, 8 deletions
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index 552f0a41b..79459cf0e 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -125,9 +125,7 @@
(for-each (match-lambda
((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
(lookup-parallel-moves label allocation))
- (emit-return-values asm (1+ (length args))))
- (($ $primcall (or 'throw 'throw/value 'throw/value+data))
- (compile-effect label exp #f))))
+ (emit-return-values asm (1+ (length args))))))
(define (compile-value label exp dst)
(match exp
@@ -398,12 +396,15 @@
(($ $primcall 'atomic-box-set! #f (box val))
(emit-atomic-box-set! asm (from-sp (slot box)) (from-sp (slot val))))
(($ $primcall 'handle-interrupts #f ())
- (emit-handle-interrupts asm))
- (($ $primcall 'throw #f (key args))
+ (emit-handle-interrupts asm))))
+
+ (define (compile-throw op param args)
+ (match (vector op param args)
+ (#('throw #f (key args))
(emit-throw asm (from-sp (slot key)) (from-sp (slot args))))
- (($ $primcall 'throw/value param (val))
+ (#('throw/value param (val))
(emit-throw/value asm (from-sp (slot val)) param))
- (($ $primcall 'throw/value+data param (val))
+ (#('throw/value+data param (val))
(emit-throw/value+data asm (from-sp (slot val)) param))))
(define (compile-prompt label k kh escape? tag)
@@ -632,7 +633,11 @@
(($ $prompt k kh src escape? tag)
(when src
(emit-source asm src))
- (compile-prompt label (skip-elided-conts k) kh escape? tag))))
+ (compile-prompt label (skip-elided-conts k) kh escape? tag))
+ (($ $throw src op param args)
+ (when src
+ (emit-source asm src))
+ (compile-throw op param args))))
(define (compile-cont label cont)
(match cont