-- file Pass4Xa.Mesa
-- last written by Satterthwaite, January 17, 1980  3:15 PM

DIRECTORY
  AltoDefs: FROM "altodefs"
    USING [charlength, maxinteger, maxword, wordlength],
  ComData: FROM "comdata"
    USING [ownSymbols, switches, typeINTEGER, typeCHARACTER],
  InlineDefs: FROM "inlinedefs" USING [BITAND, BITOR, BITSHIFT],
  Literals: FROM "literals" USING [LitDescriptor, ltType],
  LiteralOps: FROM "literalops" USING [FindDescriptor, MasterString],
  Log: FROM "log" USING [Error, ErrorN, ErrorTree],
  P4: FROM "p4"
    USING [
      Covering, Repr, none, signed, unsigned, both, other, RegCount, MaxRegs,
      AdjustBias, BiasForType, BitsForType, CatchNest, ComputeIndexRegs,
      Exp, ForceType, MakeStructuredLiteral, MakeTreeLiteral, OperandType,
      RegsForType, RepForType, RValue, StructuredLiteral, TreeLiteral,
      TreeLiteralDesc, TreeLiteralValue, TypeExp,
      VBias, VPop, VPush, VRegs, VRep, WordsForType, ZeroP],
  Symbols: FROM "symbols"
    USING [ctxType, seType,
      BitAddress, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
      typeANY, lZ],
  SymbolOps: FROM "symbolops"
    USING [
      Cardinality, FirstVisibleSe, FnField, NextSe, NormalType, RecordRoot,
      UnderType],
  SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree"
    USING [Index, Link, Map, Scan, Null, treeType],
  TreeOps: FROM "treeops"
    USING [
      FreeNode, GetNode, ListLength, PopTree, PushTree, PushLit, PushNode,
      ScanList, SetAttr, SetInfo, TestTree, UpdateList],
  Types: FROM "types" USING [Assignable];

