-- file: PeepholeU.mesa, edited by Sweet on February 12, 1979  10:30 AM

DIRECTORY
  Code: FROM "code" USING [codeptr],
  P5U: FROM "p5u" USING [AllocCodeCCItem, DeleteCell, ParamCount],
  CodeDefs: FROM "codedefs" USING [CCIndex, CCNull, CodeCCIndex, CodeCCNull],
  ControlDefs: FROM "controldefs" USING [FieldDescriptor],
  FOpCodes: FROM "fopcodes" USING [qGADRB, qLADRB, qLG, qLI, qLL, qNOOP, qRIG, qRIL, qRR],
  InlineDefs: FROM "inlinedefs" USING [BITAND, BITOR, BITSHIFT],
  Mopcodes: FROM "mopcodes" USING [zLIB, zLIN1, zLINB, zLINI, zLIW],
  OpCodeParams: FROM "opcodeparams" USING [BYTE, LoadImmediateSlots, LocalHB, zLIn],
  OpTableDefs: FROM "optabledefs" USING [instaligned, instlength],
  P5: FROM "p5" USING [NumberOfParams, P5Error],
  PeepholeDefs: FROM "peepholedefs" USING [JumpPeepState, PeepState],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [treeType];

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

  -- imported definitions

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


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

  PeepholeUNotify: Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    cb _ base[Tree.treeType];
    RETURN
    END;

  sourceIndex: CARDINAL;

  SetSourceIndex: PROCEDURE [c: CARDINAL] =
    BEGIN sourceIndex _ c END;

  GenRealInst: BOOLEAN;

  SetRealInst: PROCEDURE [b: BOOLEAN] =
    BEGIN GenRealInst _ b END;


  HalfByteLocal: PROCEDURE [c: CCIndex] RETURNS [BOOLEAN] =
    BEGIN
    IF c = CCNull THEN RETURN [FALSE];
    WITH cb[c] SELECT FROM
      code => RETURN[inst = FOpCodes.qLL AND parameters[1] IN LocalHB];
      ENDCASE => RETURN [FALSE]
    END;

  LoadInst: PROCEDURE [c: CCIndex] RETURNS [BOOLEAN] =
    BEGIN OPEN FOpCodes;
    IF c = CCNull THEN RETURN[FALSE];
    WITH cb[c] SELECT FROM
      code => RETURN[~realinst AND (SELECT inst FROM
	qLI, qLL, qLG, qRIL, qRIG, qLADRB, qGADRB, qRR => TRUE,
	ENDCASE => FALSE)];
      ENDCASE => RETURN[FALSE]
    END;


  PackPair: PROCEDURE [l,r: [0..16)] RETURNS [w: WORD] =
    BEGIN OPEN InlineDefs;
    w _ BITSHIFT[l, 4];
    w _ BITOR[w, BITAND[r, 17B]];
    RETURN
    END;

  UnpackPair: PROCEDURE [w: WORD] RETURNS [l,r: [0..16)] =
    BEGIN OPEN InlineDefs;
    l _ BITAND[BITSHIFT[w, -4], 17B];
    r _ BITAND[w, 17B];
    RETURN
    END;

  UnpackFD: PROCEDURE [d: ControlDefs.FieldDescriptor] RETURNS [p,s: CARDINAL] =
    BEGIN
    [posn: p, size: s] _ d;
    RETURN
    END;


  InitParametersABC: PROCEDURE [p: POINTER TO PeepState] =
    BEGIN -- p.c is initialized and p.c # CCNull and cb[p.c].cctag = code
    OPEN p;
    i: CARDINAL;

    aInst _ bInst _ cInst _ qNOOP;
    aMin _ bMin _ cMin _ FALSE;
    a _ b _ CodeCCNull;
    IF ~(GenRealInst OR ~cb[c].realinst) THEN RETURN;
    FillInC[p];
    IF (b_LOOPHOLE[cb[c].blink, CodeCCIndex]) = CCNull THEN RETURN;
    WITH cb[LOOPHOLE[b, CCIndex]] SELECT FROM
      code =>
       IF GenRealInst OR ~realinst THEN
	BEGIN
	bInst _ inst;
	bMin _ minimalStack;
	bP _ [0,0,0];
	FOR i IN [1..P5U.ParamCount[b]] DO bP[i] _ parameters[i] ENDLOOP;
	END;
      ENDCASE;
    IF (a_LOOPHOLE[cb[b].blink, CodeCCIndex]) = CCNull THEN RETURN;
    WITH cb[LOOPHOLE[a, CCIndex]] SELECT FROM
      code =>
       IF GenRealInst OR ~realinst THEN
	BEGIN
	aInst _ inst;
	aMin _ minimalStack;
	aP _ [0,0,0];
	FOR i IN [1..P5U.ParamCount[a]] DO aP[i] _ parameters[i] ENDLOOP;
	END;
      ENDCASE;
    END;

  InitParametersBC: PROCEDURE [p: POINTER TO PeepState] =
    BEGIN -- p.c is initialized and p.c # CCNull and cb[p.c].cctag = code
    OPEN p;
    i: CARDINAL;

    aInst _ bInst _ cInst _ qNOOP;
    aMin _ bMin _ cMin _ FALSE;
    a _ b _ CodeCCNull;
    IF ~(GenRealInst OR ~cb[c].realinst) THEN RETURN;
    FillInC[p];
    IF (b_LOOPHOLE[cb[c].blink, CodeCCIndex]) = CCNull THEN RETURN;
    WITH cb[LOOPHOLE[b, CCIndex]] SELECT FROM
      code =>
       IF GenRealInst OR ~realinst THEN
	BEGIN
	bInst _ inst;
	bMin _ minimalStack;
	bP _ [0,0,0];
	FOR i IN [1..P5U.ParamCount[b]] DO bP[i] _ parameters[i] ENDLOOP;
	END;
      ENDCASE;
    END;

  InitParametersC: PROCEDURE [p: POINTER TO PeepState] =
    BEGIN -- p.c is initialized and p.c # CCNull and cb[p.c].cctag = code
    OPEN p;

    aInst _ bInst _ cInst _ qNOOP;
    aMin _ bMin _ cMin _ FALSE;
    a _ b _ CodeCCNull;
    IF ~(GenRealInst OR ~cb[c].realinst) THEN RETURN;
    FillInC[p];
    END;

  CondFillInC: PRIVATE PROCEDURE [p: POINTER TO PeepState] =
    BEGIN OPEN p;
    IF GenRealInst OR ~cb[c].realinst THEN FillInC[p]
    ELSE
      BEGIN
      aInst _ bInst _ cInst _ qNOOP;
      aMin _ bMin _ cMin _ FALSE;
      a _ b _ CodeCCNull;
      END;
    END; 

  FillInC: PRIVATE PROCEDURE [p: POINTER TO PeepState] =
    BEGIN -- p.c is initialized and p.c # CCNull and cb[p.c].cctag = code
    OPEN p;
    i: CARDINAL;

    CPtr.codeptr _ c;
    sourceIndex _ cb[c].sourcefileindex;
    cInst _ cb[c].inst;
    cMin _ cb[c].minimalStack;
    cP _ [0,0,0];
    FOR i IN [1..P5U.ParamCount[c]] DO cP[i] _ cb[c].parameters[i] ENDLOOP;
    END;

  InitJParametersBC: PROCEDURE [p: POINTER TO JumpPeepState] =
    BEGIN -- p.c is initialized and p.c # CCNull and cb[p.c].cctag = jump
    OPEN p;
    i: CARDINAL;

    bInst _ cInst _ qNOOP;
    bMin _ cMin _ FALSE;
    b _ CodeCCNull;
    IF (b_LOOPHOLE[cb[c].blink, CodeCCIndex]) = CCNull THEN RETURN;
    WITH cb[LOOPHOLE[b, CCIndex]] SELECT FROM
      code =>
	BEGIN
	bP _ [0,0,0];
	IF ~(GenRealInst OR ~cb[b].realinst) THEN 
	  BEGIN
	  bInst _ qNOOP;
	  bMin _ FALSE;
	  b _ CodeCCNull;
	  RETURN;
	  END;
	bInst _ inst;
	bMin _ minimalStack;
	FOR i IN [1..P5U.ParamCount[b]] DO bP[i] _ parameters[i] ENDLOOP;
	END;
      ENDCASE;
    END;

  SlidePeepState2: PROCEDURE [p: POINTER TO PeepState, ci: CodeCCIndex] =
    BEGIN OPEN p;
    a _ b; aMin _ bMin; aP _ bP; aInst _ bInst;
    b _ c; bMin _ cMin; bP _ cP; bInst _ cInst;
    c _ ci; CondFillInC[p];
    END;

  SlidePeepState1: PROCEDURE [p: POINTER TO PeepState, ci: CodeCCIndex] =
    BEGIN OPEN p;
    b _ c; bMin _ cMin; bP _ cP; bInst _ cInst;
    c _ ci; CondFillInC[p];
    END;

  LoadConstant: PROCEDURE [c: UNSPECIFIED] =
    BEGIN
    OPEN Mopcodes;
    ic: INTEGER;
    IF ~GenRealInst THEN
      BEGIN C1[FOpCodes.qLI, c]; RETURN END;
    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, InlineDefs.BITAND[ic,377B]]
	ELSE C1W[zLIW, ic];
    RETURN
    END;

  MC0: PROCEDURE [i: BYTE, minimal: BOOLEAN] =
    BEGIN -- outputs an parameter-less instruction
    c: CodeCCIndex;

    IF InstParamCount[i] # 0 THEN P5.P5Error[961];
    c _ PeepAllocCodeCCItem[i,0];
    cb[c].inst _ i;
    cb[c].minimalStack _ minimal;
    RETURN
    END;


  C0: PROCEDURE [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;
    RETURN
    END;


  C1: PROCEDURE [i: BYTE, p1: WORD] =
    BEGIN -- outputs a one-parameter instruction
    c: CodeCCIndex;

    c _ PeepAllocCodeCCItem[i,1];
    cb[c].inst _ i;
    cb[c].parameters[1] _ p1;
    RETURN
    END;


  C1W: PROCEDURE [i: BYTE, p1: WORD] =
    BEGIN -- outputs a one-parameter(two-byte-param) instruction
    c: CodeCCIndex;

    c _ PeepAllocCodeCCItem[i,2];
    cb[c].inst _ i;
    cb[c].parameters[1] _ InlineDefs.BITSHIFT[p1, -8];
    cb[c].parameters[2] _ InlineDefs.BITAND[p1, 377B];
    RETURN
    END;


  C2: PROCEDURE [i: BYTE, p1, p2: WORD] =
    BEGIN -- outputs a two-parameter instruction
    c: CodeCCIndex;

    c _ PeepAllocCodeCCItem[i,2];
    cb[c].inst _ i;
    cb[c].parameters[1] _ p1;
    cb[c].parameters[2] _ p2;
    RETURN
    END;


  C3: PROCEDURE [i: BYTE, p1, p2, p3: WORD] =
    BEGIN -- outputs a three-parameter instruction
    c: CodeCCIndex;

    c _ PeepAllocCodeCCItem[i,3];
    cb[c].inst _ i;
    cb[c].parameters[1] _ p1;
    cb[c].parameters[2] _ p2;
    cb[c].parameters[3] _ p3;
    RETURN
    END;


  InstParamCount: PROCEDURE [i: BYTE] RETURNS [CARDINAL] =
    BEGIN
    RETURN[IF GenRealInst THEN OpTableDefs.instlength[i]-1 ELSE P5.NumberOfParams[i]]
    END;

  PeepAllocCodeCCItem: PROCEDURE [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;
    cb[c].sourcefileindex _ sourceIndex;
    IF GenRealInst THEN
      BEGIN
      cb[c].isize _ n+1;
      cb[c].aligned _ OpTableDefs.instaligned[i];
      END;
    RETURN
    END;

  Delete2: PROCEDURE [a,b: CCIndex] =
    BEGIN P5U.DeleteCell[a]; P5U.DeleteCell[b]; RETURN END;

  Delete3: PROCEDURE [a,b,c: CCIndex] =
    BEGIN P5U.DeleteCell[a]; P5U.DeleteCell[b]; P5U.DeleteCell[c]; RETURN END;


  END...