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

Add new "throw" VM ops

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-11-05 14:47:18 +01:00
parent cf486700b7
commit f96a670332
10 changed files with 199 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

46
libguile/vm.c
View file

@ -418,6 +418,10 @@ vm_reinstate_partial_continuation (struct scm_vm *vp, SCM cont, size_t nargs,
* VM Error Handling
*/
static void vm_throw (SCM key, SCM args) SCM_NORETURN;
static void vm_throw_with_value (SCM val, SCM key_subr_and_message) SCM_NORETURN SCM_NOINLINE;
static void vm_throw_with_value_and_data (SCM val, SCM key_subr_and_message) SCM_NORETURN SCM_NOINLINE;
static void vm_error (const char *msg, SCM arg) SCM_NORETURN;
static void vm_error_bad_instruction (scm_t_uint32 inst) SCM_NORETURN SCM_NOINLINE;
static void vm_error_unbound (SCM sym) SCM_NORETURN SCM_NOINLINE;
@ -447,13 +451,47 @@ static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE;
static void vm_error_continuation_not_rewindable (SCM cont) SCM_NORETURN SCM_NOINLINE;
static void
vm_throw (SCM key, SCM args)
{
scm_throw (key, args);
abort(); /* not reached */
}
static void
vm_throw_with_value (SCM val, SCM key_subr_and_message)
{
SCM key, subr, message, args, data;
key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
args = scm_list_1 (val);
data = SCM_BOOL_F;
vm_throw (key, scm_list_4 (subr, message, args, data));
}
static void
vm_throw_with_value_and_data (SCM val, SCM key_subr_and_message)
{
SCM key, subr, message, args, data;
key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
args = scm_list_1 (val);
data = args;
vm_throw (key, scm_list_4 (subr, message, args, data));
}
static void
vm_error (const char *msg, SCM arg)
{
scm_throw (sym_vm_error,
scm_list_3 (sym_vm_run, scm_from_latin1_string (msg),
SCM_UNBNDP (arg) ? SCM_EOL : scm_list_1 (arg)));
abort(); /* not reached */
vm_throw (sym_vm_error,
scm_list_3 (sym_vm_run, scm_from_latin1_string (msg),
SCM_UNBNDP (arg) ? SCM_EOL : scm_list_1 (arg)));
}
static void