[Help-smalltalk] Re: Trying to test Seaside on MacOS

[Paolo Bonzini]

> And, once Processor activeProcess suspend is executed, then, I can't 
> stop (interrupt) GST.

This patch completely overhauls the way GST deals with SIGINT, so that 
^C propagates up and terminates all call-ins.  It's not perfect but it's 
a great improvement.

It also makes "kill -USR1" work more reliably to show the backtrace of 
the currently executing process.

Paolo

2008-06-04  Paolo Bonzini  <address@hidden>
    
        * libgst/interp-bc.inl: Create a jmp_buf for _gst_interpret.
        * libgst/interp-jit.inl: Likewise.
        * libgst/interp.c: Rewrite handling of interp_jmp_buf and signals.  Use
        the jmp_buf from _gst_interpret when SIGINT is sent but the current
        process is terminated.
        * libgst/prims.def: Use push_jmp_buf and pop_jmp_buf.  Propagate
        interruptions until the interpreter is reached.

diff --git a/libgst/interp-bc.inl b/libgst/interp-bc.inl
index 093940f..461e2fa 100644
--- a/libgst/interp-bc.inl
+++ b/libgst/interp-bc.inl
@@ -441,6 +441,9 @@ _gst_validate_method_cache_entries (void)
 OOP
 _gst_interpret (OOP processOOP)
 {
+  interp_jmp_buf jb;
+  gst_callin_process process;
+
 #ifdef LOCAL_REGS
 # undef  sp
 # undef  ip
@@ -494,22 +497,24 @@ _gst_interpret (OOP processOOP)
 
 #include "vm.inl"
 
-  /* Set the global variables holding the pointers to the bytecode
-     routines.  */
+  /* Global pointers to the bytecode routines are used to interrupt the
+     bytecode interpreter "from the outside" and divert it to
+     monitor_byte_codes.  */
   global_normal_bytecodes = normal_byte_codes;
   global_monitored_bytecodes = monitored_byte_codes;
   dispatch_vec = normal_byte_codes;
 
-  /* The first time through, evaluate the monitoring code in order to
-     process the execution tracing flag.  */
-  _gst_except_flag = true;
-
-  _gst_register_oop (processOOP);
-  in_interpreter = true;
-
   /* Prime the interpreter's registers.  */
   IMPORT_REGS ();
 
+  push_jmp_buf (&jb, true, processOOP);
+  if (setjmp (jb.jmpBuf) == 0)
+    goto monitor_byte_codes;
+  else
+    goto return_value;
+
+  /* The code blocks that follow are executed in threaded-code style.  */
+
 monitor_byte_codes:
   SET_EXCEPT_FLAG (false);
   if (!disable_preemption)
@@ -548,12 +553,7 @@ monitor_byte_codes:
     }
 
   if (is_process_terminating (processOOP))
-    {
-      gst_callin_process process = (gst_callin_process) OOP_TO_OBJ 
(processOOP);
-      _gst_unregister_oop (processOOP);
-      in_interpreter = false;
-      return (process->returnedValue);
-    }
+    goto return_value;
 
   if UNCOMMON (_gst_abort_execution)
     {
@@ -561,6 +561,7 @@ monitor_byte_codes:
       selectorOOP = _gst_intern_string ((char *) _gst_abort_execution);
       _gst_abort_execution = NULL;
       SEND_MESSAGE (selectorOOP, 0);
+      IMPORT_REGS ();
     }
 
   if UNCOMMON (_gst_execution_tracing)
@@ -603,6 +604,13 @@ lookahead_dup_false:
   PREFETCH_VEC (false_byte_codes);
   PUSH_OOP (_gst_false_oop);
   NEXT_BC_VEC (false_byte_codes);
+
+ return_value:
+  process = (gst_callin_process) OOP_TO_OBJ (processOOP);
+  if (pop_jmp_buf ())
+    stop_execution ();
+
+  return (process->returnedValue);
 }
 
 
