DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [codeptr],
CodeDefs: 
TYPE 
USING [
Base, CCIndex, CCNull, codeType, CJItem, JumpCCIndex, JumpCCNull,
LabelCCIndex, LabelCCNull],
 
OpTableDefs: TYPE USING [InstLength],
P5F: TYPE USING [DidSomething, StartIndex, UCjump, UnthreadJump],
P5U: TYPE USING [CreateLabel, DeleteCell, OutJump, ParamCount],
PeepholeDefs: TYPE USING [NextInteresting, PrevInteresting];
 
CrossJump: 
PROGRAM
IMPORTS CPtr: Code, OpTableDefs, P5U, P5F, PeepholeDefs 
EXPORTS CodeDefs, P5F =
BEGIN
OPEN PeepholeDefs, 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  --  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 EqualInst[i1.inst, i2.inst] 
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;
 
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←PrevInteresting[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 ← PrevInteresting[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 ← NextInteresting[c]; c2fwd ← NextInteresting[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 = PrevInteresting[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;
 
END.