
<<file: PeepholeQ.mesa>>
<<last edited by Sweet on  5-Oct-82 11:26:03>>
<<last edited by Satterthwaite on December 5, 1985 10:04:36 am PST>>

DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [BITAND, BITSHIFT],
Code: TYPE USING [CodePassInconsistency, codeptr],
CodeDefs: TYPE USING [
Base, CCIndex, CCNull, CodeCCIndex, codeType, JumpCCIndex, JumpType],
FOpCodes: TYPE USING [
qACD, qADC, qADD, qADDSB, qAL0IB, qAMUL, qAND, qDADD, qDBL,
qDBS, qDDBL, qDDUP, qDEC, qDI, qDINC, qDIS, qDIS2, qDMUL, qDSHIFT,
qDSK, qDSUB, qDUDIV, qDUP, qEFC, qEI, qEXCH, qEXDIS, qGA, qINC,
qIOR, qKFCB, qLA, qLFC, qLG, qLGD, qLI, qLID, qLL, qLLD, qLLK, qLP,
qLSTE, qLSTF, qMUL, qNEG, qNULL, qPI, qPL, qPLD, qPO, qPS, 
qPSCDL, qPSCIDL, qPSD, qPSDL, qPSF, qPSL, qPSLF, qR, qRD, qRDL,
qREC, qREC2, qRET, qRF, qRGDI, qRGDIL, qRGI, qRGIL, qRGILF,
qRKDI, qRKI, qRL, qRLDI, qRLDIL, qRLF, qRLI, qRLIF, qRLIL, qRLILF,
qRSTR, qRSTRL, qSDIV, qSFC, qSG, qSGD, qSHIFT, qSHIFTSB, qSL, qSLD,
qSUB, qTRPL, qUDIV, qWDL, qWF, qWGDI, qWGDIL, qWGI, qWGIL, qWGILF,
qWL, qWLDI, qWLDIL, qWLF, qWLI, qWLIL, qWLILF, qWS, qWSCDL,
qWSCIDL, qWSD, qWSDL, qWSF,  qWSL, qWSLF, qWSTR, qWSTRL, qXOR],
OpCodeParams: TYPE USING [BYTE, GlobalHB, HB, LocalBase, LocalHB],
P5: TYPE USING [PopEffect, PushEffect, C0, C1, C2, C3, LoadConstant],
P5U: TYPE USING [DeleteCell],
PeepholeDefs: TYPE USING [
ConsPeepState, DblLoadInst, Delete2, Delete3, InitConsState, InitJParametersBC,
InitParameters, JumpPeepState, LoadInst, NextInteresting, NextIsPush, PeepholeANotify,
PeepholeUNotify, PeepholeZNotify, Peep1, Peep2, Peep10, PeepState, PeepZ,
SetRealInst, SlideConsState, SlidePeepState2, UnpackFD],
PrincOps: TYPE USING [FieldDescriptor];

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

<<imported definitions>>

BYTE: TYPE = OpCodeParams.BYTE;
qNULL: BYTE = FOpCodes.qNULL;

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

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];
PeepholeANotify[base];  PeepholeZNotify[base];  PeepholeUNotify[base];
END;


start: PUBLIC CodeCCIndex;

