-- CrossJump.mesa, modified by Sweet, August 17, 1979 1:57 PM DIRECTORY Code: FROM "code" USING [codeptr], CodeDefs: FROM "codedefs" USING [CCIndex, CCNull, JumpCCIndex, JumpCCNull, LabelCCIndex], FOpCodes: FROM "fopcodes", OpTableDefs: FROM "optabledefs" USING [instlength], P5F: FROM "p5f", P5U: FROM "p5u" USING [CreateLabel, DeleteCell, OutJump, ParamCount], Table: FROM "table" USING [Base, Notifier], Tree: FROM "tree" USING [treeType]; CrossJump: PROGRAM IMPORTS CPtr: Code, OpTableDefs, P5U, P5F EXPORTS CodeDefs, P5F = BEGIN OPEN CodeDefs; cb: Table.Base; -- code base (local copy) CrossJumpNotify: PUBLIC Table.Notifier = BEGIN -- called by allocator whenever table area is repacked cb _ base[Tree.treeType]; RETURN END; CJcheck: PUBLIC BOOLEAN _ FALSE; FunnyJump: SIGNAL [c: CCIndex] = CODE; CPass5: PUBLIC PROCEDURE = BEGIN -- pass 5: cross jumping father, son, thisSon, nextc, c: CCIndex; CJed: BOOLEAN; FOR c _ cb[P5F.StartIndex].flink, nextc WHILE c # CCNull DO WITH cc: cb[c] SELECT FROM label => BEGIN lc: LabelCCIndex = LOOPHOLE[c]; [father, son] _ InitCrossSearch[lc]; CJed _ FALSE; UNTIL father = CCNull DO UNTIL son = CCNull DO thisSon _ EldestSon[son]; son _ NextSon[thisSon, lc]; IF FunnyUCjump[LOOPHOLE[father]] THEN SIGNAL FunnyJump[father]; IF EqualInst[father, thisSon] THEN BEGIN CrossJumpIt[father, thisSon, lc]; P5F.DidSomething _ CJed _ TRUE; END; ENDLOOP; IF CJed THEN EXIT; [father, son] _ NextFather[father, lc]; ENDLOOP; nextc _ cc.flink; END; ENDCASE => nextc _ cc.flink; ENDLOOP; RETURN END; InitCrossSearch: PROCEDURE[lc: LabelCCIndex] RETURNS [father, son: CCIndex] = BEGIN j: JumpCCIndex _ cb[lc].jumplist; IF j = JumpCCNull THEN RETURN[CCNull, CCNull]; IF (father_cb[lc].blink) = CCNull THEN RETURN[CCNull, CCNull]; WITH cb[father] SELECT FROM code => RETURN[father, j]; jump => IF ~(P5F.UCjump[father] OR FunnyUCjump[father] OR destlabel = lc) THEN RETURN[father, EldestSon[j]]; ENDCASE; father _ EldestSon[j]; IF FunnyUCjump[father] THEN BEGIN [father, son] _ NextFather[father, lc]; RETURN [father, son]; END; j _ cb[j].thread; IF j = JumpCCNull THEN RETURN[CCNull, CCNull] ELSE RETURN[father, j] END; FunnyUCjump: PROCEDURE [j: CCIndex] RETURNS [BOOLEAN] = 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; NextFather: PROCEDURE[oldFather: CCIndex, lbl: LabelCCIndex] RETURNS [newFather, son: CCIndex] = BEGIN j: JumpCCIndex; sD: BOOLEAN _ FALSE; IF cb[oldFather].flink = lbl THEN WITH cb[oldFather] SELECT FROM jump => sD _ destlabel # lbl; ENDCASE => sD _ TRUE; DO -- until newFather not a funnyjump IF sD THEN BEGIN j _ cb[lbl].jumplist; IF j = oldFather THEN j _ cb[j].thread; -- jump to .+1 END ELSE j _ cb[UnEldestSon[oldFather, lbl]].thread; IF j = JumpCCNull THEN RETURN[CCNull, CCNull]; newFather _ EldestSon[j]; j _ cb[j].thread; IF j = JumpCCNull THEN RETURN[CCNull, CCNull]; IF ~FunnyUCjump[newFather] THEN EXIT; oldFather _ EldestSon[j]; sD _ FALSE; ENDLOOP; RETURN[newFather, EldestSon[j]] END; EqualInst: PROCEDURE[c, cc: CCIndex] RETURNS [BOOLEAN] = BEGIN i, 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 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 IF c1.jtype # c2.jtype THEN RETURN[FALSE]; IF c1.destlabel # c2.destlabel THEN RETURN[FALSE]; WITH c1f : cb[c1.flink] SELECT FROM jump => WITH c2f : cb[c2.flink] SELECT FROM jump => IF c1f.destlabel = c2f.destlabel THEN RETURN[TRUE]; label => IF c1f.destlabel = c2.flink THEN RETURN[TRUE]; ENDCASE; label => WITH c2f : cb[c2.flink] SELECT FROM jump => IF c2f.destlabel = c1.flink THEN RETURN[TRUE]; ENDCASE; ENDCASE; END; ENDCASE; ENDCASE; RETURN[FALSE] END; UnEldestSon: PROCEDURE [son: CCIndex, lbl: LabelCCIndex] RETURNS [JumpCCIndex] = BEGIN c: CCIndex; WITH cb[son] SELECT FROM jump => IF destlabel = lbl THEN RETURN[LOOPHOLE[son]]; ENDCASE; c _ cb[son].flink; WITH cb[c] SELECT FROM jump => RETURN [LOOPHOLE[c]]; ENDCASE => ERROR; END; EldestSon: PROCEDURE [j: CCIndex] RETURNS [CCIndex] = BEGIN RETURN[IF ~P5F.UCjump[j] THEN j ELSE cb[j].blink] END; NextSon: PROCEDURE[son: CCIndex, lbl: LabelCCIndex] RETURNS [CCIndex] = BEGIN j: JumpCCIndex _ cb[UnEldestSon[son, lbl]].thread; IF j = JumpCCNull THEN RETURN[CCNull]; RETURN[j]; END; CrossJumpIt: PROCEDURE[father, son: CCIndex, lbl: LabelCCIndex] = BEGIN l: LabelCCIndex; sj: JumpCCIndex = UnEldestSon[son,lbl]; fb: CCIndex = cb[father].blink; WITH cb[fb] SELECT FROM label => l _ LOOPHOLE[fb]; ENDCASE => BEGIN CPtr.codeptr _ fb; l _ P5U.CreateLabel[]; END; CPtr.codeptr _ cb[son].blink; P5U.OutJump[Jump,l]; P5F.UnthreadJump[sj]; IF son # sj THEN BEGIN P5U.DeleteCell[sj]; IF cb[son].cctag = jump THEN P5F.UnthreadJump[LOOPHOLE[son]]; END; WITH f: cb[father] SELECT FROM code => WITH s: cb[son] SELECT FROM code => f.minimalStack _ f.minimalStack AND s.minimalStack; ENDCASE; ENDCASE; P5U.DeleteCell[son]; RETURN END; END...