-- Final.mesa
-- last modified by Sweet, 15-Sep-82 16:42:40
-- edited by Satterthwaite, December 16, 1982 9:25 am 

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [
    bodyRecurLabel, CodePassInconsistency, codeptr, tailJumpOK],
  CodeDefs: TYPE USING [
    Base, CCIndex, CCInfoType, CCNull, codeType, JumpCCIndex, JumpCCNull,
    JumpType, LabelCCIndex, LabelCCNull, RelativePC, TableCodeBytes],
  ComData: TYPE USING [bodyIndex, switches],
  FOpCodes: TYPE USING [qADD, qDIS, qLFC, qLI, qLL, qRET, qSELFC, qSFC],
  OpTableDefs: TYPE USING [InstLength],
  P5: TYPE USING [C0, C1, PeepHole],
  P5F: TYPE USING [BindJump, CodeJump, CPass5, FillInPCEstimates],
  P5U: TYPE USING [DeleteCell, OutJump],
  PeepholeDefs: TYPE USING [
    CJump, NextInteresting, PrevInteresting, RemoveThisPop, SetRealInst],
  PrincOps: TYPE USING [framelink],
  Symbols: TYPE USING [Base, CBTIndex, BTIndex, bodyType];

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)
  bb: Symbols.Base;

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

  DidSomething: PUBLIC BOOL;
  StartIndex, EndIndex: PUBLIC CCIndex;
  SeenSwitch: BOOL;
  JumpCellCount: CARDINAL;
  
  ccInfo: PUBLIC CCInfoType _ generating;

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

  Fixup: PUBLIC PROC [start: CCIndex, ownEntry: CARDINAL] =
    BEGIN -- a final pass over the code to fix up jumps
    jumpsbefore, jumpsafter, totalJumps: CARDINAL;
    crossJump: BOOL = MPtr.switches['j];
    ccInfo _ generating;
    DidSomething _ TRUE;
    SeenSwitch _ TRUE;
    StartIndex _ start;

    PeepholeDefs.SetRealInst[FALSE];
    TailJump[crossJump AND CPtr.tailJumpOK];
    CPtr.bodyRecurLabel _ 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: code jumps
    ccInfo _ coding;
    IF totalJumps # 0 THEN CPass10[];
    -- pass 11: Remove extra source chunks
    CPass11[];
    END;


  TailJump: PROC [jumpOK: BOOL] =
    BEGIN  -- remove simple tail recursion
    enableLevel: CARDINAL _ 0;
    next: CCIndex;
    FOR c: CCIndex _ cb[StartIndex].flink, next WHILE c # CCNull DO
      next _ cb[c].flink;
      WITH cc: cb[c] SELECT FROM
	code =>
	  IF ~cc.realinst AND cc.inst = FOpCodes.qSELFC THEN {
	    CPtr.codeptr _ cb[c].blink;
	    IF jumpOK AND enableLevel = 0 AND UCreturn[next] THEN
	      BEGIN
	      P5U.OutJump[Jump, CPtr.bodyRecurLabel];
	      P5U.DeleteCell[c]
	      END
	    ELSE
	      BEGIN
	      bti: Symbols.CBTIndex = MPtr.bodyIndex;
	      WITH body: bb[bti] SELECT FROM
	        Outer => {P5.C1[FOpCodes.qLFC, body.entryIndex]; P5U.DeleteCell[c]};
		Inner => {
		  P5.C1[FOpCodes.qLL, PrincOps.framelink];
		  P5.C1[FOpCodes.qLI, body.frameOffset];
		  P5.C0[FOpCodes.qADD];
		  P5.C0[FOpCodes.qSFC];
		  P5U.DeleteCell[c]};
		ENDCASE => ERROR;
	      END};
	other => WITH oc: cc SELECT FROM
	  markbody => {
	    index: Symbols.BTIndex = oc.index;
	    WITH bb[index] SELECT FROM 
	      Callable => EXIT;
	      ENDCASE};
	  markCatch => 
	    IF oc.start THEN enableLevel _ enableLevel + 1
	    ELSE enableLevel_ enableLevel - 1;
	  ENDCASE;
	ENDCASE;
      ENDLOOP;
    END;

  UCreturn: PROC [start: CCIndex] RETURNS [BOOL] =
    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, markCatch => 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 _ cb[StartIndex].flink, 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 AND ~cc.catch THEN
	    BEGIN
	    unreferencedlabel: LabelCCIndex _ LOOPHOLE[c, LabelCCIndex];
	    DidSomething _ TRUE; P5U.DeleteCell[unreferencedlabel];
	    END
	  ELSE 
	    BEGIN
	    duplabel: LabelCCIndex _ LOOPHOLE[c, LabelCCIndex];
	    IF nextc = CCNull THEN RETURN;
	    WITH cb[nextc] SELECT FROM
	      label =>
		BEGIN
		DeleteLabel[duplabel, LOOPHOLE[nextc, LabelCCIndex]];
		DidSomething _ TRUE;
		END;
	      ENDCASE;
	    END;
	ENDCASE;
      ENDLOOP;
   END;

  DotPlusOneJump: PROC [jc: JumpCCIndex, next: CCIndex] RETURNS [BOOL] = 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.qDIS];
	[] _ 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: BOOL _ 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 BEGIN jtojexists _ FALSE; EXIT END;
	      jccount _ jccount +1;
	      IF jccount > JumpCellCount THEN
		BEGIN jtojexists _ FALSE; EXIT END;
	      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;
	      IF jj.jtype = JumpLIO THEN cb[jclabel].offsetLoaded _ TRUE;
	      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 OR catch 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] THEN
	    BEGIN
	    IF nextc = CCNull THEN RETURN;
	    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;
	  END;
	ENDCASE => nextc _ cb[c].flink;
      ENDLOOP;
    END;

  CPass7: PROC RETURNS [unboundJumps: CARDINAL] =
    BEGIN -- pass 7: set length, 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;
    unboundJumps _ 0;
    FOR c _ cb[StartIndex].flink, next WHILE c # CCNull DO
      next _ cb[c].flink;
      WITH cb[c] SELECT FROM
	code => IF isize = 0 THEN isize _ OpTableDefs.InstLength[inst];
	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: 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;
    IF cb[oldc].offsetLoaded THEN cb[c].offsetLoaded _ TRUE;
    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 [BOOL] =
    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 [BOOL] =
    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 _ (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 BEGIN rpc _ rpc+nbytes; cc.pc _ rpc; LOOP END
	  ELSE cc.pc _ rpc;
	label => cc.pc _ rpc;
	ENDCASE;
      rpc _ rpc+nbytes;
      ENDLOOP;
    END;

  CPass11: PROC =
    BEGIN  -- pass 11: Remove extra source chunks
    prev: CCIndex _ CCNull;
    FOR c: CCIndex _ cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cc: cb[c] SELECT FROM
	code => prev _ CCNull;
	other => WITH cc SELECT FROM
	  table => prev _ CCNull;
	  source => {
	    IF prev # CCNull THEN P5U.DeleteCell[prev];
	    prev _ c};
	  ENDCASE;
	ENDCASE;
      ENDLOOP;
    END;


  END.