diff --git a/libgst/interp-jit.inl b/libgst/interp-jit.inl
index 8f7c291..2c07522 100644
--- a/libgst/interp-jit.inl
+++ b/libgst/interp-jit.inl
@@ -379,98 +379,100 @@ refresh_native_ips (OOP contextOOP)
 OOP
 _gst_interpret (OOP processOOP)
 {
-  _gst_register_oop (processOOP);
-  in_interpreter = true;
-
-  for (;;)
-    {
-      gst_method_context thisContext;
-
-      if (!native_ip)
-       return (_gst_nil_oop);
-
-      native_ip = _gst_run_native_code (native_ip);
-
-      if (!_gst_except_flag)
-       {
-          OOP activeProcessOOP = get_scheduled_process ();
-          gst_callin_process process = (gst_callin_process) OOP_TO_OBJ 
(activeProcessOOP);
-          process->returnedValue = POP_OOP ();
-          _gst_terminate_process (activeProcessOOP);
-       }
-
-      if UNCOMMON (_gst_abort_execution)
-       {
-         OOP selectorOOP;
-         selectorOOP = _gst_intern_string ((char *)_gst_abort_execution);
-         _gst_abort_execution = NULL;
-         SEND_MESSAGE (selectorOOP, 0);
-       }
-
-      if (!disable_preemption)
-        {
-         _gst_disable_interrupts ();   /* block out everything! */
-          if UNCOMMON (async_queue_index)
-           {
-             /* deal with any async signals */
-             int i;
-             for (i = 0; i < async_queue_index; i++)
-               {
-                 sync_signal (queued_async_signals[i].sem);
-                 if (queued_async_signals[i].unregister)
-                   _gst_unregister_oop (queued_async_signals[i].sem);
-               }
-
-             async_queue_index = 0;
-           }
-          _gst_enable_interrupts ();
-       }
-
-      thisContext =
-       (gst_method_context) OOP_TO_OBJ (_gst_this_context_oop);
-      thisContext->native_ip = GET_NATIVE_IP (native_ip);
-
-      _gst_except_flag = false;
-
-      if UNCOMMON (!IS_NIL (switch_to_process))
-       {
-         change_process_context (switch_to_process);
-          if UNCOMMON (single_step_semaphore)
-            {
-              _gst_async_signal (single_step_semaphore);
-              single_step_semaphore = NULL;
-            }
-       }
-
-      else if UNCOMMON (time_to_preempt)
-       ACTIVE_PROCESS_YIELD ();
-
-      if (is_process_terminating (processOOP))
-        {
-          gst_callin_process process = (gst_callin_process) OOP_TO_OBJ 
(processOOP);
-          if (!IS_NIL (switch_to_process))
-            change_process_context (switch_to_process);
-
-         _gst_unregister_oop (processOOP);
-         in_interpreter = false;
-          return (process->returnedValue);
-        }
-
-      /* If the native_ip in the context is not valid, this is a
-         process that we have not restarted yet! Get a fresh
-         native_ip for each context in the chain, recompiling
-         methods if needed. */
-      thisContext =
-       (gst_method_context) OOP_TO_OBJ (_gst_this_context_oop);
-
-      if (!(_gst_this_method->flags & F_XLAT)
-         || thisContext->native_ip == DUMMY_NATIVE_IP)
-       {
-         refresh_native_ips (_gst_this_context_oop);
-         native_ip = GET_CONTEXT_IP (thisContext);
-       }
-
-      if UNCOMMON (time_to_preempt)
-       set_preemption_timer ();
-    }
+  gst_callin_process process;
+  push_jmp_buf (&jb, true, processOOP);
+
+  if (setjmp (jb.jmpBuf) == 0)
+    for (;;)
+      {
+        gst_method_context thisContext;
+
+        if (!native_ip)
+         return (_gst_nil_oop);
+
+        native_ip = _gst_run_native_code (native_ip);
+
+        if (!_gst_except_flag)
+         {
+            OOP activeProcessOOP = get_scheduled_process ();
+            gst_callin_process process = (gst_callin_process) OOP_TO_OBJ 
(activeProcessOOP);
+            process->returnedValue = POP_OOP ();
+            _gst_terminate_process (activeProcessOOP);
+         }
+
+        if UNCOMMON (_gst_abort_execution)
+         {
+           OOP selectorOOP;
+           selectorOOP = _gst_intern_string ((char *)_gst_abort_execution);
+           _gst_abort_execution = NULL;
+           SEND_MESSAGE (selectorOOP, 0);
+         }
+
+        if (!disable_preemption)
+          {
+           _gst_disable_interrupts (); /* block out everything! */
+            if UNCOMMON (async_queue_index)
+             {
+               /* deal with any async signals */
+               int i;
+               for (i = 0; i < async_queue_index; i++)
+                 {
+                   sync_signal (queued_async_signals[i].sem);
+                   if (queued_async_signals[i].unregister)
+                     _gst_unregister_oop (queued_async_signals[i].sem);
+                 }
+
+               async_queue_index = 0;
+             }
+            _gst_enable_interrupts ();
+         }
+
+        thisContext =
+         (gst_method_context) OOP_TO_OBJ (_gst_this_context_oop);
+        thisContext->native_ip = GET_NATIVE_IP (native_ip);
+
+        _gst_except_flag = false;
+
+        if UNCOMMON (!IS_NIL (switch_to_process))
+         {
+           change_process_context (switch_to_process);
+            if UNCOMMON (single_step_semaphore)
+              {
+                _gst_async_signal (single_step_semaphore);
+                single_step_semaphore = NULL;
+              }
+         }
+
+        else if UNCOMMON (time_to_preempt)
+         ACTIVE_PROCESS_YIELD ();
+
+        if (is_process_terminating (processOOP))
+          break;
+
+        /* If the native_ip in the context is not valid, this is a
+           process that we have not restarted yet! Get a fresh
+           native_ip for each context in the chain, recompiling
+           methods if needed. */
+        thisContext =
+         (gst_method_context) OOP_TO_OBJ (_gst_this_context_oop);
+
+        if (!(_gst_this_method->flags & F_XLAT)
+           || thisContext->native_ip == DUMMY_NATIVE_IP)
+         {
+           refresh_native_ips (_gst_this_context_oop);
+           native_ip = GET_CONTEXT_IP (thisContext);
+         }
+
+        if UNCOMMON (time_to_preempt)
+         set_preemption_timer ();
+      }
+
+  if (!IS_NIL (switch_to_process))
+    change_process_context (switch_to_process);
+
+  process = (gst_callin_process) OOP_TO_OBJ (processOOP);
+  if (pop_jmp_buf ())
+    stop_execution ();
+
+  return (process->returnedValue);
 }
