-- Final.mesa, modified by Sweet, March 20, 1979  10:57 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE],
  Code: FROM "code" USING [CodePassInconsistency, codeptr, dStar],
  CodeDefs: FROM "codedefs" USING [CCIndex, CCInfoType, CCNull, JumpCCIndex, JumpCCNull, JumpType, LabelCCIndex, LabelCCNull, NULLfileindex, RelativePC],
  ComData: FROM "comdata" USING [switches],
  FOpCodes: FROM "fopcodes",
    Mopcodes: FROM "mopcodes" USING [zJB, zJEQ4, zJEQB, zJGB, zJGEB, zJLB, zJLEB, zJNE4, zJNEB, zJUGB, zJUGEB, zJULB, zJULEB, 
    zJW, zJZEQB, zJZNEB],
    OpCodeParams: FROM "opcodeparams" USING [zJEQn, zJn, zJNEn],
  OpTableDefs: FROM "optabledefs" USING [instaligned, instlength],
  P5: FROM "p5" USING [C0, C1, C1W, PeepHole],
  P5F: FROM "p5f",
  P5U: FROM "p5u" USING [DeleteCell],
  PeepholeDefs: FROM "peepholedefs" USING [RemoveThisPop, SetRealInst, SetSourceIndex],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [treeType];

