make applicable smob calls cheaper, and fix a memory leak

[bpt/guile.git] / libguile / vm.c

diff --git a/libguile/vm.c b/libguile/vm.c
index a283857..5645f81 100644 (file)
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -247,9 +247,11 @@ vm_dispatch_hook (SCM vm, int hook_num)
   vp->trace_level = saved_trace_level;
 }
 
-static void vm_abort (SCM vm, size_t n, scm_t_int64 cookie) SCM_NORETURN;
 static void
-vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
+vm_abort (SCM vm, size_t n, scm_i_jmp_buf *current_registers) SCM_NORETURN;
+
+static void
+vm_abort (SCM vm, size_t n, scm_i_jmp_buf *current_registers)
 {
   size_t i;
   ssize_t tail_len;
@@ -272,12 +274,13 @@ vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
   /* NULLSTACK (n + 1) */
   SCM_VM_DATA (vm)->sp -= n + 1;
 
-  scm_c_abort (vm, tag, n + tail_len, argv, vm_cookie);
+  scm_c_abort (vm, tag, n + tail_len, argv, current_registers);
 }
 
-static scm_t_ptrdiff
-vm_reinstate_partial_continuation (SCM vm, SCM cont,
-                                   size_t n, SCM *argv, scm_t_int64 vm_cookie)
+static void
+vm_reinstate_partial_continuation (SCM vm, SCM cont, size_t n, SCM *argv,
+                                   scm_t_dynstack *dynstack,
+                                   scm_i_jmp_buf *registers)
 {
   struct scm_vm *vp;
   struct scm_vm_cont *cp;
@@ -325,16 +328,24 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont,
   vp->sp++;
   *vp->sp = scm_from_size_t (n);
 
-  /* Finally, rewind the dynamic state.  Unhappily, we have to do this
-     in the vm_engine.  If we do it here, the stack frame will likely
-     have been stompled by some future call out of the VM, so we will
-     return to some other part of the VM.
-
-     We used to wind and relocate the prompts here, but that's bogus,
-     because a rewinder would then be able to abort to a prompt with a
-     stale jmpbuf.  */
-
-  return reloc;
+  /* The prompt captured a slice of the dynamic stack.  Here we wind
+     those entries onto the current thread's stack.  We also have to
+     relocate any prompts that we see along the way.  */
+  {
+    scm_t_bits *walk;
+
+    for (walk = SCM_DYNSTACK_FIRST (cp->dynstack);
+         SCM_DYNSTACK_TAG (walk);
+         walk = SCM_DYNSTACK_NEXT (walk))
+      {
+        scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
+
+        if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
+          scm_dynstack_wind_prompt (dynstack, walk, reloc, registers);
+        else
+          scm_dynstack_wind_1 (dynstack, walk);
+      }
+  }
 #undef RELOC
 }
 
@@ -422,6 +433,24 @@ vm_make_boot_program (long nargs)
  * VM
  */
 
+/* We are calling a SMOB.  The calling code pushed the SMOB after the
+   args, and incremented nargs.  That nargs is passed here.  This
+   function's job is to replace the procedure with the trampoline, and
+   shuffle the smob itself to be argument 0.  This function must not
+   allocate or throw, as the VM registers are not synchronized.  */
+static void
+prepare_smob_call (SCM *sp, int nargs, SCM smob)
+{
+  SCM *args = sp - nargs + 1;
+
+  /* Shuffle args up.  */
+  while (nargs--)
+    args[nargs + 1] = args[nargs];
+
+  args[0] = smob;
+  args[-1] = SCM_SMOB_DESCRIPTOR (smob).apply_trampoline;
+}
+
 static SCM
 resolve_variable (SCM what, SCM program_module)
 {
@@ -522,7 +551,6 @@ make_vm (void)
   vp->trace_level = 0;
   for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
     vp->hooks[i] = SCM_BOOL_F;
-  vp->cookie = 0;
   return scm_cell (scm_tc7_vm, (scm_t_bits)vp);
 }
 #undef FUNC_NAME