-- file Pass3M.Mesa
-- last modified by Satterthwaite, November 12, 1979  4:38 PM

DIRECTORY
  ComData: FROM "comdata"
    USING [
      bodyIndex, idUNWIND, mainBody, ownSymbols, seAnon, stopping,
      textIndex, typeCONDITION, typeLOCK],
  Log: FROM "log" USING [Error, ErrorSei, ErrorTree],
  Pass3: FROM "pass3"
    USING [continued, currentBody, lockHeld, lockNode, markCatch],
  P3: FROM "p3"
    USING [
      Attr, BodyData, NPUse, BoundNP, MergeNP, SequenceNP, SetNP,
      pathNP, phraseNP,
      Apply, BumpArgRefs, BumpCount, CanonicalType, CheckLocals,
      ClearRefStack, Exp, LongPath, MakePointerType, MatchFields,
      OperandInline, OperandInternal, OperandLhs, OperandType,
      PopCtx, PushCtx, RAttr, RPop, RPush, RType, SealRefStack,
      SearchCtxList, Stmt, UnsealRefStack, UpdateTreeAttr, VoidExp],
  StringDefs: FROM "stringdefs" USING [SubStringDescriptor],
  Symbols: FROM "symbols"
    USING [seType, ctxType, mdType, bodyType,
      SERecord, BodyRecord, 
      SEIndex, ISEIndex, CSEIndex, RecordSEIndex,
      CTXIndex, BTIndex, CBTIndex,
      HTNull, SENull, ISENull, CSENull, RecordSENull, CBTNull,
      lG, lZ, typeANY],
  SymbolOps: FROM "symbolops"
    USING [
      EnterString, MakeNonCtxSe, NextSe, NormalType,
      TransferTypes, TypeRoot, UnderType, XferMode],
  Table: FROM "table" USING [Base, Notifier, Bounds],
  Tree: FROM "tree"
    USING [treeType,
      Index, Link, Map, NodeName, Null, NullIndex, Scan],
  TreeOps: FROM "treeops"
    USING [
      CopyTree, FreeNode, FreeTree, GetNode, MakeList, MakeNode,
      PopTree, PushTree, PushSe, PushNode, ScanList, SetAttr, SetInfo,
      Shared, TestTree, UpdateList],
  Types: FROM "types" USING [Assignable, Equivalent];

