tick in calls, procedure-name works on compiled procedures

* module/system/vm/program.scm:
* libguile/programs.h:
* libguile/programs.c (scm_program_bindings, scm_program_bindings)
  (scm_program_properties, scm_program_name): Unfortunately, implement
  more procs in C, so that C can use them more easily.

* libguile/debug.c (scm_procedure_name): Dispatch to scm_program_name as
  appropriate.

* libguile/vm-i-system.c (call): Tick in a call.

libguile/debug.c

@@ -42,6 +42,7 @@
 #include "libguile/root.h"
 #include "libguile/fluids.h"
 #include "libguile/objects.h"
+#include "libguile/programs.h"
 
 #include "libguile/validate.h"
 #include "libguile/debug.h"
@@ -314,6 +315,8 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
 #endif
       if (scm_is_false (name) && SCM_CLOSUREP (proc))
 	name = scm_reverse_lookup (SCM_ENV (proc), proc);
+      if (scm_is_false (name) && SCM_PROGRAM_P (proc))
+        name = scm_program_name (proc);
       return name;
     }
   }

libguile/programs.c

@@ -48,6 +48,7 @@
 #include "instructions.h"
 #include "modules.h"
 #include "programs.h"
+#include "procprop.h" // scm_sym_name
 #include "vm.h"
 
 
@@ -190,18 +191,73 @@ SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-extern SCM
-scm_c_program_source (SCM program, size_t ip)
+SCM_DEFINE (scm_program_bindings, "program-bindings", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_bindings
 {
-  SCM meta, sources, source;
+  SCM meta;
+  
+  SCM_VALIDATE_PROGRAM (1, program);
 
   meta = scm_program_meta (program);
   if (scm_is_false (meta))
     return SCM_BOOL_F;
-  meta = scm_call_0 (meta);
+  
+  return scm_car (scm_call_0 (meta));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_sources, "program-sources", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_sources
+{
+  SCM meta;
+  
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  meta = scm_program_meta (program);
   if (scm_is_false (meta))
-    return SCM_BOOL_F;
-  sources = scm_cadr (meta);
+    return SCM_EOL;
+  
+  return scm_cadr (scm_call_0 (meta));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_properties, "program-properties", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_properties
+{
+  SCM meta;
+  
+  SCM_VALIDATE_PROGRAM (1, program);
+
+  meta = scm_program_meta (program);
+  if (scm_is_false (meta))
+    return SCM_EOL;
+  
+  return scm_cddr (scm_call_0 (meta));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_name, "program-name", 1, 0, 0,
+	    (SCM program),
+	    "")
+#define FUNC_NAME s_scm_program_name
+{
+  SCM_VALIDATE_PROGRAM (1, program);
+  return scm_assq_ref (scm_program_properties (program), scm_sym_name);
+}
+#undef FUNC_NAME
+
+extern SCM
+scm_c_program_source (SCM program, size_t ip)
+{
+  SCM sources, source;
+
+  sources = scm_program_sources (program);
   source = scm_assv (scm_from_size_t (ip), sources);
   if (scm_is_false (source))
     return SCM_BOOL_F;

libguile/programs.h

@@ -66,6 +66,10 @@ extern SCM scm_program_p (SCM obj);
 extern SCM scm_program_base (SCM program);
 extern SCM scm_program_arity (SCM program);
 extern SCM scm_program_meta (SCM program);
+extern SCM scm_program_bindings (SCM program);
+extern SCM scm_program_sources (SCM program);
+extern SCM scm_program_properties (SCM program);
+extern SCM scm_program_name (SCM program);
 extern SCM scm_program_objects (SCM program);
 extern SCM scm_program_module (SCM program);
 extern SCM scm_program_external (SCM program);

libguile/vm-i-system.c

@@ -488,6 +488,9 @@ VM_DEFINE_INSTRUCTION (39, call, "call", 1, -1, 1)
  vm_call:
   x = sp[-nargs];
 
+  SYNC_REGISTER ();
+  SCM_TICK;	/* allow interrupt here */
+
   /*
    * Subprogram call
    */

module/system/vm/program.scm

@@ -51,13 +51,6 @@
 (define (binding:start b) (list-ref b 3))
 (define (binding:end b) (list-ref b 4))
 
-(define (curry1 proc)
-  (lambda (x) (proc (x))))
-
-(define (program-bindings prog)
-  (cond ((program-meta prog) => (curry1 car))
-	(else #f)))
-
 (define (source:addr source)
   (car source))
 (define (source:line source)
@@ -67,23 +60,12 @@
 (define (source:file source)
   (vector-ref (cdr source) 2))
 
-(define (program-sources prog)
-  (cond ((program-meta prog) => (curry1 cadr))
-	(else '())))
-
-(define (program-properties prog)
-  (or (and=> (program-meta prog) (curry1 cddr))
-      '()))
-
 (define (program-property prog prop)
   (assq-ref (program-properties proc) prop))
 
 (define (program-documentation prog)
   (assq-ref (program-properties prog) 'documentation))
 
-(define (program-name prog)
-  (assq-ref (program-properties prog) 'name))
-
 (define (program-bindings-as-lambda-list prog)
   (let ((bindings (program-bindings prog))
         (nargs (arity:nargs (program-arity prog)))