summaryrefslogtreecommitdiff
path: root/module/system/vm/disassembler.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2017-11-05 14:47:18 +0100
committerAndy Wingo <wingo@pobox.com>2017-11-05 15:00:16 +0100
commitf96a670332b224326b89ce135a0edfb77a70c46e (patch)
tree9db32959b5f53e2d245bce5735214d462caffa3c /module/system/vm/disassembler.scm
parentcf486700b78a72f1bcab5b450394a63cf3ec7bff (diff)
downloadguile-f96a670332b224326b89ce135a0edfb77a70c46e.tar.gz
Add new "throw" VM ops
* libguile/throw.h (scm_ithrow, scm_throw): Mark as SCM_NORETURN. * libguile/throw.c (scm_throw, scm_ithrow): Adapt to not return. * libguile/vm-engine.c (throw, throw/value, throw/value+data): New instructions. * libguile/vm.c (vm_throw, vm_throw_with_value) (vm_throw_with_value_and_data): New helpers. * module/language/cps/compile-bytecode.scm (compile-function): Add cases for new instructions. * module/language/cps/prune-bailouts.scm (prune-bailouts): More simple, now that there are no $kreceives in play. * module/language/cps/reify-primitives.scm (reify-clause): Update reification of no-clause functions to use new throw op. * module/language/tree-il/compile-cps.scm (convert): Convert invocations of the variable-arity 'throw primitive from Tree-IL to the new fixed-arity CPS instructions. * module/system/vm/assembler.scm (emit-throw/value*) (emit-throw/value+data*, emit-throw): Export new instructions. * module/system/vm/disassembler.scm (code-annotation): Add annotation.
Diffstat (limited to 'module/system/vm/disassembler.scm')
-rw-r--r--module/system/vm/disassembler.scm3
1 files changed, 3 insertions, 0 deletions
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 5183b2d2e..89acf6090 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -260,6 +260,8 @@ address of that offset."
(when (program? val)
(push-addr! (program-code val) val))
(list "~@Y" val)))
+ (((or 'throw/value 'throw/value+data) dst target)
+ (list "~@Y" (reference-scm target)))
(('builtin-ref dst idx)
(list "~A" (builtin-index->name idx)))
(((or 'static-ref 'static-set!) _ target)
@@ -511,6 +513,7 @@ address of that offset."
(define (instruction-has-fallthrough? code pos)
(define non-fallthrough-set
(static-opcode-set halt
+ throw throw/value throw/value+data
tail-call tail-call-label tail-call/shuffle
return-values
subr-call foreign-call continuation-call