-- file Pass4Xa.mesa
-- last written by Satterthwaite, May 21, 1982 1:54 pm

DIRECTORY
  Alloc: TYPE USING [Notifier],
  ComData: TYPE USING [ownSymbols, switches, typeINT, typeCARDINAL, typeCHAR, zone],
  Environment: TYPE USING [bitsPerByte, bitsPerWord, maxCARDINAL, maxINTEGER],
  Heap: TYPE USING [FreeNode, MakeNode],
  Inline: TYPE USING [BITAND, BITOR, BITSHIFT],
  Literals: TYPE USING [Base, LitDescriptor, ltType],
  LiteralOps: TYPE USING [ValueDescriptor, FindDescriptor, MasterString],
  Log: TYPE USING [Error, ErrorN, ErrorTree],
  P4: TYPE USING [
    Covering, Repr, none, signed, unsigned, both, other, RegCount, MaxRegs,
    checked, 
    AdjustBias, BiasForType, BitsForType, CatchNest, ComputeIndexRegs,
    Exp, ForceType, MakeStructuredLiteral, MakeTreeLiteral, OperandType,
    RegsForType, RepForType, RValue, StructuredLiteral, TreeLiteral,
    TreeLiteralDesc, TreeLiteralValue, TypeExp, TypeForTree,
    VBias, VPop, VPush, VRegs, VRep, WordsForType, ZeroP],
  Pass4: TYPE USING [implicitBias, implicitRep, implicitType],
  Symbols: TYPE USING [
    Base, BitAddress, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
    ISENull, RecordSENull, typeANY, ctxType, seType],
  SymbolOps: TYPE USING [
    ArgRecord, BitsPerElement, Cardinality, FirstVisibleSe, FnField, NextSe,
    RecordRoot, UnderType, VariantField],
  Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, treeType],
  TreeOps: TYPE USING [
    FreeNode, FreeTree, GetNode, ListLength, NthSon, OpName, PopTree, PushTree,
    PushLit, PushNode, ScanList, SetAttr, SetInfo, UpdateList],
  Types: TYPE USING [Assignable];

