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

VM throw uses intrinsics

Browse source 
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add intrinsics for
  throw, throw/value, and throw/value+data.
* libguile/intrinsics.c (throw_, throw_with_value):
  (throw_with_value_and_data): And here they are.
* libguile/vm-engine.c (throw, throw/value, throw/value+data): Use
  intrinsics.
* libguile/vm.c: Remove vm_throw et al.
This commit is contained in:
Andy Wingo 2018-06-26 20:45:26 +02:00
parent 51e71a473f
commit 0ce9a1f870
4 changed files with 52 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

42
libguile/intrinsics.c
View file

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

4
libguile/intrinsics.h
View file

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

6
libguile/vm-engine.c
View file

@ -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 */
}

44
libguile/vm.c
View file

@ -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;
@ -320,47 +317,12 @@ static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
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