[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] Re: Trying to test Seaside on MacOS
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] Re: Trying to test Seaside on MacOS |
Date: |
Wed, 04 Jun 2008 14:35:38 +0200 |
User-agent: |
Thunderbird 2.0.0.14 (Macintosh/20080421) |
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;
}
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, (continued)
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Giuseppe Luigi Punzi Ruiz, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Paolo Bonzini, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Giuseppe Luigi Punzi Ruiz, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Paolo Bonzini, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Giuseppe Luigi Punzi Ruiz, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Paolo Bonzini, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Giuseppe Luigi Punzi Ruiz, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Giuseppe Luigi Punzi Ruiz, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Paolo Bonzini, 2008/06/03
- Re: [Help-smalltalk] Trying to test Seaside on MacOS, Giuseppe Luigi Punzi Ruiz, 2008/06/03
- [Help-smalltalk] Re: Trying to test Seaside on MacOS,
Paolo Bonzini <=