prev back next

Exception handling and signals

Contents

Introduction

Whenever some error occurs in Smalltalk/X (such as a division by zero), the system does not simply crash or terminate, but instead notify the running program via an exception mechanism. There are many reasons, why a sophisticated error handling mechanism is needed in smalltalk, the most obvious is of course, that you are working in the system and dont want to get kicked out due to some minor error. Especially, when evaluating doIt expressions or while testing new methods, errors can happen quite easily.

To do this, all errors have associated with them a so called Signal object (no to confuse with Unix-Signals), which gets notified of the error. In smalltalk terms, this is called "raising a signal" or "raising an exception".

Your program can provide a handler for such an exception, which can decide what to do with the error. If no handler exists, a reasonable default action is taken (typically, the debugger is entered, but there are signals which are ignored).

Signals, parents and SignalSets

Usually, all signal objects which can be raised by some classes methods are kept in the class as classvariables and created during early initialization of the system. Most classes provide access to those signals via class methods.

For example, the signal raised upon division-by-zero errors is kept in the class ArithmeticValue as classvariable DivisionByZeroSignal. The method that provides access to this signal is

      ArithmeticValue divisionByZeroSignal.
Since subclasses of ArithmeticValue share its class variables and inherit its methods, all numeric classes will of course also respond to this message and return the signal object (i.e. Float divisionByZeroSignal will also work and return the same object).

Every signal (except ErrorSignal) has a parent signal. Whenever a handler is specified for a parentSignal, all child signals are also handled by this handler. There are some signals which are never raised directly, but instead exist as parent signals of others for the purpose of handling them all at once. An example of such a signal is ArithmeticValue>>arithmeticSignal, which is a parent of all other numeric signals.

Sometimes, you may want to handle a group of unrelated signals with a common handler (i.e. signals which do not have a common parent). For example, in a desk-calculator you may decide to handle any numeric error and the messageNotUnderstood signals with a common handler. To support this, Smalltalk/X provides groups of signals, so called SignalSets.
A signalSet may contain a number of signals and also responds to the handle:do: and catch: messages in much the same way as signals do (see below). A signalSet to catch the above errors could be created with:

	|s|

	s := SignalSet 
		with:(Object messageNotUnderstoodSignal)
		with:(ArithmeticValue arithmeticSignal).
	...
(Notice: SignalSet is inheriting from Collection; therefore the with:with: is understood by the SignalSet class - but you will need individual add: messages if a set with more than 4 signals is to be created).

Signal handlers

Signals are handled by providing a signal handler (-block) for the duration of some computation. Whenever the handled signal is raised during the computation, the handler will be evaluated. The handler gets the reason (i.e. the signal) and location (i.e. the context) of the exception as argument; wrapped into a so-called exception object. An optional additional parameter and an error string are also available in the exception object.

The handler can decide how to react to the signal - it may:

Many applications must perform operations "save" from entering the debugger. Such a "save" computation is performed by passing both the handler-block and the block which does the actual computation to the signals handle:do: method.
The following shall make this somewhat clearer:
	aSignal
	    handle:[:ex |
		"this is the handler ...
		 ex is the exception object - see more below."
	    ]
	    do:[
		"this is the computation"
	    ]
In the above, whenever aSignal is raised during evaluation of the second block (the one after 'do:'), the handler block (the one after 'handle:') is evaluated. The handler is a block with one argument (ex) in which the exception object (containing the exception info) will be passed.

a concrete example:
In a desk calculator, you want to catch division-by-zero errors (remember: end-users should normally not be confused by debuggers):

	|result arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue divisionByZeroSignal
	    handle:[:ex |
		Transcript showCr:'an error occurred.'.
		ex return
	    ]
	    do:[
		"now divide ..."
		result := arg / divisor
	    ].
	Transcript showCr:('the result is ' , result printString).
The interresting thing in the above code is the 'ex return'. This is the handlers action (in this case returning from the faulty computation).

Lets try another one, in which the handler restarts the computation (not without changing the divisor first ...):

	|result arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue divisionByZeroSignal
	    handle:[:ex |
		Transcript showCr:'an error occurred.'.
		Transcript showCr:'retry with 1 as divisor.'.
		divisor := 1.
		ex restart
	    ]
	    do:[
		"now divide ..."
		result := arg / divisor
	    ].
	Transcript showCr:('the result is ' , result printString).