diff --git a/libgst/interp.c b/libgst/interp.c
index 14a2913..4ed28a8 100644
--- a/libgst/interp.c
+++ b/libgst/interp.c
@@ -128,10 +128,12 @@ async_queue_entry;
 
 typedef struct interp_jmp_buf
 {
+  jmp_buf jmpBuf;
   struct interp_jmp_buf *next;
-  int suspended;
+  unsigned short suspended;
+  unsigned char interpreter;
+  unsigned char interrupted;
   OOP processOOP;
-  jmp_buf jmpBuf;
 }
 interp_jmp_buf;
 
@@ -218,9 +220,6 @@ OOP _gst_this_method = NULL;
 /* Signal this semaphore at the following instruction.  */
 static OOP single_step_semaphore = NULL;
 
-/* Answer whether we are in the interpreter or in application code.  */
-static mst_Boolean in_interpreter = false;
-
 /* CompiledMethod cache which memoizes the methods and some more
    information for each class->selector pairs.  */
 static method_cache_entry method_cache[METHOD_CACHE_SIZE] CACHELINE_ALIGNED;
@@ -328,17 +327,12 @@ static OOP next_scheduled_process (void);
    CONTEXTOOP context, and answer it.  */
 static OOP create_callin_process (OOP contextOOP);
 
-/* Sets flags so that the interpreter starts returning immediately from
-   whatever byte codes it's executing.  It returns via a normal message
-   send of the unary selector MSG, so that the world is in a consistent 
-   state when it's done.  */
-static void stop_executing (const char *msg);
-
 /* Set a timer at the end of which we'll preempt the current process.  */
 static void set_preemption_timer (void);
 
