-- file: PeepholeU.mesa
-- last edited by Sweet on 4-Dec-81 11:23:05
-- last edited by Satterthwaite on December 16, 1982 9:50 am
DIRECTORY
Alloc: TYPE USING [Notifier],
Code: TYPE USING [codeptr],
CodeDefs: TYPE USING [
Base, CCIndex, CCNull, CodeCCIndex, codeType, JumpCCIndex],
FOpCodes: TYPE USING [
qDB, qGA, qLA, qLG, qLGD, qLI, qLL, qLLD, qRGDI, qRGI,
qRKDI, qRKI, qRLI, qRLDI],
Inline: TYPE USING [BITAND, BITOR, BITSHIFT, COPY],
Mopcodes: TYPE USING [zLIB, zLIHB, zLIN1, zLINB, zLINI, zLIW],
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 [
ConsPeepState, JumpPeepState, NullComponent, NullConsState,
NullJumpState, NullState, PeepComponent, PeepState, StateExtent],
PrincOps: TYPE USING [FieldDescriptor];
PeepholeU: PROGRAM
IMPORTS CPtr: Code, Inline, 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, double: BOOL] RETURNS [BOOL] =
BEGIN OPEN FOpCodes;
op: BYTE = IF double THEN qLGD ELSE qLG;
IF c = CCNull THEN RETURN [FALSE];
RETURN [WITH cb[c] SELECT FROM
code => inst = op AND parameters[1] IN GlobalHB,
ENDCASE => FALSE]
END;
HalfByteLocal: PROC [c: CCIndex, double: BOOL] RETURNS [BOOL] =
BEGIN OPEN FOpCodes;
op: BYTE = IF double THEN qLLD ELSE qLL;
IF c = CCNull THEN RETURN [FALSE];
RETURN [WITH cb[c] SELECT FROM
code => inst = op 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, qRLI, qRGI, qRKI, qLA, qGA, qDB => TRUE,
ENDCASE => FALSE),
ENDCASE => FALSE]
END;
DblLoadInst: 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
qLLD, qLGD, qRLDI, qRGDI, qRKDI => TRUE,
ENDCASE => FALSE),
ENDCASE => FALSE]
END;
PackPair: PROC [l, r: [0..16)] RETURNS [WORD] =
BEGIN OPEN Inline;
RETURN [BITOR[BITSHIFT[l, 4], BITAND[r, 17b]]]
END;
UnpackPair: PROC [w: WORD] RETURNS [l, r: [0..16)] =
BEGIN OPEN Inline;
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;
InitComponent: PROC [pc: POINTER TO PeepComponent, c: CCIndex] RETURNS [BOOL] =
BEGIN
pc.index ← LOOPHOLE[c]; -- pc↑ is initialized to NullComponent
WITH cb[c] SELECT FROM
code => {
IF ~(GenRealInst OR ~realinst) THEN RETURN [FALSE];
pc.inst ← inst;
FOR i: CARDINAL IN [1..P5U.ParamCount[pc.index]] DO
pc.params[i] ← parameters[i]
ENDLOOP};
ENDCASE => RETURN[FALSE];
RETURN[TRUE];
END;
InitParameters: PROC [
p: POINTER TO PeepState, ci: CodeCCIndex, extent: StateExtent] =
BEGIN -- ci # CCNull and cb[ci].cctag = code
ai, bi: CCIndex;
p↑ ← NullState;
IF ~InitComponent[@p.cComp, ci] THEN RETURN;
CPtr.codeptr ← ci;
IF extent = c THEN RETURN;
IF (bi ← PrevInteresting[ci]) = CCNull THEN RETURN;
[] ← InitComponent[@p.bComp, bi];
IF extent = bc THEN RETURN;
IF (ai ← PrevInteresting[bi]) = CCNull THEN RETURN;
[] ← InitComponent[@p.aComp, ai];
END;
CondFillInC: PRIVATE PROC [p: POINTER TO PeepState, ci: CodeCCIndex] =
BEGIN
p.cComp ← NullComponent;
IF InitComponent[@p.cComp, ci] THEN CPtr.codeptr ← ci;
END;
InitConsState: PROC [p: POINTER TO ConsPeepState, di: CodeDefs.CodeCCIndex] =
BEGIN
ai, bi, ci: CCIndex;
p↑ ← NullConsState;
IF ~InitComponent[@p.d, di] THEN RETURN;
CPtr.codeptr ← di;
IF (ci ← PrevInteresting[di]) = CCNull THEN RETURN;
[] ← InitComponent[@p.c, ci];
IF (bi ← PrevInteresting[ci]) = CCNull THEN RETURN;
[] ← InitComponent[@p.b, bi];
IF (ai ← PrevInteresting[bi]) = CCNull THEN RETURN;
[] ← InitComponent[@p.a, ai];
END;
SlideConsState: PROC [p: POINTER TO ConsPeepState, di: CodeDefs.CodeCCIndex] =
BEGIN
Inline.COPY[
from: @p.b,
to: @p.a,
nwords: 3*PeepComponent.SIZE];
p.d ← NullComponent;
IF InitComponent[@p.d, di] THEN CPtr.codeptr ← di;
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
Inline.COPY[
from: @p.cComp,
to: @p.bComp,
nwords: PeepComponent.SIZE];
CondFillInC[p, ci];
END;
SlidePeepState2: PROC [p: POINTER TO PeepState, ci: CodeCCIndex] =
BEGIN
Inline.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 Mopcodes;
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, Inline.BITAND[ic,377B]]
ELSE IF CARDINAL[ic] MOD 256 = 0 THEN
C1[zLIHB, CARDINAL[ic]/256]
ELSE {
C1W[zLIW, ic];
WITH cb[CPtr.codeptr] SELECT FROM
code => lco ← FALSE;
ENDCASE => ERROR};
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] ← Inline.BITSHIFT[p1, -8];
cb[c].parameters[2] ← Inline.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.