-- Signaller.Mesa  Edited by Geschke on August 29, 1978  11:15 AM

-- Modified for PilotMesa

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE],
  CodeDefs: FROM "codedefs" USING [Codebase, ReleaseCode],
  ControlDefs: FROM "controldefs" USING [
    Alloc, ControlLink, Frame, FrameHandle, Free, GetReturnFrame,
    GetReturnLink, Greg, InstWord, localbase, Lreg, NullFrame, SetReturnLink,
    StateVector, WordPC],
  FrameDefs: FROM "framedefs",
  ImageDefs: FROM "imagedefs" USING [PuntMesa],
  Mopcodes: FROM "mopcodes" USING [
    zCATCH, zJ2, zJ9, zJB, zJW, zKFCB, zNOOP, zPORTI, zSLB],
  NucleusDefs: FROM "nucleusdefs",
  SDDefs: FROM "sddefs" USING [
    SD, sError, sErrorList, sReturnError, sReturnErrorList, sSignal,
    sSignalList, sUncaughtSignal, sUnnamedError],
  TrapDefs: FROM "trapdefs",
  XMesaDefs: FROM "XMesaDefs" USING [LowHalfPtr, XCOPY];

DEFINITIONS FROM ControlDefs;

Signaller: PROGRAM
  IMPORTS CodeDefs
  EXPORTS NucleusDefs, TrapDefs =
  BEGIN

  BYTE: TYPE = AltoDefs.BYTE;

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

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

  SendMsgSignal: PUBLIC SIGNAL RETURNS [UNSPECIFIED, UNSPECIFIED] = CODE;

  signalling: CARDINAL = 177777B;
  notSignalling: CARDINAL = 0;

  MarkSignalFrame: PROCEDURE [value: CARDINAL] =
    MACHINE CODE BEGIN Mopcodes.zSLB, 3 --OFFSET[mark]-- END;


  SignalHandler: PROCEDURE [signal: SIGNAL, message: UNSPECIFIED] =
    BEGIN

    SignalFrame: TYPE = POINTER TO FRAME[SignalHandler];

    frame, nextFrame: FrameHandle;
    target, nextTarget: FrameHandle;
    self: FrameHandle = REGISTER[Lreg];
    start: FrameHandle;
    catchFrame: CatchPointer;
    action: ActionCode;
    unwinding: BOOLEAN;
    catchPhrase: BOOLEAN;
    catchFSIndex: BYTE;
    catchPC, exitPC: WordPC;
    catchState: ControlDefs.StateVector;

    MarkSignalFrame[signalling];  unwinding _ FALSE;
    start _ GetFrame[self.returnlink];  target _ NullFrame;  
      DO
      nextFrame _ start;
      UNTIL nextFrame = target DO
	frame _ nextFrame;
	IF frame.accesslink = REGISTER[Greg] AND frame.mark THEN
	  BEGIN
	  OPEN thisSignaller: LOOPHOLE[frame, SignalFrame];
	  IF unwinding THEN
	    BEGIN
	    IF signal = thisSignaller.signal THEN
	      nextTarget _ IF thisSignaller.unwinding
	        THEN thisSignaller.nextTarget
	        ELSE thisSignaller.nextFrame;
	    IF thisSignaller.unwinding THEN
	      BEGIN
	      IF thisSignaller.frame = LOOPHOLE[frame.returnlink] THEN
	        frame.returnlink _ [frame[thisSignaller.nextFrame]];
	      ControlDefs.Free[thisSignaller.frame];
	      END;
	    nextFrame _ GetFrame[frame.returnlink];
	    END
	  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;
	  END
	ELSE nextFrame _ GetFrame[frame.returnlink];
	IF unwinding AND nextTarget = frame THEN  nextTarget _ nextFrame;
	[catchPhrase, catchFSIndex, catchPC] _ CheckCatch[frame];
	IF catchPhrase
	  THEN
	    BEGIN
	    catchFrame _ ControlDefs.Alloc[catchFSIndex];
	    catchFrame^ _ Frame[
		accesslink: frame.accesslink,
		pc: catchPC,
		returnlink: [frame[self]],
		extensions: catch[unused: ,
		  staticlink: frame+localbase, messageval: message]];
	    action _ LOOPHOLE[catchFrame, CatchCall]
	     [IF unwinding THEN LOOPHOLE[UNWIND] ELSE signal
	      ! SendMsgSignal => RESUME[message, signal]];
	    catchState _ STATE;
	    SELECT action FROM
	      reject =>  NULL;
	      resume =>
		IF unwinding
		  THEN ERROR ResumeError
		  ELSE
		    BEGIN
		    catchState.dest _ ControlDefs.GetReturnLink[];
		    catchState.source _ 0;
		    RETURN WITH catchState;
		    END;
	      exit =>
		BEGIN
		-- catchFrame is waiting to execute its exit jump
		exitPC _ catchFrame.pc;
		ControlDefs.Free[catchFrame];
		target _ LOOPHOLE[catchState.stk[0]-ControlDefs.localbase];
		nextTarget _ nextFrame;
		unwinding _ TRUE;  message _ NIL;
		GO TO StartUnwind;
		END;
	      ENDCASE;
	    END;
	IF unwinding
	  THEN
	    BEGIN
	    IF frame = start THEN start _ nextFrame;
	    IF frame = LOOPHOLE[self.returnlink]
	      THEN self.returnlink _ [frame[nextFrame]];
	    ControlDefs.Free[frame];
	    END;
	REPEAT
	  StartUnwind =>  NULL;
	  FINISHED =>  EXIT
	ENDLOOP;
      REPEAT
        ucs => NULL;
      ENDLOOP;
    IF unwinding THEN target.pc _ exitPC
    ELSE
      BEGIN
      IF SDDefs.SD[SDDefs.sUncaughtSignal] = 0 THEN ImageDefs.PuntMesa[];
      UncaughtSignal[message, signal, frame];
      END;
    RETURN
    END;

  CheckCatch: PROCEDURE [frame: FrameHandle]
    RETURNS [catchPhrase: BOOLEAN, fsIndex: BYTE, pc: WordPC] =
    BEGIN  OPEN Mopcodes;
    codebase: LONG POINTER;
    ix: [0..3) _ 0;    							--XM
    instwd: ARRAY [0..3) OF InstWord; -- worst case is XFER NOOP CATCH 0 --	--XM
    iw: LONG POINTER;  -- TO InstWord --					--XM
    nwords: CARDINAL;						--XM
    parity: {even, odd};
    MarkSignalFrame[notSignalling];
    codebase _ CodeDefs.Codebase[frame.accesslink];
    iw _ ABS[frame.pc] + codebase;
    nwords _ MIN[177777B-LOOPHOLE[XMesaDefs.LowHalfPtr[iw], CARDINAL], 2]+1; 			--XM
    XMesaDefs.XCOPY[from: iw, to: LONG[@instwd[0]], nwords: nwords];		--XM
    parity _ IF frame.pc < 0 THEN odd ELSE even;
    DO
      SELECT (IF parity=even THEN instwd[ix].evenbyte ELSE instwd[ix].oddbyte) FROM
        zCATCH => BEGIN catchPhrase _ parity = even; EXIT END;
        zPORTI,zNOOP =>
          IF parity=even THEN  parity _ odd
          ELSE  BEGIN  ix _ ix + 1;  parity _ even;  END;			--XM
        ENDCASE => BEGIN catchPhrase _ FALSE; EXIT END;
      ENDLOOP;
    IF catchPhrase
      THEN
	BEGIN  -- [ix, parity] indexes zCatch (note: parity must be even) --	--XM
	pc _ WordPC[ABS[frame.pc]+ix+1];				--XM
	fsIndex _ instwd[ix].oddbyte;					--XM
	SELECT instwd[ix+1].evenbyte FROM				--XM
	  zJB =>
	    BEGIN pc _ [pc + 1]; GO TO evenPC END;
	  IN [zJ2..zJ9] =>
	    GO TO oddPC;
	  zJW => -- always padded !
	    BEGIN pc _ [pc + 2];  GO TO evenPC  END;
	  ENDCASE;
	EXITS
	  evenPC => NULL;
	  oddPC => pc _ [-pc];
	END;
    CodeDefs.ReleaseCode[frame.accesslink];
    RETURN
    END;

  GetFrame: PROCEDURE [link: ControlLink] RETURNS [FrameHandle] =  
    BEGIN
    -- MarkSignalFrame[notSignalling];
    DO
      WITH cl: link SELECT link.tag FROM
        frame =>  RETURN [cl.frame];
        indirect =>  link _ cl.link^;
        ENDCASE => RETURN[NullFrame];
      ENDLOOP;
    END;


  Signal: PROCEDURE [signal: SIGNAL, message: UNSPECIFIED] = SignalHandler;

  SignalList: PROCEDURE [signal: SIGNAL, message: POINTER TO UNSPECIFIED] =
    BEGIN
    MarkSignalFrame[notSignalling];
    SignalHandler[signal, message !
      UNWIND => ControlDefs.Free[message]];
    ControlDefs.Free[message];
    RETURN
    END;


  ResumeError: PUBLIC SIGNAL = CODE;

  Error: PROCEDURE [signal: SIGNAL, message: UNSPECIFIED] =
    BEGIN
    MarkSignalFrame[notSignalling];
    SignalHandler[signal, message];
    ERROR ResumeError
    END;

  ErrorList: PROCEDURE [signal: SIGNAL, message: POINTER TO UNSPECIFIED] =
    BEGIN
    MarkSignalFrame[notSignalling];
    SignalHandler[signal, message !
      UNWIND => ControlDefs.Free[message]];
    ControlDefs.Free[message];  
    ERROR ResumeError
    END;

  ReturnError: PROCEDURE [signal: SIGNAL, message: UNSPECIFIED] =
    BEGIN
    caller: FrameHandle = ControlDefs.GetReturnFrame[];
    ControlDefs.SetReturnLink[caller.returnlink];
    MarkSignalFrame[notSignalling];
    SignalHandler[signal, message !
      UNWIND => ControlDefs.Free[caller]];
    ControlDefs.Free[caller];  
    ERROR ResumeError
    END;

  ReturnErrorList: PROCEDURE [signal: SIGNAL, message: POINTER TO UNSPECIFIED] =
    BEGIN
    caller: FrameHandle = ControlDefs.GetReturnFrame[];
    ControlDefs.SetReturnLink[caller.returnlink];
    MarkSignalFrame[notSignalling];
    SignalHandler[signal, message !
      UNWIND =>
        BEGIN
        ControlDefs.Free[caller];
        ControlDefs.Free[message];
        END];
    ControlDefs.Free[caller];  
    ControlDefs.Free[message];  
    ERROR ResumeError
    END;

  UnnamedError: PROCEDURE =
    BEGIN
    MarkSignalFrame[notSignalling];
    SignalHandler[LOOPHOLE[-1], -1];
    ERROR ResumeError
    END;

  UncaughtSignal: PROCEDURE [msg, signal: UNSPECIFIED, frame: FrameHandle] =
    MACHINE CODE BEGIN Mopcodes.zKFCB, SDDefs.sUncaughtSignal END;


  Init: PROCEDURE =
    BEGIN OPEN SDDefs;
    sd: POINTER TO ARRAY [0..0) OF UNSPECIFIED _ SD;
    sd[sSignalList] _ SignalList;
    sd[sSignal] _ Signal;
    sd[sErrorList] _ ErrorList;
    sd[sError] _ Error;
    sd[sReturnErrorList] _ ReturnErrorList;
    sd[sReturnError] _ ReturnError;
    sd[sUnnamedError] _ UnnamedError;
    END;

  Init[];

  END.
(1820)