-- Address.mesa, modified by Sweet, January 18, 1980  3:49 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength],
  Code: FROM "code",
  CodeDefs: FROM "codedefs" USING [
    BoVarIndex, IndVarIndex, Lexeme, VarComponent, VarIndex, VarNull],
  ComData: FROM "comdata" USING [typeINTEGER],
  ControlDefs: FROM "controldefs" USING [framelink, globalbase, localbase],
  FOpCodes: FROM "fopcodes" USING [qBNDCK, qNILCK, qNILCKL],
  InlineDefs: FROM "inlinedefs" USING [LongNumber],
  Literals: FROM "literals" USING [LTIndex],
  OpCodeParams: FROM "opcodeparams",
  P5: FROM "p5" USING [Exp, P5Error],
  P5L: FROM "p5l" USING [
    ComponentForLex, CopyVarItem, EasilyLoadable,
    FieldOfVar, FieldOfVarOnly, GenVarItem, 
    LoadBoth, LoadComponent, LoadVar, MakeBo, MakeComponent, ModComponent,
    ReleaseVarItem, TOSComponent, VarForLex, Words],
  P5S: FROM "p5s",
  P5U: FROM "p5u" USING [OperandType, Out0, TreeLiteral, TreeLiteralValue],
  Stack: FROM "stack" USING [Mark],
  SymbolOps: FROM "symbolops" USING [
    BitsForType, Cardinality, NormalType, UnderType, WordsForType],
  Symbols: FROM "symbols" USING [
    BitAddress, ContextLevel, CSEIndex, CTXIndex, ctxType, HTIndex, ISEIndex, 
    lG, lZ, SEIndex, seType],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [Index, Link, Null, treeType],
  TreeOps: FROM "treeops" USING [
    FreeNode, PopTree, PushNode, PushTree, SetAttr, SetInfo];

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

  -- imported definitions

  BYTE: TYPE = AltoDefs.BYTE;
  wordlength: CARDINAL = AltoDefs.wordlength;
  charlength: CARDINAL = AltoDefs.charlength;

  framelink: CARDINAL = ControlDefs.framelink;
  globalbase: CARDINAL = ControlDefs.globalbase;
  localbase: CARDINAL = ControlDefs.localbase;

  BitAddress: TYPE = Symbols.BitAddress;
  ContextLevel: TYPE = Symbols.ContextLevel;
  CTXIndex: TYPE = Symbols.CTXIndex;
  HTIndex: TYPE = Symbols.HTIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  CSEIndex: TYPE = Symbols.CSEIndex;
  lG: ContextLevel = Symbols.lG;
  lZ: ContextLevel = Symbols.lZ;
  SEIndex: TYPE = Symbols.SEIndex;


  LTIndex: TYPE = Literals.LTIndex;


  tb: Table.Base;		-- tree base (local copy)
  seb: Table.Base;		-- semantic entry base (local copy)
  ctxb: Table.Base;		-- context entry base (local copy)
  cb: Table.Base;		-- code base (local copy)

  AddressNotify: PUBLIC Table.Notifier =
    BEGIN  -- called by Code whenever table area is repacked
    seb _ base[Symbols.seType];
    ctxb _ base[Symbols.ctxType];
    cb _ tb _ base[Tree.treeType];
    RETURN
    END;


  Index: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generates code for array indexing
    elementWords: CARDINAL _ SymbolOps.WordsForType[tb[node].info];
    grain, ePerWord: CARDINAL;
    ar: VarIndex;
    bar: BoVarIndex;
    er: IndVarIndex;
    arraytype: CSEIndex;
    delta: INTEGER;
    treeInserted, packed: BOOLEAN _ FALSE;
    t1, t2: Tree.Link;
    base, index, offset: VarComponent;
    indexMax, owd: CARDINAL;

    t1 _ tb[node].son[1];
    t2 _ tb[node].son[2];
    arraytype _ P5U.OperandType[t1];
    WITH a:seb[arraytype] SELECT FROM
      array =>
	BEGIN
	indexMax _ SymbolOps.Cardinality[a.indexType];
        IF a.oldPacked THEN
	  BEGIN
          SELECT SymbolOps.BitsForType[a.componentType] FROM
	    1 => grain _ 1;
	    2 => grain _ 2;
	    3,4 => grain _ 4;
	    5,6,7,8 => grain _ 8;
	    ENDCASE => GO TO not;
	  grain _ 8; -- *************** until after 6.0c bootstrap
	  ePerWord _ 16/grain;
	  packed _ TRUE;
	  EXITS
	   not => packed _ FALSE;
	  END
	ELSE packed _ FALSE;
	END;
      ENDCASE => ERROR;
    ar _ P5L.VarForLex[P5.Exp[t1]];
    bar _ P5L.MakeBo[ar];
    IF bar = VarNull THEN
      SIGNAL CPtr.CodeNotImplemented; -- no packed arrays of arrays
    base _ cb[bar].base; offset _ cb[bar].offset;
    WITH oo: offset SELECT FROM
      frame =>
	BEGIN
	IF oo.level # lZ THEN ERROR;
        IF packed THEN
	  BEGIN
	  IF oo.bd MOD grain # 0 THEN ERROR;
	  oo.wd _ (oo.wd*ePerWord) + oo.bd / grain;
	    -- above converts wd to element count vs word count
	  oo.bd _ 0; 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
	  IF oo.bd MOD grain # 0 THEN ERROR;
	  oo.wd _ (oo.wd*ePerWord) + oo.bd / grain;
	    -- above converts wd to element count vs word count
	  oo.bd _ 0; 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, treeInserted] _
      CheckAdditivity[t2, elementWords, owd];
    P5L.ModComponent[var: @offset, wd: INTEGER[elementWords] * delta];
    index _ P5L.ComponentForLex[P5.Exp[t2]];
    WITH ii: index SELECT FROM
      const =>
        BEGIN
        co: InlineDefs.LongNumber;
        co.lc _ LONG[elementWords] * ii.d1;
	IF co.highbits # 0 THEN GO TO tooBig;
        IF packed THEN
	  BEGIN
	  newwd: CARDINAL;
	  newbd: [0..wordlength);
	  IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
	    GO TO tooBig;
	  owd _ owd + co.lowbits;
	  newwd _ owd / ePerWord; newbd _ (owd MOD ePerWord) * grain;
	  WITH oo: offset SELECT FROM
	    frame => BEGIN oo.wd _ newwd; oo.bd _ newbd; END;
	    code => BEGIN oo.wd _ newwd; oo.bd _ newbd; END;
	    ENDCASE;
	  END
        ELSE
	  BEGIN
	  IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
	    GO TO tooBig;
	  P5L.ModComponent[var: @offset, wd: co.lowbits];
	  END;
        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 _ SymbolOps.WordsForType[arraytype] <= 256;
      cb[er].packinfo _ packed [grain: grain];
      END
    ELSE
      BEGIN
      longBase: BOOLEAN _ P5L.Words[base.wSize, base.bSize] > 1;
      cb[er].simple _ 
	~longBase OR
	  (indexMax # 0 AND LONG[elementWords]*LONG[indexMax] < 200000B);
      cb[er].packinfo _ notPacked[elementWords];
      END;

    IF treeInserted THEN WITH t2 SELECT FROM
      subtree =>
	BEGIN tb[index].son[1] _ Tree.Null; TreeOps.FreeNode[index]; END;
      ENDCASE => P5.P5Error[323];
    RETURN [[bdo[er]]];
    END;


  CheckAdditivity: PROCEDURE [t: Tree.Link, elementWords, current: CARDINAL]
      RETURNS [rt: Tree.Link, delta: INTEGER, insertedtree: BOOLEAN] =
    BEGIN OPEN Tree, TreeOps;
    node: Tree.Index;
    p: BOOLEAN;
    cDelta: CARDINAL;

    rt _ t;
    delta _ 0;
    insertedtree _ FALSE;
    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 LONG[cDelta]*LONG[elementWords] >
		LONG[LAST[CARDINAL] - current] THEN
	      GO TO tooBig;
	    delta _ cDelta; -- ok if > LAST[INTEGER] as used later
	    IF p THEN
	      rt _ tb[node].son[2]
	    ELSE
	      BEGIN
	      PushTree[tb[node].son[2]]; PushNode[uminus, 1];
	      SetInfo[MPtr.typeINTEGER];
	      SetAttr[1, FALSE];  rt _ PopTree[];
	      insertedtree _ TRUE;
	      END;
	    END
	  ELSE IF P5U.TreeLiteral[tb[node].son[2]] THEN
	    BEGIN
	    cDelta _ P5U.TreeLiteralValue[tb[node].son[2]];
	    IF p THEN
	      IF LONG[cDelta]*LONG[elementWords] >
		  LONG[LAST[CARDINAL] - current] THEN
		GO TO tooBig
	      ELSE delta _ cDelta -- ok if > LAST[INTEGER] as used later
	    ELSE
	      IF LONG[cDelta]*LONG[elementWords] > LONG[current] THEN
		GO TO tooBig
	      ELSE delta _ -INTEGER[cDelta];
	    rt _ tb[node].son[1];
	    END;
	EXITS
	  tooBig => delta _ 0;
	END;
      ENDCASE;
    RETURN
    END;


  DIndex: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generates code for indexing from an array descriptor
    er: IndVarIndex;
    rBase: VarIndex;
    nilck: BOOLEAN _ tb[node].attr1;
    long: BOOLEAN = tb[node].attr2;
    bndck: BOOLEAN _ tb[node].attr3;
    elementWords: CARDINAL _ SymbolOps.WordsForType[tb[node].info];
    treeInserted: BOOLEAN _ FALSE;
    packed: BOOLEAN;
    pLength: CARDINAL = IF long THEN 2 ELSE 1;
    arraytype, arraydtype: CSEIndex;
    t1, t2: Tree.Link;
    delta, grain, owd: CARDINAL;
    base, bound, index: VarComponent;
    offset: frame VarComponent;

    t1 _ tb[node].son[1];
    t2 _ tb[node].son[2];
    arraydtype _ SymbolOps.NormalType[P5U.OperandType[t1]];
    WITH seb[arraydtype] SELECT FROM
      arraydesc => arraytype _ SymbolOps.UnderType[describedType];
      ENDCASE;
    WITH a:seb[arraytype] SELECT FROM
      array =>
        IF a.oldPacked THEN
	  BEGIN
          SELECT SymbolOps.BitsForType[a.componentType] FROM
	    1 => grain _ 1;
	    2 => grain _ 2;
	    3,4 => grain _ 4;
	    5,6,7,8 => grain _ 8;
	    ENDCASE => GO TO not;
	  grain _ 8; -- *************** until after 6.0c bootstrap
	  packed _ TRUE;
	  EXITS
	   not => packed _ FALSE;
	  END
	ELSE packed _ FALSE;
      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[t1]];
    IF bndck THEN
      BEGIN
      rBound: VarIndex _ P5L.CopyVarItem[rBase];
      P5L.FieldOfVar[r: rBound, wd: pLength, wSize: 1];
      P5L.FieldOfVar[r: rBase, wSize: pLength];
      bound _ P5L.MakeComponent[rBound];
      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;
    [t2, delta, treeInserted] _ CheckAdditivity[t2, 1, 0];
    offset.wd _ owd _ elementWords * delta; -- elementWords = 1 if packed
    index _ P5L.ComponentForLex[P5.Exp[t2]];
    
    IF bndck THEN
      BEGIN
      P5L.LoadBoth[@index, @bound, FALSE];
      P5U.Out0[FOpCodes.qBNDCK];
      index _ P5L.TOSComponent[1];
      END
    ELSE WITH index SELECT FROM
      const =>
	BEGIN
        bar: VarIndex;
        co: InlineDefs.LongNumber;
	
        co.lc _ elementWords * d1;
	IF co.highbits # 0 THEN GO TO tooBig;
        bar _ P5L.GenVarItem[bo];
        IF packed THEN
	  BEGIN
	  ePerWord: CARDINAL = wordlength / grain;
	  IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
	    GO TO tooBig;
	  owd _ owd + co.lowbits;
	  offset.wd _ owd / ePerWord; 
	  offset.bd _ (owd MOD ePerWord) * grain;
	  END
        ELSE
	  BEGIN
	  IF LONG[owd] + co.lc > LONG[LAST[CARDINAL]] THEN
	    GO TO tooBig;
	  P5L.ModComponent[var: @offset, wd: co.lowbits];
	  END;
	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
      BEGIN
      cb[er].simple _ FALSE;
      cb[er].packinfo _ packed [grain: grain];
      END
    ELSE
      BEGIN
      cb[er].simple _ ~long;
      cb[er].packinfo _ notPacked[elementWords];
      END;
    IF treeInserted THEN WITH t2 SELECT FROM
      subtree =>
	BEGIN tb[index].son[1] _ Tree.Null; TreeOps.FreeNode[index]; END;
      ENDCASE => P5.P5Error[323];
    RETURN[[bdo[er]]];
    END;

  SeqIndex: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    easy: BOOLEAN _ FALSE;
    nilck: BOOLEAN _ tb[node].attr1;
    long: BOOLEAN _ tb[node].attr2;
    bndck: BOOLEAN _ tb[node].attr3;
    t1: Tree.Link _ tb[node].son[1];
    t2: Tree.Link _ tb[node].son[2];
    base, index: VarComponent;
    rBound: VarIndex;
    er: VarIndex;
    delta: INTEGER;
    treeInserted: BOOLEAN _ FALSE;
    StringHeaderSize: CARDINAL = 2;
    CharsPerWord: CARDINAL = 2;
    byteOffset: CARDINAL = StringHeaderSize*CharsPerWord;

    IF long AND bndck THEN Stack.Mark[];
    base _ P5L.ComponentForLex[P5.Exp[t1]];
    IF bndck THEN
      BEGIN
      base _ P5L.EasilyLoadable[base, load];
      rBound _ P5L.GenVarItem[bo];
      cb[rBound] _
        [body: bo[base: base, offset: [wSize: 1, space: frame[wd: 1]]]];
      END;
    IF nilck THEN
      BEGIN
      P5L.LoadComponent[base];
      P5U.Out0[IF long THEN FOpCodes.qNILCKL ELSE FOpCodes.qNILCK];
      base _ P5L.TOSComponent[IF long THEN 2 ELSE 1];
      END;
    [t2, delta, treeInserted] _ CheckAdditivity[t2, 1, byteOffset];
    index _ P5L.ComponentForLex[P5.Exp[t2]];
    IF bndck THEN
      BEGIN
      P5L.LoadComponent[index];
      P5L.LoadVar[rBound];
      P5U.Out0[FOpCodes.qBNDCK];
      index _ P5L.TOSComponent[1];
      END
    ELSE WITH index SELECT FROM
      const =>
	BEGIN
        co: CARDINAL = d1 + CARDINAL[byteOffset + delta];
        bar: VarIndex = P5L.GenVarItem[bo];
	cb[bar] _ [body: bo[base: base, offset: 
	  [bSize: charlength, space:
	    frame[wd: co/CharsPerWord,
		bd: (co MOD CharsPerWord)*charlength]]]];
        RETURN [[bdo[bar]]];
        END;
      ENDCASE;

    er _ P5L.GenVarItem[ind];
    cb[er] _ [body: ind[
      base: base,
      index: index,
      offset: [bSize: 8, space: frame[wd: 4+delta]],
      simple: FALSE,
      packinfo: packed[grain: 8]]];
    IF treeInserted THEN WITH t2 SELECT FROM
      subtree =>
	BEGIN tb[index].son[1] _ Tree.Null; TreeOps.FreeNode[index]; END;
      ENDCASE => P5.P5Error[323];
    RETURN[[bdo[er]]];
    END;

END...