
<<file: PeepholeU.mesa>>
<<last edited by Sweet on 4-Dec-81 11:23:05>>
<<last edited by Satterthwaite on April 18, 1986 2:34:39 pm PST>>

DIRECTORY
Alloc: TYPE USING [Notifier],
Basics: TYPE USING [BITAND, BITOR, BITSHIFT],
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],
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, zLIB, zLIHB, zLIN1, zLINB, zLINI, zLIW],
PrincOpsUtils: TYPE USING [Copy];

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

<<imported definitions>>

BYTE: TYPE = OpCodeParams.BYTE;


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

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

GenRealInst: BOOL;

SetRealInst: PUBLIC PROC [b: BOOL] = {GenRealInst _ b};


HalfByteGlobal: PUBLIC 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: PUBLIC 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: PUBLIC 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: PUBLIC 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: PUBLIC PROC [l, r: [0..16)] RETURNS [WORD] =
BEGIN OPEN Basics;
RETURN [BITOR[BITSHIFT[l, 4], BITAND[r, 17b]]]
END;

UnpackPair: PUBLIC PROC [w: WORD] RETURNS [l, r: [0..16)] =
BEGIN OPEN Basics;
RETURN [l: BITAND[BITSHIFT[w, -4], 17b], r: BITAND[w, 17b]]
END;

UnpackFD: PUBLIC PROC [d: PrincOps.FieldDescriptor] RETURNS [p, s: CARDINAL] =
BEGIN
RETURN [p: d.posn, s: d.size]
END;

InitComponent: PUBLIC 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: PUBLIC 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: PROC [p: POINTER TO PeepState, ci: CodeCCIndex] =
BEGIN
p.cComp _ NullComponent;
IF InitComponent[@p.cComp, ci] THEN CPtr.codeptr _ ci;
END; 

InitConsState: PUBLIC 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: PUBLIC PROC [p: POINTER TO ConsPeepState, di: CodeDefs.CodeCCIndex] =
BEGIN
PrincOpsUtils.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: PUBLIC 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: PUBLIC PROC [p: POINTER TO PeepState, ci: CodeCCIndex] =
BEGIN
PrincOpsUtils.Copy[
from: @p.cComp,
to: @p.bComp,
nwords: PeepComponent.SIZE];
CondFillInC[p, ci];
END;

SlidePeepState2: PUBLIC 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: PUBLIC 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: PUBLIC 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: PUBLIC 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, Basics.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: PUBLIC 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: PUBLIC 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: PUBLIC 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] _ Basics.BITSHIFT[p1, -8];
cb[c].parameters[2] _ Basics.BITAND[p1, 377B];
END;


C2: PUBLIC 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: PUBLIC 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: PUBLIC PROC [i: BYTE] RETURNS [CARDINAL] =
BEGIN
RETURN [IF GenRealInst THEN OpTableDefs.InstLength[i]-1 ELSE P5.NumberOfParams[i]]
END;

PeepAllocCodeCCItem: PUBLIC 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: PUBLIC PROC [a,b: CCIndex] =
{P5U.DeleteCell[a]; P5U.DeleteCell[b]};

Delete3: PUBLIC PROC [a,b,c: CCIndex] =
{P5U.DeleteCell[a]; P5U.DeleteCell[b]; P5U.DeleteCell[c]};

END.

