"
 COPYRIGHT (c) 1993 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#Signal
         instanceVariableNames:'mayProceed notifierString nameClass message'
         classVariableNames:'NoHandlerSignal'
         poolDictionaries:''
         category:'Kernel-Exceptions'
!

Signal comment:'

COPYRIGHT (c) 1993 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.6 1994-01-16 03:46:05 claus Exp $
'!

!Signal class methodsFor:'documentation'!

documentation
"
Signal and Exception provide a framework for exception handling.

A Signal object is usually defined somewhere up in the calling chain
and associated with some abnormal event. Many signals are also
created at startup time and reused.

When the event is raised (by Signal>>raise) the control will be either 
given to a debugger or - if a handler was defined - to the handler. 
The handler will get a description of what (and where) happened in an 
Exception object and decide how to react on the situation (i.e. proceed,
return or restart).

There is also a companion class called SignalSet, which allows handling
multiple signals in with one handler (for example all arithmetic signals).
And, finally there is a very special SignalSet which allows catching
any signal.

This Signal implementation has been modeled after what some PD
programs seem to expect - it may not be perfect currently
(especially, I dont know what nameClass and message are for).

Parts of the implementation is a left-over from old times when the resume/
restart things in context did not work properly; now, with the handler-
and suspendedContext at hand, the exception can do it using other mechanisms.
This might be cleaned up ...

See samples in doc/coding.
"
! !

!Signal class methodsFor:'initialization'!

initialize
    "setup the signal used to handle unhandled signals"

    NoHandlerSignal := (Signal new).
    NoHandlerSignal mayProceed:true.
    NoHandlerSignal notifierString:'no Handler'
! !

!Signal class methodsFor:'instance creation'!

new
    "return a new signal"

    ^ self basicNew notifierString:'signal'
! !

!Signal class methodsFor:'signal access'!

noHandlerSignal
    "return the signal used to handle unhandled signals"

    ^ NoHandlerSignal
! !

!Signal methodsFor:'instance creation'!

newSignalMayProceed:aBoolean
    "create a new signal, using the receiver as a prototype"

    ^ (self copy) mayProceed:aBoolean
!

newSignal
    "create a new signal, using the receiver as a prototype"

    ^ (self copy)
! !

!Signal methodsFor:'accessing'!

nameClass:aClass message:aSelector
    "I dont know what that is used for (yet)"

    nameClass := aClass.
    message := aSelector
!

mayProceed:aBoolean
    "set/clear the signals ability to proceed.
     This flag is not checked in the current version of
     the debugger."

    mayProceed := aBoolean
!

notifierString:aString
    "set the notifier string"

    notifierString := aString
!

notifierString
    "return the notifier string"

    ^ notifierString
! !

!Signal methodsFor:'save evaluation'!

handle:handleBlock do:aBlock
    "evaluate the argument, aBlock.
     If the receiver-signal is raised during evaluation,
     evaluate the handleBlock passing it an Exception argument.
     The handler may decide how to react to the signal by sending
     a corresponding message to the exception (see there).
     If the signal is not raised, return the value of evaluating
     aBlock."

     ^ aBlock value  "the real logic is in raise/Exception"
!

catch:aBlock
     "evaluate the argument, aBlock.
      If the receiver-signal is raised during evaluation, abort
      the evaluation and return nil."

      ^ self handle:[:ex | ex return] do:aBlock

      "Object messageNotUnderstoodSignal catch:[
          123 foobar
       ]"
! !

!Signal methodsFor:'raising'!

raise
    "raise a signal - create an Exception object
     and call the handler with this as argument.
     This could have been redefined to use raiseRequestWith:, but
     has not to not add too many contexts to the backtrace (which
     would make look things more complicated)"

    |ex|

    ex := Exception new signal:self
                     parameter:nil 
                   errorString:nil
              suspendedContext:thisContext sender.

    ex resumeBlock:[:value | ^ value].
    self evaluateHandlerWith:ex.

    "mmhh - no handler found (will eventually raise a noHandlerSignal)"
"
    (Exception emergencyHandler) value:ex value:thisContext.
"

" "
    self enterDebuggerWith:('unhandled exception: ' , notifierString).
" "
    ^ nil
!

raiseRequestWith:aParameter
    "raise a signal - create an Exception object with aParameter
     and call the handler with this as argument.
     This could have been redefined to use raiseRequestWith:errorString:, but
     has not to not add too many contexts to the backtrace (which
     would make look things more complicated)"

    |ex|

    ex := Exception new signal:self
                     parameter:aParameter 
                   errorString:nil
              suspendedContext:thisContext sender.

    ex resumeBlock:[:value | ^ value].
    self evaluateHandlerWith:ex.

    "mmhh - no handler found (will eventually raise a noHandlerSignal)"
"
    (Exception emergencyHandler) value:ex value:thisContext.
"
" "
    self enterDebuggerWith:('unhandled exception: ' , notifierString).
" "
    ^ nil
!

raiseRequestWith:aParameter errorString:aString
    "raise a signal - create an Exception object with aParameter
     and call the handler with this as argument."

    |ex|

    ex := Exception new signal:self
                     parameter:aParameter 
                   errorString:aString
              suspendedContext:thisContext sender.

    ex resumeBlock:[:value | ^ value].
    self evaluateHandlerWith:ex.

    "mmhh - no handler found (will eventually raise a noHandlerSignal)"
"
    (Exception emergencyHandler) value:ex value:thisContext.
"
" "
    self enterDebuggerWith:('unhandled exception: ' , aString).
" "
    ^ nil
! !

!Signal methodsFor:'private'!

evaluateHandlerWith:anException
    "search through the context-calling chain for a
     handle:do: frame to the receiver or a SignalSet which includes
     the receiver."

    |con|

    con := thisContext.
    con := con sender.
    con isRecursive ifTrue:[
        ^ self enterDebuggerWith:'recursive signal raise'
    ].

    [con notNil] whileTrue:[
        (con selector == #handle:do:) ifTrue:[
            "
             if this is the Signal>>handle:do: context
             or a SignalSet>>handle:do: context with self in it,
             call the handler
            "
            ((con receiver == self) 
            or:[(con receiver isMemberOf:SignalSet) and:[con receiver includes:self]]) ifTrue:[
                "call the handler"

                anException handlerContext:con.
                self doCallHandler:(con args at:1) with:anException.

                "if the handler rejects or falls through we arrive here"
                "continue search for another handler"
            ].
        ].
        con := con sender
    ]
!

doCallHandler:aHandler with:ex
    "call the handler proper - needed an extra method
     to have a separate returncontext for the rejectBlock"

    ex rejectBlock:[^ self]. "this will return on reject"
    aHandler value:ex.
    "handler return - is just like a reject"
! !