/* Handle error exception conditions. */!!

inherit(Object, #ErrorHandler,
#(receiver, /* receiver of the errorHandler */
type,     /* type of error: primError, error or fail */
subType,  /* sub type of error */
bp,       /* base ptr of method in which the errorHandler is installed */
action  /* the errorHandler action */), 2, nil)!!

setClassVars(ErrorHandler, #($ErrorStack,  /* a stack of error handlers */
$ErrorBp      /* boolean to determine a recursive error condition */
$ExceptionType  /* latest exception type*/
$ExceptionSelector  /* latest exception selector */
$Receiver $SubType /* save for later retrieval */))!!

now(class(ErrorHandler))!!

/* 9/26/1994 14:47 */
Def subType(self)
{
  ^$SubType;
}
!!

/* 9/26/1994 14:47 */
Def receiver(self)
{
  ^$Receiver;
}
!!

/* Continue from the point left off and adjust the
  stack accordingly.  The continue primitive would be
  called here and it would return the appropriate
  value.  The abort in ErrorHandler:resolve would
  never execute so the program should be able to
  continue executing. */
Def continue(self, errorBp, return)
{ unNestStack(self, errorBp);
  ^return(System, errorBp, return)
}!!

/* Return the bp value stored in $ErrorBp.  This is
  the bp where the error occured. */
Def errorBp(self)
{ ^$ErrorBp
}!!

/* Entry point for user error. If the resolve does fix
  the problem, it blows away this code, so it never
  returns to this method. */
Def errorEntry(self, rcr, type, subType, args, errorBp)
{ /* beep(); @@@ jtb: don't want to beep! */
  if errorBp(self)
  then print("Recursive Error");
  else setErrorBp(self, errorBp); /* Save the error location */
    resolve(self, rcr, type, subType, args, errorBp);
    if type == #fail cor type == #setIvarFail
    then perform(rcr, errorBp, subType, args, type);
    endif;
    if type == #error cor type == #primError cor type == #getIvarFail
    then perform(rcr, errorBp, subType, type)
    endif;
  endif;
  abort();
}!!

/* return the exception selector. */
Def exceptionSelector(self)
{
  ^$ExceptionSelector;
}
!!

/* return the exception type. */
Def exceptionType(self)
{
  ^$ExceptionType;
}
!!

/* This message reinitializes the errorhandler stack.
  True (self) is returned to inform the system, when
  SystemClass:abort sends this message, that it is OK
  to continue the abort process. */
Def init(self)
{ setErrorBp(self, nil);
  init($ErrorStack);
}!!

/* Remove the last installed error handler. */
Def offError(self)
{
  if size($ErrorStack) > 0
    ^pop($ErrorStack)
  endif;
  ^0;
}!!

/* Install error handler to specific errors.  The type
  parameter can be #error, #primError, #fail or #all
  and the subType parameter will be a Set of
  particular errors or #all for all errors of the
  given type. */
Def onError(self, receiver, type, subType, action)
{ ^push($ErrorStack, init(new(self:Behavior), receiver,
    stackLink(stackTop()), type, subType, action));
}!!

/* Traverses the error stack to see if any of the
  error handlers can handle the error. */
Def resolve(self, rcr, type, subType, args, errorBp | temp)
{ temp := copy($ErrorStack);
  $Receiver := rcr;
  $SubType := subType;
  do(reverse(temp),
  {using(errorHandler)
    if handledError?(errorHandler, type, subType, errorBp)
    then ^abort();
    endif;
  });
}!!

/* Set the $ErrorBp class variable. */
Def setErrorBp(self, errorBp)
{ ^$ErrorBp := errorBp
}!!

/* Adjust the stack for resuming at the given bp and
  set $ErrorBp to nil (Assume we are resuming). */
Def unNestStack(self, bp)
{ loop
  while size($ErrorStack) > 0 cand bp(last($ErrorStack)) < bp
  begin pop($ErrorStack);
  endLoop;
  setErrorBp(self, nil);
}!!

now(ErrorHandler)!!

/* Return the base pointer of the errorhandler. */
Def bp(self)
{ ^bp
}!!

/* If an error occurs which self knows how to handle,
  then execute the error handler. */
Def handledError?(self, passedType, passedError, errorBp)
{
  $ExceptionType := passedType;    /* save passedType, Error for retrieval (jtb) */
  $ExceptionSelector := passedError;
  if (passedType == type cor type == #all)
    cand (subType == #all cor passedError in subType)
  then ^doErrorAction(action, receiver, bp, errorBp);
  endif;
  ^nil
}!!

/* Initial a new ErrorHandler. */
Def init(self, rcvr, sTop, t, subT, act | c, a)
{ if (c := class(act)) == BlockContext
  then a := args(act);
  else
    if (c ~= Symbol) cor not(a := findFunction(class(rcvr), act))
    then alert(System, act, #illegalErrorFunction);
    endif;
    a := args(a) + 1;
  endif;
  if a ~= 3
  then alert(System, act, #numArgsError);
  endif;
  receiver := rcvr;
  bp := sTop;
  type := t;
  subType := subT;
  action := act;
}!!

/* ErrorHandler class initialization */
$ErrorBp := nil;
/*$ErrorStack := new(OrderedCollection, 2); don't lose state while loading! -KenD */
$ExceptionType := nil;
$ExceptionSelector := nil;!!
