
<<Final.mesa>>
<<last modified by Sweet, 15-Sep-82 16:42:40>>
<<edited by Satterthwaite, December 1, 1985 4:06:53 pm PST >>

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.

