-- 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...