-- file Pass3S.mesa
-- last modified by Satterthwaite, February 22, 1983 3:22 pm
-- last modified by Donahue, 10-Dec-81 11:28:15

DIRECTORY
  A3: TYPE USING [
    LhsMode, CanonicalType, DefaultInit, IdentifiedType, OperandLhs, TargetType, Voidable],
  Alloc: TYPE USING [Notifier],
  ComData: TYPE USING [bodyIndex, idANY, monitored, ownSymbols, textIndex, typeBOOL],
  Log: TYPE USING [Error, ErrorSei, ErrorTree, Warning, WarningTree],
  Pass3: TYPE USING [checkedANY, lockNode],
  P3: TYPE USING [
    Attr, NPUse, Safety, phraseNP, BoundNP, SequenceNP, voidAttr,
    And, Apply, Assignment, BumpCount, CheckDisjoint, CloseBase,
    ClearRefStack, CopyLock, DeclList, Discrimination, EnterComposite, EnterType,
    Exp, Extract, FieldDefault, FindLockParams, FirstId, LockVar, MatchFields,
    MiscStmt, OpenBase, PopCtx, PushCtx, Range, RAttr, RecordMention, Rhs, RPop,
    RPush, RType, SealRefStack, UnsealRefStack, UpdateTreeAttr, InsertCatchLabel],
  P3S: TYPE USING [BodyData, ImplicitInfo, implicit],
  SymLiteralOps: TYPE USING [DescribeRefLits],
  Symbols: TYPE USING [
    Base, ContextLevel, 
    Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex,
    nullName, nullType, ISENull, CSENull, RecordSENull, CTXNull, BTNull,
    lG, RootBti, typeANY, seType, ctxType, mdType, bodyType],
  SymbolOps: TYPE USING [
    CopyBasicType, FirstCtxSe, NextSe, RCType, TransferTypes, TypeForm, UnderType],
  Tree: TYPE USING [Base, Index, Link, Map, Null, Scan, NullId, NullIndex, treeType],
  TreeOps: TYPE USING [
    FreeNode, GetHash, GetNode, MakeList, OpName, NthSon, PopTree, PushTree, PushNode,
    ReverseScanList, ScanList, SetAttr, SetInfo, UpdateList],
  Types: TYPE USING [Assignable];