PeepHole: PUBLIC PROC [s: CCIndex] =
BEGIN
start _ LOOPHOLE[s];
SetRealInst[FALSE];
Peep0[]; -- remove POPs by modifying previous instruction
Peep1[]; -- expand families
Peep2[]; -- discover short magic
Peep5[]; -- discover long magic
Peep3[]; -- discover doubles (shouldn't uncover any long magic)
Peep4[]; -- long arithmetic: INC and DEC, MUL to SHIFT etc
Peep5a[]; -- constructor stuff
Peep3[]; -- discover doubles again (5a may have uncovered some)
Peep6[]; -- sprinkle single DUPs
Peep7[]; -- sprinkle double DUPs
Peep8[]; -- PUTs and PUSHs, RF and WF to RSTR and WSTR
Peep9[]; -- long PUTs and PUSHs
Peep10[]; -- expand unimplemented magic
Peep11[]; -- short arithmetic: INC and DEC, MUL to SHIFT etc
Peep13[]; -- find special jumps
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, qPO, qPI, qLSTE, qLSTF, qDSK => 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[qDIS];
1 => {P5.C0[qEXCH]; P5.C0[qDIS]};
2 => {P5.C0[qDIS]; P5.C0[qEXCH]; P5.C0[qREC]; P5.C0[qEXCH]; P5.C0[qDIS]};
3 =>
BEGIN
P5.C0[qDIS]; P5.C0[qDIS]; P5.C0[qEXCH]; P5.C0[qREC]; P5.C0[qEXCH];
P5.C0[qREC]; P5.C0[qEXCH]; P5.C0[qDIS];
END;
ENDCASE => SIGNAL CPtr.CodePassInconsistency;
CPtr.codeptr _ saveCodePtr;
END;

Peep0: PUBLIC 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 ~realinst THEN SELECT inst FROM
qDIS => changed _ changed OR RemoveThisPop[ci];
qDIS2 => {
inst _ qDIS;
CPtr.codeptr _ ci; P5.C0[qDIS];
next _ CPtr.codeptr;
changed _ changed OR RemoveThisPop[ci]};
ENDCASE;
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
qDIS =>
IF Popable[bInst] THEN
{P5U.DeleteCell[b]; P5U.DeleteCell[c]; didThisTime _ TRUE}
ELSE
SELECT bInst FROM
qR, qRF, qNEG, qDBS, 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, qUDIV, qSDIV, qAND, qIOR, qXOR,
qSHIFT, qRL, qRLF =>
BEGIN
np: CCIndex;
P5U.DeleteCell[b];
CPtr.codeptr _ cb[c].blink;
P5.C0[qDIS];
np _ CPtr.codeptr;
[] _ RemoveThisPop[np];  [] _ RemoveThisPop[c];
END;
<<should add arm for RLFS>>
qDADD =>
IF Popable[aInst] THEN
BEGIN
Delete2[a,b];
InsertPOP[1];
P5.C0[qADD];
P5U.DeleteCell[c];
didThisTime _ TRUE;
END;
qLGD => {cb[b].inst _ qLG; P5U.DeleteCell[c]; didThisTime _ TRUE};
qLLD => {cb[b].inst _ qLL; P5U.DeleteCell[c]; didThisTime _ TRUE};
qLID => {cb[b].inst _ qLI; P5U.DeleteCell[c]; didThisTime _ TRUE};
qRD => {cb[b].inst _ qR; P5U.DeleteCell[c]; didThisTime _ TRUE};
qRDL => {cb[b].inst _ qRL; P5U.DeleteCell[c]; didThisTime _ TRUE};
qRGDI => {
cb[b].inst _ qRGI; P5U.DeleteCell[c]; didThisTime _ TRUE};
qRGDIL => {
cb[b].inst _ qRGIL; P5U.DeleteCell[c]; didThisTime _ TRUE};
qRKDI => {
cb[b].inst _ qRKI; P5U.DeleteCell[c]; didThisTime _ TRUE};
qRLDI => {
cb[b].inst _ qRLI; P5U.DeleteCell[c]; didThisTime _ TRUE};
qRLDIL => {
cb[b].inst _ qRLIL; P5U.DeleteCell[c]; didThisTime _ TRUE};
qDI, qEI => {CommuteCells[b,c]; didThisTime _ TRUE};
<<could handle qACD and qADC when have more time to think thru>>
qEXCH => 
IF IsLoad[aInst] THEN
BEGIN
Delete2[b, c];
CPtr.codeptr _ cb[a].blink;
P5.C0[qDIS];
[] _ RemoveThisPop[CPtr.codeptr];
didThisTime _ TRUE;
END
ELSE {cb[c].inst _ qEXDIS; P5U.DeleteCell[b]; didThisTime _ TRUE};
ENDCASE;
ENDCASE;
END;
ENDCASE; -- of WITH
END;

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

IsLoad: PROC [inst: BYTE] RETURNS [BOOL] =
BEGIN
RETURN [inst#qNULL AND inst # FOpCodes.qREC AND
(P5.PopEffect[inst]=0 AND P5.PushEffect[inst]=1)]
END;

Peep5: PUBLIC PROC =
BEGIN -- discover long magic
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
<<discover family members from sequences>>
qRL =>
IF cP[1] IN HB THEN
SELECT bInst FROM
qLLD =>
IF -- RiImplemented[read][local][long][single] AND
bP[1] IN LocalHB THEN 
{P5.C2[qRLIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
qLGD =>
IF -- RiImplemented[read][global][long][single] AND
bP[1] IN GlobalHB THEN 
{P5.C2[qRGIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
qWL =>
IF cP[1] IN HB THEN
SELECT bInst FROM
qLLD =>
IF -- RiImplemented[write][local][long][single] AND
bP[1] IN LocalHB THEN 
{P5.C2[qWLIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
qLGD =>
IF -- RiImplemented[write][global][long][single] AND
bP[1] IN GlobalHB THEN 
{P5.C2[qWGIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
qRDL =>
IF cP[1] IN HB THEN
SELECT bInst FROM
qLLD =>
IF -- RiImplemented[read][local][long][double] AND
bP[1] IN LocalHB THEN 
{P5.C2[qRLDIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
qLGD =>
IF -- RiImplemented[read][global][long][double] AND
bP[1] IN GlobalHB THEN 
{P5.C2[qRGDIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
qWDL =>
IF cP[1] IN HB THEN
SELECT bInst FROM
qLLD =>
IF -- RiImplemented[write][local][long][double] AND
bP[1] IN LocalHB THEN 
{P5.C2[qWLDIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
qLGD =>
IF -- RiImplemented[write][global][long][double] AND
bP[1] IN GlobalHB THEN 
{P5.C2[qWGDIL, bP[1], cP[1]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
qRLF =>
IF cP[1] IN HB THEN
SELECT bInst FROM
qLLD =>
IF -- RiImplemented[read][local][long][field] AND
bP[1] IN LocalHB THEN 
{P5.C3[qRLILF, bP[1], cP[1], cP[2]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
qLGD =>
IF -- RiImplemented[read][global][long][field] AND
bP[1] IN GlobalHB THEN 
{P5.C3[qRGILF, bP[1], cP[1], cP[2]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
qWLF =>
IF cP[1] IN HB THEN
SELECT bInst FROM
qLLD =>
IF -- RiImplemented[write][local][long][field] AND
bP[1] IN LocalHB THEN 
{P5.C3[qWLILF, bP[1], cP[1], cP[2]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
qLGD =>
IF -- RiImplemented[write][global][long][field] AND
bP[1] IN GlobalHB THEN 
{P5.C3[qWGILF, bP[1], cP[1], cP[2]]; Delete2[b,c]}
ELSE canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
END;

Peep5a: PUBLIC PROC =
BEGIN -- constructor stuff
OPEN FOpCodes;
di: CCIndex;
next: CCIndex;
state: ConsPeepState;
didSomething: BOOL _ TRUE;
canSlide: BOOL _ FALSE;
WHILE didSomething DO
next _ start;
didSomething _ FALSE;
UNTIL (di _ next) = CCNull DO
next _ NextInteresting[di];
WITH dd: cb[di] SELECT FROM
code =>
BEGIN OPEN state;
IF canSlide THEN SlideConsState[@state, LOOPHOLE[di]]
ELSE InitConsState[@state, LOOPHOLE[di]];
SELECT d.inst FROM
qPSF, qWSF => 
IF c.inst = qLI AND b.inst = qPSF AND a.inst = qLI THEN
BEGIN
newOp: BYTE = IF d.inst = qPSF THEN qPS ELSE qWS;
mask: ARRAY [0..16] OF CARDINAL = [
0, 1, 3, 7, 17B, 37B, 77B, 177B, 377B,
777B, 1777B, 3777B, 7777B, 17777B, 37777B,
77777B, 177777B];
p1, s1, p2, s2, v: CARDINAL;
fd: PrincOps.FieldDescriptor;
FullWord: PrincOps.FieldDescriptor = [offset: 0, posn: 0, size: 16];
IF b.params[1] # d.params[1] THEN GO TO slide;
[p: p1, s: s1] _ UnpackFD[LOOPHOLE[b.params[2]]];
[p: p2, s: s2] _ UnpackFD[LOOPHOLE[d.params[2]]];
IF p1+s1 # p2 THEN GO TO slide;
v _ Basics.BITSHIFT[a.params[1], s2] + Basics.BITAND[c.params[1], mask[s2]];
fd _ [offset: 0, posn: p1, size: s1+s2];
IF fd = FullWord THEN {
P5.C1[newOp, d.params[1]];
Delete3[a.index, b.index, d.index]}
ELSE {
cb[d.index].parameters[2] _ LOOPHOLE[fd];
Delete2[a.index, b.index]};
cb[c.index].parameters[1] _ v;
didSomething _ TRUE;
canSlide _ FALSE;
END; 
qPSLF, qWSLF => 
IF c.inst = qLI AND b.inst = qPSLF AND a.inst = qLI THEN
BEGIN
newOp: BYTE = IF d.inst = qPSLF THEN qPSL ELSE qWSL;
mask: ARRAY [0..16] OF CARDINAL = [
0, 1, 3, 7, 17B, 37B, 77B, 177B, 377B,
777B, 1777B, 3777B, 7777B, 17777B, 37777B,
77777B, 177777B];
p1, s1, p2, s2, v: CARDINAL;
fd: PrincOps.FieldDescriptor;
FullWord: PrincOps.FieldDescriptor = [offset: 0, posn: 0, size: 16];
IF b.params[1] # d.params[1] THEN GO TO slide;
[p: p1, s: s1] _ UnpackFD[LOOPHOLE[b.params[2]]];
[p: p2, s: s2] _ UnpackFD[LOOPHOLE[d.params[2]]];
IF p1+s1 # p2 THEN GO TO slide;
v _ Basics.BITSHIFT[a.params[1], s2] + Basics.BITAND[c.params[1], mask[s2]];
fd _ [offset: 0, posn: p1, size: s1+s2];
IF fd = FullWord THEN {
P5.C1[newOp, d.params[1]];
Delete3[a.index, b.index, d.index]}
ELSE {
cb[d.index].parameters[2] _ LOOPHOLE[fd];
Delete2[a.index, b.index]};
cb[c.index].parameters[1] _ v;
didSomething _ TRUE;
canSlide _ FALSE;
END; 
qPS, qWS => 
BEGIN
newOp: BYTE = IF d.inst = qPS THEN qPSD ELSE qWSD;
IF LoadInst[c.index] AND b.inst = qPS AND LoadInst[a.index] 
AND b.params[1] + 1 = d.params[1] THEN
BEGIN
cb[d.index].inst _ newOp;
cb[d.index].parameters[1] _ b.params[1];
P5U.DeleteCell[b.index];
didSomething _ TRUE;
canSlide _ FALSE;
END
ELSE canSlide _ TRUE; 
END;
qPSL, qWSL => 
BEGIN
newOp: BYTE = IF d.inst = qPSL THEN qPSDL ELSE qWSDL;
IF LoadInst[c.index] AND b.inst = qPSL AND LoadInst[a.index] 
AND b.params[1] + 1 = d.params[1] THEN
BEGIN
cb[d.index].inst _ newOp;
cb[d.index].parameters[1] _ b.params[1];
P5U.DeleteCell[b.index];
didSomething _ TRUE;
canSlide _ FALSE;
END
ELSE canSlide _ TRUE; 
END;
qSL, qSG => 
BEGIN
newOp: BYTE = IF d.inst = qSL THEN qSLD ELSE qSGD;
IF LoadInst[c.index] AND b.inst = d.inst AND LoadInst[a.index] 
AND b.params[1] + 1 = d.params[1] AND ~NextIsPush[d.index] THEN
BEGIN
cb[d.index].inst _ newOp;
cb[d.index].parameters[1] _ b.params[1];
P5U.DeleteCell[b.index];
didSomething _ TRUE;
canSlide _ FALSE;
END
ELSE canSlide _ TRUE; 
END;
ENDCASE => canSlide _ TRUE;
EXITS
slide => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
ENDLOOP; -- of WHILE didSomething
END;


Peep6: PUBLIC PROC =
BEGIN -- sprinkle single 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 _ FALSE;
SELECT cInst FROM
<<replace load,load with load,DUP>>
qLI =>
IF bInst = cInst AND cP[1] = bP[1] THEN 
IF cP[1] = 0 THEN {P5.C1[qLID, 0]; Delete2[b, c]}
ELSE {P5.C0[qDUP]; P5U.DeleteCell[c]}
ELSE canSlide _ TRUE;
qLP =>
IF bInst = qLI AND bP[1] = 0 THEN {
P5.C1[qLID, 0]; Delete2[b, c]}
ELSE canSlide _ TRUE;
qLL, qLG, qLLK, qLA, qGA =>
IF bInst = cInst AND cP[1] = bP[1] THEN {
P5.C0[qDUP]; P5U.DeleteCell[c]}
ELSE canSlide _ TRUE;
qRLI, qRGI, qRLIL, qRGIL, qRKI =>
IF bInst = cInst AND cP[1] = bP[1] AND 
cP[2] = bP[2] THEN
{P5.C0[qDUP]; P5U.DeleteCell[c]}
ELSE canSlide _ TRUE;
qRLIF, qRLILF =>
IF bInst = cInst AND cP[1] = bP[1] AND 
cP[2] = bP[2] AND cP[3] = bP[3] THEN
{P5.C0[qDUP]; P5U.DeleteCell[c]}
ELSE canSlide _ TRUE;
ENDCASE => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
END;

Peep7: PUBLIC PROC =
BEGIN -- sprinkle double 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 _ FALSE;
SELECT cInst FROM
<<replace load,load with load,DDUP>>
qLLD, qLGD =>
IF bInst = cInst AND cP[1] = bP[1] THEN {P5.C0[qDDUP]; P5U.DeleteCell[c]};
qRLDI, qRLDIL, qRKDI =>
IF bInst = cInst AND cP[1] = bP[1] AND cP[2] = bP[2] THEN
{P5.C0[qDDUP]; P5U.DeleteCell[c]};
ENDCASE => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
END;

Peep8: PUBLIC 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] IN BYTE AND cP[1] = bP[1] THEN
{cb[b].inst _ qPL; P5U.DeleteCell[c]}
ELSE IF bInst = qSLD AND cP[1] = bP[1] THEN
{CPtr.codeptr _ b; P5.C0[qREC]; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qREC => SELECT bInst FROM 
qSL => IF bP[1] IN BYTE THEN {cb[b].inst _ qPL; P5U.DeleteCell[c]};
qREC => {cb[b].inst _ qREC2; P5U.DeleteCell[c]};
ENDCASE =>  GO TO Slide;
qLG =>
IF (bInst = qSG OR bInst = qSGD) AND cP[1] = bP[1] THEN
{CPtr.codeptr _ b; P5.C0[qREC]; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRLI =>
IF (bInst = qWLI OR bInst = qWLDI) AND 
cP[1] = bP[1] AND cP[2] = bP[2] THEN
{CPtr.codeptr _ b; P5.C0[qREC]; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRLIL =>
IF (bInst = qWLIL OR bInst = qWLDIL)
AND cP[1] = bP[1] AND cP[2] = bP[2] THEN
{CPtr.codeptr _ b; P5.C0[qREC]; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRF, qWF, qRLF, qWLF =>
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,
qRLF => qRSTRL,
ENDCASE => qWSTRL), cP[1]*2+position/8];
P5U.DeleteCell[c];
END;
ENDCASE => GO TO Slide
ELSE GO TO Slide; 
END;
ENDCASE => GO TO Slide;
EXITS
Slide => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
END;

Peep9: PUBLIC PROC =
BEGIN -- long PUTs and PUSHs
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 = qPL AND cP[1] = bP[1]+1 AND aInst = qSL AND aP[1] = cP[1] THEN
{cb[b].inst _ qPLD; Delete2[a, c]}
ELSE GO TO Slide;
qLLD =>
IF bInst = qSLD AND cP[1] IN BYTE AND cP[1] = bP[1] THEN
{cb[b].inst _ qPLD; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qREC2 => SELECT bInst FROM 
qSLD => IF bP[1] IN BYTE THEN {cb[b].inst _ qPLD; P5U.DeleteCell[c]};
qWSL => {cb[b].inst _ qPSL; P5U.DeleteCell[c]};
qWSDL => {cb[b].inst _ qPSDL; P5U.DeleteCell[c]};
qWSLF => {cb[b].inst _ qPSLF; P5U.DeleteCell[c]};
qWSCIDL => {cb[b].inst _ qPSCIDL; P5U.DeleteCell[c]};
qWSCDL => {cb[b].inst _ qPSCDL; P5U.DeleteCell[c]};
ENDCASE =>  GO TO Slide;
qLGD =>
IF bInst = qSGD AND cP[1] = bP[1] THEN
{CPtr.codeptr _ b; P5.C0[qREC2]; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRLDI =>
IF bInst = qWLDI AND cP[1] = bP[1] AND cP[2] = bP[2] THEN
{CPtr.codeptr _ b; P5.C0[qREC2]; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRLDIL =>
IF bInst = qWLDIL AND cP[1] = bP[1] AND cP[2] = bP[2] THEN
{CPtr.codeptr _ b; P5.C0[qREC2]; P5U.DeleteCell[c]}
ELSE GO TO Slide;
ENDCASE => GO TO Slide;
EXITS
Slide => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
END;

Peep3: PUBLIC PROC =
BEGIN -- discover doubles
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;
qRLI =>
IF bInst = qRLI AND cP[1] = bP[1] AND cP[2] = bP[2]+1 THEN
{cb[b].inst _ qRLDI; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRGI =>
IF bInst = qRGI AND cP[1] = bP[1] AND cP[2] = bP[2]+1 THEN
{cb[b].inst _ qRGDI; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRLIL =>
IF bInst = qRLIL AND cP[1] = bP[1] AND cP[2] = bP[2]+1 THEN
{cb[b].inst _ qRLDIL; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qRGIL =>
IF bInst = qRGIL AND cP[1] = bP[1] AND cP[2] = bP[2]+1 THEN
{cb[b].inst _ qRGDIL; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qWLI =>
IF bInst = qWLI AND cP[1] = bP[1] AND cP[2]+1 = bP[2] THEN
{cb[c].inst _ qWLDI; P5U.DeleteCell[b]}
ELSE GO TO Slide;
qWGI =>
IF bInst = qWGI AND cP[1] = bP[1] AND cP[2]+1 = bP[2] THEN
{cb[c].inst _ qWGDI; P5U.DeleteCell[b]}
ELSE GO TO Slide;
qWLIL =>
IF bInst = qWLIL AND cP[1] = bP[1] AND cP[2]+1 = bP[2] THEN
{cb[c].inst _ qWLDIL; P5U.DeleteCell[b]}
ELSE GO TO Slide;
qWGIL =>
IF bInst = qWGIL AND cP[1] = bP[1] AND cP[2]+1 = bP[2] THEN
{cb[c].inst _ qWGDIL; P5U.DeleteCell[b]}
ELSE GO TO Slide;
qRKI =>
IF bInst = qRKI AND cP[1] = bP[1] AND cP[2] = bP[2]+1 THEN
{cb[b].inst _ qRKDI; P5U.DeleteCell[c]}
ELSE GO TO Slide;
qDIS =>
IF bInst = qDIS THEN
{cb[b].inst _ qDIS2; P5U.DeleteCell[c]}
ELSE GO TO Slide;
ENDCASE => GO TO Slide;
EXITS
Slide => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
END;

CommuteCells: PUBLIC 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;

Peep11: PUBLIC PROC =
BEGIN -- short arithmetic: INC and DEC, MUL to SHIFT etc
OPEN FOpCodes;
ci: CCIndex;
next: CCIndex _ start;
canSlide: BOOL _ FALSE;
state: PeepState;
negate: BOOL _ FALSE;

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 SlidePeepState2[@state, LOOPHOLE[ci]]
ELSE InitParameters[@state, LOOPHOLE[ci], abc];
canSlide _ FALSE;
SELECT cInst FROM
qADD =>
IF bInst = qLI THEN
BEGIN
SELECT aInst FROM
qLL => IF aP[1] = LocalBase AND bP[1] IN BYTE THEN {
P5.C1[qAL0IB, bP[1]]; Delete3[a, b, c]; GO TO done};
qGA, qLA, qLI => {
cb[a].parameters[1] _ cb[a].parameters[1] + bP[1];
Delete2[b, c];
GO TO done};
qADD => {
z: CCIndex = cb[a].blink;
WITH zz: cb[z] SELECT FROM
code => IF ~zz.realinst AND zz.inst = qLI THEN {
cb[b].parameters[1] _ bP[1] _ bP[1] + zz.parameters[1];
Delete2[z, a]};
ENDCASE};
qADDSB => {
cb[b].parameters[1] _ bP[1] _ bP[1] + aP[1];
P5U.DeleteCell[a]};
qINC => {
cb[b].parameters[1] _ bP[1] _ bP[1] + 1;
P5U.DeleteCell[a]};
qDEC => {
cb[b].parameters[1] _ bP[1] _ bP[1] - 1;
P5U.DeleteCell[a]};
ENDCASE;
SELECT LOOPHOLE[bP[1], INTEGER] FROM
0 => Delete2[b,c];
1 => {cb[c].inst _ qINC; P5U.DeleteCell[b]};
-1 => {cb[c].inst _ qDEC; P5U.DeleteCell[b]};
IN [-200B..200B) => {P5.C1[qADDSB, bP[1]]; Delete2[b, c]};
ENDCASE => GO TO Slide;
EXITS
done => NULL;
END 
ELSE IF bInst = qNEG THEN
{cb[c].inst _ qSUB; P5U.DeleteCell[b]}
ELSE GO TO Slide;
qSUB =>
IF bInst = qLI THEN
BEGIN
SELECT LOOPHOLE[bP[1], INTEGER] FROM
0 => Delete2[b,c];
1 => {cb[c].inst _ qDEC; P5U.DeleteCell[b]};
-1 => {cb[c].inst _ qINC; P5U.DeleteCell[b]};
IN (-200B..200B] => {P5.C1[qADDSB, -INTEGER[bP[1]]]; Delete2[b, c]};
ENDCASE => GO TO Slide;
END 
ELSE IF bInst = qNEG THEN
{cb[c].inst _ qADD; P5U.DeleteCell[b]}
ELSE GO TO Slide;
qSHIFT =>
IF bInst = qLI THEN
SELECT INTEGER[bP[1]] FROM
1 => 
IF aInst = qSHIFTSB AND aP[1] > 0 THEN {
cb[a].parameters[1] _ aP[1] + bP[1];
Delete2[b,c]}
ELSE {cb[c].inst _ qDBL; P5U.DeleteCell[b]};
0 => Delete2[b,c];
IN [-200B..200B) =>
IF aInst = qSHIFTSB
AND INTEGER[aP[1]]*INTEGER[bP[1]] > 0 THEN {
cb[a].parameters[1] _ aP[1] + bP[1]; 
Delete2[b,c]}
ELSE {
P5.C1[qSHIFTSB, bP[1]];
Delete2[b, c]};
ENDCASE => GO TO Slide
ELSE GO TO Slide;
qSHIFTSB =>
IF bInst = qSHIFTSB AND INTEGER[bP[1]]*INTEGER[cP[1]] > 0 THEN {
cb[c].parameters[1] _ bP[1] + cP[1];
P5U.DeleteCell[b]}
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[qTRPL]; 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[qTRPL]; D2[]};
7 => {P5.C0[qDUP]; P5.C0[qDBL]; P5.C0[qTRPL]; P5.C0[qADD]; D2[]};
9 => {P5.C0[qTRPL]; P5.C0[qTRPL]; D2[]};
10 => {P5.C0[qDUP]; P5.C0[qTRPL]; P5.C0[qTRPL]; P5.C0[qADD]; D2[]};
ENDCASE =>
BEGIN
powerOf2: BOOL;
log: CARDINAL;
[powerOf2, log] _ Log2[LOOPHOLE[bP[1]]];
IF powerOf2 THEN {P5.C1[qSHIFTSB, log]; D2[]}
ELSE GO TO Slide;
END;
END;
qUDIV =>
IF bInst = qLI THEN
BEGIN
powerOf2: BOOL;
log: CARDINAL;
negate _ FALSE;
[powerOf2, log] _ Log2[LOOPHOLE[bP[1]]];
IF powerOf2 THEN {P5.C1[qSHIFTSB, -log]; D2[]}
ELSE GO TO Slide;
END;
qDIS =>
IF bInst = qEXCH THEN {cb[c].inst _ qEXDIS; P5U.DeleteCell[b]}
ELSE GO TO Slide;
ENDCASE => GO TO Slide;
EXITS
Slide => canSlide _ TRUE;
END; -- of OPEN state
ENDCASE => canSlide _ FALSE; -- of WITH
ENDLOOP;
END;

Peep4: PUBLIC PROC =
BEGIN -- long arithmetic: INC and DEC, MUL to SHIFT etc
OPEN FOpCodes;
ci: CCIndex;
next: CCIndex _ start;
canSlide: BOOL _ FALSE;
state: PeepState;

D3: PROC = {Delete3[state.a, state.b, state.c]};

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
qDADD =>
IF bInst = qLI AND bP[1] = 0 THEN
BEGIN
IF aInst = qLI THEN SELECT aP[1] FROM
0 => {Delete3[a,b,c]; GO TO done};
1 => {cb[c].inst _ qDINC; Delete2[a,b]; GO TO done};
ENDCASE;
cb[c].inst _ qADC; P5U.DeleteCell[b];
EXITS
done => NULL;
END 
ELSE IF DblLoadInst[b] AND aInst = qLI AND aP[1] = 0 THEN {
cb[c].inst _ qACD; P5U.DeleteCell[a]}
ELSE IF bInst = qLID AND bP[1] = 0 THEN Delete3[a,b,c]
ELSE GO TO Slide;
qDSUB =>
IF bInst = qLI AND bP[1] = 0 AND aInst = qLI AND aP[1] = 0 THEN
Delete3[a,b,c]
ELSE IF bInst = qLID AND bP[1] = 0 THEN Delete3[a,b,c]
ELSE GO TO Slide;
qADC =>
IF bInst = qLI THEN SELECT bP[1] FROM
1 => {cb[c].inst _ qDINC; P5U.DeleteCell[b]};
0 => Delete3[a,b,c];
ENDCASE => GO TO Slide
ELSE GO TO Slide;
qREC =>
IF bInst = qAMUL AND aInst = qLI THEN
BEGIN
SELECT aP[1] FROM
1 => D3[];
2 => {P5.C1[qLI, 0]; P5.C0[qDDBL]; D3[]};
3 => {P5.C1[qLI, 0]; P5.C0[qDDUP]; P5.C0[qDDBL]; P5.C0[qDADD]; D3[]};
4 => {P5.C1[qLI, 0]; P5.C0[qDDBL]; P5.C0[qDDBL]; D3[]};
8 => {P5.C1[qLI, 0]; P5.C0[qDDBL]; P5.C0[qDDBL]; P5.C0[qDDBL]; D3[]};
ENDCASE => GO TO Slide;
END;
qDUDIV =>
IF bInst = qLI AND bP[1] = 0 AND aInst = qLI THEN
BEGIN
powerOf2: BOOL;
log: CARDINAL;
[powerOf2, log] _ Log2[LOOPHOLE[aP[1]]];
IF powerOf2 THEN {
P5.C1[qLI, -log];
P5.C0[qDSHIFT]; D3[]}
ELSE GO TO Slide;
END;
qDMUL =>
IF bInst = qLI AND bP[1] = 0 AND aInst = qLI THEN
BEGIN
SELECT aP[1] FROM
1 => D3[];
2 => {P5.C0[qDDBL]; D3[]};
3 => {P5.C0[qDDUP]; P5.C0[qDDBL]; P5.C0[qDADD]; D3[]};
4 => {P5.C0[qDDBL]; P5.C0[qDDBL]; D3[]};
5 => {P5.C0[qDDUP]; P5.C0[qDDBL]; P5.C0[qDDBL]; P5.C0[qDADD]; D3[]};
6 => {P5.C0[qDDBL]; P5.C0[qDDUP]; P5.C0[qDDBL]; P5.C0[qDADD]; D3[]};
8 => {P5.C0[qDDBL]; P5.C0[qDDBL]; P5.C0[qDDBL]; D3[]};
ENDCASE =>
BEGIN
powerOf2: BOOL;
log: CARDINAL;
[powerOf2, log] _ Log2[LOOPHOLE[aP[1]]];
IF powerOf2 THEN {
P5.C1[qLI, log];
P5.C0[qDSHIFT]; D3[]}
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: CARDINAL] RETURNS [BOOL, CARDINAL] =
BEGIN OPEN Basics;
IF i = 0 THEN RETURN [FALSE, 0];
IF BITAND[i, i-1] # 0 THEN RETURN [FALSE, 0];
FOR shift: [0..16) IN [0..16) DO
IF BITAND[i,1] = 1 THEN RETURN [TRUE, shift];
i _ BITSHIFT[i, -1];
ENDLOOP;
ERROR; -- can't be reached
END;


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

END.