-/* Same as _gst_parse_stream, but creating a reentrancy_jmpbuf.  */
-static void parse_stream_with_protection (mst_Boolean method);
+/* Same as _gst_parse_stream, but creating a reentrancy_jmpbuf.  Returns
+   true if interrupted. */
+static mst_Boolean parse_stream_with_protection (mst_Boolean method);
 
 /* Put the given process to sleep by rotating the list of processes for
    PROCESSOOP's priority (i.e. it was the head of the list and becomes
@@ -517,54 +511,28 @@ static mst_Boolean unwind_to (OOP returnContextOOP);
    doing a local return.  */
 static mst_Boolean disable_non_unwind_contexts (OOP returnContextOOP);
 
-/* Called to handle signals that are not passed to the Smalltalk
-   program, such as interrupts or segmentation violation.  In the
-   latter case, try to show a method invocation backtrace if possibly,
-   otherwise try to show where the system was in the file it was
-   processing when the error occurred.  */
-static RETSIGTYPE interrupt_handler (int sig);
-
 /* Called to preempt the current process after a specified amount
    of time has been spent in the GNU Smalltalk interpreter.  */
 #ifdef ENABLE_PREEMPTION
 static RETSIGTYPE preempt_smalltalk_process (int sig);
 #endif
 
-/* This macro acts as a block statement (if, for, while); it
-   accepts a pointer to an interp_jmp_buf and executes its body
-   so that the current process is suspended and SIGINT breaks
-   out of it.  */
-#define PROTECT_CURRENT_PROCESS_WITH(jb) \
-  for ((jb)->next = reentrancy_jmp_buf, \
-       (jb)->suspended = 0, \
-       (jb)->processOOP = get_active_process (), \
-       _gst_register_oop ((jb)->processOOP), \
-       reentrancy_jmp_buf = (jb), \
-       in_interpreter = false; \
-       !in_interpreter; \
-       in_interpreter = true, \
-       _gst_unregister_oop ((jb)->processOOP), \
-       reentrancy_jmp_buf = reentrancy_jmp_buf->next) \
-    if (setjmp (reentrancy_jmp_buf->jmpBuf) != 0) \
-      continue; \
-    else \
-
-/* This macro acts as a block statement (if, for, while); it
-   accepts a pointer to an interp_jmp_buf and executes its body
-   so that the current process is not suspended (like in
-   asynchronous C call-outs) but SIGINT breaks out of it.  */
-#define PROTECT_FROM_INTERRUPT_WITH(jb) \
-  for ((jb)->next = reentrancy_jmp_buf, \
-       (jb)->suspended = 0, \
-       (jb)->processOOP = _gst_nil_oop, \
-       reentrancy_jmp_buf = (jb), \
-       in_interpreter = false; \
-       !in_interpreter; \
-       in_interpreter = true, \
-       reentrancy_jmp_buf = reentrancy_jmp_buf->next) \
-    if (setjmp (reentrancy_jmp_buf->jmpBuf) != 0) \
-      continue; \
-    else \
+/* Push an execution state for process PROCESSOOP.  The process is
+   used for two reasons: 1) it is suspended if there is a call-in
+   while the execution state is on the top of the stack; 2) it is
+   sent #userInterrupt if the user presses Ctrl-C.  */
+static void push_jmp_buf (interp_jmp_buf *jb,
+                         int for_interpreter,
+                         OOP processOOP);
+
+/* Pop an execution state.  Return true if the interruption has to
+   be propagated up.  */
+static mst_Boolean pop_jmp_buf (void);
+
+/* Jump out of the top execution state.  This is used by C call-out
+   primitives to jump out repeatedly until a Smalltalk process is
+   encountered and terminated.  */
+static void stop_execution (void);
 
 /* Pick a process that is the highest-priority process different from
    the currently executing one, and schedule it for execution after
@@ -2217,14 +2185,9 @@ _gst_nvmsg_send (OOP receiver,
   /* Re-enable the previously executing process *now*, because a
      primitive might expect the current stack pointer to be that
      of the process that was executing.  */
