-- Address.mesa, 
--  last modified by Sweet,  August 29, 1980  2:04 PM
--  last modified by Satterthwaite,  6-May-82 12:02:34

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [CodeNotImplemented],
  CodeDefs: TYPE USING [
    Base, BoVarIndex, codeType, IndVarIndex, Lexeme, VarComponent, VarIndex, VarNull],
  ComData: TYPE USING [typeINT],
  FOpCodes: TYPE USING [qBNDCK, qNILCK, qNILCKL],
  Inline: TYPE USING [LongMult, LongNumber],
  P5: TYPE USING [AdjustNilCheck, Exp, PushRhs],
  P5L: TYPE USING [
    ComponentForLex, ComponentForSE, FieldOfVar, FieldOfVarOnly, GenVarItem, 
    LoadBoth, LoadComponent, LoadVar, MakeBo, MakeComponent, ModComponent,
    ReleaseVarItem, ReusableCopies, TOSComponent, VarForLex, Words],
  P5S: TYPE USING [],
  P5U: TYPE USING [OperandType, Out0, TreeLiteral, TreeLiteralValue],
  SymbolOps: TYPE USING [BitsPerElement, Cardinality, NormalType, UnderType],
  Symbols: TYPE USING [
    Base, ByteLength, CSEIndex, ISEIndex, lZ, seType, WordLength],
  Tree: TYPE USING [Base, Index, Link, treeType],
  TreeOps: TYPE USING [PopTree, PushNode, PushTree, SetAttr, SetInfo];

