-- CrossJump.mesa,
-- last modified by Sweet, 4-Dec-81 14:20:33
-- last modified by Satterthwaite, December 16, 1982 9:11 am
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [codeptr],
CodeDefs: TYPE USING [
Base, CCIndex, CCNull, CJItem, codeType, EINull, EnableIndex,
JumpCCIndex, JumpCCNull, LabelCCIndex, LabelCCNull],
OpTableDefs: TYPE USING [InstLength],
P5F: TYPE USING [DidSomething, StartIndex, UCjump, UnthreadJump],
P5U: TYPE USING [CreateLabel, DeleteCell, OutJump, ParamCount];
CrossJump: PROGRAM
IMPORTS CPtr: Code, OpTableDefs, P5U, P5F
EXPORTS CodeDefs, P5F =
BEGIN
OPEN CodeDefs;
cb: CodeDefs.Base; -- code base (local copy)
CrossJumpNotify: PUBLIC Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
cb ← base[codeType];
END;
CJcheck: PUBLIC BOOL ← FALSE;
CJNull: CJItem = [CCNull, fallIn[LabelCCNull]];
FunnyJump: SIGNAL [c: CCIndex] = CODE;
CPass5: PUBLIC PROC =
BEGIN
CPass5a[];
CPass5b[];
END;
CPass5a: PROC =
BEGIN -- set enable index in jumps and labels
stack: ARRAY [0..15) OF EnableIndex;
sptr: CARDINAL ← 0;
curEi: EnableIndex ← EINull;
c: CCIndex;
Push: PROC [new: EnableIndex] =
BEGIN
stack[sptr] ← curEi;
curEi ← new;
sptr ← sptr + 1;
END;
Pop: PROC =
BEGIN
sptr ← sptr - 1;
curEi ← stack[sptr];
END;
FOR c ← cb[P5F.StartIndex].flink, cb[c].flink WHILE c # CCNull DO
WITH cc: cb[c] SELECT FROM
label => cc.ei ← curEi;
jump => cc.ei ← curEi;
other => WITH cc SELECT FROM
markCatch => IF start THEN Push[index] ELSE Pop[];
ENDCASE;
ENDCASE;
ENDLOOP;
END;
CPass5b: PROC =
BEGIN -- pass 5: cross jumping
i1, i2, next2: CJItem;
nextc, c: CCIndex;
CJed: BOOL;
FOR c ← cb[P5F.StartIndex].flink, nextc WHILE c # CCNull DO
WITH cc: cb[c] SELECT FROM
label =>
BEGIN
lc: LabelCCIndex = LOOPHOLE[c];
i1 ← FirstItem[lc];
CJed ← FALSE;
UNTIL i1.inst = CCNull DO
i2 ← NextItem[i1];
UNTIL i2.inst = CCNull DO
next2 ← NextItem[i2];
IF i1.inst # i2.inst AND EqualItems[i1, i2] THEN
BEGIN
CrossJumpIt[i1, i2];
P5F.DidSomething ← CJed ← TRUE;
END;
i2 ← next2;
ENDLOOP;
IF CJed THEN EXIT;
i1 ← NextItem[i1];
ENDLOOP;
nextc ← cc.flink;
END;
ENDCASE => nextc ← cc.flink;
ENDLOOP;
END;
EqualItems: PROC [i1, i2: CJItem] RETURNS [BOOL] =
BEGIN -- can't cross jump into different enable scopes
ei1, ei2: EnableIndex;
IF ~EqualInst[i1.inst, i2.inst] THEN RETURN[FALSE];
WITH i1 SELECT FROM
fallIn => ei1 ← cb[lc].ei;
jumpIn => ei1 ← cb[jc].ei;
ENDCASE;
WITH i2 SELECT FROM
fallIn => ei2 ← cb[lc].ei;
jumpIn => ei2 ← cb[jc].ei;
ENDCASE;
RETURN [ei1 = ei2];
END;
Executable: PROC [c: CCIndex] RETURNS [BOOL] =
BEGIN
RETURN [WITH cb[c] SELECT FROM
code => TRUE,
jump => ~(P5F.UCjump[c] OR FunnyUCjump[c]),
ENDCASE => FALSE]
END;
FirstItem: PROC[lc: LabelCCIndex] RETURNS [item: CJItem] =
BEGIN
j: JumpCCIndex ← cb[lc].jumplist;
pred: CCIndex;
IF j = JumpCCNull THEN RETURN [CJNull];
IF (pred←PrevInst[lc]) = CCNull THEN RETURN [CJNull];
item ← [pred, fallIn[lc]];
IF Executable[pred] THEN RETURN [item];
RETURN [NextItem[item]]
END;
NextItem: PROC [item: CJItem] RETURNS [CJItem] =
BEGIN
j: JumpCCIndex;
inst: CCIndex;
DO
WITH ii: item SELECT FROM
fallIn => j ← cb[ii.lc].jumplist;
jumpIn => j ← cb[ii.jc].thread;
ENDCASE;
IF j = CCNull THEN RETURN [CJNull];
IF FunnyUCjump[j] THEN {item ← [CCNull, jumpIn[j]]; LOOP};
IF Executable[j] THEN {inst ← j; EXIT};
inst ← PrevInst[j];
IF inst # CCNull AND Executable[inst] THEN EXIT;
item ← [CCNull, jumpIn[j]];
ENDLOOP;
RETURN [[inst, jumpIn[j]]]
END;
FunnyUCjump: PROC [j: CCIndex] RETURNS [BOOL] =
BEGIN -- predicate testing if c is not interesting jump for crossjumping
RETURN [WITH cb[j] SELECT FROM
jump => (jtype = JumpC) OR (jtype = JumpA)
OR (jtype = JumpCA) OR (jtype = JumpRet),
ENDCASE => FALSE]
END;
EqualInst: PROC [c, cc: CCIndex] RETURNS [BOOL] =
BEGIN
np: CARDINAL;
WITH c1: cb[c] SELECT FROM
code =>
WITH c2 : cb[cc] SELECT FROM
code =>
BEGIN
IF c1.realinst # c2.realinst THEN RETURN [FALSE];
IF c1.inst # c2.inst THEN RETURN [FALSE];
np ← IF c1.realinst THEN OpTableDefs.InstLength[c1.inst]-1
ELSE P5U.ParamCount[LOOPHOLE[c]];
FOR i: CARDINAL IN [1..np] DO
IF c1.parameters[i] # c2.parameters[i] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE]
END;
ENDCASE;
jump =>
WITH c2 : cb[cc] SELECT FROM
jump =>
BEGIN
c1fwd, c2fwd: CCIndex;
IF c1.jtype # c2.jtype THEN RETURN [FALSE];
IF c1.destlabel # c2.destlabel THEN RETURN [FALSE];
c1fwd ← NextInst[c]; c2fwd ← NextInst[cc];
WITH c1f : cb[c1fwd] SELECT FROM
jump =>
WITH c2f : cb[c2fwd] SELECT FROM
jump => IF c1f.destlabel = c2f.destlabel THEN RETURN [TRUE];
label => IF c1f.destlabel = c2fwd THEN RETURN [TRUE];
ENDCASE;
label =>
WITH c2f : cb[c2fwd] SELECT FROM
jump => IF c2f.destlabel = c1fwd THEN RETURN [TRUE];
ENDCASE;
ENDCASE;
END;
ENDCASE;
ENDCASE;
RETURN [FALSE]
END;
CrossJumpIt: PROC [i1, i2: CJItem] =
BEGIN
l: LabelCCIndex;
fb: CCIndex = PrevInst[i1.inst];
WITH cb[fb] SELECT FROM
label => l ← LOOPHOLE[fb];
ENDCASE => {CPtr.codeptr ← fb; l ← P5U.CreateLabel[]};
CPtr.codeptr ← cb[i2.inst].blink; -- don't skip over source here
P5U.OutJump[Jump,l];
WITH cb[i2.inst] SELECT FROM
jump => P5F.UnthreadJump[LOOPHOLE[i2.inst]];
ENDCASE;
P5U.DeleteCell[i2.inst];
WITH ii: i2 SELECT FROM
jumpIn => IF ii.jc # i2.inst THEN
{P5F.UnthreadJump[ii.jc]; P5U.DeleteCell[ii.jc]};
ENDCASE;
END;
-- the following two procs are like NextInteresting and PrevInteresting
-- in PeepholeU, only they won't skip over a MarkCatch
NextInst: PROC [c: CCIndex] RETURNS [CCIndex] =
BEGIN -- skip over startbody, endbody, and source other CCItems
WHILE (c ← cb[c].flink) # CCNull DO
WITH cc: cb[c] SELECT FROM
other => WITH cc SELECT FROM
table, markCatch => EXIT;
ENDCASE;
ENDCASE => EXIT;
ENDLOOP;
RETURN [c]
END;
PrevInst: PROC [c: CCIndex] RETURNS [CCIndex] =
BEGIN -- skip over startbody, endbody, and source other CCItems
WHILE (c ← cb[c].blink) # CCNull DO
WITH cc: cb[c] SELECT FROM
other => WITH cc SELECT FROM
table, markCatch => EXIT;
ENDCASE;
ENDCASE => EXIT;
ENDLOOP;
RETURN [c]
END;
END.