diff options
-rw-r--r-- | libguile/intrinsics.c | 42 | ||||
-rw-r--r-- | libguile/intrinsics.h | 4 | ||||
-rw-r--r-- | libguile/vm-engine.c | 6 | ||||
-rw-r--r-- | libguile/vm.c | 44 |
4 files changed, 52 insertions, 44 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index 4adb67b8c..90941341f 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -269,6 +269,45 @@ lookup (SCM module, SCM name) return scm_module_variable (module, name); } +static void throw_ (SCM key, SCM args) SCM_NORETURN; +static void throw_with_value (SCM val, SCM key_subr_and_message) SCM_NORETURN; +static void throw_with_value_and_data (SCM val, SCM key_subr_and_message) SCM_NORETURN; + +static void +throw_ (SCM key, SCM args) +{ + scm_throw (key, args); + abort(); /* not reached */ +} + +static void +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; + + throw_ (key, scm_list_4 (subr, message, args, data)); +} + +static void +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; + + throw_ (key, scm_list_4 (subr, message, args, data)); +} + void scm_bootstrap_intrinsics (void) { @@ -314,6 +353,9 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.resolve_module = resolve_module; scm_vm_intrinsics.lookup = lookup; scm_vm_intrinsics.define_x = scm_module_ensure_local_variable; + scm_vm_intrinsics.throw_ = throw_; + scm_vm_intrinsics.throw_with_value = throw_with_value; + scm_vm_intrinsics.throw_with_value_and_data = throw_with_value_and_data; scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index a46f73191..cc175fef6 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -58,6 +58,7 @@ typedef SCM (*scm_t_scm_from_thread_regs_intrinsic) (scm_thread*, jmp_buf*); typedef void (*scm_t_thread_regs_scm_intrinsic) (scm_thread*, jmp_buf*, SCM); typedef int (*scm_t_int_from_scm_intrinsic) (SCM); typedef void (*scm_t_thread_regs_intrinsic) (scm_thread*, jmp_buf*); +typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) SCM_NORETURN; #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -113,6 +114,9 @@ typedef void (*scm_t_thread_regs_intrinsic) (scm_thread*, jmp_buf*); M(thread_regs_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \ M(int_from_scm, rest_arg_length, "rest-arg-length", REST_ARG_LENGTH) \ M(thread_regs, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \ + M(scm_scm_noreturn, throw_, "throw", THROW) \ + M(scm_scm_noreturn, throw_with_value, "throw/value", THROW_WITH_VALUE) \ + M(scm_scm_noreturn, throw_with_value_and_data, "throw/value+data", THROW_WITH_VALUE_AND_DATA) \ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ enum scm_vm_intrinsic diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 71b3dfd5a..18ae5a638 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -832,7 +832,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume) args = SP_REF (b); SYNC_IP (); - vm_throw (key, args); + scm_vm_intrinsics.throw_ (key, args); abort (); /* never reached */ } @@ -861,7 +861,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume) key_subr_and_message = SCM_PACK (key_subr_and_message_bits); SYNC_IP (); - vm_throw_with_value (val, key_subr_and_message); + scm_vm_intrinsics.throw_with_value (val, key_subr_and_message); abort (); /* never reached */ } @@ -890,7 +890,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume) key_subr_and_message = SCM_PACK (key_subr_and_message_bits); SYNC_IP (); - vm_throw_with_value_and_data (val, key_subr_and_message); + scm_vm_intrinsics.throw_with_value_and_data (val, key_subr_and_message); abort (); /* never reached */ } diff --git a/libguile/vm.c b/libguile/vm.c index 45040993f..bb6c32a74 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -308,9 +308,6 @@ static void vm_dispatch_abort_hook (struct scm_vm *vp) * 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 (uint32_t inst) SCM_NORETURN SCM_NOINLINE; @@ -321,46 +318,11 @@ static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE; static void vm_error_wrong_number_of_values (uint32_t expected) 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) { - 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))); + 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))); } static void |