-- file Pass3D.Mesa
-- last modified by Satterthwaite, December 20, 1979  11:08 AM

DIRECTORY
  ComData: FROM "comdata"
    USING [
      definitionsOnly, idANY, idCARDINAL, mainCtx, moduleCtx, seAnon,
      textIndex, typeINTEGER, typeSTRING],
  Log: FROM "log" USING [Error, ErrorHti, ErrorSei, ErrorTree],
  P3: FROM "p3"
    USING [
      CircuitCheck, CircuitSignal, Mark, NPUse, SequenceNP,
      pathNP, phraseNP,
      CheckDisjoint, ClearRefStack, CompleteRecord, Exp, FindSe, Interval,
      MakeFrameRecord, PopCtx, PushCtx, RAttr, RecordLhs, RecordMention, 
      Rhs, RPop, RType, SealRefStack, SearchCtxList, SelectVariantType,
      TopCtx, UnsealRefStack, UpdateTreeAttr, VariantUnionType],
  Symbols: FROM "symbols"
    USING [seType, ctxType, mdType,
      SERecord, 
      HTIndex, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
      SENull, CTXNull, codeANY, codeINTEGER, lG, lZ, typeANY, typeTYPE],
  SymbolOps: FROM "symbolops"
    USING [
      CtxEntries, EnterExtension, FindExtension, LinkMode, MakeNonCtxSe,
      NormalType, TypeForm, UnderType, XferMode],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [Index, Link, Map, Null, NullIndex, Scan, treeType],
  TreeOps: FROM "treeops"
    USING [
      FreeTree, GetNode, IdentityMap, ListHead, ListLength,
      ScanList, TestTree, UpdateList];

Pass3D: PROGRAM
    IMPORTS
	Log, P3, SymbolOps, TreeOps,
	dataPtr: ComData
    EXPORTS P3 =
  BEGIN
  OPEN TreeOps, SymbolOps, Symbols, P3;

  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)
  mdb: Table.Base;	-- module table base address (local copy)

  DeclNotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    tb _ base[Tree.treeType];
    seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType];
    END;


-- signals for type loop detection

  CheckTypeLoop: PUBLIC CircuitCheck = CODE;
  LogTypeLoop: CircuitSignal = CODE;