Pass4Xa: PROGRAM
    IMPORTS
      InlineDefs, Log, LiteralOps, P4, SymbolOps, SystemDefs, TreeOps, Types,
      dataPtr: ComData
    EXPORTS P4 =
  BEGIN
  OPEN SymbolOps, TreeOps, P4;

 -- pervasive definitions from Symbols

  SEIndex: TYPE = Symbols.SEIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  CSEIndex: TYPE = Symbols.CSEIndex;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;

  BitAddress: TYPE = Symbols.BitAddress;


  tb: Table.Base;	-- tree base address (local copy)
  ltb: Table.Base;	-- literal base address (local copy)
  seb: Table.Base;	-- se table base address (local copy)
  ctxb: Table.Base;	-- context table base address (local copy)

  ExpANotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    tb _ base[Tree.treeType];  ltb _ base[Literals.ltType];
    seb _ base[Symbols.seType];  ctxb _ base[Symbols.ctxType];
    END;


 -- expression list manipulation

  MakeRecord: PROCEDURE [record: RecordSEIndex, expList: Tree.Link]
      RETURNS [val: Tree.Link, nRegs: RegCount] =
    BEGIN
    sei: ISEIndex;
    const: BOOLEAN;
    subNode: Tree.Index;

    EvaluateField: Tree.Map =
      BEGIN
      type: CSEIndex = UnderType[seb[sei].idType];
      IF t = Tree.Null
	THEN
	  BEGIN
	  v _ Tree.Null;
	  IF BitsForType[type] # 0 THEN const _ FALSE;
	  END
	ELSE
	  BEGIN  
	  v _ WITH t SELECT FROM
	    subtree =>
	      SELECT tb[index].name FROM
		construct => NestedConstruct[index, type],
		union => Union[index, TRUE],
		ENDCASE => Rhs[t, type],
	    ENDCASE => Rhs[t, type];
	  IF ~TreeLiteral[v]
	    THEN
	      WITH v SELECT FROM
		subtree =>
		  SELECT tb[index].name FROM
		    mwconst =>  NULL;
		    union => IF ~tb[index].attr1 THEN const _ FALSE;
		    ENDCASE =>  const _ FALSE;
		ENDCASE =>  const _ FALSE;
	  nRegs _ MAX[VRegs[], nRegs];  VPop[];
	  END;
      sei _ NextSe[sei];
      RETURN
      END;

    sei _ FirstVisibleSe[seb[record].fieldCtx];  const _ TRUE;  nRegs _ 0;
    val _ UpdateList[expList, EvaluateField];
    IF TestTree[val, list] 
      THEN  BEGIN subNode _ GetNode[val]; tb[subNode].attr1 _ const END;
    RETURN
    END;

    NestedConstruct: PROCEDURE [node: Tree.Index, lType: CSEIndex] RETURNS [val: Tree.Link] =
      BEGIN
      rType: CSEIndex = tb[node].info;
      val _ Construct[node, TRUE];
      IF WordsForType[lType] > WordsForType[rType]
	THEN val _ PadRecord[val, lType];
      RETURN
      END;

  MakeArgRecord: PUBLIC PROCEDURE [record: RecordSEIndex, expList: Tree.Link]
      RETURNS [val: Tree.Link] =
    BEGIN
    type: CSEIndex;
    seb[record].lengthUsed _ TRUE;
    SELECT TRUE FROM
      (expList = Tree.Null) =>   val _ Tree.Null;
      TestTree[expList, list] =>  val _ MakeRecord[record, expList].val;
      ENDCASE =>
	BEGIN
	type _ UnderType[seb[FirstVisibleSe[seb[record].fieldCtx]].idType];
	val _ Rhs[expList, type];  VPop[];
	END;
    RETURN
    END;


  -- construction of packed values (machine dependent)

  WordLength: CARDINAL = AltoDefs.wordlength;
  ByteLength: CARDINAL = AltoDefs.charlength;

  FillMultiWord: PROCEDURE [words: DESCRIPTOR FOR ARRAY OF WORD,
	origin: CARDINAL, t: Tree.Link] RETURNS [newOrigin: CARDINAL] =
    BEGIN
    desc: Literals.LitDescriptor;
    i: CARDINAL;
    desc _ TreeLiteralDesc[t];
    FOR i IN [0 .. desc.length)
      DO words[origin + i] _ ltb[desc.offset][i] ENDLOOP;
    RETURN [origin + desc.length]
    END;

  PackRecord: PROCEDURE [record: RecordSEIndex, expList: Tree.Link] RETURNS [Tree.Link] =
    BEGIN
    n: CARDINAL = WordsForType[record];
    root, type: RecordSEIndex;
    list: Tree.Link;
    sei: ISEIndex;
    offset: CARDINAL;
    words: DESCRIPTOR FOR ARRAY OF WORD;
    i: CARDINAL;
    more: BOOLEAN;

    StoreBits: PROCEDURE [sei: ISEIndex, value: WORD] =
      BEGIN
      OPEN InlineDefs;
      Masks: ARRAY [0..WordLength] OF WORD =
	[0B, 1B, 3B, 7B, 17B, 37B, 77B, 177B, 377B, 777B,
	 1777B, 3777B, 7777B, 17777B, 37777B, 77777B, 177777B];
      address: BitAddress;
      size, w, shift: CARDINAL;
      IF seb[root].argument
	THEN  [address, size] _ FnField[sei]
	ELSE  BEGIN address _ seb[sei].idValue; size _ seb[sei].idInfo END;
      w _ address.wd;
      shift _ (WordLength-offset) - (address.bd+size);
      words[w] _ BITOR[words[w], BITSHIFT[BITAND[value, Masks[size]], shift]];
      END;

    PackField: Tree.Scan =
      BEGIN
      node: Tree.Index;
      address: BitAddress;
      typeId: ISEIndex;
      subType: CSEIndex;
      SELECT TRUE FROM
	t = Tree.Null =>  NULL;
        TreeLiteral[t] =>  StoreBits[sei, TreeLiteralValue[t]];
	ENDCASE =>
	  BEGIN  node _ GetNode[t];
	  SELECT tb[node].name FROM
	    mwconst =>
	      BEGIN
	      address _ IF seb[root].argument
		THEN FnField[sei].offset
		ELSE seb[sei].idValue;
	      [] _ FillMultiWord[words, address.wd, tb[node].son[1]];
	      END;
	    union =>
	      BEGIN
	      WITH tb[node].son[1] SELECT FROM
		symbol =>  typeId _ index;
		ENDCASE =>  ERROR;
	      subType _ UnderType[seb[sei].idType];
	      WITH seb[subType] SELECT FROM
		union =>
		  IF controlled THEN StoreBits[tagSei, seb[typeId].idValue];
		ENDCASE =>  ERROR;
	      type _ LOOPHOLE[UnderType[typeId], RecordSEIndex];
	      list _ tb[node].son[2];  more _ TRUE;
	      END;
	    ENDCASE =>  ERROR;
	  END;
      sei _ NextSe[sei];
      END;

    words _ DESCRIPTOR[SystemDefs.AllocateHeapNode[n], n];
    FOR i IN [0 .. n) DO words[i] _ 0 ENDLOOP;
    root _ type _ RecordRoot[record];
    offset _ IF seb[record].length < WordLength
	THEN WordLength - seb[record].length
	ELSE 0;
    list _ expList;  more _ TRUE;
    WHILE more 
      DO
      more _ FALSE;
      sei _ FirstVisibleSe[seb[type].fieldCtx];
      ScanList[list, PackField];
      ENDLOOP;
    PushLit[LiteralOps.FindDescriptor[words]];
    PushNode[IF n=1 THEN cast ELSE mwconst, 1];  SetInfo[record];
    SystemDefs.FreeHeapNode[BASE[words]];
    RETURN [PopTree[]]
    END;

  
  PadRecord: PUBLIC PROCEDURE [t: Tree.Link, lType: CSEIndex] RETURNS [Tree.Link] =
    BEGIN
    IF StructuredLiteral[t]
      THEN
	BEGIN
	words: DESCRIPTOR FOR ARRAY OF WORD;
	w, nW: CARDINAL;
	node: Tree.Index;
	nW _ WordsForType[lType];
	words _ DESCRIPTOR[SystemDefs.AllocateHeapNode[nW], nW];
	FOR w IN [0 .. nW) DO words[w] _ 0 ENDLOOP;
	IF TreeLiteral[t]
	  THEN  words[0] _ TreeLiteralValue[t]
	  ELSE
	    BEGIN  node _ GetNode[t];
	    SELECT tb[node].name FROM
	      mwconst =>  w _ FillMultiWord[words, 0, tb[node].son[1]];
	      ENDCASE =>  ERROR;
	    FreeNode[node];
	    END;
	PushLit[LiteralOps.FindDescriptor[words]];  PushNode[mwconst, 1];
	SystemDefs.FreeHeapNode[BASE[words]];
	END
      ELSE  BEGIN  PushTree[t];  PushNode[pad, 1]  END;
    SetInfo[lType];
    RETURN [PopTree[]]
    END;


  ExtractValue: PROCEDURE [t: Tree.Link, addr: BitAddress, size: CARDINAL, type: CSEIndex]
      RETURNS [val: Tree.Link] =
    BEGIN
    words: DESCRIPTOR FOR ARRAY OF WORD;
    i: CARDINAL;
    desc: Literals.LitDescriptor = TreeLiteralDesc[t];
    n: CARDINAL = size/WordLength;
    IF n > 1
      THEN
	BEGIN
	IF addr.bd # 0 THEN Log.Error[unimplemented];
	words _ DESCRIPTOR[SystemDefs.AllocateHeapNode[n], n];
	FOR i IN [0 .. n) DO words[i] _ ltb[desc.offset][addr.wd+i] ENDLOOP;
	PushLit[LiteralOps.FindDescriptor[words]];
	PushNode[mwconst, 1];  SetInfo[type];
	SystemDefs.FreeHeapNode[BASE[words]];
	val _ PopTree[];
	END
      ELSE
	val _ MakeStructuredLiteral[
		InlineDefs.BITSHIFT[
		  InlineDefs.BITSHIFT[ltb[desc.offset][addr.wd], addr.bd],
		  -(WordLength - size)],
		type];
    RETURN
    END;


  UnpackField: PROCEDURE [t: Tree.Link, field: ISEIndex] RETURNS [val: Tree.Link] =
    BEGIN
    rType: CSEIndex = OperandType[t];
    vType: CSEIndex = UnderType[seb[field].idType];
    addr: BitAddress;
    addr _ seb[field].idValue;
    WITH r: seb[rType] SELECT FROM
      record =>
	IF r.length < WordLength
	  THEN  addr.bd _ addr.bd + (WordLength - r.length);
      ENDCASE => ERROR;
    RETURN [ExtractValue[t, addr, seb[field].idInfo, vType]]
    END;

  UnpackElement: PROCEDURE [t: Tree.Link, i: CARDINAL] RETURNS [val: Tree.Link] =
    BEGIN
    aType: CSEIndex = OperandType[t];
    cType: CSEIndex;
    addr: BitAddress;
    nB, nW: CARDINAL;
    BytesPerWord: CARDINAL = WordLength/ByteLength;
    WITH a: seb[aType] SELECT FROM
      array =>
	BEGIN
	cType _ UnderType[a.componentType];  nB _ BitsForType[cType];
	IF nB > ByteLength OR ~a.oldPacked
	  THEN
	    BEGIN
	    nW _ (nB+(WordLength-1))/WordLength;
	    addr _ [wd:i*nW, bd:0];  nB _ nW*WordLength;
	    END
	  ELSE
	    BEGIN
	    addr _ [wd:i/BytesPerWord, bd:(i MOD BytesPerWord)*ByteLength];
	    nB _ ByteLength;
	    END;
	END;
      ENDCASE => ERROR;
    RETURN [ExtractValue[t, addr, nB, cType]]
    END;


 -- operators

  Call: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
    BEGIN  OPEN tb[node];
    type: CSEIndex;
    son[1] _ Exp[son[1], none];  VPop[];
    type _ OperandType[son[1]];
    WITH seb[type] SELECT FROM
      transfer =>
	BEGIN
	son[2] _ MakeArgRecord[inRecord, son[2]];
	VPush[BiasForType[outRecord], RepForType[outRecord], MaxRegs];
	END;
      ENDCASE =>  ERROR;
    IF nSons > 2 THEN  CatchNest[son[3]];
    RETURN [[subtree[index: node]]]
    END;

  MiscXfer: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
    BEGIN
    type: CSEIndex;
    SELECT tb[node].name FROM
      new =>
	BEGIN
	tb[node].son[1] _ RValue[tb[node].son[1], 0, none];  VPop[];
	VPush[0, unsigned, MaxRegs];
        END;
      fork =>
	BEGIN  OPEN tb[node];
	son[1] _ Exp[son[1], none];  VPop[];
	type _ OperandType[son[1]];
	WITH seb[type] SELECT FROM
	  transfer =>
	    BEGIN
	    son[2] _ MakeArgRecord[inRecord, son[2]];
	    VPush[0, other, MaxRegs];
	    END;
	  ENDCASE =>  ERROR;
  	END;
      ENDCASE =>  ERROR;
    IF tb[node].nSons > 2 THEN CatchNest[tb[node].son[3]];
    RETURN [[subtree[index: node]]]
    END;



  Construct: PUBLIC PROCEDURE [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    type: RecordSEIndex = info;
    record: RecordSEIndex = RecordRoot[type];
    nRegs: RegCount;
    k: RegCount = RegsForType[type];
    [son[2], nRegs] _ MakeRecord[record, son[2]]; seb[type].lengthUsed _ TRUE;
    SELECT TRUE FROM
      TestTree[son[2], list] OR TestTree[son[2], union] =>
	BEGIN
	subNode: Tree.Index = GetNode[son[2]];
	IF ~tb[subNode].attr1	-- ~all fields constant
	  THEN  BEGIN val _ [subtree[index: node]]; nRegs _ MAX[nRegs, k] END
	  ELSE
	    BEGIN
	    val _ PackRecord[type, son[2]]; FreeNode[node]; nRegs _ k;
	    END;
	VPush[0, other, nRegs];
	END;
      (son[2] = Tree.Null) =>  BEGIN val _ Tree.Null; VPush[0, other, 0] END;
      ENDCASE =>  val _ CastUniList[node, type, nested];
    RETURN
    END;

  Union: PUBLIC PROCEDURE [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    vSei: ISEIndex = WITH son[1] SELECT FROM symbol=>index, ENDCASE=>ERROR;
    type: RecordSEIndex = LOOPHOLE[UnderType[vSei]];
    tSei: CSEIndex = UnderType[info];
    tagged: BOOLEAN =
      WITH seb[tSei] SELECT FROM union => controlled, ENDCASE => FALSE;
    nRegs: RegCount;
    [son[2], nRegs] _ MakeRecord[type, son[2]];  seb[type].lengthUsed _ TRUE;
    attr2 _ tagged;
    SELECT TRUE FROM
      TestTree[son[2], list] OR TestTree[son[2], union] =>
	BEGIN
        attr1 _ WITH son[2] SELECT FROM
		  subtree => tb[index].attr1,
		  ENDCASE => FALSE;
        val _ [subtree[index: node]];  VPush[0, other, nRegs];
	END;
      (son[2] = Tree.Null) =>
	BEGIN
        attr1 _ TRUE; val _ [subtree[index: node]]; VPush[0, other, 1];
	END;
      ENDCASE =>
	IF WordsForType[type] = 1 AND (~tagged OR seb[vSei].idValue = 0)
	  THEN  val _ CastUniList[node, type, nested]
	  ELSE
	    BEGIN
	    attr1 _ StructuredLiteral[son[2]];
	    val _ [subtree[index: node]];  VPush[0, other, RegsForType[type]];
	    END;
    RETURN
    END;

  CastUniList: PROCEDURE [node: Tree.Index, type: CSEIndex, nested: BOOLEAN]
      RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    unSafe: BOOLEAN;
    t: Tree.Link _ tb[node].son[2];
    IF (unSafe _ TestTree[t, safen])
      THEN
	BEGIN
	subNode _ GetNode[t];  t _ tb[subNode].son[1];
	tb[subNode].son[1] _ Tree.Null;  FreeNode[subNode];
	END;
    tb[node].son[2] _ Tree.Null;  FreeNode[node];
    val _ ForceType[t, type];
    IF unSafe AND nested
      THEN
	BEGIN
	PushTree[val];  PushNode[safen, 1];  SetInfo[type];  val _ PopTree[];
	END;
    VPush[BiasForType[type], RepForType[type], RegsForType[type]];
    RETURN
    END;


  RowConstruct: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    aType: Symbols.ArraySEIndex = info;
    cType: CSEIndex = UnderType[seb[aType].componentType];
    n: CARDINAL = Cardinality[seb[aType].indexType];
    const, strings, lstrings: BOOLEAN;
    nRegs: RegCount;
    l: CARDINAL;

    EvalElement: Tree.Map =
      BEGIN
      IF t = Tree.Null
	THEN  BEGIN  v _ Tree.Null;  const _ strings _ lstrings _ FALSE  END
	ELSE
	  BEGIN
	  v _ Rhs[t, cType];  nRegs _ MAX[VRegs[], nRegs];
	  IF TreeLiteral[v]
	    THEN  strings _ lstrings _ FALSE
	    ELSE
	      WITH v SELECT FROM
		subtree =>
		  SELECT tb[index].name FROM
		    mwconst =>  strings _ lstrings _ FALSE;
		    ENDCASE =>  const _ strings _ lstrings _ FALSE;
		literal =>
		  WITH info SELECT FROM
		    string =>
		      BEGIN   const _ FALSE;
		      IF LiteralOps.MasterString[index] = index
			THEN lstrings _ FALSE
			ELSE strings _ FALSE;
		      END;
		    ENDCASE;
		ENDCASE =>  const _ strings _ lstrings _ FALSE;
	  VPop[];
	  END;
      RETURN
      END;

    w, nW: CARDINAL;
    words: DESCRIPTOR FOR ARRAY OF WORD;
    bitsLeft: CARDINAL;
    bitCount: CARDINAL;

    PackElement: Tree.Scan =
      BEGIN
      node: Tree.Index;
      IF TreeLiteral[t]
	THEN
	  BEGIN
	  bitsLeft _ bitsLeft - bitCount;
	  words[w] _ InlineDefs.BITOR[words[w],
		  InlineDefs.BITSHIFT[TreeLiteralValue[t], bitsLeft]];
	  IF bitsLeft < bitCount
	    THEN  BEGIN  w _ w+1;  bitsLeft _ WordLength  END;
	  END
	ELSE
	  BEGIN  node _ GetNode[t];
	  SELECT tb[node].name FROM
	    mwconst =>  w _ FillMultiWord[words, w, tb[node].son[1]];
	    ENDCASE =>  ERROR;
	  END;
      END;

    SELECT (l _ ListLength[son[2]]) FROM
      = n => NULL;
      > n => Log.ErrorN[listLong, l-n];
      < n => Log.ErrorN[listShort, n-l];
      ENDCASE;
    const _ strings _ lstrings _ TRUE;  nRegs _ 0;
    son[2] _ UpdateList[son[2], EvalElement];
    IF const AND l = n
      THEN
	BEGIN
	nW _ WordsForType[aType];
	words _ DESCRIPTOR[SystemDefs.AllocateHeapNode[nW], nW];
	FOR w IN [0 .. nW) DO words[w] _ 0 ENDLOOP;
	bitCount _
	  IF seb[aType].oldPacked AND BitsForType[cType] <= ByteLength
	    THEN ByteLength ELSE WordLength;
	w _ 0;  bitsLeft _ WordLength;
	ScanList[son[2], PackElement];  FreeNode[node];
	PushLit[LiteralOps.FindDescriptor[words]];
	PushNode[IF nW = 1 THEN cast ELSE mwconst, 1];  SetInfo[aType];
	SystemDefs.FreeHeapNode[BASE[words]];
	val _ PopTree[];  nRegs _ RegsForType[aType];
	END
      ELSE
	BEGIN attr1 _ strings # lstrings; val _ [subtree[index: node]] END;
    seb[aType].lengthUsed _ TRUE;  VPush[0, other, nRegs];  RETURN
    END;

  All: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
    BEGIN
    OPEN tb[node];
    aType: Symbols.ArraySEIndex = info;
    cType: CSEIndex = UnderType[seb[aType].componentType];
    IF son[1] # Tree.Null THEN
      BEGIN
      son[1] _ Rhs[son[1], cType];
      IF OperandType[son[1]] # cType THEN son[1] _ ForceType[son[1], cType];
      VPop[];
      END;
    VPush[0, other, RegsForType[aType]];
    seb[aType].lengthUsed _ TRUE;  RETURN [[subtree[index: node]]]
    END;


 
  Dollar: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    rep: Repr;
    bias: INTEGER;
    nRegs: RegCount;
    k: RegCount = RegsForType[info];
    son[1] _ Exp[son[1], none];  nRegs _ VRegs[];  VPop[];
    son[2] _ Exp[son[2], none];  rep _ VRep[];  bias _ VBias[];  VPop[];
    IF ~StructuredLiteral[son[1]]
      THEN  BEGIN val _ [subtree[index: node]]; nRegs _ MAX[nRegs, k] END
      ELSE
	WITH son[2] SELECT FROM
	  symbol =>
	    BEGIN
	    val _ UnpackField[son[1], index];  FreeNode[node];  nRegs _ k;
	    END;
	  ENDCASE => ERROR;
    VPush[bias, rep, nRegs];  RETURN
    END;


  Index: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    aType, iType, cType: CSEIndex;
    next: SEIndex;
    nRegs: RegCount;
    son[1] _ Exp[son[1], none];
    FOR aType _ OperandType[son[1]], UnderType[next]
      DO
      WITH seb[aType] SELECT FROM
	array =>
	  BEGIN
	  iType _ UnderType[indexType]; cType _ UnderType[componentType]; EXIT
	  END;
	arraydesc =>  next _ describedType;
	long =>  next _ rangeType;
	ENDCASE =>  ERROR;
      ENDLOOP;
    IF name = dindex
      THEN
	BEGIN
	son[2] _ RValue[son[2], BiasForType[iType], unsigned];
	attr1 _ dataPtr.switches['n];  attr3 _ dataPtr.switches['b];
	END
      ELSE son[2] _ Rhs[son[2], iType, TRUE];
    SELECT TRUE FROM
      (TreeLiteral[son[2]] AND TestTree[son[1], all]) =>
	BEGIN
	subNode: Tree.Index = GetNode[son[1]];
	val _ tb[subNode].son[1];
	tb[subNode].son[1] _ Tree.Null;  FreeNode[node];
	nRegs _ RegsForType[cType];
	END;
      (TreeLiteral[son[2]] AND StructuredLiteral[son[1]]) =>
	BEGIN
	val _ UnpackElement[son[1], TreeLiteralValue[son[2]]]; FreeNode[node];
	nRegs _ RegsForType[cType];
	END;
      ENDCASE =>
	BEGIN val _ [subtree[index:node]]; nRegs _ ComputeIndexRegs[node] END;
    VPop[]; VPop[];  VPush[BiasForType[cType], RepForType[cType], nRegs];
    RETURN
    END;

  Reloc: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    nRegs: RegCount;
    type: CSEIndex = tb[node].info;
    tb[node].son[1] _ RValue[tb[node].son[1], 0, unsigned];
    tb[node].son[2] _ RValue[tb[node].son[2], 0, unsigned];
    nRegs _ ComputeIndexRegs[node];  VPop[]; VPop[];
    IF ~tb[node].attr1 AND ZeroP[tb[node].son[1]]
      THEN
	BEGIN
	subType: CSEIndex = OperandType[tb[node].son[2]];
	rType: CSEIndex;
	PushTree[tb[node].son[2]];  tb[node].son[2] _ Tree.Null;
	WITH r: seb[subType] SELECT FROM
	  relative =>
	    BEGIN
	    rType _ UnderType[r.resultType];
	    IF tb[node].attr2 AND seb[UnderType[r.offsetType]].typeTag # long
	      THEN
		BEGIN
		PushNode[lengthen, 1];
		SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE];
		END
	      ELSE  PushNode[cast, 1];
	    END;
	  ENDCASE => ERROR;
	SetInfo[rType];
	PushNode[uparrow, 1];  SetInfo[type];
	SetAttr[1, dataPtr.switches['n]];  SetAttr[2, tb[node].attr2];
	val _ PopTree[];  FreeNode[node];
	END
      ELSE  val _ [subtree[node]];
    VPush[BiasForType[type], RepForType[type], nRegs];
    END;


  Assignment: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Tree.Link] =
    BEGIN  OPEN tb[node];
    lhsType: CSEIndex;
    son[1] _ Exp[son[1], none];  lhsType _ OperandType[son[1]];
    son[2] _ Rhs[son[2], lhsType];  VPop[];
    RETURN [RewriteAssign[node, lhsType]]
    END;


  TargetRep: PUBLIC PROCEDURE [rep: Repr] RETURNS [Repr] =
    BEGIN
    RETURN [IF rep = both THEN signed ELSE rep]
    END;


  Rhs: PUBLIC PROCEDURE [
	exp: Tree.Link, lType: CSEIndex, voidOK: BOOLEAN _ FALSE]
      RETURNS [val: Tree.Link] =
    BEGIN
    lBias: INTEGER = BiasForType[lType];
    lRep: Repr = RepForType[lType];
    rType: CSEIndex _ OperandType[exp];
    rRep: Repr;
    nw: CARDINAL;
    val _ RValue[exp, lBias, TargetRep[lRep]];
    rRep _ VRep[];
    IF ~Types.Assignable[
	[dataPtr.ownSymbols, lType], [dataPtr.ownSymbols, rType]]
      THEN  Log.ErrorTree[typeClash, val];
    nw _ WordsForType[lType];
    IF ~(IF nw = 0 THEN voidOK ELSE WordsForType[rType] = nw) THEN
      SELECT seb[lType].typeTag FROM
	record =>  val _ PadRecord[val, lType];
	union =>  NULL;
	ENDCASE =>  Log.ErrorTree[sizeClash, val];
    IF (lType = dataPtr.typeINTEGER AND rRep = unsigned) OR
       ((rType = dataPtr.typeINTEGER AND rRep = signed) AND lRep = unsigned)
      THEN val _ CheckRange[val, CARDINAL[AltoDefs.maxinteger-lBias]+1, lType]
      ELSE
	SELECT seb[lType].typeTag FROM
	  subrange, enumerated, relative =>
	    SELECT Cover[lType, lRep, rType, rRep] FROM
	      full => NULL;
	      partial =>  val _ CheckRange[val, Cardinality[lType], lType];
	      ENDCASE =>  IF nw # 0 THEN val _ BoundsFault[val, lType];
	  basic =>
	    IF lType = dataPtr.typeCHARACTER AND
	     (rRep # both OR TreeLiteral[val])
	      THEN  val _ CheckRange[val, Cardinality[lType], lType];
	  ENDCASE => NULL;
    RETURN
    END;


  Cover: PUBLIC PROCEDURE [lType: CSEIndex, lRep: Repr, rType: CSEIndex, rRep: Repr]
      RETURNS [Covering] =
    BEGIN
    lLb, lUb, rLb, rUb: LONG INTEGER;
    [lLb, lUb] _ Bounds[lType, lRep];
    [rLb, rUb] _ Bounds[rType, rRep];
    RETURN [
      IF lLb <= rLb
	THEN IF lUb < rLb THEN none ELSE IF lUb < rUb THEN partial ELSE full
	ELSE IF lLb <= rUb THEN partial ELSE none]
    END;

  Bounds: PROCEDURE [type: CSEIndex, rep: Repr] RETURNS [lb, ub: LONG INTEGER] =
    BEGIN
    WITH t: seb[type] SELECT FROM
      subrange => BEGIN  lb _ t.origin; ub _ lb + t.range  END;
      enumerated => BEGIN  lb _ 0; ub _ t.nValues-1  END;
      relative =>  [lb, ub] _ Bounds[UnderType[t.offsetType], rep];
      ENDCASE =>
	SELECT rep FROM
	  signed =>
	    BEGIN  lb _ -AltoDefs.maxinteger-1; ub _ AltoDefs.maxinteger  END;
	  both =>  BEGIN  lb _ 0;  ub _ AltoDefs.maxinteger  END;
	  ENDCASE =>  BEGIN  lb _ 0;  ub _ AltoDefs.maxword  END;
    RETURN
    END;

  CheckRange: PROCEDURE [t: Tree.Link, bound: CARDINAL, type: CSEIndex]
      RETURNS [val: Tree.Link] =
    BEGIN
    SELECT TRUE FROM
      (bound = 0) =>  val _ t;
      TreeLiteral[t] =>
	val _ IF TreeLiteralValue[t] >= bound THEN BoundsFault[t,type] ELSE t;
      dataPtr.switches['b] =>
	BEGIN
	PushTree[MakeTreeLiteral[bound]];
	IF TestTree[t, safen]
	  THEN
	    BEGIN
	    node: Tree.Index = GetNode[t];
	    PushTree[tb[node].son[1]];  PushNode[check, -2];  SetInfo[type];
	    tb[node].son[1] _ PopTree[];  val _ t;
	    END
	  ELSE
	    BEGIN
	    PushTree[t];
	    PushNode[check, -2];  SetInfo[type];  val _ PopTree[];
	    END;
	END;
      ENDCASE =>  val _ t;
    RETURN
    END;

  BoundsFault: PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] =
    BEGIN
    Log.ErrorTree[boundsFault, AdjustBias[t, -BiasForType[type]]];
    PushTree[t];  PushTree[MakeTreeLiteral[0]];
    PushNode[check, 2];  SetInfo[type];
    RETURN [PopTree[]]
    END;

  PushAssignment: PUBLIC PROCEDURE [id, val: Tree.Link, type: CSEIndex] =
    BEGIN
    rewrite: BOOLEAN;
    i, n: CARDINAL;
    rewrite _ TRUE;
    WITH val SELECT FROM
      subtree =>
	SELECT tb[index].name FROM
	  body, signalinit =>  rewrite _ FALSE;
	  ENDCASE => NULL;
      ENDCASE => NULL;
    ScanList[id, PushTree];  n _ ListLength[id];  PushTree[val];
    FOR i IN [1 .. n]
      DO
      IF i = n
	THEN  PushNode[assign, 2]
	ELSE  BEGIN  PushNode[assignx, 2];  SetInfo[type]  END;
      IF rewrite
	THEN PushTree[RewriteAssign[GetNode[PopTree[]], type]]
	ELSE SetAttr[1, FALSE];
      ENDLOOP;
    END;



  RewriteAssign: PROCEDURE [node: Tree.Index, lType: CSEIndex] RETURNS [Tree.Link] =
    BEGIN
    IF (tb[node].attr1 _ seb[lType].typeTag = union)
      THEN
	BEGIN
	WITH tb[node].son[1] SELECT FROM
	  subtree =>
	    BEGIN
	    subType: CSEIndex;
	    subNode: Tree.Index = index;
	    SELECT tb[subNode].name FROM
	      dot =>
		BEGIN
		subType _ OperandType[tb[subNode].son[1]];
		PushTree[tb[subNode].son[1]];  PushNode[uparrow, 1];
		SetInfo[WITH seb[subType] SELECT FROM
			pointer => UnderType[refType],
			ENDCASE => Symbols.typeANY];
		tb[subNode].son[1] _ PopTree[];
		tb[subNode].name _ dollar;
		END;
	      dollar =>  NULL;
	      ENDCASE =>  NULL;	-- flagged by code generators for now
	    END;
	  ENDCASE =>  NULL;	-- flagged by code generators for now
	END;
    IF tb[node].name = assignx
      THEN tb[node].info _ OperandType[tb[node].son[1]];
    RETURN [[subtree[index: node]]]
    END;


 -- misc addressing operators

  AddrOp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    nRegs: RegCount;
    SELECT tb[node].name FROM

      addr =>  val _ Addr[node];

      base =>
	BEGIN
	tb[node].son[1] _ Exp[tb[node].son[1], none]; nRegs _ VRegs[]; VPop[];
	VPush[0, unsigned, nRegs];  val _ [subtree[index: node]];
	END;

      length =>
	BEGIN
	type: CSEIndex;
	tb[node].son[1] _ Exp[tb[node].son[1], none];
	type _ OperandType[tb[node].son[1]];
	WITH seb[type] SELECT FROM
	  array =>
	    BEGIN
	    val _ MakeTreeLiteral[Cardinality[indexType]];
	    FreeNode[node];  nRegs _ 1;
	    END;
	  ENDCASE =>  BEGIN val _ [subtree[index: node]]; nRegs _ VRegs[] END;
	VPop[];  VPush[0, both, nRegs];
	END;

      arraydesc =>
	BEGIN
	subNode: Tree.Index = GetNode[tb[node].son[1]];
	type: CSEIndex = tb[node].info;
	tb[subNode].son[1] _ RValue[tb[subNode].son[1], 0, unsigned];
	nRegs _ VRegs[];
	tb[subNode].son[2] _ RValue[tb[subNode].son[2], 0, none];
	nRegs _ MAX[VRegs[], nRegs];
	IF tb[subNode].son[3] # Tree.Null THEN TypeExp[tb[subNode].son[3]];
	VPop[]; VPop[];
	IF StructuredLiteral[tb[subNode].son[1]]
	 AND StructuredLiteral[tb[subNode].son[2]]
	  THEN
	    BEGIN
	    n: CARDINAL = WordsForType[type];
	    words: DESCRIPTOR FOR ARRAY OF WORD;
	    words _ DESCRIPTOR[SystemDefs.AllocateHeapNode[n], n];
	    [] _ FillMultiWord[
		    words,
		    FillMultiWord[words, 0, tb[subNode].son[1]],
		    tb[subNode].son[2]];
	    PushLit[LiteralOps.FindDescriptor[words]];
	    PushNode[mwconst, 1];  SetInfo[type];
	    SystemDefs.FreeHeapNode[BASE[words]];
	    val _ PopTree[];  FreeNode[node];
	    END
	  ELSE val _ [subtree[index: node]];
	VPush[0, other, MAX[RegsForType[type], nRegs]];
	END;

      ENDCASE =>
	BEGIN
	Log.Error[unimplemented];  VPush[0, none, 0];  val _ [subtree[node]];
	END;

    RETURN
    END;

  Addr: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN  OPEN tb[node];
    subNode: Tree.Index;
    t, v: Tree.Link;
    type, next: CSEIndex;
    nRegs: RegCount;
    WordSize: CARDINAL = AltoDefs.wordlength;
    son[1] _ Exp[son[1], none];  nRegs _ MAX[VRegs[], RegsForType[info]];
    FOR t _ son[1], v
      DO
      WITH t SELECT FROM
	symbol =>
	  BEGIN
	  IF ctxb[seb[index].idCtx].level = Symbols.lZ AND
	     (LOOPHOLE[seb[index].idValue, Symbols.BitAddress].bd # 0 OR
	      LOOPHOLE[seb[index].idInfo, CARDINAL] MOD WordSize # 0)
	    THEN GO TO fail;
	  GO TO pass;
	  END;
	subtree =>
	  BEGIN  subNode _ index;
	  SELECT tb[subNode].name FROM
	    dot, dollar =>  v _ tb[subNode].son[2];
	    index, dindex =>
	      FOR  type _ NormalType[OperandType[tb[subNode].son[1]]], next
		DO
		WITH seb[type] SELECT FROM
		  array =>  IF oldPacked THEN GO TO fail ELSE GO TO pass;
		  arraydesc =>  next _ UnderType[describedType];
		  ENDCASE => ERROR;
		ENDLOOP;
	    seqindex => GO TO fail;
	    uparrow, reloc =>  GO TO pass;
	    cast, chop =>  v _ tb[subNode].son[1];
	    ENDCASE =>  ERROR;
	  END;
	ENDCASE =>  ERROR;
      REPEAT
	pass => NULL;
	fail => Log.ErrorTree[nonAddressable, son[1]]; 
      ENDLOOP;
    val _ [subtree[index: node]];
    IF TestTree[son[1], dot]
      THEN
	BEGIN  subNode _ GetNode[son[1]];
	IF TreeLiteral[tb[subNode].son[1]]
	  THEN
	    WITH tb[subNode].son[2] SELECT FROM
	      symbol =>
		BEGIN
		val _ MakeStructuredLiteral[
		       TreeLiteralValue[tb[subNode].son[1]] +
			LOOPHOLE[seb[index].idValue, Symbols.BitAddress].wd,
		      info];
		FreeNode[node];
		END;
	      ENDCASE => ERROR;
	END;
    VPop[];  VPush[0, unsigned, nRegs];  RETURN
    END;

  END.