summaryrefslogtreecommitdiff
path: root/libguile/programs.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-11-27 11:44:11 +0100
committerAndy Wingo <wingo@pobox.com>2015-12-01 11:30:54 +0100
commit8af3423efe1aa4168a097cf9ae11d3c4338894bb (patch)
tree48a07cb6fe453883931f0555b13549b1a764b55c /libguile/programs.c
parent3b3405e5040ea5d264706bc82e2a5bb224c704cd (diff)
downloadguile-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.c12
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);