Pass3M: PROGRAM
    IMPORTS
	Log, P3, SymbolOps, Table, TreeOps, Types,
	dataPtr: ComData, passPtr: Pass3
    EXPORTS P3 =
  BEGIN
  OPEN SymbolOps, Symbols, P3, TreeOps;

  InsertCatchLabel: PUBLIC SIGNAL [catchSeen, exit: BOOLEAN] = CODE;

  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)

  MiscNotify: 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;

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

 -- statements

  MiscStmt: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    val _ [subtree[index: node]];	-- the default
    SELECT tb[node].name FROM

      signal, error, start, join, wait =>
	BEGIN  
	IF tb[node].name = xerror AND current.catchDepth # 0
	  THEN Log.Error[misplacedReturn];
	PushTree[SELECT tb[node].name FROM
	      start => Start[node],
	      join => Join[node],
	      wait => Wait[node],
	      ENDCASE => Signal[node]];
	SELECT RType[] FROM
	  CSENull, typeANY =>  NULL;
	  ENDCASE =>  Log.Error[nonVoidStmt];
	SetInfo[dataPtr.textIndex];  val _ PopTree[];  RPop[];
	pathNP _ SequenceNP[pathNP][phraseNP];
	IF TestTree[val, error] THEN current.reachable _ FALSE;
	END;

      xerror =>
	BEGIN  
	subNode: Tree.Index;
	IF current.catchDepth # 0 THEN Log.Error[misplacedReturn];
	tb[node].name _ error;
	val _ MiscStmt[node];  subNode _ GetNode[val];
	SELECT tb[subNode].name FROM
	  error, errorx =>  tb[subNode].name _ xerror;
	  ENDCASE => NULL;
	tb[subNode].attr1 _ current.entry;
	IF current.entry
	  THEN tb[subNode].attr2 _ CheckLocals[tb[subNode].son[2]];
	current.reachable _ FALSE;
	END;

      resume =>  Resume[node];

      continue, retry =>
	BEGIN
	SIGNAL InsertCatchLabel[catchSeen:FALSE, exit:tb[node].name=continue];
	current.reachable _ FALSE;
	END;

      restart =>
	BEGIN val _ Restart[node]; pathNP _ SequenceNP[pathNP][phraseNP] END;

      stop =>
	BEGIN
	IF dataPtr.bodyIndex # dataPtr.mainBody OR current.catchDepth # 0
	 OR current.returnRecord # SENull
	  THEN Log.Error[misplacedStop];
	IF tb[node].son[1] # Tree.Null THEN [] _ CatchPhrase[tb[node].son[1]];
	dataPtr.stopping _ TRUE;  pathNP _ SetNP[pathNP];
	END;

      notify, broadcast =>
	BEGIN  OPEN tb[node];
	type: CSEIndex;
	IF ~passPtr.lockHeld THEN Log.Error[misplacedMonitorRef];
	son[1] _ Exp[son[1], typeANY];
	IF ~OperandLhs[son[1]] THEN Log.ErrorTree[nonLHS, son[1]];
	type _ RType[];  RPop[];  pathNP _ SequenceNP[pathNP][phraseNP];
	IF type # dataPtr.typeCONDITION THEN Log.ErrorTree[typeClash, son[1]];
	END;

      dst, lst, lstf =>
	BEGIN  OPEN tb[node];
	v: Tree.Link;
	v _ son[1] _ Exp[son[1], typeANY];  RPop[];
	SELECT name FROM
	  lstf =>  current.reachable _ FALSE;
	  dst =>  IF ~OperandLhs[son[1]] THEN GO TO fail;
	  ENDCASE;
	IF name # dst THEN phraseNP _ SetNP[phraseNP];
	pathNP _ SequenceNP[pathNP][phraseNP];
	-- check for simple addressability
	  DO
	  WITH v SELECT FROM
	    symbol =>  IF seb[index].constant THEN GO TO fail ELSE EXIT;
	    subtree =>
	      BEGIN
	      IF tb[index].name # dollar THEN GO TO fail;
	      v _ tb[index].son[1]
	      END;
	    ENDCASE =>  GO TO fail;
	  ENDLOOP;
	EXITS
	  fail => Log.ErrorTree[nonLHS, tb[node].son[1]];
	END;

      enable =>
	BEGIN  OPEN tb[node];
	saveEnabled: BOOLEAN = current.unwindEnabled;
	IF CatchPhrase[son[1]].unwindCaught THEN current.unwindEnabled _ TRUE;
	IF phraseNP # none THEN pathNP _ unsafe;
	son[2] _ UpdateList[son[2], Stmt];
	current.unwindEnabled _ saveEnabled;
	END;

      ENDCASE =>  Log.Error[unimplemented];

    RETURN
    END;


 -- control transfers

  MiscXfer: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex] RETURNS [val: Tree.Link] =
    BEGIN
    SELECT tb[node].name FROM
      signalx, errorx =>  val _ Signal[node];
      new =>  val _ New[node, target];
      startx =>  val _ Start[node];
      fork =>  val _ Fork[node, target];
      joinx =>  val _ Join[node];
      ENDCASE => BEGIN Log.Error[unimplemented]; val _ [subtree[node]] END;
    RETURN
    END;


  MakeFrameRecord: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [rSei: CSEIndex] =
    BEGIN
    bti: CBTIndex = XferBody[t];
    IF bti # CBTNull
      THEN
	rSei _ AllocFrameRecord[bti, TransferTypes[bb[bti].ioType].typeIn]
      ELSE  BEGIN  Log.Error[nonTypeCons];  rSei _ typeANY  END;
    RETURN
    END;

  AllocFrameRecord: PROCEDURE [bti: CBTIndex, link: SEIndex] RETURNS [sei: RecordSEIndex] =
    BEGIN
    sei _ LOOPHOLE[MakeNonCtxSe[SIZE[linked record cons SERecord]]];
    seb[sei] _ SERecord[mark3: TRUE, mark4: FALSE,
	body: cons[record[
	    machineDep: FALSE,
	    argument: FALSE,
	    hints: [
		unifield: FALSE, variant: FALSE,
		comparable: FALSE, privateFields: TRUE],
	    fieldCtx: bb[bti].localCtx,
	    length: 0 -- n*wordlength --,
	    lengthUsed: FALSE,
	    monitored: bb[bti].monitored,
	    linkPart: linked[link]]]];
    RETURN
    END;


  XferBody: PROCEDURE [t: Tree.Link] RETURNS [bti: CBTIndex] =
    BEGIN
    sei: ISEIndex;
    type: CSEIndex;
    WITH t SELECT FROM
      symbol =>
	BEGIN  sei _ index;
	type _ UnderType[seb[sei].idType];
	bti _ WITH seb[type] SELECT FROM
	  transfer =>
	    IF ~seb[sei].immutable
	      THEN CBTNull
	      ELSE
		SELECT mode FROM
		  program =>
		    IF seb[sei].mark4
		      THEN
			IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull
		      ELSE dataPtr.mainBody,
		  procedure =>
		    IF sei = bb[dataPtr.bodyIndex].id
		      THEN dataPtr.bodyIndex
		      ELSE CBTNull,
		  ENDCASE => CBTNull,
	  ENDCASE =>  CBTNull;
	END;
      ENDCASE =>  bti _ CBTNull;
    RETURN
    END;

  XferForFrame: PUBLIC PROCEDURE [ctx: CTXIndex] RETURNS [CSEIndex] =
    BEGIN
    bti: BTIndex;
    btLimit: BTIndex = LOOPHOLE[Table.Bounds[bodyType].size];
    bti _ FIRST[BTIndex];
    UNTIL bti = btLimit
      DO
      WITH entry: bb[bti] SELECT FROM
	Callable =>
	  BEGIN
	  IF entry.localCtx = ctx THEN RETURN [UnderType[entry.ioType]];
	  bti _ bti + (WITH  entry SELECT FROM
		    Inner => SIZE[Inner Callable BodyRecord],
		    ENDCASE => SIZE[Outer Callable BodyRecord]);
	  END;
	ENDCASE => bti _ bti + SIZE[Other BodyRecord];
      ENDLOOP;
    ERROR
    END;


  New: PROCEDURE [node: Tree.Index, target: CSEIndex] RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    val _ ForceApplication[tb[node].son[1]];
    tb[node].son[1] _ Tree.Null;  FreeNode[node];
    subNode _ GetNode[val];
      BEGIN  OPEN tb[subNode];
      type, mType, rType: CSEIndex;
      attr: Attr;

      NewError: PROCEDURE =
        BEGIN  Log.ErrorTree[typeClash, son[1]]; type _ typeANY  END;

      name _ new;  attr1 _ TRUE;
      son[1] _ Exp[son[1], typeANY];
      mType _ RType[];  attr _ RAttr[];  RPop[];  phraseNP _ SetNP[phraseNP];
      WITH seb[mType] SELECT FROM
	transfer =>
	  IF mode = program
	    THEN
	      SELECT XferBody[son[1]] FROM
		CBTNull =>  type _ mType;
		dataPtr.mainBody =>
		  BEGIN
		  type _ IF seb[target].typeTag = pointer
		    THEN MakePointerType[MakeFrameRecord[son[1]], target]
		    ELSE mType;
		  attr1 _ FALSE;
		  END;
		ENDCASE => NewError[]
	    ELSE NewError[];
	pointer =>
	  BEGIN
	  type _ mType; dereferenced _ TRUE; rType _ UnderType[refType];
	  WITH seb[rType] SELECT FROM
	    record =>
	      SELECT TRUE FROM
		(ctxb[fieldCtx].level # lG) =>  NewError[];
		(seb[target].typeTag = transfer) =>
		  type _ XferForFrame[fieldCtx];
		ENDCASE;
	    ENDCASE =>  IF refType # typeANY THEN NewError[];
	  END;
	ENDCASE =>  IF mType # typeANY THEN type _ typeANY ELSE NewError[];
      IF son[2] # Tree.Null
	THEN
	  BEGIN  Log.ErrorTree[noApplication, son[1]];
	  son[2] _ UpdateList[son[2], VoidExp];
	  END;
      IF nSons > 2 THEN [] _ CatchPhrase[son[3]];
      attr.const _ attr.noXfer _ FALSE;  RPush[type, attr];
      END;
    RETURN
    END;


  Start: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    val _ ForceApplication[tb[node].son[1]];
    subNode _ GetNode[val];
    Apply[subNode, typeANY, TRUE];
    SELECT tb[subNode].name FROM
      start, startx, apply => NULL;
      ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
    tb[node].son[1] _ Tree.Null;  FreeNode[node];  RETURN
    END;


  Restart: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    type: CSEIndex;
    val _ ForceApplication[tb[node].son[1]];
    subNode _ GetNode[val];
      BEGIN  OPEN tb[subNode];
      name _ tb[node].name;  info _ tb[node].info;
      son[1] _ Exp[son[1], typeANY];  type _ RType[];  RPop[];
      phraseNP _ SetNP[phraseNP];
      WITH seb[type] SELECT FROM
	pointer =>  NULL;		-- a weak check for now
	transfer =>
	  IF mode # program OR XferBody[son[1]] # CBTNull
	    THEN Log.ErrorTree[typeClash, son[1]];
	ENDCASE =>  IF type # typeANY THEN Log.ErrorTree[typeClash, son[1]];
      IF son[2] # Tree.Null
	THEN
	  BEGIN  Log.ErrorTree[noApplication, son[1]];
	  son[2] _ UpdateList[son[2], VoidExp];
	  END;
      IF nSons > 2 THEN [] _ CatchPhrase[son[3]];
      END;
    tb[node].son[1] _ Tree.Null;  FreeNode[node];  RETURN
    END;


  Fork: PROCEDURE [node: Tree.Index, target: CSEIndex] RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    type, subType: CSEIndex;
    attr: Attr;
    val _ ForceApplication[tb[node].son[1]];
    tb[node].son[1] _ Tree.Null;  FreeNode[node];
    subNode _ GetNode[val];
    Apply[subNode, typeANY, TRUE];  attr _ RAttr[];  RPop[];
    SELECT tb[subNode].name FROM
      call, callx =>
	BEGIN
	IF passPtr.lockHeld AND OperandInternal[tb[subNode].son[1]]
	  THEN  Log.ErrorTree[internalCall, tb[subNode].son[1]];
	subType _ OperandType[tb[subNode].son[1]];
	WITH procType: seb[subType] SELECT FROM
	  transfer =>
	    BEGIN
	    type _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
	    seb[type] _ SERecord[mark3: TRUE, mark4: TRUE,
			  body: cons[transfer[
			      mode: process,
			      inRecord: RecordSENull,
			      outRecord: procType.outRecord]]];
	    IF OperandInline[tb[subNode].son[1]]
	      THEN  Log.ErrorTree[misusedInline, tb[subNode].son[1]];
	    END;
	  ENDCASE => ERROR;
	tb[subNode].name _ fork;
	END;
      apply => type _ typeANY;
      ENDCASE =>
	BEGIN
	Log.ErrorTree[typeClash, tb[node].son[1]];  type _ typeANY;
	END;
    tb[subNode].info _ type;
    attr.const _ attr.noXfer _ FALSE;  RPush[type, attr];
    RETURN
    END;

  Join: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    val _ ForceApplication[tb[node].son[1]];
    subNode _ GetNode[val];
    Apply[subNode, typeANY, TRUE];
    SELECT tb[subNode].name FROM
      join, joinx => NULL;
      apply => NULL;
      ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
    tb[node].son[1] _ Tree.Null;  FreeNode[node];  RETURN
    END;

  Wait: PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    saveNP: NPUse;
    IF ~passPtr.lockHeld THEN  Log.Error[misplacedMonitorRef];
    val _ ForceApplication[tb[node].son[1]];
    subNode _ GetNode[val];
    Apply[subNode, typeANY, TRUE];
    SELECT tb[subNode].name FROM
      wait => NULL;
      apply => NULL;
      ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
    tb[node].son[1] _ Tree.Null;  FreeNode[node];
    IF ~OperandLhs[tb[subNode].son[1]]
      THEN Log.ErrorTree[nonLHS, tb[subNode].son[1]];
    [] _ FreeTree[tb[subNode].son[2]];
    saveNP _ phraseNP;
    tb[subNode].son[2] _ tb[subNode].son[1];  tb[subNode].son[1] _ CopyLock[];
    phraseNP _ MergeNP[saveNP][phraseNP];
    RETURN
    END;


 -- monitors

  LockVar: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [val: Tree.Link] =
    BEGIN
    type, nType: CSEIndex;
    desc: StringDefs.SubStringDescriptor;
    sei: ISEIndex;
    nDerefs: CARDINAL;
    long, b: BOOLEAN;

    Dereference: PROCEDURE [type: CSEIndex] =
      BEGIN
      PushTree[val];  PushNode[uparrow, 1];  SetInfo[type];  SetAttr[1, long];
      val _ PopTree[];
      END;

    val _ Exp[t, typeANY];  long _ LongPath[val];
    type _ RType[];  RPop[];  nDerefs _ 0;
      DO
      IF type = dataPtr.typeLOCK
	THEN
	  BEGIN
	  IF nDerefs # 0 THEN Dereference[type];
	  GO TO success
	  END;
      type _ TypeRoot[type];  nType _ NormalType[type];
      WITH seb[nType] SELECT FROM
	record =>
	  BEGIN
	  IF monitored
	    THEN
	      BEGIN
	      desc _ ["LOCK"L, 0, ("LOCK"L).length];
	      [b, sei] _ SearchCtxList[EnterString[@desc], fieldCtx];
	      IF ~b THEN BEGIN Log.Error[noAccess]; sei _ dataPtr.seAnon END;
	      PushTree[val];  PushSe[sei];
	      PushNode[IF nDerefs = 0 THEN dollar ELSE dot, 2];
	      SetInfo[dataPtr.typeLOCK];  SetAttr[1, long];  val _ PopTree[];
	      GO TO success;
	      END;
	  GO TO failure;
	  END;
	pointer =>
	  BEGIN
	  IF (nDerefs _ nDerefs + 1) > 255 THEN GO TO failure;
	  IF nDerefs > 1 THEN Dereference[type];
	  long _ seb[type].typeTag = long;
	  dereferenced _ TRUE;  type _ UnderType[refType];
	  END;
	ENDCASE => GO TO failure;
      REPEAT
	success => NULL;
	failure => Log.ErrorTree[typeClash, val];
      ENDLOOP;
    IF ~OperandLhs[val] THEN Log.ErrorTree[nonLHS, val];
    RETURN
    END;

  FindLockParams: PUBLIC PROCEDURE RETURNS [formal, actual: ISEIndex] =
    BEGIN
    node: Tree.Index = GetNode[tb[passPtr.lockNode].son[1]];
    found: BOOLEAN;
    IF node = Tree.NullIndex
      THEN  formal _ actual _ ISENull
      ELSE
	BEGIN
	WITH tb[node].son[1] SELECT FROM
	  symbol => formal _ index;
	  ENDCASE => ERROR;
	IF current.inputRecord = SENull
	  THEN  found _ FALSE
	  ELSE  [found, actual] _ SearchCtxList[
		    seb[formal].hash,
		    seb[current.inputRecord].fieldCtx];
	IF ~found THEN actual _ ISENull;
	END;
    RETURN
    END;


  LambdaApply: PROCEDURE [t: Tree.Link, formal, actual: ISEIndex] RETURNS [Tree.Link] =
    BEGIN

    Substitute: Tree.Map =
      BEGIN
      sei: ISEIndex;
      WITH t SELECT FROM
	symbol =>
	  BEGIN  sei _ index;
	  IF sei = formal THEN sei _ actual;
	  BumpCount[sei];
	  v _ [symbol[index: sei]];
	  END;
	subtree =>
	  IF Shared[t]
	    THEN  BEGIN  [] _ UpdateTreeAttr[t];  v _ t  END
	    ELSE  v _ CopyTree[[baseP:@tb, link:t], Substitute];
	ENDCASE =>  v _ t;
      RETURN
      END;

    RETURN [Substitute[t]];
    END;

  CopyLock: PUBLIC PROCEDURE RETURNS [val: Tree.Link] =
    BEGIN
    formal, actual: ISEIndex;
    SELECT TRUE FROM
      passPtr.lockNode = Tree.NullIndex =>  val _ Tree.Null;
      tb[current.bodyNode].son[4] # Tree.Null =>
	val _ LambdaApply[tb[current.bodyNode].son[4], ISENull, ISENull];
      ENDCASE =>
        BEGIN
	[formal:formal, actual:actual] _ FindLockParams[];
	IF formal # SENull
	  THEN
	    BEGIN
	    IF actual = SENull
	      THEN
		BEGIN
		Log.ErrorSei[missingLock, formal];
		actual _ dataPtr.seAnon;
		END;
	    IF ~Types.Assignable[
		    [dataPtr.ownSymbols, UnderType[seb[formal].idType]],
		    [dataPtr.ownSymbols, UnderType[seb[actual].idType]]]
	      THEN Log.ErrorSei[typeClash, actual];
	    END;
	val _ LambdaApply[tb[passPtr.lockNode].son[2], formal, actual];
	END;
    RETURN
    END;


 -- signals

  Signal: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [val: Tree.Link] =
    BEGIN
    subNode: Tree.Index;
    nodeTag: Tree.NodeName = tb[node].name;
    val _ ForceApplication[tb[node].son[1]];
    subNode _ GetNode[val];
    Apply[subNode, typeANY, TRUE];
    SELECT tb[subNode].name FROM
      signal, signalx =>  tb[subNode].name _ nodeTag;
      error, errorx =>
	BEGIN
	SELECT nodeTag FROM 
	  signal, signalx =>  Log.ErrorTree[typeClash, tb[subNode].son[1]];
	  ENDCASE => NULL;
	tb[subNode].name _ nodeTag;
	END;
      apply => NULL;
      ENDCASE =>  Log.ErrorTree[typeClash, tb[subNode].son[1]];
    tb[node].son[1] _ Tree.Null;  FreeNode[node];  RETURN
    END;

  ForceApplication: PROCEDURE [t: Tree.Link] RETURNS [Tree.Link] =
    BEGIN
    IF TestTree[t, apply] THEN  RETURN [t];
    PushTree[t];  PushTree[Tree.Null];
    RETURN [MakeNode[apply, 2]]
    END;


 -- catch phrases


  CatchPhrase: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [unwindCaught: BOOLEAN] =
    BEGIN
    saveReachable: BOOLEAN = current.reachable;
    savePathNP: NPUse = pathNP;
    entryNP, exitNP: NPUse;

    CatchItem: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      type: CSEIndex;
      mixed: BOOLEAN;
      saveIndex: CARDINAL = dataPtr.textIndex;

      CatchLabel: Tree.Map =
	BEGIN
	subType: CSEIndex;
	v _ Exp[t, typeANY];  subType _ CanonicalType[RType[]];  RPop[];
	entryNP _ SequenceNP[entryNP][phraseNP];
	SELECT XferMode[subType] FROM
	  signal, error =>
	    IF type = typeANY
	      THEN type _ subType
	      ELSE IF ~Types.Equivalent[
		    [dataPtr.ownSymbols, type], [dataPtr.ownSymbols, subType]]
		THEN mixed _ TRUE;
	  ENDCASE =>  IF subType # typeANY THEN Log.ErrorTree[typeClash, t];
	RETURN
	END;

      dataPtr.textIndex _ tb[node].info;
      type _ typeANY;  mixed _ FALSE;
      tb[node].son[1] _ UpdateList[tb[node].son[1], CatchLabel];
      IF mixed THEN type _ typeANY;
      tb[node].son[2] _ CatchBody[tb[node].son[2], type];
      IF tb[node].son[1] = Tree.Link[symbol[index: dataPtr.idUNWIND]]
	THEN
	  BEGIN
	  unwindCaught _ TRUE;
	  IF current.entry AND ~current.unwindEnabled
	   AND current.catchDepth = 0
	    THEN
	      BEGIN
	      PushTree[tb[node].son[2]];  PushTree[CopyLock[]];
	      PushNode[unlock, 1];  SetInfo[dataPtr.textIndex];
	      tb[node].son[2] _ MakeList[2];
	      END;
	  END;
      tb[node].info _ IF type # typeANY THEN type ELSE SENull;
      dataPtr.textIndex _ saveIndex;  RETURN
      END;

    CatchBody: PROCEDURE [body: Tree.Link, type: CSEIndex] RETURNS [val: Tree.Link] =
      BEGIN
      saveRecord:  RecordSEIndex = current.resumeRecord;
      saveFlag: BOOLEAN = current.resumeFlag;
      current.catchDepth _ current.catchDepth + 1;
      WITH seb[type] SELECT FROM
	transfer =>
	  BEGIN  current.resumeFlag _ mode = signal;
	  PushArgCtx[inRecord];
	  BumpArgRefs[inRecord, TRUE];
	  PushArgCtx[current.resumeRecord _ outRecord];
	  ClearRefStack[];
	  END;
	ENDCASE =>
	  BEGIN
	  current.resumeFlag _ FALSE; current.resumeRecord _ RecordSENull;
	  END;
      current.reachable _ TRUE;  pathNP _ entryNP;
      val _ UpdateList[body, Stmt
		! InsertCatchLabel => IF catchSeen THEN RESUME];
      exitNP _ BoundNP[exitNP][pathNP];
      WITH seb[type] SELECT FROM
	transfer =>  BEGIN  PopArgCtx[outRecord];  PopArgCtx[inRecord]  END;
	ENDCASE;
      current.catchDepth _ current.catchDepth - 1;
      current.resumeRecord _ saveRecord;  current.resumeFlag _ saveFlag;
      RETURN
      END;

    setLabel, continued: BOOLEAN;
    node: Tree.Index = GetNode[t];
    SealRefStack[];
    setLabel _ continued _ unwindCaught _ FALSE;  entryNP _ exitNP _ none;
      BEGIN
      ENABLE InsertCatchLabel =>
	IF ~catchSeen
	  THEN
	    BEGIN
	    setLabel _ TRUE;  IF exit THEN continued _ TRUE;
	    SIGNAL InsertCatchLabel[catchSeen:TRUE, exit:exit]; RESUME
	    END;
      ScanList[tb[node].son[1], CatchItem];
      IF tb[node].nSons > 1
	THEN tb[node].son[2] _ CatchBody[tb[node].son[2], typeANY];
      END;
    IF setLabel
      THEN BEGIN passPtr.markCatch _ TRUE; passPtr.continued _ continued END;
    UnsealRefStack[];  current.reachable _ saveReachable;
    phraseNP _ exitNP;  pathNP _ savePathNP;  RETURN
    END;

  PushArgCtx: PROCEDURE [rSei: RecordSEIndex] =
    BEGIN
    ctx: CTXIndex;
    IF rSei # RecordSENull THEN
      BEGIN
      ctx _ seb[rSei].fieldCtx;
      ctxb[ctx].level _ current.level + current.catchDepth;  PushCtx[ctx];
      END;
    END;

  PopArgCtx: PROCEDURE [rSei: RecordSEIndex] =
    BEGIN
    IF rSei # RecordSENull THEN
      BEGIN  PopCtx[];  ctxb[seb[rSei].fieldCtx].level _ lZ  END;
    END;


  Resume: PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    rSei: RecordSEIndex = current.resumeRecord;
    n: CARDINAL;
    sei: ISEIndex;
    IF ~current.resumeFlag THEN Log.Error[misplacedResume];
    IF rSei = SENull OR son[1] # Tree.Null
      THEN  BEGIN  son[1] _ MatchFields[rSei, son[1], FALSE];  RPop[]  END
      ELSE
	BEGIN  n _ 0;
	BumpArgRefs[rSei, FALSE];
	FOR sei _ ctxb[seb[rSei].fieldCtx].seList, NextSe[sei] UNTIL sei = SENull
	  DO
	  n _ n+1; 
	  IF n=1 AND seb[sei].hash = HTNull THEN Log.Error[illDefinedReturn];
	  PushSe[sei];
	  ENDLOOP;
	son[1] _ MakeList[n];
	END;
    current.reachable _ FALSE;
    END;

  END.