From 747a163532590459f2d2f83a405fd604d382c5ce Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 4 Feb 2009 00:09:38 +0100
Subject: [PATCH] make catch cache and restore vm regs, not the vm itself --
 speedy speedy

* libguile/throw.c (scm_c_catch): Stash away the current vm's regs, and
  restore them if there's a nonlocal exit. There is a terrible case we
  have to handle if we catch from when the vm smob type isn't registered
  but the throw has the vm registered, but I think we handle this fine.

* libguile/vm-engine.c (vm_run):
* libguile/vm-i-system.c (halt): Don't make a dynwind context, so that
  entering the VM doesn't cons at all, except for the arg list. Maybe we
  can fix that bit too.

* libguile/vm.c (vm_reset_stack): Remove, as there is no more dynwind.
  (make_vm): Return #f if the tc16 hasn't yet been registered.
---
 libguile/throw.c       | 34 ++++++++++++++++++++++++++++++++++
 libguile/vm-engine.c   | 14 --------------
 libguile/vm-i-system.c |  1 -
 libguile/vm.c          | 25 +++++--------------------
 4 files changed, 39 insertions(+), 35 deletions(-)

diff --git a/libguile/throw.c b/libguile/throw.c
index ae538e25e..e0dda27cf 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -41,6 +41,7 @@
 #include "libguile/throw.h"
 #include "libguile/init.h"
 #include "libguile/strings.h"
+#include "libguile/vm.h"
 
 #include "libguile/private-options.h"
 
@@ -169,8 +170,17 @@ scm_c_catch (SCM tag,
   struct jmp_buf_and_retval jbr;
   SCM jmpbuf;
   SCM answer;
+  SCM vm;
+  SCM *sp = NULL, *fp = NULL; /* to reset the vm */
   struct pre_unwind_data pre_unwind;
 
+  vm = scm_the_vm ();
+  if (SCM_NFALSEP (vm))
+    {
+      sp = SCM_VM_DATA (vm)->sp;
+      fp = SCM_VM_DATA (vm)->fp;
+    }
+
   jmpbuf = make_jmpbuf ();
   answer = SCM_EOL;
   scm_i_set_dynwinds (scm_acons (tag, jmpbuf, scm_i_dynwinds ()));
@@ -199,6 +209,30 @@ scm_c_catch (SCM tag,
       throw_tag = jbr.throw_tag;
       jbr.throw_tag = SCM_EOL;
       jbr.retval = SCM_EOL;
+      if (SCM_NFALSEP (vm))
+        {
+          SCM_VM_DATA (vm)->sp = sp;
+          SCM_VM_DATA (vm)->fp = fp;
+#ifdef VM_ENABLE_STACK_NULLING
+          /* see vm.c -- you'll have to enable this manually */
+          memset (sp + 1, 0,
+                  (SCM_VM_DATA (vm)->stack_size
+                   - (sp + 1 - SCM_VM_DATA (vm)->stack_base)) * sizeof(SCM));
+#endif
+        }
+      else if (SCM_NFALSEP ((vm = scm_the_vm ())))
+        {
+          /* oof, it's possible this catch was called before the vm was
+             booted... yick. anyway, try to reset the vm stack. */
+          SCM_VM_DATA (vm)->sp = SCM_VM_DATA (vm)->stack_base - 1;
+          SCM_VM_DATA (vm)->fp = NULL;
+#ifdef VM_ENABLE_STACK_NULLING
+          /* see vm.c -- you'll have to enable this manually */
+          memset (SCM_VM_DATA (vm)->stack_base, 0,
+                  SCM_VM_DATA (vm)->stack_size * sizeof(SCM));
+#endif
+        }
+          
       answer = handler (handler_data, throw_tag, throw_args);
     }
   else
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 97684d90b..2be9b46b3 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -72,7 +72,6 @@ vm_run (SCM vm, SCM program, SCM args)
 #if VM_USE_HOOKS
   SCM hook_args = SCM_LIST1 (vm);
 #endif
-  struct vm_unwind_data wind_data;
 
 #ifdef HAVE_LABELS_AS_VALUES
   static void **jump_table = NULL;
@@ -92,19 +91,6 @@ vm_run (SCM vm, SCM program, SCM args)
     }
 #endif
 
-  /* dynwind ended in the halt instruction */
-  scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
-  wind_data.vp = vp;
-  wind_data.sp = vp->sp;
-  wind_data.fp = vp->fp;
-  scm_dynwind_unwind_handler (vm_reset_stack, &wind_data, 0);
-
-  /* could do this if we reified all vm stacks -- for now, don't bother changing
-     *the-vm*
-  if (scm_fluid_ref (scm_the_vm_fluid) != vm)
-    scm_dynwind_fluid (scm_the_vm_fluid, vm);
-   */
-
   /* Initialization */
   {
     SCM prog = program;
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index d677a41b3..1dfec4822 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -56,7 +56,6 @@ VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0)
     NULLSTACK (stack_base - sp);
   }
   SYNC_ALL ();
-  scm_dynwind_end ();
   return ret;
 }
 
diff --git a/libguile/vm.c b/libguile/vm.c
index ffb14384e..074bec63c 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -67,6 +67,7 @@
    are NULL. This is useful for checking the internal consistency of the VM's
    assumptions and its operators, but isn't necessary for normal operation. It
    will ensure that assertions are enabled. Slows down the VM by about 30%. */
+/* NB! If you enable this, search for NULLING in throw.c */
 /* #define VM_ENABLE_STACK_NULLING */
 
 /* #define VM_ENABLE_PARANOID_ASSERTIONS */
@@ -208,26 +209,6 @@ scm_vm_reinstate_continuations (SCM conts)
     reinstate_vm_cont (SCM_VM_DATA (SCM_CAAR (conts)), SCM_CDAR (conts));
 }
 
-struct vm_unwind_data 
-{
-  struct scm_vm *vp;
-  SCM *sp;
-  SCM *fp;
-};
-
-static void
-vm_reset_stack (void *data)
-{
-  struct vm_unwind_data *w = data;
-  struct scm_vm *vp = w->vp;
-  
-  vp->sp = w->sp;
-  vp->fp = w->fp;
-#ifdef VM_ENABLE_STACK_NULLING
-  memset (vp->sp + 1, 0, (vp->stack_size - (vp->sp + 1 - vp->stack_base)) * sizeof(SCM));
-#endif
-}
-
 static void enfalsen_frame (void *p)
 { 
   struct scm_vm *vp = p;
@@ -331,6 +312,10 @@ make_vm (void)
 #define FUNC_NAME "make_vm"
 {
   int i;
+
+  if (!scm_tc16_vm)
+    return SCM_BOOL_F; /* not booted yet */
+
   struct scm_vm *vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
 
   vp->stack_size  = VM_DEFAULT_STACK_SIZE;