Pass3S: PROGRAM
    IMPORTS
      A3, Log, P3, P3S, SymLiteralOps, SymbolOps, TreeOps, Types,
      dataPtr: ComData, passPtr: Pass3
    EXPORTS P3, P3S = {
  OPEN SymbolOps, Symbols, A3, P3, TreeOps;

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

  StmtNotify: 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]};


 -- parameter usage

  pathNP: PUBLIC NPUse;

 -- bodies and blocks

  currentBody: PUBLIC P3S.BodyData;
  current: POINTER TO P3S.BodyData = @currentBody;

  currentScope: PUBLIC BTIndex;
  safety: PUBLIC Safety ← none;
  exits: BOOL;

  BodyList: PUBLIC PROC [firstBti: BTIndex] = {
    bti: BTIndex ← firstBti;
    IF bti # BTNull THEN
      DO
	WITH bb[bti] SELECT FROM
	  Callable => IF nesting # Catch THEN Body[LOOPHOLE[bti, CBTIndex]];
	  ENDCASE => NULL;
	IF bb[bti].link.which = parent THEN EXIT;
	bti ← bb[bti].link.index;
	ENDLOOP};

  Body: PROC [bti: CBTIndex] = {
    saved: P3S.BodyData = current↑;
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveBodyIndex: CBTIndex = dataPtr.bodyIndex;
    saveScope: BTIndex = currentScope;
    saveSafety: Safety = safety;
    node: Tree.Index;
    lockVar: ISEIndex;
    lockBit: BOOL;
    inRecord, outRecord: RecordSEIndex;
    argLevel: ContextLevel;
    dataPtr.bodyIndex ← currentScope ← bti;
    dataPtr.textIndex ← bb[bti].sourceIndex;
    current.bodyNode ← node ← WITH bb[bti].info SELECT FROM
      Internal => bodyTree,
      ENDCASE => ERROR;
    current.level ← bb[bti].level;  current.entry ← bb[bti].entry;
    SetSafety[SafetyAttr[node]];
    bb[bti].resident ← FALSE;
    current.lockHeld ← bb[bti].entry OR bb[bti].internal;
    argLevel ← IF bti = RootBti THEN lG ELSE current.level;
    IF bb[bti].ioType # typeANY THEN seb[bb[bti].ioType].mark4 ← FALSE;
    [inRecord, outRecord] ← TransferTypes[bb[bti].ioType];
    IF inRecord = RecordSENull THEN current.argCtx ← CTXNull
    ELSE {
      current.argCtx ← seb[inRecord].fieldCtx;
      ctxb[current.argCtx].level ← argLevel;
      IF argLevel = lG THEN EnterTypes[current.argCtx]};
    IF outRecord # RecordSENull THEN ctxb[seb[outRecord].fieldCtx].level ← argLevel;
    PushArgCtx[current.inputRecord ← inRecord];  SetArgRefs[inRecord, 1];
    PushArgCtx[current.returnRecord ← outRecord];  SetArgRefs[outRecord, 0];
    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 {
      IF (lockVar ← FindLockParams[].actual) # ISENull THEN {
        lockBit ← seb[lockVar].immutable; seb[lockVar].immutable ← TRUE};
      tb[node].son[4] ← CopyLock[];  pathNP ← phraseNP};

    BEGIN
    ENABLE
      InsertCatchLabel => {Log.Error[catchLabel]; RESUME};
    outInit: Tree.Link ← Tree.Null;
    ScanList[tb[node].son[1], OpenItem];
    current.noXfers ← TRUE;
    IF inRecord # RecordSENull THEN CheckDisjoint[current.argCtx, bb[bti].localCtx];
    IF outRecord # RecordSENull THEN {
      CheckDisjoint[seb[outRecord].fieldCtx, bb[bti].localCtx];
      outInit ← AssignDefaults[seb[outRecord].fieldCtx, bb[bti].inline]};
    PushCtx[bb[bti].localCtx];
    IF bti = RootBti AND dataPtr.monitored THEN {
      PushCtx[tb[passPtr.lockNode].info];
      DeclList[tb[passPtr.lockNode].son[1]];
      IF (lockVar ← FirstCtxSe[tb[passPtr.lockNode].info]) # ISENull THEN BumpCount[lockVar];
      tb[passPtr.lockNode].son[2] ← LockVar[tb[passPtr.lockNode].son[2]];
      PopCtx[];  ClearRefStack[]};
    DeclList[tb[node].son[2]];
    IF outInit # Tree.Null THEN {
      PushTree[outInit];  PushTree[tb[node].son[2]];
      PushNode[initlist, 2];  SetInfo[dataPtr.textIndex];
      tb[node].son[2] ← PopTree[]};
    END;
 
    IF bb[bti].type # RecordSENull THEN {
      IF bti = RootBti THEN SetBodyAttrs[bb[bti].type];
      seb[bb[bti].type].mark3 ← TRUE};
    current.reachable ← TRUE;
    tb[node].son[3] ← UpdateList[tb[node].son[3], Stmt
	! InsertCatchLabel => {IF ~catchSeen THEN Log.Error[catchLabel]; RESUME}];
    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].noXfers ← current.noXfers;
    bb[bti].hints ← [
	safe: pathNP <= ref,
	argUpdated: inRecord # RecordSENull AND ctxb[seb[inRecord].fieldCtx].varUpdated,
	nameSafe: pathNP # unsafe,
	noStrings: ];
    PopArgCtx[outRecord];  PopArgCtx[inRecord];
    IF bti = RootBti AND SymLiteralOps.DescribeRefLits[].length # 0 THEN {
      rSei: RecordSEIndex = bb[bti].type;
      seb[rSei].hints.refField ← TRUE; EnterType[rSei]};
    IF current.entry AND lockVar # ISENull THEN seb[lockVar].immutable ← lockBit;
    current↑ ← saved;  currentScope ← saveScope;
    SetSafety[saveSafety];
    dataPtr.bodyIndex ← saveBodyIndex;  dataPtr.textIndex ← saveIndex};

  Scope: PUBLIC PROC [node: Tree.Index, body: Tree.Map] = {
    bti: BTIndex = tb[node].info;
    saveIndex: CARDINAL = dataPtr.textIndex;
    saveScope: BTIndex = currentScope;
    dataPtr.textIndex ← bb[bti].sourceIndex;
    currentScope ← bti;
    PushCtx[bb[bti].localCtx];
    DeclList[tb[node].son[1] ! InsertCatchLabel => {Log.Error[catchLabel]; RESUME}];
    IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].mark3 ← TRUE;
    tb[node].son[2] ← body[tb[node].son[2]];
    BodyList[bb[bti].firstSon];
    PopCtx[];
    currentScope ← saveScope;  dataPtr.textIndex ← saveIndex};


  PushArgCtx: PROC [rSei: RecordSEIndex] = {
    IF rSei # RecordSENull THEN PushCtx[seb[rSei].fieldCtx]};

  PopArgCtx: PROC [rSei: RecordSEIndex] = {IF rSei # RecordSENull THEN PopCtx[]};

  SetArgRefs: PROC [rSei: RecordSEIndex, nRefs: CARDINAL] = {
    IF rSei # RecordSENull THEN {
      seb[rSei].mark4 ← FALSE;
      FOR sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
	IF seb[sei].mark4 THEN {seb[sei].idValue ← Tree.NullIndex; seb[sei].mark4 ← FALSE};
	seb[sei].idInfo ← nRefs;
	ENDLOOP}};

  EnterTypes: PROC [ctx: CTXIndex] = {
    FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
      IF RCType[seb[sei].idType] = composite THEN
        EnterType[UnderType[seb[sei].idType]];
      ENDLOOP};

  AssignDefault: PROC [sei: ISEIndex] RETURNS [v: Tree.Link] = {
    IF seb[sei].hash = nullName AND ~seb[sei].extended THEN v ← Tree.Null
    ELSE {
      t: Tree.Link =
	IF seb[sei].extended THEN FieldDefault[sei] ELSE DefaultInit[seb[sei].idType];
      IF t = Tree.Null THEN {
	IF ~Voidable[seb[sei].idType] THEN Log.ErrorSei[missingInit, sei];
	v ← Tree.Null}
      ELSE {
	lhs: Tree.Link = [symbol[sei]];
	mode: LhsMode;
	RecordMention[sei];  mode ← OperandLhs[lhs];
	PushTree[lhs];  PushTree[t];  PushNode[assign, 2];
	SetInfo[dataPtr.textIndex];  SetAttr[1, TRUE];
	IF mode # counted THEN SetAttr[2, FALSE]
	ELSE {
	  type: Type = seb[sei].idType;
	  SELECT RCType[type] FROM
	    simple => {SetAttr[2, OpName[t] # nil]; SetAttr[3, FALSE]};
	    composite => {
	      SetAttr[2, TRUE];  SetAttr[3, TRUE]; EnterComposite[type, t, TRUE]};
	    ENDCASE => SetAttr[2, FALSE]};
	v ← PopTree[]};
      RPop[]};
    RETURN};

  AssignDefaults: PROC [ctx: CTXIndex, copyable: BOOL] RETURNS [Tree.Link] = {
    n: INTEGER ← 0;
    FOR sei: ISEIndex ← FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
      IF seb[sei].hash # nullName OR seb[sei].extended THEN {
	t: Tree.Link = AssignDefault[sei];
	IF t # Tree.Null THEN {
	  IF seb[sei].hash = nullName AND copyable THEN Log.ErrorSei[defaultForm, sei];
	  PushTree[t]; n ← n+1; pathNP ← SequenceNP[pathNP][phraseNP]; ClearRefStack[]}};
      ENDLOOP;
    RETURN [MakeList[n]]};

  SetBodyAttrs: PROC [rSei: RecordSEIndex] = {
    FOR sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
      IF ~seb[sei].constant AND RCType[seb[sei].idType] # none THEN {
	seb[rSei].hints.refField ← TRUE; EnterType[rSei]; EXIT}
      ENDLOOP};


  SafetyAttr: PUBLIC PROC [node: Tree.Index] RETURNS [Safety] = {
    RETURN [SELECT TRUE FROM
      tb[node].attr1 => checked,
      tb[node].attr2 => asserted,
      ENDCASE => none]};
      
  SetSafety: PUBLIC PROC [new: Safety] = {
    IF safety # new THEN {
      SELECT new FROM
        checked => {
          IF passPtr.checkedANY = CSENull THEN
	    passPtr.checkedANY ← CopyBasicType[typeANY];
	  seb[dataPtr.idANY].idInfo ← passPtr.checkedANY};
        ENDCASE => seb[dataPtr.idANY].idInfo ← typeANY;
      safety ← new}};
             

 -- statements

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

	  assign => {
	    Assignment[node];  RPop[];  pathNP ← SequenceNP[pathNP][phraseNP]};

	  extract => {
	    Extract[node];  RPop[];  pathNP ← SequenceNP[pathNP][phraseNP]};

	  apply => {
	    node ← Apply[node, typeANY, TRUE];  val ← [subtree[node]];
	    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]};

	  block => {
	    saveSafety: Safety = safety;
	    SetSafety[SafetyAttr[node]];
	    IF saveSafety = checked AND safety = none THEN Log.Error[unsafeBlock];
	    Scope[node, Stmt];
	    SetSafety[SafetyAttr[node]]};

	  if => {
	    saveReachable: BOOL;
	    entryNP, saveNP: NPUse;
	    tb[node].son[1] ← Rhs[tb[node].son[1], dataPtr.typeBOOL];  RPop[]; 
	    pathNP ← entryNP ← SequenceNP[pathNP][phraseNP];  ClearRefStack[];
	    tb[node].son[2] ← UpdateList[tb[node].son[2], Stmt];
	    saveReachable ← current.reachable;  saveNP ← pathNP;
	    current.reachable ← TRUE;  pathNP ← entryNP;
	    tb[node].son[3] ← UpdateList[tb[node].son[3], Stmt];
	    IF saveReachable THEN current.reachable ← TRUE;
	    pathNP ← BoundNP[saveNP][pathNP]};

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

	  label => {
	    InsertLabels[tb[node].son[2]];
	    tb[node].son[1] ← UpdateList[tb[node].son[1], Stmt];
	    DeleteLabels[tb[node].son[2]];
	    LabelList[tb[node].son[2]]};

	  goto => {ValidateLabel[tb[node].son[1]]; current.reachable ← FALSE};
	  return => Return[node];

	  exit, loop => {
	    IF tb[node].name = exit THEN exits ← TRUE;
	    IF current.loopDepth = 0 THEN Log.Error[exit];
	    current.reachable ← FALSE};

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

	  open => {
	    ScanList[tb[node].son[1], OpenItem];
	    tb[node].son[2] ← UpdateList[tb[node].son[2], Stmt];
	    ReverseScanList[tb[node].son[1], CloseItem]};

	  checked => { 
	    saveSafety: Safety = safety;
	    SetSafety[SafetyAttr[node]];
	    IF saveSafety = checked AND safety = none THEN Log.Error[unsafeBlock];
	    tb[node].son[1] ← Stmt[tb[node].son[1]];
	    SetSafety[saveSafety]};

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

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


 -- case driver

  Case: PUBLIC PROC [node: Tree.Index, selection: Tree.Map] = {
    OPEN tb[node];
    saveImplicit: P3S.ImplicitInfo = P3S.implicit;
    entryNP: NPUse;

    attr: Attr;
    eqTests: BOOL;

    CaseItem: Tree.Scan = {
      switchable: BOOL;
      saveIndex: CARDINAL = dataPtr.textIndex;

      CaseTest: Tree.Map = {
	node: Tree.Index = GetNode[t];
	  BEGIN  OPEN tb[node];
	  SELECT name FROM
	    relE => {
	      son[2] ← Rhs[son[2], TargetType[P3S.implicit.type]];
	      info ← dataPtr.typeBOOL;
	      SELECT TypeForm[RType[]] FROM
		long => {attr1 ← FALSE; attr2 ← TRUE};
		real => {attr1 ← TRUE; attr2 ← FALSE};
		ENDCASE => {
		  IF OpName[son[2]] = shorten THEN
		    Log.ErrorTree[typeClash, NthSon[son[2], 1]];
		  attr1 ← attr2 ← FALSE};
	      switchable ← switchable AND RAttr[].const;  v ← t};
	    ENDCASE => {
	      v ← Rhs[t, dataPtr.typeBOOL]; eqTests ← switchable ← FALSE};
	  attr ← And[RAttr[], attr];  RPop[];
	  entryNP ← SequenceNP[entryNP][phraseNP];
	  END;
	RETURN};

      node: Tree.Index = GetNode[t];
      IF OpName[tb[node].son[1]] = decl THEN {
	bti: BTIndex = tb[node].info;

	Item: Tree.Map = {phraseNP ← entryNP; v ← selection[t]};

	dataPtr.textIndex ← bb[bti].sourceIndex;
	Log.Error[other];  switchable ← FALSE;
	Scope[node, Item]}
      ELSE {
	dataPtr.textIndex ← tb[node].info;
	switchable ← TRUE;
	tb[node].son[1] ← UpdateList[tb[node].son[1], CaseTest];
	tb[node].attr1 ← switchable;
	phraseNP ← entryNP;  tb[node].son[2] ← selection[tb[node].son[2]]};
      dataPtr.textIndex ← saveIndex};

    SealRefStack[];
    son[1] ← Exp[son[1], typeANY];
    P3S.implicit.type ← CanonicalType[RType[]]; 
    P3S.implicit.attr ← attr ← RAttr[];  RPop[];
    entryNP ← phraseNP;
    IF ~IdentifiedType[P3S.implicit.type] THEN Log.ErrorTree[relationType, son[1]];
    P3S.implicit.tree ← son[1];  eqTests ← TRUE;
    UnsealRefStack[];
    ScanList[son[2], CaseItem];  attr1 ← eqTests; attr2 ← attr.const;
    phraseNP ← entryNP;  son[3] ← selection[son[3]];
    RPush[nullType, attr];
    P3S.implicit ← saveImplicit};


 -- selection

  SelectStmt: PROC [node: Tree.Index, driver: PROC [Tree.Index, Tree.Map]] = {
    newReachable: BOOL;
    newNP: NPUse;
    saveNP: NPUse = pathNP;

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

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



 -- iteration

  DoStmt: PROC [node: Tree.Index] = {
    OPEN tb[node];
    forNode: Tree.Index;
    cvType: CSEIndex;
    controlled, block, cvUpdate, newReachable, saveExits: BOOL;
    saveNP, exitNP: NPUse;
    saveScope: BTIndex = currentScope;
    newReachable ← controlled ← block ← cvUpdate ← FALSE;
    IF son[1] # Tree.Null THEN {
      sei: ISEIndex;
      mode: LhsMode;
      forNode ← GetNode[son[1]];
      IF tb[forNode].son[1] = Tree.Null THEN {
        sei ← ISENull;  mode ← uncounted;  cvType ← typeANY}
      ELSE {
	IF OpName[tb[forNode].son[1]] # decl THEN {
	  tb[forNode].son[1] ← Exp[tb[forNode].son[1], typeANY];
	  IF (mode ← OperandLhs[tb[forNode].son[1]]) = none THEN
	    Log.ErrorTree[nonLHS, tb[forNode].son[1]];
	  sei ← WITH tb[forNode].son[1] SELECT FROM symbol => index, ENDCASE => ISENull}
	ELSE {
	  bti: BTIndex = tb[forNode].info;
	  declNode: Tree.Index = GetNode[tb[forNode].son[1]];
	  block ← TRUE;  currentScope ← bti;
	  PushCtx[bb[bti].localCtx];
	  DeclList[tb[forNode].son[1]];
	  sei ← FirstId[declNode];  seb[sei].immutable ← TRUE;
	  RPush[seb[sei].idType, voidAttr];
	  mode ← IF ctxb[seb[sei].idCtx].level = lG THEN counted ELSE uncounted};
	IF sei # ISENull THEN {BumpCount[sei]; BumpCount[sei]}	-- account for implicit refs
	ELSE Log.ErrorTree[controlId, tb[forNode].son[1]];
	cvType ← TargetType[RType[]];  RPop[]};
      SELECT mode FROM
	counted =>
	  SELECT RCType[cvType] FROM
	    simple => {tb[forNode].attr2 ← TRUE; tb[forNode].attr3 ← FALSE};
	    composite => tb[forNode].attr2 ← tb[forNode].attr3 ← TRUE;
	    ENDCASE => tb[forNode].attr2 ← FALSE;
	ENDCASE => tb[forNode].attr2 ← FALSE;
      SELECT tb[forNode].name FROM
	forseq => {
	  OPEN seq: tb[forNode];
	  seq.son[2] ← Rhs[seq.son[2], cvType];  RPop[];
	  IF seq.attr2 AND seq.attr3 THEN
	    EnterComposite[cvType, seq.son[2], OpName[seq.son[1]] = decl];
	  cvUpdate ← TRUE};
	upthru, downthru => {
	  controlled ← TRUE;
	  tb[forNode].son[2] ← Range[tb[forNode].son[2], cvType];
	  IF ~Types.Assignable[
	  	[dataPtr.ownSymbols, cvType], [dataPtr.ownSymbols, UnderType[RType[]]]] THEN
	    Log.ErrorTree[typeClash, tb[forNode].son[2]];
	  RPop[]};
	ENDCASE => ERROR;
      pathNP ← SequenceNP[pathNP][phraseNP];  ClearRefStack[]};
    saveNP ← pathNP;  pathNP ← none;
    IF son[2] # Tree.Null THEN {
      controlled ← TRUE; son[2] ← Rhs[son[2], dataPtr.typeBOOL]; RPop[];
      pathNP ← SequenceNP[pathNP][phraseNP];  ClearRefStack[]};
    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 {
      OPEN seq: tb[forNode];
      seq.son[3] ← Rhs[seq.son[3], cvType];  RPop[];
      IF seq.attr2 AND seq.attr3 THEN EnterComposite[cvType, seq.son[3], FALSE];
      pathNP ← SequenceNP[pathNP][phraseNP];  ClearRefStack[]};
    IF pathNP = refset THEN pathNP ← unsafe;
    saveNP ← pathNP ← SequenceNP[saveNP][pathNP];
    IF son[5] # Tree.Null THEN {
      current.reachable ← FALSE;
      LabelList[son[5]];  IF current.reachable THEN newReachable ← TRUE};
    exitNP ← pathNP;
    IF son[6] # Tree.Null THEN {
      current.reachable ← controlled;  pathNP ← saveNP;
      son[6] ← UpdateList[son[6], Stmt];
      IF current.reachable THEN newReachable ← TRUE;
      exitNP ← BoundNP[exitNP][pathNP]}
    ELSE IF controlled THEN newReachable ← TRUE;
    ReverseScanList[son[3], CloseItem];
    current.reachable ← newReachable;  pathNP ← exitNP;
    IF block THEN PopCtx[];
    currentScope ← saveScope};


 -- labels

  LabelList: PROC [t: Tree.Link] = {
    newReachable: BOOL;
    saveNP, newNP: NPUse;

    LabelItem: PROC [item: Tree.Link] = {
      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]};

    newReachable ← current.reachable;  saveNP ← pathNP;  newNP ← none;
    ScanList[t, LabelItem];
    current.reachable ← newReachable;  pathNP ← newNP};


  InsertLabels: PROC [t: Tree.Link] = {
    labelMark: Tree.Link = current.labelList;

    InsertLabel: PROC [labeled: Tree.Link] = {
      node: Tree.Index = GetNode[labeled];
      saveIndex: CARDINAL = dataPtr.textIndex;
      dataPtr.textIndex ← tb[node].info;
      ScanList[tb[node].son[1], StackLabel];
      dataPtr.textIndex ← saveIndex};

    StackLabel: PROC [id: Tree.Link] = {
      node: Tree.Index;
      FOR t: Tree.Link ← 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[]};

    ScanList[t, InsertLabel]};


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


  DeleteLabels: PROC [t: Tree.Link] = {
    anyReachable: BOOL;

    DeleteLabel: PROC [labeled: Tree.Link] = {
      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};

    UnstackLabel: PROC [id: Tree.Link] = {
      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]};

    ReverseScanList[t, DeleteLabel]};


 -- control transfers

  BumpArgRefs: PUBLIC PROC [record: RecordSEIndex, write: BOOL] = {
    IF record # RecordSENull THEN
      FOR sei: ISEIndex ← FirstCtxSe[seb[record].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
	IF write THEN BumpCount[sei] ELSE RecordMention[sei];
	ENDLOOP};

  CheckLocals: PUBLIC PROC [t: Tree.Link] RETURNS [localsOnly: BOOL] = {
    level: ContextLevel = bb[dataPtr.bodyIndex].level;

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

    localsOnly ← TRUE;  ScanList[t, CheckElement];  RETURN};


  Return: PROC [node: Tree.Index] = {
    OPEN tb[node];
    rSei: RecordSEIndex = current.returnRecord;
    IF current.catchDepth # 0 OR (dataPtr.bodyIndex = RootBti AND rSei = RecordSENull) THEN
      Log.Error[misplacedReturn];
    IF rSei # RecordSENull AND son[1] = Tree.Null THEN {
      BumpArgRefs[rSei, FALSE];
      FOR sei: ISEIndex ← FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
	IF seb[sei].hash = nullName AND ~seb[sei].extended THEN {
	  Log.Error[illDefinedReturn]; EXIT};
	ENDLOOP;
      attr2 ← TRUE}
    ELSE {
      son[1] ← IF attr3 AND rSei # RecordSENull
        THEN Rhs[son[1], rSei]
        ELSE MatchFields[rSei, son[1]];
      RPop[];
      pathNP ← SequenceNP[pathNP][phraseNP];
      IF current.entry THEN attr2 ← CheckLocals[son[1]]};
    IF (attr1 ← current.entry) THEN {
      [] ← UpdateTreeAttr[tb[current.bodyNode].son[4]];
      pathNP ← SequenceNP[pathNP][phraseNP]};
    current.reachable ← FALSE};

  ImpliedReturn: Tree.Map = {
    IF current.returnRecord # RecordSENull OR current.entry THEN {
      PushTree[Tree.Null]; PushNode[return, 1];
      SetInfo[dataPtr.textIndex];  SetAttr[3,  FALSE];
      PushTree[Stmt[PopTree[]]];
      PushTree[t];  v ← MakeList[-2]}
    ELSE v ← t;
    RETURN};


 -- basing

  OpenItem: Tree.Scan = {
    node: Tree.Index = GetNode[t];
    saveIndex: CARDINAL = dataPtr.textIndex;
    dataPtr.textIndex ← tb[node].info;
    tb[node].son[2] ← OpenBase[tb[node].son[2], GetHash[tb[node].son[1]]
	 ! InsertCatchLabel => {Log.Error[catchLabel]; RESUME}];
    ClearRefStack[];
    dataPtr.textIndex ← saveIndex};

  CloseItem: Tree.Scan = {
    node: Tree.Index = GetNode[t];
    CloseBase[tb[node].son[2], GetHash[tb[node].son[1]]]};

  }.