"
 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
				handlerBlock parent'
	 classVariableNames:'NoHandlerSignal RecursiveRaiseSignal'
	 poolDictionaries:''
	 category:'Kernel-Exceptions'
!

Signal comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.14 1994-10-10 00:28:19 claus Exp $
'!

!Signal class methodsFor:'documentation'!

copyright
"
 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.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.14 1994-10-10 00:28:19 claus Exp $
"
!

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 can 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 with one handler (for example all arithmetic signals).
    And, finally there is a very special SignalSet which allows catching
    any signal (SignalSet>>anySignal).

    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).

    special:

    In addition to the nested catch & throw mechanism, signals can also be
    used when no such handler scope exists. To support this, signals can be 
    assigned a handlerBlock, which gets evaluated with the exception as argument 
    in case no handler was found (on the stack).

    If no handler was found, a NoHandler-Signal will be raised instead,
    passing it the original exception in its exception-parameter.
    This NoHandler-signal can be handled just like any other signal.
    (therefore, it is possible to catch any error by catching the NoHandler
     signal).

    When the NoHandler signal is raised, and neither a handler-context, nor 
    a handler block is defined for it, an emergencyHandler(-block) is evaluated.
    This block is either provided by the current process 
    (see Process>>emergencySignalHandler) or as a global default by the Exception
    class (see Exception>>emergencyHandler).
    The default emergencyHandlerBlock (from Exception) will bring up a debugger.

    HandlerBlocks allow a global (if its the EmergencyHandler in Exception)
    or per-process signal handling to be added. Even to code which was never
    planned to handle signals.

    See samples in doc/coding.

    Instance variables:

	mayProceed      <Boolean>       hint for the debugger - program may 
					proceed (currently not honored by the
					debugger)

	notifierString  <String>        eror message to be output 

	nameClass       <???>           I dont know what this is for 
					(included for ST-80 compatibility)

	message         <???>           I dont know what this is for
					(included for ST-80 compatibility)

	handlerBlock    <Block>         if nonNil, a 1-arg block to be 
					evaluated when no handler context is 
					found. The block gets the exception
					object as argument.

    Notice:
    Part 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 ...
"
! !

!Signal class methodsFor:'initialization'!

initialize 
    "setup the signal used to handle unhandled signals"

    NoHandlerSignal isNil ifTrue:[
	Object initialize.

	NoHandlerSignal := Object errorSignal newSignalMayProceed:true.
	NoHandlerSignal nameClass:self message:#noHandlerSignal.
	NoHandlerSignal notifierString:'unhandled exception'.

	RecursiveRaiseSignal := Object errorSignal newSignalMayProceed:false.
	RecursiveRaiseSignal nameClass:self message:#recursiveRaiseSignal.
	RecursiveRaiseSignal notifierString:'recursive signal raise'
    ]
! !

!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
!

recursiveRaiseSignal
    "return the signal used to handle recursive signal raises"

    ^ RecursiveRaiseSignal
! !

!Signal methodsFor:'instance creation'!

newSignalMayProceed:aBoolean
    "create a new signal, using the receiver as a prototype and
     setting the parent of the new signal to the receiver."

    |newSignal|

    newSignal := (self copy) mayProceed:aBoolean.
    newSignal parent:self.
    ^ newSignal
!

newSignal
    "create a new signal, using the receiver as a prototype and
     setting the parent of the new signal to the receiver."

    ^ (self copy) parent:self
! !

!Signal methodsFor:'copying'!

deepCopy
    "raise an error - deepCopy is not allowed for signals"

    ^ self deepCopyError
! !

!Signal methodsFor:'accessing'!

nameClass:aClass message:aSelector
    "this sets the class & selector of a method which returns
     that signal - this is simply for documentation purposes -
     see Signal>>printOn: implementation.
     (took me a while to find that one out ;-)"

    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
!

parent:aSignal 
    "set the parent-signal of the receiver."

    parent := aSignal
!

parent
    "return the parent-signal of the receiver"

    ^ parent
!

notifierString:aString
    "set the notifier string"

    notifierString := aString
!

notifierString
    "return the notifier string"

    ^ notifierString
!

handlerBlock:aOneArgBlock
    "set the handlerblock - this will be evaluated with the exception 
     object as argument, if no #handle:do: context was found on the stack."

    handlerBlock := aOneArgBlock
! !

!Signal methodsFor:'printing'!

