help-smalltalk
[Top][All Lists]
Advanced

[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;
            }
 

reply via email to

[Prev in Thread] Current Thread [Next in Thread]