diff -r be947d4e7fb2 -r 514c749165c3 Signal.st --- a/Signal.st Mon Oct 10 01:29:01 1994 +0100 +++ b/Signal.st Mon Oct 10 01:29:28 1994 +0100 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1993 by Claus Gittinger - All Rights Reserved + 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 @@ -11,18 +11,18 @@ " Object subclass:#Signal - instanceVariableNames:'mayProceed notifierString nameClass message - handlerBlock' - classVariableNames:'NoHandlerSignal' - poolDictionaries:'' - category:'Kernel-Exceptions' + instanceVariableNames:'mayProceed notifierString nameClass message + handlerBlock parent' + classVariableNames:'NoHandlerSignal RecursiveRaiseSignal' + poolDictionaries:'' + category:'Kernel-Exceptions' ! Signal comment:' COPYRIGHT (c) 1993 by Claus Gittinger - All Rights Reserved + All Rights Reserved -$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.13 1994-08-23 23:11:14 claus Exp $ +$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.14 1994-10-10 00:28:19 claus Exp $ '! !Signal class methodsFor:'documentation'! @@ -30,7 +30,7 @@ copyright " COPYRIGHT (c) 1993 by Claus Gittinger - All Rights Reserved + 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 @@ -43,7 +43,7 @@ version " -$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.13 1994-08-23 23:11:14 claus Exp $ +$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.14 1994-10-10 00:28:19 claus Exp $ " ! @@ -98,22 +98,22 @@ Instance variables: - mayProceed hint for the debugger - program may - proceed (currently not honored by the - debugger) + mayProceed hint for the debugger - program may + proceed (currently not honored by the + debugger) - notifierString eror message to be output + notifierString eror message to be output - nameClass I dont know what this is for - (included for ST-80 compatibility) + nameClass I dont know what this is for + (included for ST-80 compatibility) - message I dont know what this is for - (included for ST-80 compatibility) + message I dont know what this is for + (included for ST-80 compatibility) - handlerBlock if nonNil, a 1-arg block to be - evaluated when no handler context is - found. The block gets the exception - object as argument. + handlerBlock if nonNil, a 1-arg block to be + evaluated when no handler context is + found. The block gets the exception + object as argument. Notice: Part of the implementation is a left-over from old times when the @@ -125,12 +125,19 @@ !Signal class methodsFor:'initialization'! -initialize +initialize "setup the signal used to handle unhandled signals" NoHandlerSignal isNil ifTrue:[ - NoHandlerSignal := (Signal new) mayProceed:true. - NoHandlerSignal notifierString:'unhandled exception' + Object initialize. + + NoHandlerSignal := Object errorSignal newSignalMayProceed:true. + NoHandlerSignal nameClass:self message:#noHandlerSignal. + NoHandlerSignal notifierString:'unhandled exception'. + + RecursiveRaiseSignal := Object errorSignal newSignalMayProceed:false. + RecursiveRaiseSignal nameClass:self message:#recursiveRaiseSignal. + RecursiveRaiseSignal notifierString:'recursive signal raise' ] ! ! @@ -148,26 +155,49 @@ "return the signal used to handle unhandled signals" ^ NoHandlerSignal +! + +recursiveRaiseSignal + "return the signal used to handle recursive signal raises" + + ^ RecursiveRaiseSignal ! ! !Signal methodsFor:'instance creation'! newSignalMayProceed:aBoolean - "create a new signal, using the receiver as a prototype" + "create a new signal, using the receiver as a prototype and + setting the parent of the new signal to the receiver." - ^ (self copy) mayProceed:aBoolean + |newSignal| + + newSignal := (self copy) mayProceed:aBoolean. + newSignal parent:self. + ^ newSignal ! newSignal - "create a new signal, using the receiver as a prototype" + "create a new signal, using the receiver as a prototype and + setting the parent of the new signal to the receiver." + + ^ (self copy) parent:self +! ! - ^ (self copy) +!Signal methodsFor:'copying'! + +deepCopy + "raise an error - deepCopy is not allowed for signals" + + ^ self deepCopyError ! ! !Signal methodsFor:'accessing'! nameClass:aClass message:aSelector - "I dont know what that is used for (yet)" + "this sets the class & selector of a method which returns + that signal - this is simply for documentation purposes - + see Signal>>printOn: implementation. + (took me a while to find that one out ;-)" nameClass := aClass. message := aSelector @@ -181,6 +211,18 @@ mayProceed := aBoolean ! +parent:aSignal + "set the parent-signal of the receiver." + + parent := aSignal +! + +parent + "return the parent-signal of the receiver" + + ^ parent +! + notifierString:aString "set the notifier string" @@ -200,6 +242,20 @@ handlerBlock := aOneArgBlock ! ! +!Signal methodsFor:'printing'! + +printOn:aStream + "append a printed representation of the receiver on aStream" + + nameClass notNil ifTrue:[ + aStream nextPutAll:nameClass name. + aStream space. + aStream nextPutAll:message. + ^ self + ]. + ^ super printOn:aStream +! ! + !Signal methodsFor:'save evaluation'! handle:handleBlock do:aBlock @@ -215,10 +271,10 @@ " Object messageNotUnderstoodSignal handle:[:ex | - 'oops' printNL. - ex return + 'oops' printNL. + ex return ] do:[ - 123 size open + 123 size open ] " @@ -227,18 +283,18 @@ num := 0. Number divisionByZeroSignal handle:[:ex | - 'oops' printNL. - ex return + 'oops' printNL. + ex return ] do:[ - 123 / num + 123 / num ] " ! catch:aBlock - "evaluate the argument, aBlock; return false. + "evaluate the argument, aBlock. If the receiver-signal is raised during evaluation, abort - the evaluation and return true. + 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." @@ -250,13 +306,43 @@ " Object messageNotUnderstoodSignal catch:[ - 123 size open + 123 size open + ] + " +! + +ignore: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 AbortSignals, because continuing after an exception without any cleanup + will often lead to followup-errors." + + ^ self handle:[:ex | ex proceed] do:aBlock. + + " + Object messageNotUnderstoodSignal ignore:[ + 123 size open ] " ! ! !Signal methodsFor:'queries'! +accepts:aSignal + "return true, if the receiver accepts the argument, aSignal. + (i.e. the recevier is aSignal or a parent of it). False otherwise." + + |s| + + s := aSignal. + [s notNil] whileTrue:[ + self == s ifTrue:[^ true]. + s := s parent + ]. + ^ false +! + isHandled "return true, if there is a handler for the receiver signal. Raising an unhandled signal will usually lead into the debugger, @@ -267,19 +353,18 @@ con := thisContext. con := con sender. [con notNil] whileTrue:[ - (con selector == #handle:do:) ifTrue:[ - " - is this is the Signal>>handle:do: context - or a SignalSet>>handle:do: context with self in it ? - " - ((con receiver == self) - or:[(con receiver isMemberOf:SignalSet) and:[con receiver includes:self]]) ifTrue:[ - "found it" + (con selector == #handle:do:) ifTrue:[ + " + is this is the Signal>>handle:do: context + or a SignalSet>>handle:do: context with self in it ? + " + (con receiver accepts:self) ifTrue:[ + "found a handler context" - ^ true - ]. - ]. - con := con sender + ^ true + ]. + ]. + con := con sender ]. ^ false ! ! @@ -298,34 +383,41 @@ |ex block| ex := Exception new - signal:self - parameter:nil - errorString:notifierString - suspendedContext:thisContext sender. + signal:self + parameter:nil + errorString:notifierString + suspendedContext:thisContext sender. ex resumeBlock:[:value | ^ value]. self evaluateHandlerWith:ex. (block := handlerBlock) isNil ifTrue:[ - " - if I am not the NoHandlerSignal, raise it ... - passing the exception as parameter. - " - self == NoHandlerSignal ifFalse:[ - ^ NoHandlerSignal - raiseRequestWith:ex - errorString:('unhandled exception: ' , ex errorString) - ]. + " + if I am not the NoHandlerSignal, raise it ... + passing the exception as parameter. + " + self == NoHandlerSignal ifFalse:[ + ^ NoHandlerSignal + raiseRequestWith:ex + errorString:('unhandled exception: ' , ex errorString) + ]. - " - otherwise, - take either a per-process emergencyHandlerBlock - or the global emergencyHandler (from Exception) ... - " - block := Processor activeProcess emergencySignalHandler. - block isNil ifTrue:[ - block := Exception emergencyHandler - ] + " + otherwise, + take 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:ex errorString + ] ]. "... and call it" @@ -344,34 +436,41 @@ |ex block| ex := Exception new - signal:self - parameter:aParameter - errorString:notifierString - suspendedContext:thisContext sender. + signal:self + parameter:aParameter + errorString:notifierString + suspendedContext:thisContext sender. ex resumeBlock:[:value | ^ value]. self evaluateHandlerWith:ex. (block := handlerBlock) isNil ifTrue:[ - " - if I am not the NoHandlerSignal, raise it ... - passing the exception as parameter. - " - self == NoHandlerSignal ifFalse:[ - ^ NoHandlerSignal - raiseRequestWith:ex - errorString:('unhandled exception: ' , ex errorString) - ]. + " + if I am not the NoHandlerSignal, raise it ... + passing the exception as parameter. + " + self == NoHandlerSignal ifFalse:[ + ^ NoHandlerSignal + raiseRequestWith:ex + errorString:('unhandled exception: ' , ex errorString) + ]. - " - otherwise, - take either a per-process emergencyHandlerBlock - or the global emergencyHandler (from Exception) ... - " - block := Processor activeProcess emergencySignalHandler. - block isNil ifTrue:[ - block := Exception emergencyHandler - ] + " + otherwise, + take 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:ex errorString + ] ]. "... and call it" @@ -387,34 +486,41 @@ |ex block| ex := Exception new - signal:self - parameter:nil - errorString:something printString - suspendedContext:thisContext sender. + signal:self + parameter:nil + errorString:something printString + suspendedContext:thisContext sender. ex resumeBlock:[:value | ^ value]. self evaluateHandlerWith:ex. (block := handlerBlock) isNil ifTrue:[ - " - if I am not the NoHandlerSignal, raise it ... - passing the exception as parameter. - " - self == NoHandlerSignal ifFalse:[ - ^ NoHandlerSignal - raiseRequestWith:ex - errorString:('unhandled exception: ' , ex errorString) - ]. + " + if I am not the NoHandlerSignal, raise it ... + passing the exception as parameter. + " + self == NoHandlerSignal ifFalse:[ + ^ NoHandlerSignal + raiseRequestWith:ex + errorString:('unhandled exception: ' , ex errorString) + ]. - " - otherwise, - take either a per-process emergencyHandlerBlock - or the global emergencyHandler (from Exception) ... - " - block := Processor activeProcess emergencySignalHandler. - block isNil ifTrue:[ - block := Exception emergencyHandler - ] + " + otherwise, + take 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:ex errorString + ] ]. "... and call it" @@ -429,34 +535,41 @@ |ex block| ex := Exception new - signal:self - parameter:aParameter - errorString:aString - suspendedContext:thisContext sender. + signal:self + parameter:aParameter + errorString:aString + suspendedContext:thisContext sender. ex resumeBlock:[:value | ^ value]. self evaluateHandlerWith:ex. (block := handlerBlock) isNil ifTrue:[ - " - if I am not the NoHandlerSignal, raise it ... - passing the exception as parameter. - " - self == NoHandlerSignal ifFalse:[ - ^ NoHandlerSignal - raiseRequestWith:ex - errorString:('unhandled exception: ' , ex errorString) - ]. + " + if I am not the NoHandlerSignal, raise it ... + passing the exception as parameter. + " + self == NoHandlerSignal ifFalse:[ + ^ NoHandlerSignal + raiseRequestWith:ex + errorString:('unhandled exception: ' , ex errorString) + ]. - " - otherwise, - take either a per-process emergencyHandlerBlock - or the global emergencyHandler (from Exception) ... - " - block := Processor activeProcess emergencySignalHandler. - block isNil ifTrue:[ - block := Exception emergencyHandler - ] + " + otherwise, + take 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:ex errorString + ] ]. "... and call it" @@ -465,9 +578,10 @@ !Signal methodsFor:'private'! -evaluateHandlerWith:anException +evaluateHandlerWith:ex "search through the context-calling chain for a 'handle:do:'-context - to the receiver or a SignalSet which includes the receiver. + to the receiver or a parent of the receiver or a SignalSet which includes + the receiver. If found, take its 2nd argument (the handler) and evaluate it with the exception as argument. If none found, just return." @@ -477,34 +591,43 @@ con := thisContext. con := con sender. con isRecursive ifTrue:[ - " - mhmh - an error while in a handler - go immediately into the debugger. - " - ^ self enterDebuggerWith:anException - message:'recursive signal raise' + " + mhmh - an error while in a handler + " + ((self == RecursiveRaiseSignal) + or:[RecursiveRaiseSignal isNil]) ifTrue:[ + " + ... either while handling RecursiveSignal + or at startup when RecursiveSignal is not yet + created - + - go immediately into the debugger. + " + ^ self enterDebuggerWith:ex + message:'recursive signal raise' + ]. + ^ RecursiveRaiseSignal + raiseRequestWith:ex + errorString:('recursive signal raise: ' , ex errorString) ]. [con notNil] whileTrue:[ - (con selector == #'handle:do:') ifTrue:[ - " - if this is the Signal>>handle:do: context - or a SignalSet>>handle:do: context with self in it, - call the handler - " - ((con receiver == self) - or:[(con receiver isMemberOf:SignalSet) - and:[con receiver includes:self]]) ifTrue:[ - "call the handler" + (con selector == #'handle:do:') ifTrue:[ + " + if this is the Signal>>handle:do: context + or a SignalSet>>handle:do: context with self in it, + call the handler + " + (con receiver accepts:self) ifTrue:[ + "call the handler" - anException handlerContext:con. - self doCallHandler:(con args at:1) with:anException. + ex handlerContext:con. + self doCallHandler:(con args at:1) with:ex. - "if the handler rejects or falls through we arrive here" - "continue search for another handler" - ]. - ]. - con := con sender + "if the handler rejects or falls through we arrive here" + "continue search for another handler" + ]. + ]. + con := con sender ]. "