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, 19 insertions, 14 deletions

diff --git a/module/statprof.scm b/module/statprof.scm
index e613aad2d..74b32c0ba 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -327,10 +327,13 @@
       (set-buffer! state buffer)
       (set-buffer-pos! state (1+ pos)))
      (else
-      (let ((proc (frame-procedure frame)))
-        (write-sample-and-continue (if (primitive? proc)
-                                       (procedure-name proc)
-                                       (frame-instruction-pointer frame))))))))
+      (let ((ip (frame-instruction-pointer frame)))
+        (write-sample-and-continue
+         (if (primitive-code? ip)
+             ;; Grovel and get the primitive name from the gsubr, which
+             ;; we know to be in slot 0.
+             (procedure-name (frame-local-ref frame 0 'scm))
+             ip)))))))
 
 (define (reset-sigprof-timer usecs)
   ;; Guile's setitimer binding is terrible.
@@ -376,11 +379,11 @@
     (unless (inside-profiler? state)
       (accumulate-time state (get-internal-run-time))
 
-      (let* ((key (let ((proc (frame-procedure frame)))
-                    (cond
-                     ((primitive? proc) (procedure-name proc))
-                     ((program? proc) (program-code proc))
-                     (else proc))))
+      ;; We know local 0 is a SCM value: the c
+      (let* ((ip (frame-instruction-pointer frame))
+             (key (if (primitive-code? ip)
+                      (procedure-name (frame-local-ref frame 0 'scm))
+                      ip))
              (handle (hashv-create-handle! (call-counts state) key 0)))
         (set-cdr! handle (1+ (cdr handle))))
 
@@ -594,11 +597,13 @@ it represents different functions with the same name."
 none is available."
   (when (statprof-active?)
     (error "Can't call statprof-proc-call-data while profiler is running."))
-  (hashv-ref (stack-samples->procedure-data state)
-             (cond
-              ((primitive? proc) (procedure-name proc))
-              ((program? proc) (program-code proc))
-              (else (program-code proc)))))
+  (unless (program? proc)
+    (error "statprof-call-data only works for VM programs"))
+  (let* ((code (program-code proc))
+         (key (if (primitive-code? code)
+                  (procedure-name proc)
+                  code)))
+    (hashv-ref (stack-samples->procedure-data state) key)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Stats