Address: PROGRAM
    IMPORTS MPtr: ComData, CPtr: Code, Inline, P5U, P5L, P5, SymbolOps, TreeOps 
    EXPORTS CodeDefs, P5S =
  BEGIN
  OPEN CodeDefs;

  -- imported definitions

  WordLength: CARDINAL = Symbols.WordLength;
  CSEIndex: TYPE = Symbols.CSEIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;


  tb: Tree.Base;		-- tree base (local copy)
  seb: Symbols.Base;		-- semantic entry base (local copy)
  cb: CodeDefs.Base;		-- code base (local copy)

  AddressNotify: PUBLIC Alloc.Notifier =
    BEGIN  -- called by Code whenever table area is repacked
    seb ← base[Symbols.seType];
    tb ← base[Tree.treeType];
    cb ← base[codeType];
    END;


 -- utilities

  LongMult: PROC [CARDINAL, CARDINAL] RETURNS [LONG CARDINAL] =
    Inline.LongMult;

  MaxShortIndex: LONG CARDINAL = LAST[CARDINAL];

  WordOffset: PROC [sei: ISEIndex] RETURNS [CARDINAL] =
    BEGIN
    var: VarComponent = P5L.ComponentForSE[sei];
    RETURN [WITH vv: var SELECT FROM
      frame => P5L.Words[w: vv.wd, b: vv.bd],
      ENDCASE => ERROR]
    END;


  -- in a packed ind VarItem, the wd of the offset is scaled
  -- and measured in units of element size

  ScaleComponent: PROC [var: POINTER TO VarComponent, grain: [0..WordLength]] =
    BEGIN
    ePerWord: [0..WordLength] = WordLength/grain;
    WITH vv: var↑ SELECT FROM
      frame =>
	BEGIN
	vv.wd ← (vv.wd*ePerWord) + vv.bd/grain;
	vv.bd ← vv.bd MOD grain;
	END;
      code =>
	BEGIN -- this gets cross jumped
	vv.wd ← (vv.wd*ePerWord) + vv.bd/grain;
	vv.bd ← vv.bd MOD grain;
	END;
      ENDCASE => ERROR;
    END;

  UnscaleComponent: PROC [var: POINTER TO VarComponent, grain: [0..WordLength]] =
    BEGIN
    ePerWord: [0..WordLength] = WordLength/grain;
    WITH vv: var↑ SELECT FROM
      frame => 
	BEGIN
	newBd: CARDINAL = vv.bd + (vv.wd MOD ePerWord)*grain;
	vv.wd ← vv.wd/ePerWord + newBd/WordLength;
	vv.bd ← newBd MOD WordLength;
	END;
      code =>
	BEGIN -- this gets cross jumped
	newBd: CARDINAL = vv.bd + (vv.wd MOD ePerWord)*grain;
	vv.wd ← vv.wd/ePerWord + newBd/WordLength;
	vv.bd ← newBd MOD WordLength;
	END;
      ENDCASE => ERROR;
    END;


 -- operations

  Index: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generates code for array indexing
    arrayType: CSEIndex = P5U.OperandType[tb[node].son[1]];
    elementWords, grain: CARDINAL;
    packed: BOOLEAN;
    indexMax: CARDINAL;
    owd, tBits: CARDINAL;
    delta: INTEGER;
    t2: Tree.Link;
    base, index, offset: VarComponent;
    er: IndVarIndex;
    bar: BoVarIndex ← P5L.MakeBo[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
    IF bar = VarNull THEN
      SIGNAL CPtr.CodeNotImplemented; -- no packed arrays of arrays
    base ← cb[bar].base; offset ← cb[bar].offset;
    WITH a: seb[arrayType] SELECT FROM
      array =>
	BEGIN
	grain ← SymbolOps.BitsPerElement[a.componentType, a.packed];
	packed ← grain < WordLength;
	elementWords ← IF packed THEN 1 ELSE grain/WordLength;
	indexMax ← SymbolOps.Cardinality[a.indexType];
	END;
      ENDCASE => ERROR;
    IF packed AND (tBits ← indexMax * grain) IN (0..WordLength) THEN
      BEGIN
      fieldSize: CARDINAL = offset.wSize*WordLength + offset.bSize;
      IF tBits < fieldSize THEN
	P5L.ModComponent[var: @offset, wd: 0, bd: fieldSize-tBits];
      END;
    WITH oo: offset SELECT FROM
      frame =>
	BEGIN
	IF oo.level # Symbols.lZ THEN ERROR;
	IF packed THEN
	  BEGIN
	  ScaleComponent[@offset, grain];
	  offset.wSize ← 0;  offset.bSize ← grain;
	  END
	ELSE
	  BEGIN
	  IF oo.bd # 0 OR offset.bSize # 0 THEN 
	    ERROR; -- arrays start on word boundaries and are words long
	  offset.wSize ← elementWords;
	  END;
	owd ← oo.wd;
	END;
      code =>
	BEGIN -- this gets cross jumped
        IF packed THEN
	  BEGIN
	  ScaleComponent[@offset, grain];
	  offset.wSize ← 0;  offset.bSize ← grain;
	  END
	ELSE
	  BEGIN
	  IF oo.bd # 0 OR offset.bSize # 0 THEN 
	    ERROR; -- arrays start on word boundaries and are words long
	  offset.wSize ← elementWords;
	  END;
	owd ← oo.wd;
	END;
      ENDCASE => ERROR;
    [t2, delta] ← CheckAdditivity[tb[node].son[2], elementWords, owd];
    P5L.ModComponent[var: @offset, wd: INTEGER[elementWords] * delta];
    index ← P5L.ComponentForLex[P5.Exp[t2]];
    WITH ii: index SELECT FROM
      const =>
	BEGIN
	co: Inline.LongNumber = [lc[LongMult[elementWords, ii.d1]]];
	IF co.highbits # 0 OR LONG[owd] + co.lc > MaxShortIndex THEN GO TO tooBig;
	P5L.ModComponent[var: @offset, wd: co.lowbits];
	IF packed THEN UnscaleComponent[@offset, grain];
	cb[bar].offset ← offset;
	RETURN [[bdo[bar]]]
	EXITS
	  tooBig => NULL;
	END;
      ENDCASE;
    P5L.ReleaseVarItem[bar];
    er ← LOOPHOLE[P5L.GenVarItem[ind]];
    cb[er] ← [body: ind[base: base, index: index, offset: offset,
	simple: NULL, packinfo: NULL]];
    IF packed THEN
      BEGIN
      cb[er].simple ← indexMax # 0 AND grain*(owd+LONG[indexMax]) <= 4096;
      cb[er].packinfo ← packed[grain: grain];
      END
    ELSE
      BEGIN
      cb[er].simple ← 
	(P5L.Words[base.wSize, base.bSize] = 1) OR
	  (indexMax # 0 AND elementWords*LONG[indexMax] <= MaxShortIndex);
      cb[er].packinfo ← notPacked[elementWords];
      END;
    RETURN [[bdo[er]]]
    END;


  CheckAdditivity: PROC [t: Tree.Link, elementWords: CARDINAL, current: LONG CARDINAL]
      RETURNS [rt: Tree.Link, delta: INTEGER ← 0] =
    BEGIN
    node: Tree.Index;
    p: BOOLEAN;
    cDelta: CARDINAL;
    rt ← t;
    WITH t SELECT FROM
      subtree =>
	BEGIN node ← index;
	IF (p ← (tb[node].name = plus)) OR tb[node].name = minus THEN
	  IF P5U.TreeLiteral[tb[node].son[1]] THEN
	    BEGIN
	    cDelta ←  P5U.TreeLiteralValue[tb[node].son[1]];
	    IF LongMult[cDelta, elementWords] > MaxShortIndex - current THEN
	      GO TO tooBig;
	    delta ← cDelta; -- ok if > LAST[INTEGER] as used later
	    IF ~p THEN
	      BEGIN OPEN TreeOps;
	      PushTree[tb[node].son[2]]; PushNode[uminus, 1];
	      SetInfo[MPtr.typeINT];  SetAttr[1, FALSE];
	      tb[node].son[2] ← PopTree[];  tb[node].name ← plus;
	      END;
	    rt ← tb[node].son[2]
	    END
	  ELSE IF P5U.TreeLiteral[tb[node].son[2]] THEN
	    BEGIN
	    cDelta ← P5U.TreeLiteralValue[tb[node].son[2]];
	    IF p THEN
	      IF LongMult[cDelta, elementWords] > MaxShortIndex - current THEN
		GO TO tooBig
	      ELSE delta ← cDelta -- ok if > LAST[INTEGER] as used later
	    ELSE
	      IF LongMult[cDelta, elementWords] > current THEN
		GO TO tooBig
	      ELSE delta ← -INTEGER[cDelta];
	    rt ← tb[node].son[1];
	    END;
	EXITS
	  tooBig => NULL;
	END;
      ENDCASE;
    RETURN
    END;


  DIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generates code for indexing from an array descriptor
    arrayDType: CSEIndex = SymbolOps.NormalType[P5U.OperandType[tb[node].son[1]]];
    arrayType: CSEIndex = WITH seb[arrayDType] SELECT FROM
      arraydesc => SymbolOps.UnderType[describedType],
      ENDCASE => ERROR;
    packed: BOOLEAN;
    elementWords, grain: CARDINAL;
    nilck: BOOLEAN = tb[node].attr1;
    long: BOOLEAN = tb[node].attr2;
    pLength: CARDINAL = IF long THEN 2 ELSE 1;
    bndck: BOOLEAN = tb[node].attr3;
    owd: CARDINAL;
    delta: CARDINAL ← 0;
    t2: Tree.Link;
    rBase, rBound: VarIndex;
    base, bound, index: VarComponent;
    offset: frame VarComponent;
    er: IndVarIndex;
    WITH a:seb[arrayType] SELECT FROM
      array =>
	BEGIN
	grain ← SymbolOps.BitsPerElement[a.componentType, a.packed];
	packed ← grain < WordLength;
	elementWords ← IF packed THEN 1 ELSE grain/WordLength;
	END
      ENDCASE => ERROR;
    IF packed THEN offset ← [bSize: grain, space: frame[wd: 0]]
    ELSE offset ← [wSize: elementWords, space: frame[wd: 0]];

    rBase ← P5L.VarForLex[P5.Exp[tb[node].son[1]]];
    IF bndck THEN
      BEGIN
      IF nilck THEN [first: rBase, next: rBound] ← P5L.ReusableCopies[rBase, load, TRUE]
      ELSE [first: rBound, next: rBase] ← P5L.ReusableCopies[rBase, load, TRUE];
      P5L.FieldOfVar[r: rBound, wd: pLength, wSize: 1];
      P5L.FieldOfVar[r: rBase, wSize: pLength];
      END
    ELSE P5L.FieldOfVarOnly[r: rBase, wSize: pLength];
    base ← P5L.MakeComponent[rBase];
    IF nilck THEN
      BEGIN
      P5L.LoadComponent[base];
      P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE FOpCodes.qNILCK];
      base ← P5L.TOSComponent[pLength];
      END;
    IF bndck THEN t2 ← tb[node].son[2]
    ELSE [t2, delta] ← CheckAdditivity[tb[node].son[2], elementWords, 0];
    offset.wd ← owd ← elementWords * delta; -- elementWords = 1 if packed
    index ← P5L.ComponentForLex[P5.Exp[t2]];
    
    IF bndck THEN
      BEGIN
      bound ← P5L.MakeComponent[rBound];
      P5L.LoadBoth[@index, @bound, FALSE];
      P5U.Out0[FOpCodes.qBNDCK];
      index ← P5L.TOSComponent[1];
      END
    ELSE WITH ii: index SELECT FROM
      const =>
	BEGIN
	bar: VarIndex;
        co: Inline.LongNumber = [lc[LongMult[elementWords, ii.d1]]];
	IF co.highbits # 0 OR LONG[owd] + co.lc > MaxShortIndex THEN GO TO tooBig;
	P5L.ModComponent[var: @offset, wd: co.lowbits];
	IF packed THEN UnscaleComponent[@offset, grain];
	bar ← P5L.GenVarItem[bo];
	cb[bar] ← [body: bo[base: base, offset: offset]];
	RETURN [[bdo[bar]]]
	EXITS
	  tooBig => NULL;
        END;
      ENDCASE;

    er ← LOOPHOLE[P5L.GenVarItem[ind]];
    cb[er] ← [body: ind[base: base, index: index, offset: offset,
	simple: NULL, packinfo: NULL]];
    IF packed
      THEN {cb[er].simple ← FALSE; cb[er].packinfo ← packed[grain: grain]}
      ELSE {cb[er].simple ← ~long; cb[er].packinfo ← notPacked[elementWords]};
    RETURN [[bdo[er]]]
    END;

  SeqIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    seqType: CSEIndex = P5U.OperandType[tb[node].son[1]];
    isString: BOOLEAN ← FALSE;
    elementWords, grain: CARDINAL;
    packed: BOOLEAN;
    indexMax: CARDINAL;
    long: BOOLEAN = tb[node].attr2;
    bndck: BOOLEAN = tb[node].attr3;
    owd: CARDINAL;
    rBound, bor: BoVarIndex;
    base, offset, index: VarComponent;
    er: IndVarIndex;
    WITH ss: seb[seqType] SELECT FROM
      array =>
	BEGIN
	isString ← packed ← TRUE;  grain ← Symbols.ByteLength;
	elementWords ← 1;
	indexMax ← SymbolOps.Cardinality[ss.indexType];
	END;
      sequence =>
	BEGIN
	grain ← SymbolOps.BitsPerElement[ss.componentType, ss.packed];
	packed ← grain < WordLength;
	elementWords ← IF packed THEN 1 ELSE grain/WordLength;
	indexMax ← SymbolOps.Cardinality[seb[ss.tagSei].idType];
	IF bndck THEN P5.AdjustNilCheck[tb[node].son[1], WordOffset[ss.tagSei]];
	END;
      ENDCASE => ERROR;
    bor ← P5L.MakeBo[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
    IF bor = VarNull THEN 
      SIGNAL CPtr.CodeNotImplemented; -- no packed arrays of sequences
    IF bndck THEN
      BEGIN
      [first: LOOPHOLE[bor, VarIndex], next: LOOPHOLE[rBound, VarIndex]] ←
	P5L.ReusableCopies[bor, load, FALSE];
      P5L.LoadComponent[cb[bor].base];
      cb[bor].base ← P5L.TOSComponent[IF long THEN 2 ELSE 1];
      END;
    IF isString THEN
      BEGIN
      IF bndck THEN WITH vv: cb[rBound].offset SELECT FROM
	frame => {vv.wd ← vv.wd - 1; vv.wSize ← 1};	-- maxlength precedes text
	ENDCASE => ERROR;
      END
    ELSE P5L.FieldOfVar[
      r: bor, wd: cb[bor].offset.wSize, bd: cb[bor].offset.bSize]; -- skip tag
    base ← cb[bor].base; offset ← cb[bor].offset;
    IF packed THEN {offset.bSize ← grain; offset.wSize ← 0}
    ELSE {offset.wSize ← elementWords; offset.bSize ← 0};
    WITH vv: offset SELECT FROM
      frame =>
	BEGIN
	IF packed THEN ScaleComponent[@offset, grain];
	owd ← vv.wd;
	END;
      ENDCASE => ERROR;
    IF bndck THEN
      BEGIN
      P5.PushRhs[tb[node].son[2]];
      P5L.LoadVar[rBound];
      P5U.Out0[FOpCodes.qBNDCK];
      index ← P5L.TOSComponent[1];
      END
    ELSE
      BEGIN
      t2: Tree.Link;
      delta: INTEGER;
      [t2, delta] ← CheckAdditivity[tb[node].son[2], elementWords, owd];
      P5L.ModComponent[var: @offset, wd: INTEGER[elementWords] * delta];
      index ← P5L.ComponentForLex[P5.Exp[t2]];
      END;
    WITH ii: index SELECT FROM
      const =>
	BEGIN
	co: Inline.LongNumber = [lc[LongMult[elementWords, ii.d1]]];
	IF co.highbits # 0 OR LONG[owd] + co.lc > MaxShortIndex THEN GO TO tooBig;
	P5L.ModComponent[var: @offset, wd: co.lowbits];
	IF packed THEN UnscaleComponent[@offset, grain];
	cb[bor].offset ← offset;
	RETURN [[bdo[bor]]]
	EXITS
	  tooBig => NULL;
        END;
      ENDCASE;
    P5L.ReleaseVarItem[bor];
    er ← LOOPHOLE[P5L.GenVarItem[ind]];
    cb[er] ← [body: ind[base: base, index: index, offset: offset,
      simple: NULL, packinfo: NULL]];
    IF packed THEN
      BEGIN
      cb[er].simple ← indexMax # 0 AND grain*(owd+LONG[indexMax]) <= 4096;
      cb[er].packinfo ← packed[grain: grain];
      END
    ELSE
      BEGIN
      cb[er].simple ← 
	(P5L.Words[base.wSize, base.bSize] = 1) OR
	  (indexMax # 0 AND elementWords*LONG[indexMax] <= MaxShortIndex);
      cb[er].packinfo ← notPacked[elementWords];
      END;
    RETURN [[bdo[er]]]
    END;

  END.