-- file: PeepholeQ.mesa
-- last edited by Sweet on August 22, 1980  4:12 PM
-- last edited by Satterthwaite on May 25, 1982 12:15 pm

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [CodeNotImplemented, CodePassInconsistency, codeptr],
  P5U: TYPE USING [DeleteCell],
  CodeDefs: TYPE USING [
    Base, CCIndex, CCNull, CodeCCIndex, codeType, JumpCCIndex, JumpType],
  FOpCodes: TYPE USING [
    qADD, qAMUL, qAND, qDADD, qDBL, qDEC, qDESCB, qDESCBS, qDIV, qDST,
    qDUP, qDWDC, qEFC, qEXCH, qFDESCBS, qGADRB, qINC, qIWDC, qKFCB,
    qLADRB, qLFC, qLG, qLGD, qLI, qLINKB, qLINT, qLL, qLLD, qLLK, qLST, qLSTF,
    qMUL, qNEG, qNOOP, qOR, qPL, qPOP, qPORTI, qPORTO, qPS, qPSD, qPSF, qPUSH,
    qR, qRD, qRET, qRF, qRFL, qRFS, qRIG, qRIGL, qRIL, qRILF, qRILL, qRL,
    qRSTR, qRSTRL, qRXG, qRXGL, qRXL, qRXLL, qSDIV, qSFC, qSG, qSGD, qSHIFT,
    qSL, qSLD, qSUB, qW, qWD, qWF, qWFL, qWIG, qWIGL, qWIL, qWILL, qWL, qWS,
    qWSD, qWSF, qWSTR, qWSTRL, qWXG, qWXGL, qWXL, qWXLL, qXOR],
  Inline: TYPE USING [BITAND, BITSHIFT],
  OpCodeParams: TYPE USING [Byte, GlobalHB, HB, LocalBase, LocalHB, LocalPutSlots],
  P5: TYPE USING [PopEffect, PushEffect, C0, C1, C2, LoadConstant],
  PeepholeDefs: TYPE USING [
    PeepZ, Delete2, Delete3, HalfByteGlobal, HalfByteLocal, InitJParametersBC,
    InitParameters, JumpPeepState, LoadInst, MC0, NextInteresting, PeepholeUNotify,
    PeepholeZNotify, PeepState, PrevInteresting, SetRealInst, SlidePeepState1,
    SlidePeepState2, UnpackFD],
  SDDefs: TYPE USING [sSignedDiv];

