These are the changes needed to make the debugger work with the new GTK
event loop. Gwen confirmed that Iliad works under VisualGST with the
first patch I posted, but the debugger was broken (he also had hacks in
his patch to fix this).
In the old event loop, the debugger worked more or less by chance
because it went into a busy wait processing GTK events. Now instead we
must return from whatever GTK event we were processing (returning nil
seems to work) so that g_main_context_dispatch can keep running. Doing
this requires implementing a nice CallinProcess>>#detach method that
changes the CallinProcess into a Process and continues the work there.
In the meanwhile, I fixed a few bugs in UnhandledException that popped
up while testing. We are very very close to removing the old
instance-based (VisualAge-inspired) exception handling system.
All that's missing is GtkDialog>>#run, then we're good to go. Gwen,
would you take a look at that?
Paolo
2010-02-19 Paolo Bonzini <[email protected]>
* kernel/CallinProcess.st: Add #detach and #returnContext.
* kernel/Process.st: Add #suspendedContext:.
* kernel/ExcHandling.st: Move #instantiateNextHandler:from:
to Signal and rename it. Extract #instantiateDefaultHandler.
* kernel/AnsiExcept.st: Use #instantiateNextHandlerFrom:.
Override #instantiateDefaultHandler for UnhandledException.
* kernel/AnsiExcept.st: Add InvalidState.
libgst:
2010-02-19 Paolo Bonzini <[email protected]>
* libgst/vm.def: Make EXIT_INTERPRETER safer since we now can fork
CallinProcesses to Processes.
* libgst/comp.c: Compile the termination method with an infinite
loop to avoid falling off the last context.
diff --git a/kernel/AnsiExcept.st b/kernel/AnsiExcept.st
index adb4bef..308f36c 100644
--- a/kernel/AnsiExcept.st
+++ b/kernel/AnsiExcept.st
@@ -212,7 +212,7 @@ CoreException, so the two mechanisms are actually
interchangeable.'>
"Raise the exceptional event represented by the receiver"
<category: 'exception signaling'>
- self exception instantiateNextHandler: self from: thisContext.
+ self instantiateNextHandlerFrom: thisContext.
^self activateHandler: (onDoBlock isNil and: [ self isResumable ])
]
@@ -687,6 +687,29 @@ Error subclass: InvalidValue [
Namespace current: SystemExceptions [
+InvalidValue subclass: InvalidState [
+ | value |
+
+ <category: 'Language-Exceptions'>
+ <comment: 'I am raised when one invokes a method and the receiver or an
argument
+are in an invalid state for the method.'>
+
+ messageText [
+ "Answer an exception's message text."
+
+ <category: 'accessing'>
+ ^'%1 is in an invalid state: %2' %
+ {self value.
+ self basicMessageText}
+ ]
+]
+
+]
+
+
+
+Namespace current: SystemExceptions [
+
InvalidValue subclass: NotIndexable [
<category: 'Language-Exceptions'>
@@ -1535,6 +1558,29 @@ current process.'>
thisContext environment continue: nil
]
+ instantiateDefaultHandler [
+ "Private - Fill the receiver with information on its default handler."
+
+ <category: 'private'>
+ | signalingContext resumeContext |
+
+ "This exception is kind of special, as we forcedly have to find
+ a place to resume---even if the exception was not resumable!
+ This typically will happens when the user steps out of the
+ exception handling gobbledegook in the debugger."
+ signalingContext := thisContext.
+ [resumeContext := signalingContext parentContext.
+ resumeContext isEnvironment not
+ and: [resumeContext isInternalExceptionHandlingContext]]
+ whileTrue: [signalingContext := resumeContext].
+
+ self
+ onDoBlock: nil
+ handlerBlock: self exception actualDefaultHandler
+ onDoContext: signalingContext
+ previousState: nil
+ ]
+
originalException [
"Answer the uncaught exception."
diff --git a/kernel/CallinProcess.st b/kernel/CallinProcess.st
index 60aa482..d43826a 100644
--- a/kernel/CallinProcess.st
+++ b/kernel/CallinProcess.st
@@ -39,5 +39,38 @@ Process subclass: CallinProcess [
execution, so I must store the returned value once my computation
terminates and I must not survive across image saves (since those who
invoked me no longer exist). I am otherwise equivalent to a Process.'>
+
+ returnContext [
+ "Return the base context in the process, i.e. the one that is
+ responsible for passing the return value to C."
+
+ | context |
+ context := self context.
+ [ context parentContext isNil ] whileFalse: [
+ context := context parentContext ].
+ ^context
+ ]
+
+ detach [
+ "Continue running the receiver as a normal Process, and return
+ nil from the callin."
+ | p |
+ self isActive ifFalse: [
+ ^SystemExceptions.InvalidState signalOn: self
+ reason: 'process not active' ].
+
+ p := Process basicNew.
+ Link instSize + 1 to: Process instSize do: [ :i |
+ p instVarAt: i put: (self instVarAt: i) ].
+
+ "Start executing the detached process from here."
+ p suspendedContext: thisContext copy.
+
+ Processor activeProcess == self ifTrue: [
+ "This only runs in the CallinProcess."
+ thisContext parentContext: self returnContext.
+ p resume.
+ ^nil ]
+ ]
]
diff --git a/kernel/ExcHandling.st b/kernel/ExcHandling.st
index f30cbb3..6a8b51b 100644
--- a/kernel/ExcHandling.st
+++ b/kernel/ExcHandling.st
@@ -230,7 +230,7 @@ hold on to a CoreException via a class-instance variable.'>
signal := (signalClass new)
initArguments: #();
initException: self.
- self instantiateNextHandler: signal from: thisContext.
+ signal instantiateNextHandlerFrom: thisContext.
^signal activateHandler: false
]
@@ -244,7 +244,7 @@ hold on to a CoreException via a class-instance variable.'>
signal := (signalClass new)
initArguments: {arg};
initException: self.
- self instantiateNextHandler: signal from: thisContext.
+ signal instantiateNextHandlerFrom: thisContext.
^signal activateHandler: false
]
@@ -261,7 +261,7 @@ hold on to a CoreException via a class-instance variable.'>
{arg.
arg2};
initException: self.
- self instantiateNextHandler: signal from: thisContext.
+ signal instantiateNextHandlerFrom: thisContext.
^signal activateHandler: false
]
@@ -276,7 +276,7 @@ hold on to a CoreException via a class-instance variable.'>
signal := (signalClass new)
initArguments: args;
initException: self.
- self instantiateNextHandler: signal from: thisContext.
+ signal instantiateNextHandlerFrom: thisContext.
^signal activateHandler: false
]
@@ -330,26 +330,6 @@ hold on to a CoreException via a class-instance variable.'>
depth := anInteger
]
- instantiateNextHandler: aSignal from: aContext [
- "Private - Tell aSignal what it needs on the next handler for the
receiver.
- If none is found, look for an handler for our parent, until one
- is found or ExAll if reached and there is no handler. In this case,
answer
- the default handler for anException."
-
- <category: 'private'>
- aContext parentContext scanBacktraceForAttribute:
#exceptionHandlerSearch:reset:
- do:
- [:context :attr |
- | status |
- status := (attr arguments at: 1) value: context value: aSignal.
- status == #found ifTrue: [^self]].
- aSignal
- onDoBlock: nil
- handlerBlock: self actualDefaultHandler
- onDoContext: nil
- previousState: nil
- ]
-
actualDefaultHandler [
"Private - Answer the default handler for the receiver. It differs from
#defaultHandler because if the default handler of the parent has to be
@@ -556,6 +536,32 @@ with a lower priority.'>
^self exception isResumable
]
+ instantiateNextHandlerFrom: aContext [
+ "Private - Fill the receiver with information on the next handler for
+ it, possibly a handler for a parent or the default handler."
+
+ <category: 'private'>
+ aContext parentContext scanBacktraceForAttribute:
#exceptionHandlerSearch:reset:
+ do:
+ [:context :attr |
+ | status |
+ status := (attr arguments at: 1) value: context value: self.
+ status == #found ifTrue: [^self]].
+
+ self instantiateDefaultHandler.
+ ]
+
+ instantiateDefaultHandler [
+ "Private - Fill the receiver with information on its default handler."
+
+ <category: 'private'>
+ self
+ onDoBlock: nil
+ handlerBlock: self exception actualDefaultHandler
+ onDoContext: nil
+ previousState: nil
+ ]
+
outer [
"Raise the exception that instantiated the receiver, passing the same
parameters.
@@ -570,7 +576,7 @@ with a lower priority.'>
| signal |
signal := self copy.
signal isNested: true.
- self exception instantiateNextHandler: signal from: self context.
+ signal instantiateNextHandlerFrom: self context.
^signal activateHandler: true
]
@@ -584,7 +590,7 @@ with a lower priority.'>
| signal |
signal := self copy.
signal isNested: true.
- self exception instantiateNextHandler: signal from: self context.
+ signal instantiateNextHandlerFrom: self context.
^self return: (signal activateHandler: true)
]
@@ -641,8 +647,7 @@ with a lower priority.'>
<category: 'exception handling'>
Kernel.CoreException resetAllHandlers.
- replacementException exception
- instantiateNextHandler: replacementException from: thisContext.
+ replacementException instantiateNextHandlerFrom: thisContext.
^replacementException return: (replacementException activateHandler:
true)
]
@@ -746,7 +751,7 @@ with a lower priority.'>
"Mark the handler that the receiver is using as not active."
<category: 'private'>
- context isNil
+ onDoBlock isNil
ifFalse: [context at: context numArgs + 1 put: previousState]
]
diff --git a/kernel/Process.st b/kernel/Process.st
index d948d35..3f76f92 100644
--- a/kernel/Process.st
+++ b/kernel/Process.st
@@ -223,6 +223,14 @@ can suspend themselves and resume themselves however they
wish.'>
^suspendedContext
]
+ suspendedContext: aContext [
+ "Modify the context that the process was executing at the time it was
+ suspended."
+
+ <category: 'accessing'>
+ suspendedContext := aContext
+ ]
+
name [
"Answer the user-friendly name of the process."
diff --git a/libgst/comp.c b/libgst/comp.c
index 44083c7..5761ea5 100644
--- a/libgst/comp.c
+++ b/libgst/comp.c
@@ -451,7 +451,7 @@ _gst_install_initial_methods (void)
_gst_set_compilation_category (_gst_string_new ("private"));
_gst_alloc_bytecodes ();
_gst_compile_byte (EXIT_INTERPRETER, 0);
- _gst_compile_byte (RETURN_CONTEXT_STACK_TOP, 0);
+ _gst_compile_byte (JUMP_BACK, 4);
/* The zeros are primitive, # of args, # of temps, stack depth */
termination_method = _gst_make_new_method (0, 0, 0, 0, _gst_nil_oop,
diff --git a/libgst/vm.def b/libgst/vm.def
index 7a6760f..618f6b8 100644
--- a/libgst/vm.def
+++ b/libgst/vm.def
@@ -925,7 +925,8 @@ operation EXIT_INTERPRETER ( val -- val ) {
if (IS_NIL (activeProcessOOP))
abort ();
- process->returnedValue = val;
+ if (process->objClass == _gst_callin_process_class)
+ process->returnedValue = val;
_gst_terminate_process (activeProcessOOP);
if (processOOP == activeProcessOOP)
SET_EXCEPT_FLAG (true);
diff --git a/packages/visualgst/Debugger/GtkDebugger.st
b/packages/visualgst/Debugger/GtkDebugger.st
index 6966583..87f6418 100644
--- a/packages/visualgst/Debugger/GtkDebugger.st
+++ b/packages/visualgst/Debugger/GtkDebugger.st
@@ -12,6 +12,13 @@ GtkMainWindow subclass: GtkDebugger [
GtkDebugger class >> open: aString [
<category: 'user interface'>
+ Processor activeProcess class == CallinProcess ifTrue: [
+ "The current process might be processing an event. Gtk will
+ block inside g_main_loop_dispatch and won't deliver any
+ other events until this one is processed. So, fork into a
+ new process and return nil without executing #ensure: blocks."
+ Processor activeProcess detach ].
+
[ :debugger |
Processor activeProcess name: 'Notifier/Debugger'.
(self openSized: 1...@600)
_______________________________________________
help-smalltalk mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/help-smalltalk