-- declaration processing

  DeclList: PUBLIC Tree.Scan =
    BEGIN
    ScanList[t, DeclItemA];  ScanList[t, DeclItemBI];
    END;

  DeclItemA: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    type: SEIndex;
    saveIndex: CARDINAL = dataPtr.textIndex;
    IF tb[node].attr3 = P3.Mark THEN RETURN;	-- already processed
    tb[node].attr3 _ P3.Mark;
    dataPtr.textIndex _ tb[node].info;
    tb[node].son[2] _ TypeLink[tb[node].son[2]
	  ! CheckTypeLoop => IF loopNode=node THEN RESUME [TRUE];
	    LogTypeLoop => IF loopNode=node THEN RESUME];
    type _ TypeForTree[tb[node].son[2]];
    IF tb[node].name = typedecl
      THEN  DefineTypeSe[tb[node].son[1], type]
      ELSE  DefineSeType[tb[node].son[1], type, tb[node].attr1];
    ClearRefStack[];
    dataPtr.textIndex _ saveIndex;
    END;

  DeclItemB: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    type: SEIndex;

    ExpInit: PROCEDURE [t: Tree.Link] RETURNS [val: Tree.Link] =
      BEGIN
      val _ Rhs[t, TargetType[UnderType[type]]];  RPop[];
      pathNP _ SequenceNP[pathNP][phraseNP];
      RETURN
      END;

    saveIndex: CARDINAL = dataPtr.textIndex;
    IF tb[node].attr2 = P3.Mark THEN RETURN;	-- already processed
    tb[node].attr2 _ P3.Mark;
    dataPtr.textIndex _ tb[node].info;
    TypeAttr[tb[node].son[2]];
    SELECT tb[node].name FROM
      typedecl => NULL;
      ENDCASE =>
	BEGIN
	type _ TypeForTree[tb[node].son[2]];
	IF tb[node].son[3] # Tree.Null
	  THEN
	    BEGIN
	    ScanList[tb[node].son[1], RecordDeclInit];
	    tb[node].son[3] _ UpdateList[tb[node].son[3], ExpInit];
	    IF VoidItem[tb[node].son[3]] AND ~Voidable[type]
	      THEN Log.ErrorTree[defaultForm, ListHead[tb[node].son[1]]];
	    END;
	DefineSeValue[tb[node].son[1], FALSE, FALSE];
	END;
    ClearRefStack[];
    dataPtr.textIndex _ saveIndex;
    END;

  DeclItemBI: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    expNode: Tree.Index;
    type: SEIndex;
    eqFlag, constFlag, extFlag: BOOLEAN;

    ExpInit: PROCEDURE [t: Tree.Link] RETURNS [val: Tree.Link] =
      BEGIN
      val _ Rhs[t, TargetType[UnderType[type]]];
      constFlag _ eqFlag AND RAttr[].const;  RPop[];
      pathNP _ SequenceNP[pathNP][phraseNP];
      RETURN
      END;

    saveIndex: CARDINAL = dataPtr.textIndex;
    IF tb[node].attr2 = P3.Mark THEN RETURN;	-- already processed
    tb[node].attr2 _ P3.Mark;
    dataPtr.textIndex _ tb[node].info;
    TypeAttr[tb[node].son[2]];  type _ TypeForTree[tb[node].son[2]];
    SELECT tb[node].name FROM
      typedecl =>
	BEGIN
	IF tb[node].son[3] # Tree.Null
	  THEN
	    BEGIN
	    tb[node].son[3] _ UpdateList[tb[node].son[3], ExpInit];
	    IF VoidItem[tb[node].son[3]] AND ~Voidable[type]
	      THEN Log.ErrorTree[defaultForm, ListHead[tb[node].son[1]]];
	    END;
	IF tb[node].son[3] # Tree.Null THEN ProcessDefaults[t, TRUE];
	END;
      ENDCASE =>
	BEGIN
	extFlag _ FALSE;  eqFlag _ tb[node].attr1;
	IF tb[node].son[3] = Tree.Null
	  THEN
	    BEGIN
	    v: Tree.Link = DefaultInit[type];
	    IF v # Tree.Null
	      THEN
		BEGIN
		tb[node].son[3] _ v;  [] _ UpdateTreeAttr[v];
		pathNP _ SequenceNP[pathNP][phraseNP];
		END;
	    constFlag _ FALSE;
	    END
	  ELSE
	    BEGIN
	    ScanList[tb[node].son[1], RecordDeclInit];
	    WITH tb[node].son[3] SELECT FROM
	      subtree =>
		BEGIN  expNode _ index;
		SELECT tb[expNode].name FROM
		  body =>
		    BEGIN  -- defer processing of bodies (see Body)
		    constFlag _ FALSE;
		    SELECT XferMode[type] FROM
		      procedure, program => NULL;
		      ENDCASE =>
			IF TypeForm[type] = definition
			  THEN  constFlag _ TRUE
			  ELSE  Log.Error[bodyType];
		    extFlag _ eqFlag AND tb[expNode].attr3;  -- inline
		    END;
		  inline =>
		    BEGIN
		    IF XferMode[type] # procedure OR ~eqFlag
		      THEN Log.Error[inlineType];
		    tb[expNode].son[1] _
			    UpdateList[tb[expNode].son[1], InlineOp];
		    constFlag _ eqFlag;
		    END;
		  apply =>
		    IF tb[expNode].son[1] # Tree.Null
		     OR UnderType[type] # dataPtr.typeSTRING
		     OR ListLength[tb[expNode].son[2]] # 1
		      THEN  tb[node].son[3] _ ExpInit[tb[node].son[3]]
		      ELSE
			BEGIN  tb[expNode].name _ stringinit;
			tb[expNode].info _ dataPtr.typeSTRING; 
			tb[expNode].son[2] _ Rhs[ 
				tb[expNode].son[2], dataPtr.typeINTEGER];
			IF ~RAttr[].const
			  THEN Log.ErrorTree[nonConstant, tb[expNode].son[2]];
			RPop[];  constFlag _ FALSE;
			pathNP _ SequenceNP[pathNP][phraseNP];
			END;
		  signalinit =>  constFlag _ FALSE;
		  void =>
		    BEGIN
		    IF ~Voidable[type] THEN
		      Log.ErrorTree[defaultForm, ListHead[tb[node].son[1]]];
		    tb[node].son[3] _ FreeTree[tb[node].son[3]];
		    constFlag _ FALSE;
		    END;
		  ENDCASE =>  tb[node].son[3] _ ExpInit[tb[node].son[3]];
		END;
	      ENDCASE =>  tb[node].son[3] _ ExpInit[tb[node].son[3]];
	    END;
	DefineSeValue[tb[node].son[1], constFlag, extFlag];
	END;
    ClearRefStack[];
    dataPtr.textIndex _ saveIndex;
    END;


  RecordDeclInit: Tree.Scan =
    BEGIN
    sei: ISEIndex;
    WITH t SELECT FROM
      symbol =>  BEGIN sei _ index; RecordMention[sei]; RecordLhs[sei] END;
      ENDCASE => ERROR;
    END;

  InlineOp: Tree.Map =
    BEGIN

    EvalConst: Tree.Map =
      BEGIN
      v _ Rhs[t, dataPtr.typeINTEGER];
      IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, v];
      RPop[];  RETURN
      END;

    RETURN [UpdateList[t, EvalConst]]
    END;


  InterfaceSe: PROCEDURE [sei: ISEIndex] RETURNS [BOOLEAN] = INLINE
    BEGIN
    RETURN [dataPtr.definitionsOnly AND ctxb[seb[sei].idCtx].level = lG]
    END;


  DefineSeType: PROCEDURE [t: Tree.Link, type: SEIndex, fixed: BOOLEAN] =
    BEGIN

    UpdateSe: Tree.Scan =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	symbol =>
	  BEGIN  sei _ index;
	  seb[sei].idType _ type;  seb[sei].constant _ FALSE;
	  IF InterfaceSe[sei]
	    THEN  seb[sei].immutable _ seb[sei].immutable OR fixed
	    ELSE
	      BEGIN
	      IF seb[sei].immutable THEN Log.ErrorSei[attrClash, sei];
	      seb[sei].immutable _ fixed
	      END;
	  seb[sei].mark3 _ TRUE;
	  END;
	ENDCASE =>  ERROR;
      END;

    ScanList[t, UpdateSe];
    END;

  DefineSeValue: PROCEDURE [t: Tree.Link, const, ext: BOOLEAN] =
    BEGIN

    UpdateSe: Tree.Scan =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	symbol =>
	  BEGIN  sei _ index;
	  seb[sei].constant _ const;  seb[sei].extended _ ext;
	  IF InterfaceSe[sei] AND LinkMode[sei] = val
	    THEN  seb[sei].immutable _ TRUE;
	  END;
	ENDCASE =>  ERROR;
      END;

    ScanList[t, UpdateSe];
    END;


  DefineTypeSe: PROCEDURE [t: Tree.Link, info: SEIndex] =
    BEGIN
    first: BOOLEAN _ TRUE;

    UpdateSe: Tree.Scan =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	symbol =>
	  BEGIN  sei _ index;
	  seb[sei].idType _ typeTYPE;  seb[sei].idInfo _ info;
	  seb[sei].immutable _ seb[sei].constant _ TRUE;
	  IF first THEN  BEGIN  info _ sei;  first _ FALSE  END;
	  seb[sei].mark3 _ TRUE;
	  END;
	ENDCASE =>  ERROR;
      END;

    ScanList[t, UpdateSe];   RETURN
    END;


  ProcessDefaults: PROCEDURE [t: Tree.Link, valid: BOOLEAN] =
    BEGIN

    ProcessDefault: Tree.Scan =
      BEGIN
      copy: BOOLEAN;
      node: Tree.Index = GetNode[t];

      DefineDefault: Tree.Scan =
	BEGIN
	WITH t SELECT FROM
	  symbol =>
	    EnterExtension[index, default,
	      IF copy THEN IdentityMap[tb[node].son[3]] ELSE tb[node].son[3]];
	  ENDCASE => ERROR;
	copy _ TRUE;
	END;

      IF tb[node].son[3] # Tree.Null THEN
	BEGIN
	IF ~valid
	  THEN Log.ErrorTree[default, ListHead[tb[node].son[1]]];
	IF TestTree[tb[node].son[3], stringinit]
	  THEN Log.ErrorTree[defaultForm, ListHead[tb[node].son[1]]];
	copy _ FALSE;
	ScanList[tb[node].son[1], DefineDefault]; tb[node].son[3] _ Tree.Null;
	END;
      END;

    ScanList[t, ProcessDefault];
    END;


 -- default merging

  DefaultInit: PUBLIC PROCEDURE [type: SEIndex] RETURNS [v: Tree.Link] =
    BEGIN
    s, next: SEIndex;
    v _ Tree.Null;
    FOR s _ type, next
      DO
      WITH seb[s] SELECT FROM
	id =>
	  BEGIN
	  sei: ISEIndex = LOOPHOLE[s];

	  CopyNonVoid: Tree.Scan =
	    BEGIN
	    IF ~TestTree[t, void] AND v = Tree.Null THEN v _ IdentityMap[t];
	    END;

	  IF seb[sei].extended THEN
	    BEGIN ScanList[FindExtension[sei].tree, CopyNonVoid]; EXIT END;
	  next _ seb[sei].idInfo;
	  END;
	ENDCASE => EXIT;
      ENDLOOP;
    RETURN
    END;

  VoidItem: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [void: BOOLEAN] =
    BEGIN
    TestVoid: Tree.Scan = BEGIN IF TestTree[t, void] THEN void _ TRUE END;
    void _ FALSE;  ScanList[t, TestVoid];  RETURN
    END;

  Voidable: PUBLIC 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 [VoidItem[FindExtension[sei].tree]];
	  next _ seb[sei].idInfo;
	  END;
	ENDCASE =>  RETURN [TRUE];
      ENDLOOP;
    END;


  ResolveType: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN
    currentCtx: CTXIndex = TopCtx[];
    IF seb[sei].idCtx # currentCtx
      THEN  BEGIN PopCtx[]; ResolveType[sei]; PushCtx[currentCtx] END
      ELSE
	BEGIN
	SealRefStack[];
	DeclItemA[[subtree[index: seb[sei].idValue]]];
	UnsealRefStack[];
	END;
    END;

  ResolveValue: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN
    currentCtx: CTXIndex = TopCtx[];
    IF seb[sei].idCtx # currentCtx
      THEN  BEGIN PopCtx[]; ResolveValue[sei]; PushCtx[currentCtx] END
      ELSE
	BEGIN
	SealRefStack[];
	IF currentCtx = CTXNull OR
	 (ctxb[currentCtx].level = lZ AND currentCtx # dataPtr.moduleCtx)
	  THEN  DeclItemB[[subtree[index: seb[sei].idValue]]]
	  ELSE  DeclItemBI[[subtree[index: seb[sei].idValue]]];
	UnsealRefStack[];
	END;
    END;


  CheckTypeId: PROCEDURE [sei: ISEIndex] RETURNS [BOOLEAN] =
    BEGIN
    node: Tree.Index;
    IF seb[sei].mark3 THEN RETURN [seb[sei].idType = typeTYPE];
    node _ seb[sei].idValue;
    RETURN [node = Tree.NullIndex OR tb[node].name = typedecl]
    END;

  TypeSymbol: PROCEDURE [sei: ISEIndex] RETURNS [val: Tree.Link] =
    BEGIN
    declNode: Tree.Index;
    saveIndex: CARDINAL;
    entryIndex: CARDINAL = dataPtr.textIndex;
    circular: BOOLEAN;
    circular _ FALSE;
    IF ~seb[sei].mark3
      THEN
	BEGIN
	ENABLE
	  LogTypeLoop =>
	    BEGIN  saveIndex _ dataPtr.textIndex;
	    dataPtr.textIndex _ entryIndex;
	    Log.ErrorSei[circularType, sei];
	    circular _ TRUE;
	    dataPtr.textIndex _ saveIndex;
	    END;
	declNode _ seb[sei].idValue;
	IF tb[declNode].attr3 # P3.Mark
	  THEN ResolveType[sei]
	  ELSE
	    IF SIGNAL CheckTypeLoop[declNode]
	      THEN SIGNAL LogTypeLoop[declNode];
	END;
    IF CheckTypeId[sei] AND ~circular
      THEN  val _ Tree.Link[symbol[index: sei]]
      ELSE
	BEGIN
	IF ~circular AND sei # dataPtr.seAnon
	  THEN Log.ErrorSei[nonTypeId, sei];
	val _ Tree.Link[symbol[index: dataPtr.idANY]];
	END;
    RETURN
    END;


  PushArgCtx: PROCEDURE [sei: RecordSEIndex] =
    BEGIN
    IF sei # SENull THEN PushCtx[seb[sei].fieldCtx];
    END;

  PopArgCtx: PROCEDURE [sei: RecordSEIndex] =
    BEGIN
    IF sei # SENull THEN PopCtx[];
    END;


  TypeExp: PUBLIC PROCEDURE [typeExp: Tree.Link] RETURNS [val: Tree.Link] =
    BEGIN
    val _ TypeLink[typeExp];  TypeAttr[val];  RETURN
    END;

  TypeForTree: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [SEIndex] =
    -- N.B. assumes t evaluated by TypeLink or Exp
    BEGIN
    RETURN [WITH t SELECT FROM
      symbol => index,
      subtree =>
	SELECT tb[index].name FROM
	  cdot => TypeForTree[tb[index].son[2]],
	  ENDCASE => tb[index].info,
      ENDCASE => typeANY]
    END;


  TypeLink: PROCEDURE [typeExp: Tree.Link] RETURNS [val: Tree.Link] =
    BEGIN
    WITH typeExp SELECT FROM
      hash =>    val _ TypeSymbol[FindSe[index].symbol];
      symbol =>  val _ TypeSymbol[index];
      subtree =>
	BEGIN
	node: Tree.Index = index;
	iSei: ISEIndex;
	SELECT tb[node].name FROM
	  discrimTC =>
	    BEGIN  OPEN tb[node];
	    son[1] _ TypeLink[son[1]];
	    iSei _ WITH son[2] SELECT FROM
	      hash => SelectVariantType[TypeForTree[son[1]], index],
	      ENDCASE =>  ERROR;
	    info _ iSei;  son[2] _ Tree.Link[symbol[index: iSei]];
	    END;
	  dot =>
	    BEGIN  OPEN tb[node];
	    found: BOOLEAN;
	    nDerefs: CARDINAL;
	    sei: SEIndex;
	    subType: CSEIndex;
	    ctx: CTXIndex;
	    son[1] _ Exp[son[1], typeANY];
	    WITH son[2] SELECT FROM
	      hash =>
		BEGIN
		nDerefs _ 0;
		FOR subType _ RType[], UnderType[sei]
		  DO
		  WITH t: seb[subType] SELECT FROM
		    definition =>  BEGIN  ctx _ t.defCtx;  GO TO search  END;
		    record =>  BEGIN  ctx _ t.fieldCtx;  GO TO search  END;
		    pointer =>
		      BEGIN
		      IF (nDerefs _ nDerefs+1) > 255 THEN GO TO fail;
		      t.dereferenced _ TRUE;  sei _ t.refType;
		      END;
		    long =>  sei _ t.rangeType;
		    subrange =>  sei _ t.rangeType;
		    ENDCASE =>  GO TO fail;
		  REPEAT
		    fail =>  found _ FALSE;
		    search =>  [found, iSei] _ SearchCtxList[index, ctx];
		  ENDLOOP;
		IF ~found
		  THEN
		    BEGIN
		    iSei _ dataPtr.idANY;  Log.ErrorHti[unknownField, index];
		    END;
		name _ cdot;  info _ iSei;  son[2] _ TypeSymbol[iSei];
		END;
	      ENDCASE =>  ERROR;
	    RPop[];
	    END;
	  frameTC =>
	    BEGIN  OPEN tb[node];
	    son[1] _ Exp[son[1], typeANY];  RPop[];
	    info _ MakeFrameRecord[son[1]];
	    END;
	  ENDCASE =>
	    BEGIN  OPEN tb[node];
	    type: CSEIndex = info;
	    WITH t: seb[type] SELECT FROM
	      enumerated =>  NULL;
	      record =>
		BEGIN
		PushCtx[t.fieldCtx];  ScanList[son[1], DeclItemA];  PopCtx[];
		END;
	      pointer =>
		BEGIN
		son[1] _ TypeLink[son[1] ! CheckTypeLoop => RESUME [FALSE]];
		t.refType _ TypeForTree[son[1]];
		END;
	      array =>
		BEGIN
		IF son[1] = Tree.Null
		  THEN  t.indexType _ dataPtr.idCARDINAL
		  ELSE
		    BEGIN
		    son[1] _ TypeLink[son[1]];
		    t.indexType _ TypeForTree[son[1]];
		    END;
		son[2] _ TypeLink[son[2]];
		t.componentType _ TypeForTree[son[2]];
		END;
	      arraydesc =>
		BEGIN
		son[1] _ TypeLink[son[1] ! CheckTypeLoop => RESUME [FALSE]];
		t.describedType _ TypeForTree[son[1]];
		END;
	      transfer =>
		BEGIN
		ENABLE  CheckTypeLoop => RESUME [FALSE];
		IF t.inRecord # SENull AND t.outRecord # SENull
		  THEN CheckDisjoint[
			seb[t.inRecord].fieldCtx, seb[t.outRecord].fieldCtx];
		PushArgCtx[t.inRecord];   ScanList[son[1], DeclItemA];
		PushArgCtx[t.outRecord];  ScanList[son[2], DeclItemA];
		PopArgCtx[t.outRecord];  PopArgCtx[t.inRecord];
		END;
	      definition =>  t.defCtx _ dataPtr.mainCtx;
	      union =>
		BEGIN
		DeclItemA[son[1]];  ScanList[son[2], DeclItemA];
		END;
	      relative =>
		BEGIN
		son[1] _ TypeLink[son[1] ! CheckTypeLoop => RESUME [FALSE]];
		t.baseType _ TypeForTree[son[1]];
		son[2] _ TypeLink[son[2]];
		t.resultType _ t.offsetType _ TypeForTree[son[2]];
		END;
	      subrange =>
		BEGIN
		t.range _ LOOPHOLE[node];    -- to allow symbolic evaluation
		son[1] _ TypeLink[son[1]]; t.rangeType _ TypeForTree[son[1]];
		END;
	      long =>
		BEGIN
		son[1] _ TypeLink[son[1]]; t.rangeType _ TypeForTree[son[1]];
		END;
	      ENDCASE =>  ERROR;
	    seb[type].mark3 _ TRUE;
	    END;
	val _ typeExp;
	END;
      ENDCASE =>  ERROR;
    RETURN
    END;


  TypeAttr: PROCEDURE [typeExp: Tree.Link] =
    BEGIN
    WITH typeExp SELECT FROM
      symbol =>
	BEGIN
	sei: ISEIndex = index;
	declNode: Tree.Index;
	IF ~seb[sei].mark4
	  THEN
	    BEGIN
	    declNode _ seb[sei].idValue;
	    IF seb[sei].mark3 AND tb[declNode].attr2 # P3.Mark
	      THEN ResolveValue[sei];
	    END;
	END;
      subtree =>
	BEGIN
	node: Tree.Index = index;
	SELECT tb[node].name FROM
	  discrimTC, cdot, frameTC =>  NULL;
	  ENDCASE =>
	    BEGIN  OPEN tb[node];
	    type: CSEIndex = info;
	    subType: CSEIndex;
	    WITH t: seb[type] SELECT FROM
	      enumerated =>  NULL;
	      record =>
		BEGIN
		saveNP: NPUse = pathNP;
		PushCtx[t.fieldCtx];  pathNP _ none;
		ScanList[son[1], DeclItemB];  ProcessDefaults[son[1], TRUE];
		PopCtx[];  pathNP _ saveNP;
		END;
	      pointer =>  TypeAttr[son[1]];
	      array =>
		BEGIN
		IF son[1] # Tree.Null THEN TypeAttr[son[1]];
		SELECT TRUE FROM
		  ~OrderedType[t.indexType] =>
		    BEGIN t.indexType_typeANY; Log.Error[nonOrderedType] END;
		  (TypeForm[t.indexType]=long) => Log.Error[subrangeNesting];
		  ENDCASE;
		TypeAttr[son[2]];
		END;
	      arraydesc =>
		BEGIN
		TypeAttr[son[1]];
		IF TypeForm[t.describedType] # array
		  THEN Log.Error[descriptor];
		END;
	      transfer =>
		BEGIN
		saveNP: NPUse = pathNP;
		PushArgCtx[t.inRecord];
		ScanList[son[1], DeclItemB];  ProcessDefaults[son[1], TRUE];
		PushArgCtx[t.outRecord];
		ScanList[son[2], DeclItemB];  ProcessDefaults[son[2], FALSE];
		PopArgCtx[t.outRecord];  PopArgCtx[t.inRecord];
		pathNP _ saveNP;
		END;
	      definition =>  NULL;
	      union =>
		BEGIN
		tagType: CSEIndex;
		DeclItemB[son[1]];
		seb[t.tagSei].immutable _ TRUE;
		tagType _ TargetType[UnderType[seb[t.tagSei].idType]];
		IF seb[tagType].typeTag # enumerated
		  THEN
		    BEGIN
		    Log.ErrorSei[nonTagType, t.tagSei]; tagType _ typeANY;
		    END;
		VariantList[son[2], tagType];
		END;
	      relative =>
		BEGIN
		vType: CSEIndex;
		TypeAttr[son[1]];
		IF seb[NormalType[UnderType[t.baseType]]].typeTag # pointer
		  THEN Log.Error[relative];
		TypeAttr[son[2]];
		vType _ UnderType[t.offsetType];  subType _ NormalType[vType];
		SELECT seb[subType].typeTag FROM
		  pointer, arraydesc => NULL;
		  ENDCASE =>
		    BEGIN  Log.Error[relative];  subType _ typeANY  END;
		IF seb[UnderType[t.baseType]].typeTag = long
		 OR seb[vType].typeTag = long
		  THEN subType _ MakeLongType[subType, vType];
		t.resultType _ subType;
		END;
	      subrange =>
		BEGIN
		TypeAttr[son[1]];  subType _ UnderType[t.rangeType];
		SELECT TRUE FROM
		  (TypeForm[subType] = pointer) =>
		    BEGIN
		    Interval[son[2], dataPtr.typeINTEGER, TRUE];  RPop[];
		    END;
		  OrderedType[subType] =>
		    BEGIN
		    IF TypeForm[subType] = long
		      THEN Log.Error[subrangeNesting];
		    Interval[son[2], subType, TRUE];  RPop[];
		    END;
		  ENDCASE =>
		    BEGIN  Log.Error[nonOrderedType];
		    Interval[son[2], typeANY, TRUE];  RPop[];
		    END;
		END;
	      long =>
		BEGIN
		TypeAttr[son[1]];  subType _ UnderType[t.rangeType];
		WITH s: seb[subType] SELECT FROM
		  basic =>
		    SELECT s.code FROM
		      codeINTEGER, codeANY => NULL;
		      ENDCASE => Log.Error[long];
		  pointer, arraydesc => NULL;
		  subrange =>
		    IF t.rangeType # dataPtr.idCARDINAL THEN Log.Error[long];
		  ENDCASE =>  Log.Error[long];
		END;
	      ENDCASE =>  ERROR;
	    END;
	END;
      ENDCASE =>  ERROR;
    END;


  VariantList: PROCEDURE [t: Tree.Link, tagType: CSEIndex] =
    BEGIN

    DefineTag: Tree.Scan =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	symbol =>
	  BEGIN  sei _ index;
	  seb[sei].idValue _ TagValue[seb[sei].hash, tagType];
	  END;
	ENDCASE =>  ERROR;
      END;

    VariantItem: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex _ tb[node].info;
      ScanList[tb[node].son[1], DefineTag];
      DeclItemB[t];
      dataPtr.textIndex _ saveIndex;
      END;

    ScanList[t, VariantItem];
    END;

  TagValue: PROCEDURE [tag: HTIndex, tagType: CSEIndex] RETURNS [CARDINAL] =
    BEGIN
    matched: BOOLEAN;
    sei: ISEIndex;
    WITH seb[tagType] SELECT FROM
      enumerated =>
	BEGIN
	[matched, sei] _ SearchCtxList[tag, valueCtx];
	IF matched THEN RETURN [seb[sei].idValue];
	END;
      ENDCASE;
    Log.ErrorHti[unknownTag, tag];  RETURN [0]
    END;


 -- type mappings and predicates

  Bundling: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [nLevels: CARDINAL] =
    BEGIN
    next: CSEIndex;
    ctx: CTXIndex;
    nLevels _ 0;
      DO
      IF type = SENull THEN EXIT;
      WITH seb[type] SELECT FROM
	record =>
	  BEGIN
	  IF ~hints.unifield THEN EXIT;
	  ctx _ fieldCtx;
	  WITH ctxb[ctx] SELECT FROM
	    included =>
	      BEGIN
	      IF hints.privateFields AND ~mdb[module].shared THEN EXIT;
	      IF ~complete THEN CompleteRecord[LOOPHOLE[type, RecordSEIndex]];
	      IF ~complete THEN EXIT;
	      END;
	    ENDCASE;
	  IF CtxEntries[fieldCtx] # 1 OR hints.variant THEN EXIT;
	  nLevels _ nLevels + 1;
	  next _ Unbundle[LOOPHOLE[type, RecordSEIndex]];
	  END;
	ENDCASE => EXIT;
      type _ next;
      ENDLOOP;
    RETURN
    END;

  Unbundle: PUBLIC PROCEDURE [record: RecordSEIndex] RETURNS [CSEIndex] =
    BEGIN  OPEN seb[record];
    RETURN [UnderType[seb[ctxb[fieldCtx].seList].idType]]
    END;


  TargetType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [target: CSEIndex] =
    BEGIN
    next: CSEIndex;
    FOR target _ type, next
      DO
      WITH seb[target] SELECT FROM
	subrange =>  next _ UnderType[rangeType];
	ENDCASE =>  EXIT;
      ENDLOOP;
    RETURN [target]
    END;

  CanonicalType: PUBLIC PROCEDURE [sType: CSEIndex] RETURNS [type: CSEIndex] =
    BEGIN
    next: CSEIndex;
    FOR type _ sType, next
      DO
      WITH seb[type] SELECT FROM
	subrange =>  next _ UnderType[rangeType];
	record =>
	  IF Bundling[type] # 0
	    THEN  next _ Unbundle[LOOPHOLE[type, RecordSEIndex]]
	    ELSE RETURN;
	ENDCASE =>  RETURN
      ENDLOOP;
    END;


  IdentifiedType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [BOOLEAN] =
    BEGIN
    WITH seb[type] SELECT FROM
      mode, definition, nil => RETURN [FALSE];
      record =>
	BEGIN
	IF hints.variant AND ~hints.comparable
	  THEN [] _ VariantUnionType[type];	-- force copying now
	RETURN [TRUE]
	END;
      ENDCASE => RETURN [TRUE]
    END;

  OrderedType: PUBLIC PROCEDURE [type: SEIndex] RETURNS [BOOLEAN] =
    BEGIN
    sei: CSEIndex;
      DO
      sei _ UnderType[type];
      WITH seb[sei] SELECT FROM
	basic =>  RETURN [ordered];
	enumerated =>  RETURN [ordered];
	pointer => RETURN [ordered];
	relative =>  type _ offsetType;
	subrange =>  type _ rangeType;
	long, real =>  type _ rangeType;
	ENDCASE =>  RETURN [FALSE];
      ENDLOOP;
    END;


  MakeLongType: PUBLIC PROCEDURE [rType: SEIndex, hint: CSEIndex] RETURNS [type: CSEIndex] =
    BEGIN
    WITH seb[hint] SELECT FROM
      long =>
	IF TargetType[UnderType[rangeType]] = TargetType[UnderType[rType]]
	  THEN RETURN [hint];
      ENDCASE;
    type _ MakeNonCtxSe[SIZE[long cons SERecord]];
    seb[type] _ SERecord[mark3: TRUE, mark4: TRUE,
	body: cons[long[rangeType: rType]]];
    RETURN
    END;

  MakePointerType: PUBLIC PROCEDURE [cType: SEIndex, hint: CSEIndex, readOnly: BOOLEAN]
      RETURNS [type: CSEIndex] =
    BEGIN
    WITH t: seb[hint] SELECT FROM
      pointer =>
	IF ~t.ordered AND t.readOnly = readOnly
	 AND UnderType[t.refType] = UnderType[cType]
	  THEN RETURN [hint];
      ENDCASE;
    type _ MakeNonCtxSe[SIZE[pointer cons SERecord]];
    seb[type] _ SERecord[mark3: TRUE, mark4: TRUE,
	body: cons[pointer[
	    ordered: FALSE,
	    readOnly: readOnly,
	    basing: FALSE,
	    dereferenced: FALSE,
	    refType: cType]]];
    RETURN
    END;

  END.