-- file Pass3Xa.Mesa
-- last modified by Satterthwaite, December 17, 1979  1:46 PM

DIRECTORY
  ComData: FROM "comdata"
    USING [
      ownSymbols, seAnon,
      typeCHARACTER, typeCONDITION, typeINTEGER, typeStringBody],
  Copier: FROM "copier" USING [CompleteContext],
  InlineDefs: FROM "inlinedefs" USING [BITAND],
  Log: FROM "log"
    USING [Error, ErrorHti, ErrorN, ErrorNode, ErrorSei, ErrorTree],
  P3: FROM "p3"
    USING [
      Attr, EmptyAttr, FullAttr, VoidAttr, NPUse, MergeNP, SetNP,
      --And,-- ArrangeKeys, Bundling, CanonicalType, CatchPhrase,
      CompleteRecord, DefaultInit, DefinedId, DiscriminatedType, Exp,
      FieldId, ForceType, OperandType, PopCtx, PushCtx,
      RAttr, RecordLhs, Rhs, RPop, RPush, RType, Span, TargetType,
      TypeForTree, Unbundle, UpdateTreeAttr,
      VariantUnionType, Voidable, VoidExp, VoidItem, XferForFrame],
  Pass3: FROM "pass3"
    USING [
      currentBody, enclosingBody,
      implicitAttr, implicitRecord, implicitType, lockHeld],
  Symbols: FROM "symbols"
    USING [bodyType, ctxType, seType,
      HTIndex, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex,
      CTXIndex, CBTIndex,
      HTNull, SENull, ISENull, CSENull, CTXNull, CBTNull,
      lG, typeANY, typeTYPE],
  SymbolOps: FROM "symbolops"
    USING [
      ConstantId, FindExtension, FirstVisibleSe, NextSe,
      NormalType, TypeRoot, UnderType, VisibleCtxEntries, XferMode],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree"
    USING [Index, Link, Map, NodeName, Scan, Null, NullIndex, treeType],
  TreeOps: FROM "treeops"
    USING [
      FreeNode, FreeTree, GetNode, IdentityMap, ListHead, ListLength,
      ListTail, MakeList, MakeNode, PopTree, PushList, PushTree,
      PushProperList, PushNode, ScanList, SetAttr, SetInfo, TestTree,
      UpdateList],
  Types: FROM "types" USING [SymbolTableBase, Assignable];