-  if (reentrancy_jmp_buf && !--reentrancy_jmp_buf->suspended)
+  if (reentrancy_jmp_buf && !--reentrancy_jmp_buf->suspended
+      && !is_process_terminating (reentrancy_jmp_buf->processOOP))
     {
-      if (is_process_terminating (reentrancy_jmp_buf->processOOP))
-       {
-         _gst_errorf ("Process terminated during call-out, VM confused!\n");
-         abort ();
-       }
-
       resume_process (reentrancy_jmp_buf->processOOP, true);
       if (!IS_NIL (switch_to_process))
         change_process_context (switch_to_process);
@@ -2430,80 +2393,31 @@ _gst_restore_object_pointers (void)
   SET_EXCEPT_FLAG (true);      /* force to import registers */
 }
 
-void
-_gst_init_signals (void)
+static RETSIGTYPE
+interrupt_on_signal (int sig)
 {
-  if (!_gst_make_core_file)
+  if (reentrancy_jmp_buf)
+    stop_execution ();
+  else
     {
-#ifdef ENABLE_JIT_TRANSLATION
-      _gst_set_signal_handler (SIGILL, interrupt_handler);
-#endif
-      _gst_set_signal_handler (SIGABRT, interrupt_handler);
+      _gst_set_signal_handler (sig, SIG_DFL);
+      raise (sig);
     }
-  _gst_set_signal_handler (SIGTERM, interrupt_handler);
-  _gst_set_signal_handler (SIGINT, interrupt_handler);
-  _gst_set_signal_handler (SIGFPE, interrupt_handler);
-  _gst_set_signal_handler (SIGUSR1, interrupt_handler);
-}
-
-
-void
-stop_executing (const char *msg)
-{
-  _gst_abort_execution = msg;
-  SET_EXCEPT_FLAG (true);
-  if (reentrancy_jmp_buf)
-    longjmp (reentrancy_jmp_buf->jmpBuf, 1);   /* throw out from C
-                                                  code */
 }
 