Final: PROGRAM
    IMPORTS CPtr: Code, MPtr: ComData, OpTableDefs, P5U, P5, P5F, PeepholeDefs 
    EXPORTS CodeDefs, P5, P5F =
  BEGIN
  OPEN CodeDefs;

  cb: Table.Base;		-- code base (local copy)

  CJump: ARRAY JumpType[JumpE..ZJumpN] OF JumpType = [
	JumpN, JumpE, JumpGE, JumpL, JumpLE, JumpG,
	UJumpGE, UJumpL, UJumpLE, UJumpG, ZJumpN, ZJumpE];

  FinalNotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    cb _ base[Tree.treeType];
    RETURN
    END;

  DidSomething: PUBLIC BOOLEAN;
  StartIndex, EndIndex: PUBLIC CCIndex;
  SeenSwitch: BOOLEAN;
  JumpCellCount: CARDINAL;


  ccInfo: CCInfoType _ generating;

  CCInfoMeaning: PUBLIC PROCEDURE RETURNS [CCInfoType] =
    BEGIN
    RETURN[ccInfo]
    END;

  Fixup: PUBLIC PROCEDURE [start: CCIndex] =
    BEGIN -- a final pass over the code to fix up jumps
    jumpsbefore, jumpsafter, totalJumps: CARDINAL;
    crossJump: BOOLEAN _ MPtr.switches['j];
    dStar: BOOLEAN = CPtr.dStar;
    ccInfo _ generating;
    DidSomething _ TRUE;
    SeenSwitch _ TRUE;
    StartIndex _ start;

    --ComplementCursor[];
    PeepholeDefs.SetRealInst[FALSE];
    PeepholeDefs.SetSourceIndex[NULLfileindex];
    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[dStar];
      ENDLOOP;
    -- pass 9: resolve (remaining) jump instructions
    IF jumpsafter # 0 THEN CPass9[dStar];
    -- pass 10: set pad fields
    CPass10[dStar];
    -- pass 11: code jumps
    ccInfo _ coding;
    IF totalJumps # 0 THEN CPass11[dStar];
    --ComplementCursor[];
    RETURN
    END;


  CPass0: PROCEDURE =
    BEGIN  -- pass 0: distinguish forward and backward jumps
    c: CCIndex;

    JumpCellCount _ 0;
    FOR c _ 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;
    RETURN
    END;


  CPass1: PROCEDURE =
    BEGIN   -- pass 1: eliminate multiple labels, unreferenced labels,
	    --         and jumps to .+1
    duplabel, unreferencedlabel: LabelCCIndex;
    nextc, c: CCIndex;

    FOR c _ cb[StartIndex].flink, nextc WHILE c # CCNull DO
      WITH cc:cb[c] SELECT FROM
	jump =>
	  IF DotPlusOneJump[LOOPHOLE[c]] THEN
	    BEGIN
	    IF UCjump[c] THEN GO TO gunIt
	    ELSE IF cc.jtype IN [JumpE..UJumpLE] THEN
	      BEGIN
	      THROUGH [0..2) DO
		CPtr.codeptr _ cc.blink;
		P5.C0[FOpCodes.qPOP];
		[] _ PeepholeDefs.RemoveThisPop[CPtr.codeptr];
		ENDLOOP;
	      GO TO gunIt;
	      END;
	    nextc _ cc.flink;
	    EXITS
	      gunIt =>
		BEGIN
		UnthreadJump[LOOPHOLE[c]]; nextc _ cc.flink;
		DidSomething _ TRUE; P5U.DeleteCell[c];
		END;
	    END
	  ELSE nextc _ cc.flink;
	label =>
	  IF cc.jumplist = JumpCCNull THEN
	    BEGIN
	    unreferencedlabel _ LOOPHOLE[c, LabelCCIndex]; nextc _ cc.flink;
	    DidSomething _ TRUE; P5U.DeleteCell[unreferencedlabel];
	    END
	  ELSE 
	    BEGIN
	    duplabel _ LOOPHOLE[c, LabelCCIndex]; nextc _ cc.flink;
	    IF cc.flink = CCNull THEN RETURN;
	    WITH cb[cc.flink] SELECT FROM
	      label =>
		BEGIN
		DeleteLabel[duplabel, LOOPHOLE[cc.flink, LabelCCIndex]];
		DidSomething _ TRUE;
		END;
	      ENDCASE;
	    END;
	ENDCASE => nextc _ cc.flink;
      ENDLOOP;
   RETURN
   END;

  DotPlusOneJump: PROCEDURE [jc: JumpCCIndex] RETURNS [BOOLEAN] =
    BEGIN
    c: CCIndex;
    target: CCIndex _ cb[jc].destlabel;

    FOR c _ cb[jc].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	other => IF otag = table THEN RETURN[FALSE];
	label => RETURN [c = target];
	ENDCASE => RETURN[FALSE];
      ENDLOOP;
    RETURN[FALSE];
    END;


  CPass2: PROCEDURE =
    BEGIN   -- pass 2: eliminate jump to jumps
    c, cc: CCIndex;
    jc: JumpCCIndex;
    jtojexists: BOOLEAN;
    jclabel, formerlabel: LabelCCIndex;
    jccount: CARDINAL;

    FOR c _ cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump =>
	  IF destlabel # LabelCCNull THEN
	    BEGIN
	    jtojexists _ FALSE;
	    jccount _ 0;
	    jc _ LOOPHOLE[c, JumpCCIndex];
	    DO
	      jclabel _ cb[jc].destlabel;
	      IF (cc _ cb[jclabel].flink) = 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;
	      formerlabel _ destlabel;
	      UnthreadJump[LOOPHOLE[c, JumpCCIndex]];
	      thread _ cb[jclabel].jumplist;
	      cb[jclabel].jumplist _ LOOPHOLE[c, JumpCCIndex];
	      destlabel _ jclabel;
	      END;
	    END;
	ENDCASE
      ENDLOOP;
    RETURN
    END;


  CPass3: PROCEDURE =
    BEGIN   -- pass 3: eliminate unreachable code
    c, cc, oldc: CCIndex;

    FOR c _ 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 _ flink;
	    DO
	      IF (oldc _ cc) = CCNull THEN RETURN;
	      cc _ cb[cc].flink;
	      WITH cb[oldc] SELECT FROM
		label => IF jumplist # JumpCCNull THEN EXIT;
		jump => UnthreadJump[LOOPHOLE[oldc, JumpCCIndex]];
		other => IF otag # table THEN LOOP; --body start/stop
		ENDCASE;
	      P5U.DeleteCell[oldc];
	      DidSomething _ TRUE;
	      ENDLOOP;
	    END;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;

  CPass4: PROCEDURE =
    BEGIN   -- pass 4: replace cj-j seq. with ccj
    c, nextc: CCIndex;

    FOR c _ cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH oldc:cb[c] SELECT FROM
	jump =>
	  IF oldc.jtype IN [JumpE..ZJumpN] THEN
	    BEGIN
	    nextc _ oldc.flink;
	    IF nextc = CCNull THEN RETURN;
	    WITH nc:cb[nextc] SELECT FROM
	      jump =>
		IF UCjump[nextc] AND (cb[oldc.destlabel].blink = nextc) THEN
		  BEGIN
		  newLbl: LabelCCIndex = nc.destlabel;
		  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;
		  P5U.DeleteCell[nextc];
		  END;
	      ENDCASE;
	    END;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;

  CPass7: PROCEDURE RETURNS [unboundJumps: CARDINAL] =
    BEGIN -- pass 7: set length and alignment, count jumps
    c, next: CCIndex;

    unboundJumps _ 0;
    FOR c _ cb[StartIndex].flink, next WHILE c # CCNull DO
      next _ cb[c].flink;
      WITH cb[c] SELECT FROM
	code => IF ~realinst THEN -- ignore dummies for fgt info
	  BEGIN
	  aligned _ FALSE; isize _ 0;
	  END
	ELSE
	  BEGIN
	  IF isize = 0 THEN isize _ OpTableDefs.instlength[inst];
	  aligned _ isize = 3 OR OpTableDefs.instaligned[inst];
	  END;
	jump =>
	  IF jtype = JumpRet THEN
	    P5U.DeleteCell[c]
	  ELSE unboundJumps _ unboundJumps+1;
	ENDCASE;
      ENDLOOP;
    END;

  CPass8: PROCEDURE [dStar: BOOLEAN] RETURNS [unboundJumps: CARDINAL] =
    BEGIN -- pass 8: resolve easy jumps
    c: CCIndex;
    min, max: CARDINAL;
    binder: PROCEDURE [min, max: INTEGER, c: JumpCCIndex] RETURNS [bindable: BOOLEAN] = IF dStar THEN
        P5F.BindJumpDStar
      ELSE P5F.BindJump;

    unboundJumps _ 0;
    IF dStar THEN P5F.FillInPCEstimatesDStar[]
    ELSE P5F.FillInPCEstimates[];
    FOR c _ cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump => IF ~fixedup THEN
	  BEGIN
	  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 ~binder[min, max, LOOPHOLE[c, JumpCCIndex]]
	      THEN unboundJumps _ unboundJumps+1;
	  END;
	ENDCASE;
      ENDLOOP;
    END;


  CPass9: PROCEDURE [dStar: BOOLEAN] =
    BEGIN   -- pass 9: resolve (remaining) jump instructions
    c: CCIndex;
    nbytes: CARDINAL;
    binder: PROCEDURE [min, max: INTEGER, c: JumpCCIndex] RETURNS [bindable: BOOLEAN] = IF dStar THEN
        P5F.BindJumpDStar
      ELSE P5F.BindJump;

    IF dStar THEN P5F.FillInPCEstimatesDStar[]
    ELSE P5F.FillInPCEstimates[];
    FOR c _ cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump =>
	  IF ~fixedup THEN
	      BEGIN
	      IF forward THEN 
	        BEGIN
		nbytes _ cb[destlabel].maxPC - maxPC;
	        END
	      ELSE
	        BEGIN 
	        nbytes _ maxPC - cb[destlabel].maxPC;
	        END;
	      [] _ binder[nbytes, nbytes, LOOPHOLE[c, JumpCCIndex]];
	      END;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;

  CPass10: PROCEDURE [dStar: BOOLEAN] =
    BEGIN -- pass 10: set pad field of chunks
    c: CCIndex;
    parity: [0..2] _ 0;
    cpad: [0..1];
    aligned: BOOLEAN;
    t: CARDINAL;

    FOR c _ cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      IF dStar THEN
	BEGIN cb[c].pad _ 0; LOOP END;
      WITH cc:cb[c] SELECT FROM
	code =>
	  BEGIN
	  t _ cc.isize;
	  aligned _ cc.aligned;
	  END;
	other => WITH cc SELECT FROM
	  table =>
	    BEGIN
	    t _ tablecodebytes;
	    aligned _ TRUE;
	    END;
	  ENDCASE =>
	    BEGIN
	    t _ 0;
	    aligned _ FALSE;
	    END;
	jump =>
	  IF cc.completed THEN BEGIN t _ 0; aligned _ FALSE END
	  ELSE
	    BEGIN
	    t _ cc.jsize;
	    aligned _  t > 1;
	    END;
        label =>
	  BEGIN
	  t _ 0;
	  aligned _ FALSE;
	  END;
	ENDCASE;
      parity _ (parity+t) MOD 2;
      IF aligned AND parity # 0 THEN 
	BEGIN
	cpad _ 1;
	parity _ 0;
	END
      ELSE cpad _ 0;
      cb[c].pad _ cpad;
      ENDLOOP;
    END;


  CPass11: PROCEDURE [dStar: BOOLEAN] =
    BEGIN   -- pass 11: code jumps
    c: CCIndex;
    coder: PROCEDURE [nbytes: INTEGER, c: JumpCCIndex] = IF dStar THEN
	P5F.CodeJumpDStar
      ELSE P5F.CodeJump;

    FillInPC[];
    FOR c _ cb[StartIndex].flink, cb[c].flink WHILE c # CCNull DO
      WITH cb[c] SELECT FROM
	jump =>
	  BEGIN
	  IF ~fixedup THEN SIGNAL CPtr.CodePassInconsistency 
	  ELSE coder[(IF forward THEN cb[destlabel].pc - pc
	    ELSE pc - cb[destlabel].pc), LOOPHOLE[c, JumpCCIndex]];
	  END;
	ENDCASE;
      ENDLOOP;
    RETURN
    END;


  DeleteLabel: PROCEDURE [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;
    P5U.DeleteCell[oldc];
    RETURN
    END;


  UnthreadJump: PUBLIC PROCEDURE [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;
    RETURN
    END;


  UCjump: PUBLIC PROCEDURE [c: CCIndex] RETURNS [BOOLEAN] =
    BEGIN -- predicate testing if c is an unconditonal jump
    WITH cb[c] SELECT FROM
      jump => RETURN[jtype = Jump];
      ENDCASE =>  RETURN[FALSE]
    END;


  Removeablejump: PROCEDURE [c: CCIndex] RETURNS [BOOLEAN] =
    BEGIN -- predicate testing if c is an unconditonal jump
    WITH cb[c] SELECT FROM
      jump => RETURN[(jtype = Jump OR jtype = JumpA OR jtype = JumpCA)];
      ENDCASE =>  RETURN[FALSE]
    END;


  FillInPC: PROCEDURE =
    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)
    k: CCIndex;
    rpc: RelativePC;
    nbytes: CARDINAL;

    rpc _ 0;
    FOR k _ StartIndex, cb[k].flink UNTIL k = CCNull DO
      nbytes _ cb[k].pad + (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 BEGIN cc.pc _ rpc; END;
	label => cc.pc _ rpc;
	ENDCASE;
      rpc _ rpc+nbytes;
      ENDLOOP;
    RETURN
    END;

  CodeJumpDist: PUBLIC PROCEDURE [jDist: INTEGER, l: [0..7], pad: [0..1], c: JumpCCIndex, dStar: BOOLEAN] =
    BEGIN -- code all jump instruction(s)
    OPEN Mopcodes, OpCodeParams;
    t: JumpType;
    RelJumpOps: ARRAY JumpType[JumpL..ZJumpN] OF AltoDefs.BYTE = [
      zJLB, zJGEB, zJGB, zJLEB, zJULB, zJUGEB, zJUGB, zJULEB,
      zJZEQB, zJZNEB];
  
    t _ cb[c].jtype;
    SELECT t FROM
     Jump, JumpA, JumpCA =>
      SELECT l FROM
       1 =>
        BEGIN
        IF jDist ~IN [2..9] THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C0[zJn+jDist-2];
        END;
       2 =>
        BEGIN
        IF jDist ~IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C1[zJB, jDist];
        cb[CPtr.codeptr].pad _ pad;
        END;
       ENDCASE =>
        BEGIN
        P5.C1W[zJW, jDist];
        cb[CPtr.codeptr].pad _ pad;
        END;
     JumpE, JumpN =>
      SELECT l FROM
       1 =>
        BEGIN
        IF jDist ~IN [2..9] THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C0[(IF t=JumpE THEN zJEQn ELSE zJNEn)+jDist-2];
        END;
       2 =>
        BEGIN
        IF jDist ~IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C1[(IF t = JumpE THEN zJEQB ELSE zJNEB), jDist];
        cb[CPtr.codeptr].pad _ pad;
        END;
       ENDCASE =>
        BEGIN
        P5.C0[(IF t = JumpE THEN zJNE4 ELSE zJEQ4)+pad];
        P5.C1W[zJW, jDist]; cb[CPtr.codeptr].pad _ pad;
        END;
     JumpC => NULL;
     ENDCASE =>
      SELECT l FROM
       2 =>
        BEGIN
        IF jDist ~IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
        P5.C1[RelJumpOps[t], jDist];
        cb[CPtr.codeptr].pad _ pad;
        END;
       ENDCASE =>
        BEGIN
        P5.C1[RelJumpOps[CJump[t]], 5]; cb[CPtr.codeptr].pad _ pad;
        P5.C1W[zJW, jDist]; cb[CPtr.codeptr].pad _ IF dStar THEN 0 ELSE 1;
        END;
    cb[c].completed _ TRUE;
    cb[c].pad _ 0; -- so it doesn't have to be ignored in ComputeJumpDistance
    cb[c].jsize _ 0; -- so it doesn't have to be ignored in ComputeJumpDistance
    RETURN
    END;
  

  END...