Pass4Xa: PROGRAM
    IMPORTS
      Heap, Inline, Log, LiteralOps, P4, SymbolOps, TreeOps, Types,
      dataPtr: ComData, passPtr: Pass4
    EXPORTS P4 = {
  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: Tree.Base;	-- tree base address (local copy)
  ltb: Literals.Base;	-- literal base address (local copy)
  seb: Symbols.Base;	-- se table base address (local copy)
  ctxb: Symbols.Base;	-- context table base address (local copy)

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


 -- expression list manipulation

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

    EvaluateField: Tree.Map = {
      type: CSEIndex = UnderType[seb[sei].idType];
      IF t = Tree.Null THEN {
	v _ Tree.Null;
	IF BitsForType[type] # 0 OR VariantType[type] THEN const _ FALSE}
      ELSE {
	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[]};
      sei _ NextSe[sei];
      RETURN};

    sei _ FirstVisibleSe[seb[record].fieldCtx];  const _ TRUE;  nRegs _ 0;
    val _ UpdateList[expList, EvaluateField];
    IF OpName[val] = list THEN {subNode _ GetNode[val]; tb[subNode].attr1 _ const};
    RETURN};

    VariantType: PROC [type: CSEIndex] RETURNS [BOOLEAN] = INLINE {
      RETURN [SELECT seb[type].typeTag FROM
	union, sequence => TRUE,
	ENDCASE => FALSE]};

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

  MakeArgRecord: PUBLIC PROC [record: RecordSEIndex, expList: Tree.Link]
      RETURNS [val: Tree.Link] = {
    SELECT TRUE FROM
      (expList = Tree.Null) => val _ Tree.Null;
      (record = Symbols.RecordSENull) => val _ FreeTree[expList];
      (OpName[expList] = list) => val _ MakeRecord[record, expList].val;
      ENDCASE => {
	type: CSEIndex = UnderType[seb[FirstVisibleSe[seb[record].fieldCtx]].idType];
	val _ Rhs[expList, type];  VPop[]};
    RETURN};


  -- construction of packed values (machine dependent)

  WordLength: CARDINAL = Environment.bitsPerWord;
  ByteLength: CARDINAL = Environment.bitsPerByte;

  FillMultiWord: PUBLIC PROC [
      words: LiteralOps.ValueDescriptor, origin: CARDINAL, t: Tree.Link] = {
    desc: Literals.LitDescriptor = TreeLiteralDesc[t];
    IF origin + desc.length <= LENGTH[words] THEN
      FOR i: CARDINAL IN [0 .. desc.length) DO words[origin+i] _ ltb[desc.offset][i] ENDLOOP};

  PackRecord: PROC [record: RecordSEIndex, expList: Tree.Link] RETURNS [Tree.Link] = {
    n: CARDINAL = WordsForType[record];
    root, type: RecordSEIndex;
    list: Tree.Link;
    sei: ISEIndex;
    offset: CARDINAL;
    words: LiteralOps.ValueDescriptor;
    more: BOOLEAN;

    StoreBits: PROC [sei: ISEIndex, value: WORD] = {
      OPEN Inline;
      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 {address _ seb[sei].idValue; size _ seb[sei].idInfo};
      w _ address.wd;
      shift _ (WordLength-offset) - (address.bd+size);
      words[w] _ BITOR[words[w], BITSHIFT[BITAND[value, Masks[size]], shift]]};

    PackField: Tree.Scan = {
      node: Tree.Index;
      address: BitAddress;
      typeId: ISEIndex;
      subType: CSEIndex;
      SELECT TRUE FROM
	t = Tree.Null => NULL;
        TreeLiteral[t] => StoreBits[sei, TreeLiteralValue[t]];
	ENDCASE => {
	  node _ GetNode[t];
	  SELECT tb[node].name FROM
	    mwconst => {
	      address _ IF seb[root].argument
	        THEN FnField[sei].offset
		ELSE seb[sei].idValue;
	      FillMultiWord[words, address.wd, tb[node].son[1]]};
	    union => {
	      typeId _ WITH tb[node].son[1] SELECT FROM
		symbol => 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};
	    ENDCASE => ERROR};
      sei _ NextSe[sei]};

    words _ DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n];
    FOR i: CARDINAL 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];
    Heap.FreeNode[dataPtr.zone, BASE[words]];
    RETURN [PopTree[]]};

  
  PadRecord: PUBLIC PROC [t: Tree.Link, lType: CSEIndex] RETURNS [Tree.Link] = {
    IF StructuredLiteral[t] THEN {
      nW: CARDINAL = WordsForType[lType];
      words: LiteralOps.ValueDescriptor;
      node: Tree.Index;
      words _ DESCRIPTOR[Heap.MakeNode[dataPtr.zone, nW], nW];
      FOR w: CARDINAL IN [0 .. nW) DO words[w] _ 0 ENDLOOP;
      IF TreeLiteral[t] THEN words[0] _ TreeLiteralValue[t]
      ELSE {
	node _ GetNode[t];
	SELECT tb[node].name FROM
	      mwconst => FillMultiWord[words, 0, tb[node].son[1]];
	      ENDCASE => ERROR;
	FreeNode[node]};
      PushLit[LiteralOps.FindDescriptor[words]];  PushNode[mwconst, 1];
      Heap.FreeNode[dataPtr.zone, BASE[words]]}
    ELSE {PushTree[t]; PushNode[pad, 1]};
    SetInfo[lType];
    RETURN [PopTree[]]};


  ExtractValue: PROC [t: Tree.Link, addr: BitAddress, size: CARDINAL, type: CSEIndex]
      RETURNS [val: Tree.Link] = {
    words: LiteralOps.ValueDescriptor;
    desc: Literals.LitDescriptor = TreeLiteralDesc[t];
    n: CARDINAL = size/WordLength;
    IF n > 1 THEN {
      IF addr.bd # 0 THEN Log.Error[unimplemented];
      words _ DESCRIPTOR[Heap.MakeNode[dataPtr.zone, n], n];
      FOR i: CARDINAL IN [0..n) DO words[i] _ ltb[desc.offset][addr.wd+i] ENDLOOP;
      PushLit[LiteralOps.FindDescriptor[words]];
      PushNode[mwconst, 1];  SetInfo[type];
      Heap.FreeNode[dataPtr.zone, BASE[words]];
      val _ PopTree[]}
    ELSE
      val _ MakeStructuredLiteral[
		Inline.BITSHIFT[
		  Inline.BITSHIFT[ltb[desc.offset][addr.wd], addr.bd],
		  -(WordLength - size)],
		type];
    RETURN};


  UnpackField: PROC [t: Tree.Link, field: ISEIndex] RETURNS [val: Tree.Link] = {
    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]]};

  UnpackElement: PROC [t: Tree.Link, i: CARDINAL] RETURNS [val: Tree.Link] = {
    aType: CSEIndex = OperandType[t];
    cType: CSEIndex;
    addr: BitAddress;
    nB, nW: CARDINAL;
    WITH a: seb[aType] SELECT FROM
      array => {
	cType _ UnderType[a.componentType];
	nB _ BitsPerElement[cType, a.packed];
	IF nB > ByteLength THEN {
	  nW _ (nB+(WordLength-1))/WordLength;
	  addr _ [wd:i*nW, bd:0];  nB _ nW*WordLength}
	ELSE {
	  itemsPerWord: CARDINAL = WordLength/nB;
	  offset: CARDINAL = IF WordsForType[aType] = 1
				THEN WordLength - BitsForType[aType]
				ELSE 0;
	  addr _ [wd: i/itemsPerWord, bd: offset + (i MOD itemsPerWord)*nB]}};
      ENDCASE => ERROR;
    RETURN [ExtractValue[t, addr, nB, cType]]};


 -- operators

  Call: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    OPEN tb[node];
    type: CSEIndex;
    son[1] _ Exp[son[1], none];  VPop[];
    type _ OperandType[son[1]];
    WITH t: seb[type] SELECT FROM
      transfer => {
	IF attr1 AND name # xerror AND t.typeIn # Symbols.RecordSENull THEN {
	  son[2] _ Rhs[son[2], t.typeIn]; VPop[]}
	ELSE son[2] _ MakeArgRecord[ArgRecord[t.typeIn], son[2]];
	VPush[BiasForType[t.typeOut], RepForType[t.typeOut], MaxRegs]};
      ENDCASE => ERROR;
    IF nSons > 2 THEN CatchNest[son[3]];
    RETURN [[subtree[index: node]]]};


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

  Union: PUBLIC PROC [node: Tree.Index, nested: BOOLEAN] RETURNS [val: Tree.Link] = {
    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]];
    attr2 _ tagged;
    SELECT TRUE FROM
      (OpName[son[2]] = list OR OpName[son[2]] = union) => {
        attr1 _ WITH son[2] SELECT FROM subtree => tb[index].attr1, ENDCASE => FALSE;
        val _ [subtree[index: node]];  VPush[0, other, nRegs]};
      (son[2] = Tree.Null) => {
	attr1 _ TRUE; val _ [subtree[index: node]]; VPush[0, other, 1]};
      ENDCASE =>
	IF (~tagged OR seb[vSei].idValue = 0) AND WordsForType[type] = 1
	 AND ZeroOffset[IF tagged THEN TagSei[tSei] ELSE FirstVisibleSe[seb[type].fieldCtx]]
	 THEN val _ CastUniList[node, type, nested]
	ELSE {
	  attr1 _ StructuredLiteral[son[2]];
	  val _ [subtree[index: node]];  VPush[0, other, RegsForType[type]]};
    RETURN};

  TagSei: PROC [tSei: CSEIndex] RETURNS [ISEIndex] = INLINE {
    RETURN [WITH seb[tSei] SELECT FROM union => tagSei, ENDCASE => Symbols.ISENull]};

  ZeroOffset: PROC [sei: ISEIndex] RETURNS [BOOLEAN] = INLINE {
    RETURN [sei # Symbols.ISENull AND seb[sei].idValue = BitAddress[0, 0]]};

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


  RowConstruct: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    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 = {
      IF t = Tree.Null THEN {v _ Tree.Null; const _ strings _ lstrings _ FALSE}
      ELSE {
	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 => {
		  const _ FALSE;
		  IF LiteralOps.MasterString[index] = index THEN lstrings _ FALSE
		  ELSE strings _ FALSE};
		ENDCASE;
	    ENDCASE => const _ strings _ lstrings _ FALSE;
	VPop[]};
      RETURN};

    w, nW: CARDINAL;
    words: LiteralOps.ValueDescriptor;
    bitsLeft: CARDINAL;
    bitCount: CARDINAL;

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

    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 {
      nW _ WordsForType[aType];
      words _ DESCRIPTOR[Heap.MakeNode[dataPtr.zone, nW], nW];
      FOR w: CARDINAL IN [0 .. nW) DO words[w] _ 0 ENDLOOP;
      bitCount _ BitsPerElement[cType, seb[aType].packed];
      w _ 0;  bitsLeft _ IF nW = 1 THEN BitsForType[aType] ELSE WordLength;
      ScanList[son[2], PackElement];  FreeNode[node];
      PushLit[LiteralOps.FindDescriptor[words]];
      PushNode[IF nW = 1 THEN cast ELSE mwconst, 1];  SetInfo[aType];
      Heap.FreeNode[dataPtr.zone, BASE[words]];
      val _ PopTree[];  nRegs _ RegsForType[aType]}
    ELSE {attr1 _ strings # lstrings; val _ [subtree[index: node]]};
    VPush[0, other, nRegs];  RETURN};

  All: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    OPEN tb[node];
    aType: Symbols.ArraySEIndex = info;
    cType: CSEIndex = UnderType[seb[aType].componentType];
    val _ [subtree[index: node]];
    IF son[1] # Tree.Null THEN {
      son[1] _ Rhs[son[1], cType];
      IF TreeLiteral[son[1]] AND WordsForType[aType] = 1 THEN {
	nB: CARDINAL = BitsPerElement[cType, seb[aType].packed];
	v, w: WORD;
	v _ TreeLiteralValue[son[1]];  w _ 0;
	THROUGH [1 .. Cardinality[seb[aType].indexType]] DO
	  w _ Inline.BITOR[Inline.BITSHIFT[w, nB], v] ENDLOOP;
	val _ ForceType[MakeTreeLiteral[w], aType];  FreeNode[node]}
      ELSE IF OperandType[son[1]] # cType THEN son[1] _ ForceType[son[1], cType];
      VPop[]};
    VPush[0, other, RegsForType[aType]];  RETURN};


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


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

  SeqIndex: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    OPEN tb[node];
    iType, cType, sType: CSEIndex;
    nRegs: RegCount;
    son[1] _ Exp[son[1], none];
    sType _ OperandType[son[1]];
    WITH t: seb[sType] SELECT FROM
      sequence => {
	iType _ UnderType[seb[t.tagSei].idType]; cType _ UnderType[t.componentType];
	attr3 _ t.controlled AND (checked OR dataPtr.switches['b])};
      array => {
	iType _ UnderType[t.indexType]; cType _ UnderType[t.componentType];
	attr3 _ checked OR dataPtr.switches['b]};
      ENDCASE;
    son[2] _ RValue[son[2], BiasForType[iType], TargetRep[RepForType[iType]]];
    nRegs _ ComputeIndexRegs[node];
    VPop[]; VPop[];  VPush[BiasForType[cType], RepForType[cType], nRegs];
    RETURN [[subtree[index:node]]]};

  Reloc: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    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 {
      rType, subType, next: CSEIndex;
      FOR subType _ OperandType[tb[node].son[2]], next DO    -- CanonicalType
	WITH r: seb[subType] SELECT FROM
	  relative => {
	    rType _ UnderType[r.resultType];
	    PushTree[tb[node].son[2]];  tb[node].son[2] _ Tree.Null;
	    IF tb[node].attr2 AND seb[UnderType[r.offsetType]].typeTag # long THEN {
	      PushNode[lengthen, 1];
	      SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE]}
	    ELSE PushNode[cast, 1];
	    EXIT};
	  record => next _ UnderType[seb[FirstVisibleSe[r.fieldCtx]].idType];
	  ENDCASE => ERROR;
	ENDLOOP;
      SetInfo[rType];
      PushNode[uparrow, 1];  SetInfo[type];
      SetAttr[1, dataPtr.switches['n]];  SetAttr[2, tb[node].attr2];
      val _ PopTree[];  FreeNode[node]}
    ELSE val _ [subtree[node]];
    VPush[BiasForType[type], RepForType[type], nRegs]};


  Assignment: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    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]]};

  Extract: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    subNode: Tree.Index = GetNode[tb[node].son[1]];
    rType: RecordSEIndex = tb[subNode].info;
    sei: ISEIndex;

    AssignItem: Tree.Map = {
      type: CSEIndex;
      saveType: CSEIndex = passPtr.implicitType;
      saveBias: INTEGER = passPtr.implicitBias;
      saveRep: Repr = passPtr.implicitRep;
      IF t = Tree.Null THEN v _ Tree.Null
      ELSE {
	subNode: Tree.Index = GetNode[t];
	type _ UnderType[seb[sei].idType];
	passPtr.implicitType _ type;
	passPtr.implicitBias _ BiasForType[type];  passPtr.implicitRep _ RepForType[type];
	v _ IF tb[subNode].name = extract THEN Extract[subNode] ELSE Assignment[subNode];
	VPop[]};
      sei _ NextSe[sei];
      passPtr.implicitRep _ saveRep;  passPtr.implicitBias _ saveBias;
      passPtr.implicitType _ saveType;  RETURN};

    sei _ FirstVisibleSe[seb[rType].fieldCtx];
    tb[subNode].son[1] _ UpdateList[tb[subNode].son[1], AssignItem];
    tb[node].son[2] _ Exp[tb[node].son[2], none];  VPop[];
    VPush[BiasForType[rType], RepForType[rType], MaxRegs];
    RETURN [[subtree[index:node]]]};


  New: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
    OPEN tb[node];
    IF son[1] # Tree.Null THEN {son[1] _ Exp[son[1], none]; VPop[]};
    IF OpName[son[2]] = apply THEN {
      subNode: Tree.Index = GetNode[son[2]];
      vSei: ISEIndex;
      TypeExp[tb[subNode].son[1]];
      tb[subNode].son[2] _ Rhs[tb[subNode].son[2], dataPtr.typeCARDINAL];  VPop[];
      vSei _ VariantField[UnderType[TypeForTree[tb[subNode].son[1]]]];
      IF vSei # Symbols.ISENull THEN {
	vType: CSEIndex = UnderType[seb[vSei].idType];
	n: CARDINAL = WITH t: seb[vType] SELECT FROM
		sequence => Cardinality[seb[t.tagSei].idType],
		ENDCASE => 0;
	subType: CSEIndex = OperandType[tb[subNode].son[2]];
	IF subType = dataPtr.typeINT OR ~(Cardinality[subType] IN [1..n]) THEN  -- (0..n]
	  tb[subNode].son[2] _ CheckRange[tb[subNode].son[2], n, dataPtr.typeCARDINAL]}}
    ELSE TypeExp[son[2], OpName[son[3]] = body];
    SELECT OpName[son[3]] FROM
      body => {
	expNode: Tree.Index = GetNode[son[3]];
	PushNode[body, 0];  SetInfo[tb[expNode].info];  son[3] _ PopTree[]};
      signalinit => NULL;
      ENDCASE =>
	IF son[3] # Tree.Null THEN {
	  son[3] _ Rhs[son[3], UnderType[TypeForTree[son[2]]]]; VPop[]};
    IF nSons > 3 THEN CatchNest[son[4]];
    VPush[0, unsigned, MaxRegs];
    RETURN [[subtree[index:node]]]};


  Narrow: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
    type: CSEIndex = tb[node].info;
    IF tb[node].son[2] # Tree.Null THEN TypeExp[tb[node].son[2]];
    IF tb[node].attr2 OR tb[node].attr3 THEN {
      OPEN tb[node];
      son[1] _ RValue[son[1], 0, RepForType[OperandType[son[1]]]];  VPop[];
      IF nSons > 2 THEN CatchNest[son[3]];
      val _ [subtree[index: node]];
      VPush[BiasForType[type], RepForType[type], MaxRegs]}
    ELSE {
      val _ Rhs[tb[node].son[1], type];
      tb[node].son[1] _ Tree.Null;  FreeNode[node]}};


  TargetRep: --PUBLIC-- PROC [rep: Repr] RETURNS [Repr] = INLINE {
    RETURN [--IF rep = both THEN signed ELSE-- rep]};


  Rhs: PUBLIC PROC [exp: Tree.Link, lType: CSEIndex, voidOK: BOOLEAN _ FALSE]
      RETURNS [val: Tree.Link] = {
    lBias: INTEGER = BiasForType[lType];
    lRep: Repr = RepForType[lType];
    nw: CARDINAL = WordsForType[lType];
    rType: CSEIndex = OperandType[exp];
    rRep: Repr;
    val _ RValue[exp, lBias, TargetRep[lRep]];  rRep _ VRep[];
    IF ~Types.Assignable[[dataPtr.ownSymbols, lType], [dataPtr.ownSymbols, rType]] THEN
      Log.ErrorTree[typeClash, val];
    IF ~(IF nw = 0 THEN voidOK ELSE WordsForType[rType] = nw) THEN
      SELECT TRUE FROM
	(seb[lType].typeTag = record) AND (seb[rType].typeTag = record) =>
	  val _ PadRecord[val, lType];
	(seb[lType].typeTag = union) AND (seb[rType].typeTag = union) => NULL;
	ENDCASE => Log.ErrorTree[sizeClash, val];
    IF (lType = dataPtr.typeINT AND rRep = unsigned) OR
       ((rType = dataPtr.typeINT AND rRep = signed) AND lRep = unsigned) THEN
      val _ CheckRange[val, CARDINAL[Environment.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.typeCHAR AND (rRep # both OR TreeLiteral[val]) THEN
	    val _ CheckRange[val, Cardinality[lType], lType];
	ENDCASE => NULL;
    RETURN};


  Cover: PUBLIC PROC [lType: CSEIndex, lRep: Repr, rType: CSEIndex, rRep: Repr]
      RETURNS [Covering] = {
    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]};

  Bounds: PROC [type: CSEIndex, rep: Repr] RETURNS [lb, ub: LONG INTEGER] = {
    WITH t: seb[type] SELECT FROM
      subrange => {lb _ t.origin; ub _ lb + t.range};
      enumerated => {lb _ 0; ub _ t.nValues-1};
      relative => [lb, ub] _ Bounds[UnderType[t.offsetType], rep];
      ENDCASE =>
	SELECT rep FROM
	  signed => {lb _ -Environment.maxINTEGER-1; ub _ Environment.maxINTEGER};
	  both => {lb _ 0;  ub _ Environment.maxINTEGER};
	  ENDCASE => {lb _ 0;  ub _ Environment.maxCARDINAL};
    RETURN};

  CheckRange: PUBLIC PROC [t: Tree.Link, bound: CARDINAL, type: CSEIndex]
      RETURNS [val: Tree.Link] = {
    SELECT TRUE FROM
      (bound = 0) => val _ t;
      TreeLiteral[t] =>
	val _ IF TreeLiteralValue[t] >= bound THEN BoundsFault[t,type] ELSE t;
      (checked OR dataPtr.switches['b]) AND ~Bounded[t, bound] => {
	PushTree[MakeTreeLiteral[bound]];
	IF OpName[t] = safen THEN {
	  node: Tree.Index = GetNode[t];
	  PushTree[tb[node].son[1]];  PushNode[check, -2];  SetInfo[type];
	  tb[node].son[1] _ PopTree[];  val _ t}
	ELSE {PushTree[t]; PushNode[check,-2]; SetInfo[type]; val _ PopTree[]}};
      ENDCASE => val _ t;
    RETURN};

  Bounded: PROC [t: Tree.Link, bound: CARDINAL] RETURNS [BOOLEAN] = INLINE {
    IF OpName[t] = mod THEN {
      t2: Tree.Link = NthSon[t, 2];
      RETURN [TreeLiteral[t2] AND TreeLiteralValue[t2] IN [0..bound]]}
    ELSE RETURN [FALSE]};

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


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

  }.