-- Final.mesa
-- last modified by Sweet, September 8, 1980 10:08 AM
-- edited by Satterthwaite, November 2, 1982 3:53 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 [
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 BOOL;
StartIndex: PUBLIC LabelCCIndex;
EndIndex: PUBLIC CCIndex;
SeenSwitch: BOOL;
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: BOOL = 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 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 [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 => 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 [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.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: 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 {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;


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 [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 {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], 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];
END;
ENDCASE =>
BEGIN
P5.C1W[zJW, jDist];
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];
END;
ENDCASE =>
BEGIN
P5.C0[(IF t = JumpE THEN zJNE4 ELSE zJEQ4)];
P5.C1W[zJW, jDist];
END;
JumpC => NULL;
ENDCASE =>
SELECT l FROM
2 =>
BEGIN
IF jDist NOT IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
P5.C1[RelJumpOps[t], jDist];
END;
ENDCASE =>
BEGIN
P5.C1[RelJumpOps[CJump[t]], 5];
P5.C1W[zJW, jDist];
END;
cb[c].completed ← TRUE;
cb[c].jsize ← 0; -- so it doesn't have to be ignored in ComputeJumpDistance
END;

END.