-- Final.mesa
-- last modified by Sweet, September 8, 1980  10:08 AM
-- edited by Satterthwaite, May 25, 1982 12:17 pm 

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [CodePassInconsistency, codeptr, reentryLabel, tailJumpOK],
  CodeDefs: TYPE USING [
    Base, Byte, CCIndex, CCInfoType, CCNull, codeType, JumpCCIndex, JumpCCNull,
    JumpType, LabelCCIndex, LabelCCNull, RelativePC],
  ComData: TYPE USING [switches],
  FOpCodes: TYPE USING [qLFC, qPOP, qRET],
  Mopcodes: TYPE USING [
    zCATCH, zJB, zJEQ4, zJEQB, zJGB, zJGEB, zJLB, zJLEB, zJNE4, zJNEB,
    zJUGB, zJUGEB, zJULB, zJULEB, zJW, zJZEQB, zJZNEB],
  OpCodeParams: TYPE USING [zJEQn, zJn, zJNEn],
  OpTableDefs: TYPE USING [InstAligned, InstLength],
  P5: TYPE USING [C0, C1, C1W, PeepHole],
  P5F: TYPE USING [BindJump, CodeJump, CPass5, FillInPCEstimates],
  P5U: TYPE USING [DeleteCell, OutJump],
  PeepholeDefs: TYPE USING [
    NextInteresting, PrevInteresting, RemoveThisPop, SetRealInst];

