[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] Rewrite unhandled exception handling
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] [PATCH] Rewrite unhandled exception handling |
Date: |
Tue, 01 Apr 2008 10:49:33 +0200 |
User-agent: |
Thunderbird 2.0.0.12 (Macintosh/20080213) |
Very old code was surviving here. We can (more elegantly) raise a
special exception when we find an unhandled exception. The default
handler will terminate the code.
All the stuff here is heavily tested by the testsuite.
I'm not yet removing the "unwindPoints" instance variables from Process
(I will actually rename it soon to provide thread-local variables, which
are needed by more recent versions of Seaside than the one currently
distributed).
Paolo
2008-04-01 Paolo Bonzini <address@hidden>
* kernel/AnsiExcept.st: Add UnhandledException.
* kernel/ContextPart.st: Rewrite #unwind: to raise UnhandledException.
Use #isEnvironment to delimit stack scanning.
* kernel/BlkClosure.st: Rewrite #valueWithUnwind to trap
UnhandledException.
* kernel/MthContext.st: Rewrite #mark.
* libgst/interp.c: Correct output for execution environment contexts
that have a parent.
diff --git a/kernel/AnsiExcept.st b/kernel/AnsiExcept.st
index 4b71afd..6cf038d 100644
--- a/kernel/AnsiExcept.st
+++ b/kernel/AnsiExcept.st
@@ -305,7 +305,6 @@ even though it is not to be considered an error.'
]
]
-
Error subclass: Halt [
@@ -1419,6 +1418,33 @@ of concrete subclass.'>
+Namespace current: SystemExceptions [
+
+Exception subclass: UnhandledException [
+
+ <category: 'Language-Exception'>
+ <comment: 'I am raised when a backtrace is shown to terminate the
+current process.'>
+
+ description [
+ "Answer a textual description of the exception."
+
+ <category: 'accessing'>
+ ^'an unhandled exception occurred in the current process'
+ ]
+
+ defaultAction [
+ "Terminate the currrent process."
+
+ <category: 'accessing'>
+ thisContext environment continue: self tag
+ ]
+]
+
+]
+
+
+
Number extend [
arithmeticError: msg [
diff --git a/kernel/BlkClosure.st b/kernel/BlkClosure.st
index 6e7bca3..0b45506 100644
--- a/kernel/BlkClosure.st
+++ b/kernel/BlkClosure.st
@@ -304,7 +304,7 @@ creation of Processes from blocks.'>
<category: 'unwind protection'>
thisContext mark.
- ^[self value] ensure: [ContextPart removeLastUnwindPoint]
+ ^self value
]
repeat [
diff --git a/kernel/ContextPart.st b/kernel/ContextPart.st
index 4eecb97..7e80acf 100644
--- a/kernel/ContextPart.st
+++ b/kernel/ContextPart.st
@@ -68,31 +68,6 @@ methods that can be used in inspection or debugging.'>
thisContext parentContext backtraceOn: aStream
]
- ContextPart class >> removeLastUnwindPoint [
- "Private - Return and remove the last context marked as an unwind point,
- or our environment if the last unwind point belongs to another
- environment."
-
- <category: 'exception handling'>
- | unwindPoints |
- unwindPoints := Processor activeProcess unwindPoints.
- ^unwindPoints isEmpty
- ifTrue: [thisContext environment]
- ifFalse: [unwindPoints removeLast]
- ]
-
- ContextPart class >> lastUnwindPoint [
- "Private - Return the last context marked as an unwind point, or
- our environment if none is."
-
- <category: 'exception handling'>
- | unwindPoints |
- unwindPoints := Processor activeProcess unwindPoints.
- ^unwindPoints isEmpty
- ifTrue: [thisContext environment]
- ifFalse: [unwindPoints at: unwindPoints size]
- ]
-
ContextPart class >> unwind [
"Return execution to the last context marked as an unwind point,
returning
nil on that stack."
@@ -102,17 +77,13 @@ methods that can be used in inspection or debugging.'>
]
ContextPart class >> unwind: returnValue [
- "Return execution to the last context marked as an unwind point,
returning
- returnValue on that stack."
+ "Return execution to the innermost #valueWithUnwind call, passing it
+ returnValue."
<category: 'exception handling'>
- | point |
- point := self removeLastUnwindPoint.
- point isProcess
- ifTrue:
- [Processor terminateActive
- "Bye bye, we never get past here."].
- point continue: returnValue
+ SystemExceptions.UnhandledException new
+ tag: returnValue;
+ signal
]
ContextPart class >> thisContext [
@@ -171,14 +142,13 @@ methods that can be used in inspection or debugging.'>
<category: 'debugging'>
| ctx debuggerClass currentClass last |
ctx := self.
- last := self class lastUnwindPoint.
[currentClass := ctx receiver class debuggerClass.
currentClass isNil ifTrue: [^nil].
(debuggerClass isNil
or: [currentClass debuggingPriority > debuggerClass
debuggingPriority])
ifTrue: [debuggerClass := currentClass].
- ctx == last | ctx isNil]
+ ctx isNil or: [ctx isEnvironment]]
whileFalse: [ctx := ctx parentContext].
^debuggerClass
]
@@ -419,13 +389,6 @@ methods that can be used in inspection or debugging.'>
^nativeIP ~~ 0
]
- mark [
- "Add the receiver as a possible unwind point"
-
- <category: 'exception handling'>
- Processor activeProcess unwindPoints addLast: self
- ]
-
deepCopy [
"Answer a copy of the entire stack, but don't copy any
of the other instance variables of the context."
@@ -451,10 +414,9 @@ methods that can be used in inspection or debugging.'>
context and the attribute."
<category: 'enumerating'>
- | ctx last attr |
+ | ctx attr |
ctx := self.
- last := self class lastUnwindPoint.
- [ctx == last | ctx isNil] whileFalse:
+ [ctx isNil or: [ctx isEnvironment]] whileFalse:
[(ctx isBlock not and:
[attr := ctx method attributeAt: selector ifAbsent:
[nil].
attr notNil])
@@ -468,10 +430,9 @@ methods that can be used in inspection or debugging.'>
context."
<category: 'enumerating'>
- | ctx last |
+ | ctx |
ctx := self.
- last := self class lastUnwindPoint.
- [ctx == last | ctx isNil] whileFalse:
+ [ctx isNil or: [ctx isEnvironment]] whileFalse:
[(ctx isBlock not and: [selectors includes: ctx selector])
ifTrue: [aBlock value: ctx].
ctx := ctx parentContext]
diff --git a/kernel/MthContext.st b/kernel/MthContext.st
index e9d15a5..7476812 100644
--- a/kernel/MthContext.st
+++ b/kernel/MthContext.st
@@ -117,6 +117,16 @@ execution stack.'>
^(flags bitAnd: 4) == 4
]
+ mark [
+ "To create a valid execution environment for the interpreter even
+ before it starts, GST creates a fake context which invokes a special
+ ``termination'' method. A similar context is created by
+ #valueWithUnwind, by using this method."
+
+ <category: 'accessing'>
+ flags := flags bitOr: 4
+ ]
+
sender [
"Return the context from which the receiver was sent"
diff --git a/libgst/interp.c b/libgst/interp.c
index ccee27b..18d2573 100644
--- a/libgst/interp.c
+++ b/libgst/interp.c
@@ -2563,7 +2563,7 @@ _gst_show_backtrace (void)
if (IS_NIL(context->parentContext))
printf ("<bottom>\n");
else
- printf ("<call-in>\n");
+ printf ("<unwind point>\n");
continue;
}
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] Rewrite unhandled exception handling,
Paolo Bonzini <=