printOn:aStream
    "append a printed representation of the receiver on aStream"

    nameClass notNil ifTrue:[
	aStream nextPutAll:nameClass name.
	aStream space.
	aStream nextPutAll:message.
	^ self
    ].
    ^ super printOn:aStream
! !

!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"

      "
       Object messageNotUnderstoodSignal handle:[:ex |
	  'oops' printNL.
	  ex return
       ] do:[
	  123 size open   
       ]
      "

      "
       |num|

       num := 0.
       Number divisionByZeroSignal handle:[:ex |
	  'oops' printNL.
	  ex return
       ] do:[
	  123 / num   
       ]
      "
!

catch:aBlock
     "evaluate the argument, aBlock.
      If the receiver-signal is raised during evaluation, abort
      the evaluation and return true; otherwise return false. 
      This is the catch & throw mechanism found in other languages,
      where the returned value indicates if an exception occured."

      |raiseOccurred|

      raiseOccurred := false.
      self handle:[:ex | raiseOccurred := true. ex return] do:aBlock.
      ^ raiseOccurred

      "
       Object messageNotUnderstoodSignal catch:[
	  123 size open   
       ]
      "
!

ignore:aBlock
     "evaluate the argument, aBlock.
      Ignore the receiver-signal during evaluation - i.e. simply
      continue. This makes only sense for some signals, such as UserInterrupt
      or AbortSignals, because continuing after an exception without any cleanup
      will often lead to followup-errors."

      ^ self handle:[:ex | ex proceed] do:aBlock.

      "
       Object messageNotUnderstoodSignal ignore:[
	  123 size open   
       ]
      "
! !

!Signal methodsFor:'queries'!

accepts:aSignal
    "return true, if the receiver accepts the argument, aSignal.
     (i.e. the recevier is aSignal or a parent of it). False otherwise."

    |s|

    s := aSignal.
    [s notNil] whileTrue:[
	self == s ifTrue:[^ true].
	s := s parent
    ].
    ^ false
!

isHandled
    "return true, if there is a handler for the receiver signal.
     Raising an unhandled signal will usually lead into the debugger,
     but can be cought globally by setting Exceptions EmergencyHandler."

    |con|

    con := thisContext.
    con := con sender.
    [con notNil] whileTrue:[
	(con selector == #handle:do:) ifTrue:[
	    "
	     is this is the Signal>>handle:do: context
	     or a SignalSet>>handle:do: context with self in it ?
	    "
	    (con receiver accepts:self) ifTrue:[
		"found a handler context"

		^ true
	    ].
	].
	con := con sender
    ].
    ^ false
! !

!Signal methodsFor:'raising'!

raise
    "raise a signal - create an Exception object
     and call the handler with this as argument.
     The signals notifierString is used as errorString."

    "This could have been defined using 'raiseRequestWith:', 
     but is not - to not add too many contexts to the backtrace 
     (thus making things cleaner in the debugger-walkback eventually)"

    |ex block|

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

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

    (block := handlerBlock) isNil ifTrue:[
	"
	 if I am not the NoHandlerSignal, raise it ...
	 passing the exception as parameter.
	"
	self == NoHandlerSignal ifFalse:[
	    ^ NoHandlerSignal 
		  raiseRequestWith:ex
		       errorString:('unhandled exception: ' , ex errorString)
	].

	"
	 otherwise,
	 take either a per-process emergencyHandlerBlock 
	 or the global emergencyHandler (from Exception) ...
	"
	Processor notNil ifTrue:[ 
	    "care for signal during startup (Processor not yet created)"
	    block := Processor activeProcess emergencySignalHandler.
	].
	block isNil ifTrue:[
	    block := Exception emergencyHandler
	].
	block isNil ifTrue:[
	    "care for error during startup (Exception not yet initialized)"
	    ^ MiniDebugger enterWithMessage:ex errorString
	]
    ].

    "... and call it"
    ^ block value:ex.
!

