added GenericException in-between, to allow for some exceptions
to be cousins of Exception (UnhandledException and Interrupts)
--- a/Exception.st Sat Jul 31 18:12:36 1999 +0200
+++ b/Exception.st Sat Jul 31 18:22:47 1999 +0200
@@ -10,24 +10,13 @@
hereby transferred.
"
-Object subclass:#Exception
- instanceVariableNames:'signal parameter errorString suspendedContext handlerContext
- rejected originator resumeBlock rejectBlock proceedable
- handlingSignal'
- classVariableNames:'EmergencyHandler RecursiveExceptionSignal'
+GenericException subclass:#Exception
+ instanceVariableNames:''
+ classVariableNames:''
poolDictionaries:''
category:'Kernel-Exceptions'
!
-Exception class instanceVariableNames:'NotifierString'
-
-"
- The following class instance variables are inherited by this class:
-
- Object -
-"
-!
-
!Exception class methodsFor:'documentation'!
copyright
@@ -46,1890 +35,8 @@
documentation
"
- Exception and its subclasses implement the same protocol as Signal.
- So class based exceptions may be implemented as subclasses of Exception.
-
- Instances of Exception are passed to a Signal handling block as argument.
- The handler block may perform various actions by sending corresponding messages
- to the exception object. The following actions are possible:
-
- reject - don't handle this signal;
- another handler will be searched for,
- upper in the calling hierarchy
-
- proceed - return from the Signal>>raise, with nil as value
-
- proceedWith:val - same, but return val from Signal>>raise
-
- return - return from the Signal>>handle:do:, with nil as value
-
- returnWith:val - same, but return val from Signal>>handle:do:
- (this is also the handlers default,
- if it falls through; taking the handlerBlocks value
- as return value)
-
- restart - restart the Signal>>handle:do:, after repairing
-
- Via the Exception object, the handler can also query the state of execution:
- where the Signal was raised, where the handler is, the signal which caused
- the error and the errorString passed when the signal was raised. Also, an optional
- parameter can be passed - the use is signal specific.
-
- [instance variables:]
- signal <Signal> the signal which caused the exception
-
- parameter <Object> a parameter (if any) which was passed when raising
- the signal (only if raised with #raiseWith:aParameter)
-
- errorString <String> an errorString
- (usually the signals own errorString, but sometimes
- changed explicitely in #raiseWith:errorString:)
-
- suspendedContext <Context> the context in which the raise occured
-
- handlerContext <Context> the context of the handler (if any)
-
- resumeBlock <Block> private to the exception; needed to perform resume action
-
- rejectBlock <Block> private to the exception; needed to perform reject action
-
- In case of an unhandled signal raise, Exceptions EmergenyHandler will be evaluated.
- The default emergeny handler will enter the debugger.
-
- For applications, which do not want Debuggers to come up, other handlers are
- possible.
- For example, to get the typical C++ behavior, use:
- Exception emergencyHandler:[:ex | Smalltalk exitWithCoreDump]
-
-
- [Class variables:]
- EmergencyHandler <Block> this block is evaluated, if no handler was defined
- for a signal (i.e. this one is responsible for the
- unhandled exception debugger).
- Having this being a block allows to globally catch
- these errors - even when no enclosing handler-scope
- around the erronous code exists.
- (as the catch/through does).
-
- RecursiveExceptionSignal
- <Signal> raised when within a handler for some signal,
- the same signal is raised again.
-
-
- [see also:]
- Signal SignalSet QuerySignal
- Context Block
- Object DebugView
- (``Exception handling and signals'': programming/exceptions.html)
-
- [author:]
- Claus Gittinger
-"
-!
-
-examples
-"
- Examples on Exception-raising & handling are found in the doc/coding
- section (CodingExamples).
-
- The emergencyHandler stuff is very useful, to prevent endUser applications
- from entering the debugger.
- Some commonly used (useful) emergency handlers are provided in the
- 'useful handlers' section; try them to learn more
- (especially, the mailingHandler is fun).
-
- Of course, these are only examples - you may define your own handler
- block and pass it to the #emergencyHandler: method.
-
- BTW: the Launchers 'source & debugger' settings menu allows you
- to install either a default or the notifying handler.
-
-
- A handler which shows a box, then aborts - (no more debuggers):
- [exBegin]
- Exception emergencyHandler:(Exception abortingEmergencyHandler)
- [exEnd]
-
-
- A handler which aborts - (no box, no debugger):
- [exBegin]
- Exception emergencyHandler:[:ex | AbortSignal raise]
- [exEnd]
-
-
- try some exception (for demonstration, in some other process):
- [exBegin]
- [
- #(1 2 3) at:4
- ] fork.
- [exEnd]
-
- cleanup (switch back to the regular handler, which enters the debugger):
- [exBegin]
- Exception emergencyHandler:nil
- [exEnd]
-
-
- A handler which shows a warnBox and asks for debugging:
- [exBegin]
- Exception emergencyHandler:(Exception notifyingEmergencyHandler)
- [exEnd]
-
-
-
- A handler which dumps information to a file (watch the file 'errorTrace.stx'):
- [exBegin]
- Exception emergencyHandler:(Exception dumpingEmergencyHandler)
- [exEnd]
-
-
-
- A handler which sends you mail:
- [exBegin]
- Exception emergencyHandler:(Exception mailingEmergencyHandler)
- [exEnd]
+ all logic moved to GenericException,
+ to allow for some exceptions (UnhandledExceptionException and
+ Interrupts) to be not a parent of Exception.
"
! !
-
-!Exception class methodsFor:'initialization'!
-
-initialize
- "setup the signal used to handle unhandled signals"
-
- RecursiveExceptionSignal isNil ifTrue:[
- RecursiveExceptionSignal := ErrorSignal newSignalMayProceed:false.
- RecursiveExceptionSignal nameClass:self message:#recursiveExceptionSignal.
- RecursiveExceptionSignal notifierString:'recursive signal raise in handler'
- ]
-! !
-
-!Exception class methodsFor:'instance creation'!
-
-signal:aSignal originator:origin
- "create a new instance and set the fields in preparation for a raise.
- - only to be sent from the signal when raising"
-
- "{ Pragma: +inlineNew }"
-
- ^ (self basicNew) signal:aSignal originator:origin.
-
- "Created: / 23.7.1999 / 13:40:45 / stefan"
-!
-
-signal:aSignal parameter:aParameter errorString:aString suspendedContext:sContext originator:origin
- "create a new instance and set the fields in preparation for a raise.
- - only to be sent from the signal when raising"
-
- "{ Pragma: +inlineNew }"
-
- ^ (self basicNew)
- signal:aSignal
- parameter:aParameter
- errorString:aString
- suspendedContext:sContext
- originator:origin.
-! !
-
-!Exception class methodsFor:'Signal constants'!
-
-recursiveExceptionSignal
- "return the signal used to handle recursive signals in the handlers"
-
- ^ RecursiveExceptionSignal
-! !
-
-!Exception class methodsFor:'compatibility - accessing'!
-
-errorString
- "return the notifier string.
- If the notifier string starts with space, prepend
- the parents notifier string"
-
- NotifierString isNil ifTrue:[
- ^ self parent errorString
- ] ifFalse:[
- (NotifierString size > 0
- and:[NotifierString first == (Character space)]) ifTrue:[
- ^ self parent errorString, NotifierString
- ] ifFalse:[
- ^ NotifierString
- ].
- ]
-
- "
- Object errorSignal errorString
- "
-
- "Created: / 23.7.1999 / 14:22:25 / stefan"
-!
-
-errorStringExtra:extraString with:aParameter
- "used when raising with a given error string and/or parameter;
- if the errorString starts with a space, it is appended to the receivers
- notifier string; if it ends with a space, it is prepended.
- Otherwise, the extraString is returned.
- If no extraString is given, use the signals default errorString."
-
- |t|
-
- (self inheritsFrom:Object userNotificationSignal) ifTrue:[
- "/ all userNotifications pass the extraString unchanged.
- ^ extraString
- ].
-
- extraString isNil ifTrue:[
- t := self errorString
- ] ifFalse:[
- t := extraString.
- (extraString endsWith:Character space) ifTrue:[
- t := extraString, self errorString
- ] ifFalse:[
- (extraString startsWith:Character space) ifTrue:[
- t := self errorString, extraString
- ]
- ].
- ].
- ^ t.
-
-"/ aParameter isNil ifTrue:[
-"/ ^ t
-"/ ].
-"/
-"/ (t startsWith:' ') ifTrue:[
-"/ ^ aParameter printString , t
-"/ ].
-"/ (t endsWith:' ') ifTrue:[
-"/ ^ t , aParameter printString
-"/ ].
-"/ ^ t
-
- "Modified: / 25.3.1997 / 12:12:37 / cg"
- "Created: / 23.7.1999 / 14:23:38 / stefan"
-!
-
-handlerBlock
- "Compatibility with Signal. Class based exeptions do not have a handler
- block. They redefine the #action method instead"
-
- ^ nil
-
- "Created: / 23.7.1999 / 14:43:18 / stefan"
- "Modified: / 24.7.1999 / 20:52:10 / stefan"
-! !
-
-!Exception class methodsFor:'compatibility - queries'!
-
-accepts:aSignal
- "return true, if the receiver accepts the argument, aSignal.
- (i.e. the receiver is aSignal or a parent of it). False otherwise."
-
- |s|
-
- aSignal isQuerySignal ifTrue:[^ false].
-
- s := aSignal.
- [s notNil] whileTrue:[
- self == s ifTrue:[^ true].
- s := s parent
- ].
- ^ false
-
- "Created: / 23.7.1999 / 14:00:47 / stefan"
-!
-
-handlerForSignal:signal context:theContext originator:originator
- "answer the handler block for the signal from originator.
- The block is retrieved from aContext.
- Answer nil if the signal is not handled"
-
-
- (theContext selector ~~ #'handle:from:do:'
- or:[(theContext argAt:2) == originator]) ifTrue:[
- (self accepts:signal) ifTrue:[
- ^ theContext argAt:1
- ]
- ].
-
- ^ nil
-
- "Created: / 25.7.1999 / 19:52:58 / stefan"
-!
-
-handlingExceptionInContext:theContext
- "answer the handling exception from aContext."
-
- (theContext selector == #'handle:from:do:'
- or:[theContext selector == #'handle:do:']) ifTrue:[
- ^ theContext receiver
- ].
-
- ^ nil
-!
-
-inheritsFrom:anotherSignal
- "return true, if the receiver is a child of anotherSignal
- (i.e. if handling anotherSignal also handles the receiver)
- This is almost the same as accepts, but returns false, if
- the receiver is identical to anotherSignal."
-
- self == anotherSignal ifTrue:[^ false].
- ^ anotherSignal accepts:self
-
- "Created: / 23.7.1999 / 13:59:51 / stefan"
-!
-
-isHandled
- "return true, if there is a handler for the receiver signal.
- Raising an unhandled signal will usually lead into the debugger,
- but can be caught globally by setting Exceptions EmergencyHandler."
-
- ^ self isHandledIn:(thisContext sender).
-
- "Created: / 23.7.1999 / 14:03:50 / stefan"
-!
-
-isHandledIn:aContext
- "return true, if there is a handler for the receiver signal in the
- contextChain starting with aContext."
-
- |con r|
-
- con := aContext.
- [con notNil] whileTrue:[
- con := con findSpecialHandle:true raise:false.
- con notNil ifTrue:[
- ((r := con receiver) notNil
- and:[(r handlerForSignal:self context:con originator:nil) notNil]
- ) ifTrue:[
- "found a handler context"
- ^ true
- ]
- ]
- ].
- ^ false
-
- "Created: / 23.7.1999 / 14:03:34 / stefan"
- "Modified: / 25.7.1999 / 22:59:03 / stefan"
-!
-
-isQuerySignal
- "return true, if this is a querySignal - always return false here"
-
- ^ false
-
- "Created: / 23.7.1999 / 13:50:16 / stefan"
-!
-
-isSignal
- "return true, if the receiver is some kind of signal;
- true returned here - the method is redefined from Object."
-
- ^ true
-
- "Created: / 23.7.1999 / 13:49:59 / stefan"
-!
-
-mayProceed
- "return true, if the exception handler is allowed to proceed
- the execution where the exception occured.
-
- Subclasses may redefine this."
-
- ^ true
-
- "Modified: / 23.7.1999 / 14:50:11 / stefan"
-!
-
-parent
- "return the parent Signal/Exception of myself.
- Subclasses may redefine this to install themself as child of
- existing Signals."
-
- self == Exception ifTrue:[
- ^ nil
- ].
-
- ^ self superclass
-
- "Created: / 23.7.1999 / 14:01:29 / stefan"
- "Modified: / 23.7.1999 / 16:15:38 / stefan"
-! !
-
-!Exception class methodsFor:'compatibility - raising'!
-
-new
-
- ^ self basicNew signal:self.
-
- "Modified: / 23.7.1999 / 13:53:12 / stefan"
- "Created: / 24.7.1999 / 13:21:13 / stefan"
-!
-
-newException
-
- ^ self new
-
- "Created: / 23.7.1999 / 13:45:49 / stefan"
- "Modified: / 24.7.1999 / 13:21:25 / stefan"
-!
-
-newExceptionFrom:originator
- "answer a new exception object for this signal.
- Set the originator.
- Subclasses may redefine this method"
-
- ^ self new originator:originator
-
- "Created: / 23.7.1999 / 13:47:07 / stefan"
-!
-
-raise
- "raise a signal nonproceedable.
- The signals notifierString is used as errorString."
-
- ^ self newException raise
-
- "Modified: / 2.5.1996 / 16:36:23 / cg"
- "Modified: / 5.3.1998 / 16:44:36 / stefan"
- "Created: / 23.7.1999 / 14:07:17 / stefan"
-!
-
-raiseErrorString:aString
- "raise a signal nonproceedable.
- The argument is used as errorString."
-
- ^ (self newException errorString:aString) raise.
-
- "Modified: / 9.5.1996 / 15:17:59 / cg"
- "Modified: / 12.3.1998 / 15:15:22 / stefan"
- "Created: / 23.7.1999 / 14:07:33 / stefan"
-!
-
-raiseErrorString:aString in:aContext
- "raise a signal nonproceedable.
- The argument is used as errorString.
- The additional context is passed as the context responsible for the raise,
- allowing a raise to mimicri the exception happened somewhere else."
-
- ^ (self newException
- signal:self
- parameter:nil
- errorString:aString
- suspendedContext:aContext
- originator:nil) raise.
-
- "Modified: / 26.7.1996 / 16:42:47 / cg"
- "Modified: / 12.3.1998 / 15:43:43 / stefan"
- "Created: / 23.7.1999 / 14:07:48 / stefan"
-!
-
-raiseFrom:something
- "raise a signal nonproceedable.
- The argument, something is passed both as parameter and originator."
-
- ^ ((self newExceptionFrom:something) parameter:something) raise
-
- "Modified: / 2.5.1996 / 16:36:38 / cg"
- "Modified: / 5.3.1998 / 16:49:55 / stefan"
- "Created: / 23.7.1999 / 14:07:59 / stefan"
-!
-
-raiseIn:aContext
- "raise a signal nonproceedable.
- The signals notifierString is used as errorString.
- The additional context is passed as the context responsible for the raise,
- allowing a raise to mimicri the exception happened somewhere else."
-
- ^ (self newException suspendedContext:aContext) raise.
-
- "Modified: / 2.5.1996 / 16:36:44 / cg"
- "Modified: / 5.3.1998 / 16:50:21 / stefan"
- "Created: / 23.7.1999 / 14:08:13 / stefan"
-!
-
-raiseRequest
- "raise a signal proceedable.
- The signals notifierString is used as errorString."
-
- ^ self newException raiseRequest.
-
- "Modified: / 2.5.1996 / 16:36:52 / cg"
- "Modified: / 5.3.1998 / 16:50:46 / stefan"
- "Created: / 23.7.1999 / 14:08:24 / stefan"
-!
-
-raiseRequestFrom:something
- "raise a signal proceedable.
- The argument, something is passed both as parameter and originator."
-
- ^ ((self newExceptionFrom:something) parameter:something) raiseRequest.
-
- "Modified: / 2.5.1996 / 16:36:38 / cg"
- "Modified: / 5.3.1998 / 16:52:46 / stefan"
- "Created: / 23.7.1999 / 14:08:36 / stefan"
-!
-
-raiseRequestWith:aParameter
- "raise a signal proceedable.
- The signals notifierString is used as errorString."
-
- ^ (self newException parameter:aParameter) raiseRequest.
-
- "Modified: / 9.5.1996 / 15:13:20 / cg"
- "Modified: / 12.3.1998 / 15:16:57 / stefan"
- "Created: / 23.7.1999 / 14:08:48 / stefan"
-!
-
-raiseRequestWith:aParameter errorString:aString
- "raise a signal proceedable.
- The argument, aString is used as errorString."
-
- ^ (self newException
- parameter:aParameter;
- errorString:aString
- ) raiseRequest
-
- "Modified: / 9.5.1996 / 15:13:35 / cg"
- "Modified: / 12.3.1998 / 15:17:52 / stefan"
- "Created: / 23.7.1999 / 14:08:57 / stefan"
-!
-
-raiseRequestWith:aParameter errorString:aString in:aContext
- "raise a signal proceedable.
- The argument, aString is used as errorString.
- The additional context is passed as the context responsible for the raise,
- allowing a raise to mimicri the exception happened somewhere else."
-
- ^ (self newException
- parameter:aParameter;
- errorString:aString;
- suspendedContext:aContext) raiseRequest
-
- "Modified: / 26.7.1996 / 16:29:27 / cg"
- "Modified: / 12.3.1998 / 15:18:34 / stefan"
- "Created: / 23.7.1999 / 14:09:07 / stefan"
-!
-
-raiseRequestWith:aParameter in:aContext
- "raise a signal proceedable.
- The signals notifierString is used as errorString.
- The additional context is passed as the context responsible for the raise,
- allowing a raise to mimicri the exception happened somewhere else."
-
- ^ (self newException
- parameter:aParameter;
- suspendedContext:aContext) raiseRequest.
-
- "Modified: / 26.7.1996 / 16:29:33 / cg"
- "Modified: / 12.3.1998 / 15:18:55 / stefan"
- "Created: / 23.7.1999 / 14:09:17 / stefan"
-!
-
-raiseWith:aParameter
- "raise a signal nonproceedable.
- The argument, aParameter is passed as parameter."
-
- ^ (self newException parameter:aParameter) raise.
-
- "Modified: / 9.5.1996 / 15:14:24 / cg"
- "Modified: / 12.3.1998 / 15:19:11 / stefan"
- "Created: / 23.7.1999 / 14:09:27 / stefan"
-!
-
-raiseWith:aParameter errorString:aString
- "raise a signal nonproceedable.
- The argument, aString is used as errorString, aParameter is passed
- as exception parameter."
-
- ^ (self newException
- parameter:aParameter;
- errorString:aString) raise.
-
- "Modified: / 9.5.1996 / 15:14:32 / cg"
- "Modified: / 12.3.1998 / 15:19:40 / stefan"
- "Created: / 23.7.1999 / 14:09:36 / stefan"
-!
-
-raiseWith:aParameter errorString:aString in:aContext
- "raise a signal nonproceedable.
- The argument, aString is used as errorString, aParameter is passed
- as exception parameter.
- The additional context is passed as the context responsible for the raise,
- allowing a raise to mimicri the exception happened somewhere else."
-
-
- ^ (self newException
- parameter:aParameter;
- errorString:aString;
- suspendedContext:aContext) raise.
-
- "Modified: / 26.7.1996 / 16:29:42 / cg"
- "Modified: / 12.3.1998 / 15:20:12 / stefan"
- "Created: / 23.7.1999 / 14:09:46 / stefan"
-!
-
-raiseWith:aParameter in:aContext
- "raise a signal nonproceedable.
- The argument, aParameter is passed as parameter."
-
- ^ (self newException parameter:aParameter;
- suspendedContext:aContext) raise.
-
- "Modified: / 9.5.1996 / 15:14:24 / cg"
- "Modified: / 12.3.1998 / 15:34:51 / stefan"
- "Created: / 23.7.1999 / 14:10:04 / stefan"
-! !
-
-!Exception class methodsFor:'compatibility - save evaluation'!
-
-catch:aBlock
- "evaluate the argument, aBlock.
- If the receiver-signal is raised during evaluation, abort
- the evaluation and return true; otherwise return false.
- This is the catch & throw mechanism found in other languages,
- where the returned value indicates if an exception occured."
-
- |raiseOccurred|
-
- raiseOccurred := false.
- self handle:[:ex | raiseOccurred := true. ex return] do:aBlock.
- ^ raiseOccurred
-
- "
- Object messageNotUnderstoodSignal catch:[
- 123 size open
- ]
- "
-
- "Created: / 23.7.1999 / 14:06:01 / stefan"
-!
-
-handle:handleBlock do:aBlock
- "evaluate the argument, aBlock.
- If the receiver-signal is raised during evaluation,
- evaluate the handleBlock passing it an Exception argument.
- The handler may decide how to react to the signal by sending
- a corresponding message to the exception (see there).
- If the signal is not raised, return the value of evaluating
- aBlock."
-
- thisContext markForHandle.
- ^ aBlock value "the real logic is in Exception>>doRaise"
-
- "
- Object messageNotUnderstoodSignal handle:[:ex |
- 'oops' printNL.
- ex return
- ] do:[
- 123 size open
- ]
- "
-
- "
- |num|
-
- num := 0.
- Number divisionByZeroSignal handle:[:ex |
- 'oops' printNL.
- ex return
- ] do:[
- 123 / num
- ]
- "
-
- "Created: / 23.7.1999 / 14:06:13 / stefan"
- "Modified: / 25.7.1999 / 19:44:05 / stefan"
-!
-
-handle:handleBlock from:anObject do:aBlock
- "evaluate the argument, aBlock.
- If the receiver-signal is raised during evaluation,
- and the exception originated from anObject,
- evaluate the handleBlock passing it an Exception argument.
- The handler may decide how to react to the signal by sending
- a corresponding message to the exception (see there).
- If the signal is not raised, return the value of evaluating
- aBlock."
-
- thisContext markForHandle.
- ^ aBlock value "the real logic is in Exception>>doRaise"
-
- "
- the first open will be caught; the second not:
-
- |o1 o2|
-
- o1 := 123.
- o2 := nil.
- Object messageNotUnderstoodSignal
- handle:
- [:ex |
- 'oops' printNL.
- ex proceed
- ]
- from:o1
- do:
- [
- o1 open.
- o2 open
- ]
- "
-
- "Created: / 23.7.1999 / 14:06:26 / stefan"
- "Modified: / 25.7.1999 / 19:44:13 / stefan"
-!
-
-ignoreIn:aBlock
- "evaluate the argument, aBlock.
- Ignore the receiver-signal during evaluation - i.e. simply
- continue.
- This makes only sense for some signals, such as UserInterrupt
- or AbortSignal, because continuing after an exception without any cleanup
- often leads to followup-errors."
-
- ^ self handle:[:ex | ex proceed] do:aBlock.
-
- "
- Object messageNotUnderstoodSignal ignoreIn:[
- 123 size open
- ]
- "
-
- "Created: / 23.7.1999 / 14:06:40 / stefan"
-! !
-
-!Exception class methodsFor:'compatibility - signal creation'!
-
-newSignal
- "create a new signal, using the receiver as a prototype and
- setting the parent of the new signal to the receiver."
-
- ^ self newSignalMayProceed:self mayProceed
-
- "Created: / 23.7.1999 / 20:13:23 / stefan"
-!
-
-newSignalMayProceed:proceed
- "create a new signal, using the receiver as a prototype and
- setting the parent of the new signal to the receiver."
-
- ^ (Signal basicNew) mayProceed:proceed;
- notifierString:NotifierString;
- parent:self
-
- "Created: / 23.7.1999 / 20:12:43 / stefan"
-! !
-
-!Exception class methodsFor:'defaults'!
-
-emergencyHandler
- "return the handler used for unhandled exceptions.
-
- If no EmergencyHandler has been set, a handler which enters the
- debugger is returned.
- The debugger is opened by asking the signal for a debug action,
- this allows to provide other debuggers in specialized (subclass-instances)
- of Signal (if that is ever needed)"
-
- "
- set it up, when called the first time
- "
- EmergencyHandler isNil ifTrue:[
- EmergencyHandler := [:ex |
- "
- sending it to the signal allows per-signal specific
- debuggers to be implemented in the future
- (for example, segv in primitive code could show things
- on the C-level ..)
- "
- (ex signal) enterDebuggerWith:ex message:(ex errorString).
- ]
- ].
-
- ^ EmergencyHandler
-
- "Modified: 15.1.1997 / 20:50:37 / cg"
-!
-
-emergencyHandler:aOneArgBlock
- "set the handler used for unhandled exceptions.
- The default (a nil-handler) leads to a debugger to be shown."
-
- EmergencyHandler := aOneArgBlock
-
- "ST-80 behavior of first showing a notifier:
- (I prefer to get right into the debugger, though)
-
- Exception
- emergencyHandler:
- [:ex | self errorNotify:ex errorString ]
- "
-
- "ST-X behavior of going right into the debugger:
-
- Exception
- emergencyHandler:nil
- "
-
- "automatically aborting current operation, on error:
- (may be useful for end-user apps; make certain,
- you have abortSignal handlers at appropriate places)
-
- Exception
- emergencyHandler:
- [:ex | Object abortSignal raise. ex return. ]
- "
-
- "finally, traditional language system behavior; dump core ;-)
-
- Exception
- emergencyHandler:
- [:ex | Smalltalk exitWithCoreDump. ]
- "
-
- "Modified: 15.1.1997 / 20:49:06 / cg"
-! !
-
-!Exception class methodsFor:'useful handlers'!
-
-abortingEmergencyHandler
- "return a block (usable as an emergency handler),
- which aborts after showing a warnBox.
- This is useful for endUser applications"
-
- ^ [:ex | self warn:'Error: ' , ex errorString.
- AbortSignal raise
- ]
-
- "test with (try a few halts or CTRL-C's):
- Exception emergencyHandler:(Exception abortingEmergencyHandler)
- "
-
- "back with:
- Exception emergencyHandler:(Exception notifyingEmergencyHandler)
- Exception emergencyHandler:nil
- "
-
- "Created: 15.1.1997 / 20:13:06 / cg"
- "Modified: 15.1.1997 / 20:15:02 / cg"
-!
-
-dumpingEmergencyHandler
- "return a block (usable as an emergency handler),
- which dumps the stackBacktrace to a trace file and
- aborts after showing a warnBox.
- This is useful, for endUser application, which are still being
- debugged (i.e. the programmers may have a look at the traceFile
- from time to time).
-
- Notice:
- The code below is just an example; you may want to change the
- name of the error-file in your application
- (but please: copy the code; do not modify here)"
-
- ^ [:ex |
- |str printedException|
-
- ex signal == Signal noHandlerSignal ifTrue:[
- printedException := ex parameter.
- ] ifFalse:[
- printedException := ex
- ].
-
- "/ user interruption is handled specially:
- "/ allow user to choose between proceeding or aborting
- "/ but never dump that information to the file.
-
- printedException signal == Object userInterruptSignal ifTrue:[
- (self confirm:'abort current action ?') ifTrue:[
- AbortSignal raise
- ].
- ex proceed
- ].
-
- "/
- "/ dump it to 'errorTrace.stx'
- "/
- str := 'errorTrace.stx' asFilename appendingWriteStream.
-
- str nextPutLine:('******************************* '
- , AbsoluteTime now printString
- , ' *******************************').
- str cr.
-
- str nextPutLine:('** Error: ' , printedException errorString).
- str nextPutLine:('** Signal: ' , printedException signal printString).
- str nextPutLine:('** Parameter: ' , printedException parameter printString).
- str nextPutLine:('** Process: ' , Processor activeProcess printString).
- str nextPutLine:('** Backtrace:').
- str cr.
-
- printedException suspendedContext fullPrintAllOn:str.
- str cr.
- str cr.
- str close.
-
- "/ send a line to stdErr
-
- ('[warning]: ignored error: ' , printedException errorString) errorPrintCR.
- ('[warning]: error information appended to ''errorTrace.stx''') errorPrintCR.
-
- AbortSignal raise
- ]
-
- "test with (try a few halts or CTRL-C's):
- Exception emergencyHandler:(Exception dumpingEmergencyHandler)
- "
-
- "back with:
- Exception emergencyHandler:(Exception notifyingEmergencyHandler)
- Exception emergencyHandler:nil
- "
-
- "Created: 15.1.1997 / 20:14:52 / cg"
- "Modified: 24.1.1997 / 20:36:21 / cg"
-!
-
-mailingEmergencyHandler
- "return a block (usable as an emergency handler),
- which shows a warnBox and optionally mails a stackBacktrace to a maintainer.
- This is useful, for endUser application, which are still being
- debugged (i.e. the programmers may have a look at the errors).
-
- Notice: the stuff here is a demonstration only; it should be modified
- for your particular environment ...
- ... but please: copy the code and modify there;
- leave the stuff below as it is."
-
- ^ [:ex |
- |str printedException doMail emergencyMailReceiver pipe|
-
- ex signal == Signal noHandlerSignal ifTrue:[
- printedException := ex parameter.
- ] ifFalse:[
- printedException := ex
- ].
-
- "/ user interruption is handled specially:
- "/ allow user to choose between proceeding or aborting
- "/ but never dump that information to the file.
-
- printedException signal == Object userInterruptSignal ifTrue:[
- (self confirm:'abort current action ?') ifTrue:[
- AbortSignal raise
- ].
- ex proceed
- ].
-
- "/ somehow get the name of the guy to receive the mail
- "/ you have to implement that yourself.
-
- "/ emergencyMailReceiver := OneOfYourClass getEmergencyMailReceiver.
- emergencyMailReceiver := OperatingSystem getLoginName.
-
- emergencyMailReceiver isNil ifTrue:[
- self warn:(printedException errorString
- , '\\No mailing to service people possible.') withCRs.
- doMail := false.
- ] ifFalse:[
- doMail := self confirm:(printedException errorString
- , '\\Mail error information to the service people ('
- , emergencyMailReceiver , ') ?') withCRs
- ].
- doMail ifTrue:[
- str := '' writeStream.
-
- str nextPutLine:('Error notification from '
- , OperatingSystem getLoginName
- , '@'
- , OperatingSystem getHostName).
- str cr.
-
- str nextPutLine:('Time: ' , AbsoluteTime now printString).
- str nextPutLine:('Error: ', printedException errorString).
- str nextPutLine:('Signal: ', printedException signal printString).
- str nextPutLine:('Parameter: ', printedException parameter printString).
- str nextPutLine:('Process: ', Processor activeProcess printString).
- str nextPutLine:'Backtrace:'.
- str cr.
-
- printedException suspendedContext fullPrintAllOn:str.
- str cr;cr.
-
- str close.
-
- pipe := PipeStream
- writingTo:'mail ', emergencyMailReceiver.
- pipe notNil ifTrue:[
- pipe nextPutLine:'Subject: automatic error report'.
- pipe nextPutAll:str contents.
- pipe cr.
- pipe close.
- ]
- ].
-
- AbortSignal raise
- ]
-
- "test with (try a few halts or CTRL-C's):
- Exception emergencyHandler:(Exception mailingEmergencyHandler)
- "
-
- "back with:
- Exception emergencyHandler:(Exception notifyingEmergencyHandler)
- Exception emergencyHandler:nil
- "
-
- "Created: 15.1.1997 / 20:14:52 / cg"
- "Modified: 15.1.1997 / 21:10:28 / cg"
-!
-
-notifyingEmergencyHandler
- "return a block (usable as an emergency handler for exceptions),
- which does errorNotification before going into the debugger."
-
- ^ [:ex | nil errorNotify:ex errorString from:ex suspendedContext ]
-
- "test with (try a few halts or CTRL-C's):
- Exception emergencyHandler:(Exception notifyingEmergencyHandler)
- "
-
- "back with:
- Exception emergencyHandler:nil
- "
-
- "Modified: 15.1.1997 / 20:15:12 / cg"
-! !
-
-!Exception methodsFor:'accessing'!
-
-errorString
- "return the errorString passsed with the signal raise
- (or nil, if there was none)"
-
- ^ signal errorStringExtra:errorString with:nil
-
- "Modified: / 12.3.1998 / 15:13:28 / stefan"
-!
-
-errorString:aString
- "set the errorString.
- If it starts with a space, the signals errorString is prepended,
- if it ends with a space, it is appended."
-
- errorString := aString
-
- "Created: / 5.3.1998 / 16:45:29 / stefan"
- "Modified: / 12.3.1998 / 15:30:45 / stefan"
-!
-
-handlerContext
- "return the context of the handler"
-
- ^ handlerContext
-!
-
-handlingSignal
- "return the handling signal (or signalSet or Exception).
- This is only valid during handler evaluation, and answers
- the object which accepted the actual signal.
- (i.e. the parent or signalSet or handlerCollection)"
-
- ^ handlingSignal
-!
-
-originator
- "return the originator passsed with the signal raise
- (or nil, if there was none)"
-
- ^ originator
-!
-
-originator:anObject
- "set the originator"
-
- originator := anObject
-
- "Created: / 5.3.1998 / 16:34:56 / stefan"
-!
-
-parameter
- "return the parameter passsed with the signal raise
- (or nil, if there was none)"
-
- ^ parameter
-!
-
-parameter:anObject
- "set the parameter of the exception"
-
- parameter := anObject
-
- "Created: / 5.3.1998 / 16:34:22 / stefan"
-!
-
-rejected
- "return true, if any other of the exceptions handlers has rejected
- Uncertain, if this is really interesting to anybody.
- This is only valid during handler execution.
- (i.e. an outer handler can find out, if any other handler has already
- rejected).
- Currently only used to change the 'unhandled-exception' errorString
- into 'rejected-exception' for information).
- "
-
- ^ rejected
-!
-
-signal
- "return the signal, that caused the exception"
-
- ^ signal
-!
-
-signal:aSignal
- "set the signal, that caused the exception"
-
- signal := aSignal
-
- "Created: / 5.3.1998 / 16:02:46 / stefan"
-!
-
-suspendedContext
- "return the context in which the raise occured"
-
- ^ suspendedContext
-!
-
-suspendedContext:something
- "set the value of the instance variable 'suspendedContext' (automatically generated)"
-
- suspendedContext := something.
-
- "Created: / 2.3.1998 / 12:43:20 / stefan"
-!
-
-willProceed
- "return true, if the exception is proceedable"
-
- ^ resumeBlock notNil and:[proceedable]
-
- "Modified: / 2.3.1998 / 12:20:43 / stefan"
-! !
-
-!Exception methodsFor:'copying'!
-
-postCopy
- "set the internal state to nil"
-
- suspendedContext := handlerContext := rejected := nil
-
- "Created: / 2.3.1998 / 12:30:06 / stefan"
-! !
-
-!Exception methodsFor:'default actions'!
-
-action
- "perform a action for the signal if it hasn't been catched
- We arrive here, if either no handler was found, or none of the
- handlers did a return (i.e. every handler rejected or fell through).
-
- The default is to evaluate the signal's handlerBlock or the
- per process handler (if its the noHandlerSignal).
- Finally fall back to Exceptions emergencyHandler, which is always
- available and enters the debugger.
- Subclasses may redefine this."
-
- |block noHandlerSignal msg|
-
- "
- try per signal handler
- "
- (block := signal handlerBlock) isNil ifTrue:[
- "/
- "/ if its a querySignal, ignore it
- "/
- signal isQuerySignal ifTrue:[^ nil].
-
- "/
- "/ if it is not the NoHandlerSignal, raise it ...
- "/ passing the receiver as parameter.
- "/
- signal ~~ (noHandlerSignal := Signal noHandlerSignal) ifTrue:[
- noHandlerSignal notNil ifTrue:[
- handlerContext notNil ifTrue:[
- msg := 'unhandled (rejected)'
- ] ifFalse:[
- msg := 'unhandled'
- ].
- msg := msg , ' exception: (' , self errorString , ')'.
- ^ noHandlerSignal
- raiseRequestWith:self
- errorString:msg
- in:self suspendedContext
- ].
- "/
- "/ mhmh - an error during early startup; noHandlerSignal is
- "/ not yet defined.
- "/
- ^ MiniDebugger enterWithMessage:self errorString
- ].
-
- "
- mhmh - smells like trouble - there is no handler and
- no per-signal handler block.
- Look for either a per-process emergencyHandlerBlock
- or the global emergencyHandler (from Exception) ...
- "
- Processor notNil ifTrue:[
- "care for signal during startup (Processor not yet created)"
- block := Processor activeProcess emergencySignalHandler.
- ].
- block isNil ifTrue:[
- block := Exception emergencyHandler.
- block isNil ifTrue:[
- "care for error during startup (Exception not yet initialized)"
- ^ MiniDebugger enterWithMessage:self errorString
- ].
- ].
- ].
- "... and call it"
- ^ block value:self.
-
- "Created: / 23.7.1999 / 14:38:03 / stefan"
- "Modified: / 25.7.1999 / 20:11:12 / stefan"
-!
-
-mayProceed
- "return true, if the exception handler is allowed to proceed
- the execution where the exception occured.
-
- Subclasses may redefine this."
-
- ^ signal mayProceed
-
- "Created: / 23.7.1999 / 14:48:26 / stefan"
-! !
-
-!Exception methodsFor:'handler actions'!
-
-proceed
- "Continue after the raise - the raise returns nil"
-
- |b|
-
- resumeBlock isNil ifTrue:[
- "signal raiser does not want us to proceed"
- Signal proceedErrorSignal raiseWith:self.
- ] ifFalse:[
- proceedable ifFalse:[
- ('WARNING: signal <', signal printString, '> has been raised nonproceedable') errorPrintCR.
- (' by: ', suspendedContext printString) errorPrintCR.
- (' ', thisContext sender printString , ' tries to proceed.') errorPrintCR.
- (' This will be an error in future ST/X versions.') errorPrintCR.
- ].
- b := resumeBlock.
- resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
- b value:nil
- ]
-
- "
- Object errorSignal handle:[:ex|
- ex proceed
- ] do:[
- Object errorSignal raise
- ].
- "
-
- "Modified: / 27.3.1997 / 16:44:39 / cg"
- "Modified: / 2.3.1998 / 12:00:10 / stefan"
-!
-
-proceedWith:value
- "Continue after the raise - the raise returns value"
-
- |b|
-
- resumeBlock isNil ifTrue:[
- "signal raiser does not want us to proceed"
- Signal proceedErrorSignal raiseWith:self.
- ] ifFalse:[
- proceedable ifFalse:[
- ('WARNING: signal <', signal printString, '> has been raised nonproceedable') errorPrintCR.
- (' by: ', suspendedContext printString) errorPrintCR.
- (' ', thisContext sender printString , ' tries to proceed.') errorPrintCR.
- (' This will be an error in future ST/X versions.') errorPrintCR.
- ].
- b := resumeBlock.
- resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
- b value:value
- ]
-
- "Modified: / 27.3.1997 / 16:45:57 / cg"
- "Modified: / 2.3.1998 / 12:02:06 / stefan"
-!
-
-reject
- "handler decided not to handle this signal -
- system will look for another handler"
-
-"/ |con|
-"/
-"/ "/ find my raise context
-"/ con := thisContext findSpecialHandle:false raise:true.
-"/ [con notNil and:[con receiver ~~ self]] whileTrue:[
-"/ con := con findSpecialHandle:false raise:true.
-"/ ].
-"/ rejected := true.
-"/ con unwind:nil.
-"/self halt.
-
- rejected := true.
- rejectBlock value
-
- "
- Object errorSignal handle:[:ex |
- '1' printCR.
- ex reject
- ] do:[
- Object errorSignal handle:[:ex |
- '2' printCR.
- ex reject
- ] do:[
- #() at:1
- ]
- ]
- "
-!
-
-restart
- "restart the handle:do: - usually after some repair work is done
- in the handler"
-
- handlerContext unwindAndRestart
-
- "
- |rslt n|
-
- Object errorSignal handle:[:ex |
- 'fixing divisor ...' printCR.
- n := 1.
- ex restart.
- ] do:[
- rslt := 5 / n.
- ].
- rslt
- "
-!
-
-restartDo:aBlock
- "restart the handle:do: but execute the argument, aBlock instead of the
- original do-block - usually after some repair work is done in handler"
-
- handlerContext selector == #'handle:do:' ifFalse:[
- self error:'unimplemented feature'.
- ].
-
-"/ handlerContext unwindThenDo:[
-"/ handlerContext receiver
-"/ handle:(handlerContext argAt:1)
-"/ do:aBlock
-"/ ].
- handlerContext argAt:2 put:aBlock.
- handlerContext unwindAndRestart
-
- "
- |sig rslt|
-
- sig := Signal new.
-
- sig handle:[:ex |
- ex restartDo:[ rslt := 999 ]
- ] do:[
- rslt := 0.
- sig raise
- ].
- Transcript showCR:rslt
- "
-
- "
- |sig rslt|
-
- Object errorSignal handle:[:ex |
- ex restartDo:[ rslt := 999 ]
- ] do:[
- rslt := nil foo.
-
- ].
- Transcript showCR:rslt
- "
-
- "
- |sig rslt|
-
- Object errorSignal handle:[:ex |
- ex restartDo:[ 'handler' printCR. rslt := nil foo ]
- ] do:[
- rslt := nil foo.
-
- ].
- Transcript showCR:rslt
- "
-
- "Modified: / 8.11.1997 / 18:52:28 / cg"
-!
-
-resume
- "Continue after the raise - the raise returns nil
- obsolete (use #proceed), retained for backwards compatibility"
-
- self obsoleteMethodWarning:'use #proceed'.
- ^ self proceed
-
- "Modified: / 2.3.1998 / 10:51:55 / stefan"
-!
-
-resumeWith:value
- "Continue after the raise - the raise returns value
- obsolete (use #proceedWith:), retained for backwards compatibility"
-
- self obsoleteMethodWarning:'use #proceedWith:'.
- ^ self proceedWith:value
-
- "Modified: / 2.3.1998 / 10:51:48 / stefan"
-!
-
-return
- "Continue after the handle:do: - the handle:do: returns nil"
-
- |con|
-
- con := handlerContext.
- resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
- con unwind:nil
-
- "Modified: 27.3.1997 / 16:46:39 / cg"
-!
-
-returnDoing:aBlock
- "Continue after the handle:do: - the handle:do: returns aBlock value"
-
- handlerContext unwindThenDo:aBlock
-!
-
-returnWith:value
- "Continue after the handle:do: - the handle:do: returns value"
-
- |con|
-
- con := handlerContext.
- resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
- con unwind:value
-
- "Modified: 27.3.1997 / 16:46:51 / cg"
-! !
-
-!Exception methodsFor:'private'!
-
-XXdoRaise
- "search through the context-calling chain for a 'handle:do:'-context
- to the raising signal, a parent of it, or a SignalSet which includes
- the raising signal.
- If found, take the contexts 2nd argument (the handler) and evaluate
- it with the receiver exception as argument.
- If no handler is found, try per signal handler, or
- per process handler (if its the noHandlerSignal).
- Finally fall back to Exceptions emergencyHandler, which is always
- available and enters the debugger.
- ATTENTION: the code below depends on being called by #raise or
- #raiseRequest for proper operation (it skips the sending context)."
-
- |theContext conArg1
- theSignal c ex1 activeHandlers inHandler
- lastHandler h r firstHandler|
-
- "/ is nil a valid originator? If so, we need an extra
- "/ instanceVariable to record the originator setting.
-
- originator isNil ifTrue:[
- originator := suspendedContext homeReceiver
- ].
-
- theSignal := signal.
- theSignal isSignal ifFalse:[
- self halt:'unexpected non-Signal in calling context'.
- ].
-
-"/ 'search handler for: ' print. theSignal displayString printCR.
-
- inHandler := false.
- c := thisContext sender sender. "the raise/raiseRequest-context"
- "the signal raise context"
-
- "/ since the exceptionHandler is evaluated onTop of the
- "/ contextChain, we must skip active handlers before searching.
- "/ otherwise, we get into trouble, when re-raising an exception
- "/ from within a handler (which would lead to re-executing the
- "/ same handler)
- "/ the code below collects active handlers ...
-
- "/ on the fly, look for the first #handle:do: - context,
- "/ and remember it (as firstHandler) to avoid walking the context chain twice
- "/ in most cases ...
-
- firstHandler := nil.
-
- [c notNil] whileTrue:[
- firstHandler isNil ifTrue:[
- c := c findNextContextWithSelector:#doRaise or:#'handle:do:' or:#'handle:from:do:'.
- ] ifFalse:[
- c := c findNextContextWithSelector:#doRaise or:nil or:nil.
- ].
- c notNil ifTrue:[
- (c selector == #doRaise) ifTrue:[
-
- ex1 := c receiver.
-
- ((ex1 class == self class)
- or:[ex1 species == self species]) ifTrue:[
- (ex1 signal == theSignal) ifTrue:[
- h := ex1 handlerContext.
- h notNil ifTrue:[
- r := h receiver.
- (r notNil and:[r accepts:theSignal]) ifTrue:[
- activeHandlers isNil ifTrue:[
- activeHandlers := OrderedCollection new
- ].
-
- lastHandler := h.
- activeHandlers add:lastHandler.
- inHandler := true.
- c := lastHandler.
- ]
- ]
- ]
- ]
- ] ifFalse:[
- "/ must be a #handle:do context ...
- firstHandler := c.
- ]
- ]
- ].
-
- "/ now, start searching for a handler,
- "/ start search above the last active handler.
- "/ Or start with the first handle:do: context, if one
- "/ was found as a side effect of the previous handler search.
- "/ If nil, then there is no handler and we can directly proceed
- "/ to the unhandled code below.
-
-"/ lastHandler notNil ifTrue:[
-"/ theContext := lastHandler.
-"/ theContext := lastHandler findNextContextWithSelector:#'handle:do:' or:#'handle:from:do:' or:nil.
-"/ ] ifFalse:[
- theContext := firstHandler.
-"/ ].
-
- [theContext notNil] whileTrue:[
- (theContext selector == #'handle:do:'
- or:[(theContext argAt:2) == originator])
- ifTrue:[
- (activeHandlers notNil
- and:[activeHandlers includesIdentical:theContext]) ifTrue:[
-"/ 'skip activeHandler: ' print. theContext displayString printCR.
-
- ] ifFalse:[
- "
- if this is the Signal>>handle:do: context
- or a SignalSet>>handle:do: context with self in it,
- call the handler
- "
- r := theContext receiver.
- (r notNil and:[r accepts:signal]) ifTrue:[
- "call the handler"
-
- conArg1 := theContext argAt:1.
-
- handlerContext := theContext.
-
- self doCallHandler:conArg1.
-
- "/ if the handler rejects, we arrive here
- "/ continue search for another handler
- ].
- ]
- ].
- theContext := theContext findNextContextWithSelector:#'handle:do:' or:#'handle:from:do:' or:nil.
- ].
-
- activeHandlers := nil.
-
- "
- we arrive here, if either no handler was found, or none of the
- handlers did a return (i.e. every handler rejected or fell through).
- "
-
- ^ self action
-
- "Modified: / 9.11.1997 / 14:48:44 / cg"
- "Modified: / 23.7.1999 / 14:40:12 / stefan"
- "Created: / 25.7.1999 / 20:13:19 / stefan"
-!
-
-doCallHandler:aHandlerBlock
- "call the handler proper - needed an extra method
- to have a separate returnContext for the rejectBlock.
- (which is historical, and actually no longer needed)"
-
- |val|
-
- rejectBlock := [^ self]. "this will return on reject"
-
- thisContext markForRaise.
-
- val := aHandlerBlock value:self.
- "
- handler fall through - is just like a returnWith:blocks-value
- "
- rejectBlock := nil.
- self returnWith:val
-
- "Modified: / 26.7.1999 / 14:41:55 / stefan"
-!
-
-doRaise
- "search through the context-calling chain for a handle-context
- to the raising signal, a parent of it, or a SignalSet which includes
- the raising signal.
- If found, ask the receiver for the handler and evaluate
- it with the receiver exception as argument.
- If no handler is found, perform the default #action method.
-
- ATTENTION: the code below depends on being called by #raise or
- #raiseRequest for proper operation (it skips the sending context)."
-
- |theContext handler
- theSignal c ex1 activeHandlers inHandler
- lastHandler h r firstHandler searchForHandle searchForRaise|
-
-
- "/ is nil a valid originator? If so, we need an extra
- "/ instanceVariable to record the originator setting.
-
- originator isNil ifTrue:[
- originator := suspendedContext homeReceiver
- ].
-
- theSignal := signal.
- theSignal isSignal ifFalse:[
- self halt:'unexpected non-Signal in calling context'.
- ].
-
-"/ 'search handler for: ' print. theSignal displayString printCR.
-
- "/ inHandler := false.
- c := thisContext sender sender. "the raise/raiseRequest-context"
- "the signal raise context"
-
- "/ since the exceptionHandler is evaluated on top of the
- "/ contextChain, we must skip active handlers before searching.
- "/ otherwise, we get into trouble, when re-raising an exception
- "/ from within a handler (which would lead to re-executing the
- "/ same handler)
- "/ the code below collects active handlers ...
-
- "/ on the fly, look for the first handle - context,
- "/ and remember it (as firstHandler) to avoid walking the context chain twice
- "/ in most cases ...
-
- firstHandler := nil.
- searchForHandle := searchForRaise := true.
-
- [c notNil] whileTrue:[
- c := c findSpecialHandle:searchForHandle raise:searchForRaise.
-
- c notNil ifTrue:[
- (c isRaiseContext) ifTrue:[
- ex1 := c receiver.
- ((ex1 class == self class)
- or:[ex1 species == self species]) ifTrue:[
- h := ex1 handlerContext.
- h notNil ifTrue:[
- ((ex1 signal == theSignal)
-
- "/ mhmh - if not ==, the raised signal there is not ours,
- "/ but the handler could still be for a signalSet, parentSig
- "/ or other thingy which accepts our signal.
- "/ If we ommit that check, a signalSet-handler gets invoked
- "/ again by an exception occuring inside its handler.
-
- "/ to avoid overhead, only do it if the
- "/ handlers receiver is not of the signals class...
- "/ ...i.e. knowing that most are r handle:do: contexts,
- "/ where the receiver is the handling signal.
- or:[h receiver ~~ ex1 signal
- and:[ex1 handlingSignal accepts:theSignal]]) ifTrue:[
- activeHandlers isNil ifTrue:[
- activeHandlers := OrderedCollection new
- ].
-
- activeHandlers add:h.
- "/ lastHandler := h.
- "/ inHandler := true.
- c := h.
- ]
- ]
- ]
- ] ifFalse:[
- "/ must be a handle context ...
- firstHandler := c.
- searchForHandle := false.
- ]
- ]
- ].
-
- "/ now, start searching for a handler,
- "/ start search above the last active handler.
- "/ Or start with the first handle context, if one
- "/ was found as a side effect of the previous handler search.
- "/ If nil, then there is no handler and we can directly proceed
- "/ to the unhandled code below.
-
-"/ lastHandler notNil ifTrue:[
-"/ theContext := lastHandler.
-"/ theContext := lastHandler findNextHandleContext
-"/ ] ifFalse:[
- theContext := firstHandler.
-"/ ].
-
- [theContext notNil] whileTrue:[
- "/
- "/ ask the Signal instance/Exception class for the handler.
- "/ nil is returned, if the signal is not accepted
- "/
- r := theContext receiver.
- (r notNil and:[(handler := r handlerForSignal:signal
- context:theContext
- originator:originator) notNil]
- ) ifTrue:[
- (activeHandlers notNil
- and:[activeHandlers includesIdentical:theContext]) ifTrue:[
-"/ 'skip activeHandler: ' print. theContext displayString printCR.
-
- ] ifFalse:[
- "call the handler"
-
- handlerContext := theContext.
- "/ remember the handling signal, sigSet, or exception
- "/ for the #accepts: check above
- handlingSignal := r handlingExceptionInContext:theContext.
- theContext := nil.
- self doCallHandler:handler.
-
- "/ if the handler rejects, we arrive here
- "/ continue search for another handler
- theContext := handlerContext.
- ].
- ].
- theContext := theContext findSpecialHandle:true raise:false.
- ].
-
- "/ help GC a bit, by clearing things we no longer need
- "/ (especially useful for contexts ...)
- activeHandlers := handler := c := ex1 := firstHandler := nil.
-
- "
- we arrive here, if either no handler was found,
- or every handler rejected.
- "
-
- ^ self action
-
- "Created: / 12.5.1996 / 15:09:39 / cg"
- "Modified: / 9.11.1997 / 14:48:44 / cg"
- "Modified: / 26.7.1999 / 14:50:50 / stefan"
-! !
-
-!Exception methodsFor:'raising'!
-
-raise
- "actually raise a non-proceedable exception
-
- In the past, ST/X did not distinguish between proceedable and
- non-proceedable signals (signals invoked with #raise could proceed).
- To allow a migration of old applications, we do not invoke a signal
- but print out a warning, when trying to proceed a non-proceedable signal.
- In the next release, this will raise a signal, so fix your code"
-
- suspendedContext isNil ifTrue:[
- "Call chain:
- (origin)>>someMethod sender
- Signal>>raise sender
- Exception>>raise thisContext
- "
- suspendedContext := thisContext sender sender
- ].
-
- "/ remove the next 2 lines to make proceeding from non-proceedable signals an error.
- proceedable := false.
- resumeBlock := [:value | ^ value].
-
- ^ self doRaise
-
- "Modified: / 12.5.1996 / 15:09:47 / cg"
- "Modified: / 5.3.1998 / 16:40:23 / stefan"
-!
-
-raiseRequest
- "actually raise a proceedable exception."
-
- suspendedContext isNil ifTrue:[
- "Call chain:
- (origin)>>someMethod sender
- Signal>>raise sender
- Exception>>raise thisContext
- "
- suspendedContext := thisContext sender sender
- ].
-
- self mayProceed ifFalse:[
- "/ proceeding from wrongProceedabilitySignal grants the raiseRequest
- Signal wrongProceedabilitySignal raiseRequestWith:signal in:suspendedContext
- ].
- proceedable := true.
- resumeBlock := [:value | ^ value].
- ^ self doRaise
-
- "Modified: / 12.5.1996 / 15:09:44 / cg"
- "Modified: / 23.7.1999 / 14:48:48 / stefan"
-! !
-
-!Exception methodsFor:'setup'!
-
-signal:aSignal originator:origin
- "set the fields usable for inspection by the handler
- - only to be sent from the signal when raising"
-
- signal := aSignal.
- originator := origin.
-
- "Created: / 23.7.1999 / 13:39:35 / stefan"
-!
-
-signal:aSignal parameter:aParameter errorString:aString suspendedContext:sContext originator:origin
- "set the fields usable for inspection by the handler
- - only to be sent from the signal when raising"
-
- signal := aSignal.
- parameter := aParameter.
- errorString := aString.
- suspendedContext := sContext.
- originator := origin.
-! !
-
-!Exception class methodsFor:'documentation'!
-
-version
- ^ '$Header: /cvs/stx/stx/libbasic/Exception.st,v 1.76 1999-07-31 16:12:36 cg Exp $'
-! !
-Exception initialize!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GenericException.st Sat Jul 31 18:22:47 1999 +0200
@@ -0,0 +1,1935 @@
+"
+ COPYRIGHT (c) 1993 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Object subclass:#GenericException
+ instanceVariableNames:'signal parameter errorString suspendedContext handlerContext
+ rejected originator resumeBlock rejectBlock proceedable
+ handlingSignal'
+ classVariableNames:'EmergencyHandler RecursiveExceptionSignal'
+ poolDictionaries:''
+ category:'Kernel-Exceptions'
+!
+
+GenericException class instanceVariableNames:'NotifierString'
+
+"
+ The following class instance variables are inherited by this class:
+
+ Object -
+"
+!
+
+!GenericException class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1993 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ GenericException and its subclasses implement the same protocol as Signal.
+ So class based exceptions may be implemented as subclasses of GenericException.
+
+ Instances of Exception are passed to a Signal handling block as argument.
+ The handler block may perform various actions by sending corresponding messages
+ to the exception object. The following actions are possible:
+
+ reject - don't handle this signal;
+ another handler will be searched for,
+ upper in the calling hierarchy
+
+ proceed - return from the Signal>>raise, with nil as value
+
+ proceedWith:val - same, but return val from Signal>>raise
+
+ return - return from the Signal>>handle:do:, with nil as value
+
+ returnWith:val - same, but return val from Signal>>handle:do:
+ (this is also the handlers default,
+ if it falls through; taking the handlerBlocks value
+ as return value)
+
+ restart - restart the Signal>>handle:do:, after repairing
+
+ Via the Exception object, the handler can also query the state of execution:
+ where the Signal was raised, where the handler is, the signal which caused
+ the error and the errorString passed when the signal was raised. Also, an optional
+ parameter can be passed - the use is signal specific.
+
+ [instance variables:]
+ signal <Signal> the signal which caused the exception
+
+ parameter <Object> a parameter (if any) which was passed when raising
+ the signal (only if raised with #raiseWith:aParameter)
+
+ errorString <String> an errorString
+ (usually the signals own errorString, but sometimes
+ changed explicitely in #raiseWith:errorString:)
+
+ suspendedContext <Context> the context in which the raise occured
+
+ handlerContext <Context> the context of the handler (if any)
+
+ resumeBlock <Block> private to the exception; needed to perform resume action
+
+ rejectBlock <Block> private to the exception; needed to perform reject action
+
+ In case of an unhandled signal raise, Exceptions EmergenyHandler will be evaluated.
+ The default emergeny handler will enter the debugger.
+
+ For applications, which do not want Debuggers to come up, other handlers are
+ possible.
+ For example, to get the typical C++ behavior, use:
+ Exception emergencyHandler:[:ex | Smalltalk exitWithCoreDump]
+
+
+ [Class variables:]
+ EmergencyHandler <Block> this block is evaluated, if no handler was defined
+ for a signal (i.e. this one is responsible for the
+ unhandled exception debugger).
+ Having this being a block allows to globally catch
+ these errors - even when no enclosing handler-scope
+ around the erronous code exists.
+ (as the catch/through does).
+
+ RecursiveExceptionSignal
+ <Signal> raised when within a handler for some signal,
+ the same signal is raised again.
+
+
+ [see also:]
+ Signal SignalSet QuerySignal
+ Context Block
+ Object DebugView
+ (``Exception handling and signals'': programming/exceptions.html)
+
+ [author:]
+ Claus Gittinger
+"
+!
+
+examples
+"
+ Examples on Exception-raising & handling are found in the doc/coding
+ section (CodingExamples).
+
+ The emergencyHandler stuff is very useful, to prevent endUser applications
+ from entering the debugger.
+ Some commonly used (useful) emergency handlers are provided in the
+ 'useful handlers' section; try them to learn more
+ (especially, the mailingHandler is fun).
+
+ Of course, these are only examples - you may define your own handler
+ block and pass it to the #emergencyHandler: method.
+
+ BTW: the Launchers 'source & debugger' settings menu allows you
+ to install either a default or the notifying handler.
+
+
+ A handler which shows a box, then aborts - (no more debuggers):
+ [exBegin]
+ Exception emergencyHandler:(Exception abortingEmergencyHandler)
+ [exEnd]
+
+
+ A handler which aborts - (no box, no debugger):
+ [exBegin]
+ Exception emergencyHandler:[:ex | AbortSignal raise]
+ [exEnd]
+
+
+ try some exception (for demonstration, in some other process):
+ [exBegin]
+ [
+ #(1 2 3) at:4
+ ] fork.
+ [exEnd]
+
+ cleanup (switch back to the regular handler, which enters the debugger):
+ [exBegin]
+ Exception emergencyHandler:nil
+ [exEnd]
+
+
+ A handler which shows a warnBox and asks for debugging:
+ [exBegin]
+ Exception emergencyHandler:(Exception notifyingEmergencyHandler)
+ [exEnd]
+
+
+
+ A handler which dumps information to a file (watch the file 'errorTrace.stx'):
+ [exBegin]
+ Exception emergencyHandler:(Exception dumpingEmergencyHandler)
+ [exEnd]
+
+
+
+ A handler which sends you mail:
+ [exBegin]
+ Exception emergencyHandler:(Exception mailingEmergencyHandler)
+ [exEnd]
+"
+! !
+
+!GenericException class methodsFor:'initialization'!
+
+initialize
+ "setup the signal used to handle unhandled signals"
+
+ RecursiveExceptionSignal isNil ifTrue:[
+ RecursiveExceptionSignal := ErrorSignal newSignalMayProceed:false.
+ RecursiveExceptionSignal nameClass:self message:#recursiveExceptionSignal.
+ RecursiveExceptionSignal notifierString:'recursive signal raise in handler'
+ ]
+! !
+
+!GenericException class methodsFor:'instance creation'!
+
+signal:aSignal originator:origin
+ "create a new instance and set the fields in preparation for a raise.
+ - only to be sent from the signal when raising"
+
+ "{ Pragma: +inlineNew }"
+
+ ^ (self basicNew) signal:aSignal originator:origin.
+
+ "Created: / 23.7.1999 / 13:40:45 / stefan"
+!
+
+signal:aSignal parameter:aParameter errorString:aString suspendedContext:sContext originator:origin
+ "create a new instance and set the fields in preparation for a raise.
+ - only to be sent from the signal when raising"
+
+ "{ Pragma: +inlineNew }"
+
+ ^ (self basicNew)
+ signal:aSignal
+ parameter:aParameter
+ errorString:aString
+ suspendedContext:sContext
+ originator:origin.
+! !
+
+!GenericException class methodsFor:'Signal constants'!
+
+recursiveExceptionSignal
+ "return the signal used to handle recursive signals in the handlers"
+
+ ^ RecursiveExceptionSignal
+! !
+
+!GenericException class methodsFor:'compatibility - accessing'!
+
+errorString
+ "return the notifier string.
+ If the notifier string starts with space, prepend
+ the parents notifier string"
+
+ NotifierString isNil ifTrue:[
+ ^ self parent errorString
+ ] ifFalse:[
+ (NotifierString size > 0
+ and:[NotifierString first == (Character space)]) ifTrue:[
+ ^ self parent errorString, NotifierString
+ ] ifFalse:[
+ ^ NotifierString
+ ].
+ ]
+
+ "
+ Object errorSignal errorString
+ "
+
+ "Created: / 23.7.1999 / 14:22:25 / stefan"
+!
+
+errorStringExtra:extraString with:aParameter
+ "used when raising with a given error string and/or parameter;
+ if the errorString starts with a space, it is appended to the receivers
+ notifier string; if it ends with a space, it is prepended.
+ Otherwise, the extraString is returned.
+ If no extraString is given, use the signals default errorString."
+
+ |t|
+
+ (self inheritsFrom:Object userNotificationSignal) ifTrue:[
+ "/ all userNotifications pass the extraString unchanged.
+ ^ extraString
+ ].
+
+ extraString isNil ifTrue:[
+ t := self errorString
+ ] ifFalse:[
+ t := extraString.
+ (extraString endsWith:Character space) ifTrue:[
+ t := extraString, self errorString
+ ] ifFalse:[
+ (extraString startsWith:Character space) ifTrue:[
+ t := self errorString, extraString
+ ]
+ ].
+ ].
+ ^ t.
+
+"/ aParameter isNil ifTrue:[
+"/ ^ t
+"/ ].
+"/
+"/ (t startsWith:' ') ifTrue:[
+"/ ^ aParameter printString , t
+"/ ].
+"/ (t endsWith:' ') ifTrue:[
+"/ ^ t , aParameter printString
+"/ ].
+"/ ^ t
+
+ "Modified: / 25.3.1997 / 12:12:37 / cg"
+ "Created: / 23.7.1999 / 14:23:38 / stefan"
+!
+
+handlerBlock
+ "Compatibility with Signal. Class based exeptions do not have a handler
+ block. They redefine the #action method instead"
+
+ ^ nil
+
+ "Created: / 23.7.1999 / 14:43:18 / stefan"
+ "Modified: / 24.7.1999 / 20:52:10 / stefan"
+! !
+
+!GenericException class methodsFor:'compatibility - queries'!
+
+accepts:aSignal
+ "return true, if the receiver accepts the argument, aSignal.
+ (i.e. the receiver is aSignal or a parent of it). False otherwise."
+
+ |s|
+
+ aSignal isQuerySignal ifTrue:[^ false].
+
+ s := aSignal.
+ [s notNil] whileTrue:[
+ self == s ifTrue:[^ true].
+ s := s parent
+ ].
+ ^ false
+
+ "Created: / 23.7.1999 / 14:00:47 / stefan"
+!
+
+handlerForSignal:signal context:theContext originator:originator
+ "answer the handler block for the signal from originator.
+ The block is retrieved from aContext.
+ Answer nil if the signal is not handled"
+
+
+ (theContext selector ~~ #'handle:from:do:'
+ or:[(theContext argAt:2) == originator]) ifTrue:[
+ (self accepts:signal) ifTrue:[
+ ^ theContext argAt:1
+ ]
+ ].
+
+ ^ nil
+
+ "Created: / 25.7.1999 / 19:52:58 / stefan"
+!
+
+handlingExceptionInContext:theContext
+ "answer the handling exception from aContext."
+
+ (theContext selector == #'handle:from:do:'
+ or:[theContext selector == #'handle:do:']) ifTrue:[
+ ^ theContext receiver
+ ].
+
+ ^ nil
+!
+
+inheritsFrom:anotherSignal
+ "return true, if the receiver is a child of anotherSignal
+ (i.e. if handling anotherSignal also handles the receiver)
+ This is almost the same as accepts, but returns false, if
+ the receiver is identical to anotherSignal."
+
+ self == anotherSignal ifTrue:[^ false].
+ ^ anotherSignal accepts:self
+
+ "Created: / 23.7.1999 / 13:59:51 / stefan"
+!
+
+isHandled
+ "return true, if there is a handler for the receiver signal.
+ Raising an unhandled signal will usually lead into the debugger,
+ but can be caught globally by setting Exceptions EmergencyHandler."
+
+ ^ self isHandledIn:(thisContext sender).
+
+ "Created: / 23.7.1999 / 14:03:50 / stefan"
+!
+
+isHandledIn:aContext
+ "return true, if there is a handler for the receiver signal in the
+ contextChain starting with aContext."
+
+ |con r|
+
+ con := aContext.
+ [con notNil] whileTrue:[
+ con := con findSpecialHandle:true raise:false.
+ con notNil ifTrue:[
+ ((r := con receiver) notNil
+ and:[(r handlerForSignal:self context:con originator:nil) notNil]
+ ) ifTrue:[
+ "found a handler context"
+ ^ true
+ ]
+ ]
+ ].
+ ^ false
+
+ "Created: / 23.7.1999 / 14:03:34 / stefan"
+ "Modified: / 25.7.1999 / 22:59:03 / stefan"
+!
+
+isQuerySignal
+ "return true, if this is a querySignal - always return false here"
+
+ ^ false
+
+ "Created: / 23.7.1999 / 13:50:16 / stefan"
+!
+
+isSignal
+ "return true, if the receiver is some kind of signal;
+ true returned here - the method is redefined from Object."
+
+ ^ true
+
+ "Created: / 23.7.1999 / 13:49:59 / stefan"
+!
+
+mayProceed
+ "return true, if the exception handler is allowed to proceed
+ the execution where the exception occured.
+
+ Subclasses may redefine this."
+
+ ^ true
+
+ "Modified: / 23.7.1999 / 14:50:11 / stefan"
+!
+
+parent
+ "return the parent Signal/Exception of myself.
+ Subclasses may redefine this to install themself as child of
+ existing Signals."
+
+ self == GenericException ifTrue:[
+ ^ nil
+ ].
+
+ ^ self superclass
+
+ "Created: / 23.7.1999 / 14:01:29 / stefan"
+ "Modified: / 23.7.1999 / 16:15:38 / stefan"
+! !
+
+!GenericException class methodsFor:'compatibility - raising'!
+
+new
+
+ ^ self basicNew signal:self.
+
+ "Modified: / 23.7.1999 / 13:53:12 / stefan"
+ "Created: / 24.7.1999 / 13:21:13 / stefan"
+!
+
+newException
+
+ ^ self new
+
+ "Created: / 23.7.1999 / 13:45:49 / stefan"
+ "Modified: / 24.7.1999 / 13:21:25 / stefan"
+!
+
+newExceptionFrom:originator
+ "answer a new exception object for this signal.
+ Set the originator.
+ Subclasses may redefine this method"
+
+ ^ self new originator:originator
+
+ "Created: / 23.7.1999 / 13:47:07 / stefan"
+!
+
+raise
+ "raise a signal nonproceedable.
+ The signals notifierString is used as errorString."
+
+ ^ self newException raise
+
+ "Modified: / 2.5.1996 / 16:36:23 / cg"
+ "Modified: / 5.3.1998 / 16:44:36 / stefan"
+ "Created: / 23.7.1999 / 14:07:17 / stefan"
+!
+
+raiseErrorString:aString
+ "raise a signal nonproceedable.
+ The argument is used as errorString."
+
+ ^ (self newException errorString:aString) raise.
+
+ "Modified: / 9.5.1996 / 15:17:59 / cg"
+ "Modified: / 12.3.1998 / 15:15:22 / stefan"
+ "Created: / 23.7.1999 / 14:07:33 / stefan"
+!
+
+raiseErrorString:aString in:aContext
+ "raise a signal nonproceedable.
+ The argument is used as errorString.
+ The additional context is passed as the context responsible for the raise,
+ allowing a raise to mimicri the exception happened somewhere else."
+
+ ^ (self newException
+ signal:self
+ parameter:nil
+ errorString:aString
+ suspendedContext:aContext
+ originator:nil) raise.
+
+ "Modified: / 26.7.1996 / 16:42:47 / cg"
+ "Modified: / 12.3.1998 / 15:43:43 / stefan"
+ "Created: / 23.7.1999 / 14:07:48 / stefan"
+!
+
+raiseFrom:something
+ "raise a signal nonproceedable.
+ The argument, something is passed both as parameter and originator."
+
+ ^ ((self newExceptionFrom:something) parameter:something) raise
+
+ "Modified: / 2.5.1996 / 16:36:38 / cg"
+ "Modified: / 5.3.1998 / 16:49:55 / stefan"
+ "Created: / 23.7.1999 / 14:07:59 / stefan"
+!
+
+raiseIn:aContext
+ "raise a signal nonproceedable.
+ The signals notifierString is used as errorString.
+ The additional context is passed as the context responsible for the raise,
+ allowing a raise to mimicri the exception happened somewhere else."
+
+ ^ (self newException suspendedContext:aContext) raise.
+
+ "Modified: / 2.5.1996 / 16:36:44 / cg"
+ "Modified: / 5.3.1998 / 16:50:21 / stefan"
+ "Created: / 23.7.1999 / 14:08:13 / stefan"
+!
+
+raiseRequest
+ "raise a signal proceedable.
+ The signals notifierString is used as errorString."
+
+ ^ self newException raiseRequest.
+
+ "Modified: / 2.5.1996 / 16:36:52 / cg"
+ "Modified: / 5.3.1998 / 16:50:46 / stefan"
+ "Created: / 23.7.1999 / 14:08:24 / stefan"
+!
+
+raiseRequestFrom:something
+ "raise a signal proceedable.
+ The argument, something is passed both as parameter and originator."
+
+ ^ ((self newExceptionFrom:something) parameter:something) raiseRequest.
+
+ "Modified: / 2.5.1996 / 16:36:38 / cg"
+ "Modified: / 5.3.1998 / 16:52:46 / stefan"
+ "Created: / 23.7.1999 / 14:08:36 / stefan"
+!
+
+raiseRequestWith:aParameter
+ "raise a signal proceedable.
+ The signals notifierString is used as errorString."
+
+ ^ (self newException parameter:aParameter) raiseRequest.
+
+ "Modified: / 9.5.1996 / 15:13:20 / cg"
+ "Modified: / 12.3.1998 / 15:16:57 / stefan"
+ "Created: / 23.7.1999 / 14:08:48 / stefan"
+!
+
+raiseRequestWith:aParameter errorString:aString
+ "raise a signal proceedable.
+ The argument, aString is used as errorString."
+
+ ^ (self newException
+ parameter:aParameter;
+ errorString:aString
+ ) raiseRequest
+
+ "Modified: / 9.5.1996 / 15:13:35 / cg"
+ "Modified: / 12.3.1998 / 15:17:52 / stefan"
+ "Created: / 23.7.1999 / 14:08:57 / stefan"
+!
+
+raiseRequestWith:aParameter errorString:aString in:aContext
+ "raise a signal proceedable.
+ The argument, aString is used as errorString.
+ The additional context is passed as the context responsible for the raise,
+ allowing a raise to mimicri the exception happened somewhere else."
+
+ ^ (self newException
+ parameter:aParameter;
+ errorString:aString;
+ suspendedContext:aContext) raiseRequest
+
+ "Modified: / 26.7.1996 / 16:29:27 / cg"
+ "Modified: / 12.3.1998 / 15:18:34 / stefan"
+ "Created: / 23.7.1999 / 14:09:07 / stefan"
+!
+
+raiseRequestWith:aParameter in:aContext
+ "raise a signal proceedable.
+ The signals notifierString is used as errorString.
+ The additional context is passed as the context responsible for the raise,
+ allowing a raise to mimicri the exception happened somewhere else."
+
+ ^ (self newException
+ parameter:aParameter;
+ suspendedContext:aContext) raiseRequest.
+
+ "Modified: / 26.7.1996 / 16:29:33 / cg"
+ "Modified: / 12.3.1998 / 15:18:55 / stefan"
+ "Created: / 23.7.1999 / 14:09:17 / stefan"
+!
+
+raiseWith:aParameter
+ "raise a signal nonproceedable.
+ The argument, aParameter is passed as parameter."
+
+ ^ (self newException parameter:aParameter) raise.
+
+ "Modified: / 9.5.1996 / 15:14:24 / cg"
+ "Modified: / 12.3.1998 / 15:19:11 / stefan"
+ "Created: / 23.7.1999 / 14:09:27 / stefan"
+!
+
+raiseWith:aParameter errorString:aString
+ "raise a signal nonproceedable.
+ The argument, aString is used as errorString, aParameter is passed
+ as exception parameter."
+
+ ^ (self newException
+ parameter:aParameter;
+ errorString:aString) raise.
+
+ "Modified: / 9.5.1996 / 15:14:32 / cg"
+ "Modified: / 12.3.1998 / 15:19:40 / stefan"
+ "Created: / 23.7.1999 / 14:09:36 / stefan"
+!
+
+raiseWith:aParameter errorString:aString in:aContext
+ "raise a signal nonproceedable.
+ The argument, aString is used as errorString, aParameter is passed
+ as exception parameter.
+ The additional context is passed as the context responsible for the raise,
+ allowing a raise to mimicri the exception happened somewhere else."
+
+
+ ^ (self newException
+ parameter:aParameter;
+ errorString:aString;
+ suspendedContext:aContext) raise.
+
+ "Modified: / 26.7.1996 / 16:29:42 / cg"
+ "Modified: / 12.3.1998 / 15:20:12 / stefan"
+ "Created: / 23.7.1999 / 14:09:46 / stefan"
+!
+
+raiseWith:aParameter in:aContext
+ "raise a signal nonproceedable.
+ The argument, aParameter is passed as parameter."
+
+ ^ (self newException parameter:aParameter;
+ suspendedContext:aContext) raise.
+
+ "Modified: / 9.5.1996 / 15:14:24 / cg"
+ "Modified: / 12.3.1998 / 15:34:51 / stefan"
+ "Created: / 23.7.1999 / 14:10:04 / stefan"
+! !
+
+!GenericException class methodsFor:'compatibility - save evaluation'!
+
+catch:aBlock
+ "evaluate the argument, aBlock.
+ If the receiver-signal is raised during evaluation, abort
+ the evaluation and return true; otherwise return false.
+ This is the catch & throw mechanism found in other languages,
+ where the returned value indicates if an exception occured."
+
+ |raiseOccurred|
+
+ raiseOccurred := false.
+ self handle:[:ex | raiseOccurred := true. ex return] do:aBlock.
+ ^ raiseOccurred
+
+ "
+ Object messageNotUnderstoodSignal catch:[
+ 123 size open
+ ]
+ "
+
+ "Created: / 23.7.1999 / 14:06:01 / stefan"
+!
+
+handle:handleBlock do:aBlock
+ "evaluate the argument, aBlock.
+ If the receiver-signal is raised during evaluation,
+ evaluate the handleBlock passing it an Exception argument.
+ The handler may decide how to react to the signal by sending
+ a corresponding message to the exception (see there).
+ If the signal is not raised, return the value of evaluating
+ aBlock."
+
+ thisContext markForHandle.
+ ^ aBlock value "the real logic is in Exception>>doRaise"
+
+ "
+ Object messageNotUnderstoodSignal handle:[:ex |
+ 'oops' printNL.
+ ex return
+ ] do:[
+ 123 size open
+ ]
+ "
+
+ "
+ |num|
+
+ num := 0.
+ Number divisionByZeroSignal handle:[:ex |
+ 'oops' printNL.
+ ex return
+ ] do:[
+ 123 / num
+ ]
+ "
+
+ "Created: / 23.7.1999 / 14:06:13 / stefan"
+ "Modified: / 25.7.1999 / 19:44:05 / stefan"
+!
+
+handle:handleBlock from:anObject do:aBlock
+ "evaluate the argument, aBlock.
+ If the receiver-signal is raised during evaluation,
+ and the exception originated from anObject,
+ evaluate the handleBlock passing it an Exception argument.
+ The handler may decide how to react to the signal by sending
+ a corresponding message to the exception (see there).
+ If the signal is not raised, return the value of evaluating
+ aBlock."
+
+ thisContext markForHandle.
+ ^ aBlock value "the real logic is in Exception>>doRaise"
+
+ "
+ the first open will be caught; the second not:
+
+ |o1 o2|
+
+ o1 := 123.
+ o2 := nil.
+ Object messageNotUnderstoodSignal
+ handle:
+ [:ex |
+ 'oops' printNL.
+ ex proceed
+ ]
+ from:o1
+ do:
+ [
+ o1 open.
+ o2 open
+ ]
+ "
+
+ "Created: / 23.7.1999 / 14:06:26 / stefan"
+ "Modified: / 25.7.1999 / 19:44:13 / stefan"
+!
+
+ignoreIn:aBlock
+ "evaluate the argument, aBlock.
+ Ignore the receiver-signal during evaluation - i.e. simply
+ continue.
+ This makes only sense for some signals, such as UserInterrupt
+ or AbortSignal, because continuing after an exception without any cleanup
+ often leads to followup-errors."
+
+ ^ self handle:[:ex | ex proceed] do:aBlock.
+
+ "
+ Object messageNotUnderstoodSignal ignoreIn:[
+ 123 size open
+ ]
+ "
+
+ "Created: / 23.7.1999 / 14:06:40 / stefan"
+! !
+
+!GenericException class methodsFor:'compatibility - signal creation'!
+
+newSignal
+ "create a new signal, using the receiver as a prototype and
+ setting the parent of the new signal to the receiver."
+
+ ^ self newSignalMayProceed:self mayProceed
+
+ "Created: / 23.7.1999 / 20:13:23 / stefan"
+!
+
+newSignalMayProceed:proceed
+ "create a new signal, using the receiver as a prototype and
+ setting the parent of the new signal to the receiver."
+
+ ^ (Signal basicNew) mayProceed:proceed;
+ notifierString:NotifierString;
+ parent:self
+
+ "Created: / 23.7.1999 / 20:12:43 / stefan"
+! !
+
+!GenericException class methodsFor:'defaults'!
+
+emergencyHandler
+ "return the handler used for unhandled exceptions.
+
+ If no EmergencyHandler has been set, a handler which enters the
+ debugger is returned.
+ The debugger is opened by asking the signal for a debug action,
+ this allows to provide other debuggers in specialized (subclass-instances)
+ of Signal (if that is ever needed)"
+
+ "
+ set it up, when called the first time
+ "
+ EmergencyHandler isNil ifTrue:[
+ EmergencyHandler := [:ex |
+ "
+ sending it to the signal allows per-signal specific
+ debuggers to be implemented in the future
+ (for example, segv in primitive code could show things
+ on the C-level ..)
+ "
+ (ex signal) enterDebuggerWith:ex message:(ex errorString).
+ ]
+ ].
+
+ ^ EmergencyHandler
+
+ "Modified: 15.1.1997 / 20:50:37 / cg"
+!
+
+emergencyHandler:aOneArgBlock
+ "set the handler used for unhandled exceptions.
+ The default (a nil-handler) leads to a debugger to be shown."
+
+ EmergencyHandler := aOneArgBlock
+
+ "ST-80 behavior of first showing a notifier:
+ (I prefer to get right into the debugger, though)
+
+ Exception
+ emergencyHandler:
+ [:ex | self errorNotify:ex errorString ]
+ "
+
+ "ST-X behavior of going right into the debugger:
+
+ Exception
+ emergencyHandler:nil
+ "
+
+ "automatically aborting current operation, on error:
+ (may be useful for end-user apps; make certain,
+ you have abortSignal handlers at appropriate places)
+
+ Exception
+ emergencyHandler:
+ [:ex | Object abortSignal raise. ex return. ]
+ "
+
+ "finally, traditional language system behavior; dump core ;-)
+
+ Exception
+ emergencyHandler:
+ [:ex | Smalltalk exitWithCoreDump. ]
+ "
+
+ "Modified: 15.1.1997 / 20:49:06 / cg"
+! !
+
+!GenericException class methodsFor:'useful handlers'!
+
+abortingEmergencyHandler
+ "return a block (usable as an emergency handler),
+ which aborts after showing a warnBox.
+ This is useful for endUser applications"
+
+ ^ [:ex | self warn:'Error: ' , ex errorString.
+ AbortSignal raise
+ ]
+
+ "test with (try a few halts or CTRL-C's):
+ Exception emergencyHandler:(Exception abortingEmergencyHandler)
+ "
+
+ "back with:
+ Exception emergencyHandler:(Exception notifyingEmergencyHandler)
+ Exception emergencyHandler:nil
+ "
+
+ "Created: 15.1.1997 / 20:13:06 / cg"
+ "Modified: 15.1.1997 / 20:15:02 / cg"
+!
+
+dumpingEmergencyHandler
+ "return a block (usable as an emergency handler),
+ which dumps the stackBacktrace to a trace file and
+ aborts after showing a warnBox.
+ This is useful, for endUser application, which are still being
+ debugged (i.e. the programmers may have a look at the traceFile
+ from time to time).
+
+ Notice:
+ The code below is just an example; you may want to change the
+ name of the error-file in your application
+ (but please: copy the code; do not modify here)"
+
+ ^ [:ex |
+ |str printedException|
+
+ ex signal == Signal noHandlerSignal ifTrue:[
+ printedException := ex parameter.
+ ] ifFalse:[
+ printedException := ex
+ ].
+
+ "/ user interruption is handled specially:
+ "/ allow user to choose between proceeding or aborting
+ "/ but never dump that information to the file.
+
+ printedException signal == Object userInterruptSignal ifTrue:[
+ (self confirm:'abort current action ?') ifTrue:[
+ AbortSignal raise
+ ].
+ ex proceed
+ ].
+
+ "/
+ "/ dump it to 'errorTrace.stx'
+ "/
+ str := 'errorTrace.stx' asFilename appendingWriteStream.
+
+ str nextPutLine:('******************************* '
+ , AbsoluteTime now printString
+ , ' *******************************').
+ str cr.
+
+ str nextPutLine:('** Error: ' , printedException errorString).
+ str nextPutLine:('** Signal: ' , printedException signal printString).
+ str nextPutLine:('** Parameter: ' , printedException parameter printString).
+ str nextPutLine:('** Process: ' , Processor activeProcess printString).
+ str nextPutLine:('** Backtrace:').
+ str cr.
+
+ printedException suspendedContext fullPrintAllOn:str.
+ str cr.
+ str cr.
+ str close.
+
+ "/ send a line to stdErr
+
+ ('[warning]: ignored error: ' , printedException errorString) errorPrintCR.
+ ('[warning]: error information appended to ''errorTrace.stx''') errorPrintCR.
+
+ AbortSignal raise
+ ]
+
+ "test with (try a few halts or CTRL-C's):
+ Exception emergencyHandler:(Exception dumpingEmergencyHandler)
+ "
+
+ "back with:
+ Exception emergencyHandler:(Exception notifyingEmergencyHandler)
+ Exception emergencyHandler:nil
+ "
+
+ "Created: 15.1.1997 / 20:14:52 / cg"
+ "Modified: 24.1.1997 / 20:36:21 / cg"
+!
+
+mailingEmergencyHandler
+ "return a block (usable as an emergency handler),
+ which shows a warnBox and optionally mails a stackBacktrace to a maintainer.
+ This is useful, for endUser application, which are still being
+ debugged (i.e. the programmers may have a look at the errors).
+
+ Notice: the stuff here is a demonstration only; it should be modified
+ for your particular environment ...
+ ... but please: copy the code and modify there;
+ leave the stuff below as it is."
+
+ ^ [:ex |
+ |str printedException doMail emergencyMailReceiver pipe|
+
+ ex signal == Signal noHandlerSignal ifTrue:[
+ printedException := ex parameter.
+ ] ifFalse:[
+ printedException := ex
+ ].
+
+ "/ user interruption is handled specially:
+ "/ allow user to choose between proceeding or aborting
+ "/ but never dump that information to the file.
+
+ printedException signal == Object userInterruptSignal ifTrue:[
+ (self confirm:'abort current action ?') ifTrue:[
+ AbortSignal raise
+ ].
+ ex proceed
+ ].
+
+ "/ somehow get the name of the guy to receive the mail
+ "/ you have to implement that yourself.
+
+ "/ emergencyMailReceiver := OneOfYourClass getEmergencyMailReceiver.
+ emergencyMailReceiver := OperatingSystem getLoginName.
+
+ emergencyMailReceiver isNil ifTrue:[
+ self warn:(printedException errorString
+ , '\\No mailing to service people possible.') withCRs.
+ doMail := false.
+ ] ifFalse:[
+ doMail := self confirm:(printedException errorString
+ , '\\Mail error information to the service people ('
+ , emergencyMailReceiver , ') ?') withCRs
+ ].
+ doMail ifTrue:[
+ str := '' writeStream.
+
+ str nextPutLine:('Error notification from '
+ , OperatingSystem getLoginName
+ , '@'
+ , OperatingSystem getHostName).
+ str cr.
+
+ str nextPutLine:('Time: ' , AbsoluteTime now printString).
+ str nextPutLine:('Error: ', printedException errorString).
+ str nextPutLine:('Signal: ', printedException signal printString).
+ str nextPutLine:('Parameter: ', printedException parameter printString).
+ str nextPutLine:('Process: ', Processor activeProcess printString).
+ str nextPutLine:'Backtrace:'.
+ str cr.
+
+ printedException suspendedContext fullPrintAllOn:str.
+ str cr;cr.
+
+ str close.
+
+ pipe := PipeStream
+ writingTo:'mail ', emergencyMailReceiver.
+ pipe notNil ifTrue:[
+ pipe nextPutLine:'Subject: automatic error report'.
+ pipe nextPutAll:str contents.
+ pipe cr.
+ pipe close.
+ ]
+ ].
+
+ AbortSignal raise
+ ]
+
+ "test with (try a few halts or CTRL-C's):
+ Exception emergencyHandler:(Exception mailingEmergencyHandler)
+ "
+
+ "back with:
+ Exception emergencyHandler:(Exception notifyingEmergencyHandler)
+ Exception emergencyHandler:nil
+ "
+
+ "Created: 15.1.1997 / 20:14:52 / cg"
+ "Modified: 15.1.1997 / 21:10:28 / cg"
+!
+
+notifyingEmergencyHandler
+ "return a block (usable as an emergency handler for exceptions),
+ which does errorNotification before going into the debugger."
+
+ ^ [:ex | nil errorNotify:ex errorString from:ex suspendedContext ]
+
+ "test with (try a few halts or CTRL-C's):
+ Exception emergencyHandler:(Exception notifyingEmergencyHandler)
+ "
+
+ "back with:
+ Exception emergencyHandler:nil
+ "
+
+ "Modified: 15.1.1997 / 20:15:12 / cg"
+! !
+
+!GenericException methodsFor:'accessing'!
+
+errorString
+ "return the errorString passsed with the signal raise
+ (or nil, if there was none)"
+
+ ^ signal errorStringExtra:errorString with:nil
+
+ "Modified: / 12.3.1998 / 15:13:28 / stefan"
+!
+
+errorString:aString
+ "set the errorString.
+ If it starts with a space, the signals errorString is prepended,
+ if it ends with a space, it is appended."
+
+ errorString := aString
+
+ "Created: / 5.3.1998 / 16:45:29 / stefan"
+ "Modified: / 12.3.1998 / 15:30:45 / stefan"
+!
+
+handlerContext
+ "return the context of the handler"
+
+ ^ handlerContext
+!
+
+handlingSignal
+ "return the handling signal (or signalSet or Exception).
+ This is only valid during handler evaluation, and answers
+ the object which accepted the actual signal.
+ (i.e. the parent or signalSet or handlerCollection)"
+
+ ^ handlingSignal
+!
+
+originator
+ "return the originator passsed with the signal raise
+ (or nil, if there was none)"
+
+ ^ originator
+!
+
+originator:anObject
+ "set the originator"
+
+ originator := anObject
+
+ "Created: / 5.3.1998 / 16:34:56 / stefan"
+!
+
+parameter
+ "return the parameter passsed with the signal raise
+ (or nil, if there was none)"
+
+ ^ parameter
+!
+
+parameter:anObject
+ "set the parameter of the exception"
+
+ parameter := anObject
+
+ "Created: / 5.3.1998 / 16:34:22 / stefan"
+!
+
+rejected
+ "return true, if any other of the exceptions handlers has rejected
+ Uncertain, if this is really interesting to anybody.
+ This is only valid during handler execution.
+ (i.e. an outer handler can find out, if any other handler has already
+ rejected).
+ Currently only used to change the 'unhandled-exception' errorString
+ into 'rejected-exception' for information).
+ "
+
+ ^ rejected
+!
+
+signal
+ "return the signal, that caused the exception"
+
+ ^ signal
+!
+
+signal:aSignal
+ "set the signal, that caused the exception"
+
+ signal := aSignal
+
+ "Created: / 5.3.1998 / 16:02:46 / stefan"
+!
+
+suspendedContext
+ "return the context in which the raise occured"
+
+ ^ suspendedContext
+!
+
+suspendedContext:something
+ "set the value of the instance variable 'suspendedContext' (automatically generated)"
+
+ suspendedContext := something.
+
+ "Created: / 2.3.1998 / 12:43:20 / stefan"
+!
+
+willProceed
+ "return true, if the exception is proceedable"
+
+ ^ resumeBlock notNil and:[proceedable]
+
+ "Modified: / 2.3.1998 / 12:20:43 / stefan"
+! !
+
+!GenericException methodsFor:'copying'!
+
+postCopy
+ "set the internal state to nil"
+
+ suspendedContext := handlerContext := rejected := nil
+
+ "Created: / 2.3.1998 / 12:30:06 / stefan"
+! !
+
+!GenericException methodsFor:'default actions'!
+
+action
+ "perform a action for the signal if it hasn't been catched
+ We arrive here, if either no handler was found, or none of the
+ handlers did a return (i.e. every handler rejected or fell through).
+
+ The default is to evaluate the signal's handlerBlock or the
+ per process handler (if its the noHandlerSignal).
+ Finally fall back to Exceptions emergencyHandler, which is always
+ available and enters the debugger.
+ Subclasses may redefine this."
+
+ |block noHandlerSignal msg|
+
+ "
+ try per signal handler
+ "
+ (block := signal handlerBlock) isNil ifTrue:[
+ "/
+ "/ if its a querySignal, ignore it
+ "/
+ signal isQuerySignal ifTrue:[^ nil].
+
+ "/
+ "/ if it is not the NoHandlerSignal, raise it ...
+ "/ passing the receiver as parameter.
+ "/
+ signal ~~ (noHandlerSignal := Signal noHandlerSignal) ifTrue:[
+ noHandlerSignal notNil ifTrue:[
+ handlerContext notNil ifTrue:[
+ msg := 'unhandled (rejected)'
+ ] ifFalse:[
+ msg := 'unhandled'
+ ].
+ msg := msg , ' exception: (' , self errorString , ')'.
+ ^ noHandlerSignal
+ raiseRequestWith:self
+ errorString:msg
+ in:self suspendedContext
+ ].
+ "/
+ "/ mhmh - an error during early startup; noHandlerSignal is
+ "/ not yet defined.
+ "/
+ ^ MiniDebugger enterWithMessage:self errorString
+ ].
+
+ "
+ mhmh - smells like trouble - there is no handler and
+ no per-signal handler block.
+ Look for either a per-process emergencyHandlerBlock
+ or the global emergencyHandler (from Exception) ...
+ "
+ Processor notNil ifTrue:[
+ "care for signal during startup (Processor not yet created)"
+ block := Processor activeProcess emergencySignalHandler.
+ ].
+ block isNil ifTrue:[
+ block := Exception emergencyHandler.
+ block isNil ifTrue:[
+ "care for error during startup (Exception not yet initialized)"
+ ^ MiniDebugger enterWithMessage:self errorString
+ ].
+ ].
+ ].
+ "... and call it"
+ ^ block value:self.
+
+ "Created: / 23.7.1999 / 14:38:03 / stefan"
+ "Modified: / 25.7.1999 / 20:11:12 / stefan"
+!
+
+mayProceed
+ "return true, if the exception handler is allowed to proceed
+ the execution where the exception occured.
+
+ Subclasses may redefine this."
+
+ ^ signal mayProceed
+
+ "Created: / 23.7.1999 / 14:48:26 / stefan"
+! !
+
+!GenericException methodsFor:'handler actions'!
+
+proceed
+ "Continue after the raise - the raise returns nil"
+
+ |b|
+
+ resumeBlock isNil ifTrue:[
+ "signal raiser does not want us to proceed"
+ Signal proceedErrorSignal raiseWith:self.
+ ] ifFalse:[
+ proceedable ifFalse:[
+ ('WARNING: signal <', signal printString, '> has been raised nonproceedable') errorPrintCR.
+ (' by: ', suspendedContext printString) errorPrintCR.
+ (' ', thisContext sender printString , ' tries to proceed.') errorPrintCR.
+ (' This will be an error in future ST/X versions.') errorPrintCR.
+ ].
+ b := resumeBlock.
+ resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
+ b value:nil
+ ]
+
+ "
+ Object errorSignal handle:[:ex|
+ ex proceed
+ ] do:[
+ Object errorSignal raise
+ ].
+ "
+
+ "Modified: / 27.3.1997 / 16:44:39 / cg"
+ "Modified: / 2.3.1998 / 12:00:10 / stefan"
+!
+
+proceedWith:value
+ "Continue after the raise - the raise returns value"
+
+ |b|
+
+ resumeBlock isNil ifTrue:[
+ "signal raiser does not want us to proceed"
+ Signal proceedErrorSignal raiseWith:self.
+ ] ifFalse:[
+ proceedable ifFalse:[
+ ('WARNING: signal <', signal printString, '> has been raised nonproceedable') errorPrintCR.
+ (' by: ', suspendedContext printString) errorPrintCR.
+ (' ', thisContext sender printString , ' tries to proceed.') errorPrintCR.
+ (' This will be an error in future ST/X versions.') errorPrintCR.
+ ].
+ b := resumeBlock.
+ resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
+ b value:value
+ ]
+
+ "Modified: / 27.3.1997 / 16:45:57 / cg"
+ "Modified: / 2.3.1998 / 12:02:06 / stefan"
+!
+
+reject
+ "handler decided not to handle this signal -
+ system will look for another handler"
+
+"/ |con|
+"/
+"/ "/ find my raise context
+"/ con := thisContext findSpecialHandle:false raise:true.
+"/ [con notNil and:[con receiver ~~ self]] whileTrue:[
+"/ con := con findSpecialHandle:false raise:true.
+"/ ].
+"/ rejected := true.
+"/ con unwind:nil.
+"/self halt.
+
+ rejected := true.
+ rejectBlock value
+
+ "
+ Object errorSignal handle:[:ex |
+ '1' printCR.
+ ex reject
+ ] do:[
+ Object errorSignal handle:[:ex |
+ '2' printCR.
+ ex reject
+ ] do:[
+ #() at:1
+ ]
+ ]
+ "
+!
+
+restart
+ "restart the handle:do: - usually after some repair work is done
+ in the handler"
+
+ handlerContext unwindAndRestart
+
+ "
+ |rslt n|
+
+ Object errorSignal handle:[:ex |
+ 'fixing divisor ...' printCR.
+ n := 1.
+ ex restart.
+ ] do:[
+ rslt := 5 / n.
+ ].
+ rslt
+ "
+!
+
+restartDo:aBlock
+ "restart the handle:do: but execute the argument, aBlock instead of the
+ original do-block - usually after some repair work is done in handler"
+
+ handlerContext selector == #'handle:do:' ifFalse:[
+ self error:'unimplemented feature'.
+ ].
+
+"/ handlerContext unwindThenDo:[
+"/ handlerContext receiver
+"/ handle:(handlerContext argAt:1)
+"/ do:aBlock
+"/ ].
+ handlerContext argAt:2 put:aBlock.
+ handlerContext unwindAndRestart
+
+ "
+ |sig rslt|
+
+ sig := Signal new.
+
+ sig handle:[:ex |
+ ex restartDo:[ rslt := 999 ]
+ ] do:[
+ rslt := 0.
+ sig raise
+ ].
+ Transcript showCR:rslt
+ "
+
+ "
+ |sig rslt|
+
+ Object errorSignal handle:[:ex |
+ ex restartDo:[ rslt := 999 ]
+ ] do:[
+ rslt := nil foo.
+
+ ].
+ Transcript showCR:rslt
+ "
+
+ "
+ |sig rslt|
+
+ Object errorSignal handle:[:ex |
+ ex restartDo:[ 'handler' printCR. rslt := nil foo ]
+ ] do:[
+ rslt := nil foo.
+
+ ].
+ Transcript showCR:rslt
+ "
+
+ "Modified: / 8.11.1997 / 18:52:28 / cg"
+!
+
+resume
+ "Continue after the raise - the raise returns nil
+ obsolete (use #proceed), retained for backwards compatibility"
+
+ self obsoleteMethodWarning:'use #proceed'.
+ ^ self proceed
+
+ "Modified: / 2.3.1998 / 10:51:55 / stefan"
+!
+
+resumeWith:value
+ "Continue after the raise - the raise returns value
+ obsolete (use #proceedWith:), retained for backwards compatibility"
+
+ self obsoleteMethodWarning:'use #proceedWith:'.
+ ^ self proceedWith:value
+
+ "Modified: / 2.3.1998 / 10:51:48 / stefan"
+!
+
+return
+ "Continue after the handle:do: - the handle:do: returns nil"
+
+ |con|
+
+ con := handlerContext.
+ resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
+ con unwind:nil
+
+ "Modified: 27.3.1997 / 16:46:39 / cg"
+!
+
+returnDoing:aBlock
+ "Continue after the handle:do: - the handle:do: returns aBlock value"
+
+ handlerContext unwindThenDo:aBlock
+!
+
+returnWith:value
+ "Continue after the handle:do: - the handle:do: returns value"
+
+ |con|
+
+ con := handlerContext.
+ resumeBlock := rejectBlock := handlerContext := suspendedContext := nil.
+ con unwind:value
+
+ "Modified: 27.3.1997 / 16:46:51 / cg"
+! !
+
+!GenericException methodsFor:'private'!
+
+XXdoRaise
+ "search through the context-calling chain for a 'handle:do:'-context
+ to the raising signal, a parent of it, or a SignalSet which includes
+ the raising signal.
+ If found, take the contexts 2nd argument (the handler) and evaluate
+ it with the receiver exception as argument.
+ If no handler is found, try per signal handler, or
+ per process handler (if its the noHandlerSignal).
+ Finally fall back to Exceptions emergencyHandler, which is always
+ available and enters the debugger.
+ ATTENTION: the code below depends on being called by #raise or
+ #raiseRequest for proper operation (it skips the sending context)."
+
+ |theContext conArg1
+ theSignal c ex1 activeHandlers inHandler
+ lastHandler h r firstHandler|
+
+ "/ is nil a valid originator? If so, we need an extra
+ "/ instanceVariable to record the originator setting.
+
+ originator isNil ifTrue:[
+ originator := suspendedContext homeReceiver
+ ].
+
+ theSignal := signal.
+ theSignal isSignal ifFalse:[
+ self halt:'unexpected non-Signal in calling context'.
+ ].
+
+"/ 'search handler for: ' print. theSignal displayString printCR.
+
+ inHandler := false.
+ c := thisContext sender sender. "the raise/raiseRequest-context"
+ "the signal raise context"
+
+ "/ since the exceptionHandler is evaluated onTop of the
+ "/ contextChain, we must skip active handlers before searching.
+ "/ otherwise, we get into trouble, when re-raising an exception
+ "/ from within a handler (which would lead to re-executing the
+ "/ same handler)
+ "/ the code below collects active handlers ...
+
+ "/ on the fly, look for the first #handle:do: - context,
+ "/ and remember it (as firstHandler) to avoid walking the context chain twice
+ "/ in most cases ...
+
+ firstHandler := nil.
+
+ [c notNil] whileTrue:[
+ firstHandler isNil ifTrue:[
+ c := c findNextContextWithSelector:#doRaise or:#'handle:do:' or:#'handle:from:do:'.
+ ] ifFalse:[
+ c := c findNextContextWithSelector:#doRaise or:nil or:nil.
+ ].
+ c notNil ifTrue:[
+ (c selector == #doRaise) ifTrue:[
+
+ ex1 := c receiver.
+
+ ((ex1 class == self class)
+ or:[ex1 species == self species]) ifTrue:[
+ (ex1 signal == theSignal) ifTrue:[
+ h := ex1 handlerContext.
+ h notNil ifTrue:[
+ r := h receiver.
+ (r notNil and:[r accepts:theSignal]) ifTrue:[
+ activeHandlers isNil ifTrue:[
+ activeHandlers := OrderedCollection new
+ ].
+
+ lastHandler := h.
+ activeHandlers add:lastHandler.
+ inHandler := true.
+ c := lastHandler.
+ ]
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ "/ must be a #handle:do context ...
+ firstHandler := c.
+ ]
+ ]
+ ].
+
+ "/ now, start searching for a handler,
+ "/ start search above the last active handler.
+ "/ Or start with the first handle:do: context, if one
+ "/ was found as a side effect of the previous handler search.
+ "/ If nil, then there is no handler and we can directly proceed
+ "/ to the unhandled code below.
+
+"/ lastHandler notNil ifTrue:[
+"/ theContext := lastHandler.
+"/ theContext := lastHandler findNextContextWithSelector:#'handle:do:' or:#'handle:from:do:' or:nil.
+"/ ] ifFalse:[
+ theContext := firstHandler.
+"/ ].
+
+ [theContext notNil] whileTrue:[
+ (theContext selector == #'handle:do:'
+ or:[(theContext argAt:2) == originator])
+ ifTrue:[
+ (activeHandlers notNil
+ and:[activeHandlers includesIdentical:theContext]) ifTrue:[
+"/ 'skip activeHandler: ' print. theContext displayString printCR.
+
+ ] ifFalse:[
+ "
+ if this is the Signal>>handle:do: context
+ or a SignalSet>>handle:do: context with self in it,
+ call the handler
+ "
+ r := theContext receiver.
+ (r notNil and:[r accepts:signal]) ifTrue:[
+ "call the handler"
+
+ conArg1 := theContext argAt:1.
+
+ handlerContext := theContext.
+
+ self doCallHandler:conArg1.
+
+ "/ if the handler rejects, we arrive here
+ "/ continue search for another handler
+ ].
+ ]
+ ].
+ theContext := theContext findNextContextWithSelector:#'handle:do:' or:#'handle:from:do:' or:nil.
+ ].
+
+ activeHandlers := nil.
+
+ "
+ we arrive here, if either no handler was found, or none of the
+ handlers did a return (i.e. every handler rejected or fell through).
+ "
+
+ ^ self action
+
+ "Modified: / 9.11.1997 / 14:48:44 / cg"
+ "Modified: / 23.7.1999 / 14:40:12 / stefan"
+ "Created: / 25.7.1999 / 20:13:19 / stefan"
+!
+
+doCallHandler:aHandlerBlock
+ "call the handler proper - needed an extra method
+ to have a separate returnContext for the rejectBlock.
+ (which is historical, and actually no longer needed)"
+
+ |val|
+
+ rejectBlock := [^ self]. "this will return on reject"
+
+ thisContext markForRaise.
+
+ val := aHandlerBlock value:self.
+ "
+ handler fall through - is just like a returnWith:blocks-value
+ "
+ rejectBlock := nil.
+ self returnWith:val
+
+ "Modified: / 26.7.1999 / 14:41:55 / stefan"
+!
+
+doRaise
+ "search through the context-calling chain for a handle-context
+ to the raising signal, a parent of it, or a SignalSet which includes
+ the raising signal.
+ If found, ask the receiver for the handler and evaluate
+ it with the receiver exception as argument.
+ If no handler is found, perform the default #action method.
+
+ ATTENTION: the code below depends on being called by #raise or
+ #raiseRequest for proper operation (it skips the sending context)."
+
+ |theContext handler
+ theSignal c ex1 activeHandlers inHandler
+ lastHandler h r firstHandler searchForHandle searchForRaise|
+
+
+ "/ is nil a valid originator? If so, we need an extra
+ "/ instanceVariable to record the originator setting.
+
+ originator isNil ifTrue:[
+ originator := suspendedContext homeReceiver
+ ].
+
+ theSignal := signal.
+ theSignal isSignal ifFalse:[
+ self halt:'unexpected non-Signal in calling context'.
+ ].
+
+"/ 'search handler for: ' print. theSignal displayString printCR.
+
+ "/ inHandler := false.
+ c := thisContext sender sender. "the raise/raiseRequest-context"
+ "the signal raise context"
+
+ "/ since the exceptionHandler is evaluated on top of the
+ "/ contextChain, we must skip active handlers before searching.
+ "/ otherwise, we get into trouble, when re-raising an exception
+ "/ from within a handler (which would lead to re-executing the
+ "/ same handler)
+ "/ the code below collects active handlers ...
+
+ "/ on the fly, look for the first handle - context,
+ "/ and remember it (as firstHandler) to avoid walking the context chain twice
+ "/ in most cases ...
+
+ firstHandler := nil.
+ searchForHandle := searchForRaise := true.
+
+ [c notNil] whileTrue:[
+ c := c findSpecialHandle:searchForHandle raise:searchForRaise.
+
+ c notNil ifTrue:[
+ (c isRaiseContext) ifTrue:[
+ ex1 := c receiver.
+ ((ex1 class == self class)
+ or:[ex1 species == self species]) ifTrue:[
+ h := ex1 handlerContext.
+ h notNil ifTrue:[
+ ((ex1 signal == theSignal)
+
+ "/ mhmh - if not ==, the raised signal there is not ours,
+ "/ but the handler could still be for a signalSet, parentSig
+ "/ or other thingy which accepts our signal.
+ "/ If we ommit that check, a signalSet-handler gets invoked
+ "/ again by an exception occuring inside its handler.
+
+ "/ to avoid overhead, only do it if the
+ "/ handlers receiver is not of the signals class...
+ "/ ...i.e. knowing that most are r handle:do: contexts,
+ "/ where the receiver is the handling signal.
+ or:[h receiver ~~ ex1 signal
+ and:[ex1 handlingSignal accepts:theSignal]]) ifTrue:[
+ activeHandlers isNil ifTrue:[
+ activeHandlers := OrderedCollection new
+ ].
+
+ activeHandlers add:h.
+ "/ lastHandler := h.
+ "/ inHandler := true.
+ c := h.
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ "/ must be a handle context ...
+ firstHandler := c.
+ searchForHandle := false.
+ ]
+ ]
+ ].
+
+ "/ now, start searching for a handler,
+ "/ start search above the last active handler.
+ "/ Or start with the first handle context, if one
+ "/ was found as a side effect of the previous handler search.
+ "/ If nil, then there is no handler and we can directly proceed
+ "/ to the unhandled code below.
+
+"/ lastHandler notNil ifTrue:[
+"/ theContext := lastHandler.
+"/ theContext := lastHandler findNextHandleContext
+"/ ] ifFalse:[
+ theContext := firstHandler.
+"/ ].
+
+ [theContext notNil] whileTrue:[
+ "/
+ "/ ask the Signal instance/Exception class for the handler.
+ "/ nil is returned, if the signal is not accepted
+ "/
+ r := theContext receiver.
+ (r notNil and:[(handler := r handlerForSignal:signal
+ context:theContext
+ originator:originator) notNil]
+ ) ifTrue:[
+ (activeHandlers notNil
+ and:[activeHandlers includesIdentical:theContext]) ifTrue:[
+"/ 'skip activeHandler: ' print. theContext displayString printCR.
+
+ ] ifFalse:[
+ "call the handler"
+
+ handlerContext := theContext.
+ "/ remember the handling signal, sigSet, or exception
+ "/ for the #accepts: check above
+ handlingSignal := r handlingExceptionInContext:theContext.
+ theContext := nil.
+ self doCallHandler:handler.
+
+ "/ if the handler rejects, we arrive here
+ "/ continue search for another handler
+ theContext := handlerContext.
+ ].
+ ].
+ theContext := theContext findSpecialHandle:true raise:false.
+ ].
+
+ "/ help GC a bit, by clearing things we no longer need
+ "/ (especially useful for contexts ...)
+ activeHandlers := handler := c := ex1 := firstHandler := nil.
+
+ "
+ we arrive here, if either no handler was found,
+ or every handler rejected.
+ "
+
+ ^ self action
+
+ "Created: / 12.5.1996 / 15:09:39 / cg"
+ "Modified: / 9.11.1997 / 14:48:44 / cg"
+ "Modified: / 26.7.1999 / 14:50:50 / stefan"
+! !
+
+!GenericException methodsFor:'raising'!
+
+raise
+ "actually raise a non-proceedable exception
+
+ In the past, ST/X did not distinguish between proceedable and
+ non-proceedable signals (signals invoked with #raise could proceed).
+ To allow a migration of old applications, we do not invoke a signal
+ but print out a warning, when trying to proceed a non-proceedable signal.
+ In the next release, this will raise a signal, so fix your code"
+
+ suspendedContext isNil ifTrue:[
+ "Call chain:
+ (origin)>>someMethod sender
+ Signal>>raise sender
+ Exception>>raise thisContext
+ "
+ suspendedContext := thisContext sender sender
+ ].
+
+ "/ remove the next 2 lines to make proceeding from non-proceedable signals an error.
+ proceedable := false.
+ resumeBlock := [:value | ^ value].
+
+ ^ self doRaise
+
+ "Modified: / 12.5.1996 / 15:09:47 / cg"
+ "Modified: / 5.3.1998 / 16:40:23 / stefan"
+!
+
+raiseRequest
+ "actually raise a proceedable exception."
+
+ suspendedContext isNil ifTrue:[
+ "Call chain:
+ (origin)>>someMethod sender
+ Signal>>raise sender
+ Exception>>raise thisContext
+ "
+ suspendedContext := thisContext sender sender
+ ].
+
+ self mayProceed ifFalse:[
+ "/ proceeding from wrongProceedabilitySignal grants the raiseRequest
+ Signal wrongProceedabilitySignal raiseRequestWith:signal in:suspendedContext
+ ].
+ proceedable := true.
+ resumeBlock := [:value | ^ value].
+ ^ self doRaise
+
+ "Modified: / 12.5.1996 / 15:09:44 / cg"
+ "Modified: / 23.7.1999 / 14:48:48 / stefan"
+! !
+
+!GenericException methodsFor:'setup'!
+
+signal:aSignal originator:origin
+ "set the fields usable for inspection by the handler
+ - only to be sent from the signal when raising"
+
+ signal := aSignal.
+ originator := origin.
+
+ "Created: / 23.7.1999 / 13:39:35 / stefan"
+!
+
+signal:aSignal parameter:aParameter errorString:aString suspendedContext:sContext originator:origin
+ "set the fields usable for inspection by the handler
+ - only to be sent from the signal when raising"
+
+ signal := aSignal.
+ parameter := aParameter.
+ errorString := aString.
+ suspendedContext := sContext.
+ originator := origin.
+! !
+
+!GenericException class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.1 1999-07-31 16:22:47 cg Exp $'
+! !
+GenericException initialize!
--- a/Make.proto Sat Jul 31 18:12:36 1999 +0200
+++ b/Make.proto Sat Jul 31 18:22:47 1999 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/Make.proto,v 1.110 1999-07-28 07:53:25 stefan Exp $
+# $Header: /cvs/stx/stx/libbasic/Make.proto,v 1.111 1999-07-31 16:22:47 cg Exp $
#
# -------------- no need to change anything below ----------
@@ -90,11 +90,12 @@
Context.$(O) \
BContext.$(O) \
Delay.$(O) \
- Exception.$(O) \
- Error.$(O) \
- Warning.$(O) \
- Notification.$(O) \
- Query.$(O) \
+ GenericException.$(O) \
+ Exception.$(O) \
+ Error.$(O) \
+ Warning.$(O) \
+ Notification.$(O) \
+ Query.$(O) \
ExecFunc.$(O) \
CompCode.$(O) \
Block.$(O) \