-- file Pass3D.mesa
-- last modified by Satterthwaite, February 24, 1983 3:14 pm
-- last modified by Donahue, 10-Dec-81 10:22:58

DIRECTORY
  A3: TYPE USING [
    AssignableType, Default, DefaultInit, IndexType, NewableType, OrderedType,
    TargetType, TypeForTree, Voidable, VoidItem],
  Alloc: TYPE USING [Notifier],
  ComData: TYPE USING [
    idANY, idCARDINAL, interface, mainCtx, moduleCtx, seAnon, textIndex,
    typeINTEGER, typeStringBody],
  Inline: TYPE USING [BITOR],
  Log: TYPE USING [Error, ErrorHti, ErrorSei, ErrorTree],
  P3: TYPE USING [
    Attr, NPUse, SequenceNP, fullAttr, voidAttr,
    mark, pathNP, phraseNP,
    CheckDisjoint, ClearRefStack, CopyTree, EnterComposite, Exp, FindSe,
    InterfaceCtx, MakeFrameRecord, PopCtx, PushCtx, RAttr, RecordLhs,
    RecordMention, Rhs, RPop, RPush, RType, SafetyAttr, SealRefStack,
    SearchCtxList, SelectVariantType, TopCtx, UnsealRefStack, VariantUnionType,
    VoidExp],
  Symbols: TYPE USING [
    Base, SERecord, Name, Type, ISEIndex, CSEIndex,
    RecordSEIndex, RefSEIndex, CTXIndex, CBTIndex,
    nullType, ISENull, CTXNull, codeANY, codeINT, lG, lZ, typeANY, typeTYPE,
    seType, ctxType, mdType, bodyType],
  SymbolOps: TYPE USING [
    ArgCtx, CopyXferType, EnterExtension, LinkMode, MakeNonCtxSe, NormalType,
    RCType, ReferentType, TypeForm, TypeLink, UnderType, XferMode],
  Tree: TYPE USING [Base, Index, Link, Map, Null, NullIndex, Scan, treeType],
  TreeOps: TYPE USING [
    FreeTree, GetHash, GetNode, GetSe, IdentityMap, ListHead, ListLength,
    NthSon, OpName, ScanList, UpdateList];

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

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

  DeclNotify: PUBLIC Alloc.Notifier = {
    -- called by allocator whenever table area is repacked
    tb ← base[Tree.treeType];
    seb ← base[seType];  ctxb ← base[ctxType];  mdb ← base[mdType];
    bb ← base[bodyType]};


-- signals for type loop detection

  CheckTypeLoop: SIGNAL [loopNode: Tree.Index] RETURNS [BOOL] = CODE;
  LogTypeLoop: SIGNAL [loopNode: Tree.Index] = CODE;