PeepholeQ: PROGRAM
    IMPORTS CPtr: Code, Inline, P5U, P5, PeepholeDefs
    EXPORTS CodeDefs, P5, PeepholeDefs =
  BEGIN OPEN PeepholeDefs, OpCodeParams, CodeDefs;

  -- imported definitions

  Byte: TYPE = OpCodeParams.Byte;
  qNOOP: Byte = FOpCodes.qNOOP;

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

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

  DummyProc: PROC =
    BEGIN -- every 2 minutes of compile time helps
    s: PeepState;
    js: JumpPeepState;
    IF FALSE THEN [] _ s;
    IF FALSE THEN [] _ js;
    END;

  PeepholeNotify: PUBLIC Alloc.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    cb _ base[codeType];
    PeepholeZNotify[base];  PeepholeUNotify[base];
    END;

  
  start: CodeCCIndex;

  PeepHole: PUBLIC PROC [s: CCIndex] =
    BEGIN
    start _ LOOPHOLE[s];
    SetRealInst[FALSE];
    Peep0[];
    Peep1[];
    Peep2[];
    Peep3[];
    Peep4[];
    Peep5[];
    Peep6[];
    Peep7[];
    SetRealInst[TRUE];
    PeepZ[start];
    END;

  BackupCP: PROC [n: INTEGER] RETURNS [INTEGER] =
    BEGIN OPEN FOpCodes; -- back up codeptr n stack positions
    cc: CCIndex _ CPtr.codeptr;
    netEffect: INTEGER;
    WHILE (cc _ cb[cc].blink) # CCNull AND n # 0 DO
      WITH cb[cc] SELECT FROM
	code =>
	  BEGIN
	  IF realinst THEN EXIT;
	  SELECT inst FROM
	    qEFC, qLFC, qSFC, qKFCB, qRET, qPORTO, qPORTI, qLST, qLSTF, qDST => EXIT;
	    ENDCASE;
	  netEffect _ P5.PushEffect[inst] - P5.PopEffect[inst];
	  IF n < netEffect THEN EXIT;
	  n _ n - netEffect;
	  END;
	other => IF otag = table THEN EXIT;
	ENDCASE => EXIT;
      ENDLOOP;
    CPtr.codeptr _ cc;
    RETURN [n]
    END;

  InsertPOP: PROC [n: INTEGER] =
    BEGIN OPEN FOpCodes; -- insert (or simulate) a POP of the word at tos-n
    saveCodePtr: CCIndex _ CPtr.codeptr;
    n _ BackupCP[n];
    SELECT n FROM
      0 => P5.C0[qPOP];
      1 => {P5.C0[qEXCH]; P5.C0[qPOP]};
      2 => {P5.C0[qPOP]; P5.C0[qEXCH]; P5.C0[qPUSH]; P5.C0[qEXCH]; P5.C0[qPOP]};
      3 =>
	BEGIN
	P5.C0[qPOP]; P5.C0[qPOP]; P5.C0[qEXCH]; P5.C0[qPUSH]; P5.C0[qEXCH];
	P5.C0[qPUSH]; P5.C0[qEXCH]; P5.C0[qPOP];
	END;
      ENDCASE => SIGNAL CPtr.CodePassInconsistency;
    CPtr.codeptr _ saveCodePtr;
    END;


  Peep0: PROC =
    BEGIN -- undo doubles
    OPEN FOpCodes;
    ci: CCIndex;
    state: PeepState;
    next: CCIndex _ start;
    UNTIL (ci _ next) = CCNull DO
      next _ NextInteresting[ci];
      WITH cb[ci] SELECT FROM
	code =>
	  BEGIN OPEN state;
	  InitParameters[@state, LOOPHOLE[ci], c];
	  SELECT cInst FROM
	    qLGD => {inst _ qLG; P5.C1[qLG, cP[1]+1]};
	    qLLD => {inst _ qLL; P5.C1[qLL, cP[1]+1]};
	    ENDCASE;
	  END; -- of OPEN state
	ENDCASE; -- of WITH
      ENDLOOP;
    END;

  Peep1: PROC =
    BEGIN -- remove POPs by modifying previous instruction
    OPEN FOpCodes;
    next, ci: CCIndex;
    changed: BOOLEAN _ TRUE;
    WHILE changed DO
      next _ start;
      changed _ FALSE;
      UNTIL (ci _ next) = CCNull DO
        next _ NextInteresting[ci];
        WITH cb[ci] SELECT FROM
	  code =>
	    IF inst = qPOP AND ~realinst THEN
              changed _ changed OR RemoveThisPop[ci];
	  ENDCASE;
        ENDLOOP;
      ENDLOOP;
    END;

  RemoveThisPop: PUBLIC PROC [ci: CCIndex] RETURNS [didThisTime: BOOLEAN] =
    BEGIN -- remove POP by modifying previous instruction, if possible
    OPEN FOpCodes;
    state: PeepState;
    didThisTime _ FALSE;
    WITH cb[ci] SELECT FROM
      code =>
        BEGIN OPEN state;
        InitParameters[@state, LOOPHOLE[ci], abc];
        SELECT cInst FROM
          qPOP =>
            IF Popable[bInst] THEN
              {P5U.DeleteCell[b]; P5U.DeleteCell[c]; didThisTime _ TRUE}
            ELSE
              SELECT bInst FROM
                qR, qRF, qRXL, qNEG, qDESCBS, qINC, qDEC =>
                  BEGIN
                  P5U.DeleteCell[b];
		 [] _ RemoveThisPop[c]; -- the blink may be popable now
		      -- above is unnecessary if called from Peep1
		      -- but useful if called from jump elimination
                  didThisTime _ TRUE;
                  END;
	        qRSTR, qADD, qSUB, qMUL, qAMUL, qDIV, qSDIV, qAND, qOR, qXOR,
		qSHIFT, qRFS, qRL, qRFL =>
		  BEGIN
		  np: CCIndex;
		  P5U.DeleteCell[b];
		  CPtr.codeptr _ cb[c].blink;
		  P5.C0[qPOP];
		  np _ CPtr.codeptr;
		  [] _ RemoveThisPop[np];  [] _ RemoveThisPop[c];
		  END;
                qDADD =>
                  IF Popable[aInst] THEN
                    BEGIN
                    Delete2[a,b];
                    InsertPOP[1];
                    MC0[qADD, bMin];
                    P5U.DeleteCell[c];
                    didThisTime _ TRUE;
                    END;
                qRD => {cb[b].inst _ qR; P5U.DeleteCell[c]; didThisTime _ TRUE};
                qIWDC, qDWDC => {CommuteCells[b,c]; didThisTime _ TRUE};
	        qEXCH => IF IsLoad[aInst] THEN
		  BEGIN
		  Delete2[b, c];
		  CPtr.codeptr _ cb[a].blink;
		  P5.C0[qPOP];
		  [] _ RemoveThisPop[CPtr.codeptr];
		  didThisTime _ TRUE;
		  END;
                ENDCASE;
          ENDCASE;
        END;
      ENDCASE; -- of WITH
    END;

  Popable: PROC [inst: Byte] RETURNS [BOOLEAN] =
    BEGIN
    RETURN [inst#qNOOP AND
      (P5.PopEffect[inst]=0 AND P5.PushEffect[inst]=1 OR inst = FOpCodes.qDUP)]
    END;

  IsLoad: PROC [inst: Byte] RETURNS [BOOLEAN] =
    BEGIN
    RETURN [inst#qNOOP AND inst # FOpCodes.qPUSH AND
      (P5.PopEffect[inst]=0 AND P5.PushEffect[inst]=1)]
    END;

  Peep2: PROC =
    BEGIN -- expand families
    OPEN FOpCodes;
    ci: CCIndex;
    next: CCIndex _ start;
    state: PeepState;
    canSlide: BOOLEAN _ FALSE;
    UNTIL (ci _ next) = CCNull DO
      next _ NextInteresting[ci];
      WITH cb[ci] SELECT FROM
	code =>
	  BEGIN OPEN state;
	  IF canSlide THEN SlidePeepState2[@state, LOOPHOLE[ci]]
	  ELSE InitParameters[@state, LOOPHOLE[ci], abc];
	  canSlide _ FALSE;
	  SELECT cInst FROM
	    -- expand out-of-range families
	    qEFC, qLLK =>
	      BEGIN
	      IF cP[1] NOT IN Byte THEN SIGNAL CPtr.CodeNotImplemented;
	      canSlide _ TRUE;
	      END;
	    qLINKB =>
	      IF cP[1] IN Byte THEN canSlide _ TRUE
	      ELSE
		BEGIN
		cb[c].parameters[1] _ 377B;
		P5.C1[qLL, LocalBase];
		P5.LoadConstant[cP[1]-377B];
		P5.C0[qSUB]; P5.C1[qSL, LocalBase];
		END;
	    qDESCBS, qDESCB, qFDESCBS =>
	      BEGIN
	      parameters[1] _ cP[1]*2;
	      IF cInst = qFDESCBS THEN {inst _ qDESCBS; P5.C0[qSFC]};
	      END;
	    qSDIV => {P5.C1[qKFCB, SDDefs.sSignedDiv]; P5U.DeleteCell[c]};
	    qDEC =>
	      IF cMin THEN {P5.LoadConstant[0-1]; MC0[qADD, TRUE]; P5U.DeleteCell[c]}
	      ELSE {P5.LoadConstant[1]; P5.C0[qSUB]; P5U.DeleteCell[c]};
	    qLINT =>
	      BEGIN
	      P5.C0[qDUP];
	      P5.LoadConstant[0-15];
	      P5.C0[qSHIFT];
	      P5.C0[qNEG];
	      P5U.DeleteCell[c];
	      END;
	    qGADRB, qLADRB =>
	      IF cP[1] IN Byte THEN canSlide _ TRUE
	      ELSE
		BEGIN
		parameters[1] _ LAST[Byte];
		P5.LoadConstant[cP[1]-LAST[Byte]]; P5.C0[qADD];
		END;
	    qWS, qPS, qWSF, qPSF, qWSD, qPSD =>
	      BEGIN
	      IF cP[1] NOT IN Byte THEN SIGNAL CPtr.CodePassInconsistency;
	      canSlide _ TRUE;
	      END;
	    -- discover family members from sequences
	    qR =>
	      IF cP[1] IN HB THEN
		SELECT bInst FROM
		  qADD =>
		    IF HalfByteLocal[a] THEN {P5.C2[qRXL, aP[1], cP[1]]; Delete3[a,b,c]}
		    ELSE canSlide _ TRUE;
		  qLL =>
		    IF bP[1] IN LocalHB THEN {P5.C2[qRIL, bP[1], cP[1]]; Delete2[b,c]}
		    ELSE canSlide _ TRUE;
		  qLG =>
		    IF bP[1] IN GlobalHB THEN {P5.C2[qRIG, bP[1], cP[1]]; Delete2[b,c]}
		    ELSE canSlide _ TRUE;
		  ENDCASE => canSlide _ TRUE
	      ELSE canSlide _ TRUE;
	    qW =>
	      IF cP[1] IN HB THEN
		SELECT bInst FROM
		  qADD =>
		    IF HalfByteLocal[a] THEN {P5.C2[qWXL, aP[1], cP[1]]; Delete3[a,b,c]}
		    ELSE canSlide _ TRUE;
		  qLL =>
		    IF bP[1] IN LocalHB THEN {P5.C2[qWIL, bP[1], cP[1]]; Delete2[b,c]}
		    ELSE canSlide _ TRUE;
		  ENDCASE => canSlide _ TRUE
	      ELSE canSlide _ TRUE;
	    qRL =>
	      IF cP[1] IN HB THEN
		SELECT bInst FROM
		  qADD =>
		    IF aInst = qLI AND aP[1] = 0 THEN
		      BEGIN
		      aa: CCIndex = PrevInteresting[a];
		      IF aa # CCNull THEN WITH cc: cb[aa] SELECT FROM
		        code => IF HalfByteLocal[LOOPHOLE[aa]] THEN
			  BEGIN
			  P5.C2[qRXLL, cc.parameters[1], cP[1]];
			  Delete3[a,b,c]; P5U.DeleteCell[aa];
			  END
			ELSE IF HalfByteGlobal[LOOPHOLE[aa]] THEN
			  BEGIN
			  P5.C2[qRXGL, cc.parameters[1], cP[1]];
			  Delete3[a,b,c]; P5U.DeleteCell[aa];
			  END
			ELSE canSlide _ TRUE;
			ENDCASE
		      ELSE canSlide _ TRUE;
		      END
		    ELSE canSlide _ TRUE;
		  qLL =>
		    IF aInst = qLL AND aP[1] IN LocalHB AND bP[1] = aP[1]+1 THEN
		      {P5.C2[qRILL, aP[1], cP[1]]; Delete3[a,b,c]}
		    ELSE canSlide _ TRUE;
		  qLG =>
		    IF aInst = qLL AND aP[1] IN GlobalHB AND bP[1] = aP[1]+1 THEN
		      {P5.C2[qRIGL, aP[1], cP[1]]; Delete3[a,b,c]}
		    ELSE canSlide _ TRUE;
		  ENDCASE => canSlide _ TRUE
	      ELSE canSlide _ TRUE;
	    qWL =>
	      IF cP[1] IN HB THEN
		SELECT bInst FROM
		  qADD =>
		    IF aInst = qLI AND aP[1] = 0 THEN
		      BEGIN
		      aa: CCIndex = PrevInteresting[a];
		      IF aa # CCNull THEN WITH cc: cb[aa] SELECT FROM
		        code => IF HalfByteLocal[LOOPHOLE[aa]] THEN
			  BEGIN
			  P5.C2[qWXLL, cc.parameters[1], cP[1]];
			  Delete3[a,b,c]; P5U.DeleteCell[aa];
			  END
			ELSE IF HalfByteGlobal[LOOPHOLE[aa]] THEN
			  BEGIN
			  P5.C2[qWXGL, cc.parameters[1], cP[1]];
			  Delete3[a,b,c]; P5U.DeleteCell[aa];
			  END
			ELSE canSlide _ TRUE;
			ENDCASE
		      ELSE canSlide _ TRUE;
		      END
		    ELSE canSlide _ TRUE;
		  qLL =>
		    IF aInst = qLL AND aP[1] IN LocalHB AND bP[1] = aP[1]+1 THEN
		      {P5.C2[qWILL, aP[1], cP[1]]; Delete3[a,b,c]}
		    ELSE canSlide _ TRUE;
		  qLG =>
		    IF aInst = qLL AND aP[1] IN GlobalHB AND bP[1] = aP[1]+1 THEN
		      {P5.C2[qWIGL, aP[1], cP[1]]; Delete3[a,b,c]}
		    ELSE canSlide _ TRUE;
		  ENDCASE => canSlide _ TRUE
	      ELSE canSlide _ TRUE;
	    qRXG =>
	      IF TRUE THEN
		BEGIN
		P5.C1[qLG, cP[1]]; MC0[qADD, cMin]; P5.C1[qR, cP[2]];
		P5U.DeleteCell[c];
		END;
	    qWXG =>
	      IF TRUE THEN
		BEGIN
		P5.C1[qLG, cP[1]]; P5.C0[qADD]; P5.C1[qW, cP[2]];
		P5U.DeleteCell[c];
		END;
	    qWIG =>
	      IF TRUE THEN
		{P5.C1[qLG, cP[1]]; P5.C1[qW, cP[2]]; P5U.DeleteCell[c]};
	    qRILF =>
	      IF TRUE THEN
		BEGIN
		P5.C1[qLL, cP[1]]; P5.C2[qRF, cP[2], cP[3]];
		P5U.DeleteCell[c];
		END;
	    ENDCASE => canSlide _ TRUE;
	  END; -- of OPEN state
	ENDCASE => canSlide _ FALSE; -- of WITH
      ENDLOOP;
    END;

  Peep3: PROC =
    BEGIN -- sprinkle DUPs
    OPEN FOpCodes;
    ci: CCIndex;
    next: CCIndex _ start;
    state: PeepState;
    canSlide: BOOLEAN _ FALSE;
    UNTIL (ci _ next) = CCNull DO
      next _ NextInteresting[ci];
      WITH cb[ci] SELECT FROM
	code =>
	  BEGIN OPEN state;
	  IF canSlide THEN SlidePeepState2[@state, LOOPHOLE[ci]]
	  ELSE InitParameters[@state, LOOPHOLE[ci], abc];
	  canSlide _ TRUE;
	  IF bInst = cInst THEN
	    -- replace load,load with load,DUP
	    SELECT cInst FROM
	      qLL, qLG, qLI =>
		IF cP[1] = bP[1] THEN {P5.C0[qDUP]; P5U.DeleteCell[c]; canSlide _ FALSE};
	      qRIL, qRIG, qRILL, qRIGL =>
		IF cP[1] = bP[1] AND cP[2] = bP[2] THEN
		  {P5.C0[qDUP]; P5U.DeleteCell[c]; canSlide _ FALSE};
	      ENDCASE;
	  END; -- of OPEN state
	ENDCASE => canSlide _ FALSE; -- of WITH
      ENDLOOP;
    END;

  Peep4: PROC =
    BEGIN -- PUTs and PUSHs, RF and WF to RSTR and WSTR
    OPEN FOpCodes;
    ci: CCIndex;
    next: CCIndex _ start;
    state: PeepState;
    canSlide: BOOLEAN _ FALSE;
    UNTIL (ci _ next) = CCNull DO
      next _ NextInteresting[ci];
      WITH cb[ci] SELECT FROM
	code =>
	  BEGIN OPEN state;
	  IF canSlide THEN SlidePeepState2[@state, LOOPHOLE[ci]]
	  ELSE InitParameters[@state, LOOPHOLE[ci], abc];
	  canSlide _ FALSE;
	  SELECT cInst FROM
	    qLL =>
	      IF bInst = qSL AND cP[1] = bP[1] THEN
		IF cP[1] IN LocalPutSlots THEN
		  {cb[b].inst _ qPL; P5U.DeleteCell[c]}
		ELSE {CPtr.codeptr _ b; P5.C0[qPUSH]; P5U.DeleteCell[c]}
	      ELSE canSlide _ TRUE;
	    qPUSH =>
	      IF bInst = qSL AND bP[1] IN LocalPutSlots THEN
		{cb[b].inst _ qPL; P5U.DeleteCell[c]}
	      ELSE canSlide _ TRUE;
	    qLG =>
	      IF bInst = qSG AND cP[1] = bP[1] THEN
		{CPtr.codeptr _ b; P5.C0[qPUSH]; P5U.DeleteCell[c]}
	      ELSE canSlide _ TRUE;
	    qRIL =>
	      IF bInst = qWIL AND cP[1] = bP[1] AND cP[2] = bP[2] THEN
		{CPtr.codeptr _ b; P5.C0[qPUSH]; P5U.DeleteCell[c]}
	      ELSE canSlide _ TRUE;
	    qRILL =>
	      IF bInst = qWILL AND cP[1] = bP[1] AND cP[2] = bP[2] THEN
		{CPtr.codeptr _ b; P5.C0[qPUSH]; P5U.DeleteCell[c]}
	      ELSE canSlide _ TRUE;
	    qRIGL =>
	      IF bInst = qWIGL AND cP[1] = bP[1] AND cP[2] = bP[2] THEN
		{CPtr.codeptr _ b; P5.C0[qPUSH]; P5U.DeleteCell[c]}
	      ELSE canSlide _ TRUE;
	    qRF, qWF, qRFL, qWFL =>
	      BEGIN
	      position, size: [0..16);
	      [position, size] _ UnpackFD[LOOPHOLE[cP[2]]];
	      IF size = 8 AND cP[1] <= LAST[Byte]/2 THEN
		SELECT position FROM
		  0, 8 => 
		    BEGIN 
		    P5.LoadConstant[0];
		    P5.C1[(SELECT cInst FROM
		      qRF => qRSTR,
		      qWF => qWSTR,
		      qRFL => qRSTRL,
		      ENDCASE => qWSTRL), cP[1]*2+position/8];
		    P5U.DeleteCell[c];
		    END;
		  ENDCASE => canSlide _ TRUE
	      ELSE canSlide _ TRUE; 
	      END;
	    ENDCASE => canSlide _ TRUE;
	  END; -- of OPEN state
	ENDCASE => canSlide _ FALSE; -- of WITH
      ENDLOOP;
    END;

  NonWS: ARRAY [FOpCodes.qWS..FOpCodes.qWSD] OF Byte = [
	FOpCodes.qW, FOpCodes.qWF, FOpCodes.qWD];

  Peep5: PROC =
    BEGIN -- put doubles back, eliminate EXCH preceding commutative operator
    OPEN FOpCodes;
    ci: CCIndex;
    next: CCIndex _ start;
    state: PeepState;
    canSlide: BOOLEAN _ FALSE;
    UNTIL (ci _ next) = CCNull DO
      next _ NextInteresting[ci];
      WITH cc:cb[ci] SELECT FROM
	code =>
	  BEGIN OPEN state;
	  IF canSlide THEN SlidePeepState2[@state, LOOPHOLE[ci]]
	  ELSE InitParameters[@state, LOOPHOLE[ci], abc];
	  canSlide _ FALSE;
	  SELECT cInst FROM
	    qLL =>
	      IF bInst = qLL AND cP[1] = bP[1]+1 THEN
		{cb[b].inst _ qLLD; P5U.DeleteCell[c]}
	      ELSE GO TO Slide;
	    qSL =>
	      IF bInst = qSL AND cP[1] = bP[1]-1 THEN
		{cb[c].inst _ qSLD; P5U.DeleteCell[b]}
	      ELSE GO TO Slide;
	    qLG =>
	      IF bInst = qLG AND cP[1] = bP[1]+1 THEN
		{cb[b].inst _ qLGD; P5U.DeleteCell[c]}
	      ELSE GO TO Slide;
	    qSG =>
	      IF bInst = qSG AND cP[1] = bP[1]-1 THEN
		{cb[c].inst _ qSGD; P5U.DeleteCell[b]}
	      ELSE GO TO Slide;
	    qADD, qMUL, qAND, qOR, qXOR =>
	      IF bInst = qEXCH THEN P5U.DeleteCell[b] ELSE GO TO Slide;
	    qWS, qWSF, qWSD =>
	      IF bInst = qEXCH AND ~NextIsPush[c] THEN 
		{P5U.DeleteCell[b]; cc.inst _ NonWS[cInst]}
	      ELSE GO TO Slide;
	    qEXCH =>
	      IF bInst = qEXCH THEN Delete2[b,c]
	      ELSE IF LoadInst[b] AND LoadInst[a] THEN
		BEGIN
		P5U.DeleteCell[c];
		CommuteCells[a,b];
		cb[a].minimalStack _ bMin;
		cb[b].minimalStack _ aMin;
		END
	      ELSE GO TO Slide;
	    ENDCASE => GO TO Slide;
	  EXITS
	    Slide => canSlide _ TRUE;
	  END; -- of OPEN state
	jump =>
	  BEGIN
	  canSlide _ FALSE;
	  IF cc.jtype IN [JumpE..UJumpLE] THEN
	    BEGIN
	    prev: CCIndex _ PrevInteresting[ci];
	    WITH cb[prev] SELECT FROM
	      code =>
		IF ~realinst AND inst = qEXCH AND
		 ~PushFollows[LOOPHOLE[ci,JumpCCIndex]] THEN 
		  {P5U.DeleteCell[prev]; cc.jtype _ RJump[cc.jtype]};
	      ENDCASE;
	    END;
	  END;
	ENDCASE => canSlide _ FALSE; -- of WITH
      ENDLOOP;
    END;

  PushFollows: PROC [c: JumpCCIndex] RETURNS [BOOLEAN] =
    BEGIN -- c is conditional jump; TRUE if PUSH follows on either branch
    next: CCIndex;
    FOR next _ NextInteresting[c], NextInteresting[next] WHILE next # CCNull DO
      WITH cb[next] SELECT FROM
        code => IF ~realinst AND inst = FOpCodes.qPUSH THEN RETURN [TRUE]
		ELSE EXIT;
	label => NULL;
        ENDCASE => EXIT;
      ENDLOOP;
    IF (next_NextInteresting[cb[c].destlabel]) # CCNull THEN
      WITH cb[next] SELECT FROM
        code => IF ~realinst AND inst = FOpCodes.qPUSH THEN RETURN [TRUE];
        ENDCASE;
    RETURN [FALSE]
    END;

  NextIsPush: PROC [c: CCIndex] RETURNS [BOOLEAN] =
    BEGIN -- c is conditional jump; TRUE if PUSH follows on either branch
    FOR next: CCIndex _ NextInteresting[c], NextInteresting[next] WHILE next # CCNull DO
      WITH cb[next] SELECT FROM
        code => IF ~realinst AND inst = FOpCodes.qPUSH THEN RETURN [TRUE]
		ELSE EXIT;
	label => NULL;
        ENDCASE => EXIT;
      ENDLOOP;
    RETURN [FALSE]
    END;

  CommuteCells: PROC [a, b: CCIndex] =
    BEGIN -- could be a "source other CCItem" between,
    --  in any case, move a to after b
    --  see 3/5/80 notes for rationale
    aPrev: CCIndex = cb[a].blink; -- never Null
    aNext: CCIndex = cb[a].flink; -- probably b
    bPrev: CCIndex = cb[b].blink; -- probably a
    bNext: CCIndex = cb[b].flink;
    cb[aPrev].flink _ aNext;
    cb[aNext].blink _ aPrev;
    cb[b].flink _ a;
    cb[a].blink _ b;  cb[a].flink _ bNext;
    IF bNext # CCNull THEN cb[bNext].blink _ a;
    END;

  Peep6: PROC =
    BEGIN -- store double/load double, INC and DEC, MUL to SHIFT etc
    OPEN FOpCodes;
    ci: CCIndex;
    next: CCIndex _ start;
    canSlide: BOOLEAN _ FALSE;
    state: PeepState;
    negate: BOOLEAN;

    D2: PROC = {Delete2[state.b, state.c]; IF negate THEN P5.C0[qNEG]};

    UNTIL (ci _ next) = CCNull DO
      next _ NextInteresting[ci];
      WITH cb[ci] SELECT FROM
	code =>
	  BEGIN OPEN state;
	  IF canSlide THEN SlidePeepState1[@state, LOOPHOLE[ci]]
	  ELSE InitParameters[@state, LOOPHOLE[ci], bc];
	  canSlide _ FALSE;
	  SELECT cInst FROM
	    qLLD =>
	      IF bInst = qSLD AND cP[1] = bP[1] THEN
		BEGIN
		CPtr.codeptr _ b;
		IF cP[1] IN LocalPutSlots THEN
		  {P5.C1[qSL, cP[1]+1]; P5.C1[qPL, cP[1]]; P5.C0[qPUSH]; Delete2[b,c]}
		ELSE {P5.C0[qPUSH]; P5.C0[qPUSH]; P5U.DeleteCell[c]};
		END
	      ELSE GO TO Slide;
	    qLGD =>
	      IF bInst = qSGD AND cP[1] = bP[1] THEN
		{CPtr.codeptr _ b; P5.C0[qPUSH]; P5.C0[qPUSH]; P5U.DeleteCell[c]}
	      ELSE GO TO Slide;
	    qADD, qSUB =>
	      IF bInst = qLI THEN
		BEGIN
		SELECT LOOPHOLE[bP[1], INTEGER] FROM
		  0 => Delete2[b,c];
		  1 => IF cInst = qADD THEN {cb[c].inst _ qINC; P5U.DeleteCell[b]};
		  -1 => IF cInst = qSUB THEN {cb[c].inst _ qINC; P5U.DeleteCell[b]};
		  ENDCASE => GO TO Slide;
		END 
	      ELSE IF bInst = qNEG THEN
		{cb[c].inst _ IF cInst = qADD THEN qSUB ELSE qADD; P5U.DeleteCell[b]}
	      ELSE GO TO Slide;
	    qSHIFT =>
	      IF bInst = qLI THEN
		SELECT bP[1] FROM
		  1 => {cb[c].inst _ qDBL; P5U.DeleteCell[b]};
		  0 => Delete2[b,c];
		  ENDCASE => GO TO Slide
	      ELSE GO TO Slide;
	    qMUL =>
	      IF bInst = qLI THEN
		BEGIN
		negate _ FALSE;
		IF LOOPHOLE[bP[1], INTEGER] < 0 THEN
		  {negate _ TRUE; bP[1] _ -LOOPHOLE[bP[1], INTEGER]};
		SELECT bP[1] FROM
		  1 => D2[];
		  2 => {P5.C0[qDBL]; D2[]};
		  3 => {P5.C0[qDUP]; P5.C0[qDBL]; MC0[qADD, cMin]; D2[]};
		  4 => {P5.C0[qDBL]; P5.C0[qDBL]; D2[]};
		  5 => {P5.C0[qDUP]; P5.C0[qDBL]; P5.C0[qDBL]; MC0[qADD, cMin]; D2[]};
		  6 => {P5.C0[qDBL]; P5.C0[qDUP]; P5.C0[qDBL]; MC0[qADD, cMin]; D2[]};
		  ENDCASE =>
		    BEGIN
		    powerOf2: BOOLEAN;
		    log: CARDINAL;
		    [powerOf2, log] _ Log2[LOOPHOLE[bP[1]]];
		    IF powerOf2 THEN {P5.LoadConstant[log]; P5.C0[qSHIFT]; D2[]}
		    ELSE GO TO Slide;
		    END;
		END;
	    ENDCASE => GO TO Slide;
	  EXITS
	    Slide => canSlide _ TRUE;
	  END; -- of OPEN state
	ENDCASE => canSlide _ FALSE; -- of WITH
      ENDLOOP;
    END;

  Log2: PROC [i: INTEGER] RETURNS [BOOLEAN, CARDINAL] =
    BEGIN OPEN Inline;
    IF i = 0 THEN RETURN [FALSE, 0];
    i _ ABS[i];
    IF BITAND[i, i-1] # 0 THEN RETURN [FALSE, 0];
    FOR shift: CARDINAL IN [0..16) DO
      IF BITAND[i,1] = 1 THEN RETURN [TRUE, shift];
      i _ BITSHIFT[i, -1];
      ENDLOOP;
    ERROR -- can't be reached
    END;


  Peep7: PROC =
    BEGIN -- find special jumps
    OPEN FOpCodes;
    ci: CCIndex;
    next: CCIndex _ start;
    jstate: JumpPeepState;
    UNTIL (ci _ next) = CCNull DO
      next _ NextInteresting[ci];
      WITH cb[ci] SELECT FROM
	jump =>
	  BEGIN OPEN jstate;
	  InitJParametersBC[@jstate, LOOPHOLE[ci]];
	  SELECT jtype FROM
	    JumpE =>
	      IF bInst = qLI AND bP[1] = 0 THEN {jtype _ ZJumpE; P5U.DeleteCell[b]};
	    JumpN =>
	      IF bInst = qLI AND bP[1] = 0 THEN {jtype _ ZJumpN; P5U.DeleteCell[b]};
	    ENDCASE;
	  END; -- of OPEN jstate
	ENDCASE; -- of WITH
      ENDLOOP;
    END;

  END.