expectvalue %SymbolDictionary
run
" preload script "
Globals at: #ANSIException ifAbsentPut: [SymbolDictionary new at: #English put: (Array with: #(1 ' signal: ' 2)); yourself].
%
expectvalue %String
run
Object _newKernelSubclass: 'ExceptionSet'
  instVarNames: #( selectors)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil 
%
expectvalue %String
run
| oldClass expectedInstVars newClass |
expectedInstVars := #(#'tryBlock' #'handlerBlock' #'gsException' 
	#'returnBlock' #'resumeBlock' #'alternateBlock'
	#'exceptionSelector' #'signaledException').
oldClass := Globals at: #ExceptionHandler otherwise: nil.
(oldClass notNil and: [oldClass instVarNames = expectedInstVars]) ifTrue: [
	^'Found expected class'.
].
newClass := Object
	subclass: 'ExceptionHandler'
	instVarNames: expectedInstVars
	classVars: #( TraceLog)
	classInstVars: #()
	poolDictionaries: #()
	inDictionary: Globals
	instancesInvariant: false
	isModifiable: false.
^(oldClass isNil ifTrue: ['Created new class:'] ifFalse: ['Replaced old class with:']) , '
' , newClass definition.
%
expectvalue %String
run
Object _newKernelSubclass: 'ExceptionA'
  instVarNames: #( tag messageText handler
                    action result gsCategory gsNumber
                    gsArguments)
  classVars: #( TraceLog)
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
Object _newKernelSubclass: 'FailedMessage'
  instVarNames: #( arguments selector)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
ExceptionA _newKernelSubclass: 'Error'
  instVarNames: #()
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
ExceptionA _newKernelSubclass: 'Notification'
  instVarNames: #()
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
Notification _newKernelSubclass: 'Warning'
  instVarNames: #()
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
Error _newKernelSubclass: 'MessageNotUnderstood'
  instVarNames: #( receiver)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%
