-- 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.