-- file Pass3S.Mesa
-- last modified by Satterthwaite, October 31, 1979  1:54 PM

DIRECTORY
  ComData: FROM "comdata"
    USING [
      bodyIndex, mainBody, monitored, nTypeCodes, stopping, textIndex,
      typeBOOLEAN, typeMap],
  Copier: FROM "copier" USING [CopyXferType],
  InlineDefs: FROM "inlinedefs" USING [BITAND],
  Log: FROM "log" USING [Error, ErrorTree, Warning, WarningTree],
  Pass3: FROM "pass3"
    USING [
      continued, currentBody, implicitAttr, implicitTree, implicitType,
      enclosingBody, lockHeld, lockNode, markCatch],
  P3: FROM "p3"
    USING [
      Attr, BodyData, NPUse, BoundNP, SequenceNP,
      phraseNP,
      --And,-- Apply, Assignment, BumpCount, CanonicalType, CheckDisjoint,
      CloseBase, ClearRefStack, CopyLock, DeclList, Discrimination, Exp,
      Extract, FindLockParams, IdentifiedType, LockVar, MatchFields,
      MiscStmt, OpenBase, OperandLhs, OrderedType, PopCtx, PushCtx,
      Range, RAttr, RecordMention, Rhs, RPop, RPush, RType,
      SealRefStack, TargetType, TypeForTree, UnsealRefStack, UpdateTreeAttr,
      InsertCatchLabel],
  Symbols: FROM "symbols"
    USING [seType, ctxType, mdType, bodyType,
      ContextLevel, 
      SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex,
      HTNull, SENull, CSENull, RecordSENull, CTXNull, BTNull,
      lG, typeANY],
  SymbolOps: FROM "symbolops"
    USING [FirstCtxSe, NextSe, TransferTypes, UnderType],
  SystemDefs: FROM "systemdefs" USING [AllocateHeapNode],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [treeType, Index, Link, Map, Null, Scan, NullId],
  TreeOps: FROM "treeops"
    USING [
      FreeNode, GetNode, MakeList, PopTree, PushTree, PushNode,
      ReverseScanList, ScanList, SetAttr, SetInfo, UpdateList];