expectvalue %String
run
Error _newKernelSubclass: 'ZeroDivide'
  instVarNames: #()
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[  ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: nil
%

category: 'For Documentation Installation only'
classmethod: ExceptionSet
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This protocol describes the behavior of objects that may be 
used to group a set of <exceptionSelector> objects into a 
single <exceptionSelector>. This is useful for establishing 
a single exception handler that may deal with several different 
types of exceptions.

Instances conform to exceptionSelector and Object.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: ExceptionHandler
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This is an internal class that assists in the implementation of
ANSI Exceptions.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: ExceptionA
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'Because GemStone/S already had an Exception class, the ANSI Exception 
class is named ExceptionA. This is not much of an inconvenience since 
most references will be to subclasses (Error, Warning, and Notification).

The class protocol describe the behavior of class objects that are used to 
create, signal, and select exceptions that exist within a specialization 
hierarchy.

The value of the standard global Exception is a class object that conforms 
to this protocol. The class Exception is explicitly specified to be 
subclassable. Conforming implementations must implement its behaviors in 
a non-fragile manner.

The instance protocol describes the behavior of instances of class Exception. 
Typically, actual exceptions used by an application will be either 
direct or indirect subclasses of this class. Exception combines the 
behavior of <exceptionBuilder> and <signaledException>. Instances are 
used to both supplied inform before an exception is signaled and to 
pass the information to an exception handler.

As Exception is explicitly specified to be subclassable, conforming 
implementations must implement its behavior in a non- fragile manner.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: FailedMessage
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This protocol describes the behavior of objects that represent a message 
that was sent to an object, but was not understood by that object.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: Error
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'The class protocol describe the behavior of the global Error. The value 
of the standard global Error is a class object that conforms to this 
protocol. The class Error is explicitly specified to be subclassable in 
a standard conforming program. Conforming implementations must implement 
its behaviors in a non-fragile manner.

The signaled exceptions generated by this type of object conform to the 
protocol <Error>.

The instance protocol describes the behavior of instances of class Error. 
These are used to represent error conditions that prevent the normal 
continuation of processing. Actual error exceptions used by an application 
may be subclasses of this class.

As Error is explicitly specified to be subclassable, conforming 
implementations must implement its behavior in a non- fragile manner.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: Notification
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'The class protocol describe the behavior of the global Notification. 
The value of the standard global Notification is a class object that 
conforms to this protocol. The class Notification is explicitly specified 
to be subclassable in a standard conforming program. Conforming 
implementations must implement its behaviors in a non-fragile manner.

The signaled exceptions generated by this type of object conform to 
the protocol <Notification>.

The instance protocol describes the behavior of instances of the class 
Notification. These are used to represent exceptional conditions that 
may occur but which are not considered errors. Actual notification 
exceptions used by an application may be subclasses of this class.

As Notification is explicitly specified to be subclassable, conforming 
implementations must implement its behavior in a non-fragile manner.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: Warning
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'The class protocol describe the behavior of the global Warning. 
The value of the standard global Warning is a class object that 
conforms to this protocol. The class Warning is explicitly specified 
to be subclassable in a standard conforming program. Conforming 
implementations must implement its behaviors in a non-fragile manner.

The signaled exceptions generated by this type of object conform to 
the protocol <Warning>.

The instance protocol describes the behavior of instances of class 
Warning. These are used to represent exceptional conditions that 
might occur that are not considered errors but which should be 
reported to the user. Typically, the actual warning exceptions 
used by an application will be subclasses of this class.

As Warning is explicitly specified to be subclassable, conforming 
implementations must implement its behavior in a non-fragile manner.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: MessageNotUnderstood
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'The class protocol describe the behavior of the value of the global 
named MessageNotUnderstood.

This object is used to as an exception selector to catch failed message 
sends. Message not understood exceptions are resumable so any message 
in this protocol that signal such an exception may ultimately return 
to their sender.

This object is not specifed as an <exceptionSignaler> or an 
<exceptionInstantiator>. It as assumed that message not understood 
exceptions are signaled by the implemention dependent implementaton 
of the message <Object> #doesNotUnderstand:.

The instance protocol describes the behavior of exceptions that are 
signalled if the receiver of a message does not have a method with a 
matching selector.'.
doc documentClassWith: txt.

self description: doc.
%
category: 'For Documentation Installation only'
classmethod: ZeroDivide
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'The class protocol describe the behavior of the global ZeroDivide. 
It is used to as an exception selector to catch zero divide exceptions 
and can also be used to signal that a division by zero error has 
occured. Zero divide exceptions are resumable so any message in this 
protocol that signal such an exception may ultimately return to their 
sender. The signaled exceptions generated by this type of object 
conform to the protocol <ZeroDivide>.

The instance protocol describes the behavior of exceptions that are 
signalled when an attempt is made to divide some number (the dividend) 
by zero.'.
doc documentClassWith: txt.

self description: doc.
%

category: 'ANSI - signaledException'
method: Error
defaultAction
	"The current computation is terminated. The cause of the error should be
	logged or reported to the user. If the program is operating in an interactive
	debugging environment the computation should be suspended and the 
	debugger activated."

	^super defaultAction.
%
category: 'ANSI - exceptionDescription'
method: Error
isResumable
	"Error exceptions by default are assumed to not be 'resumable.' 
	Subclasses may override this definition for situations where it is
	appropriate for an error to be resumable."

	^false.
%
category: 'ANSI support'
classmethod: Exception
signal

	^ExceptionA signal.
%
category: 'ANSI support'
classmethod: Exception
signal: messageText

	^ExceptionA signal: messageText.
%
category: 'ANSI support'
classmethod: Exception
try: tryBlock on: aSymbolDictionary do: handlerBlock
		"This is called from ExecutableBlock #on:do: and allows us to support the following semantics:
	tryBlock on: Exception<Subclass> do: handlerBlock."

	^ExceptionA
		try: tryBlock 
		on: aSymbolDictionary 
		do: handlerBlock.
%
category: 'ANSI support'
method: Exception
handler

	^(subtype isKindOf: ExceptionHandler)
		ifTrue:  [subtype]
		ifFalse: [nil].
%
category: 'ANSI support'
method: Exception
handler: anObject

	subtype == nil ifFalse: [self error: 'subtype instance variable in use'].
	subtype := anObject.
%
category: 'ANSI support'
method: Exception
isStaticHandler

	| staticHandler |
	staticHandler := Exception _staticExceptions.
	[
		staticHandler ~~ nil.
	] whileTrue: [
		staticHandler = self ifTrue: [^true].
		staticHandler := staticHandler next.
	].
	^false.
%
category: 'ANSI - exceptionSelector'
classmethod: ExceptionA
, anotherException
	"Returns an exception set that contains the receiver and the argument
	exception. This is commonly used to specify a set of exception selectors
	for an 'exception handler.'"

	^anotherException exceptionSetWithException: self.
%
category: 'ANSI support'
classmethod: ExceptionA
asSymbol

	^self name asSymbol.
%
category: 'ANSI support'
classmethod: ExceptionA
category: cat number: errNum arguments: args

	cat == GemStoneError ifTrue: [
		errNum == 2010 ifTrue: [
			^MessageNotUnderstood new
				message: (FailedMessage new
					arguments: (args at: 3);
					selector: (args at: 2);
					yourself);
				receiver: (args at: 1);
				yourself.
		].
		errNum == 2026 ifTrue: [
			^ZeroDivide new
				tag: args first;
				yourself.
		].
	].
	(cat = ExceptionA exceptionCategory _and: [errNum == ExceptionA errorNumberToSignal]) ifTrue: [
		^args first.
	].
	^self new.
%
category: 'ANSI support'
classmethod: ExceptionA
errorNumberToCatch

	^nil.
%
category: 'ANSI support'
classmethod: ExceptionA
errorNumberToSignal

	^1.
%
category: 'ANSI support'
classmethod: ExceptionA
exceptionCategory

	^ANSIException.
%
category: 'ANSI support'
classmethod: ExceptionA
exceptionSetWithException: anException

	^ExceptionSet
		with: anException
		with: self.
%
category: 'ANSI support'
classmethod: ExceptionA
exceptionSetWithExceptionSet: anExceptionSet

	anExceptionSet add: self.
	^anExceptionSet.
%
category: 'ANSI - exceptionSelector'
classmethod: ExceptionA
handles: anExceptionA

	"This message determines whether the 'exception handler' associted with
	the receiver may be used to process the argument. Answer 'true' if an 
	associated handler should be used to process 'exception.' Answer 'false'
	if an associated handler may not be used to process the exception.

	Returns 'true' if the class of 'exception' is the receiver or a general
	subclass of the receiver.

	This definition implies that subclasses of an exception class are considered 
	to be 'subexceptions' of the type of exception defined by their superclass.
	An 'exception handler' that 'handles' an exception class will also handle any
	exceptions that are instances of the exception class's subclasses."

	^anExceptionA isKindOf: self
%
category: 'ANSI support'
classmethod: ExceptionA
initialize
	"no longer needed, but left for any stray callers"
%
category: 'ANSI support'
classmethod: ExceptionA
isGemStoneError

	^#[
		Exception ,
		ExceptionA ,
		Error , 
		MessageNotUnderstood ,
		ZeroDivide 
	] includes: self.
