mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

$throw is a new kind of CPS term

Browse source 
* module/language/cps.scm ($throw): New term type that doesn't have a
  continuation.  Adapt all callers.  Remove now-unneeded
  "prune-bailouts" pass.
This commit is contained in:
Andy Wingo 2018-01-03 18:25:42 +01:00
parent de5c81b1d1
commit ad55ee83c3
26 changed files with 145 additions and 148 deletions
Download patch file Download diff file Expand all files Collapse all files

21
module/language/cps/compile-bytecode.scm
View file

@ -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