-- Signaller.Mesa  Edited by Sandman on May 22, 1980 11:11 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [BYTE],
  ControlDefs USING [
    ControlLink, Frame, FrameHandle, GlobalFrameHandle, InstWord, localbase,
    NullFrame, StateVector, WordPC],
  FrameDefs USING [SwapInCode],
  FrameOps USING [
    Alloc, Free, GetReturnLink, MyGlobalFrame, MyLocalFrame, ReleaseCode],
  ImageDefs USING [PuntMesa],
  Mopcodes USING [zCATCH, zJ2, zJ9, zJB, zJW, zKFCB, zNOOP, zPORTI, zRBL, zSLB],
  NucleusOps USING [],
  SDOps USING [],
  SDDefs USING [SD, sUncaughtSignal],
  TrapDefs USING [];

Signaller: PROGRAM
  IMPORTS FrameDefs, FrameOps, ImageDefs EXPORTS NucleusOps, SDOps, TrapDefs
  =PUBLIC

  BEGIN OPEN ControlDefs;

  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 = FrameOps.MyLocalFrame[];
    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 = FrameOps.MyGlobalFrame[] 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]];
	      FrameOps.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 _ FrameOps.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 _ FrameOps.GetReturnLink[];
		catchState.source _ 0;
		RETURN WITH catchState;
		END;
	    exit =>
	      BEGIN -- catchFrame is waiting to execute its exit jump
	      exitPC _ catchFrame.pc;
	      FrameOps.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]];
	  FrameOps.Free[frame];
	  END;
	REPEAT StartUnwind => NULL; FINISHED => EXIT
	ENDLOOP;
      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;

  ReadWord0: PROCEDURE [LONG POINTER] RETURNS [InstWord] = MACHINE CODE
    BEGIN Mopcodes.zRBL, 0 END;

  ReadWord1: PROCEDURE [LONG POINTER] RETURNS [InstWord] = MACHINE CODE
    BEGIN Mopcodes.zRBL, 1 END;

  ReadWord2: PROCEDURE [LONG POINTER] RETURNS [InstWord] = MACHINE CODE
    BEGIN Mopcodes.zRBL, 2 END;

  CheckCatch: PROCEDURE [frame: FrameHandle]
    RETURNS [catchPhrase: BOOLEAN, fsIndex: BYTE, pc: WordPC] =
    BEGIN OPEN Mopcodes;
    ThreeWords: TYPE = ARRAY [0..3) OF InstWord; -- worst case XFER NOOP CATCH 0
    codeWords: ThreeWords; -- worst case is XFER NOOP CATCH 0
    code: POINTER TO ThreeWords _ @codeWords;
    c: [0..3);
    inst: [0..377B];
    g: GlobalFrameHandle _ frame.accesslink;
    parity: {even, odd};
    MarkSignalFrame[notSignalling];
    FrameDefs.SwapInCode[g];
    pc _ [ABS[frame.pc]];
    IF g.code.highByte = 0 THEN
      BEGIN
      lp: LONG POINTER TO InstWord _ pc + g.code.longbase;
      code[0] _ ReadWord0[lp];
      code[1] _ ReadWord1[lp];
      code[2] _ ReadWord2[lp];
      END
    ELSE code^ _ LOOPHOLE[pc + g.code.shortbase, POINTER TO ThreeWords]^;
    c _ 0;
    parity _ IF frame.pc < 0 THEN odd ELSE even;
    DO
      inst _ IF parity = even THEN code[c].evenbyte ELSE code[c].oddbyte;
      SELECT inst FROM
	zCATCH => BEGIN catchPhrase _ parity = even; EXIT END;
	zPORTI, zNOOP =>
	  IF parity = even THEN parity _ odd
	  ELSE BEGIN c _ c + 1; parity _ even; END;
	ENDCASE => BEGIN catchPhrase _ FALSE; EXIT END;
      ENDLOOP;
    IF catchPhrase THEN
      BEGIN -- [c, parity] points at zCatch (note: parity must be even)
      pc _ WordPC[pc + c + 1];
      fsIndex _ code[c].oddbyte;
      SELECT code[c + 1].evenbyte FROM
	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;
    FrameOps.ReleaseCode[g];
    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 => FrameOps.Free[message]];
    FrameOps.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 => FrameOps.Free[message]];
    FrameOps.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;


  END.