diff options
author | Andy Wingo <wingo@pobox.com> | 2015-11-27 11:44:11 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2015-12-01 11:30:54 +0100 |
commit | 8af3423efe1aa4168a097cf9ae11d3c4338894bb (patch) | |
tree | 48a07cb6fe453883931f0555b13549b1a764b55c /libguile/programs.c | |
parent | 3b3405e5040ea5d264706bc82e2a5bb224c704cd (diff) | |
download | guile-8af3423efe1aa4168a097cf9ae11d3c4338894bb.tar.gz |
Remove primitive?, add primitive-code?
We need to be able to identify frames that are primitive applications
without assuming that slot 0 in a frame is an SCM value and without
assuming that value is the procedure being applied.
* libguile/gsubr.c (scm_i_primitive_code_p): New helper.
(scm_i_primitive_arity): Use the new helper.
* libguile/gsubr.h: Declare the new helper.
* libguile/programs.h:
* libguile/programs.c (scm_program_code_p): New function, replacing
scm_primitive_p.
(scm_primitive_call_ip): Fix FUNC_NAME definition.
* module/statprof.scm (sample-stack-procs, count-call): Identify
primitive frames from the IP, not the frame-procedure. Avoids the
assumption that slot 0 in a frame is a SCM value.
(statprof-proc-call-data): Adapt to primitive-code? change.
* module/system/vm/frame.scm (frame-call-representation): Identify
primitive frames from the IP, not the closure. Still more work to do
here to avoid assuming slot 0 is a procedure.
* module/system/vm/program.scm: Export primitive-code? instead of
primitive?.
(program-arguments-alist, program-arguments-alists): Identify
primitives from the code instead of the flags on the program. Not
sure this is a great change, but it does avoid having to define a
primitive? predicate in Scheme.
Diffstat (limited to 'libguile/programs.c')
-rw-r--r-- | libguile/programs.c | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/libguile/programs.c b/libguile/programs.c index 64c861a71..c03865de1 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -144,19 +144,21 @@ SCM_DEFINE (scm_program_p, "program?", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_primitive_p, "primitive?", 1, 0, 0, - (SCM obj), +SCM_DEFINE (scm_primitive_code_p, "primitive-code?", 1, 0, 0, + (SCM code), "") -#define FUNC_NAME s_scm_primitive_p +#define FUNC_NAME s_scm_primitive_code_p { - return scm_from_bool (SCM_PRIMITIVE_P (obj)); + const scm_t_uint32 * ptr = (const scm_t_uint32 *) scm_to_uintptr_t (code); + + return scm_from_bool (scm_i_primitive_code_p (ptr)); } #undef FUNC_NAME SCM_DEFINE (scm_primitive_call_ip, "primitive-call-ip", 1, 0, 0, (SCM prim), "") -#define FUNC_NAME s_scm_primitive_p +#define FUNC_NAME s_scm_primitive_call_ip { SCM_MAKE_VALIDATE (1, prim, PRIMITIVE_P); |