-- 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]]]};

  }.