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.

1 files changed, 12 insertions, 3 deletions

diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index a3b804bb5..d80e5dd42 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -251,6 +251,17 @@ create_subr (int define, const char *name,
   return ret;
 }
 
+int
+scm_i_primitive_code_p (const scm_t_uint32 *code)
+{
+  if (code < subr_stub_code)
+    return 0;
+  if (code > subr_stub_code + (sizeof(subr_stub_code) / sizeof(scm_t_uint32)))
+    return 0;
+
+  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.  */
@@ -260,9 +271,7 @@ 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 (code < subr_stub_code)
-    return 0;
-  if (code > subr_stub_code + (sizeof(subr_stub_code) / sizeof(scm_t_uint32)))
+  if (!scm_i_primitive_code_p (code))
     return 0;
 
   idx = (code - subr_stub_code) / 4;