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).
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
Since subclasses of
ArithmeticValue divisionByZeroSignal.
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:
(Notice:
|s|
s := SignalSet
with:(Object messageNotUnderstoodSignal)
with:(ArithmeticValue arithmeticSignal).
...
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).
The handler can decide how to react to the signal - it may:
handle:do:
method.
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):
The interresting thing in the above code is the
|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).
'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 ...):
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
|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).
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.
If the handler does no explicit
|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).
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:
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 |
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).
To define a handler for all arithmetic errors, we can
use the parent of all arithmetic error signals:
|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).
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:
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 return.
]
do:[
"now divide ..."
result := arg / divisor
].
Transcript showCr:('the result is ' , result printString).
|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).
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:
Notice: typically, handler blocks are not nested explicit as in the above
example; instead, the nesting is burried in some called methods.
|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).
]
]
].
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:
is almost equivalent to
(remember that
|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:'.
].
Object errorSignal
is the parent signal of all others;
thus handling this one also handles any other signal too):
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.
|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:'.
].
If the NoHandler
signal is not handled, a debugger is entered normally
(but see below for what is really going on).
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).
|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.
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 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:
For a typical application of these per-process handlers, see how the
|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
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
.
return
, proceed
or reject
) behaves just like
a reject
.
handle:do:
handler, if any
then (if no handler or rejected):
handle:do:
handler(s), if any
then (if none or rejected):
then (if none or rejected):
handle:do:
handlers, if any
then (if none or rejected):
then (if none or rejected):
finally:
Exception
-class
Exception
) is always defined,
and will unconditionally enter the debugger.
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
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.
|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):
SIGINTR
(i.e. CNTL-C),
SIGALARM
(for timer)
SIGFPE
(floating point exception).
'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)