-- file Pass2.Mesa
-- last modified by Satterthwaite, November 2, 1979  8:47 AM

DIRECTORY
  ComData: FROM "comdata"
    USING [
      bodyIndex, bodyRoot, defBodyLimit, idINTEGER, idLOCK,
      importCtx, mainBody, mainCtx, moduleCtx,
      monitored, nBodies, nSigCodes, nTypeCodes, textIndex, typeMapId],
  CompilerUtil: FROM "compilerutil",
  Log: FROM "log" USING [Error, ErrorHti],
  Symbols: FROM "symbols"
    USING [
      BodyLink, BodyInfo, BodyRecord, ContextLevel, SERecord, TransferMode,
      HTIndex, SEIndex, CSEIndex, ISEIndex, RecordSEIndex,
      CTXIndex, BTIndex, CBTIndex,
      HTNull,  SENull,  CSENull,  ISENull,  RecordSENull,
      CTXNull,  BTNull,  CBTNull,
      lG, lL, lZ, typeANY, seType, ctxType, bodyType],
  SymbolOps: FROM "symbolops"
    USING [
      FillCtxSe, NewCtx, MakeNonCtxSe, MakeSeChain, NameClash,
      NextLevel, NextSe, StaticNestError],
  Table: FROM "table"
    USING [Base, Notifier, AddNotify, Allocate, DropNotify, Bounds],
  Tree: FROM "tree" USING [Index, Link, Map, Null, NullIndex, Scan, treeType],
  TreeOps: FROM "treeops"
    USING [
      FreeNode, GetNode, ListHead, ListLength,
      ScanList, TestTree, UpdateList];