-- declaration processing

  ItemId: PUBLIC PROC [t: Tree.Link] RETURNS [ISEIndex] = {
    RETURN [WITH t SELECT FROM
      symbol => index,
      subtree => ItemId[tb[index].son[1]],
      ENDCASE => ERROR]};

  FirstId: PUBLIC PROC [node: Tree.Index] RETURNS [ISEIndex] = {
    RETURN [ItemId[ListHead[tb[node].son[1]]]]};


  DeclList: PUBLIC Tree.Scan = {ScanList[t, DeclA]; ScanList[t, DeclBInit]};

  DeclA: Tree.Scan = {
    node: Tree.Index = GetNode[t];
    type: Type;
    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]];
    SELECT tb[node].name FROM
      typedecl => DefineTypeSe[tb[node].son[1], type];
      decl => DefineSeType[tb[node].son[1], type, tb[node].attr1];
      ENDCASE => ERROR;
    ClearRefStack[];
    dataPtr.textIndex ← saveIndex};

  DeclBField: Tree.Scan = {DeclBDefault[t, FALSE]};

  DeclBVarField: Tree.Scan = {DeclBDefault[t, TRUE]};

  DeclBDefault: PROC [t: Tree.Link, varOK: BOOL←FALSE] = {
    node: Tree.Index = GetNode[t];
    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[typeExp: tb[node].son[2], varOK: varOK];
    SELECT tb[node].name FROM
      typedecl => NULL;
      decl => {
	type: Type = TypeForTree[tb[node].son[2]];
	IF ~NewableType[type] THEN Log.ErrorTree[typeLength, tb[node].son[2]];
	IF tb[node].son[3] # Tree.Null THEN {
	  ScanList[tb[node].son[1], RecordDeclInit];
	  tb[node].son[3] ← DefaultExp[t:tb[node].son[3], type:type, ids:tb[node].son[1]]};
	DefineSeValue[tb[node].son[1], FALSE]};
      ENDCASE => ERROR;
    ClearRefStack[];
    dataPtr.textIndex ← saveIndex};

  DeclBInit: Tree.Scan = {
    node: Tree.Index = GetNode[t];
    saveIndex: CARDINAL = dataPtr.textIndex;
    IF tb[node].attr2 = P3.mark THEN RETURN;	-- already processed
    tb[node].attr2 ← P3.mark;
    dataPtr.textIndex ← tb[node].info;
    [] ← CheckPositions[tb[node].son[1], FieldAttrs[]];
    SELECT tb[node].name FROM
      typedecl => {
	TypeAttr[tb[node].son[2]];
	IF tb[node].son[3] # Tree.Null THEN {
	  tb[node].son[3] ← DefaultExp[
	    t:tb[node].son[3], type:TypeForTree[tb[node].son[2]], ids:tb[node].son[1]];
	  [] ← ProcessDefault[node]}};
      decl => {
	type: Type;
	constFlag, extFlag: BOOL;
	ctx: CTXIndex = TopCtx[];
	TypeAttr[typeExp: tb[node].son[2], varOK: InterfaceContext[ctx]];
	type ← TypeForTree[tb[node].son[2]];
	IF ~NewableType[type] THEN Log.ErrorTree[typeLength, tb[node].son[2]];
	IF tb[node].son[3] = Tree.Null THEN {
	  IF ~InterfaceContext[ctx] AND ~tb[node].attr1 THEN {
	    tb[node].son[3] ←  DefaultInit[type];
	    pathNP ← SequenceNP[pathNP][phraseNP]; RPop[]};
	  constFlag ← FALSE}
	ELSE {
	  [tb[node].son[3], extFlag] ← InitialExp[tb[node].son[3], type];
	  IF extFlag AND ~tb[node].attr1 THEN Log.ErrorTree[misusedInline, tb[node].son[3]];
	  pathNP ← SequenceNP[pathNP][phraseNP];
	  constFlag ← tb[node].attr1 AND RAttr[].const;  RPop[];
	  IF tb[node].son[3] # Tree.Null THEN ScanList[tb[node].son[1], RecordDeclInit]};
	SELECT TRUE FROM
	  (tb[node].son[3] = Tree.Null) =>
	    IF ~InterfaceContext[ctx] AND ~Voidable[type] THEN
	      Log.ErrorSei[missingInit, FirstId[node]];
	  GlobalContext[ctx] =>
	    SELECT RCType[type] FROM
	      composite => EnterComposite[type, tb[node].son[3], TRUE];
	      ENDCASE => NULL;
	  ENDCASE => NULL;
	DefineSeValue[tb[node].son[1], constFlag]};
      ENDCASE => ERROR;
    ClearRefStack[];
    dataPtr.textIndex ← saveIndex};


  RecordDeclInit: Tree.Scan = {
    sei: ISEIndex = ItemId[t]; RecordMention[sei]; RecordLhs[sei]};


  DefaultExp: PROC [t: Tree.Link, type: Type, ids: Tree.Link] RETURNS [v: Tree.Link] = {
    subType: CSEIndex = TargetType[type];

    ExpInit: PROC [t: Tree.Link] RETURNS [val: Tree.Link] = {
      val ← Rhs[t, subType];  RPop[];  RETURN};

    v ← UpdateList[t, ExpInit];
    IF VoidItem[v] AND ~Voidable[type] THEN Log.ErrorSei[defaultForm, ItemId[ids]];
    RETURN};

  InitialExp: PUBLIC PROC [t: Tree.Link, type: Type]
      RETURNS [v: Tree.Link, extended: BOOL] = {
    subType: CSEIndex = UnderType[type];
    v ← t;  extended ← FALSE;  phraseNP ← none;
    SELECT OpName[t] FROM
      body => {
	-- defer processing of bodies (see Body)
	expNode: Tree.Index = GetNode[t];
	bti: CBTIndex = tb[expNode].info;
	attr: Attr ← voidAttr;
	SELECT XferMode[type] FROM
	  proc, program => NULL;
	  ENDCASE =>
	    IF TypeForm[type] = definition THEN attr ← fullAttr ELSE Log.Error[bodyType];
	bb[bti].ioType ← SELECT seb[type].seTag FROM
			    cons => subType,
			    ENDCASE => CopyXferType[subType, IdentityMap];
	RPush[type, attr];  extended ← tb[expNode].attr3;  -- inline
	CheckBodyType[subType, expNode]};
      inline => {
	expNode: Tree.Index = GetNode[t];

	CodeBody: Tree.Map = {RETURN [UpdateList[t, NumericConst]]};

	IF XferMode[type] # proc THEN Log.Error[inlineType];
	IF tb[expNode].attr1 THEN Log.Error[attrClash];
	tb[expNode].son[1] ← UpdateList[tb[expNode].son[1], CodeBody];
	RPush[type, fullAttr];  extended ← TRUE;
	CheckBodyType[subType, expNode]};
      apply => {
	expNode: Tree.Index = GetNode[t];
	IF tb[expNode].son[1] = Tree.Null
	 AND ReferentType[subType] = dataPtr.typeStringBody
	 AND ListLength[tb[expNode].son[2]] = 1 THEN
	  tb[expNode].name ← stringinit;
	v ← Rhs[t, TargetType[subType]]};
      signalinit => RPush[type, voidAttr];
      void => {v ← FreeTree[t];  RPush[subType, voidAttr]};
      ENDCASE => v ← Rhs[t, TargetType[subType]];
    RETURN};



  RecordField: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {
    RETURN [ctx = CTXNull OR (ctxb[ctx].level = lZ AND ctx # dataPtr.moduleCtx)]};

  GlobalContext: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {
    RETURN [~dataPtr.interface AND ctxb[ctx].level = lG]};

  InterfaceContext: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE {
    RETURN [dataPtr.interface AND ctx = dataPtr.mainCtx]};

  InterfaceSe: PROC [sei: ISEIndex] RETURNS [BOOL] = INLINE {
    RETURN [InterfaceContext[seb[sei].idCtx]]};


  CheckBodyType: PROC [type: CSEIndex, node: Tree.Index] = {
    WITH t: seb[type] SELECT FROM
      transfer => {
        IF TypeForm[t.typeIn] = any OR TypeForm[t.typeOut] = any THEN
	  Log.Error[bodyType];
	IF t.safe AND SafetyAttr[node] = none THEN Log.Error[unsafeBlock]};
      ENDCASE};
      
      
  DefineTypeSe: PROC [t: Tree.Link, info: Type] = {
    first: BOOL ← TRUE;

    UpdateSe: Tree.Scan = {
      sei: ISEIndex = ItemId[t];
      seb[sei].idType ← typeTYPE;  seb[sei].idInfo ← info;
      seb[sei].immutable ← seb[sei].constant ← TRUE;
      IF first THEN {info ← sei; first ← FALSE};
      seb[sei].mark3 ← TRUE};

    ScanList[t, UpdateSe]};

  DefineSeType: PROC [t: Tree.Link, type: Type, fixed: BOOL] = {

    UpdateSe: Tree.Scan = {
      sei: ISEIndex = ItemId[t];
      seb[sei].idType ← type;  seb[sei].constant ← FALSE;
      IF InterfaceSe[sei] THEN seb[sei].immutable ← seb[sei].immutable OR fixed
      ELSE seb[sei].immutable ← fixed;
      seb[sei].mark3 ← TRUE};

    ScanList[t, UpdateSe]};

  DefineSeValue: PROC [t: Tree.Link, const: BOOL] = {

    UpdateSe: Tree.Scan = {
      sei: ISEIndex = ItemId[t];
      seb[sei].constant ← const;
      IF InterfaceSe[sei] AND LinkMode[sei] = val THEN seb[sei].immutable ← TRUE};

    ScanList[t, UpdateSe]};


  ProcessDefault: PROC [node: Tree.Index] RETURNS [nonVoid: BOOL] = {
    copy: BOOL;
    v: Tree.Link = tb[node].son[3];

    DefineDefault: Tree.Scan = {
      EnterExtension[ItemId[t], default, IF copy THEN CopyTree[v] ELSE v];
      copy ← TRUE};

    SELECT OpName[v] FROM
      stringinit => Log.ErrorSei[defaultForm, FirstId[node]];
      lengthen =>
	IF OpName[NthSon[v, 1]] = stringinit THEN
	  Log.ErrorSei[defaultForm, FirstId[node]];
      void => nonVoid ← FALSE;
      ENDCASE => nonVoid ← TRUE;
    copy ← FALSE;  ScanList[tb[node].son[1], DefineDefault];
    tb[node].son[3] ← Tree.Null};


 -- forward reference resolution

  ResolveType: PUBLIC PROC [sei: ISEIndex] = {
    currentCtx: CTXIndex = TopCtx[];
    IF seb[sei].idCtx # currentCtx THEN {PopCtx[]; ResolveType[sei]; PushCtx[currentCtx]}
    ELSE {SealRefStack[]; DeclA[[subtree[index: seb[sei].idValue]]]; UnsealRefStack[]}};

  ResolveValue: PUBLIC PROC [sei: ISEIndex] = {
    currentCtx: CTXIndex = TopCtx[];
    IF seb[sei].idCtx # currentCtx THEN {PopCtx[]; ResolveValue[sei]; PushCtx[currentCtx]}
    ELSE {
      SealRefStack[];
      IF RecordField[currentCtx] THEN DeclBDefault[[subtree[index: seb[sei].idValue]]]
      ELSE  DeclBInit[[subtree[index: seb[sei].idValue]]];
      UnsealRefStack[]}};


 -- type expressions

  CheckTypeId: PROC [sei: ISEIndex] RETURNS [BOOL] = {
    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]};

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


  PushArgCtx: PROC [sei: CSEIndex] = {
    ctx: CTXIndex = ArgCtx[sei];
    IF ctx # CTXNull THEN PushCtx[ctx]};

  PopArgCtx: PROC [sei: CSEIndex] = {
    IF ArgCtx[sei] # CTXNull THEN PopCtx[]};


  TypeExp: PUBLIC PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = {
    val ← TypeLink[typeExp]; TypeAttr[val]; RETURN};

  TypeAppl: PUBLIC PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = {
    attr: Attr;
    IF OpName[typeExp] = apply THEN {
      node: Tree.Index = GetNode[typeExp];
      rType: Type;
      tb[node].son[1] ← TypeExp[tb[node].son[1]];
      tb[node].info ← rType ← TypeForTree[tb[node].son[1]];
      SELECT TRUE FROM
	(UnderType[rType] = dataPtr.typeStringBody),
	(TypeForm[VariantUnionType[rType]] = sequence) => {
	  tb[node].son[2] ← Rhs[tb[node].son[2], dataPtr.typeINTEGER]; attr ← RAttr[]; RPop[]};
	(TypeForm[VariantUnionType[rType]] = union) => {
	  TypeDiscrim[rType, node];  phraseNP ← none; attr ← fullAttr};
	ENDCASE => {
	  Log.ErrorTree[typeClash, tb[node].son[1]];
	  tb[node].son[2] ← Exp[tb[node].son[2], typeANY]; attr ← RAttr[]; RPop[]};
      val ← typeExp}
    ELSE {val ← TypeExp[typeExp]; phraseNP ← none; attr ← fullAttr};
    RPush[typeTYPE, attr]};


  ClusterExp: PROC [t: Tree.Link] RETURNS [val: Tree.Link] = {
    WITH t SELECT FROM
      hash => {
        sei: ISEIndex = FindSe[index].symbol;
        IF ~CheckTypeId[sei] THEN		-- prevent duplicate error messages
          val ← Exp[IF sei = dataPtr.seAnon THEN [symbol[sei]] ELSE t, typeANY]
        ELSE {val ← TypeSymbol[sei]; RPush[typeTYPE, fullAttr]}};
      symbol => {
        sei: ISEIndex = index;
        IF ~CheckTypeId[sei] THEN val ← Exp[t, typeANY]
        ELSE {val ← TypeSymbol[sei]; RPush[typeTYPE, fullAttr]}};
      ENDCASE => {val ← TypeLink[t]; RPush[typeTYPE, fullAttr]};
    RETURN};
      
  TypeDot: PROC [rType: Type, node: Tree.Index] = TypeDiscrim;
    -- for now, should do other possible cluster items

  TypeDiscrim: PROC [rType: Type, node: Tree.Index] = {
    t2: Tree.Link = tb[node].son[2];
    WITH h: t2 SELECT FROM
      hash => {
	iSei: ISEIndex = SelectVariantType[rType, h.index];
	IF iSei # ISENull THEN {
	  tb[node].info ← iSei;  tb[node].son[2] ← [symbol[index: iSei]];
	  tb[node].name ← discrimTC}
	ELSE {
	  IF rType # typeANY THEN Log.ErrorTree[unknownVariant, t2];
	  tb[node].info ← dataPtr.idANY}};
      ENDCASE => {
	Log.ErrorTree[unknownVariant, t2]; tb[node].son[2] ← VoidExp[t2]}};


  FindLinkType: SIGNAL RETURNS [CSEIndex] = CODE;	-- to find list link type

  TypeLink: PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = {
    WITH typeExp SELECT FROM
      hash => {
	sei: ISEIndex = FindSe[index].symbol;
	IF sei # ISENull THEN val ← TypeSymbol[sei]
	ELSE {Log.ErrorHti[nonTypeId, index]; val ← [symbol[dataPtr.idANY]]}};
      symbol => val ← TypeSymbol[index];
      subtree => {
	node: Tree.Index = index;
	iSei: ISEIndex;
	SELECT tb[node].name FROM
	  discrimTC => {
	    tb[node].son[1] ← TypeLink[tb[node].son[1]];
	    TypeDiscrim[TypeForTree[tb[node].son[1]], node]};
	  apply => {
	    rType: Type;
	    tb[node].son[1] ← TypeLink[tb[node].son[1]];
	    tb[node].info ← rType ← TypeForTree[tb[node].son[1]];
	    IF TypeForm[VariantUnionType[rType]] = union THEN TypeDiscrim[rType, node]
	    ELSE Log.ErrorTree[noApplication, tb[node].son[1]]};
	  dot => {
	    name: Name = GetHash[tb[node].son[2]];
	    nDerefs: CARDINAL ← 0;
	    found: BOOL;
	    next: Type;
	    ctx: CTXIndex ← CTXNull;
	    tb[node].son[1] ← ClusterExp[tb[node].son[1]];
	    FOR subType: Type ← RType[], next DO
	      csei: CSEIndex = UnderType[subType];
	      WITH t: seb[csei] SELECT FROM
		mode => GOTO type;
		definition, transfer => {
		  ctx ← InterfaceCtx[csei, tb[node].son[1]]; GO TO cluster};
		record => {ctx ← t.fieldCtx; GO TO cluster};
		ref => {IF (nDerefs ← nDerefs+1) > 63 THEN GO TO cluster; next ← t.refType};
		long => next ← t.rangeType;
		subrange => next ← t.rangeType;
		ENDCASE => GO TO cluster;
	      REPEAT
		type => TypeDot[TypeForTree[tb[node].son[1]], node];
		cluster => {
		  [found, iSei] ← SearchCtxList[name, ctx];
		  IF ~found THEN {iSei ← dataPtr.idANY; Log.ErrorHti[unknownField, name]};
		  tb[node].name ← cdot;
		  tb[node].info ← iSei;  tb[node].son[2] ← TypeSymbol[iSei]};
	      ENDLOOP;
	    RPop[]};
	  paintTC => {
	    tb[node].son[1] ← TypeLink[tb[node].son[1]];
	    tb[node].son[2] ← TypeLink[tb[node].son[2]];
	    tb[node].info ← TypeForTree[tb[node].son[2]]};
	  linkTC => tb[node].info ← SIGNAL FindLinkType[];
	  implicitTC => NULL;
	  frameTC => {
	    tb[node].son[1] ← Exp[tb[node].son[1], typeANY];  RPop[];
	    tb[node].info ← MakeFrameRecord[tb[node].son[1]]};
	  ENDCASE => {
	    OPEN tb[node];
	    type: CSEIndex = info;
	    WITH t: seb[type] SELECT FROM
	      enumerated => NULL;
	      record => {PushCtx[t.fieldCtx]; ScanList[son[1], DeclA]; PopCtx[]};
	      ref => {
		son[1] ← TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}];
		t.refType ← TypeForTree[son[1]]};
	      array => {
		IF son[1] = Tree.Null THEN t.indexType ← dataPtr.idCARDINAL
		ELSE {son[1] ← TypeLink[son[1]]; t.indexType ← TypeForTree[son[1]]};
		son[2] ← TypeLink[son[2]];  t.componentType ← TypeForTree[son[2]]};
	      arraydesc => {
		son[1] ← TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}];
		t.describedType ← TypeForTree[son[1]]};
	      transfer => {
		ENABLE  CheckTypeLoop => {RESUME [FALSE]};
		CheckDisjoint[ArgCtx[t.typeIn], ArgCtx[t.typeOut]];
		PushArgCtx[t.typeIn];
		IF OpName[son[1]] # anyTC THEN ScanList[son[1], DeclA];
		PushArgCtx[t.typeOut];
		IF OpName[son[2]] # anyTC THEN ScanList[son[2], DeclA];
		PopArgCtx[t.typeOut];  PopArgCtx[t.typeIn]};
	      definition => t.defCtx ← dataPtr.mainCtx;
	      union => {DeclA[son[1]]; ScanList[son[2], DeclA]};
	      sequence => {
		DeclA[son[1]];
		son[2] ← TypeLink[son[2]];  t.componentType ← TypeForTree[son[2]]};
	      relative => {
		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]]};
	      opaque => IF t.id = ISENull OR ~InterfaceSe[t.id] THEN Log.Error[misplacedType];
	      zone => NULL;
	      subrange => {
		t.range ← LOOPHOLE[node];    -- to allow symbolic evaluation
		son[1] ← TypeLink[son[1]]; t.rangeType ← TypeForTree[son[1]]};
	      long => {
		son[1] ← TypeLink[son[1] ! FindLinkType => {RESUME [type]}];
		t.rangeType ← TypeForTree[son[1]]};
	      any => NULL;
	      ENDCASE => ERROR;
	    seb[type].mark3 ← TRUE};
	val ← typeExp};
      ENDCASE => ERROR;
    RETURN};


  TypeAttr: PROC [typeExp: Tree.Link, indirect, varOK: BOOL ← FALSE] = {
    WITH typeExp SELECT FROM
      symbol =>
	IF ~indirect THEN {
	  sei: ISEIndex = index;
	  IF seb[sei].mark3 AND ~seb[sei].mark4 THEN {
	    declNode: Tree.Index = seb[sei].idValue;
	    IF tb[declNode].attr2 # P3.mark THEN ResolveValue[sei]}};
      subtree => {
	node: Tree.Index = index;
	SELECT tb[node].name FROM
	  discrimTC => TypeAttr[tb[node].son[1], indirect];
	  cdot => TypeAttr[tb[node].son[2], indirect];
	  paintTC => {
	    TypeAttr[tb[node].son[1]]; TypeAttr[tb[node].son[2], indirect];
	    Log.Error[unimplemented]};
	  implicitTC, linkTC => NULL;
	  frameTC => NULL;
	  apply => tb[node].son[2] ← VoidExp[tb[node].son[2]];
	  dot => NULL;
	  ENDCASE => {
	    OPEN tb[node];
	    type: CSEIndex = info;
	    subType: CSEIndex;
	    WITH t: seb[type] SELECT FROM
	      enumerated =>
		IF AssignedEnumeration[son[1]] AND ~t.machineDep THEN Log.Error[machDep];
	      record => {
		saveNP: NPUse = pathNP;
		PushCtx[t.fieldCtx];  pathNP ← none;
		ScanList[son[1], DeclBField];
		WITH s: t SELECT FROM
		  linked => CheckDisjointPrefix[t.fieldCtx, s.linkType];
		  notLinked => {
		    attrs: FieldAttrs = CollectAttrs[
				son[1], FieldAttrs[positionValid: t.machineDep]];
		    UpdateHints[LOOPHOLE[type], attrs];
		    attr1 ← AssignedPositions[attrs]};
		  ENDCASE => ERROR;
		PopCtx[];  pathNP ← saveNP};
	      ref => {
	        IF t.var AND ~varOK THEN Log.Error[var];
		TypeAttr[son[1], TRUE]};
	      array => {
		IF son[1] # Tree.Null THEN TypeAttr[son[1]];
		SELECT TRUE FROM
		  ~IndexType[t.indexType] => {
		    t.indexType ← typeANY; Log.Error[nonOrderedType]};
		  (TypeForm[t.indexType]=long) => Log.Error[subrangeNesting];
		  ENDCASE;
		TypeAttr[son[2], indirect];
		IF ~NewableType[t.componentType] THEN Log.ErrorTree[typeLength, son[2]]};
	      arraydesc => {
		TypeAttr[son[1], TRUE];
		IF TypeForm[t.describedType] # array THEN Log.Error[descriptor]};
	      transfer => {
		saveNP: NPUse = pathNP;
		IF t.mode = error THEN t.safe ← FALSE;
		PushArgCtx[t.typeIn];
		ArgAttr[t.typeIn, son[1], t.mode = proc OR t.mode = signal];
		PushArgCtx[t.typeOut];
		ArgAttr[t.typeOut, son[2], FALSE];
		PopArgCtx[t.typeOut];  PopArgCtx[t.typeIn];
		pathNP ← saveNP};
	      definition => NULL;
	      union => {
		tagType: CSEIndex;
		DeclBDefault[son[1]];
		seb[t.tagSei].immutable ← TRUE;
		tagType ← TargetType[seb[t.tagSei].idType];
		IF seb[tagType].typeTag # enumerated THEN {
		  Log.ErrorSei[nonTagType, t.tagSei]; tagType ← typeANY};
		VariantList[son[2], tagType]};
	      sequence => {
		DeclBDefault[son[1]];
		seb[t.tagSei].immutable ← TRUE;
		SELECT TRUE FROM
		  ~IndexType[seb[t.tagSei].idType] => Log.ErrorSei[nonTagType, t.tagSei];
		  (TypeForm[seb[t.tagSei].idType]=long) => Log.Error[unimplemented];
		  ENDCASE;
		TypeAttr[son[2], indirect]};
	      relative => {
		vType: CSEIndex;
		TypeAttr[son[1], TRUE];
		IF seb[NormalType[t.baseType]].typeTag # ref THEN Log.Error[relative];
		TypeAttr[son[2]];
		vType ← UnderType[t.offsetType];  subType ← NormalType[vType];
		SELECT seb[subType].typeTag FROM
		  ref, arraydesc => NULL;
		  ENDCASE => {Log.Error[relative]; subType ← typeANY};
		IF seb[UnderType[t.baseType]].typeTag = long OR seb[vType].typeTag = long THEN
		  subType ← MakeLongType[subType, vType];
		t.resultType ← subType};
	      zone => NULL;
	      opaque =>
		IF son[1] # Tree.Null THEN {
		  son[1] ← Rhs[son[1], dataPtr.typeINTEGER];
		  IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, son[1]];
		  RPop[]};
	      subrange => {
		target: CSEIndex;
		subNode: Tree.Index = GetNode[son[2]];
		TypeAttr[son[1], indirect];  subType ← UnderType[t.rangeType];
		SELECT TRUE FROM
		  (TypeForm[subType] = ref) => target ← dataPtr.typeINTEGER;
		  OrderedType[subType] => {
		    WITH s: seb[subType] SELECT FROM
		      long => {
		        t.rangeType ← s.rangeType;
			subType ← UnderType[s.rangeType]};
		      real => Log.Error[subrangeNesting];
		      ENDCASE;
		    target ← TargetType[subType]};
		  ENDCASE => {Log.Error[nonOrderedType]; target ← typeANY};
		tb[subNode].son[1] ← EndPoint[tb[subNode].son[1], target];
		tb[subNode].son[2] ← EndPoint[tb[subNode].son[2], target]};
	      long => {
		TypeAttr[son[1], indirect, varOK];
		subType ← UnderType[t.rangeType];
		WITH s: seb[subType] SELECT FROM
		  basic =>
		    SELECT s.code FROM
		      codeINT, codeANY => NULL;
		      ENDCASE => Log.Error[long];
		  ref, arraydesc => NULL;
		  subrange => IF t.rangeType # dataPtr.idCARDINAL THEN Log.Error[long];
		  ENDCASE => Log.Error[long]};
	      any => NULL;
	      ENDCASE => ERROR}};
      ENDCASE => ERROR};
      
      EndPoint: PROC [t: Tree.Link, target: CSEIndex] RETURNS [v: Tree.Link] = {
        v ← Rhs[t, target];
        IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, v];
        RPop[]};


 -- record attribute collection

  FieldAttrs: TYPE = RECORD [
    positionValid: BOOL ← FALSE,
    noAssign: BOOL ← FALSE,
    refField, unVoidable, default: BOOL ← FALSE,
    positions: PACKED ARRAY {implicit, explicit} OF BOOL ← [FALSE, FALSE]];

  MergeAttrs: PROC [attr1, attr2: FieldAttrs] RETURNS [FieldAttrs] =
    LOOPHOLE[Inline.BITOR];

  UpdateHints: PROC [rSei: RecordSEIndex, attrs: FieldAttrs] = {
    seb[rSei].hints.assignable ← ~attrs.noAssign;
    seb[rSei].hints.refField ← attrs.refField;
    seb[rSei].hints.voidable ← ~attrs.unVoidable;
    seb[rSei].hints.default ← attrs.default};

  AssignedPositions: PROC [attrs: FieldAttrs] RETURNS [assigned: BOOL] = {
    IF attrs.positionValid THEN {
      IF attrs.positions = [TRUE, TRUE] THEN Log.Error[mixedPositions];
      assigned ← attrs.positions[explicit]}
    ELSE assigned ← FALSE;
    RETURN};

  CollectAttrs: PROC [t: Tree.Link, attrs: FieldAttrs] RETURNS [FieldAttrs] = {

    ProcessField: Tree.Scan = {
      node: Tree.Index = GetNode[t];
      type: Type = TypeForTree[tb[node].son[2]];
      subType: CSEIndex = UnderType[type];
      attrs ← CheckPositions[tb[node].son[1], attrs];
      IF (IF tb[node].son[3] = Tree.Null
		THEN Default[type] = nonVoid
		ELSE ProcessDefault[node]) THEN attrs.default ← TRUE;
      WITH t: seb[subType] SELECT FROM
	union => {
	  subNode: Tree.Index = GetNode[tb[node].son[2]];
	  IF t.controlled THEN ProcessField[tb[subNode].son[1]];
	  attrs ← MergeVariantAttrs[tb[subNode].son[2], attrs];
	  t.hints.refField ← attrs.refField; t.hints.voidable ← ~attrs.unVoidable;
	  t.hints.default ← attrs.default;
	  tb[subNode].attr1 ← attrs.positions[explicit]};
	sequence => {
	  subNode: Tree.Index = GetNode[tb[node].son[2]];
	  IF t.controlled THEN ProcessField[tb[subNode].son[1]];
	  IF RCType[t.componentType] # none THEN {
	    IF ~t.controlled THEN Log.Error[attrClash];
	    attrs.refField ← --attrs.unVoidable ←-- TRUE};
	  attrs.noAssign ← TRUE;
	  tb[subNode].attr1 ← attrs.positions[explicit]};
	ENDCASE => {
	  IF ~attrs.refField AND RCType[subType] # none THEN
	    attrs.refField ← attrs.unVoidable ← TRUE;
	  IF ~attrs.unVoidable AND ~Voidable[type] THEN attrs.unVoidable ← TRUE;
	  IF ~AssignableType[subType, FALSE] THEN attrs.noAssign ← TRUE}};

    ScanList[t, ProcessField];
    RETURN [attrs]};

  ArgAttr: PROC [rSei: CSEIndex, t: Tree.Link, varOK: BOOL] = {
    IF rSei # nullType THEN
      WITH seb[rSei] SELECT FROM
        record => {
	  ScanList[t, IF varOK THEN DeclBVarField ELSE DeclBField];
	  UpdateHints[LOOPHOLE[rSei], CollectAttrs[t, FieldAttrs[]]]};
	ENDCASE};


 -- machine dependent layout

  NumericConst: Tree.Map = {v ← Rhs[t, dataPtr.typeINTEGER];  RPop[];  RETURN};

  AssignedEnumeration: PROC [t: Tree.Link] RETURNS [assigned: BOOL] = {

    AssignElement: Tree.Scan = {
      WITH t SELECT FROM
	subtree => {
	  node: Tree.Index = index;
	  tb[node].son[2] ← NumericConst[tb[node].son[2]];  assigned ← TRUE};
	ENDCASE => NULL;
      RETURN};

    assigned ← FALSE;  ScanList[t, AssignElement];  RETURN};

  CheckPositions: PROC [t: Tree.Link, attrs: FieldAttrs] RETURNS [FieldAttrs] = {

    CheckPosition: Tree.Scan = {
      WITH t SELECT FROM
	subtree => {
	  node: Tree.Index = GetNode[tb[index].son[2]];
	  IF ~attrs.positionValid THEN Log.ErrorSei[position, ItemId[tb[index].son[1]]];
	  tb[node].son[1] ← NumericConst[tb[node].son[1]];
	  IF tb[node].son[2] # Tree.Null THEN {
	    subNode: Tree.Index = GetNode[tb[node].son[2]];
	    tb[subNode].son[1] ← NumericConst[tb[subNode].son[1]];
	    tb[subNode].son[2] ← NumericConst[tb[subNode].son[2]]};
	  attrs.positions[explicit] ← TRUE};
	ENDCASE => attrs.positions[implicit] ← TRUE};

    ScanList[t, CheckPosition]; RETURN [attrs]};


 -- variants

  CheckDisjointPrefix: PROC [ctx: CTXIndex, link: Type] = {
    FOR sei: Type ← link, SymbolOps.TypeLink[sei] UNTIL sei = nullType DO
      type: CSEIndex = UnderType[sei];
      WITH t: seb[type] SELECT FROM
	record => CheckDisjoint[ctx, t.fieldCtx];
	ENDCASE;
      ENDLOOP};
       

  VariantList: PROC [t: Tree.Link, tagType: CSEIndex] = {

    DefineTag: Tree.Scan = {
      sei: ISEIndex = GetSe[t];
      seb[sei].idValue ← TagValue[seb[sei].hash, tagType]};

    VariantItem: Tree.Scan = {
      node: Tree.Index = GetNode[t];
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex ← tb[node].info;
      ScanList[tb[node].son[1], DefineTag];
      DeclBDefault[t];
      dataPtr.textIndex ← saveIndex};

    ScanList[t, VariantItem]};

  TagValue: PROC [tag: Name, tagType: CSEIndex] RETURNS [CARDINAL] = {
    matched: BOOL;
    sei: ISEIndex;
    WITH seb[tagType] SELECT FROM
      enumerated => {
	[matched, sei] ← SearchCtxList[tag, valueCtx];
	IF matched THEN RETURN [seb[sei].idValue]};
      ENDCASE;
    Log.ErrorHti[unknownTag, tag];  RETURN [0]};

  MergeVariantAttrs: PROC [list: Tree.Link, prefixAttrs: FieldAttrs]
      RETURNS [mergedAttrs: FieldAttrs] = {

    ProcessVariant: Tree.Scan = {
      node: Tree.Index = GetNode[t];

      ProcessLabel: Tree.Scan = {
	sei: ISEIndex = GetSe[t];
	type: Type = seb[sei].idInfo;
	WITH v: seb[type] SELECT FROM
	  cons =>
	    WITH r: v SELECT FROM
	      record => {
		subNode: Tree.Index = GetNode[tb[node].son[2]];
		attrs: FieldAttrs = CollectAttrs[tb[subNode].son[1], prefixAttrs];
		UpdateHints[LOOPHOLE[type], attrs];
		r.hints.default ← TRUE;
		tb[subNode].attr1 ← attrs.positions[explicit];
		mergedAttrs ← MergeAttrs[mergedAttrs, attrs]};
	      ENDCASE;
	  id => NULL;
	  ENDCASE};

      ScanList[tb[node].son[1], ProcessLabel]};

    mergedAttrs ← prefixAttrs;
    ScanList[list, ProcessVariant];  mergedAttrs.default ← prefixAttrs.default;
    RETURN};

 -- type construction

  MakeLongType: PUBLIC PROC [rType: Type, hint: CSEIndex] RETURNS [type: CSEIndex] = {
    subType: CSEIndex = UnderType[rType];
    WITH t: seb[hint] SELECT FROM
      long =>
        IF TargetType[t.rangeType] = TargetType[subType] THEN RETURN [hint];
      ENDCASE;
    WITH t: seb[subType] SELECT FROM
      relative => {
	oType: CSEIndex = MakeLongType[UnderType[t.offsetType], UnderType[t.resultType]];
	type ← MakeNonCtxSe[SERecord.cons.relative.SIZE];
	seb[type] ← [mark3: TRUE, mark4: TRUE,
	    body: cons[relative[
		baseType: t.baseType, offsetType: oType, resultType: oType]]]};
      ENDCASE => {
	type ← MakeNonCtxSe[SERecord.cons.long.SIZE];
	seb[type] ← [mark3: TRUE, mark4: TRUE, body: cons[long[rangeType: rType]]]};
    RETURN};

  MakeRefType: PUBLIC PROC [
        cType: Type, hint: CSEIndex, readOnly, counted, var: BOOL]
      RETURNS [type: RefSEIndex] = {
    WITH t: seb[hint] SELECT FROM
      ref =>
	IF ~t.ordered
	 AND t.readOnly = readOnly AND t.counted = counted AND t.var = var
	 AND UnderType[t.refType] = UnderType[cType] THEN RETURN [LOOPHOLE[hint]];
      ENDCASE;
    type ← LOOPHOLE[MakeNonCtxSe[SERecord.cons.ref.SIZE]];
    seb[type] ← [mark3: TRUE, mark4: TRUE,
	body: cons[ref[
	    counted: counted,
	    var: var,
	    readOnly: readOnly, ordered: FALSE, list: FALSE, basing: FALSE,
	    refType: cType]]];
    RETURN};

  }.