The handler can also decide to not handle the signal, and let it be handled by someone else. This is useful when handlers are nested, and another handle:do: context is already calling this one or if a handler can do some partial repair or cleanup work, but still wants other error handlers to be executed.

Since there is no other handler in the example below, you will end up in the debugger after the handler has sent its message to the Transcript.

	|result arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue divisionByZeroSignal
	    handle:[:ex |
		Transcript showCr:'an error occurred.'.
		Transcript showCr:'I give it to the next handler.'.
		ex reject
	    ]
	    do:[
		"now divide ..."
		result := arg / divisor
	    ].
	Transcript showCr:('the result is ' , result printString).
If the handler does no explicit return, proceed or reject, but simply falls through to the end of the block, this will have the same effect as a reject.
Thus, the above is equivalent to:
	|result arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue divisionByZeroSignal
	    handle:[:ex |
		Transcript showCr:'an error occurred.'.
		Transcript showCr:'I give it to the next handler.'.
	    ]
	    do:[
		"now divide ..."
		result := arg / divisor
	    ].
	Transcript showCr:('the result is ' , result printString).
If your application is a graphical one, you might prefer to show some warn-box in the handler (your end-user application may not have a Transcript). This is of course straight forward:
	|result arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue divisionByZeroSignal
	    handle:[:ex |
		self warn:'an error occurred.'.
		ex return.
	    ]
	    do:[
		"now divide ..."
		result := arg / divisor
	    ].
	Transcript showCr:('the result is ' , result printString).
To define a handler for all arithmetic errors, we can use the parent of all arithmetic error signals: ArithmeticError.
This signal is never raised itself, however, since a handler for a parent signal will also handle child signals, defining a handler for the ArithmeticError signal will also handle division-by-zero and all other arithmetic signals:
	|result arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue arithmeticSignal
	    handle:[:ex |
		self warn:'an error occurred.'.
		ex return.
	    ]
	    do:[
		"now divide ..."
		result := arg / divisor
	    ].
	Transcript showCr:('the result is ' , result printString).
You may want to know which signal was actually responsible for the raise; you can ask the exception object for the raising signal, as in:
	|result arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue arithmeticSignal
	    handle:[:ex |
		self warn:'an error occurred (.', ex signal printString) , ')'.
		ex return.
	    ]
	    do:[
		"now divide ..."
		result := arg / divisor
	    ].
	Transcript showCr:('the result is ' , result printString).

Nested handlers

Handlers can be nested - for example, some methods can decide locally on how to handle an exception and continue gracefully. These may define a local signal handler and repair things. Any existing outer handler may or may not be notified (if the local handler rejects, the outer handler will see the exception; otherwise, the outer handler will not see anything).

An nice application for nested handlers can be found within the current smalltalk system:
whenever the abort-button is pressed in the debugger, an AbortSignal is raised, to return to some save place up in the calling hierarchy. The main event dispatcher handles this signal by simply continuing in its event loop.
A workspace on the other hand, handles errors locally, and may output an error message - in this case, the event-dispatcher will not see any error at all.

Example:

	|result1 result2 arg divisor|

	arg := 5.
	divisor := 0.

	ArithmeticValue anyArithmeticSignal
	handle:[:ex |
	    "(outer) handler for any arithmetic exception"

	    Transcript showCr:'an arithmetic error occurred'.
	    ex return.
	]
	do:[
	    "the computation"

	    ArithmeticValue divisionByZeroSignal
		handle:[:ex |
		    "(inner) handler for division by zero"

		    Transcript showCr:'division by zero ignored'.
		    ex proceedWith:0
		] 
		do:[
		    "now divide ..."
		    result1 := arg / divisor.
		    Transcript showCr:('result of division: ' , result1 printString).
		    result2 := arg arcSin.
		    "not reached, since outer handler returns"
		    Transcript showCr:('result of arcSin: ' , result2 printString).
		]
	    ]
	].