raiseRequestWith:aParameter
    "raise a signal - create an Exception object with aParameter
     and call the handler with this as argument..
     The signals notifierString is used as errorString."

    "This could have been defined using 'raiseRequestWith:', 
     but is not - to not add too many contexts to the backtrace 
     (thus making things cleaner in the debugger-walkback eventually)"

    |ex block|

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

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

    (block := handlerBlock) isNil ifTrue:[
	"
	 if I am not the NoHandlerSignal, raise it ...
	 passing the exception as parameter.
	"
	self == NoHandlerSignal ifFalse:[
	    ^ NoHandlerSignal 
		  raiseRequestWith:ex
		       errorString:('unhandled exception: ' , ex errorString)
	].

	"
	 otherwise,
	 take either a per-process emergencyHandlerBlock 
	 or the global emergencyHandler (from Exception) ...
	"
	Processor notNil ifTrue:[ 
	    "care for signal during startup (Processor not yet created)"
	    block := Processor activeProcess emergencySignalHandler.
	].
	block isNil ifTrue:[
	    block := Exception emergencyHandler
	].
	block isNil ifTrue:[
	    "care for error during startup (Exception not yet initialized)"
	    ^ MiniDebugger enterWithMessage:ex errorString
	]
    ].

    "... and call it"
    ^ block value:ex.
!

raiseFrom:something
    "raise a signal - create an Exception object with aParameter
     and call the handler with this as argument..
     The printString of the argument, something is used as errorString.
     XXX: I am not certain, if this is the correct behavior (seen in remoteInvocation-goodie)"

    |ex block|

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

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

    (block := handlerBlock) isNil ifTrue:[
	"
	 if I am not the NoHandlerSignal, raise it ...
	 passing the exception as parameter.
	"
	self == NoHandlerSignal ifFalse:[
	    ^ NoHandlerSignal 
		  raiseRequestWith:ex
		       errorString:('unhandled exception: ' , ex errorString)
	].

	"
	 otherwise,
	 take either a per-process emergencyHandlerBlock 
	 or the global emergencyHandler (from Exception) ...
	"
	Processor notNil ifTrue:[ 
	    "care for signal during startup (Processor not yet created)"
	    block := Processor activeProcess emergencySignalHandler.
	].
	block isNil ifTrue:[
	    block := Exception emergencyHandler
	].
	block isNil ifTrue:[
	    "care for error during startup (Exception not yet initialized)"
	    ^ MiniDebugger enterWithMessage:ex errorString
	]
    ].

    "... and call it"
    ^ block value:ex.
!

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

    |ex block|

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

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

    (block := handlerBlock) isNil ifTrue:[
	"
	 if I am not the NoHandlerSignal, raise it ...
	 passing the exception as parameter.
	"
	self == NoHandlerSignal ifFalse:[
	    ^ NoHandlerSignal 
		  raiseRequestWith:ex
		       errorString:('unhandled exception: ' , ex errorString)
	].

	"
	 otherwise,
	 take either a per-process emergencyHandlerBlock 
	 or the global emergencyHandler (from Exception) ...
	"
	Processor notNil ifTrue:[ 
	    "care for signal during startup (Processor not yet created)"
	    block := Processor activeProcess emergencySignalHandler.
	].
	block isNil ifTrue:[
	    block := Exception emergencyHandler
	].
	block isNil ifTrue:[
	    "care for error during startup (Exception not yet initialized)"
	    ^ MiniDebugger enterWithMessage:ex errorString
	]
    ].

    "... and call it"
    ^ block value:ex.
! !

!Signal methodsFor:'private'!

evaluateHandlerWith:ex
    "search through the context-calling chain for a 'handle:do:'-context 
     to the receiver or a parent of the receiver or a SignalSet which includes 
     the receiver.
     If found, take its 2nd argument (the handler) and evaluate
     it with the exception as argument.
     If none found, just return."

    |con|

    con := thisContext.
    con := con sender.
    con isRecursive ifTrue:[
	"
	 mhmh - an error while in a handler
	"
	((self == RecursiveRaiseSignal)
	or:[RecursiveRaiseSignal isNil]) ifTrue:[
	    "
	     ... either while handling RecursiveSignal
	     or at startup when RecursiveSignal is not yet
	     created -
	     - go immediately into the debugger.
	    "
	    ^ self enterDebuggerWith:ex
			     message:'recursive signal raise'
	].
	^ RecursiveRaiseSignal 
	    raiseRequestWith:ex
		 errorString:('recursive signal raise: ' , ex errorString)
    ].

    [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 accepts:self) ifTrue:[
		"call the handler"

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

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

    "
     we arrive here, if either no handler was found, or none of the
     handlers did a return (i.e. every handler rejected or fell through).
    "
!

doCallHandler:aHandler with:ex
    "call the handler proper - needed an extra method
     to have a separate returnContext for the rejectBlock.
     (which is historical, and actually no longer needed)"

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