-- file: PeepholeQ.mesa
-- last edited by Sweet on August 22, 1980 4:12 PM
-- last edited by Satterthwaite on November 2, 1982 3:57 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, 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: BOOL ← 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: BOOL] =
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];
P5.C0[qADD];
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 [BOOL] =
BEGIN
RETURN [inst#qNOOP AND
(P5.PopEffect[inst]=0 AND P5.PushEffect[inst]=1 OR inst = FOpCodes.qDUP)]
END;

IsLoad: PROC [inst: Byte] RETURNS [BOOL] =
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: BOOL ← 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 => {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] ← Byte.LAST;
  P5.LoadConstant[cP[1]-Byte.LAST]; 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]]; P5.C0[qADD]; 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: BOOL ← 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: BOOL ← 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] <= Byte.LAST/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: BOOL ← 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];
  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 [BOOL] =
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 [BOOL] =
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: BOOL ← FALSE;
state: PeepState;
negate: BOOL;

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]; P5.C0[qADD]; D2[]};
   4 => {P5.C0[qDBL]; P5.C0[qDBL]; D2[]};
   5 => {P5.C0[qDUP]; P5.C0[qDBL]; P5.C0[qDBL]; P5.C0[qADD]; D2[]};
   6 => {P5.C0[qDBL]; P5.C0[qDUP]; P5.C0[qDBL]; P5.C0[qADD]; D2[]};
   ENDCASE =>
   BEGIN
   powerOf2: BOOL;
   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 [BOOL, 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.