diff options
author | Andy Wingo <wingo@pobox.com> | 2018-08-13 10:59:09 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2018-08-13 10:59:09 +0200 |
commit | 11940f4c72102fc3f5147aa5529c5ed77ff09fcc (patch) | |
tree | c3b22e70fc88b03739bc60a7c7bb9c921841b3c2 | |
parent | 5df43b60a9c5186343c3270a710a7ccf1bcbbabd (diff) | |
download | guile-11940f4c72102fc3f5147aa5529c5ed77ff09fcc.tar.gz |
Update error-wrong-num-args intrinsic prototype
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* libguile/intrinsics.c (error_wrong_num_args): Take the thread as an
arg, instead of the ostensible callee.
* libguile/vm-engine.c: Update callers of wrong-num-args intrinsic to
pass a thread instead.
-rw-r--r-- | libguile/intrinsics.c | 10 | ||||
-rw-r--r-- | libguile/intrinsics.h | 3 | ||||
-rw-r--r-- | libguile/vm-engine.c | 8 |
3 files changed, 15 insertions, 6 deletions
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index cf4833d71..a56de0b5d 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -310,11 +310,19 @@ throw_with_value_and_data (SCM val, SCM key_subr_and_message) throw_ (key, scm_list_4 (subr, message, args, data)); } +static void error_wrong_num_args (scm_thread *) SCM_NORETURN; static void error_no_values (void) SCM_NORETURN; static void error_not_enough_values (void) SCM_NORETURN; static void error_wrong_number_of_values (uint32_t expected) SCM_NORETURN; static void +error_wrong_num_args (scm_thread *thread) +{ + SCM callee = SCM_FRAME_LOCAL (thread->vm.fp, 0); + scm_wrong_num_args (callee); +} + +static void error_no_values (void) { scm_misc_error (NULL, "Zero values returned to single-valued continuation", @@ -409,7 +417,7 @@ scm_bootstrap_intrinsics (void) 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_vm_intrinsics.error_wrong_num_args = scm_wrong_num_args; + scm_vm_intrinsics.error_wrong_num_args = error_wrong_num_args; scm_vm_intrinsics.error_no_values = error_no_values; scm_vm_intrinsics.error_not_enough_values = error_not_enough_values; scm_vm_intrinsics.error_wrong_number_of_values = error_wrong_number_of_values; diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 47a896956..9d5bd8c6f 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -53,6 +53,7 @@ typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) (scm_thread*, uint32_t, uint8_t); typedef SCM (*scm_t_scm_from_scm_scm_scmp_sp_intrinsic) (SCM, SCM, SCM*, const union scm_vm_stack_element*); +typedef void (*scm_t_thread_noreturn_intrinsic) (scm_thread*) SCM_NORETURN; typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_thread*, SCM) SCM_NORETURN; typedef int (*scm_t_int_from_scm_intrinsic) (SCM); typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) SCM_NORETURN; @@ -127,7 +128,7 @@ typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*); 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) \ - M(scm_noreturn, error_wrong_num_args, "wrong-num-args", ERROR_WRONG_NUM_ARGS) \ + M(thread_noreturn, error_wrong_num_args, "wrong-num-args", ERROR_WRONG_NUM_ARGS) \ M(noreturn, error_no_values, "no-values", ERROR_NO_VALUES) \ M(noreturn, error_not_enough_values, "not-enough-values", ERROR_NOT_ENOUGH_VALUES) \ M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values", ERROR_WRONG_NUMBER_OF_VALUES) \ diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 8dc5c00c1..488d4c7fb 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -885,7 +885,7 @@ VM_NAME (scm_thread *thread) uint32_t expected; UNPACK_24 (op, expected); VM_ASSERT (FRAME_LOCALS_COUNT () == expected, - CALL_INTRINSIC (error_wrong_num_args, (FP_REF (0)))); + CALL_INTRINSIC (error_wrong_num_args, (thread))); NEXT (1); } VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (X8_C24)) @@ -893,7 +893,7 @@ VM_NAME (scm_thread *thread) uint32_t expected; UNPACK_24 (op, expected); VM_ASSERT (FRAME_LOCALS_COUNT () >= expected, - CALL_INTRINSIC (error_wrong_num_args, (FP_REF (0)))); + CALL_INTRINSIC (error_wrong_num_args, (thread))); NEXT (1); } VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (X8_C24)) @@ -901,7 +901,7 @@ VM_NAME (scm_thread *thread) uint32_t expected; UNPACK_24 (op, expected); VM_ASSERT (FRAME_LOCALS_COUNT () <= expected, - CALL_INTRINSIC (error_wrong_num_args, (FP_REF (0)))); + CALL_INTRINSIC (error_wrong_num_args, (thread))); NEXT (1); } @@ -1001,7 +1001,7 @@ VM_NAME (scm_thread *thread) uint16_t expected, nlocals; UNPACK_12_12 (op, expected, nlocals); VM_ASSERT (FRAME_LOCALS_COUNT () == expected, - CALL_INTRINSIC (error_wrong_num_args, (FP_REF (0)))); + CALL_INTRINSIC (error_wrong_num_args, (thread))); ALLOC_FRAME (expected + nlocals); while (nlocals--) SP_SET (nlocals, SCM_UNDEFINED); |