-
-RETSIGTYPE
-interrupt_handler (int sig)
+static void
+backtrace_on_signal_1 (mst_Boolean is_serious_error, mst_Boolean c_backtrace)
 {
-  mst_Boolean is_serious_error = true;
-  mst_Boolean in_c_code = !in_interpreter || !ip || _gst_gc_running;
-
-  switch (sig)
-    {
-    case SIGTERM:
-      is_serious_error = false;
-      break;
-
-    case SIGUSR1:
-      is_serious_error = false;
-      _gst_set_signal_handler (sig, interrupt_handler);
-      break;
-
-    case SIGFPE:
-      _gst_set_signal_handler (sig, interrupt_handler);
-      return;
-
-    case SIGINT:
-      is_serious_error = false;
-      if (!_gst_non_interactive && in_interpreter)
-       {
-         _gst_set_signal_handler (sig, interrupt_handler);
-         stop_executing ("userInterrupt");
-         return;
-       }
-      break;
-
-    default:
-      break;
-    }
+  static int reentering = -1;
 
-  if (sig != SIGUSR1)
-    _gst_errorf ("%s", strsignal (sig));
+  /* Avoid recursive signals */
+  reentering++;
 
-  if (!in_c_code)
-    {
-      /* Avoid recursive signals */
-      mst_Boolean save_in_interpreter = in_interpreter;
-      in_interpreter = false;
-      _gst_show_backtrace ();
-      in_interpreter = save_in_interpreter;
-    }
+  if ((reentrancy_jmp_buf && reentrancy_jmp_buf->interpreter)
+      && !reentering
+      && ip
+      && !_gst_gc_running)
+    _gst_show_backtrace ();
   else
     {
       if (is_serious_error)
@@ -2512,8 +2426,7 @@ interrupt_handler (int sig)
 #ifdef HAVE_EXECINFO_H
       /* Don't print a backtrace, for example, if exiting during a
         compilation.  */
-      if ((_gst_verbosity == 3 && (ip || _gst_gc_running))
-         || is_serious_error || sig == SIGUSR1)
+      if (c_backtrace && !reentering)
        {
           PTR array[11];
           size_t size = backtrace (array, 11);
@@ -2522,21 +2435,43 @@ interrupt_handler (int sig)
 #endif
     }
 
-  switch (sig)
-    {
-    case SIGUSR1:
-      return;
+  reentering--;
+}
 
-    case SIGTERM:
-    case SIGINT:
-      exit (0);
+static RETSIGTYPE
+backtrace_on_signal (int sig)
+{
+  _gst_errorf ("%s", strsignal (sig));
+  _gst_set_signal_handler (sig, backtrace_on_signal);
+  backtrace_on_signal_1 (sig != SIGTERM, sig != SIGTERM);
+  _gst_set_signal_handler (sig, SIG_DFL);
+  raise (sig);
+}
 
-    default:
-      _gst_set_signal_handler (sig, SIG_DFL);
-      raise (sig);
+static RETSIGTYPE
+user_backtrace_on_signal (int sig)
+{
+  _gst_set_signal_handler (sig, user_backtrace_on_signal);
+  backtrace_on_signal_1 (false, true);
+}
+
+void
+_gst_init_signals (void)
+{
+  if (!_gst_make_core_file)
+    {
+#ifdef ENABLE_JIT_TRANSLATION
+      _gst_set_signal_handler (SIGILL, backtrace_on_signal);
+#endif
+      _gst_set_signal_handler (SIGABRT, backtrace_on_signal);
     }
+  _gst_set_signal_handler (SIGTERM, backtrace_on_signal);
+  _gst_set_signal_handler (SIGINT, interrupt_on_signal);
+  _gst_set_signal_handler (SIGFPE, SIG_IGN);
+  _gst_set_signal_handler (SIGUSR1, user_backtrace_on_signal);
 }
 
+
 void
 _gst_show_backtrace (void)
 {
@@ -2683,10 +2618,55 @@ _gst_set_primitive_attributes (int primitive, 
prim_table_entry *pte)
 }
 
 void
+push_jmp_buf (interp_jmp_buf *jb, int for_interpreter, OOP processOOP)
+{
+  jb->next = reentrancy_jmp_buf;
+  jb->processOOP = processOOP;
+  jb->suspended = 0;
+  jb->interpreter = for_interpreter;
+  jb->interrupted = false;
+  _gst_register_oop (processOOP);
+  reentrancy_jmp_buf = jb;
+}
+
+mst_Boolean
+pop_jmp_buf (void)
+{
+  interp_jmp_buf *jb = reentrancy_jmp_buf;
+  reentrancy_jmp_buf = jb->next;
+
+  if (jb->interpreter && !is_process_terminating (jb->processOOP))
+    _gst_terminate_process (jb->processOOP);
+    
+  _gst_unregister_oop (jb->processOOP);
+  return jb->interrupted && reentrancy_jmp_buf;
+}
+
+void
+stop_execution (void)
+{
+  reentrancy_jmp_buf->interrupted = true;
+
+  if (reentrancy_jmp_buf->interpreter
+      && !is_process_terminating (reentrancy_jmp_buf->processOOP))
+    {
+      _gst_abort_execution = "userInterrupt";
+      SET_EXCEPT_FLAG (true);
+      if (get_active_process () != reentrancy_jmp_buf->processOOP)
+       resume_process (reentrancy_jmp_buf->processOOP, true);
+    }
+  else
+    longjmp (reentrancy_jmp_buf->jmpBuf, 1);
+}
+
+mst_Boolean
 parse_stream_with_protection (mst_Boolean method)
 {
-  interp_jmp_buf localJmpBuf;
+  interp_jmp_buf jb;
 
-  PROTECT_CURRENT_PROCESS_WITH (&localJmpBuf)
+  push_jmp_buf (&jb, false, get_active_process ());
+  if (setjmp (jb.jmpBuf) == 0)
     _gst_parse_stream (method);
+
+  return pop_jmp_buf ();
 }
diff --git a/libgst/prims.def b/libgst/prims.def
index 796026a..b456e34 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -5036,6 +5036,7 @@ primitive VMpr_Behavior_primCompile [succeed]
 {
   OOP oop1;
   OOP oop2;
+  mst_Boolean interrupted;
   _gst_primitives_executed++;
 
   oop2 = POP_OOP ();
@@ -5047,9 +5048,13 @@ primitive VMpr_Behavior_primCompile [succeed]
 
   _gst_set_compilation_class (oop1);
   _gst_set_compilation_category (_gst_string_new ("still unclassified"));
-  parse_stream_with_protection (true);
+  interrupted = parse_stream_with_protection (true);
   _gst_pop_stream (true);
   PUSH_OOP (_gst_latest_compiled_method);
+
+  if (interrupted)
+    stop_execution ();
+
   PRIM_SUCCEEDED;
 }
 
@@ -5067,6 +5072,7 @@ primitive VMpr_Behavior_primCompileIfError 
[fail,succeed,reload_ip]
   if (IS_CLASS (oop3, _gst_block_closure_class))
     {
       mst_Boolean oldReportErrors = _gst_report_errors;
+      mst_Boolean interrupted;
 
       if (oldReportErrors)
        {
@@ -5081,12 +5087,17 @@ primitive VMpr_Behavior_primCompileIfError 
[fail,succeed,reload_ip]
 
       _gst_set_compilation_class (oop1);
       _gst_set_compilation_category (_gst_string_new ("still unclassified"));
-      parse_stream_with_protection (true);
+      interrupted = parse_stream_with_protection (true);
       _gst_pop_stream (true);
+      _gst_report_errors = oldReportErrors;
+      PUSH_OOP (_gst_latest_compiled_method);
 
-      if (_gst_first_error_str != NULL)
+      if (interrupted)
+        stop_execution ();
+
+      else if (_gst_first_error_str != NULL)
        {
-         PUSH_OOP (oop3);      /* block context */
+         SET_STACKTOP (oop3);  /* block context */
          if (_gst_first_error_file != NULL)
            {
              PUSH_OOP (_gst_string_new (_gst_first_error_file));
@@ -5105,11 +5116,7 @@ primitive VMpr_Behavior_primCompileIfError 
[fail,succeed,reload_ip]
          else
            PRIM_SUCCEEDED_RELOAD_IP;
        }
-      else
-       {
-         _gst_report_errors = oldReportErrors;
-         PUSH_OOP (_gst_latest_compiled_method);
-       }
+
       PRIM_SUCCEEDED;
     }
   UNPOP (3);
@@ -5162,8 +5169,7 @@ primitive VMpr_ObjectMemory_snapshot [succeed,fail]
   oop2 = POP_OOP ();
   if (IS_CLASS (oop2, _gst_string_class))
     {
-      interp_jmp_buf localJmpBuf;
-      mst_Boolean success = false;
+      mst_Boolean success;
       fileName = _gst_to_cstring (oop2);
       errno = 0;
 
@@ -5171,9 +5177,7 @@ primitive VMpr_ObjectMemory_snapshot [succeed,fail]
         the save, the stack will be in this state. See below. */
       SET_STACKTOP (_gst_true_oop);
 
-      PROTECT_CURRENT_PROCESS_WITH (&localJmpBuf)
-       success = _gst_save_to_file (fileName);
-      
+      success = _gst_save_to_file (fileName);
       xfree (fileName);
       if (success)
        {
@@ -5232,17 +5236,19 @@ primitive VMpr_Stream_fileInLine [succeed,fail]
       && (IS_NIL (oop3)
          || (IS_CLASS (oop3, _gst_string_class) && IS_INT (oop4))))
     {
-      intptr_t arg1;
-      intptr_t arg4;
-      arg1 = TO_INT (oop1);
-      arg4 = TO_INT (oop4);
+      mst_Boolean interrupted;
+      intptr_t arg1 = TO_INT (oop1);
+      intptr_t arg4 = TO_INT (oop4);
 
       _gst_push_stream_oop (streamOOP);
       _gst_set_stream_info (arg1, oop2, oop3, arg4);
       old = _gst_set_undeclared (UNDECLARED_GLOBALS);
-      parse_stream_with_protection (false);
+      interrupted = parse_stream_with_protection (false);
       _gst_set_undeclared (old);
       _gst_pop_stream (false);
+      if (interrupted)
+       stop_execution ();
+
       PRIM_SUCCEEDED;
     }
 
@@ -5771,10 +5777,10 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
 
 primitive VMpr_CFuncDescriptor_asyncCall [succeed,fail]
 {
-  volatile OOP result = NULL;
+  OOP resultOOP;
   volatile gst_method_context context;
   OOP contextOOP, cFuncOOP, receiverOOP;
-  interp_jmp_buf localJmpBuf;
+  interp_jmp_buf jb;
 
   _gst_primitives_executed++;
 
@@ -5792,11 +5798,20 @@ primitive VMpr_CFuncDescriptor_asyncCall [succeed,fail]
     }
 
   cFuncOOP = STACKTOP ();
-  PROTECT_FROM_INTERRUPT_WITH (&localJmpBuf)
-    result = _gst_invoke_croutine (cFuncOOP, receiverOOP,
-                                   context->contextStack);
+  push_jmp_buf (&jb, false, _gst_nil_oop);
+  if (setjmp (jb.jmpBuf) == 0)
+    resultOOP = _gst_invoke_croutine (cFuncOOP, receiverOOP,
+                                  context->contextStack);
+  else
+    resultOOP = NULL;
+
+  if (pop_jmp_buf ())
+    {
+      stop_execution ();
+      PRIM_SUCCEEDED;
+    }
 
-  if (result)
+  else if (resultOOP)
     {
       SET_EXCEPT_FLAG (true);
       PRIM_SUCCEEDED;
@@ -5809,15 +5824,15 @@ primitive VMpr_CFuncDescriptor_asyncCall [succeed,fail]
 
 primitive VMpr_CFuncDescriptor_call [succeed,fail]
 {
-  volatile OOP result = NULL;          /* initialize to please GCC */
   volatile gst_method_context context;
-  gst_object resultObj;
-  OOP receiverOOP, contextOOP, resultOOP, cFuncOOP;
-  interp_jmp_buf localJmpBuf;
+  gst_object resultHolderObj;
+  OOP receiverOOP, contextOOP, cFuncOOP, resultOOP;
+  volatile OOP resultHolderOOP;
+  interp_jmp_buf jb;
 
   _gst_primitives_executed++;
 
-  resultOOP = POP_OOP ();
+  resultHolderOOP = POP_OOP ();
   if (numArgs == 2)
     {
       contextOOP = POP_OOP ();
@@ -5835,18 +5850,27 @@ primitive VMpr_CFuncDescriptor_call [succeed,fail]
 
   /* Make the result reachable, and also push it before the
      active process can change.  */
-  PUSH_OOP (resultOOP);
+  PUSH_OOP (resultHolderOOP);
 
-  PROTECT_CURRENT_PROCESS_WITH (&localJmpBuf)
-    result = _gst_invoke_croutine (cFuncOOP, receiverOOP,
-                                  context->contextStack);
+  push_jmp_buf (&jb, false, get_active_process ());
+  if (setjmp (jb.jmpBuf) == 0)
+    resultOOP = _gst_invoke_croutine (cFuncOOP, receiverOOP,
+                                     context->contextStack);
+  else
+    resultOOP = NULL;
+
+  if (pop_jmp_buf ())
+    {
+      stop_execution ();
+      PRIM_SUCCEEDED;
+    }
 
-  if (result)
+  else if (resultOOP)
     {
-      if (!IS_NIL (resultOOP))
+      if (!IS_NIL (resultHolderOOP))
        {
-          resultObj = OOP_TO_OBJ (resultOOP);
-          resultObj->data[0] = result;
+          resultHolderObj = OOP_TO_OBJ (resultHolderOOP);
+          resultHolderObj->data[0] = resultOOP;
        }
       SET_EXCEPT_FLAG (true);
       PRIM_SUCCEEDED;
@@ -5857,7 +5881,7 @@ primitive VMpr_CFuncDescriptor_call [succeed,fail]
   PUSH_OOP (cFuncOOP);
   if (numArgs == 2)
     PUSH_OOP (contextOOP);
-  PUSH_OOP (resultOOP);
+  PUSH_OOP (resultHolderOOP);
   PRIM_FAILED;
 }