diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-24 14:15:38 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-24 14:15:38 +0200 |
commit | d848af9a161b0c37964d582dfb8b52ed5112355f (patch) | |
tree | 6a5fb67950693dca72b61e0ed6872ec14b6fe47a | |
parent | 5ca24b6ba1bc617e60a0a9b2ecad7f112e99ef9c (diff) | |
download | guile-d848af9a161b0c37964d582dfb8b52ed5112355f.tar.gz |
Parse bytecode to determine minimum arity
* libguile/programs.c (try_parse_arity): New helper, to parse bytecode
to determine the minimum arity of a function in a cheaper way than
grovelling through the debug info. Should speed up all thunk? checks
and similar.
(scm_i_program_arity): Simplify.
* libguile/gsubr.h:
* libguile/gsubr.c (scm_i_primitive_arity):
* libguile/foreign.h:
* libguile/foreign.c (scm_i_foreign_arity):
-rw-r--r-- | libguile/foreign.c | 19 | ||||
-rw-r--r-- | libguile/foreign.h | 2 | ||||
-rw-r--r-- | libguile/gsubr.c | 31 | ||||
-rw-r--r-- | libguile/gsubr.h | 1 | ||||
-rw-r--r-- | libguile/programs.c | 71 |
5 files changed, 58 insertions, 66 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index 936f3419c..0992ef4d3 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -792,25 +792,6 @@ get_foreign_stub_code (unsigned int nargs) return &foreign_stub_code[nargs * 2]; } -/* Given a foreign procedure, determine its minimum arity. */ -int -scm_i_foreign_arity (SCM foreign, int *req, int *opt, int *rest) -{ - const scm_t_uint32 *code = SCM_PROGRAM_CODE (foreign); - - if (code < foreign_stub_code) - return 0; - if (code > (foreign_stub_code - + (sizeof(foreign_stub_code) / sizeof(scm_t_uint32)))) - return 0; - - *req = (code - foreign_stub_code) / 2; - *opt = 0; - *rest = 0; - - return 1; -} - static SCM cif_to_procedure (SCM cif, SCM func_ptr) { diff --git a/libguile/foreign.h b/libguile/foreign.h index 53f39d5c7..4c1a19f1f 100644 --- a/libguile/foreign.h +++ b/libguile/foreign.h @@ -101,8 +101,6 @@ SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr, SCM arg_types); SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign, const union scm_vm_stack_element *argv); -SCM_INTERNAL int scm_i_foreign_arity (SCM foreign, - int *req, int *opt, int *rest); diff --git a/libguile/gsubr.c b/libguile/gsubr.c index d80e5dd42..b456b220a 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -262,37 +262,6 @@ scm_i_primitive_code_p (const scm_t_uint32 *code) return 1; } -/* Given a program that is a primitive, determine its minimum arity. - This is possible because each primitive's code is 4 32-bit words - long, and they are laid out contiguously in an ordered pattern. */ -int -scm_i_primitive_arity (SCM prim, int *req, int *opt, int *rest) -{ - const scm_t_uint32 *code = SCM_PROGRAM_CODE (prim); - unsigned idx, nargs, base, next; - - if (!scm_i_primitive_code_p (code)) - return 0; - - idx = (code - subr_stub_code) / 4; - - nargs = -1; - next = 0; - do - { - base = next; - nargs++; - next = (nargs + 1) * (nargs + 1); - } - while (idx >= next); - - *rest = (next - idx) < (idx - base); - *req = *rest ? (next - 1) - idx : (base + nargs) - idx; - *opt = *rest ? idx - (next - nargs) : idx - base; - - return 1; -} - scm_t_uintptr scm_i_primitive_call_ip (SCM subr) { diff --git a/libguile/gsubr.h b/libguile/gsubr.h index 725de2cbd..83eebc371 100644 --- a/libguile/gsubr.h +++ b/libguile/gsubr.h @@ -55,7 +55,6 @@ SCM_INTERNAL int scm_i_primitive_code_p (const scm_t_uint32 *code); -SCM_INTERNAL int scm_i_primitive_arity (SCM subr, int *req, int *opt, int *rest); SCM_INTERNAL scm_t_uintptr scm_i_primitive_call_ip (SCM subr); union scm_vm_stack_element; diff --git a/libguile/programs.c b/libguile/programs.c index 49d4c77b1..ba8e8546b 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -22,6 +22,7 @@ #include <string.h> #include "_scm.h" +#include "instructions.h" #include "modules.h" #include "programs.h" #include "procprop.h" /* scm_sym_name */ @@ -236,25 +237,69 @@ SCM_DEFINE (scm_program_free_variable_set_x, "program-free-variable-set!", 3, 0, } #undef FUNC_NAME +/* It's hacky, but it manages to cover all of the non-keyword cases. */ +static int +try_parse_arity (SCM program, int *req, int *opt, int *rest) +{ + scm_t_uint32 *code = SCM_PROGRAM_CODE (program); + scm_t_uint32 slots, min; + + switch (code[0] & 0xff) { + case scm_op_assert_nargs_ee: + slots = code[0] >> 8; + *req = slots - 1; + *opt = 0; + *rest = 0; + return 1; + case scm_op_assert_nargs_le: + slots = code[0] >> 8; + *req = 0; + *opt = slots - 1; + *rest = 0; + return 1; + case scm_op_bind_rest: + slots = code[0] >> 8; + *req = 0; + *opt = slots - 1; + *rest = 1; + return 1; + case scm_op_assert_nargs_ge: + min = code[0] >> 8; + switch (code[1] & 0xff) { + case scm_op_assert_nargs_le: + slots = code[1] >> 8; + *req = min - 1; + *opt = slots - 1 - *req; + *rest = 0; + return 1; + case scm_op_bind_rest: + slots = code[1] >> 8; + *req = min - 1; + *opt = slots - min; + *rest = 1; + return 1; + default: + return 0; + } + case scm_op_continuation_call: + case scm_op_compose_continuation: + *req = 0; + *opt = 0; + *rest = 1; + return 1; + default: + return 0; + } +} + int scm_i_program_arity (SCM program, int *req, int *opt, int *rest) { static SCM program_minimum_arity = SCM_BOOL_F; SCM l; - if (SCM_PRIMITIVE_P (program)) - return scm_i_primitive_arity (program, req, opt, rest); - - if (SCM_PROGRAM_IS_FOREIGN (program)) - return scm_i_foreign_arity (program, req, opt, rest); - - if (SCM_PROGRAM_IS_CONTINUATION (program) - || SCM_PROGRAM_IS_PARTIAL_CONTINUATION (program)) - { - *req = *opt = 0; - *rest = 1; - return 1; - } + if (try_parse_arity (program, req, opt, rest)) + return 1; if (scm_is_false (program_minimum_arity) && scm_module_system_booted_p) program_minimum_arity = |