Notice: typically, handler blocks are not nested explicit as in the above example; instead, the nesting is burried in some called methods.

unhandled exceptions

Whenever an exception is unhandled, the runtime system will raise another signal, called the NoHandlerSignal. This signal can of course be handled just like any other signal. The default action for it is to open a debugger - which is why you end in the debugger for all other unhandled signals.

Thus, handling the NoHandlerSignal is almost equivalent to handling all other signals.
Example:

	|result arg divisor|

	arg := 5.
	divisor := 0.

	Signal noHandlerSignal
	    handle:[:ex |
		Transcript showCr:'some error occurred.'.
		ex proceed
	    ]
	    do:[
		"divide by zero ..."
		result := arg / divisor.
		Transcript showCr:'after division'.

		"send some bad messages ..."
		Array new:-1.
		Transcript showCr:'after bad new'.

		1 at:5.
		Transcript showCr:'after bad at:'.
	    ].
is almost equivalent to (remember that Object errorSignal is the parent signal of all others; thus handling this one also handles any other signal too):
	|result arg divisor|

	arg := 5.
	divisor := 0.

	Object errorSignal 
	    handle:[:ex |
		Transcript showCr:'some error occurred.'.
		ex proceed
	    ]
	    do:[
		"divide by zero ..."
		result := arg / divisor.
		Transcript showCr:'after division'.

		"send some bad messages ..."
		Array new:-1.
		Transcript showCr:'after bad new'.

		1 at:5.
		Transcript showCr:'after bad at:'.
	    ].
The difference lies in the exception-objects (the argument to the handler) contents; in the first example, the handler will find the NoHandler-context in the exception as location of the raise. In the latter example, the exception will contain the place where the original raise occured, which makes any repair work easier for the handler. Thus, in the first example above, the handler is invoked somewhat more indirectly.

If the NoHandler signal is not handled, a debugger is entered normally (but see below for what is really going on).

handler blocks

Instead of a handle:do: -handler-context, you may also assign a handler block statically to a signal. This block will be evaluated in case no handler context is found, or all handlers rejected.

Warning:

Static handler blocks are associated to the signal itself; therefore, they will be valid for all processes in any evaluation context. They should be used in special situations only.
Actually, static handlers only make sense for Unix signals (see below on how to have unix-signals raise a smalltalk signal). Or in enduser applications, to make certain that some error is always handled. (although a cleaner solution is to handle the NoHandler signal).
Example:
	|result arg divisor|

	ArithmeticValue divisionByZeroSignal
	    handlerBlock:[:ex |
		Transcript showCr:'division error occured - return 0 instead.'.
		ex proceedWith:0
	    ].

	arg := 5.
	divisor := 0.
	result := arg / divisor.

	"we have to cleanup - otherwise, this error will never
	 lead to the debugger again ..."

	ArithmeticValue divisionByZeroSignal
	    handlerBlock:nil
To demonstrate the global effect of the above, first evaluate:
	ArithmeticValue divisionByZeroSignal
	    handlerBlock:[:ex |
		Transcript showCr:'division error occured - return 0 instead.'.
		ex proceedWith:0
	    ].
then open any new workspace, and evaluate:
	|divisor|

	divisor := 0.
	5 // divisor
there. Dont forget to cleanup things after your experiments, with:
	ArithmeticValue divisionByZeroSignal handlerBlock:nil
Notice:
in this demostration, you cannot directly enter '5 // 0', since the compiler checks for zero-divisors BEFORE doing the actual send (when doing constant-folding). Thus the signal will not really be sent when using a constant as divisor. The compiler is (currently) not smart enough to track the values in variables - therefore putting the zero into some variable helps.
There is one limitation in static handler-blocks: no return or restart actions are allowed (i.e. these actions will lead to another error) in the handler.
The reason is simple: return/restart try to return from/restart the evaluation-block. Since there is no handle:do: context for static handlers, no such evaluation-block is available to return from. Static handlers should either: proceed or reject the exception, or terminate the current process. (Usually after showing some warnBox or querying the user).

per process emergency handler

In addition to static per-signal handler blocks, you can assign a per-process emergency handler block. This block will be evaluated if the NoHandler signal is unhandled. Each process can be assigned its own specific handlerblock.