Final: PROGRAM
    IMPORTS CPtr: Code, MPtr: ComData, OpTableDefs, P5U, P5, P5F, PeepholeDefs 
    EXPORTS CodeDefs, P5, P5F =
  BEGIN
  OPEN PeepholeDefs, CodeDefs;

  cb: CodeDefs.Base;		-- code base (local copy)

  CJump: ARRAY JumpType[JumpE..ZJumpN] OF JumpType = [
	JumpN, JumpE, JumpGE, JumpL, JumpLE, JumpG,
	UJumpGE, UJumpL, UJumpLE, UJumpG, ZJumpN, ZJumpE];

  FinalNotify: PUBLIC Alloc.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    cb ← base[codeType];
    END;

  DidSomething: PUBLIC BOOLEAN;
  StartIndex: PUBLIC LabelCCIndex;
  EndIndex: PUBLIC CCIndex;
  SeenSwitch: BOOLEAN;
  JumpCellCount: CARDINAL;


  ccInfo: PUBLIC CCInfoType ← generating;

  CCInfoMeaning: PUBLIC PROC RETURNS [CCInfoType] =
    BEGIN
    RETURN [ccInfo]
    END;

  Fixup: PUBLIC PROC [start: LabelCCIndex, ownEntry: CARDINAL] =
    BEGIN -- a final pass over the code to fix up jumps
    jumpsBefore, jumpsAfter, totalJumps: CARDINAL;
    crossJump: BOOLEAN = MPtr.switches['j];
    ccInfo ← generating;
    DidSomething ← TRUE;
    SeenSwitch ← TRUE;
    StartIndex ← start;
    PeepholeDefs.SetRealInst[FALSE];
    IF crossJump AND CPtr.tailJumpOK THEN TailJump[ownEntry];
    CPtr.reentryLabel ← LabelCCNull;	-- avoid dangling ref if deleted
    DO
      -- pass 0: distinguish forward and backward jumps
      CPass0[];
      IF ~DidSomething THEN EXIT;
      DidSomething ← FALSE;
      SeenSwitch ← ~SeenSwitch;
      -- pass 1: eliminate multiple labels
      CPass1[];
      -- pass 2: eliminate jump to jumps
      CPass2[];
      -- pass 3: eliminate unreachable code
      CPass3[];
      -- pass 4: replace cj-j seq. with ccj
      CPass4[];
      -- pass 5: cross jumping
      IF crossJump THEN P5F.CPass5[];
      ENDLOOP; -- end of the meta-pass consisting of passes 0-5
    -- pass 6: do some peephole optimization: load-store, EXCH-commutative op.
    P5.PeepHole[StartIndex];
    -- jump threads are now pc's, debug output take note
    ccInfo ← binding;
    -- pass 7: set length and alignment, count jumps
    totalJumps ← jumpsAfter ← CPass7[];
    jumpsBefore ← jumpsAfter+1;
    -- pass 8: resolve (most) jump instructions
    THROUGH [1..3] WHILE jumpsAfter # 0 AND jumpsAfter < jumpsBefore DO
      jumpsBefore ← jumpsAfter;
      jumpsAfter ← CPass8[];
      ENDLOOP;
    -- pass 9: resolve (remaining) jump instructions
    IF jumpsAfter # 0 THEN CPass9[];
    -- pass 10: set pad fields
    CPass10[];
    -- pass 11: code jumps
    ccInfo ← coding;
    IF totalJumps # 0 THEN CPass11[];
    END;


  TailJump: PROC [ownEntry: CARDINAL] =
    BEGIN  -- remove simple tail recursion
    next: CCIndex;
    FOR c: CCIndex ← cb[StartIndex].flink, next WHILE c # CCNull DO
      next ← cb[c].flink;
      WITH cb[c] SELECT FROM
	code =>
	  IF ~realinst AND inst = FOpCodes.qLFC
	   AND parameters[1] = ownEntry
	   AND UCreturn[next] THEN
	    BEGIN
	    CPtr.codeptr ← cb[c].blink;
	    P5U.OutJump[Jump, CPtr.reentryLabel];
	    P5U.DeleteCell[c]
	    END
	ENDCASE;
      ENDLOOP;
    END;

  UCreturn: PROC [start: CCIndex] RETURNS [BOOLEAN] =
    BEGIN  -- find (unconditional) path to RET
    next: CCIndex;
    FOR c: CCIndex ← start, next WHILE c # CCNull DO
      WITH cc: cb[c] SELECT FROM
	code => RETURN [~cc.realinst AND cc.inst = FOpCodes.qRET];
	label => next ← cc.flink;
	jump =>
	  BEGIN
	  IF ~UCjump[c] THEN EXIT;
	  next ← cc.destlabel;
	  END;
	other => WITH cc SELECT FROM
	  table => EXIT;
	  ENDCASE => next ← cc.flink;
	ENDCASE => EXIT;
      ENDLOOP;
    RETURN [FALSE]
    END;


  CPass0: PROC =
    BEGIN  -- pass 0: distinguish forward and backward jumps
    JumpCellCount ← 0;
    FOR c: CCIndex ← StartIndex, cb[c].flink WHILE c # CCNull DO
      EndIndex ← c;
      WITH cb[c] SELECT FROM
	label => labelseen ← SeenSwitch;
	jump =>
	  BEGIN
	  forward ←
	    IF destlabel = LabelCCNull THEN TRUE
	    ELSE ~(cb[destlabel].labelseen = SeenSwitch);
	  JumpCellCount ← JumpCellCount + 1;
	  END;
	ENDCASE;
      ENDLOOP;
    END;


  CPass1: PROC =
    BEGIN   -- pass 1: eliminate multiple labels, unreferenced labels,
	    --         and jumps to .+1
    nextC, c: CCIndex;
    FOR c ← cb[StartIndex].flink, nextC WHILE c # CCNull DO
      nextC ← NextInteresting[c];
      WITH cc:cb[c] SELECT FROM
	jump =>
	  IF DotPlusOneJump[LOOPHOLE[c], nextC] AND 
	   (UCjump[c] OR cc.jtype IN [JumpE..UJumpLE]) THEN
	    DeleteJump[LOOPHOLE[c]];
	label =>
	  IF cc.jumplist = JumpCCNull THEN
	    {DidSomething ← TRUE; P5U.DeleteCell[LOOPHOLE[c, LabelCCIndex]]}
	  ELSE IF nextC # CCNull THEN
	    WITH cb[nextC] SELECT FROM
	      label =>
		BEGIN
		DidSomething ← TRUE;
		DeleteLabel[LOOPHOLE[c, LabelCCIndex], LOOPHOLE[nextC, LabelCCIndex]];
		END;
	      ENDCASE;
	ENDCASE;
      ENDLOOP;
   END;

  DotPlusOneJump: PROC [jc: JumpCCIndex, next: CCIndex] RETURNS [BOOLEAN] = INLINE
    BEGIN
    RETURN [IF next = CCNull THEN FALSE -- RRA fix
      ELSE WITH cb[next] SELECT FROM
        label => next = cb[jc].destlabel,
        ENDCASE => FALSE]
    END;

  DeleteJump: PROC [jc: JumpCCIndex] =
    BEGIN
    IF cb[jc].jtype IN [JumpE..UJumpLE] THEN
      THROUGH [0..2) DO
	CPtr.codeptr ← cb[jc].blink;
	P5.C0[FOpCodes.qPOP];
	[] ← PeepholeDefs.RemoveThisPop[CPtr.codeptr];
	ENDLOOP;
    UnthreadJump[jc];
    DidSomething ← TRUE; P5U.DeleteCell[jc];
    END;


  CPass2: PROC =
    BEGIN   -- pass 2: eliminate jump to jumps
    FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH jj: cb[c] SELECT FROM
	jump =>
	  IF jj.destlabel # LabelCCNull THEN
	    BEGIN
	    jtojExists: BOOLEAN ← FALSE;
	    jcCount: CARDINAL ← 0;
	    jc: JumpCCIndex ← LOOPHOLE[c, JumpCCIndex];
	    jcLabel: LabelCCIndex;
	    cc: CCIndex;
	    DO
	      jcLabel ← cb[jc].destlabel;
	      IF (cc ← NextInteresting[jcLabel]) = CCNull THEN EXIT;
	      IF ~UCjump[cc] THEN EXIT;
	      jc ← LOOPHOLE[cc, JumpCCIndex];
	      IF jc = c THEN {jtojExists ← FALSE; EXIT};
	      jcCount ← jcCount +1;
	      IF jcCount > JumpCellCount THEN {jtojExists ← FALSE; EXIT};
	      jtojExists ← TRUE;
	      ENDLOOP;
	    IF jtojExists THEN
	      BEGIN
	      DidSomething ← TRUE;
	      UnthreadJump[LOOPHOLE[c, JumpCCIndex]];
	      jj.thread ← cb[jcLabel].jumplist;
	      cb[jcLabel].jumplist ← LOOPHOLE[c, JumpCCIndex];
	      jj.destlabel ← jcLabel;
	      END;
	    END;
	ENDCASE
      ENDLOOP;
    END;


  CPass3: PROC =
    BEGIN   -- pass 3: eliminate unreachable code
    FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump =>
	  IF UCjump[c] OR jtype = JumpRet OR jtype = JumpCA THEN
	    BEGIN
	    cc: CCIndex ← flink;
	    oldc: CCIndex;
	    DO
	      IF (oldc ← cc) = CCNull THEN RETURN;
	      cc ← cb[cc].flink;
	      WITH cb[oldc] SELECT FROM
		label => IF jumplist # JumpCCNull THEN EXIT;
		jump => UnthreadJump[LOOPHOLE[oldc, JumpCCIndex]];
		other => IF otag # table THEN LOOP; --body start/stop, source
		ENDCASE;
	      P5U.DeleteCell[oldc];
	      DidSomething ← TRUE;
	      ENDLOOP;
	    END;
	ENDCASE;
      ENDLOOP;
    END;

  CPass4: PROC =
    BEGIN   -- pass 4: replace cj-j seq. with ccj
    c, nextC: CCIndex;
    FOR c ← cb[StartIndex].flink, nextC WHILE c # CCNull DO
      WITH oldC: cb[c] SELECT FROM
	jump =>
	  BEGIN
	  nextC ← IF MPtr.switches['j] THEN NextInteresting[c]
	    ELSE cb[c].flink; -- don't ignore source chunks here
	  IF oldC.jtype IN [JumpE..ZJumpN] AND nextC # CCNull THEN
	    WITH nc: cb[nextC] SELECT FROM
	      jump =>
		IF oldC.destlabel = nc.destlabel AND
	          (UCjump[c] OR oldC.jtype IN [JumpE..UJumpLE]) THEN
	           DeleteJump[LOOPHOLE[c]]
		ELSE IF UCjump[nextC] AND
		 (PrevInteresting[oldC.destlabel] = nextC) THEN
		  BEGIN
		  newLbl: LabelCCIndex = nc.destlabel;
		  nxt: CCIndex;
		  UnthreadJump[LOOPHOLE[nextC, JumpCCIndex]];
		  UnthreadJump[LOOPHOLE[c, JumpCCIndex]];
		  oldC.destlabel ← newLbl;
		  oldC.thread ← cb[newLbl].jumplist;
		  cb[newLbl].jumplist ← LOOPHOLE[c, JumpCCIndex];
		  oldC.jtype ← CJump[oldC.jtype];
		  oldC.forward ← nc.forward;
		  nxt ← nc.flink;
		  P5U.DeleteCell[nextC];
		  nextC ← nxt;
		  END;
	      ENDCASE;
	  END;
	ENDCASE => nextC ← cb[c].flink;
      ENDLOOP;
    END;

  CPass7: PROC RETURNS [unboundJumps: CARDINAL ← 0] =
    BEGIN -- pass 7: set length and alignment, count jumps
    c, next: CCIndex;
    -- look for body starting with a loop
    IF ~MPtr.switches['j] THEN
      BEGIN
      c ← NextInteresting[cb[StartIndex].flink];
      IF c # CCNull THEN  -- RRA fix
        WITH cb[c] SELECT FROM
	 label => IF jumplist # JumpCCNull THEN
	  BEGIN
	  CPtr.codeptr ← cb[c].blink;
	  P5U.OutJump[Jump, LOOPHOLE[c]];
	  cb[LOOPHOLE[CPtr.codeptr, JumpCCIndex]].forward ← TRUE;
	  END;
	ENDCASE;
      END;
    FOR c ← cb[StartIndex].flink, next WHILE c # CCNull DO
      next ← cb[c].flink;
      WITH cb[c] SELECT FROM
	code => 
	  BEGIN
	  IF isize = 0 THEN isize ← OpTableDefs.InstLength[inst];
	  aligned ← isize = 3 OR inst = Mopcodes.zCATCH OR
	    (isize # 2 AND OpTableDefs.InstAligned[inst]);
	  END;
	jump =>
	  IF jtype = JumpRet THEN P5U.DeleteCell[c]
	  ELSE unboundJumps ← unboundJumps+1;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;

  CPass8: PROC RETURNS [unboundJumps: CARDINAL ← 0] =
    BEGIN -- pass 8: resolve easy jumps
    P5F.FillInPCEstimates[];
    FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump => IF ~fixedup THEN
	  BEGIN
	  min, max: CARDINAL;
	  target: LabelCCIndex = destlabel;
	  IF forward THEN 
	    BEGIN 
	    min ← cb[target].minPC - minPC;
	    max ← cb[target].maxPC - maxPC;
	    END
	  ELSE
	    BEGIN 
	    min ← minPC - cb[target].minPC;
	    max ← maxPC - cb[target].maxPC;
	    END;
	  IF ~P5F.BindJump[min, max, LOOPHOLE[c, JumpCCIndex]]
	    THEN unboundJumps ← unboundJumps+1;
	  END;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;


  CPass9: PROC =
    BEGIN   -- pass 9: resolve (remaining) jump instructions
    P5F.FillInPCEstimates[];
    FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump =>
	  IF ~fixedup THEN
	    BEGIN
	    nBytes: CARDINAL = IF forward
		THEN cb[destlabel].maxPC - maxPC
		ELSE maxPC - cb[destlabel].maxPC;
	    [] ← P5F.BindJump[nBytes, nBytes, LOOPHOLE[c, JumpCCIndex]];
	    END;
	ENDCASE;
      ENDLOOP;
    END;

  CPass10: PROC =
    BEGIN -- pass 10: set pad field of chunks
    FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      cb[c].pad ← 0;
      ENDLOOP;
    END;


  CPass11: PROC =
    BEGIN   -- pass 11: code jumps
    FillInPC[];
    FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump =>
	  BEGIN
	  IF ~fixedup THEN SIGNAL CPtr.CodePassInconsistency 
	  ELSE P5F.CodeJump[(IF forward THEN cb[destlabel].pc - pc
	    ELSE pc - cb[destlabel].pc), LOOPHOLE[c, JumpCCIndex]];
	  END;
	ENDCASE;
      ENDLOOP;
    END;


  DeleteLabel: PROC [oldc, c: LabelCCIndex] =
    BEGIN -- removes extra label from code stream
    lq, q: JumpCCIndex;
    IF cb[c].jumplist = JumpCCNull THEN cb[c].jumplist ← cb[oldc].jumplist
    ELSE
      BEGIN
      q ← cb[c].jumplist;
      UNTIL q = JumpCCNull DO lq ← q; q ← cb[q].thread ENDLOOP;
      cb[lq].thread ← cb[oldc].jumplist;
      END;
    FOR q ← cb[oldc].jumplist, cb[q].thread UNTIL q = JumpCCNull
      DO cb[q].destlabel ← c ENDLOOP;
    P5U.DeleteCell[oldc];
    END;


  UnthreadJump: PUBLIC PROC [c: JumpCCIndex] =
    BEGIN -- pull jump cell out of thread from label
    l: LabelCCIndex = cb[c].destlabel;
    jc: JumpCCIndex;
    IF l = LabelCCNull THEN RETURN;
    jc ← cb[l].jumplist;
    IF jc = c THEN cb[l].jumplist ← cb[jc].thread
    ELSE
      BEGIN
      UNTIL cb[jc].thread = c DO jc ← cb[jc].thread ENDLOOP;
      cb[jc].thread ← cb[c].thread;
      END;
    END;


  UCjump: PUBLIC PROC [c: CCIndex] RETURNS [BOOLEAN] =
    BEGIN -- predicate testing if c is an unconditonal jump
    RETURN [WITH cb[c] SELECT FROM
      jump => jtype = Jump,
      ENDCASE => FALSE]
    END;


  Removeablejump: PROC [c: CCIndex] RETURNS [BOOLEAN] =
    BEGIN -- predicate testing if c is an unconditonal jump
    RETURN [WITH cb[c] SELECT FROM
      jump => (jtype = Jump OR jtype = JumpA OR jtype = JumpCA),
      ENDCASE => FALSE]
    END;


  FillInPC: PROC =
    BEGIN -- fills in relative PC of all labels and jumps.
    -- all jump lengths have been resolved and pad values set
    -- PC of forward jump is end of instruction
    -- PC of backward jump is start of pad (if any)
    rpc: RelativePC ← 0;
    nbytes: CARDINAL;
    FOR k: CCIndex ← StartIndex, cb[k].flink UNTIL k = CCNull DO
      nbytes ← cb[k].pad + (WITH cc:cb[k] SELECT FROM
	code => cc.isize,
	jump => IF cc.completed THEN 0 ELSE cc.jsize,
	other => (WITH cc SELECT FROM
	  table => tablecodebytes,
	  ENDCASE => 0),
	ENDCASE => 0);
      WITH cc:cb[k] SELECT FROM
	jump => 
	  IF cc.forward THEN {rpc ← rpc+nbytes; cc.pc ← rpc; LOOP}
	  ELSE cc.pc ← rpc;
	label => cc.pc ← rpc;
	ENDCASE;
      rpc ← rpc+nbytes;
      ENDLOOP;
    END;

  CodeJumpDist: PUBLIC PROC [
      jDist: INTEGER, l: [0..7], pad: [0..1], c: JumpCCIndex] =
    BEGIN -- code all jump instruction(s)
    OPEN Mopcodes, OpCodeParams;
    t: JumpType;
    RelJumpOps: ARRAY JumpType[JumpL..ZJumpN] OF Byte = [
      zJLB, zJGEB, zJGB, zJLEB, zJULB, zJUGEB, zJUGB, zJULEB,
      zJZEQB, zJZNEB];
    t ← cb[c].jtype;
    SELECT t FROM
     Jump, JumpA, JumpCA =>
      SELECT l FROM
       1 =>
        BEGIN
        IF jDist NOT IN [2..9] THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C0[zJn+jDist-2];
        END;
       2 =>
        BEGIN
        IF jDist NOT IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C1[zJB, jDist];
        cb[CPtr.codeptr].pad ← pad;
        END;
       ENDCASE =>
        BEGIN
        P5.C1W[zJW, jDist];
        cb[CPtr.codeptr].pad ← pad;
        END;
     JumpE, JumpN =>
      SELECT l FROM
       1 =>
        BEGIN
        IF jDist NOT IN [2..9] THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C0[(IF t=JumpE THEN zJEQn ELSE zJNEn)+jDist-2];
        END;
       2 =>
        BEGIN
        IF jDist NOT IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C1[(IF t = JumpE THEN zJEQB ELSE zJNEB), jDist];
        cb[CPtr.codeptr].pad ← pad;
        END;
       ENDCASE =>
        BEGIN
        P5.C0[(IF t = JumpE THEN zJNE4 ELSE zJEQ4)+pad];
        P5.C1W[zJW, jDist]; cb[CPtr.codeptr].pad ← pad;
        END;
     JumpC => NULL;
     ENDCASE =>
      SELECT l FROM
       2 =>
        BEGIN
        IF jDist NOT IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C1[RelJumpOps[t], jDist];
        cb[CPtr.codeptr].pad ← pad;
        END;
       ENDCASE =>
        BEGIN
        P5.C1[RelJumpOps[CJump[t]], 5]; cb[CPtr.codeptr].pad ← pad;
        P5.C1W[zJW, jDist];
        cb[CPtr.codeptr].pad ← 0;
        END;
    cb[c].completed ← TRUE;
    cb[c].pad ← 0; -- so it doesn't have to be ignored in ComputeJumpDistance
    cb[c].jsize ← 0; -- so it doesn't have to be ignored in ComputeJumpDistance
    END;
  
  END.