
<<DragomanSignals.mesa>>
<<Last Edited by: Sweet, February 8, 1985 4:12:02 pm PST>>
    <<Bertrand Serlet July 27, 1985 9:51:32 pm PDT>>

DIRECTORY
DragomanPrivate USING [RestartInterpreter],
Basics USING [BYTE],
PrincOps USING [
BytePC, ControlLink, --FieldDescriptor, --Frame, FrameHandle, localbase, markOffset, NullFrame, NullLink, SD, sError, sErrorList, 
sReturnError, sReturnErrorList, sSignal, sSignalList, StateVector, sUnnamedError, zCATCH, zJ2, zJ9, zJB, zJW, zLADRB, zPORTI, zWF],
PrincOpsUtils USING [
Alloc, Codebase, Free, GetReturnFrame, GetReturnLink, MyGlobalFrame, MyLocalFrame, SetReturnLink],
RuntimeError USING [RegisterUncaughtSignalHandler, ResumeError, SendMsgSignal, UCSProc, UNCAUGHT];

DragomanSignals: MONITOR
IMPORTS PrincOpsUtils, DragomanPrivate, RuntimeError =

BEGIN

<<>>
<<Types and Related Declarations>>
<<>>
BYTE: TYPE = Basics.BYTE;

CatchPointer: TYPE = POINTER TO catch PrincOps.Frame;
CatchCall: TYPE = PROCEDURE [SIGNAL ANY RETURNS ANY] RETURNS [ActionCode];
CatchContinue: TYPE = PROCEDURE;

ActionCode: TYPE = INTEGER;
reject: ActionCode = 0;
resume: ActionCode = 1;
exit: ActionCode = -1;

<<Global Variables (protected by monitor)>>
<<>>
ucsHandler: RuntimeError.UCSProc;
<<>>
<<>>
<<Language support routines>>
<<>>
Error: PROC [signal: SIGNAL ANY RETURNS ANY, message: UNSPECIFIED] = {
MarkSignalHandlerFrame[FALSE];
SignalHandler[signal, message];
ERROR RuntimeError.ResumeError
};

ErrorList: PROC [signal: SIGNAL ANY RETURNS ANY, message: POINTER TO UNSPECIFIED] = {
MarkSignalHandlerFrame[FALSE];
SignalHandler[signal, message !
UNWIND => PrincOpsUtils.Free[message]];
PrincOpsUtils.Free[message];  
ERROR RuntimeError.ResumeError
};

ReturnError: PROC [signal: SIGNAL ANY RETURNS ANY, message: UNSPECIFIED] = {
caller: PrincOps.FrameHandle = PrincOpsUtils.GetReturnFrame[];
PrincOpsUtils.SetReturnLink[caller.returnlink];
MarkSignalHandlerFrame[FALSE];
SignalHandler[signal, message ! UNWIND => PrincOpsUtils.Free[caller]];
PrincOpsUtils.Free[caller];  
ERROR RuntimeError.ResumeError
};

ReturnErrorList: PROC [
signal: SIGNAL ANY RETURNS ANY, message: POINTER TO UNSPECIFIED] = {
caller: PrincOps.FrameHandle = PrincOpsUtils.GetReturnFrame[];
PrincOpsUtils.SetReturnLink[caller.returnlink];
MarkSignalHandlerFrame[FALSE];
SignalHandler[signal, message
! UNWIND => {PrincOpsUtils.Free[caller]; PrincOpsUtils.Free[message]}
];
PrincOpsUtils.Free[caller];  
PrincOpsUtils.Free[message];  
ERROR RuntimeError.ResumeError
};

UnnamedError: PROC = {
MarkSignalHandlerFrame[FALSE];
SignalHandler[LOOPHOLE[-1], -1];
ERROR RuntimeError.ResumeError
};

Signal: PROC [signal: SIGNAL ANY RETURNS ANY, message: UNSPECIFIED] = {
MarkSignalHandlerFrame[FALSE];
SignalHandler[signal, message];
};