%
category: 'ANSI - exceptionInstantiator'
classmethod: ExceptionA
new
	"Return a newly created object initialized to a standard initial state.

	The object returned is an <exceptionBuilder> that may be used to
	signal an exception of the same type that would be signaled if the
	message #signal is sent to the receiver.

	The object returned conforms to <Exception>."

	^self basicNew initialize
%
category: 'ANSI - exceptionInstantiator'
classmethod: ExceptionA
signal

	"An exception of the type associated with the receiver is signaled.
	The <signaledException> is initialized to its default state.

	The exception signaled conforms to <Exception> with all of its
	<exceptionDescription> attributes set to their default values."

	^self signal: nil.
%
category: 'ANSI - exceptionSignaler'
classmethod: ExceptionA
signal: signalText
	
	^self new signal: signalText.
%
category: 'ANSI support'
classmethod: ExceptionA
staticCatch: anException category: cat number: errNum arguments: args

	| inst |
	inst := self 
		category: 		cat
		number: 			errNum
		arguments: 		args.
	^inst
		handler: 			anException handler copy;
		gsCategory: 		cat;
		gsNumber: 		errNum;
		gsArguments: 	args;
		_defaultAction;
		result.
%
category: 'ANSI support'
classmethod: ExceptionA
staticExceptionBlock

	^[:theException :cat :num :args |
			ExceptionA
				staticCatch: 	theException
				category: 		cat
				number: 			num
				arguments: 		args.
	].
%
category: 'ANSI support'
classmethod: ExceptionA
try: tryBlock on: aSymbolDictionary do: handlerBlock

	^ExceptionHandler new
		try: tryBlock
		on: aSymbolDictionary 
		in: self
		do: handlerBlock.
%
category: 'ANSI support'
method: ExceptionA
_defaultAction

	result := self defaultAction.
	self isResumable ifTrue: [^self].

"If the <signaled exception> is not <resumable> the action taken 
upon completion of the #defaultAction method is implementation defined.
-- ANSI section 5.5.2.1"

	Error signal: 'Returned from the default action of a non-resumable exception'.