Pass3Xa: PROGRAM
    IMPORTS
	Copier, InlineDefs, Log, P3, SymbolOps, TreeOps, Types,
	dataPtr: ComData, passPtr: Pass3
    EXPORTS P3 =
  BEGIN
  OPEN SymbolOps, TreeOps, P3;

  And: PROCEDURE [Attr, Attr] RETURNS [Attr] = LOOPHOLE[InlineDefs.BITAND];

 -- pervasive definitions from Symbols

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

  CTXIndex: TYPE = Symbols.CTXIndex;


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

  own: Types.SymbolTableBase;

  ExpANotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    seb ← base[Symbols.seType];  ctxb ← base[Symbols.ctxType];
    bb ← base[Symbols.bodyType];
    tb ← base[Tree.treeType];
    own ← dataPtr.ownSymbols;
    END;

 -- parameter reference bookkeeping

  phraseNP: PUBLIC NPUse;

 -- tree manipulation utilities

  WritableRef: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
    type: CSEIndex;
    phraseNP ← SetNP[phraseNP];
    type ← OperandType[t];
      DO
      type ← NormalType[type];
      WITH t: seb[type] SELECT FROM
	pointer => RETURN [~t.readOnly];
	arraydesc => RETURN [~t.readOnly];
	relative => type ← UnderType[t.offsetType];
	ENDCASE => RETURN [TRUE];
      ENDLOOP;
    END;

  OperandLhs: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
      DO
      WITH t SELECT FROM
	symbol =>
	  BEGIN
	  sei: ISEIndex = index;
	  ctx: CTXIndex = seb[sei].idCtx;
	  IF ctx # Symbols.CTXNull
	    THEN
	      BEGIN
	      ctxb[ctx].varUpdated ← TRUE;
	      IF ctxb[ctx].level < passPtr.currentBody.level
		THEN  phraseNP ← SetNP[phraseNP];
	      END;
	  RecordLhs[sei];
	  RETURN [~seb[sei].immutable]
	  END;
	subtree =>
	  BEGIN
	  node: Tree.Index = index;
	  IF node = Tree.NullIndex THEN RETURN [FALSE];
	  SELECT tb[node].name FROM
	    dot =>
	      RETURN [WritableRef[tb[node].son[1]]
		AND (WITH tb[node].son[2] SELECT FROM
		  symbol => ~seb[index].immutable,
		  ENDCASE => FALSE)];
	    uparrow, dindex, seqindex =>
	      RETURN [WritableRef[tb[node].son[1]]];
	    reloc =>  RETURN [WritableRef[tb[node].son[2]]];
	    dollar =>
	      WITH tb[node].son[2] SELECT FROM
		symbol =>
		  IF ~seb[index].immutable
		    THEN t ← tb[node].son[1]
		    ELSE RETURN [FALSE];
		ENDCASE =>  RETURN [FALSE];
	    index, loophole, cast, openx, pad, chop =>  t ← tb[node].son[1];
	    cdot =>  t ← tb[node].son[2];
	    apply =>  RETURN [ListLength[tb[node].son[1]] = 1];
	    ENDCASE =>  RETURN [FALSE];
	  END;
	ENDCASE =>  RETURN [FALSE];
      ENDLOOP;
    END;

  LongPath: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [long: BOOLEAN] =
    BEGIN
    node: Tree.Index;
    WITH t SELECT FROM
      subtree =>
	BEGIN  node ← index;
	IF node = Tree.NullIndex
	  THEN  long ← FALSE
	  ELSE  SELECT tb[node].name FROM
	    loophole, cast, openx, pad, chop =>
	      long ← LongPath[tb[node].son[1]];
	    ENDCASE
	    -- dot, uparrow, dindex, reloc, seqindex, dollar, index -- =>
	      long ← tb[node].attr2;
	END;
      ENDCASE =>  long ← FALSE;
    RETURN
    END;


  OperandInline: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
    bti: Symbols.CBTIndex;
    SELECT XferMode[OperandType[t]] FROM
      procedure =>
	BEGIN
	bti ← BodyForTree[t];
 	RETURN [bti # Symbols.CBTNull AND bb[bti].inline]
	END;
      ENDCASE =>  RETURN [FALSE]
    END;

  OperandInternal: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN
    node: Tree.Index;
    WITH t SELECT FROM
      symbol =>
	BEGIN
	sei: ISEIndex = index;
	subNode: Tree.Index;
	bti: Symbols.CBTIndex;
	IF ~seb[sei].immutable THEN RETURN [FALSE];
	IF seb[sei].mark4
	  THEN
	    BEGIN
	    IF ~seb[sei].constant THEN RETURN [FALSE];
	    bti ← seb[sei].idInfo;
	    RETURN [bti # Symbols.CBTNull AND bb[bti].internal]
	    END;
	subNode ← seb[sei].idValue;
	RETURN [WITH tb[subNode].son[3] SELECT FROM
	  subtree => tb[index].name = body AND tb[index].attr2,
	  ENDCASE => FALSE]
	END;
      subtree =>
	BEGIN  node ← index;
	RETURN [SELECT tb[node].name FROM
	  dot, cdot, assignx => OperandInternal[tb[node].son[2]],
	  ifx =>
	    OperandInternal[tb[node].son[2]] OR OperandInternal[tb[node].son[3]],
	  ENDCASE => FALSE]	-- should check casex, bindx also
	END;
      ENDCASE =>  RETURN [FALSE];
    END;


 -- expression list manipulation

  KeyedList: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] =
    BEGIN  RETURN [t # Tree.Null AND TestTree[ListHead[t], item]]  END;

  PopKeyList: PROCEDURE [nItems: CARDINAL] RETURNS [t: Tree.Link] =
    BEGIN
    t ← MakeList[nItems];
    IF t = Tree.Null AND nItems # 0 THEN
      BEGIN PushTree[t]; PushProperList[1]; t ← PopTree[] END;
    RETURN
    END;


  CheckLength: PROCEDURE [t: Tree.Link, length: INTEGER] =
    BEGIN
    n: INTEGER = ListLength[t];
    SELECT n FROM
      = length => NULL;
      > length => Log.ErrorN[listLong, n-length];
      < length => Log.ErrorN[listShort, length-n];
      ENDCASE;
    END;

  ContextComplete: PROCEDURE [ctx: CTXIndex] RETURNS [BOOLEAN] =
    BEGIN
    RETURN [WITH ctxb[ctx] SELECT FROM
      simple => TRUE,
      included => complete,
      ENDCASE => FALSE]
    END;


  Safen: PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] =
    BEGIN
    PushTree[t];
    WITH t SELECT FROM
      subtree =>
	SELECT tb[index].name FROM
	  construct, union, rowcons =>  NULL;
	  ENDCASE =>  BEGIN  PushNode[safen, 1];  SetInfo[type]  END;
      ENDCASE =>  BEGIN  PushNode[safen, 1];  SetInfo[type]  END;
    RETURN [PopTree[]]
    END;


  Defaultable: PROCEDURE [type: SEIndex] RETURNS [BOOLEAN] =
    BEGIN
    s, next: SEIndex;
    FOR s ← type, next
      DO
      WITH seb[s] SELECT FROM
	id =>
	  BEGIN
	  sei: ISEIndex = LOOPHOLE[s];
	  IF seb[sei].extended THEN RETURN [TRUE];
	  next ← seb[sei].idInfo;
	  END;
	ENDCASE =>  RETURN [FALSE];
      ENDLOOP;
    END;

  PadList: PROCEDURE [expList: Tree.Link, ctx: CTXIndex] RETURNS [Tree.Link] =
    BEGIN
    sei: ISEIndex;
    added: BOOLEAN;
    nFields: CARDINAL;

    PushField: Tree.Map =
      BEGIN
      PushTree[t];  nFields ← nFields + 1;  sei ← NextSe[sei];
      RETURN [Tree.Null]
      END;

    sei ← FirstVisibleSe[ctx];  added ← FALSE;  nFields ← 0;
    [] ← FreeTree[UpdateList[expList, PushField]];
    UNTIL sei = SENull
      DO
      IF ~(seb[sei].extended OR Defaultable[seb[sei].idType]) THEN EXIT;
      PushTree[Tree.Null];  added ← TRUE;  nFields ← nFields + 1;
      sei ← NextSe[sei];
      ENDLOOP;
    IF added THEN PushProperList[nFields] ELSE PushList[nFields];
    RETURN [PopTree[]]
    END;


  FieldDefault: PROCEDURE [sei: ISEIndex] RETURNS [v: Tree.Link] =
    BEGIN
    CheckOption: Tree.Scan =
      BEGIN  IF ~TestTree[t, void] THEN v ← IdentityMap[t]  END;
    v ← Tree.Null;  ScanList[FindExtension[sei].tree, CheckOption];  RETURN
    END;


  MatchFields: PUBLIC PROCEDURE [record: RecordSEIndex, expList: Tree.Link, elisions: BOOLEAN]
      RETURNS [val: Tree.Link] =
    BEGIN
    nFields: CARDINAL;
    ctx: CTXIndex;
    sei: ISEIndex;
    attr: Attr;
    first: BOOLEAN;
    exitNP: NPUse;

    EvaluateField: Tree.Map =
      BEGIN
      subAttr: Attr;
      type: CSEIndex;
      SELECT TRUE FROM
	(t = Tree.Null) =>
	  BEGIN
	  IF ~elisions THEN Log.ErrorSei[elision, sei];
	  v ← IF seb[sei].extended THEN FieldDefault[sei]
				   ELSE DefaultInit[seb[sei].idType];
	  IF v = Tree.Null
	    THEN BEGIN subAttr ← VoidAttr; phraseNP ← none; type ← typeANY END
	    ELSE BEGIN subAttr ← UpdateTreeAttr[v]; type ← OperandType[v] END;
	  END;
	TestTree[t, void] =>
	  BEGIN
	  IF ~elisions THEN Log.ErrorSei[elision, sei];
	  v ← Tree.Null; subAttr ← VoidAttr; phraseNP ← none; type ← typeANY;
	  [] ← FreeTree[t];
	  END;
	ENDCASE =>
	  BEGIN
	  v ← Rhs[t, IF sei = SENull
		THEN typeANY
		ELSE TargetType[UnderType[seb[sei].idType]]];
	  subAttr ← RAttr[];  type ← RType[];  RPop[];
	  END;
      IF v = Tree.Null AND elisions AND
	  ~(IF seb[sei].extended
	      THEN VoidItem[FindExtension[sei].tree]
	      ELSE Voidable[seb[sei].idType])
	THEN  Log.ErrorSei[elision, sei];
      IF ~subAttr.noXfer AND (~first OR ~seb[record].argument)
	THEN v ← Safen[v, type];
      attr ← And[attr, subAttr];  first ← FALSE;
      exitNP ← MergeNP[exitNP][phraseNP];
      IF sei # SENull THEN sei ← NextSe[sei];
      RETURN
      END;

    KeyFillCheck: PROCEDURE [sei: ISEIndex] RETURNS [t: Tree.Link] =
      BEGIN
      IF elisions AND (seb[sei].extended OR Defaultable[seb[sei].idType])
	THEN  t ← Tree.Null
	ELSE
	  BEGIN
	  Log.ErrorHti[omittedKey, seb[sei].hash];
	  t ← [symbol[index: dataPtr.seAnon]];
	  END;
      RETURN
      END;

    IF record = SENull
      THEN  BEGIN  CheckLength[expList, 0];  sei ← Symbols.ISENull  END
      ELSE
	BEGIN
	CompleteRecord[record];
	IF ~ContextComplete[seb[record].fieldCtx]
	  THEN
	    BEGIN
	    IF seb[record].hints.privateFields THEN Log.Error[noAccess];
	    sei ← Symbols.ISENull;
	    END
	  ELSE
	    BEGIN
	    ctx ← seb[record].fieldCtx;
	    IF KeyedList[expList]
	      THEN
		BEGIN
		nFields ← ArrangeKeys[
		  expList,
		  ctx, FirstVisibleSe[ctx], Symbols.ISENull,
		  KeyFillCheck];
		expList ← PopKeyList[nFields];
		END
	      ELSE
		BEGIN
		nFields ← VisibleCtxEntries[ctx];
		IF ListLength[expList] < nFields AND elisions
		  THEN  expList ← PadList[expList, ctx];
		CheckLength[expList, nFields];
		END;
	    sei ← FirstVisibleSe[ctx];
	    END;
	END;
    attr ← FullAttr;  first ← TRUE;  exitNP ← none;
    val ← UpdateList[expList, EvaluateField];
    RPush[record, attr];  phraseNP ← exitNP;  RETURN
    END;


 -- operators

  Dot: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    type, rType, nType: CSEIndex;
    sei: ISEIndex;
    fieldHti: Symbols.HTIndex;
    op: Tree.NodeName;
    matched, long: BOOLEAN;
    attr: Attr;
    nHits: CARDINAL;
    nDerefs: CARDINAL;
    son[1] ← Exp[son[1], typeANY];  type ← RType[]; attr ← RAttr[]; RPop[];
    WITH son[2] SELECT FROM  hash =>  fieldHti ← index;  ENDCASE =>  ERROR;
    op ← dollar;  nDerefs ← 0;  long ← LongPath[son[1]];
    -- N.B. failure is avoided only by EXITing the following loop
      DO
      nType ← NormalType[type];
      WITH seb[nType] SELECT FROM
	record =>
	  BEGIN
	  [nHits, sei] ← FieldId[fieldHti, LOOPHOLE[nType, RecordSEIndex]];
	  SELECT nHits FROM
	    0 => IF Bundling[nType] = 0 THEN GO TO nomatch;
	    1 =>
	      BEGIN
	      son[2] ← [symbol[sei]];
	      rType ← UnderType[seb[sei].idType];
	      IF ~attr.const AND ConstantId[sei]
		THEN  BEGIN  op ← cdot;  attr.const ← TRUE  END;
	      EXIT
	      END;
	    ENDCASE => GO TO ambiguous;
	  type ← Unbundle[LOOPHOLE[nType, RecordSEIndex]];
	  son[1] ← IF op = dot
		  THEN Dereference[son[1], type, long]
		  ELSE ForceType[son[1], type];
	  op ← dollar;
	  END;
	pointer =>
	  BEGIN
	  IF (nDerefs ← nDerefs+1) > 255 THEN GO TO nomatch;
	  IF op = dot THEN son[1] ← Dereference[son[1], type, long];
	  long ← seb[type].typeTag = long;  attr.const ← FALSE;
	  op ← dot;  dereferenced ← TRUE;  type ← UnderType[refType];
	  END;
	definition =>
	  BEGIN
	  [matched, sei] ← DefinedId[fieldHti, nType];
	  IF matched THEN
	    BEGIN
	    op ← cdot;
	    son[2] ← Tree.Link[symbol[sei]];
	    rType ← type ← UnderType[seb[sei].idType];
	    attr.const ← ConstantId[sei];  long ← FALSE;
	    IF ctxb[seb[sei].idCtx].ctxType = imported THEN
	      WITH seb[type] SELECT FROM
		pointer =>
		  BEGIN
		  rType ← UnderType[refType];
		  son[2] ← Dereference[son[2], rType, FALSE];
		  END;
		ENDCASE;
	    EXIT
	    END;
	  GO TO nomatch;
	  END;
	ENDCASE =>  GO TO nomatch;
      REPEAT
	nomatch =>
	  BEGIN
	  son[2] ← [symbol[dataPtr.seAnon]];
	  IF son[1] # son[2] AND fieldHti # Symbols.HTNull
	    THEN Log.ErrorHti[unknownField, fieldHti];
	  rType ← typeANY;  attr ← EmptyAttr;
	  END;
	ambiguous =>
	  BEGIN
	  Log.ErrorHti[ambiguousId, fieldHti];
	  son[2] ← [symbol[dataPtr.seAnon]];
	  rType ← typeANY;  attr ← EmptyAttr;
	  END;
      ENDLOOP;
    name ← op;  attr2 ← long;  RPush[rType, attr];
    END;

  Dereference: PROCEDURE [t: Tree.Link, type: CSEIndex, long: BOOLEAN] RETURNS [Tree.Link] =
    BEGIN
    PushTree[t];  PushNode[uparrow, 1];  SetInfo[type];  SetAttr[2, long];
    RETURN[PopTree[]]
    END;

  UpArrow: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    type, nType: CSEIndex;
    attr: Attr;
    son[1] ← Exp[son[1], typeANY];
    type ← RType[];  attr ← RAttr[];  RPop[];  attr.const ← FALSE;
      DO
      nType ← NormalType[type];
      WITH seb[nType] SELECT FROM
	pointer =>
	  BEGIN
	  dereferenced ← TRUE;  RPush[UnderType[refType], attr];
	  attr2 ← seb[type].typeTag = long;  EXIT
	  END;
	record =>
	  BEGIN
	  IF Bundling[nType] = 0 THEN GO TO fail;
	  type ← Unbundle[LOOPHOLE[nType, RecordSEIndex]];
	  END;
	ENDCASE => GO TO fail;
      REPEAT
	fail =>
	  BEGIN
	  IF type # typeANY THEN  Log.ErrorTree[typeClash, son[1]];
	  RPush[type, attr];
	  END;
      ENDLOOP;
    END;


  Apply: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex, mustXfer: BOOLEAN] =
    BEGIN  OPEN tb[node];
    opType, type, nType, subType: CSEIndex;
    nDerefs: CARDINAL;
    attr: Attr;
    leftNP: NPUse;
    desc, long: BOOLEAN;

    ApplyError: PROCEDURE [warn: BOOLEAN] =
      BEGIN
      IF warn THEN Log.ErrorTree[noApplication, son[1]];
      son[2] ← UpdateList[son[2], VoidExp];
      RPush[typeANY, EmptyAttr];
      END;

    UniOperand: PROCEDURE RETURNS [valid: BOOLEAN] =
      BEGIN
      IF ~(valid ← ListLength[son[2]] = 1)
	THEN
	  BEGIN
	  CheckLength[son[2], 1];
	  son[2] ← UpdateList[son[2], VoidExp];  RPush[typeANY, EmptyAttr];
	  END
	ELSE IF KeyedList[son[2]] THEN Log.Error[keys];
      RETURN
      END;

    IF son[1] # Tree.Null
      THEN
	BEGIN
	WITH seb[target] SELECT FROM
	  union =>
	    BEGIN  PushCtx[caseCtx];
	    son[1] ← Exp[son[1], typeANY];  PopCtx[];
	    END;
	  ENDCASE =>  son[1] ← Exp[son[1], typeANY]; 
	opType ← RType[];  attr ← RAttr[];  leftNP ← phraseNP;  RPop[];
	IF opType = Symbols.typeTYPE
	  THEN type ← UnderType[TypeForTree[son[1]]];
	END
      ELSE
	BEGIN
	opType ← Symbols.typeTYPE;
	SELECT seb[target].typeTag FROM
	  record =>  type ← TypeRoot[target];
	  array =>  type ← target;
	  ENDCASE =>
	    BEGIN type ← Symbols.CSENull; Log.ErrorNode[noTarget, node] END;
	END;
    nDerefs ← 0;  desc ← FALSE;  long ← LongPath[son[1]];
    -- dereferencing/deproceduring loop
      DO
      nType ← NormalType[opType];
      WITH seb[nType] SELECT FROM
	mode =>
	  BEGIN
	  SELECT seb[type].typeTag FROM
	    record =>  Construct[node, LOOPHOLE[type, RecordSEIndex]];
	    array =>  RowCons[node, LOOPHOLE[type, Symbols.ArraySEIndex]];
	    enumerated, subrange, basic =>
	      IF UniOperand[]
		THEN
		  BEGIN
		  son[1] ← FreeTree[son[1]];
		  son[1] ← Rhs[son[2], TargetType[type]];
		  son[2] ← Tree.Null;  name ← check;
		  attr ← RAttr[];  RPop[];  RPush[type, attr];
		  END;
	    ENDCASE =>  ApplyError[type # Symbols.CSENull];
	  EXIT
	  END;
	transfer =>
	  BEGIN
	  SELECT mode FROM
	    procedure =>
	      IF ~passPtr.lockHeld AND OperandInternal[son[1]]
		THEN  Log.ErrorTree[internalCall, son[1]];
	    program =>
	      IF BodyForTree[son[1]] # Symbols.CBTNull
		THEN Log.ErrorTree[typeClash, son[1]];
	    ENDCASE;
	  son[2] ← MatchFields[inRecord, son[2], TRUE]; 
	  name ← SELECT mode FROM
	    procedure => callx,
	    port => portcallx,
	    process => joinx,
	    signal => signalx,
	    error => errorx,
	    program => startx,
	    ENDCASE => apply;
	  attr ← And[RAttr[], attr];  phraseNP ← MergeNP[leftNP][phraseNP];
	  RPop[];
	  IF mode = procedure THEN CheckInline[node, attr];
	  attr.noXfer ← attr.const ← FALSE;  RPush[outRecord, attr];
	  phraseNP ← SetNP[phraseNP];
	  EXIT
	  END;
	array =>
	  BEGIN
	  IF UniOperand[]
	    THEN
	      BEGIN
	      IF KeyedList[son[2]] THEN Log.Error[keys];
	      son[2] ← Rhs[son[2], TargetType[UnderType[indexType]]]; 
	      END;
	  attr ← And[RAttr[], attr];  phraseNP ← MergeNP[leftNP][phraseNP];
	  RPop[];
	  RPush[UnderType[componentType], attr];
	  IF mustXfer
	    THEN
	      BEGIN
	      opType ← RType[];  RPop[];
	      PushTree[son[1]];  PushTree[son[2]];
	      PushNode[IF desc THEN dindex ELSE index, 2];
	      SetInfo[opType];  SetAttr[2, long];
	      son[1] ← PopTree[];  son[2] ← Tree.Null;
	      IF nSons > 2 THEN Log.Error[misplacedCatch];
	      mustXfer ← FALSE;	-- to avoid looping
	      END
	    ELSE
	      BEGIN
	      name ← IF desc THEN dindex ELSE index;  attr2 ← long;  EXIT
	      END;
	  END;
	arraydesc =>
	  BEGIN
	  long ← seb[opType].typeTag = long;
	  opType ← UnderType[describedType]; attr.const ← FALSE;  desc ← TRUE;
	  END;
	pointer =>
	  SELECT TRUE FROM
	    basing =>
	      BEGIN
	      IF UniOperand[]
		THEN
		  BEGIN
		  son[2] ← Rhs[son[2], typeANY];
		  subType ← CanonicalType[RType[]];
		  attr ← And[RAttr[], attr];  RPop[];
		  phraseNP ← MergeNP[leftNP][phraseNP];
		  WITH seb[subType] SELECT FROM
		    relative =>
		      BEGIN
		      IF ~Types.Assignable[
				[own, UnderType[baseType]],
				[own, opType]]
			THEN Log.ErrorTree[typeClash, son[1]];
		      type ← UnderType[resultType];
		      END;
		    ENDCASE =>
		      BEGIN  type ← typeANY;
		      IF subType # typeANY
			THEN Log.ErrorTree[typeClash, son[2]];
		      END;
		  subType ← NormalType[type];
		  attr1 ← seb[subType].typeTag = arraydesc;
		  attr2 ← seb[opType].typeTag = long
			    OR seb[type].typeTag = long;
		  WITH seb[subType] SELECT FROM
		    pointer =>
		      BEGIN
		      dereferenced ← TRUE;  type ← UnderType[refType];
		      END;
		    arraydesc =>  type ← UnderType[describedType];
		    ENDCASE;
		  attr.const ← FALSE;  RPush[type, attr];  name ← reloc;
		  END;
	      EXIT
	      END;
	    (subType ← UnderType[refType]) = dataPtr.typeStringBody =>
	      BEGIN
	      IF UniOperand[]
		THEN
		  BEGIN  dereferenced ← TRUE;  
		  son[2] ← Rhs[son[2], dataPtr.typeINTEGER];
		  attr ← And[RAttr[], attr];  RPop[];
		  phraseNP ← MergeNP[leftNP][phraseNP];
		  attr.const ← FALSE;  RPush[dataPtr.typeCHARACTER, attr];
		  name ← seqindex;  attr2 ← seb[opType].typeTag = long;
		  END;
	      EXIT
	      END;
	    ENDCASE =>
	      BEGIN
	      attr.const ← FALSE;  dereferenced ← TRUE;
	      WITH seb[subType] SELECT FROM
		record =>
		  IF ctxb[fieldCtx].level = Symbols.lG
		    THEN
		      BEGIN  opType ← XferForFrame[fieldCtx];
		      son[1] ← ForceType[son[1], opType];
		      END
		    ELSE GO TO deRef;
		ENDCASE => GO TO deRef;
	      EXITS
		deRef =>
		  BEGIN
		  IF (nDerefs ← nDerefs+1) > 255 THEN GO TO fail;
		  long ← seb[opType].typeTag = long;
		  son[1] ← Dereference[son[1], subType, long];
		  opType ← subType;
		  END;
	      END;
	record =>
	  BEGIN
	  IF nType = dataPtr.typeCONDITION
	    THEN
	      BEGIN
	      IF son[2] # Tree.Null
		THEN Log.ErrorN[listLong, ListLength[son[2]]];
	      RPush[Symbols.CSENull, attr];
	      name ← wait;  phraseNP ← SetNP[phraseNP];
	      EXIT
	      END;
	  IF Bundling[opType] = 0 THEN GO TO fail;
	  opType ← Unbundle[LOOPHOLE[opType, RecordSEIndex]];
	  son[1] ← ForceType[son[1], opType];
	  END;
	ENDCASE =>  GO TO fail;
      REPEAT
	fail =>  ApplyError[opType#typeANY OR nDerefs#0];
      ENDLOOP;
    IF nSons > 2 THEN
      BEGIN
      saveNP: NPUse = phraseNP;
      SELECT name FROM
	callx, portcallx, signalx, errorx, startx, fork, joinx, wait, apply =>
	  NULL;
	ENDCASE =>  Log.Error[misplacedCatch];
      [] ← CatchPhrase[son[3]];  phraseNP ← MergeNP[saveNP][phraseNP];
      END;
    IF RType[] = Symbols.CSENull THEN
      name ← SELECT name FROM
	callx => call,
	portcallx => portcall,
	signalx => signal,
	errorx => error,
	startx => start,
	joinx => join,
	ENDCASE => name;
    END;

  Construct: PROCEDURE [node: Tree.Index, type: RecordSEIndex] =
    BEGIN  OPEN tb[node];
    cType: CSEIndex ← type;
    attr: Attr;
    t: Tree.Link;
    son[2] ← MatchFields[type, son[2], TRUE];  attr ← RAttr[];  RPop[];
    WITH seb[type] SELECT FROM
      linked =>
	BEGIN  name ← union;  cType ← VariantUnionType[linkType]  END;
      ENDCASE =>
	BEGIN
	name ← construct;
	IF hints.variant AND (t←ListTail[son[2]]) # Tree.Null
	  THEN  cType ← DiscriminatedType[type, t];
	END;
    info ← cType;  RPush[cType, attr];
    END;

  RowCons: PROCEDURE [node: Tree.Index, aType: Symbols.ArraySEIndex] =
    BEGIN  OPEN tb[node];
    attr: Attr;
    componentType: SEIndex = seb[aType].componentType;
    iType: CSEIndex = UnderType[seb[aType].indexType];
    cType: CSEIndex = TargetType[UnderType[componentType]];
    exitNP: NPUse;

    MapValue: Tree.Map =
      BEGIN
      type: CSEIndex;
      subAttr: Attr;
      SELECT TRUE FROM
	(t = Tree.Null) =>
	  BEGIN
	  v ← DefaultInit[componentType];
	  IF v = Tree.Null
	    THEN BEGIN subAttr ← VoidAttr; phraseNP ← none; type ← typeANY END
	    ELSE BEGIN subAttr ← UpdateTreeAttr[v]; type ← OperandType[v] END;
	  END;
	TestTree[t, void] =>
	  BEGIN
	  v ← Tree.Null;  [] ← FreeTree[t];
	  subAttr ← VoidAttr; phraseNP ← none; type ← typeANY;
	  END;
	ENDCASE =>
	  BEGIN
	  v ← Rhs[t, cType]; subAttr ← RAttr[]; type ← RType[]; RPop[];
	  END;
      IF v = Tree.Null AND ~Voidable[componentType]
	THEN  Log.ErrorSei[elision, IF seb[componentType].seTag=id
			THEN LOOPHOLE[componentType] ELSE dataPtr.seAnon];
      IF ~subAttr.noXfer THEN  v ← Safen[v, type];
      exitNP ← MergeNP[exitNP][phraseNP];  attr ← And[attr, subAttr];  RETURN
      END;

    IF KeyedList[son[2]] OR
     (son[2] = Tree.Null AND seb[TargetType[iType]].typeTag = enumerated)
      THEN
	BEGIN
	keyType: CSEIndex = TargetType[iType];
	vCtx: CTXIndex;
	first, last: ISEIndex;

	KeyFillCheck: PROCEDURE [sei: ISEIndex] RETURNS [t: Tree.Link] =
	  BEGIN
	  IF Defaultable[componentType]
	    THEN  t ← Tree.Null
	    ELSE
	      BEGIN
	      Log.ErrorHti[omittedKey, seb[sei].hash];
	      t ← [symbol[index: dataPtr.seAnon]];
	      END;
	  RETURN
	  END;

	WITH seb[keyType] SELECT FROM
	  enumerated =>
	    BEGIN
	    vCtx ← valueCtx;
	    IF ctxb[vCtx].ctxType = included
	      THEN Copier.CompleteContext[LOOPHOLE[vCtx], FALSE];
	    IF ~ContextComplete[vCtx]
	      THEN Log.Error[keys]
	      ELSE
		BEGIN
		[first, last] ← Span[iType];
		IF first # Symbols.ISENull AND last # Symbols.ISENull
		 AND seb[first].idValue <= seb[last].idValue
		  THEN
		    son[2] ← PopKeyList[ArrangeKeys[
					  son[2],
					  valueCtx, first, NextSe[last],
					  KeyFillCheck]]
		  ELSE  Log.Error[keys];
	        END;
	    END;
	  ENDCASE => Log.Error[keys];
	END;
    attr ← FullAttr;  exitNP ← none;
    son[2] ← UpdateList[son[2], MapValue];
    name ← rowcons;  info ← aType;  RPush[aType, attr];  phraseNP ← exitNP;
    END;


  All: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex] =
    BEGIN  OPEN tb[node];
    t: Tree.Link = son[1];
    l: CARDINAL = ListLength[t];
    attr: Attr;
    SELECT l FROM
      0, 1 =>
	BEGIN
	WITH seb[target] SELECT FROM
	  array =>
	    BEGIN
	    cType: CSEIndex = TargetType[UnderType[componentType]];
	    SELECT TRUE FROM
	      (t = Tree.Null) =>
		IF (son[1] ← DefaultInit[componentType]) = Tree.Null
		  THEN  BEGIN attr ← VoidAttr; phraseNP ← none END
		  ELSE  attr ← UpdateTreeAttr[son[1]];
	      TestTree[t, void] =>
		BEGIN
		son[1] ← Tree.Null;  [] ← FreeTree[t];
		attr ← VoidAttr; phraseNP ← none;
		END;
	      ENDCASE =>
		BEGIN  son[1] ← Rhs[t, cType]; attr ← RAttr[]; RPop[]  END;
	    IF son[1] = Tree.Null AND ~Voidable[componentType]
	      THEN  Log.ErrorSei[elision, IF seb[componentType].seTag=id
			THEN LOOPHOLE[componentType] ELSE dataPtr.seAnon];
	    attr.const ← FALSE;
	    END;
	  ENDCASE =>
	    BEGIN
	    Log.ErrorNode[noTarget, node];
	    son[1] ← VoidExp[son[1]];  attr ← EmptyAttr;
	    END;
	END;
      ENDCASE =>
	BEGIN
	Log.ErrorN[listLong, l-1];
	son[1] ← UpdateList[son[1], VoidExp];  attr ← EmptyAttr;
	END;
    RPush[target, attr];
    END;


  CheckInline: PROCEDURE [node: Tree.Index, attr: Attr] =
    BEGIN
    bti: Symbols.CBTIndex = BodyForTree[tb[node].son[1]];
    IF bti # Symbols.CBTNull AND bb[bti].inline THEN
      WITH body: bb[bti].info SELECT FROM
	Internal =>
	  BEGIN
	  PushTree[tb[node].son[1]];
	  PushTree[[subtree[index: body.thread]]];
	  PushNode[thread, 2];  SetInfo[passPtr.enclosingBody];
	  tb[node].son[1] ← PopTree[];  body.thread ← node;
	  tb[node].attr3 ← attr.noXfer AND attr.noAssign;
	  END;
	ENDCASE => ERROR;
    END;

  BodyForTree: PROCEDURE [t: Tree.Link] RETURNS [Symbols.CBTIndex] =
    BEGIN
    sei: ISEIndex;
    node, subNode: Tree.Index;
    WITH t SELECT FROM
      symbol =>
	BEGIN  sei ← index;
	SELECT TRUE FROM
	  seb[sei].mark4 =>
	    RETURN [
	      IF seb[sei].constant THEN seb[sei].idInfo ELSE Symbols.CBTNull]; 
	  seb[sei].immutable =>
	    BEGIN
	    node ← seb[sei].idValue;
	    WITH tb[node].son[3] SELECT FROM
	      subtree =>
		BEGIN  subNode ← index;
		IF tb[subNode].name = body THEN RETURN [tb[subNode].info];
		END;
	      ENDCASE;
	    END;
	  ENDCASE; 
	END;
      subtree =>
	BEGIN  node ← index;
	SELECT tb[node].name FROM
	  cdot =>  RETURN [BodyForTree[tb[node].son[2]]];
	  ENDCASE;
	END;
      ENDCASE;
    RETURN [Symbols.CBTNull]
    END;


  Assignment: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    lhsType, rhsType: CSEIndex;
    attr: Attr;
    saveNP: NPUse;
    son[1] ← Exp[son[1], typeANY];  saveNP ← phraseNP; 
    lhsType ← RType[];  attr ← RAttr[];  RPop[];
    son[2] ← Rhs[son[2], TargetType[lhsType]]; 
    IF seb[lhsType].typeTag = union
      THEN
	IF ~Types.Assignable[
	 [own, DiscriminatedType[typeANY, son[1]]],
	 [own, DiscriminatedType[typeANY, son[2]]]] 
	  THEN Log.ErrorTree[typeClash, son[2]];
    rhsType ← RType[];  attr ← And[RAttr[], attr];  RPop[];
    attr.noAssign ← FALSE;  phraseNP ← MergeNP[phraseNP][saveNP];
    RPush[rhsType, attr];
    IF ~OperandLhs[son[1]] THEN Log.ErrorTree[nonLHS, son[1]];
    END;


  Extract: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    type: CSEIndex;
    ctx: CTXIndex;
    sei: ISEIndex;
    nL, nR: CARDINAL;
    saveRecord: RecordSEIndex = passPtr.implicitRecord;
    saveAttr: Attr = passPtr.implicitAttr;
    saveNP: NPUse;

    FillNull: PROCEDURE [ISEIndex] RETURNS [Tree.Link] =
      BEGIN  RETURN [Tree.Null]  END;

    PushItem: Tree.Map = BEGIN PushTree[t]; RETURN [Tree.Null] END;

    Extractor: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = INLINE
      BEGIN
      RETURN [TestTree[t, apply] AND tb[GetNode[t]].son[1] = Tree.Null]
      END;

    AssignItem: Tree.Map =
      BEGIN
      saveType: CSEIndex = passPtr.implicitType;
      IF t = Tree.Null
	THEN  v ← Tree.Null
	ELSE
	  BEGIN
	  passPtr.implicitType ← IF sei = SENull
		THEN typeANY
		ELSE UnderType[seb[sei].idType];
	  IF Extractor[t]
	    THEN
	      BEGIN
	      subNode: Tree.Index = GetNode[t];
	      PushTree[tb[subNode].son[2]];
	      tb[subNode].son[2] ← Tree.Null;  FreeNode[subNode];
	      PushTree[Tree.Null];  v ← MakeNode[extract, 2];
	      Extract[GetNode[v]];
	      END
	    ELSE
	      BEGIN
	      PushTree[t];  PushTree[Tree.Null];  v ← MakeNode[assign, 2];
	      Assignment[GetNode[v]];  RPop[];
	      END;
	  saveNP ← MergeNP[saveNP][phraseNP];
	  END;
      IF sei # SENull THEN sei ← NextSe[sei];
      passPtr.implicitType ← saveType;  RETURN
      END;

    son[2] ← Exp[son[2], typeANY];
    type ← RType[];  passPtr.implicitAttr ← RAttr[];  RPop[];
    saveNP ← phraseNP;
    IF type = SENull
      THEN
	BEGIN  Log.ErrorTree[typeClash, son[2]];
	type ← typeANY;  nR ← 0;  sei ← Symbols.ISENull;
	END
      ELSE
	BEGIN
	type ← TypeRoot[type];
	WITH seb[type] SELECT FROM
	  record =>
	    BEGIN
	    CompleteRecord[LOOPHOLE[type, RecordSEIndex]];
	    IF ContextComplete[fieldCtx]
	      THEN
		BEGIN
		passPtr.implicitRecord ← LOOPHOLE[type, RecordSEIndex];
		ctx ← fieldCtx;  sei ← FirstVisibleSe[ctx];
		nR ← VisibleCtxEntries[ctx];
		END
	      ELSE
		BEGIN  Log.Error[noAccess];
		type ← typeANY;  nR ← 0;  sei ← Symbols.ISENull;
		END;
	    END;
	  ENDCASE =>
	    BEGIN
	    IF type # typeANY THEN Log.ErrorTree[typeClash, son[2]];
	    type ← typeANY;  nR ← 0;  sei ← Symbols.ISENull;
	    END;
	END;
    IF KeyedList[son[1]] AND type # typeANY
      THEN
	nL ← ArrangeKeys[
		son[1],
		ctx, FirstVisibleSe[ctx], Symbols.ISENull,
		FillNull]
      ELSE
	BEGIN
	nL ← ListLength[son[1]];
	son[1] ← FreeTree[UpdateList[son[1], PushItem]];
	IF nL > nR AND type # typeANY
	  THEN  Log.ErrorN[listLong, nL-nR];
	THROUGH (nL .. nR] DO  PushTree[Tree.Null]  ENDLOOP;
	nL ← MAX[nL, nR];
	END;
    PushTree[UpdateList[MakeList[nR], AssignItem]];
    PushNode[exlist, 1];  SetInfo[type];  son[1] ← PopTree[];
    phraseNP ← saveNP;
    passPtr.implicitRecord ← saveRecord;  passPtr.implicitAttr ← saveAttr;
    END;

  END.