add vm-abort-continuation-hook, vm-restore-continuation-hook

* libguile/vm-i-system.c (call_cc, tail_call_cc): Call the new
  RESTORE_CONTINUATION_HOOK when a continuation is restored.
  (prompt): Call the new ABORT_CONTINUATION_HOOK when entering the abort
  handler's continuation.

* libguile/vm-engine.h (ABORT_CONTINUATION_HOOK)
  (RESTORE_CONTINUATION_HOOK):
* libguile/vm.h (SCM_VM_ABORT_CONTINUATION_HOOK)
  (SCM_VM_RESTORE_CONTINUATION_HOOK):
* libguile/vm.c: (scm_vm_abort_continuation_hook): New hook, called when
  entering an abort handler.
  (scm_vm_restore_continuation_hook): New hook, called after returning
  to a continuation.

* module/system/vm/vm.scm: Add hooks to export list.

diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index dd735a3..ad226dc 100644 (file)
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -232,6 +232,10 @@
   RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
 #define NEXT_HOOK()                             \
   RUN_HOOK (SCM_VM_NEXT_HOOK)
+#define ABORT_CONTINUATION_HOOK()               \
+  RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
+#define RESTORE_CONTINUATION_HOOK()            \
+  RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
 
 #define VM_HANDLE_INTERRUPTS                     \
   SCM_ASYNC_TICK_WITH_CODE (SYNC_REGISTER ())

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 063270f..05c632c 100644 (file)
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1142,12 +1142,17 @@ VM_DEFINE_INSTRUCTION (64, call_cc, "call/cc", 0, 1, 1)
     }
   else 
     {
-      /* otherwise, the vm continuation was reinstated, and
-         scm_i_vm_return_to_continuation pushed on one value. So pull our regs
-         back down from the vp, and march on to the next instruction. */
+      /* Otherwise, the vm continuation was reinstated, and
+         vm_return_to_continuation pushed on one value. We know only one
+         value was returned because we are in value context -- the
+         previous block jumped to vm_call, not vm_mv_call, after all.
+
+         So, pull our regs back down from the vp, and march on to the
+         next instruction. */
       CACHE_REGISTER ();
       program = SCM_FRAME_PROGRAM (fp);
       CACHE_PROGRAM ();
+      RESTORE_CONTINUATION_HOOK ();
       NEXT;
     }
 }
@@ -1177,10 +1182,17 @@ VM_DEFINE_INSTRUCTION (65, tail_call_cc, "tail-call/cc", 0, 1, 1)
   else
     {
       /* Otherwise, cache regs and NEXT, as above. Invoking the continuation
-         does a return from the frame, either to the RA or MVRA. */
+         does a return from the frame, either to the RA or
+         MVRA. */
       CACHE_REGISTER ();
       program = SCM_FRAME_PROGRAM (fp);
       CACHE_PROGRAM ();
+      /* Unfortunately we don't know whether we are at the RA, and thus
+         have one value without an nvalues marker, or we are at the
+         MVRA and thus have multiple values and the nvalues
+         marker. Instead of adding heuristics here, we will let hook
+         client code do that. */
+      RESTORE_CONTINUATION_HOOK ();
       NEXT;
     }
 }
@@ -1505,6 +1517,9 @@ VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 4, 2, 0)
       CACHE_REGISTER ();
       program = SCM_FRAME_PROGRAM (fp);
       CACHE_PROGRAM ();
+      /* The stack contains the values returned to this prompt, along
+         with a number-of-values marker -- like an MV return. */
+      ABORT_CONTINUATION_HOOK ();
       NEXT;
     }
       

diff --git a/libguile/vm.c b/libguile/vm.c
index fd96d7e..c0237be 100644 (file)
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -704,6 +704,24 @@ SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_vm_abort_continuation_hook, "vm-abort-continuation-hook", 1, 0, 0,
+           (SCM vm),
+           "")
+#define FUNC_NAME s_scm_vm_abort_continuation_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_vm_restore_continuation_hook, "vm-restore-continuation-hook", 1, 0, 0,
+           (SCM vm),
+           "")
+#define FUNC_NAME s_scm_vm_restore_continuation_hook
+{
+  VM_DEFINE_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_vm_option, "vm-option", 2, 0, 0,
            (SCM vm, SCM key),
            "")

diff --git a/libguile/vm.h b/libguile/vm.h
index eff6f18..acf43c2 100644 (file)
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -27,6 +27,8 @@ enum {
   SCM_VM_PUSH_CONTINUATION_HOOK,
   SCM_VM_POP_CONTINUATION_HOOK,
   SCM_VM_NEXT_HOOK,
+  SCM_VM_ABORT_CONTINUATION_HOOK,
+  SCM_VM_RESTORE_CONTINUATION_HOOK,
   SCM_VM_NUM_HOOKS,
 };
 
@@ -74,6 +76,8 @@ SCM_API SCM scm_vm_fp (SCM vm);
 SCM_API SCM scm_vm_apply_hook (SCM vm);
 SCM_API SCM scm_vm_push_continuation_hook (SCM vm);
 SCM_API SCM scm_vm_pop_continuation_hook (SCM vm);
+SCM_API SCM scm_vm_abort_continuation_hook (SCM vm);
+SCM_API SCM scm_vm_restore_continuation_hook (SCM vm);
 SCM_API SCM scm_vm_next_hook (SCM vm);
 SCM_API SCM scm_vm_option (SCM vm, SCM key);
 SCM_API SCM scm_set_vm_option_x (SCM vm, SCM key, SCM val);

diff --git a/module/system/vm/vm.scm b/module/system/vm/vm.scm
index 53e0604..3fd96f4 100644 (file)
--- a/module/system/vm/vm.scm
+++ b/module/system/vm/vm.scm
@@ -30,7 +30,8 @@
             vm-trace-level set-vm-trace-level!
             vm-push-continuation-hook vm-pop-continuation-hook
             vm-apply-hook
-            vm-next-hook))
+            vm-next-hook
+            vm-abort-continuation-hook vm-restore-continuation-hook))
 
 (load-extension (string-append "libguile-" (effective-version))
                 "scm_init_vm")