Pass3S: PROGRAM
    IMPORTS
	InlineDefs, Copier, Log, P3, SymbolOps, SystemDefs, TreeOps,
	dataPtr: ComData, passPtr: Pass3
    EXPORTS P3 =
  BEGIN
  OPEN SymbolOps, Symbols, P3, TreeOps;

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

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

  StmtNotify: 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];
    bb _ base[bodyType];
    END;


 -- parameter usage

  pathNP: PUBLIC NPUse;

 -- bodies and blocks

  current: POINTER TO P3.BodyData = @passPtr.currentBody;
  currentArgCtx: PUBLIC CTXIndex;

  exits: BOOLEAN;

  BodyList: PUBLIC 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
    item: Tree.Index;	-- item designates a declitem with body as last son
    saved: P3.BodyData = current^;
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveBodyIndex: CBTIndex = dataPtr.bodyIndex;
    saveEnclosing: BTIndex = passPtr.enclosingBody;
    saveLockHeld: BOOLEAN = passPtr.lockHeld;
    node: Tree.Index;
    lockVar: ISEIndex;
    lockBit: BOOLEAN;
    bodyType: SEIndex;
    inRecord, outRecord: RecordSEIndex;
    dataPtr.bodyIndex _ passPtr.enclosingBody _ bti;
    WITH bb[bti].info SELECT FROM
      Internal =>
	BEGIN
	dataPtr.textIndex _ sourceIndex;
	item _ bodyTree;
	current.bodyNode _ node _ GetNode[tb[item].son[3]];
	bodyTree _ node;
	END;
      ENDCASE => ERROR;
    current.level _ bb[bti].level;
    current.entry _ bb[bti].entry _ tb[node].attr1;
    bb[bti].internal _ tb[node].attr2;
    bb[bti].resident _ FALSE;
    passPtr.lockHeld _ bb[bti].entry OR bb[bti].internal;
    bodyType _ TypeForTree[tb[item].son[2]];
    bb[bti].ioType _ SELECT seb[bodyType].seTag FROM
	cons => LOOPHOLE[bodyType, CSEIndex],
	ENDCASE => Copier.CopyXferType[UnderType[bodyType]];
    [inRecord, outRecord] _ TransferTypes[bb[bti].ioType];
    IF inRecord = SENull
      THEN  currentArgCtx _ CTXNull
      ELSE  ctxb[currentArgCtx_seb[inRecord].fieldCtx].level _ bb[bti].level;
    IF outRecord # SENull
      THEN ctxb[seb[outRecord].fieldCtx].level _ bb[bti].level;
    IF current.level = lG AND dataPtr.nTypeCodes # 0
      THEN
	BEGIN
	dataPtr.typeMap _ DESCRIPTOR [
		SystemDefs.AllocateHeapNode[dataPtr.nTypeCodes*SIZE[SEIndex]],
		dataPtr.nTypeCodes];
	dataPtr.nTypeCodes _ 0;
	END;
    PushArgCtx[current.inputRecord _ inRecord];
    BumpArgRefs[current.inputRecord, TRUE];
    PushArgCtx[current.returnRecord _ outRecord];
    ClearRefStack[];
    -- initialize computed attributes
      current.labelList _ Tree.Null;  current.loopDepth _ 0;
      current.catchDepth _ 0;  current.unwindEnabled _ FALSE;
      current.resumeRecord _ RecordSENull;  current.resumeFlag _ FALSE;
    IF ~current.entry
      THEN  pathNP _ none
      ELSE
	BEGIN
	IF (lockVar _ FindLockParams[].actual) # SENull
	  THEN
	    BEGIN
	    lockBit _ seb[lockVar].immutable; seb[lockVar].immutable _ TRUE;
	    END;
	tb[node].son[4] _ CopyLock[];  pathNP _ phraseNP;
	END;
      BEGIN
      ENABLE
	InsertCatchLabel => BEGIN Log.Error[catchLabel]; RESUME END;
      ScanList[tb[node].son[1], OpenItem];
      IF inRecord # SENull THEN
	CheckDisjoint[seb[inRecord].fieldCtx, bb[bti].localCtx];
      IF outRecord # SENull THEN
	CheckDisjoint[seb[outRecord].fieldCtx, bb[bti].localCtx];
      PushCtx[bb[bti].localCtx];
      IF bti = dataPtr.mainBody AND dataPtr.monitored
	THEN
	  BEGIN
	  DeclList[tb[passPtr.lockNode].son[1]];
	  PushCtx[tb[passPtr.lockNode].info];
	  IF (lockVar _ FirstCtxSe[tb[passPtr.lockNode].info]) # SENull
	    THEN  BumpCount[lockVar];
	  tb[passPtr.lockNode].son[2] _ LockVar[tb[passPtr.lockNode].son[2]];
	  PopCtx[];  ClearRefStack[];
	  END;
      DeclList[tb[node].son[2]];
      END;
    current.reachable _ TRUE;
    tb[node].son[3] _ UpdateList[tb[node].son[3], Stmt
	! InsertCatchLabel =>
	  BEGIN IF ~catchSeen THEN Log.Error[catchLabel]; RESUME END];
    IF current.reachable
      THEN tb[node].son[3] _ ImpliedReturn[tb[node].son[3]];
    BodyList[bb[bti].firstSon];
    PopCtx[];
    ReverseScanList[tb[node].son[1], CloseItem];
    bb[bti].stopping _ dataPtr.stopping AND bb[bti].level = lG;
    bb[bti].hints _ [	-- temporary
	safe: FALSE,
	argUpdated:
	  inRecord # SENull AND ctxb[seb[inRecord].fieldCtx].varUpdated,
	nameSafe: pathNP # unsafe,
	attr4: FALSE, attr5: FALSE];
    PopArgCtx[outRecord];  PopArgCtx[inRecord];
    IF current.entry AND lockVar # SENull
      THEN seb[lockVar].immutable _ lockBit;
    current^ _ saved;  passPtr.lockHeld _ saveLockHeld;
    passPtr.enclosingBody _ saveEnclosing;
    dataPtr.bodyIndex _ saveBodyIndex;  dataPtr.textIndex _ saveIndex;
    END;

  Block: PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    bti: BTIndex = info;
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveEnclosing: BTIndex = passPtr.enclosingBody;
    WITH bb[bti].info SELECT FROM
      Internal => dataPtr.textIndex _ sourceIndex;
      ENDCASE => ERROR;
    passPtr.enclosingBody _ bti;
    PushCtx[bb[bti].localCtx];
    DeclList[son[1]
      ! InsertCatchLabel => BEGIN  Log.Error[catchLabel];  RESUME  END];
    son[2] _ UpdateList[son[2], Stmt];
    BodyList[bb[bti].firstSon];
    PopCtx[];
    passPtr.enclosingBody _ saveEnclosing;  dataPtr.textIndex _ saveIndex;
    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;

 -- statements

  Stmt: PUBLIC PROCEDURE [stmt: Tree.Link] RETURNS [val: Tree.Link] =
    BEGIN
    node: Tree.Index;
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveMark: BOOLEAN = passPtr.markCatch;
    saveContinued: BOOLEAN = passPtr.continued;
    IF stmt = Tree.Null THEN RETURN [Tree.Null];
    WITH stmt SELECT FROM
      subtree =>
	BEGIN  node _ index;
	dataPtr.textIndex _ tb[node].info;
	IF ~current.reachable AND tb[node].name # list
	  THEN BEGIN Log.Warning[unreachable]; current.reachable _ TRUE END;
	val _ stmt;		-- the default
	passPtr.markCatch _ passPtr.continued _ FALSE;
	SELECT tb[node].name FROM

	  assign =>
	    BEGIN
	    Assignment[node];  RPop[];  pathNP _ SequenceNP[pathNP][phraseNP];
	    END;

	  extract =>
	    BEGIN Extract[node]; pathNP _ SequenceNP[pathNP][phraseNP] END;

	  apply =>
	    BEGIN
	    Apply[node, typeANY, TRUE];
	    SELECT tb[node].name FROM
	      wait =>  Log.ErrorTree[typeClash, tb[node].son[1]];
	      error =>  current.reachable _ FALSE;
	      ENDCASE;
	    SELECT RType[] FROM
	      CSENull, typeANY =>  NULL;
	      ENDCASE =>  Log.Error[nonVoidStmt];
	    RPop[];   pathNP _ SequenceNP[pathNP][phraseNP];
	    END;

	  block =>  Block[node];

	  if =>
	    BEGIN  OPEN tb[node];
	    saveReachable: BOOLEAN;
	    entryNP, saveNP: NPUse;
	    son[1] _ Rhs[son[1], dataPtr.typeBOOLEAN];  RPop[]; 
	    pathNP _ entryNP _ SequenceNP[pathNP][phraseNP];  ClearRefStack[];
	    son[2] _ UpdateList[son[2], Stmt];
	    saveReachable _ current.reachable;  saveNP _ pathNP;
	    current.reachable _ TRUE;  pathNP _ entryNP;
	    son[3] _ UpdateList[son[3], Stmt];
	    IF saveReachable THEN current.reachable _ TRUE;
	    pathNP _ BoundNP[saveNP][pathNP];
	    END;

	  case =>  SelectStmt[node, Case];
	  bind =>  SelectStmt[node, Discrimination];
	  do =>  DoStmt[node];

	  label =>
	    BEGIN  OPEN tb[node];
	    InsertLabels[son[2]];
	    son[1] _ UpdateList[son[1], Stmt];
	    DeleteLabels[son[2]];
	    LabelList[son[2]];
	    END;

	  goto =>
	    BEGIN
	    ValidateLabel[tb[node].son[1]];  current.reachable _ FALSE;
	    END;

	  return =>  Return[node];

	  exit, loop =>
	    BEGIN
	    IF tb[node].name = exit THEN exits _ TRUE;
	    IF current.loopDepth = 0 THEN Log.Error[exit];
	    current.reachable _ FALSE;
	    END;

	  null =>  NULL;
	  syserror =>  current.reachable _ FALSE;

	  open =>
	    BEGIN  OPEN tb[node];
	    ScanList[son[1], OpenItem];
	    son[2] _ UpdateList[son[2], Stmt];
	    ReverseScanList[son[1], CloseItem];
	    END;

          list =>  val _ UpdateList[val, Stmt];
          ENDCASE =>  val _ MiscStmt[node];

	END;
      ENDCASE =>  ERROR;
    IF passPtr.markCatch
      THEN
	BEGIN  PushTree[val];  PushNode[catchmark,1];
	SetInfo[dataPtr.textIndex];  val _ PopTree[];
	IF passPtr.continued THEN current.reachable _ TRUE;
	pathNP _ unsafe;
	END;
    passPtr.markCatch _ saveMark;  passPtr.continued _ saveContinued;
    ClearRefStack[];
    dataPtr.textIndex _ saveIndex;  RETURN
    END;


 -- case driver

  Case: PUBLIC PROCEDURE [node: Tree.Index, selection: Tree.Map] =
    BEGIN  OPEN tb[node];
    saveType: CSEIndex = passPtr.implicitType;
    saveAttr: Attr = passPtr.implicitAttr;
    saveTree: Tree.Link = passPtr.implicitTree;
    entryNP: NPUse;

    attr: Attr;
    eqTests: BOOLEAN;

    CaseItem: Tree.Scan =
      BEGIN
      switchable: BOOLEAN;
      saveIndex: CARDINAL = dataPtr.textIndex;

      CaseTest: Tree.Map =
	BEGIN
	node: Tree.Index = GetNode[t];
	  BEGIN  OPEN tb[node];
	  SELECT name FROM
	    relE =>
	      BEGIN
	      type: CSEIndex;
	      son[2] _ Rhs[son[2], TargetType[passPtr.implicitType]];
	      type _ RType[];
	      info _ dataPtr.typeBOOLEAN;
	      SELECT seb[type].typeTag FROM
		long =>  BEGIN  attr1 _ FALSE;  attr2 _ TRUE  END;
		real =>  BEGIN  attr1 _ TRUE;  attr2 _ FALSE  END;
		ENDCASE =>  attr1 _ attr2 _ FALSE;
	      switchable _ switchable AND RAttr[].const;  v _ t;
	      END;
	    ENDCASE =>
	      BEGIN
	      v _ Rhs[t, dataPtr.typeBOOLEAN];
	      eqTests _ switchable _ FALSE;
	      END;
	  attr _ And[RAttr[], attr];  RPop[];
	  entryNP _ SequenceNP[entryNP][phraseNP];
	  END;
	RETURN
	END;

      node: Tree.Index = GetNode[t];
      dataPtr.textIndex _ tb[node].info;
	BEGIN  OPEN tb[node];
	switchable _ TRUE;
	son[1] _ UpdateList[son[1], CaseTest];  attr1 _ switchable;
	phraseNP _ entryNP;  son[2] _ selection[son[2]];
	END;
      dataPtr.textIndex _ saveIndex;
      END;

    SealRefStack[];
    son[1] _ Exp[son[1], typeANY];
    passPtr.implicitType _ CanonicalType[RType[]]; 
    passPtr.implicitAttr _ attr _ RAttr[];  RPop[];
    entryNP _ phraseNP;
    IF ~IdentifiedType[passPtr.implicitType]
      THEN Log.ErrorTree[relationType, son[1]];
    passPtr.implicitTree _ son[1];  eqTests _ TRUE;
    UnsealRefStack[];
    ScanList[son[2], CaseItem];  attr1 _ eqTests;
    phraseNP _ entryNP;  son[3] _ selection[son[3]];
    RPush[CSENull, attr];
    passPtr.implicitAttr _ saveAttr;
    passPtr.implicitType _ saveType;  passPtr.implicitTree _ saveTree;
    END;


 -- selection

  SelectStmt: PROCEDURE [node: Tree.Index, driver: PROCEDURE [Tree.Index, Tree.Map]] =
    BEGIN
    newReachable: BOOLEAN;
    newNP: NPUse;
    saveNP: NPUse = pathNP;

    Selection: Tree.Map =
      BEGIN
      current.reachable _ TRUE;  pathNP _ SequenceNP[saveNP][phraseNP];
      v _ Stmt[t];
      IF current.reachable THEN newReachable _ TRUE;
      newNP _ BoundNP[newNP][pathNP];
      END;

    newReachable _ FALSE;  newNP _ none;
    driver[node, Selection];  RPop[];
    current.reachable _ newReachable;  pathNP _ newNP;
    END;



 -- iteration

  DoStmt: PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    forNode: Tree.Index;
    cvType: CSEIndex;
    controlled, cvUpdate, newReachable, saveExits: BOOLEAN;
    saveNP, exitNP: NPUse;
    newReachable _ controlled _ cvUpdate _ FALSE;
    IF son[1] # Tree.Null
      THEN
	BEGIN  forNode _ GetNode[son[1]];
	IF tb[forNode].son[1] = Tree.Null
	  THEN RPush[typeANY, [noXfer:TRUE, noAssign:TRUE, const:FALSE]]
	  ELSE
	    BEGIN
	    tb[forNode].son[1] _ Exp[tb[forNode].son[1], typeANY];
	    IF ~OperandLhs[tb[forNode].son[1]]
	      THEN Log.ErrorTree[nonLHS, tb[forNode].son[1]];
	    WITH tb[forNode].son[1] SELECT FROM
	      symbol =>
		BEGIN	-- account for implicit references
		BumpCount[index];  BumpCount[index];
		END;
	      ENDCASE =>  Log.ErrorTree[controlId, tb[forNode].son[1]];
	    END;
	cvType _ TargetType[RType[]];  RPop[];
	SELECT tb[forNode].name FROM
	  forseq =>
	    BEGIN  -- sequencing using a generator
	    OPEN seq: tb[forNode];
	    seq.son[2] _ Rhs[seq.son[2], cvType];  RPop[];
	    cvUpdate _ TRUE;
	    END;
	  upthru, downthru =>
	    BEGIN  -- stepping through an interval
	    controlled _ TRUE;
	    IF ~OrderedType[cvType] AND cvType # typeANY
	      THEN Log.Error[nonOrderedType];
	    tb[forNode].son[2] _ Range[tb[forNode].son[2], cvType];  RPop[];
	    END;
	  ENDCASE =>  ERROR;
	pathNP _ SequenceNP[pathNP][phraseNP];  ClearRefStack[];
	END;
    saveNP _ pathNP;  pathNP _ none;
    IF son[2] # Tree.Null THEN
      BEGIN
      controlled _ TRUE; son[2] _ Rhs[son[2], dataPtr.typeBOOLEAN]; RPop[];
      pathNP _ SequenceNP[pathNP][phraseNP];  ClearRefStack[];
      END;
    ScanList[son[3], OpenItem];
    InsertLabels[son[5]];
    current.loopDepth _ current.loopDepth + 1;
    saveExits _ exits;  exits _ FALSE;  
    son[4] _ UpdateList[son[4], Stmt];
    IF exits THEN newReachable _ TRUE;  exits _ saveExits;
    DeleteLabels[son[5]];
    current.loopDepth _ current.loopDepth - 1;
    IF cvUpdate THEN
      BEGIN
      tb[forNode].son[3] _ Rhs[tb[forNode].son[3], cvType];  RPop[];
      pathNP _ SequenceNP[pathNP][phraseNP];  ClearRefStack[];
      END;
    IF pathNP = refset THEN pathNP _ unsafe;
    saveNP _ pathNP _ SequenceNP[saveNP][pathNP];
    IF son[5] # Tree.Null THEN
      BEGIN
      current.reachable _ FALSE;
      LabelList[son[5]];  IF current.reachable THEN newReachable _ TRUE;
      END;
    exitNP _ pathNP;
    IF son[6] # Tree.Null
      THEN
	BEGIN
	current.reachable _ controlled;  pathNP _ saveNP;
	son[6] _ UpdateList[son[6], Stmt];
	IF current.reachable THEN newReachable _ TRUE;
	exitNP _ BoundNP[exitNP][pathNP];
	END
      ELSE IF controlled THEN newReachable _ TRUE;
    ReverseScanList[son[3], CloseItem];
    current.reachable _ newReachable;  pathNP _ exitNP;
    END;


 -- labels

  LabelList: PROCEDURE [t: Tree.Link] =
    BEGIN
    newReachable: BOOLEAN;
    saveNP, newNP: NPUse;

    LabelItem: PROCEDURE [item: Tree.Link] =
      BEGIN
      node: Tree.Index = GetNode[item];
      current.reachable _ tb[node].attr1;  pathNP _ saveNP;
      tb[node].son[2] _ UpdateList[tb[node].son[2], Stmt];
      IF current.reachable THEN newReachable _ TRUE;
      newNP _ BoundNP[newNP][pathNP];
      END;

    newReachable _ current.reachable;  saveNP _ pathNP;  newNP _ none;
    ScanList[t, LabelItem];
    current.reachable _ newReachable;  pathNP _ newNP;
    END;


  InsertLabels: PROCEDURE [t: Tree.Link] =
    BEGIN
    labelMark: Tree.Link = current.labelList;

    InsertLabel: PROCEDURE [labeled: Tree.Link] =
      BEGIN
      node: Tree.Index = GetNode[labeled];
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex _ tb[node].info;
      ScanList[tb[node].son[1], StackLabel];
      dataPtr.textIndex _ saveIndex;
      END;

    StackLabel: PROCEDURE [id: Tree.Link] =
      BEGIN
      t: Tree.Link;
      node: Tree.Index;
      FOR t _ current.labelList, tb[node].son[2] UNTIL t = labelMark
	DO
	node _ GetNode[t];
	IF tb[node].son[1] = id AND id # Tree.NullId
	  THEN  Log.ErrorTree[duplicateLabel, id];
	ENDLOOP;
      PushTree[id];  PushTree[current.labelList];
      PushNode[item, 2];  SetAttr[1, FALSE];  current.labelList _ PopTree[];
      END;

    ScanList[t, InsertLabel];
    END;


  ValidateLabel: PROCEDURE [id: Tree.Link] =
    BEGIN
    t: Tree.Link;
    node: Tree.Index;
    FOR t _ current.labelList, tb[node].son[2] UNTIL t = Tree.Null
      DO
      node _ GetNode[t];
      IF tb[node].son[1] = id THEN
	BEGIN  tb[node].attr1 _ TRUE;  RETURN  END;
      ENDLOOP;
    Log.ErrorTree[unknownLabel, id];
    END;


  DeleteLabels: PROCEDURE [t: Tree.Link] =
    BEGIN
    anyReachable: BOOLEAN;

    DeleteLabel: PROCEDURE [labeled: Tree.Link] =
      BEGIN
      node: Tree.Index = GetNode[labeled];
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex _ tb[node].info;  anyReachable _ FALSE;
      ReverseScanList[tb[node].son[1], UnstackLabel];
      tb[node].attr1 _ anyReachable;
      dataPtr.textIndex _ saveIndex;
      END;

    UnstackLabel: PROCEDURE [id: Tree.Link] =
      BEGIN
      node: Tree.Index;
      node _ GetNode[current.labelList];
      IF tb[node].attr1
	THEN  anyReachable _ TRUE
	ELSE  Log.WarningTree[unusedId, tb[node].son[1]];
      current.labelList _ tb[node].son[2];
      tb[node].son[2] _ Tree.Null;  FreeNode[node];
      END;

    ReverseScanList[t, DeleteLabel];
    END;


 -- control transfers

  BumpArgRefs: PUBLIC PROCEDURE [record: RecordSEIndex, write: BOOLEAN] =
    BEGIN
    sei: ISEIndex;
    IF record # SENull THEN
      FOR sei _ FirstCtxSe[seb[record].fieldCtx], NextSe[sei] UNTIL sei = SENull
	DO
	IF write THEN BumpCount[sei] ELSE RecordMention[sei];
	ENDLOOP;
    END;

  CheckLocals: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [localsOnly: BOOLEAN] =
    BEGIN
    level: ContextLevel = bb[dataPtr.bodyIndex].level;

    CheckElement: Tree.Scan =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	literal => NULL;
	symbol =>
	  BEGIN  sei _ index;
	  IF ~seb[sei].constant AND ctxb[seb[sei].idCtx].level # level
	    THEN localsOnly _ FALSE;
	  END;
	ENDCASE => localsOnly _ FALSE;
      END;

    localsOnly _ TRUE;  ScanList[t, CheckElement];  RETURN
    END;


  Return: PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    rSei: RecordSEIndex = current.returnRecord;
    IF current.catchDepth # 0
     OR (dataPtr.bodyIndex = dataPtr.mainBody AND rSei = SENull)
      THEN Log.Error[misplacedReturn];
    IF rSei # SENull AND son[1] = Tree.Null
      THEN
	BEGIN
	BumpArgRefs[rSei, FALSE];
	IF seb[ctxb[seb[rSei].fieldCtx].seList].hash = HTNull
	  THEN Log.Error[illDefinedReturn];
	attr2 _ TRUE;
	END
      ELSE
	BEGIN
	son[1] _ MatchFields[rSei, son[1], FALSE];  RPop[];
	pathNP _ SequenceNP[pathNP][phraseNP];
	IF current.entry THEN  attr2 _ CheckLocals[son[1]];
	END;
    IF (attr1 _ current.entry)
      THEN
	BEGIN
	[] _ UpdateTreeAttr[tb[current.bodyNode].son[4]];
	pathNP _ SequenceNP[pathNP][phraseNP];
	END;
    current.reachable _ FALSE;
    END;

  ImpliedReturn: Tree.Map =
    BEGIN
    IF current.returnRecord # SENull OR current.entry
      THEN
	BEGIN
	PushTree[Tree.Null]; PushNode[return, 1]; SetInfo[dataPtr.textIndex];
	PushTree[Stmt[PopTree[]]];
	PushTree[t];  v _ MakeList[-2];
	END
      ELSE  v _ t;
    RETURN
    END;


 -- basing

  OpenItem: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex _ tb[node].info;
    WITH tb[node].son[1] SELECT FROM
      hash =>
	tb[node].son[2] _ OpenBase[tb[node].son[2], index
	 ! InsertCatchLabel => BEGIN Log.Error[catchLabel]; RESUME END];
      ENDCASE =>  ERROR;
    ClearRefStack[];
    dataPtr.textIndex _ saveIndex;
    END;

  CloseItem: Tree.Scan =
    BEGIN
    node: Tree.Index = GetNode[t];
    WITH tb[node].son[1] SELECT FROM
      hash =>  CloseBase[tb[node].son[2], index];
      ENDCASE =>  ERROR;
    END;

  END.