Pass2: PROGRAM
    IMPORTS
	Log, SymbolOps, Table, TreeOps,
	dataPtr: ComData
    EXPORTS CompilerUtil =
  BEGIN
  OPEN TreeOps, SymbolOps, Symbols;

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

  Notify: Table.Notifier =
    BEGIN  -- called by allocator whenever tables are repacked
    tb _ base[Tree.treeType];
    seb _ base[seType];  ctxb _ base[ctxType];  bb _ base[bodyType];
    END;

  ContextInfo: TYPE = RECORD [
    ctx: CTXIndex,
    staticLevel: ContextLevel,
    seChain: ISEIndex];

  current: ContextInfo;

  NewContext: PROCEDURE [level: ContextLevel, entries: CARDINAL, unique: BOOLEAN] =
    BEGIN
    OPEN current;
    staticLevel _ level;
    IF entries = 0 AND ~unique
      THEN  BEGIN  ctx _ CTXNull;  seChain _ ISENull  END
      ELSE
	BEGIN
	ctx _ NewCtx[level];
	ctxb[ctx].seList _ seChain _ MakeSeChain[ctx, entries, FALSE];
	END;
    END;


 -- main driver

  P2Unit: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
    BEGIN
    node: Tree.Index;
    Table.AddNotify[Notify];
    node _ GetNode[t];
      BEGIN
      ENABLE	-- default error reporting
	BEGIN
	NameClash => BEGIN Log.ErrorHti[duplicateId, hti]; RESUME END;
	StaticNestError => BEGIN Log.Error[staticNesting]; RESUME END;
	END;
      dataPtr.textIndex _ tb[node].info;
      NewContext[lZ, ListLength[tb[node].son[1]]+ListLength[tb[node].son[2]], FALSE];
      dataPtr.moduleCtx _ current.ctx;
      ScanList[tb[node].son[1], IdDefinition];
      ScanList[tb[node].son[2], Module];
      END;
    Table.DropNotify[Notify];
    RETURN [t]
    END;


  lockLambda: Tree.Index;

  Module: Tree.Scan =
    BEGIN
    saved: ContextInfo;
    saveIndex: CARDINAL = dataPtr.textIndex;
    node: Tree.Index = GetNode[t];
    dataPtr.bodyIndex _ CBTNull;  dataPtr.nBodies _ dataPtr.nSigCodes _ 0;
    btLink _ [which:parent, index:BTNull];
    dataPtr.textIndex _ tb[node].info;
    -- process import list
      saved _ current;
      NewContext[lG, ListLength[tb[node].son[1]], FALSE];
      dataPtr.importCtx _ current.ctx;
      ScanList[tb[node].son[1], IdDefinition];
      current _ saved;
    dataPtr.monitored _ tb[node].son[4] # Tree.Null;
    lockLambda _ Lambda[tb[node].son[4], lL];
    DeclList[tb[node].son[5], SENull];
    BodyList[dataPtr.bodyRoot];
    dataPtr.defBodyLimit _ Table.Bounds[bodyType].size;
    dataPtr.textIndex _ saveIndex;
    END;

  IdDefinition: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex _ tb[node].info;
    tb[node].son[1] _ Ids[
			list: tb[node].son[1],
			public: FALSE,
			link: node];
    dataPtr.textIndex _ saveIndex;
    END;


 -- monitor lock processing

  Lambda: PROCEDURE [item: Tree.Link, level: ContextLevel] RETURNS [node: Tree.Index] =
    BEGIN
    saved: ContextInfo = current;
    node _ GetNode[item];
    IF node # Tree.NullIndex
      THEN
	BEGIN
	NewContext[level, CountIds[tb[node].son[1]], FALSE];
	tb[node].info _ current.ctx;
	DeclList[tb[node].son[1], SENull];
	IF tb[node].son[2] # Tree.Null THEN Exp[tb[node].son[2]];
	END;
    current _ saved;  RETURN
    END;

  ImplicitLock: PROCEDURE [sei: ISEIndex] =
    BEGIN
    WITH tb[lockLambda].son[2] SELECT FROM
      hash =>  FillCtxSe[sei, index, tb[lockLambda].attr2];
      ENDCASE => ERROR;
     BEGIN  OPEN seb[sei];
     public _ tb[lockLambda].attr2;
     extended _ immutable _ constant _ linkSpace _ FALSE;
     idType _ dataPtr.idLOCK;
     idInfo _ 1;  idValue _ Tree.NullIndex;
     mark3 _ TRUE;  mark4 _ FALSE;
     END;
    tb[lockLambda].son[2] _ [symbol[index: sei]];
    END;


 -- type map processing

  AllocateTypeMap: PROCEDURE [sei: ISEIndex] =
    BEGIN
    mapType, subType: CSEIndex;
    FillCtxSe[sei, HTNull, FALSE];
    subType _ MakeNonCtxSe[SIZE[subrange cons SERecord]];
    seb[subType].typeInfo _ subrange[
		filled: FALSE, empty: FALSE, flexible: FALSE,
		rangeType: dataPtr.idINTEGER,
		origin: , range: ];
    seb[subType].mark3 _ TRUE;
    mapType _ MakeNonCtxSe[SIZE[array cons SERecord]];
    seb[mapType].typeInfo _ array[
		oldPacked: FALSE, lengthUsed: TRUE, comparable: TRUE,
		indexType: subType,
		componentType: typeANY];
    seb[mapType].mark3 _ TRUE;
     BEGIN  OPEN seb[sei];
     public _ extended _ constant _ linkSpace _ FALSE;  immutable _ TRUE; 
     idType _ mapType;
     idInfo _ 1;  idValue _ Tree.NullIndex;
     mark3 _ TRUE;  mark4 _ FALSE;
     END;
    END;


 -- body processing

  btLink: BodyLink;

  AllocateBody: PROCEDURE [node: Tree.Index] RETURNS [bti: CBTIndex] =
    BEGIN	-- queue body for later processing
    -- force nesting message here
      SELECT NextLevel[current.staticLevel] FROM
	lG, lL =>
	  BEGIN
	  bti _ Table.Allocate[bodyType, SIZE[Outer Callable BodyRecord]];
	  bb[bti] _ BodyRecord[,,,,, Callable[,,,,,,,,,, Outer[]]];
	  END;
	ENDCASE =>
	  BEGIN
	  bti _ Table.Allocate[bodyType, SIZE[Inner Callable BodyRecord]];
	  bb[bti] _ BodyRecord[,,,,,Callable[,,,,,,,,,,Inner[frameOffset: ]]];
	  END;
    bb[bti].firstSon _ BTNull;
    bb[bti].info _ BodyInfo[Internal[
	bodyTree: node,
	sourceIndex: dataPtr.textIndex,
	thread: Tree.NullIndex,
	frameSize: ]];
    bb[bti].id _ IF tb[node].attr1 THEN FirstId[tb[node].son[1]]
				   ELSE ISENull;
    bb[bti].ioType _ typeANY;
    LinkBody[bti];  RETURN
    END;

  LinkBody: PROCEDURE [bti: BTIndex] =
    BEGIN
    IF btLink.which = parent
      THEN
	BEGIN
	bb[bti].link _ btLink;
	IF btLink.index = BTNull THEN dataPtr.bodyRoot _ bti
				 ELSE bb[btLink.index].firstSon _ bti;
	END
      ELSE
	BEGIN
	bb[bti].link _ bb[btLink.index].link;
	bb[btLink.index].link _ [which:sibling, index: bti];
	END;
    btLink _ [which:sibling, index: bti];
    END;


  BodyList: PROCEDURE [firstBti: BTIndex] =
    BEGIN
    bti: BTIndex;
    IF (bti _ firstBti) # BTNull
      THEN
	DO
	WITH bb[bti] SELECT FROM
	  Callable =>  Body[LOOPHOLE[bti, CBTIndex]];
	  ENDCASE => NULL;
	IF bb[bti].link.which = parent THEN EXIT;
	bti _ bb[bti].link.index;
	ENDLOOP;
    END;

  Body: PROCEDURE [bti: CBTIndex] =
    BEGIN
    node: Tree.Index;
    bodyLevel: ContextLevel;
    nLocks, nMaps: [0..1];
    oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
    oldBtLink: BodyLink = btLink;
    saved: ContextInfo = current;
    dataPtr.bodyIndex _ bti;
    btLink _ [which:parent, index:bti];
    node _ WITH bb[bti].info SELECT FROM
      Internal =>  GetNode[tb[LOOPHOLE[bodyTree,Tree.Index]].son[3]],
      ENDCASE =>   ERROR;
    bodyLevel _ NextLevel[saved.staticLevel !StaticNestError => RESUME];
    nLocks _ IF dataPtr.monitored AND
	bodyLevel = lG AND tb[lockLambda].attr1 THEN 1 ELSE 0;
    nMaps _ IF bodyLevel = lG AND dataPtr.nTypeCodes # 0 THEN 1 ELSE 0;
    NewContext[
	level: bodyLevel,
	entries: nLocks + CountIds[tb[node].son[2]] + nMaps,
	unique: bodyLevel = lG];
    bb[bti].localCtx _ current.ctx;  bb[bti].level _ bodyLevel;
    bb[bti].monitored _ nLocks # 0;
    bb[bti].inline _ tb[node].attr3;
    IF bodyLevel = lG
      THEN
	BEGIN
	dataPtr.mainCtx _ current.ctx;  dataPtr.mainBody _ bti;
	dataPtr.typeMapId _ ISENull;
	END;
    ScanList[tb[node].son[1], Exp];
    IF nLocks # 0
      THEN
	BEGIN
	ImplicitLock[current.seChain];
	current.seChain _ NextSe[current.seChain]
	END;
    DeclList[tb[node].son[2], SENull];
    IF nMaps # 0
      THEN
	BEGIN
	dataPtr.typeMapId _ current.seChain;
	current.seChain _ NextSe[current.seChain];
	AllocateTypeMap[dataPtr.typeMapId];
	END;
    ScanList[tb[node].son[3], Stmt];
    BodyList[bb[bti].firstSon];
    current _ saved;  dataPtr.bodyIndex _ oldBodyIndex;  btLink _ oldBtLink;
    END;


  Inline: Tree.Scan = BEGIN ScanList[t, Exp] END;


 -- declarations

  DeclList: PROCEDURE [t: Tree.Link, linkId: SEIndex] =
    BEGIN

    DeclItem: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      subNode: Tree.Index;
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex _ tb[node].info;
      tb[node].son[1] _ Ids[
		list: tb[node].son[1],
		public: tb[node].attr2,
		readOnly: tb[node].attr3,
		link: node];
      tb[node].attr2 _ tb[node].attr3 _ FALSE;
      IF tb[node].name = typedecl
	THEN
	  BEGIN
	  TypeExp[tb[node].son[2], FirstId[tb[node].son[1]], linkId];
	  ScanList[tb[node].son[3], Exp];
	  END
	ELSE
	  BEGIN
	  TypeExp[tb[node].son[2], SENull, linkId];
	  IF tb[node].son[3] # Tree.Null AND tb[node].son[3].tag = subtree
	    THEN
	      BEGIN
	      subNode _ GetNode[tb[node].son[3]];
	      SELECT tb[subNode].name FROM
		entry, internal =>
		  BEGIN
		  IF ~dataPtr.monitored OR ~TestTree[tb[subNode].son[1], body]
		    THEN Log.Error[misplacedEntry]
		    ELSE
		      WITH tb[subNode].son[1] SELECT FROM
			subtree =>
			  SELECT tb[subNode].name FROM
			    entry =>  tb[index].attr1 _ TRUE;
			    internal =>  tb[index].attr2 _ TRUE;
			    ENDCASE;
			ENDCASE;
		  tb[node].son[3] _ tb[subNode].son[1];
		  tb[subNode].son[1] _ Tree.Null;  FreeNode[subNode];
		  END;
		ENDCASE;
	      END;
	  IF tb[node].son[3] # Tree.Null
	    THEN
	      WITH tb[node].son[3] SELECT FROM
		subtree =>
		  BEGIN  subNode _ index;
		  SELECT tb[subNode].name FROM
		    body =>
		      BEGIN
		      tb[subNode].info _ AllocateBody[node];
		      IF ~tb[subNode].attr3
			THEN  dataPtr.nBodies _ dataPtr.nBodies+1;
		      END;
		    signalinit =>
		      BEGIN
		      tb[subNode].info _ dataPtr.nSigCodes;
		      dataPtr.nSigCodes _ dataPtr.nSigCodes+1;
		      END;
		    inline => ScanList[tb[subNode].son[1], Inline];
		    ENDCASE => ScanList[tb[node].son[3], Exp];
		  END;
		ENDCASE =>  ScanList[tb[node].son[3], Exp];
	  END;
      dataPtr.textIndex _ saveIndex;
      END;

    ScanList[root:t, action:DeclItem];
    END;



  CountIds: PROCEDURE [declList: Tree.Link] RETURNS [n: CARDINAL] =
    BEGIN

    nIds: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      n _ n + ListLength[tb[node].son[1]];
      END;

    n _ 0;  ScanList[declList, nIds];  RETURN
    END;


 -- id list manipulation

  Ids: PROCEDURE [
	list: Tree.Link,
	public: BOOLEAN,
	readOnly: BOOLEAN _ FALSE,
	link: Tree.Index]
      RETURNS [Tree.Link] =
    BEGIN

    Id: Tree.Map =
      BEGIN
      hti: HTIndex;
      sei: ISEIndex;
      ctx: CTXIndex = current.ctx;
      hti _ WITH t SELECT FROM
	hash => index,
	symbol => seb[index].hash,
	ENDCASE =>  ERROR;
      sei _ current.seChain;  current.seChain _ NextSe[current.seChain];
      FillCtxSe[sei, hti, public];
      v _ Tree.Link[symbol[index: sei]];
      seb[sei].idType _ typeANY;
      seb[sei].public _ public;  seb[sei].immutable _ readOnly;
      seb[sei].idValue _ link;  seb[sei].idInfo _ 0;
      seb[sei].extended _ seb[sei].linkSpace _ FALSE;
      RETURN
      END;

    RETURN [UpdateList[root:list, map:Id]]
    END;


  FirstId: PROCEDURE [t: Tree.Link] RETURNS [ISEIndex] =
    BEGIN
    head: Tree.Link = ListHead[t];
    RETURN [WITH head SELECT FROM  symbol => index,  ENDCASE => ERROR];
    END;


 -- type manipulation

  TypeExp: PROCEDURE [t: Tree.Link, typeId, linkId: SEIndex]  =
    BEGIN
    node: Tree.Index;
    sei: CSEIndex;
    tCtx: CTXIndex;
    nFields: CARDINAL;
    WITH t SELECT FROM
      subtree =>
	BEGIN  node _ index;
	SELECT tb[node].name FROM
	  enumeratedTC =>
	    BEGIN
	    sei _ MakeNonCtxSe[SIZE[enumerated cons SERecord]];
	    tCtx _ Enumeration[node];
	    seb[sei].typeInfo _ enumerated[
		ordered: TRUE,
		valueCtx: tCtx,
		nValues: ];
	    AssignValues[sei, IF typeId # SENull THEN typeId ELSE sei];
	    END;
	  recordTC, monitoredTC =>
	    BEGIN
	    sei _ MakeNonCtxSe[SIZE[notLinked record cons SERecord]];
	    [tCtx, nFields] _ FieldList[
		t: tb[node].son[1],
		level: lZ,
		typeId: IF typeId # SENull THEN typeId ELSE sei];
	    seb[sei].typeInfo _ record[
		machineDep: tb[node].attr1,
		argument: FALSE,
		hints: [
		  unifield: nFields = 1 AND ~tb[node].attr2,
		  variant: tb[node].attr2,
		  comparable: FALSE, privateFields: FALSE],
		length: ,
		lengthUsed: FALSE,
		fieldCtx: tCtx,
		monitored: tb[node].name = monitoredTC,
		linkPart: notLinked[]];
	    END;
	  variantTC =>
	    BEGIN
	    sei _ MakeNonCtxSe[SIZE[linked record cons SERecord]];
	    tCtx _ FieldList[t:tb[node].son[1], level:lZ, typeId:typeId].ctx;
	    seb[sei].typeInfo _ record[
		machineDep: tb[node].attr1,
		argument: FALSE,
		hints: [
		  variant: tb[node].attr2,
		  unifield: FALSE, comparable: FALSE, privateFields: FALSE],
		length: ,
		lengthUsed: FALSE,
		fieldCtx: tCtx,
		monitored: FALSE,
		linkPart: linked[linkId]];
	    END;
	  pointerTC =>
	    BEGIN  sei _ MakeNonCtxSe[SIZE[pointer cons SERecord]];
	    seb[sei].typeInfo _ pointer[
		ordered: tb[node].attr1,
		basing: tb[node].attr2,
		readOnly: tb[node].attr3,
		dereferenced: FALSE,
		refType: ];
	    TypeExp[tb[node].son[1], SENull, SENull];
	    END;
	  arrayTC =>
	    BEGIN  sei _ MakeNonCtxSe[SIZE[array cons SERecord]];
	    seb[sei].typeInfo _ array[
		oldPacked: tb[node].attr1,
		lengthUsed: FALSE,
		comparable: FALSE,
		indexType: ,
		componentType: ];
	    IF tb[node].son[1] # Tree.Null
	      THEN TypeExp[tb[node].son[1], SENull, SENull];
	    TypeExp[tb[node].son[2], SENull, SENull];
	    END;
	  arraydescTC =>
	    BEGIN  sei _ MakeNonCtxSe[SIZE[arraydesc cons SERecord]];
	    seb[sei].typeInfo _ arraydesc[
		readOnly: tb[node].attr3,
		describedType: ];
	    TypeExp[tb[node].son[1], SENull, SENull];
	    END;
	  procTC =>  sei _ Transfer[node, procedure];
	  portTC =>  sei _ Transfer[node, port];
	  signalTC =>  sei _ Transfer[node, signal];
	  errorTC =>  sei _ Transfer[node, error];
	  processTC =>  sei _ Transfer[node, process];
	  programTC =>  sei _ Transfer[node, program];
	  definitionTC => 
	    BEGIN
	    sei _ MakeNonCtxSe[SIZE[definition cons SERecord]];
	    seb[sei].typeInfo _ definition[nGfi: 1, named: FALSE, defCtx: ];
	    END;
	  unionTC =>  sei _ Union[node, linkId];
	  relativeTC =>
	    BEGIN
	    sei _ MakeNonCtxSe[SIZE[relative cons SERecord]];
	    seb[sei].typeInfo _ relative[
		baseType: ,
		offsetType: ,
		resultType: ];
	    TypeExp[tb[node].son[1], SENull, SENull];
	    TypeExp[tb[node].son[2], SENull, SENull];
	    END;
	  subrangeTC =>
	    BEGIN  sei _ MakeNonCtxSe[SIZE[subrange cons SERecord]];
	    seb[sei].typeInfo _ subrange[
		filled: FALSE,
		empty: FALSE,
		flexible: FALSE,
		rangeType: ,
		origin: ,
		range: ];
	    TypeExp[tb[node].son[1], SENull, SENull];
	    Interval[tb[node].son[2]];
	    END;
	  longTC =>
	    BEGIN  sei _ MakeNonCtxSe[SIZE[long cons SERecord]];
	    seb[sei].typeInfo _ long[rangeType: ];
	    TypeExp[tb[node].son[1], SENull, SENull];
	    END;
	  implicitTC, frameTC =>  sei _ CSENull;
	  dot, discrimTC =>
	    BEGIN TypeExp[tb[node].son[1], SENull, SENull]; sei _ CSENull END;
	  ENDCASE =>
	    BEGIN  sei _ CSENull;  Log.Error[nonTypeCons]  END;
	tb[node].info _ sei;
	END;
      ENDCASE => NULL;
    END;

  Enumeration: PROCEDURE [node: Tree.Index] RETURNS [ctx: CTXIndex] =
    BEGIN
    saved: ContextInfo = current;
    NewContext[lZ, ListLength[tb[node].son[1]], TRUE];  ctx _ current.ctx;
    tb[node].son[1] _ Ids[
	list: tb[node].son[1],
	public: tb[node].attr1,
	link: Tree.NullIndex];
    current _ saved;  RETURN
    END;

  AssignValues: PROCEDURE [type: CSEIndex, valueType: SEIndex] =
    BEGIN
    i: CARDINAL;
    sei: ISEIndex;
    WITH seb[type] SELECT FROM
      enumerated =>
	BEGIN  i _ 0;
	FOR sei _ ctxb[valueCtx].seList, NextSe[sei] UNTIL sei = SENull
	  DO  OPEN seb[sei];
	  idType _ valueType;  idInfo _ 0;
	  idValue _ i;  i _ i+1;
	  immutable _ constant _ mark3 _ mark4 _ TRUE;
	  ENDLOOP;
	nValues _ i;
	END;
      ENDCASE =>  ERROR;
    END;


  FieldList: PROCEDURE [t: Tree.Link, level: ContextLevel, typeId: SEIndex] 
      RETURNS [ctx: CTXIndex, nFields: CARDINAL] =
    BEGIN
    saved: ContextInfo = current;
    nFields _ CountIds[t];
    NewContext[level, nFields, TRUE];  ctx _ current.ctx; 
    DeclList[t, typeId];
    current _ saved;  RETURN
    END;

  Transfer: PROCEDURE [node: Tree.Index, mode: TransferMode] RETURNS [sei: CSEIndex] =
    BEGIN
    sei _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
    seb[sei].typeInfo _ transfer[
	mode: mode,
	inRecord:  ArgList[tb[node].son[1]],
	outRecord: ArgList[tb[node].son[2]]];
    RETURN
    END;

  ArgList: PROCEDURE [t: Tree.Link] RETURNS [type: RecordSEIndex] =
    BEGIN
    tCtx: CTXIndex;
    nFields: CARDINAL;
    IF t = Tree.Null
      THEN type _ RecordSENull
      ELSE
	BEGIN 
	type _ LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]];
	[tCtx, nFields] _ FieldList[t, lZ, type];
	seb[type].typeInfo _ record[
		machineDep: FALSE,
		argument: TRUE,
		hints: [
		  unifield: nFields = 1,
		  variant: FALSE, comparable: FALSE, privateFields: FALSE],
		length: ,
		lengthUsed: FALSE,
		fieldCtx: tCtx,
		monitored: FALSE,
		linkPart: notLinked[]];
	END;
    RETURN
    END;


  Union: PROCEDURE [node: Tree.Index, linkId: SEIndex] RETURNS [sei: CSEIndex] =
    BEGIN
    tagId: ISEIndex;
    subnode: Tree.Index;
    saved: ContextInfo = current;
    current.ctx _ CTXNull;  current.seChain _ MakeSeChain[CTXNull, 1, FALSE];
    DeclList[tb[node].son[1], SENull];
    subnode _ GetNode[tb[node].son[1]];
    tagId _ FirstId[tb[subnode].son[1]];
    WITH tb[subnode].son[2] SELECT FROM
      subtree =>
	IF tb[index].name = implicitTC
	  THEN tb[index].info _ MakeTagType[tb[node].son[2]];
      ENDCASE =>  NULL;
    NewContext[lZ, CountIds[tb[node].son[2]], TRUE];
    DeclList[tb[node].son[2], linkId
      !NameClash =>
	BEGIN  Log.ErrorHti[duplicateTag, hti];  RESUME  END];
    sei _ MakeNonCtxSe[SIZE[union cons SERecord]];
    seb[sei].typeInfo _ union[
		caseCtx: current.ctx,
		overlayed: tb[node].attr1,
		controlled: seb[tagId].hash # HTNull,
		tagSei: tagId,
		equalLengths: FALSE];
    current _ saved;  RETURN
    END;


  MakeTagType: PROCEDURE [t: Tree.Link] RETURNS [type: CSEIndex] =
    BEGIN
    saved: ContextInfo = current;

    CollectTags: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      tb[node].son[1] _ Ids[
		list: tb[node].son[1],
		public: tb[node].attr2,
		link: Tree.NullIndex
	    !NameClash => RESUME];
      END;

    NewContext[lZ, CountIds[t], TRUE];
    type _ MakeNonCtxSe[SIZE[enumerated cons SERecord]];
    seb[type].typeInfo _ enumerated[
	ordered: FALSE,
	valueCtx: current.ctx,
	nValues: ];
    ScanList[t, CollectTags];
    AssignValues[type, type];
    current _ saved;  RETURN
    END;


 -- statements

  Stmt: PROCEDURE [stmt: Tree.Link] =
    BEGIN
    node, subNode: Tree.Index;
    saveIndex: CARDINAL = dataPtr.textIndex;
    IF stmt = Tree.Null THEN RETURN;
    WITH stmt SELECT FROM
      subtree =>
	BEGIN  node _ index;
	dataPtr.textIndex _ tb[node].info;
	SELECT tb[node].name FROM
	  assign =>  BEGIN  Exp[tb[node].son[1]];  Exp[tb[node].son[2]]  END;
	  extract =>
	    BEGIN  ScanList[tb[node].son[1], Exp];  Exp[tb[node].son[2]]  END;
	  apply =>
	    BEGIN
	    Exp[tb[node].son[1]];  ScanList[tb[node].son[2], Exp];
	    IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]];
	    END;
	  block =>  Block[node];
	  if =>
	    BEGIN  OPEN tb[node];
	    Exp[son[1]];  ScanList[son[2], Stmt];  ScanList[son[3], Stmt];
	    END;
	  case =>
	    BEGIN  OPEN tb[node];
	    Exp[son[1]];  SelectionList[son[2], Stmt];  Stmt[son[3]];
	    END;
	  bind =>
	    BEGIN  OPEN tb[node];
	    Exp[son[1]];
	    IF son[2] # Tree.Null THEN Exp[son[2]];
	    SelectionList[son[3], Stmt];
	    Stmt[son[4]];
	    END;
	  do =>
	    BEGIN  OPEN tb[node];
	    IF son[1] # Tree.Null
	      THEN
		BEGIN  subNode _ GetNode[son[1]];
		IF tb[subNode].son[1] # Tree.Null
		  THEN Exp[tb[subNode].son[1]];
		SELECT tb[subNode].name FROM
		  forseq =>
		    BEGIN
		    Exp[tb[subNode].son[2]];  Exp[tb[subNode].son[3]];
		    END;
		  upthru, downthru =>  Range[tb[subNode].son[2]];
		  ENDCASE => ERROR;
		END;
	    IF son[2] # Tree.Null THEN Exp[son[2]];
	    ScanList[son[3], Exp];
	    ScanList[son[4], Stmt];
	    ScanList[son[5], Stmt]; ScanList[son[6], Stmt];
	    END;
	  return, resume =>  ScanList[tb[node].son[1], Exp];
	  label =>
	    BEGIN
	    ScanList[tb[node].son[1], Stmt];  ScanList[tb[node].son[2], Stmt];
	    END;
	  goto, exit, loop, continue, retry, syserror, null =>  NULL;
	  signal, error, xerror, start, restart,
	  join, wait, notify, broadcast, dst, lst, lstf =>
	    Exp[tb[node].son[1]];
	  stop =>
	    IF tb[node].son[1] # Tree.Null THEN CatchPhrase[tb[node].son[1]];
	  open =>
	    BEGIN
	    ScanList[tb[node].son[1], Exp];  ScanList[tb[node].son[2], Stmt];
	    END;
	  enable =>
	    BEGIN
	    CatchPhrase[tb[node].son[1]];  ScanList[tb[node].son[2], Stmt];
	    END;
          list =>  ScanList[stmt, Stmt];
          item =>  Stmt[tb[node].son[2]];
          ENDCASE =>  Log.Error[unimplemented];
	END;
      ENDCASE =>  NULL;
    dataPtr.textIndex _ saveIndex;
    END;


  Block: PROCEDURE [node: Tree.Index] =
    BEGIN
    bti: BTIndex;
    oldBtLink: BodyLink;
    saved: ContextInfo = current;
    NewContext[
	level: saved.staticLevel,
	entries: CountIds[tb[node].son[1]],
	unique: FALSE];
    bti _ Table.Allocate[bodyType, SIZE[Other BodyRecord]];
    bb[bti] _ BodyRecord[
	link: ,
	firstSon: BTNull,
	localCtx: current.ctx,
	level: current.staticLevel,
	info: BodyInfo[Internal[
	  bodyTree: node,
	  sourceIndex: tb[node].info,
	  thread: Tree.NullIndex,
	  frameSize: ]],
	extension: Other[]];
    LinkBody[bti];  oldBtLink _ btLink;  btLink _ [which:parent, index:bti];
    tb[node].info _ bti;
    DeclList[tb[node].son[1], SENull];
    ScanList[tb[node].son[2], Stmt];
    BodyList[bb[bti].firstSon];
    current _ saved;  btLink _ oldBtLink;
    END;


  SelectionList: PROCEDURE [t: Tree.Link, selection: Tree.Scan] =
    BEGIN

    Item: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex _ tb[node].info;
      ScanList[tb[node].son[1], Exp];  selection[tb[node].son[2]];
      dataPtr.textIndex _ saveIndex;
      END;

    ScanList[t, Item];
    END;


  CatchPhrase: PROCEDURE [t: Tree.Link] =
    BEGIN
    node: Tree.Index = GetNode[t];
    saved: ContextInfo = current;
    NewContext[
	level: NextLevel[saved.staticLevel],
	entries: 0,
	unique: FALSE];
    SelectionList[tb[node].son[1], Stmt];
    IF tb[node].nSons > 1 THEN ScanList[tb[node].son[2], Stmt];
    current _ saved;
    END;


 -- expressions

  Exp: PROCEDURE [exp: Tree.Link] =
    BEGIN
    node, subNode: Tree.Index;
    IF exp = Tree.Null THEN RETURN;
    WITH exp SELECT FROM
      subtree =>
	BEGIN  node _ index;
	SELECT tb[node].name FROM
	  apply =>
	    BEGIN
	    Exp[tb[node].son[1]];  ScanList[tb[node].son[2], Exp];
	    IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]];
	    END;
	  signalx, errorx, startx, fork, joinx,
	  dot, uparrow,
	  uminus, not, addr, new =>
	    Exp[tb[node].son[1]];
	  plus, minus, times, div, mod,
	  relE, relN, relL, relGE, relG, relLE,
	  or, and, assignx =>
	    BEGIN  Exp[tb[node].son[1]];  Exp[tb[node].son[2]]  END;
	  in, notin =>
	    BEGIN  Exp[tb[node].son[1]];  Range[tb[node].son[2]]  END;
	  ifx =>
	    BEGIN
	    Exp[tb[node].son[1]]; Exp[tb[node].son[2]]; Exp[tb[node].son[3]];
	    END;
	  casex =>
	    BEGIN  OPEN tb[node];
	    Exp[son[1]];  SelectionList[son[2], Exp];  Exp[son[3]];
	    END;
	  bindx =>
	    BEGIN  OPEN tb[node];
	    Exp[son[1]];
	    IF son[2] # Tree.Null THEN Exp[son[2]];
	    SelectionList[son[3], Exp];
	    Exp[son[4]];
	    END;
	  lengthen, float, abs, min, max, base, length, all =>
	    ScanList[tb[node].son[1], Exp];
	  arraydesc =>
	    SELECT ListLength[tb[node].son[1]] FROM
	      1 => Exp[tb[node].son[1]];
	      3 =>
		BEGIN
		subNode _ GetNode[tb[node].son[1]];
		Exp[tb[subNode].son[1]];  Exp[tb[subNode].son[2]];
		IF tb[subNode].son[3] # Tree.Null
		  THEN TypeExp[tb[subNode].son[3], SENull, SENull];
		END;
	      ENDCASE => ERROR;
	  void, clit, llit, mwconst, syserrorx =>  NULL;
	  loophole =>
	    BEGIN
	    Exp[tb[node].son[1]];
	    IF tb[node].son[2] # Tree.Null
	      THEN TypeExp[tb[node].son[2], SENull, SENull];
	    END;
	  size, first, last, typecode =>
	    TypeExp[tb[node].son[1], SENull, SENull];
	  item =>  Exp[tb[node].son[2]];
	  ENDCASE =>  Log.Error[unimplemented];
	END;
      ENDCASE => NULL;
    END;

  Interval: PROCEDURE [t: Tree.Link] =
    BEGIN
    node: Tree.Index = GetNode[t];
    Exp[tb[node].son[1]];  Exp[tb[node].son[2]];
    END;

  Range: PROCEDURE [t: Tree.Link] =
    BEGIN
    node: Tree.Index;
    WITH t SELECT FROM
      subtree =>
	BEGIN  node _ index;
	SELECT tb[node].name FROM
	  subrangeTC =>
	    BEGIN
	    TypeExp[tb[node].son[1], SENull, SENull];
	    Interval[tb[node].son[2]];
	    END;
	  IN [intOO .. intCC] => Interval[t];
	  ENDCASE => TypeExp[t, SENull, SENull];
	END;
      ENDCASE => TypeExp[t, SENull, SENull];
    END;

END.