SignalList: PROC [signal: SIGNAL ANY RETURNS ANY, message: POINTER TO UNSPECIFIED] = {
MarkSignalHandlerFrame[FALSE];
SignalHandler[signal, message ! UNWIND => PrincOpsUtils.Free[message]];
PrincOpsUtils.Free[message];
};

<<>>
<<Internal Procedures>>

MarkSignalHandlerFrame: PROC [value: BOOL] = MACHINE CODE {
PrincOps.zLADRB, 0;
PrincOps.zWF,
--PrincOps.FieldDescriptor[offset: PrincOps.markOffset, posn: 0, size: 1]--
PrincOps.markOffset, 0;
};

SignalHandler: PROC [
signal: SIGNAL ANY RETURNS ANY, message: UNSPECIFIED, informational: BOOL _ FALSE] = {

SignalFrame: TYPE = POINTER TO FRAME[SignalHandler];

frame, nextFrame: PrincOps.FrameHandle;
target, nextTarget: PrincOps.FrameHandle;
self: PrincOps.FrameHandle = PrincOpsUtils.MyLocalFrame[];
start: PrincOps.FrameHandle;
catchFrame: CatchPointer;
action: ActionCode;
unwinding: BOOL;
catchPhrase: BOOL;
catchFSIndex: BYTE;
catchPC, exitPC: PrincOps.BytePC;
catchState: PrincOps.StateVector;
interpreterFrame: PrincOps.FrameHandle _ PrincOps.NullFrame; -- *** RES addition

MarkSignalHandlerFrame[TRUE];  unwinding _ FALSE;
start _ GetFrame[self.returnlink];  target _ PrincOps.NullFrame;  
DO
nextFrame _ start;
UNTIL nextFrame = target DO
frame _ nextFrame;
IF frame.accesslink = PrincOpsUtils.MyGlobalFrame[] AND frame.mark THEN {
OPEN thisSignaller: LOOPHOLE[frame, SignalFrame];
IF unwinding THEN {
IF signal = thisSignaller.signal THEN
nextTarget _ IF thisSignaller.unwinding
THEN thisSignaller.nextTarget
ELSE thisSignaller.nextFrame;
IF thisSignaller.unwinding THEN {
IF thisSignaller.frame = LOOPHOLE[frame.returnlink] THEN
frame.returnlink _ [frame[thisSignaller.nextFrame]];
PrincOpsUtils.Free[thisSignaller.frame];
};
nextFrame _ GetFrame[frame.returnlink];
}
ELSE
nextFrame _ IF signal ~= thisSignaller.signal THEN
IF thisSignaller.unwinding
THEN thisSignaller.nextFrame
ELSE GetFrame[frame.returnlink]
ELSE
IF thisSignaller.unwinding
THEN thisSignaller.nextTarget
ELSE thisSignaller.nextFrame;
}
ELSE nextFrame _ GetFrame[frame.returnlink];
IF unwinding AND nextTarget = frame THEN  nextTarget _ nextFrame;
[catchPhrase, catchFSIndex, catchPC] _ CheckCatch[frame];
IF catchPhrase THEN {
catchFrame _ PrincOpsUtils.Alloc[catchFSIndex];
catchFrame^ _ PrincOps.Frame[
accesslink: frame.accesslink,
pc: catchPC,
returnlink: [frame[self]],
extensions: catch[unused: ,
staticlink: frame+PrincOps.localbase, messageval: message]];
action _ LOOPHOLE[catchFrame, CatchCall]
[IF unwinding THEN LOOPHOLE[UNWIND] ELSE signal
! RuntimeError.SendMsgSignal => RESUME[message, signal];
  DragomanPrivate.RestartInterpreter => TRUSTED {interpreterFrame _ iFrame; RESUME[target]}]; -- *** RES
catchState _ STATE;
SELECT action FROM
reject =>  NULL;
resume =>
IF unwinding
THEN ERROR RuntimeError.ResumeError
ELSE {
catchState.dest _ PrincOpsUtils.GetReturnLink[];
catchState.source _ PrincOps.NullLink;
RETURN WITH catchState
};
exit =>
IF ~informational THEN {
<<catchFrame is waiting to execute its exit jump>>
exitPC _ catchFrame.pc;
PrincOpsUtils.Free[catchFrame];
target _ LOOPHOLE[catchState.stk[0]-PrincOps.localbase];
nextTarget _ nextFrame;
unwinding _ TRUE;  message _ NIL;
GO TO StartUnwind;
};
ENDCASE;
};
IF unwinding THEN {
IF frame = start THEN start _ nextFrame;
IF frame = LOOPHOLE[self.returnlink] THEN self.returnlink _ [frame[nextFrame]];
PrincOpsUtils.Free[frame];
};
REPEAT
StartUnwind => NULL;
FINISHED => EXIT
ENDLOOP;
ENDLOOP;
SELECT TRUE FROM
unwinding => target.pc _ exitPC;
informational OR signal = LOOPHOLE[RuntimeError.UNCAUGHT] => NULL;  -- does an implicit RESUME
ENDCASE => {
<<We want to be able to RESUME UNCAUGHT, but we don't want a random catch phrase to do so.  So, we declare it to be an ERROR in the 
interface, but raise it as a SIGNAL here.  When (if) UNCAUGHT percolates to the top of the stack, it is implicitly resumed (see the 
preceding line of code).  Control then passes to the statement following the invocation of UNCAUGHT, which calls the debugger (or 
whatever).>>
Uncaught: TYPE = SIGNAL [SIGNAL ANY RETURNS ANY, UNSPECIFIED];
LOOPHOLE[RuntimeError.UNCAUGHT, Uncaught][signal, message];
ucsHandler[message, signal, frame];
};
IF interpreterFrame # PrincOps.NullFrame THEN         -- *** RES addition
self.returnlink _ [frame[interpreterFrame]];                    -- *** RES addition
};