Per-process handlers are useful, if you want to make certain that a process cleans up and terminates gracefully in case of some unhandled error; or, if you want to catch any error within the process AND you do not want to (or cannot) add handle:do: handlers all over your code.
Example:

	|myProcess|

	myProcess := [
	    Transcript showCr:'waiting for a while ...'.
	    (Delay forSeconds:5) wait.
	    Transcript showCr:'doing something bad ...'.
	    1 at:5 put:nil.
	    "this is not reached"
	    Transcript showCr:'after the bad computation'.
	] newProcess.

	"set the handler"
	myProcess emergencySignalHandler:[:ex |
	    self warn:('process terminated due to error:' , ex errorString).
	    Processor activeProcess terminate.
	].

	"let it run"
	myProcess resume
For a typical application of these per-process handlers, see how the Launcher sets up an emergency handler in its realize method, to show a warnbox and optionally abort whatever the user action was. Like static handlers, per-process handlers also do not support return and restart.

order of handler invocation

Handlers are invoced in the following order, until some handler either returns or proceeds the exception (i.e. followup-handlers are invoked while handlers reject). Falling through a handler block (without any explicit return, proceed or reject) behaves just like a reject.
  1. enclosing handle:do: handler, if any

    then (if no handler or rejected):

  2. next enclosing handle:do: handler(s), if any

    then (if none or rejected):

  3. per-signal static handler block, if any

    then (if none or rejected):

  4. NoHandler-signal handle:do: handlers, if any

    then (if none or rejected):

  5. NoHandler static handler-block, if any

    then (if none or rejected):

  6. per-process emergency-handler-block, if any

    finally:

  7. emergencyHandler defined in Exception-class
The last handler-block (in Exception) is always defined, and will unconditionally enter the debugger.

how to completely ignore errors

From the above order of evaluation, it should be clear, that errors can be completely ignored by either:
	Exception emergencyHandler:[:ex | ]
or:
	Signal noHandlerSignal handlerBlock:[:ex | ]
or (for this process alone):
	Processor activeProcess emergencySignalHandler:[:ex |]
If you want to try it, dont forget to cleanup afterwards by either:
	ExceptionBlock emergencySignalHandler:nil
or:
	Signal noHandlerSignal handlerBlock:nil
or:
	Processor activeProcess emergencySignalHandler:nil

Unix-signals vs. Smalltalk-signals

Technically, Unix signals have nothing at all to do with smalltalk signals. However, it is possible to arrange for a smalltalk signal to be raised whenever a Unix signal arrives. This is done by:
	OperatingSystem operatingSystemSignal:aNumber
				      install:aSignal
Notice, that OS signal numbers are not portable across different Unix versions or OperatingSystems. Thus, you should not depend upon SIGUSR1 being signal number 10, for example.
OperatingSystem offers methods to get the various numbers. Thus, your code should look like:
	|sigUsr mySignal|

	sigUsr := OperatingSystem sigUSR1.
	mySignal := Signal new.

	OperatingSystem 
	    operatingSystemSignal:sigUsr install:mySignal.
then, since Unix signals may occur at any time (especially: in another process), you should assign a static handler block to the signal (instead of a handle:do:):
	mySignal handlerBlock:[:ex |
	    "do whatever has to be done ..."
	]
Before the signal is finally delivered, the OS signal has to be enabled. This is done by:
	OperatingSystem enableSignal:sigUsr
One thing has to be kept in mind with these handlerblocks: since they may be evaluated in whatever process is running at signal time, these blocks should not (cannot) return or otherwise modify the context chain. I.e. a "^ something" is not allowed from these blocks.

Not all Unix signals can be assigned a smalltalk signal: certain signals will always be handled by smalltalk itself. These are (among others):

these are handled slightly different, but can also be cought by defining an object which is notified whenever these occur. (see timers. delays and interrupts).

further reading

You will find examples in 'doc/coding' which show various aspects and code examples of signal handling.

See list of signals for a table of signals and a description of when they are raised.


Copyright © Claus Gittinger Development & Consulting, all rights reserved

(cg@ssw.de)