DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [codeptr],
CodeDefs:
TYPE
USING [
Base, CCIndex, CCNull, CodeCCIndex, codeType, JumpCCIndex],
FOpCodes: TYPE USING [qGADRB, qLADRB, qLG, qLI, qLL, qRIG, qRIL],
OpCodeParams: TYPE USING [BYTE, GlobalHB, LoadImmediateSlots, LocalHB, zLIn],
OpTableDefs: TYPE USING [InstLength],
P5: TYPE USING [NumberOfParams, P5Error],
P5U: TYPE USING [AllocCodeCCItem, DeleteCell, ParamCount],
PeepholeDefs:
TYPE
USING [
JumpPeepState, NullComponent, NullJumpState, NullState, PeepComponent,
PeepState, StateExtent],
PrincOps: TYPE USING [FieldDescriptor, zLIB, zLIN1, zLINB, zLINI, zLIW],
PrincOpsUtils: TYPE USING [BITAND, BITOR, BITSHIFT, COPY];
PeepholeU:
PROGRAM
IMPORTS CPtr: Code, PrincOpsUtils, P5U, OpTableDefs, P5
EXPORTS P5, PeepholeDefs =
PUBLIC BEGIN OPEN OpCodeParams, CodeDefs, PeepholeDefs;
imported definitions
BYTE: TYPE = OpCodeParams.BYTE;
cb: CodeDefs.Base; -- code base (local copy)
PeepholeUNotify: Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
cb ← base[codeType];
END;
GenRealInst: BOOL;
SetRealInst: PROC [b: BOOL] = {GenRealInst ← b};
HalfByteGlobal:
PROC [c: CCIndex]
RETURNS [
BOOL] =
BEGIN
IF c = CCNull THEN RETURN [FALSE];
RETURN [
WITH cb[c]
SELECT
FROM
code => inst = FOpCodes.qLG AND parameters[1] IN GlobalHB,
ENDCASE => FALSE]
END;
HalfByteLocal:
PROC [c: CCIndex]
RETURNS [
BOOL] =
BEGIN
IF c = CCNull THEN RETURN [FALSE];
RETURN [
WITH cb[c]
SELECT
FROM
code => inst = FOpCodes.qLL AND parameters[1] IN LocalHB,
ENDCASE => FALSE]
END;
LoadInst:
PROC [c: CCIndex]
RETURNS [
BOOL] =
BEGIN OPEN FOpCodes;
IF c = CCNull THEN RETURN [FALSE];
RETURN [
WITH cb[c]
SELECT
FROM
code => ~realinst
AND (
SELECT inst
FROM
qLI, qLL, qLG, qRIL, qRIG, qLADRB, qGADRB => TRUE,
ENDCASE => FALSE),
ENDCASE => FALSE]
END;
PackPair:
PROC [l, r: [0..16)]
RETURNS [
WORD] =
BEGIN OPEN PrincOpsUtils;
RETURN [BITOR[BITSHIFT[l, 4], BITAND[r, 17b]]]
END;
UnpackPair:
PROC [w:
WORD]
RETURNS [l, r: [0..16)] =
BEGIN OPEN PrincOpsUtils;
RETURN [l: BITAND[BITSHIFT[w, -4], 17b], r: BITAND[w, 17b]]
END;
UnpackFD:
PROC [d: PrincOps.FieldDescriptor]
RETURNS [p, s:
CARDINAL] =
BEGIN
RETURN [p: d.posn, s: d.size]
END;
InitParameters:
PROC [
p: POINTER TO PeepState, ci: CodeCCIndex, extent: StateExtent] =
BEGIN -- ci # CCNull and cb[ci].cctag = code
ai, bi: CCIndex;
i: CARDINAL;
p^ ← NullState; p.c ← ci;
IF ~(GenRealInst OR ~cb[ci].realinst) THEN RETURN;
FillInC[p];
IF extent = c THEN RETURN;
IF (bi ← PrevInteresting[ci]) = CCNull THEN RETURN;
p.b ← LOOPHOLE[bi];
WITH cb[bi]
SELECT
FROM
code =>
IF GenRealInst
OR ~realinst
THEN
BEGIN
p.bInst ← inst;
FOR i IN [1..P5U.ParamCount[p.b]] DO p.bP[i] ← parameters[i] ENDLOOP;
END;
ENDCASE;
IF extent = bc THEN RETURN;
IF (ai ← PrevInteresting[bi]) = CCNull THEN RETURN;
p.a ← LOOPHOLE[ai];
WITH cb[ai]
SELECT
FROM
code =>
IF GenRealInst
OR ~realinst
THEN
BEGIN
p.aInst ← inst;
FOR i IN [1..P5U.ParamCount[p.a]] DO p.aP[i] ← parameters[i] ENDLOOP;
END;
ENDCASE;
END;
CondFillInC:
PRIVATE
PROC [p:
POINTER
TO PeepState, ci: CodeCCIndex] =
BEGIN
IF GenRealInst
OR ~cb[ci].realinst
THEN
{p.cComp ← NullComponent; p.c ← ci; FillInC[p]}
ELSE {p^ ← NullState; p.c ← ci};
END;
FillInC:
PRIVATE
PROC [p:
POINTER
TO PeepState] =
BEGIN -- p.c is initialized and p.c # CCNull and cb[p.c].cctag = code
otherwise, p.cComp = NullComponent
CPtr.codeptr ← p.c;
p.cInst ← cb[p.c].inst;
FOR i:
CARDINAL
IN [1..P5U.ParamCount[p.c]]
DO
p.cP[i] ← cb[p.c].parameters[i];
ENDLOOP;
END;
InitJParametersBC:
PROC [p:
POINTER
TO JumpPeepState, ci: JumpCCIndex] =
BEGIN -- ci # CCNull and cb[ci].cctag = jump
bi: CCIndex;
p^ ← NullJumpState; p.c ← ci;
IF (bi ← PrevInteresting[ci]) = CCNull THEN RETURN;
CPtr.codeptr ← ci;
WITH cc: cb[bi]
SELECT
FROM
code =>
BEGIN
IF ~(GenRealInst OR ~cc.realinst) THEN RETURN;
p.b ← LOOPHOLE[bi];
p.bInst ← cc.inst;
FOR i:
CARDINAL
IN [1..P5U.ParamCount[p.b]]
DO
p.bP[i] ← cc.parameters[i];
ENDLOOP;
END;
ENDCASE;
END;
SlidePeepState1:
PROC [p:
POINTER
TO PeepState, ci: CodeCCIndex] =
BEGIN
PrincOpsUtils.
COPY[
from: @p.cComp,
to: @p.bComp,
nwords: PeepComponent.SIZE];
CondFillInC[p, ci];
END;
SlidePeepState2:
PROC [p:
POINTER
TO PeepState, ci: CodeCCIndex] =
BEGIN
PrincOpsUtils.
COPY[
from: @p.bComp,
to: @p.aComp,
nwords: 2*PeepComponent.SIZE];
CondFillInC[p, ci];
END;
NextInteresting:
PROC [c: CCIndex]
RETURNS [CCIndex] =
BEGIN -- skip over startbody, endbody, and source other CCItems
WHILE (c ← cb[c].flink) # CCNull
DO
WITH cc: cb[c]
SELECT
FROM
other =>
WITH cc
SELECT
FROM
table => EXIT;
ENDCASE;
ENDCASE => EXIT;
ENDLOOP;
RETURN [c]
END;
PrevInteresting:
PROC [c: CCIndex]
RETURNS [CCIndex] =
BEGIN -- skip over startbody, endbody, and source other CCItems
WHILE (c ← cb[c].blink) # CCNull
DO
WITH cc: cb[c]
SELECT
FROM
other =>
WITH cc
SELECT
FROM
table => EXIT;
ENDCASE;
ENDCASE => EXIT;
ENDLOOP;
RETURN [c]
END;
LoadConstant:
PROC [c:
UNSPECIFIED] =
BEGIN
OPEN PrincOps;
ic: INTEGER;
IF ~GenRealInst THEN {C1[FOpCodes.qLI, c]; RETURN};
ic ← LOOPHOLE[c];
SELECT ic
FROM
IN LoadImmediateSlots => C0[zLIn+ic];
-1 => C0[zLIN1];
100000B => C0[zLINI];
IN BYTE => C1[zLIB, ic];
ENDCASE =>
IF -ic
IN
BYTE
THEN
C1[zLINB, PrincOpsUtils.BITAND[ic,377B]]
ELSE C1W[zLIW, ic];
END;
C0:
PROC [i:
BYTE] =
BEGIN -- outputs an parameter-less instruction
c: CodeCCIndex;
IF InstParamCount[i] # 0 THEN P5.P5Error[962];
c ← PeepAllocCodeCCItem[i,0];
cb[c].inst ← i;
END;
C1:
PROC [i:
BYTE, p1:
WORD] =
BEGIN -- outputs a one-parameter instruction
c: CodeCCIndex ← PeepAllocCodeCCItem[i,1];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
END;
C1W:
PROC [i:
BYTE, p1:
WORD] =
BEGIN -- outputs a one-parameter(two-byte-param) instruction
c: CodeCCIndex ← PeepAllocCodeCCItem[i,2];
cb[c].inst ← i;
cb[c].parameters[1] ← PrincOpsUtils.BITSHIFT[p1, -8];
cb[c].parameters[2] ← PrincOpsUtils.BITAND[p1, 377B];
END;
C2:
PROC [i:
BYTE, p1, p2:
WORD] =
BEGIN -- outputs a two-parameter instruction
c: CodeCCIndex ← PeepAllocCodeCCItem[i,2];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
cb[c].parameters[2] ← p2;
END;
C3:
PROC [i:
BYTE, p1, p2, p3:
WORD] =
BEGIN -- outputs a three-parameter instruction
c: CodeCCIndex ← PeepAllocCodeCCItem[i,3];
cb[c].inst ← i;
cb[c].parameters[1] ← p1;
cb[c].parameters[2] ← p2;
cb[c].parameters[3] ← p3;
END;
InstParamCount:
PROC [i:
BYTE]
RETURNS [
CARDINAL] =
BEGIN
RETURN [IF GenRealInst THEN OpTableDefs.InstLength[i]-1 ELSE P5.NumberOfParams[i]]
END;
PeepAllocCodeCCItem:
PROC [i:
BYTE, n: [0..3]]
RETURNS [c: CodeCCIndex] =
BEGIN
IF InstParamCount[i] # n THEN P5.P5Error[963];
c ← P5U.AllocCodeCCItem[n];
cb[c].realinst ← GenRealInst;
IF GenRealInst THEN cb[c].isize ← n+1;
RETURN
END;
Delete2:
PROC [a,b: CCIndex] =
{P5U.DeleteCell[a]; P5U.DeleteCell[b]};
Delete3:
PROC [a,b,c: CCIndex] =
{P5U.DeleteCell[a]; P5U.DeleteCell[b]; P5U.DeleteCell[c]};
END.