CheckCatch: PROC [frame: PrincOps.FrameHandle]
RETURNS [catchPhrase: BOOL, fsIndex: BYTE, pc: PrincOps.BytePC] = {
code: LONG POINTER TO PACKED ARRAY [0..0) OF BYTE;
MarkSignalHandlerFrame[FALSE];
code _ LOOPHOLE[PrincOpsUtils.Codebase[frame.accesslink]];
pc _ [frame.pc];
DO
SELECT code[pc] FROM
PrincOps.zCATCH => {catchPhrase _ TRUE; EXIT};
PrincOps.zPORTI => pc _ [pc + 1];
ENDCASE => {catchPhrase _ FALSE; EXIT};
ENDLOOP;
IF catchPhrase THEN {
<<code[pc] points at zCatch>>
fsIndex _ code[pc+1];
SELECT code[pc _ [pc+2]] FROM
PrincOps.zJB => pc _ [pc + 2];
IN [PrincOps.zJ2..PrincOps.zJ9] => pc _ [pc + 1];
PrincOps.zJW => pc _ [pc + 3];
ENDCASE;
};
};

GetFrame: PROC [link: PrincOps.ControlLink] RETURNS [PrincOps.FrameHandle] =  {
<<MarkSignalHandlerFrame[FALSE];>>
DO
IF ~link.proc THEN
IF link.indirect THEN link _ link.link^
ELSE --frame link-- RETURN[link.frame]
ELSE RETURN[PrincOps.NullFrame];
ENDLOOP;
};


<<Initialization>>

Initialize: PROCEDURE = {
pSD: POINTER TO ARRAY [0..0) OF UNSPECIFIED _ LOOPHOLE[PrincOps.SD];
pSD[PrincOps.sSignalList] _ SignalList;
pSD[PrincOps.sSignal] _ Signal;
pSD[PrincOps.sErrorList] _ ErrorList;
pSD[PrincOps.sError] _ Error;
pSD[PrincOps.sReturnErrorList] _ ReturnErrorList;
pSD[PrincOps.sReturnError] _ ReturnError;
pSD[PrincOps.sUnnamedError] _ UnnamedError;
ucsHandler _ RuntimeError.RegisterUncaughtSignalHandler[NIL];
[] _ RuntimeError.RegisterUncaughtSignalHandler[ucsHandler];
};

Initialize[];

END.