Delta define: #BlockExceptionHandler as: ( (Class subclassOf: 'Object' instanceVariables: 'handleBlock passBlock returnBlock')) ! (Delta mirrorFor: #BlockExceptionHandler) revision: '$Revision$'! (Delta mirrorFor: #BlockExceptionHandler) group: 'exceptions'! (Delta mirrorFor: #BlockExceptionHandler) comment: 'Exception handler for an exception. Handles the exception by invoking its handleBlock.'! Delta define: #Exception as: ( (Class subclassOf: 'Object' instanceVariables: 'messageText tag handler signalledHandler "this was the first handler when the exception was originally signalled" contextBlock "used to mark the signalling context - should be restored whenever evaluated" resumeBlock')) ! (Delta mirrorFor: #Exception) revision: '$Revision$'! (Delta mirrorFor: #Exception) group: 'exceptions'! (Delta mirrorFor: #Exception) comment: 'Base class of the exception hierarchy. Implements the core of the ANSI exception handling protocols'! Delta define: #Error as: ( (Class subclassOf: 'Exception' instanceVariables: '')) ! (Delta mirrorFor: #Error) revision: '$Revision:$'! (Delta mirrorFor: #Error) group: 'Unclassified'! (Delta mirrorFor: #Error) comment: ''! Delta define: #Halt as: ( (Class subclassOf: 'Error' instanceVariables: '')) ! (Delta mirrorFor: #Halt) revision: '$Revision:$'! (Delta mirrorFor: #Halt) group: 'Unclassified'! (Delta mirrorFor: #Halt) comment: ''! Delta define: #LinkedExceptionHandler as: ( (Class subclassOf: 'Object' instanceVariables: 'exceptionSelector handleBlock nextHandler returnBlock protectee retryBlock')) ! (Delta mirrorFor: #LinkedExceptionHandler) revision: '$Revision$'! (Delta mirrorFor: #LinkedExceptionHandler) group: 'exceptions'! (Delta mirrorFor: #LinkedExceptionHandler) comment: 'Exception handler for an exception. Invokes its handleBlock when asked to handle an exceptionthat matches its exceptionSelector. If the exception does not match its exceptionSelector it passesthe exception on to the nextHandler. If the nextHandler is undefined signal an UnhandledExceptionError.This class is internal to the exception handling framework. There should be no need for code outside of thisframework to interact with instances of ExceptionHandler.'! Delta define: #MessageNotUnderstood as: ( (Class subclassOf: 'Error' instanceVariables: 'message')) ! (Delta mirrorFor: #MessageNotUnderstood) revision: '$Revision:$'! (Delta mirrorFor: #MessageNotUnderstood) group: 'Unclassified'! (Delta mirrorFor: #MessageNotUnderstood) comment: ''! Delta define: #Notification as: ( (Class subclassOf: 'Exception' instanceVariables: '')) ! (Delta mirrorFor: #Notification) revision: '$Revision:$'! (Delta mirrorFor: #Notification) group: 'Unclassified'! (Delta mirrorFor: #Notification) comment: ''! Delta define: #Process as: ( (Class subclassOf: 'Object' instanceVariables: 'priority body <[]> win32Handle "the thread id" processError "Description of why process stopped running" handlerChain "Chain of registered exception handlers for this process"')) ! (Delta mirrorFor: #Process) revision: '$Revision: 1.7 $'! (Delta mirrorFor: #Process) group: 'base'! (Delta mirrorFor: #Process) comment: 'Tags: %BlueBook %User (c) 1995-1997 Sun Microsystems, Inc. ALL RIGHTS RESERVED. Use and distribution of this software is subject to the terms of the attached source license '! Delta define: #Warning as: ( (Class subclassOf: 'Notification' instanceVariables: '')) ! (Delta mirrorFor: #Warning) revision: '$Revision:$'! (Delta mirrorFor: #Warning) group: 'Unclassified'! (Delta mirrorFor: #Warning) comment: ''! Delta define: #ZeroDivide as: ( (Class subclassOf: 'Error' instanceVariables: 'dividend')) ! (Delta mirrorFor: #ZeroDivide) revision: '$Revision:$'! (Delta mirrorFor: #ZeroDivide) group: 'Unclassified'! (Delta mirrorFor: #ZeroDivide) comment: ''! ! (Delta mirrorFor: #BlockExceptionHandler) classSide methodsFor: 'instantiation' ! default ^self handleBlock: [:ex| ex inContextDo: [|result| result := ex defaultAction. ex isResumable ifFalse: [self defaultActionReturnError]. ex resume: result]]! defaultActionReturnError self error: 'Return from non-resumable default action is not supported'! handleBlock: block ^self new handleBlock: block; yourself! new ^super new initialize! ! ! (Delta mirrorFor: #BlockExceptionHandler) methodsFor: 'exception handler' ! canHandleSignal: exception ^false! handle: exception ^handleBlock value: exception! handle: exception return: aBlock aBlock value: (handleBlock value: exception)! nextHandler ^nil! nextHandler: ignored! pass: exception passBlock value: exception! passBlock: block passBlock := block! return: value returnBlock value: value! returnBlock: block returnBlock := block! ! ! (Delta mirrorFor: #BlockExceptionHandler) methodsFor: 'private initialization' ! handleBlock: block handleBlock := block! initialize handleBlock := [:exception|]. passBlock := [:exception|].! ! ! (Delta mirrorFor: #Exception) classSide methodsFor: 'Camp Smalltalk' ! sunitSignalWith: aString ^self signal: aString! ! ! (Delta mirrorFor: #Exception) classSide methodsFor: 'exceptionInstantiator' ! new ^super new initialize; yourself! signal "Signal the occurrence of an exceptional condition." ^ self new signal! signal: signalerText "Signal the occurrence of an exceptional condition with a specified textual description." ^ self new signal: signalerText! ! ! (Delta mirrorFor: #Exception) classSide methodsFor: 'exceptionSelector' ! , anotherException "Create an exception set." " ^ExceptionSet new add: self; add: anotherException; yourself"! handles: exception "Determine whether an exception handler will accept a signaled exception." ^ exception isKindOf: self! ! ! (Delta mirrorFor: #Exception) methodsFor: 'Camp Smalltalk' ! sunitExitWith: aValue self return: aValue! ! ! (Delta mirrorFor: #Exception) methodsFor: 'exceptionBuilder' ! tag: t "This message is not specified in the ANSI protocol, but that looks like an oversight because #tag is specified, and the spec states that the signaler may store the tag value." tag := t! ! ! (Delta mirrorFor: #Exception) methodsFor: 'exceptionDescription' ! tag "Return an exception's tag value." ^tag == nil ifTrue: [self messageText] ifFalse: [tag]! ! ! (Delta mirrorFor: #Exception) methodsFor: 'handling' ! isNested "Determine whether the current exception handler is within the scope of another handler for the same exception." ^ handler notNil and: [handler nextHandler canHandleSignal: self]! outer "Evaluate the enclosing exception action and return to here instead of signal if it resumes (see #resumeUnchecked:)." | oldHandler oldContext | self isResumable ifFalse: [self pass]. ["oldContext := contextBlock." "^(self installContextAndDo: [" ^(oldHandler := handler) outer: self return: [:value| ^value] "]) value" ] ensure: [handler := oldHandler. "contextBlock := oldContext"]! pass "Yield control to the enclosing exception action for the receiver." contextBlock value: [handler pass: self]! resignalAs: replacementException "Signal an alternative exception in place of the receiver." contextBlock value: [replacementException signal]! resume "Return from the message that signaled the receiver." self resume: nil! resume: resumptionValue "Return resumptionValue as the value of the signal message." resumeBlock value: resumptionValue! retry "Abort an exception handler and re-evaluate its protected block." handler retry! retryUsing: alternativeBlock "Abort an exception handler and evaluate a new block in place of the handler's protected block." handler retryUsing: alternativeBlock! return "Return nil as the value of the block protected by the active exception handler." self return: nil! return: returnValue "Return the argument as the value of the block protected by the active exception handler." handler return: returnValue! ! ! (Delta mirrorFor: #Exception) methodsFor: 'printing' ! description "Return a textual description of the exception." | desc mt | desc := self class name asString. ^(mt := self messageText) == nil ifTrue: [desc] ifFalse: [desc, ': ', mt]! messageText "Return an exception's message text." ^messageText! printOn: stream stream nextPutAll: self description! ! ! (Delta mirrorFor: #Exception) methodsFor: 'priv handling' ! defaultAction "The default action taken if the exception is signaled." self subclassResponsibility! handler: aHandler handler := aHandler! isResumable "Determine whether an exception is resumable." ^ true! ! ! (Delta mirrorFor: #Exception) methodsFor: 'private signal handling' ! installContextAndDo: aBlock "sets up a new context used as the target of a non-local return whenever an exception handling action needs to return to the signalling context. The context reference is cached in contextBlock. Whenever this block gets evaluated, its context will be consumed, so a new one needs to be set up. This is the purpose of the recursive call in the innermost block" |result| contextBlock := [:action| ^[(self installContextAndDo: action) value]]. result := aBlock value. ^[result]! ! ! (Delta mirrorFor: #Exception) methodsFor: 'restricted exception handling' ! inContextDo: aBlock Processor activeProcess inEnvironment: signalledHandler do: aBlock ! initialize resumeBlock := [:resumptionValue| contextBlock value: [resumptionValue]]! withResume: aResumeBlock do: aBlock | oldResume | oldResume := resumeBlock. resumeBlock := aResumeBlock. aBlock ensure: [resumeBlock := oldResume]! ! ! (Delta mirrorFor: #Exception) methodsFor: 'signaling' ! messageText: signalerText "Set an exception's message text." messageText := signalerText! privateSignal ^self installContextAndDo: [signalledHandler := Processor activeProcess handlerChain. signalledHandler handle: self]! signal ^self privateSignal value! signal: signalerText "Signal the occurrence of an exceptional condition with a specified textual description." self messageText: signalerText. ^ self signal! ! ! (Delta mirrorFor: #Error) methodsFor: 'exception descriptor' ! isResumable ^false! ! ! (Delta mirrorFor: #Error) methodsFor: 'priv handling' ! defaultAction Processor stopWithError: (ProcessExplicitError new msg: messageText)! ! ! (Delta mirrorFor: #Halt) methodsFor: 'testing' ! defaultAction Processor stopWithError: ProcessHaltError new! isResumable ^true! ! ! (Delta mirrorFor: #LinkedExceptionHandler) classSide methodsFor: 'exceptionBuilder' ! on: anExceptionSelector do: handleBlock ^self new on: anExceptionSelector do: handleBlock return: [:value|] outer: nil; yourself! on: anExceptionSelector do: handleBlock return: returnBlock ^self new on: anExceptionSelector do: handleBlock return: returnBlock outer: nil; yourself! on: anExceptionSelector do: handleBlock return: returnBlock outer: outerBlock ^self new on: anExceptionSelector do: handleBlock return: returnBlock outer: outerBlock; yourself! ! ! (Delta mirrorFor: #LinkedExceptionHandler) methodsFor: 'exception handler' ! canHandleSignal: exception ^(exceptionSelector handles: exception) or: [nextHandler notNil and: [nextHandler canHandleSignal: exception]]! evaluateProtectee: aBlock |result| protectee := aBlock. retryBlock := [^[self evaluateProtectee: protectee]]."fix this - should evaluate the returned block" result := protectee value. ^[result]! handle: exception self handle: exception return: returnBlock! handle: exception return: aReturnBlock Processor activeProcess popHandler. [^(exceptionSelector handles: exception) ifTrue: [ exception handler: self. returnBlock value: (handleBlock value: exception)] ifFalse: [nextHandler handle: exception return: aReturnBlock]] ensure: [Processor activeProcess pushHandler: self]! nextHandler ^nextHandler! outer: exception return: aReturnBlock exception withResume: [:value| ^value] do: [nextHandler handle: exception return: aReturnBlock]! pass: exception ^nextHandler handle: exception! protect: aBlock Processor activeProcess pushHandler: self. ^[(self evaluateProtectee: aBlock) value] ensure: [Processor activeProcess popHandler]! retry retryBlock value! retryUsing: aBlock protectee := aBlock. retryBlock value! return: aValue returnBlock value: aValue! ! ! (Delta mirrorFor: #LinkedExceptionHandler) methodsFor: 'private - initialization' ! nextHandler: exceptionHandler nextHandler := exceptionHandler ! on: anExceptionSelector do: block return: aReturnBlock outer: outerBlock exceptionSelector := anExceptionSelector. handleBlock := block. returnBlock := aReturnBlock. nextHandler := BlockExceptionHandler default! ! ! (Delta mirrorFor: #MessageNotUnderstood) classSide methodsFor: 'instance creation' ! message: aMessage ^self new message: aMessage; yourself! ! ! (Delta mirrorFor: #MessageNotUnderstood) methodsFor: 'accessing' ! message ^message! receiver ^message receiver! ! ! (Delta mirrorFor: #MessageNotUnderstood) methodsFor: 'exception descriptor' ! isResumable ^true! ! ! (Delta mirrorFor: #MessageNotUnderstood) methodsFor: 'priv handling' ! defaultAction Processor stopWithError: (ProcessDoesNotUnderstandError new message: message)! ! ! (Delta mirrorFor: #MessageNotUnderstood) methodsFor: 'private initialization' ! message: aMessage message := aMessage! ! ! (Delta mirrorFor: #Notification) methodsFor: 'exception description' ! defaultAction ^nil! ! ! (Delta mirrorFor: #Warning) methodsFor: 'exception descriptor' ! defaultAction self halt! ! ! (Delta mirrorFor: #ZeroDivide) classSide methodsFor: 'Instance creation' ! dividend: dividend ^self new dividend: dividend; yourself! ! ! (Delta mirrorFor: #ZeroDivide) methodsFor: 'accessing' ! dividend ^dividend! ! ! (Delta mirrorFor: #ZeroDivide) methodsFor: 'private - initialization' ! dividend: aValue dividend := aValue. messageText := 'divide by zero'! ! ! (Delta mirrorFor: #ZeroDivide) methodsFor: 'testing' ! isResumable ^true! ! ! (Delta mirrorFor: #RationalNumber) classSide methodsFor: 'instance creation' ! numerator: n denominator: d ^ | gcd num denom | d < 0 ifFalse: [ d == 0 ifTrue: [ (ZeroDivide dividend: n) signal ] ifFalse: [ num := n. denom := d ] ] ifTrue: [ num := n negated. denom := d negated ]. gcd := num gcd: denom. num := num // gcd. ^gcd == denom ifTrue: [ num ] ifFalse: [ Fraction numerator: num denominator: denom // gcd ]! ! ! (Delta mirrorFor: #Process) methodsFor: 'exception support' ! handle: exception ^self handlerChain handle: exception! handlerChain handlerChain isNil ifTrue: [handlerChain := BlockExceptionHandler default]. ^handlerChain! handlerChain: aHandler handlerChain := aHandler! inEnvironment: aHandler do: block | oldHandler | oldHandler := self handlerChain. handlerChain := aHandler. block ensure: [handlerChain := oldHandler]! popHandler | poppedHandler | handlerChain := (poppedHandler := self handlerChain) nextHandler. ^poppedHandler! pushHandler: handler handler nextHandler: self handlerChain. handlerChain := handler ! resetExceptionEnvironment handlerChain := nil ! resetHandlers handlerChain := nil ! ! ! (Delta mirrorFor: #Object) methodsFor: 'private-error handling' ! doesNotUnderstand: m ^ "Processor stopWithError: (ProcessDoesNotUnderstandError new message: m)" (MessageNotUnderstood message: m) signal! error: msg ^ "Processor stopWithError: (ProcessExplicitError new msg: msg)" Error signal: msg! halt "Processor stopWithError: ProcessHaltError new." Halt signal ! shouldNotHappen ^ self error: 'This shouldn''t happen'.! shouldNotImplement ^ self error: 'A message that cannot be supported by this class has been sent to an instance'.! subclassResponsibility ^ "Note: In the Strongtalk language, a method whose body consists of only 'self subclassResponsibility' is considered a declaration, which subclasses must implement for concrete subclasses" self error: 'A message that should be implemented but is not has been sent to this object'.! unimplemented ^ self error: 'A hook for unimplemented code has been encountered'! ! ! (Delta mirrorFor: #BlockWithoutArguments) methodsFor: 'exceptions' ! on: exception do: handlerBlock ^(LinkedExceptionHandler on: exception do: handlerBlock return: [:value | ^ value]) protect: self ! !