%
category: 'Accessors'
method: ExceptionA
action

	action == nil ifTrue: [action := #resume].
	(action == #resume _and: [self isResumable not]) ifTrue: [action := #return].
	^action.
%
category: 'Accessors'
method: ExceptionA
action: aSymbol

	(#(nil #resignal #resume #retry #return) includes: aSymbol) ifFalse: [
		self error: 'unrecognized action'.
	].
	action := aSymbol.
%
category: 'ANSI - exceptionDescription'
method: ExceptionA
defaultAction
	"If the exception described by the receiver is signaled 
	and the current <exception environment> does not
	contain a handler for the exception, this method will
	be executed."

	| num cat args | 
	cat := self gsCategory.
	num := self gsNumber.
	args := self gsArguments.
	(cat = ExceptionA exceptionCategory _and: [num == ExceptionA errorNumberToSignal]) ifTrue: [
		args := Array 
			with: args first
			with: args first messageText.
	].
	result := System
		_signalGciError: 	num
		args: 				args
		signalDictionary: cat.
	^result.
%
category: 'ANSI - exceptionDescription'
method: ExceptionA
description
	"Return text that describes in a human readable form 
	an occurrence of an exception. If an explicit message
	text was provided by the signaler of the exception,
	that text should be incorporated into the description."

	| cat array num desc args |
	messageText ~~ nil ifTrue: [^messageText].
	(cat := self gsCategory) isNil ifTrue: [^self genericDescription].
	array := cat 
		at: System myUserProfile nativeLanguage 
		ifAbsent: [^self genericDescription].
	(num := self gsNumber) isNil ifTrue: [^self genericDescription].
	array size < num ifTrue: [^self genericDescription].
	(desc := array at: num) isNil ifTrue: [^self genericDescription].
	((args := self gsArguments) isKindOf: Array) ifFalse: [^self genericDescription].
	^self gsCategory 
		textForError: num
		args: args.
%
category: 'ANSI support'
method: ExceptionA
doResignal

	| gsException nextEx |
	gsException := handler gsException.
	nextEx := gsException 
		_nextExceptionFor: self gsNumber 
		signalDictionary: self gsCategory.
	result := (nextEx == nil) ifTrue: [
		self defaultAction.
	] ifFalse: [
		gsException
			resignal: self gsCategory 
			number: self gsNumber 
			args: self gsArguments.
	].
%
category: 'ANSI support'
method: ExceptionA
doResignalAs

	| newExA |
	newExA := result.
	result := newExA signal.
	action := newExA action.
%
category: 'ANSI support'
method: ExceptionA
doRetry

	| handlerBlock |
	handlerBlock := result ~~ nil 
		ifTrue:  [result] 
		ifFalse: [handler handlerBlock].
	result := handler tryBlock
		on: handler exceptionSelector
		do: handlerBlock.
%
category: 'ANSI support'
method: ExceptionA
firstGSException

	^Exception
		_exceptionFor: self class errorNumberToSignal
		signalDictionary: self class exceptionCategory.
%
category: 'ANSI support'
method: ExceptionA
genericDescription

	^'An unknown ' , self class name , ' has occurred'.
%
category: 'Accessors'
method: ExceptionA
gsArguments

	^gsArguments ~~ nil
		ifTrue:  [gsArguments]
		ifFalse: [Array with: self with: self gsNumber].
%
category: 'Accessors'
method: ExceptionA
gsArguments: anArray

	gsArguments := anArray.
%
category: 'Accessors'
method: ExceptionA
gsCategory

	^gsCategory ~~ nil
		ifTrue:  [gsCategory]
		ifFalse: [self class exceptionCategory].
%
category: 'Accessors'
method: ExceptionA
gsCategory: aSymbolDictionary

	gsCategory := aSymbolDictionary.
%
category: 'Accessors'
method: ExceptionA
gsNumber

	^gsNumber ~~ nil
		ifTrue:  [gsNumber]
		ifFalse: [self class errorNumberToSignal].
%
category: 'Accessors'
method: ExceptionA
gsNumber: anInteger

	gsNumber := anInteger.
%
category: 'Accessors'
method: ExceptionA
handler

	^handler.
%
category: 'Accessors'
method: ExceptionA
handler: anExceptionHandler

	handler := anExceptionHandler.
%
category: 'ANSI support'
method: ExceptionA
initialize
	"provided to allow subclasses to override
	(GemStone/S does not include #initialize in Object)."
%
category: 'ANSI support'
method: ExceptionA
isHalt

	^self gsCategory == GemStoneError 
		_and: [(self gsNumber == 2318 _and: [
			(self gsArguments at: 1) == #halt _and: [
			(self gsArguments at: 2) = '#halt encountered']])
		_or: [self gsNumber == 6001]].
%
category: 'ANSI - signaledException'
method: ExceptionA
isNested
	"Answer 'true' if the 'handler environment' for the current exception handler
	contains an 'exception handler' that will 'handle' the receiver. Answer 'false'
	if it does not.

	The 'default action' for an exception is not considered to be an enclosing handler.
	Only the existence of a handler explicitly established using #on:do: will result in 
	this method returning 'true'."

	^handler isNested.
%
category: 'ANSI - exceptionDescription'
method: ExceptionA
isResumable

	^false.
%
category: 'ANSI - exceptionDescription'
method: ExceptionA
messageText
	"Return the signaler message text of the receiver. If the signaler
	has not provided any message text, return nil."

	^messageText
%
! fix statement with no effect with fix 34213
category: 'ANSI - exceptionBuilder'
method: ExceptionA
messageText: signalerText
	"Set the signaler message text of the receiver. Subsequent sends of the 
	message #messageText to the receiver will return this value.
	Subsequent sends of the message #messageText to a 'signaled exception'
	generated by sending the message #signal to the receiver of this message
	will also return this value."


	messageText := signalerText.
%
category: 'Accessors'
method: ExceptionA
number

	^gsNumber.
%
category: 'ANSI - signaledException'
method: ExceptionA
outer

	"If the 'handler environment' for the current exception handler contains an
	'exception handler' that will 'handle' the receiver, evaluate that handler's
	'exception action' with the receiver as the argument to its 'handler block.' 
	If there is no enclosing handler, send the message #defaultAction to the
	receiver. The #defaultAction method is evaluated using the current
	'exception environment.'

	If the receiver is 'resumable' and the evaluated 'exception action' resumes 
	then the result returned from #outer will be the 'resumption value' of the
	evaluated 'exception action.' If the receiver is not 'resumable' or if the
	'exception action' does not resume then this message will not return.

	For exceptions that are not 'resumable', #outer is equivalent to #pass."

	^handler outer.
%
category: 'ANSI - signaledException'
method: ExceptionA
pass
	"If the 'handler environment' for the current exception handler contains an
	enclosing 'exception handler' for the receiver, activate that handler's 
	'exception action' in place of the current 'exception action.' If there is no
	enclosing handler, execute the 'default action' for the receiver as if no
	handler had been found when the exception was originally signaled. The
	default action is evaluated in the context of the signaling environment.

	Control does not return to the currently active 'exception handler.'"

	handler outer.
	handler signalEarlyReturn.
%
category: 'ANSI - signaledException'
method: ExceptionA
resignalAs: replacementException
	"The active 'exception action' is aborted and the 'exception environment'
	and the 'evaluation context' are restored to the same states that were in
	effect when the receiver was originally signaled. Restoring the 'evaluation
	context' may result in the execution of #ensure: or #ifCurtailed: termination
	blocks.

	After restoration, signal the 'replacementException' and execute the
	'exception action' as determined by the restored 'exception environment.'

	This message causes the 'replacementException' to be treated as if it had
	been originally signaled instead of the receiver.

	If the 'replacementException' is 'resumable' and its 'exception action' resumes,
	control will ultimately return from the message that signaled the original 
	exception.

	Control does not return from this message to the currently active
	'exception action.'"

	self action: #resignal.
	result := replacementException.
	handler signalEarlyReturn.
%
category: 'Accessors'
method: ExceptionA
result

	^result.
%
category: 'Accessors'
method: ExceptionA
result: anObject

anObject == #retry ifTrue: [self halt].
	result := anObject.
%
category: 'ANSI - signaledException'
method: ExceptionA
resume
	"If the current 'exception action' was activated as the result of sending
	the message #outer to the receiver, return a resumption value as the 
	value of the #outer message.

	If the receiver is a 'resumable' exception a resumption value is returned
	as the value of the message that signaled the receiver. Before returning,
	the 'exception environment' and the 'evaluation context' are restored
	to the same states that were in effect when the receiver was originally
	signaled. Restoring the 'evaluation context' may result in the execution of
	#ensure: or #ifCurtailed: termination blocks.

	This message does not return to its point of invocation.

	The resumption value is unspecified."

	self resume: nil.
%
category: 'ANSI - signaledException'
method: ExceptionA
resume: resumptionValue
	"If the current 'exception action' was activated as the result of sending the
	message #outer to the receiver, return 'resumptionValue' as the value
	of the #outer message.

	If the receiver is a 'resumable' exception, the 'resumptionValue' is returned
	as the value of the message that signaled the receiver. Before returning,
	the 'exception environment' and the 'evaluation context' are restored to the 
	same states that were in effect when the receiver was originally signaled.
	Restoring the 'evaluation context' may result in the execution of #ensure:
	or #ifCurtailed: termination blocks.

	This message does not return to its point of invocation."

	self action: #resume.
	result := resumptionValue.
	handler resume: resumptionValue.
%
category: 'ANSI - signaledException'
method: ExceptionA
retry
	"The active 'exception action' is aborted and the 'exception environment' and the
	'evaluation context' are restored to the same states that were in effect when the 
	#on:do: message that established the active handler was sent. Restoring the
	'evaluation context' may result in the execution of #ensure: or #ifCurtailed: 
	termination blocks.

	After the restoration, the #on:do: method is re-evaluated with its original receiver
	and arguments. Control does not return from this message to the curently active
	'exception action.'"

	self retryUsing: nil.
%
category: 'ANSI - signaledException'
method: ExceptionA
retryUsing: alternativeBlock
	"The active 'exception action' is aborted and the 'exception environment' and the
	'evaluation context' are restored to the same states that were in effect when the
	#on:do: message that established the active handler was sent. Restoring the 
	'evaluation context' may result in the execution of #ensure: or #ifCurtailed blocks.

	After the restoration, the #on:do: method is re-evaluated with 'alternativeBlock'
	substituted for its original receiver. The original arguments are used for the 
	re-evaluation.

	Control does not return from this message to the currently active 'exception action.'"

	self action: #retry.
	result := alternativeBlock.
	handler signalEarlyReturn.
%
category: 'ANSI - signaledException'
method: ExceptionA
return
	"The value 'nil' is returned as the value of the 'protected block' of the active
	'exception handler.' Before returning, the 'exception environment' and the 
	'evaluation context' are restored to the same states that were in effect when
	the active handler was created using #on:do:. Restoring the 'evaluation context'
	may result in the execution of #ensure: or #ifCurtailed: termination blocks.

	This message does not return to its point of invocation."

	self return: nil
%
category: 'ANSI - signaledException'
method: ExceptionA
return: returnValue
	"The 'returnValue' is returned as the value of the 'protected block' of the 
	active 'exception handler.' Before returning, the 'exception environment'
	and the 'evaluation context' are restored to the same states that were in 
	effect when the active handler was created using #on:do:. Restoring the
	'evaluation context' may result in the execution of #ensure: or #ifCurtailed
	termination blocks.

	This message does not return to its point of invocation."

	handler return: returnValue.
%
category: 'ANSI support'
method: ExceptionA
shouldReturnFromHandlerBlock

	^#(#return #retry) includes: action.
%
category: 'ANSI - exceptionSignaler'
method: ExceptionA
signal
	"Associated with the receiver is an <exceptionDescription> called the 'signaled exception.'
	The current 'exception environment' is searched for an 'exception handler' whose
	'exception selector' mathces the 'signaled exception.' The search proceeds from the most
	recently created 'exception handler' to the oldest 'exception handler.'

	A matching handler is defined to be one which would return 'true' if the message #handles:
	was sent to its 'exception selector' with the 'signaled exception' as the argument.

	If a matching handler is found, the 'exception action' of the handler is evaluated in the 
	'exception environment' tat was current when the handler was created and the state of
	the curent 'exception environment' is preserved as the 'signaling environment.'

	The 'exception action' is evaluated as if the message #value: were sent to it with a
	<signaledException> passed as its argument. The <signaledException> is derived from
	the 'signaled exception' in an implementation dependent manner.

	If the evaluation of the 'exception action' returns normally (as if it had returned from the
	#value: message), the 'handler environment' is restored and the value returned from the
	'exception action' is returned as the value of the #on:do: message that created the
	handler. Before returning, any active #ensure: or #ifCurtailed: termination blocks created
	during evaluation of the receiver of the #on:do: message are evaluated.

	If a matching handler is not found when the 'exception environment' is searched, the
	'default action' for the 'signaled exception' is performed. This is accomplished as if the
	message #defaultAction were sent to the <signaledException> object derived from the 
	'signaled exception.' If the 'exception' is 'resumable' the value returned from the 
	#defaultAction method is returned as the value of the #signal message. If the 
	'signaled exception' is not 'resumable' the action taken upon completion of the
	#defaultAction method is implementation defined."

	| gsException num |
	(gsException := self firstGSException) == nil ifTrue: [^self _defaultAction; result].
	handler := gsException handler.
	num := self class errorNumberToSignal.
	^gsException block
		value: gsException 
		value: self class exceptionCategory
		value: num
		value: (Array with: self with: num).
%
category: 'ANSI - exceptionSignaler'
method: ExceptionA
signal: signalText
	"Associated with the receiver is an <exceptionDescription> called the 'signaled exception.'
	The message text of the signaled exception is set to the value of signalerText, and then
	the exception is signaled in the same manner as if the message #signal had been sent
	to the receiver.

	Note that this message does not return in some circumstances. The situations in which
	it does not return and the returned value, if any, are the same as specified for the 
	#signal message."

	messageText := signalText.
	^self signal.
%
category: 'ANSI - exceptionDescription'
method: ExceptionA
tag
	"Return the tag value provided by the signaler of the receiver.
	If the signaler has not provided a tag value, return the same
	value as would be returned if #messageText was sent to the
	receiver of this message. If the signaler has provided neither
	a tag value nor a message text, return nil.

	Exception tags are intended for use in situations where a 
	particular occurrence of an exception needs to be identified
	and a textual description is not appropriate. For example,
	the message text might vary according to the locale and 
	thus could not be used to identify the exception."

	^tag ~~ nil 
		ifTrue: [tag]
		ifFalse: [self messageText].
%
category: 'Accessors'
method: ExceptionA
tag: anObject

	tag := anObject.
%
category: 'ANSI support'
method: ExceptionA
valueHandler: aBlock

	aBlock == nil ifTrue: [
		self action: #resume.
		result := self defaultAction.
	] ifFalse: [
		self action: #return.
		result := aBlock value: self.
	].
%
category: 'Trace Log'
classmethod: ExceptionHandler
disableTraceLog

	TraceLog := nil.
%
category: 'Trace Log'
classmethod: ExceptionHandler
enableTraceLog

	TraceLog := 0 -> (WriteStream on: String new).
%
category: 'Trace Log'
classmethod: ExceptionHandler
trace: aString

	self 
		trace: aString
		indent: 0.
%
category: 'Trace Log'
classmethod: ExceptionHandler
trace: aString indent: anInteger

	TraceLog ~~ nil ifTrue: [
		anInteger < 0 ifTrue: [TraceLog key: TraceLog key + anInteger].
		aString ~~ nil ifTrue: [
			TraceLog value cr.
			TraceLog key timesRepeat: [TraceLog value space].
			TraceLog value nextPutAll: aString.
		].
		anInteger > 0 ifTrue: [TraceLog key: TraceLog key + anInteger].
	].
%
category: 'Trace Log'
classmethod: ExceptionHandler
traceBegin: aString

	self 
		trace: aString
		indent: 2.
%
category: 'Trace Log'
classmethod: ExceptionHandler
traceBlock: aBlock

	| answer trace |
	self enableTraceLog.
	answer := aBlock value.
	trace := self traceLog.
	self disableTraceLog.
	^answer -> trace.
%
category: 'Trace Log'
classmethod: ExceptionHandler
traceEnd: aString

	self 
		trace: aString
		indent: -2.
%
category: 'Trace Log'
classmethod: ExceptionHandler
traceLog

	TraceLog == nil ifTrue: [^''].
	^TraceLog value contents.
%
category: 'Exceptions'
method: ExceptionHandler
caughtEx: ex number: num cat: cat args: args

	| curtailed |
	resumeBlock isNil ifTrue: [resumeBlock := [:value | ^value]].
	signaledException := Error
		category:    cat 
		number:      num 
		arguments:   args.
	signaledException 
		handler:     self;
		gsCategory:  cat;
		gsNumber:    num;
		gsArguments: args;
		yourself.
	self caughtException.
	signaledException shouldReturnFromHandlerBlock ifTrue: [
		returnBlock value: signaledException result.
		self error: 'Should not get here!'.
	].
	^signaledException result.
%
category: 'Exceptions'
method: ExceptionHandler
caughtException

	self shouldWeHandleThis 
		ifTrue:  [self valueHandlerBlock]
		ifFalse: [signaledException doResignal].
	signaledException action == #retry 		ifTrue: [^signaledException doRetry].
	signaledException action == #resignal 	ifTrue: [^signaledException doResignalAs].
%
category: 'Accessors'
method: ExceptionHandler
exceptionSelector

	^exceptionSelector.
%
category: 'Accessors'
method: ExceptionHandler
exceptionSelector: anExceptionSelector

	exceptionSelector := anExceptionSelector.
%
category: 'Accessors'
method: ExceptionHandler
gsException

	^gsException.
%
category: 'Accessors'
method: ExceptionHandler
gsException: anException

	gsException := anException.
	exceptionSelector := ExceptionA.
%
category: 'Accessors'
method: ExceptionHandler
handlerBlock

	^handlerBlock.
%
category: 'Accessors'
method: ExceptionHandler
handlerBlock: aBlock

	handlerBlock := aBlock.
%
category: 'Exceptions'
method: ExceptionHandler
isNested

	| nextEx |
	^(nextEx := self nextException) ~~ nil _and: [nextEx isStaticHandler not].
%
category: 'Exceptions'
method: ExceptionHandler
nextException

	| nextEx |
	nextEx := gsException.
	[
		nextEx := nextEx
			_nextExceptionFor: signaledException gsNumber
			signalDictionary: signaledException gsCategory.
		nextEx ~~ nil.
	] whileTrue: [
		nextEx handler == nil ifTrue: [^nextEx].
		(nextEx handler exceptionSelector handles: signaledException) ifTrue: [^nextEx].
	].
	^nil.
%
category: 'Exceptions'
method: ExceptionHandler
outer

	| nextException localNextHandler answer |
	(nextException := self nextException) == nil ifTrue: [
		^signaledException _defaultAction; result.
	].
	(localNextHandler := nextException handler) == nil ifTrue: [
		^nextException 
			_signal: signaledException gsCategory 
			number: signaledException gsNumber 
			args: signaledException gsArguments.
	].
	answer := localNextHandler copy outerFrom: self.
	signaledException isResumable ifTrue: [^answer].
	self error: 'Attempt to resume from a non-resumable exception'.
%
category: 'Exceptions'
method: ExceptionHandler
outerFrom: aHandler

	signaledException := aHandler signaledException.
	signaledException handler: self.
	signaledException action: nil.
	resumeBlock := [:value | ^value].
	self caughtException.
	signaledException handler: aHandler.
	^signaledException result.
%
category: 'Exceptions'
method: ExceptionHandler
resume: anObject

	resumeBlock value: anObject.
%
category: 'Exceptions'
method: ExceptionHandler
return: anObject

	returnBlock value: anObject.
%
category: 'Exceptions'
method: ExceptionHandler
shouldWeHandleThis

	alternateBlock ~~ nil ifTrue: [^false].
	signaledException isHalt ifTrue: [^false].
	^exceptionSelector handles: signaledException.
%
category: 'Exceptions'
method: ExceptionHandler
signalEarlyReturn

	alternateBlock value.
%
category: 'Accessors'
method: ExceptionHandler
signaledException

	^signaledException.
%
category: 'Accessors'
method: ExceptionHandler
signaledException: anExceptionA

	signaledException := anExceptionA.
%
category: 'Trace Log'
method: ExceptionHandler
trace: aString

	self class trace: 'ExceptionHandler(' , self asOop printString , ')>>' , aString.
%
category: 'Trace Log'
method: ExceptionHandler
traceBegin: aString

	self class traceBegin: aString.
%
category: 'Trace Log'
method: ExceptionHandler
traceEnd: aString

	self class traceEnd: aString.
%
category: 'Exceptions'
method: ExceptionHandler
try: aBlock on: aSymbolDictionary in: anExceptionSelector do: anotherBlock
 
	tryBlock := aBlock.
	exceptionSelector := anExceptionSelector.
	handlerBlock := anotherBlock.
	returnBlock := [:value | ^value].
	gsException := Exception category: nil number: nil do: [:ex :cat :num :args | 
		"The following code can return from the #'on:do:' message by using the returnBlock"
		self caughtEx: ex number: num cat: cat args: args.
		"If we fall through, the result of the above expression will be returned by the #'signal' message."
	].
	gsException handler: self.
	^tryBlock value.
%
category: 'Accessors'
method: ExceptionHandler
tryBlock

	^tryBlock.
%
category: 'Accessors'
method: ExceptionHandler
tryBlock: aBlock

	tryBlock := aBlock.
%
category: 'Exceptions'
method: ExceptionHandler
valueHandlerBlock

	alternateBlock := [^self].
	[
		signaledException valueHandler: handlerBlock.
	] ensure: [
		alternateBlock := nil.
		resumeBlock := nil.
	].
%
category: 'instance creation'
classmethod: ExceptionSet
new
	"Answer a new instance of the receiver."

	^self basicNew initialize
%
category: 'instance creation'
classmethod: ExceptionSet
with: selector1 with: selector2
	"Private - Answer a new instance of the receiver containing 
	the <exceptionSelector> arguments, selector1 and selector2"

	^self basicNew
		selectors: (OrderedCollection with: selector1 with: selector2)
%
category: 'ANSI - exceptionSelector'
method: ExceptionSet
, anotherException
	"Return an exception set that contains the receiver and the argument exception.
	This is commonly used to specify a set of exception selectors for an 
	'exception handler.'

	In addition to 'anotherException' the exception set that is returned contains
	all of the 'exception selectors' contained in the receiver.

	The returned object may or may not be the same object as the receiver."

	^anotherException exceptionSetWithExceptionSet: self.
%
category: 'ANSI support'
method: ExceptionSet
add: anException

	selectors add: anException.
%
category: 'ANSI support'
method: ExceptionSet
exceptionSetWithException: anException

	selectors add: anException.
%
category: 'ANSI support'
method: ExceptionSet
exceptionSetWithExceptionSet: anExceptionSet

	selectors addAll: anExceptionSet selectors.
%
category: 'ANSI - exceptionSelector'
method: ExceptionSet
handles: exception

	^selectors anySatisfy: [:es | es handles: exception]
%
category: 'initializing'
method: ExceptionSet
initialize

	selectors := OrderedCollection new.
%
category: 'accessing'
method: ExceptionSet
selectors
	"Answer the value of the receiver's instance variable 'selectors'.
	This method was automatically generated, but may be modified."

	^selectors
%
category: 'Exceptions'
method: ExceptionSet
selectors: anObject
	"Set the value of the receiver's instance variable 'selectors' to anObject.
	This method was automatically generated, but may be modified."

	selectors := anObject
%
category: 'ANSI support'
method: ExceptionSet
size 

	^selectors size.
%
category: 'ANSI support'
method: ExceptionSet
try: tryBlock on: aSymbolDictionary do: handlerBlock

	^ExceptionHandler new
		try: tryBlock
		on: aSymbolDictionary 
		in: self
		do: handlerBlock.
%
category: 'Block Evaluation'
method: ExecutableBlock
on: selector do: action
	"Try to evaluate the receiver, and should an exception occur which is matched
	by selector (normally a class object which is a subclass of ExceptionA), 
	evaluate the <monadicBlock>, action, passing it the exception 
	instance as its argument."

	^selector
		try: self
		on: nil
		do: action.
%
category: 'accessors'
method: FailedMessage
arguments

	^arguments.
%
category: 'accessors'
method: FailedMessage
arguments: anArray

	arguments := anArray.
%
category: 'accessors'
method: FailedMessage
selector

	^selector.
%
category: 'accessors'
method: FailedMessage
selector: aSymbol

	selector := aSymbol.
%
category: 'ANSI support'
classmethod: MessageNotUnderstood
errorNumberToCatch
	"RT_ERR_DOES_NOT_UNDERSTAND	No method was found for the given selector.
	  Args: (1) the  receiver; (2) the selector; (3) an array of arguments"

	^2010.
%
category: 'ANSI support'
classmethod: MessageNotUnderstood
errorNumberToSignal
	"RT_ERR_DOES_NOT_UNDERSTAND	No method was found for the given selector.
	  Args: (1) the  receiver; (2) the selector; (3) an array of arguments"

	^2010.
%
category: 'ANSI support'
classmethod: MessageNotUnderstood
signal: anObject

	anObject fooBar.
%
category: 'ANSI - accessing'
method: MessageNotUnderstood
defaultAction
	"The current computation is terminated. The cause of the error should be
	logged or reported to the user. If the program is operating in an interactive
	debugging environment the computation should be suspended and the 
	debugger activated."

	^super defaultAction.
%
category: 'ANSI - exceptionDescription'
method: MessageNotUnderstood
isResumable
	"Message not understood errors are considered resumable, as 
	there are a number of circumstances in which we might want 
	to perform #doesNotUnderstand: handling and continue."

	^true.
%
category: 'ANSI - exceptionDescription'
method: MessageNotUnderstood
message
	"Answer the selector and arguments of the message that failed."

	^self tag
%
category: 'ANSI - exceptionDescription'
method: MessageNotUnderstood
message: aFailedMessage

	self tag: aFailedMessage.
%
category: 'ANSI - exceptionDescription'
method: MessageNotUnderstood
receiver
	"Answer the object that was the receiver of the message that failed."

	^receiver
%
category: 'ANSI - accessing'
method: MessageNotUnderstood
receiver: anObject
	"Set the object which did not understand the message to be anObject"
	
	receiver := anObject
%
category: 'ANSI - accessing'
method: MessageNotUnderstood
selector
	"Answer the selector that was not understood from the receiver's
	<failedMessage>."

	^self message selector
%
category: 'ANSI - signaledException'
method: Notification
defaultAction
	"No action is taken. The value 'nil' is returned as the value
	of the message that signaled the exception."

	^nil.
%
category: 'ANSI - signaledException'
method: Notification
isResumable
	"Notification exceptions by default are specified to be 'resumable'."

	^true
%
category: 'Block Evaluation'
method: SymbolDictionary
try: tryBlock on: ignored do: handlerBlock
		"This allows us to support #on:do: in ExecutableBlock:
	'tryBlock on: <SymbolDictionary such as GemStoneError> do: handlerBlock.'	"

	^ExceptionA
		try: tryBlock
		on: self
		do: handlerBlock.
%
category: 'ANSI - signaledException'
method: Warning
defaultAction
	"The user should be notified of the occurrence of an exceptional
	occurrence and given an option of continuing or aborting the
	computation. The description of the occurrence should include
	any text specified as the argument of the #signal: message."

	^super defaultAction.
%
category: 'ANSI - exceptionInstantiator'
classmethod: ZeroDivide
dividend: argument
	"Signal the occurrence of a division by zero exception. Capture the number
	that was being divided such that it is available from the 'signaled exception.'

	If the message #dividend is subsequently sent to the <ZeroDivide> object
	that is the 'signaled exception' the value of 'argument' is returned."

	"It seems rare that this Exception would be signaled by sending this message.
	Typically, this Exception is signaled indirectly by the VM when a 
	division by zero occurs. So why not just take the usual path?!"

	argument / 0.
%
category: 'ANSI support'
classmethod: ZeroDivide
errorNumberToCatch
	"NUM_ERR_INT_DIVISION_BY_ZERO	An attempt was made to divide an integer by zero.  
	Args: (1) the number"

	^2026.
%
category: 'ANSI support'
classmethod: ZeroDivide
errorNumberToSignal
	"NUM_ERR_INT_DIVISION_BY_ZERO	An attempt was made to divide an integer by zero.  
	Args: (1) the number"

	^2026.
%
category: 'ANSI - exceptionInstantiator'
classmethod: ZeroDivide
signal

	0 / 0.
%
category: 'ANSI - signaledException'
method: ZeroDivide
dividend

	^tag.
%
category: 'ANSI - signaledException'
method: ZeroDivide
isResumable
	"Division by zero is not considered fatal, so allow resumption."

	^true
%
