-- file Pass3P.Mesa
-- last modified by Satterthwaite, November 13, 1979  1:30 PM

DIRECTORY
  ComData: FROM "comdata"
    USING [bodyRoot, defBodyLimit, definitionsOnly, nBodies, textIndex],
  Copier: FROM "copier" USING [CopyArgSe, CopyXferType],
  Log: FROM "log" USING [Error, ErrorSei],
  P3: FROM "p3",
  Symbols: FROM "symbols"
    USING [seType, ctxType, mdType, bodyType,
      BodyInfo, BodyRecord, ContextLevel, StandardContext,
      ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, CBTIndex,
      ISENull, RecordSENull, CTXNull, BTNull, HTNull,
      lL, typeTYPE],
  SymbolOps: FROM "symbolops"
    USING [
      CtxEntries, DelinkBti, FindExtension, FirstCtxSe, LinkBti,
      MakeSeChain, NewCtx, NextLevel, NextSe,
      ParentBti, SetSeLink, SearchContext, TransferTypes,
      StaticNestError],
  SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode],
  Table: FROM "table"
    USING [Base, Notifier, AddNotify, Allocate, Bounds, DropNotify],
  Tree: FROM "tree" USING [Index, Link, Map, Scan, Null, NullIndex, treeType],
  TreeOps: FROM "treeops"
    USING [
      CopyTree, FreeNode, FreeTree, GetNode, ListTail, MakeList, PopTree,
      PushNode, PushTree, ScanList, SetAttr, SetInfo, SetShared, Shared,
      TestTree, UpdateList, UpdateTree];

Pass3P: PROGRAM
    IMPORTS
	Copier, Log, SymbolOps, SystemDefs, Table, TreeOps,
	dataPtr: ComData
    EXPORTS P3 =
  BEGIN
  OPEN TreeOps, SymbolOps, Symbols;

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

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


 -- driver

  Postlude: PUBLIC PROCEDURE =
    BEGIN
    Table.AddNotify[PostNotify];
    LinkImportedBodies[];
    ExpandInlines[dataPtr.bodyRoot];
    Table.DropNotify[PostNotify];
    END;


-- included body copying

  LinkImportedBodies: PROCEDURE =
    BEGIN
    bti, nextBti: BTIndex;
    btLimit: BTIndex = LOOPHOLE[Table.Bounds[bodyType].size];
    FOR bti _ LOOPHOLE[dataPtr.defBodyLimit], nextBti UNTIL bti = btLimit
      DO
      WITH body: bb[bti] SELECT FROM
	Callable =>
	  BEGIN
	  IF body.inline THEN
	    BEGIN
	    body.link _ bb[dataPtr.bodyRoot].link;
	    bb[dataPtr.bodyRoot].link _ [sibling, bti];
	    END;
	  nextBti _ bti + (SELECT body.nesting FROM
			Inner => SIZE[Inner Callable BodyRecord],
			ENDCASE => SIZE[Outer Callable BodyRecord]);
	  END;
	ENDCASE => nextBti _ bti + SIZE[Other BodyRecord];
      ENDLOOP;
    END;


-- inline expansion

 -- state information

  currentMaster: CBTIndex;
  masterBody: Tree.Index;
  copyCtx: CTXIndex;
  copying: BOOLEAN;
  substSafe: BOOLEAN;
  currentEnclosing: BTIndex;
  bodyNesting: CARDINAL;

  aStack: AList;	-- current association list

  AItem: TYPE = RECORD [id: ISEIndex, name: BOOLEAN, val: Tree.Link];
  ANode: TYPE = RECORD [
    next: AList,
    ctx: CTXIndex,
    nItems: CARDINAL,
    map: ARRAY [0..0) OF AItem];
  AList: TYPE = POINTER TO ANode;


 -- overall control

  ExpandInlines: PROCEDURE [rootBti: BTIndex] =
    BEGIN
    bti: BTIndex;
    aStack _ NIL;  sharingMap _ NIL;
    bti _ rootBti;
    UNTIL bti = BTNull
      DO
      ExpandInlines[bb[bti].firstSon];
      WITH body: bb[bti] SELECT FROM
	Callable =>
	  IF body.inline THEN ExpandCalls[LOOPHOLE[bti, CBTIndex]];
	ENDCASE;
      bti _ IF bb[bti].link.which=parent THEN BTNull ELSE bb[bti].link.index;
      ENDLOOP;
    END;

  ExpandCalls: PROCEDURE [bti: CBTIndex] =
    BEGIN
    saveIndex: CARDINAL = dataPtr.textIndex;
    sei: ISEIndex = bb[bti].id;
    current, subNode: Tree.Index;
    WITH body: bb[bti].info SELECT FROM
      Internal =>
	BEGIN
	currentMaster _ bti;
	masterBody _ IF seb[sei].mark4
			THEN GetNode[FindExtension[sei].tree]
			ELSE body.bodyTree;
	copying _ TRUE;
	dataPtr.textIndex _ body.sourceIndex;
	UNTIL (current _ body.thread) = Tree.NullIndex
	  DO
	  -- process the thread (son[1])
	    subNode _ GetNode[tb[current].son[1]];
	    tb[current].son[1] _ tb[subNode].son[1];
	    currentEnclosing _ tb[subNode].info;
	    body.thread _ GetNode[tb[subNode].son[2]];
	    tb[subNode].son[1] _ tb[subNode].son[2] _ Tree.Null;
	    FreeNode[subNode];
	  IF body.thread = Tree.NullIndex
	   AND (~dataPtr.definitionsOnly OR bb[bti].level > lL)
	    THEN copying _ FALSE;
	  IF ~RecursiveSubst[bti, currentEnclosing]
	    THEN  ExpandCall[current]
	    ELSE  Log.ErrorSei[recursiveInline, bb[bti].id];
	  ENDLOOP;
	END;
      ENDCASE => ERROR;
    dataPtr.textIndex _ saveIndex;
    END;

  ExpandCall: PROCEDURE [node: Tree.Index] =
    BEGIN
    typeIn, typeOut: RecordSEIndex;
    masterCtx: CTXIndex = bb[currentMaster].localCtx;
    formalCtx: CTXIndex;
    seChain, saveChain: ISEIndex;
    nAssigns, nVars: CARDINAL;
    extendedScope: BOOLEAN;
    newBti: BTIndex;
    t: Tree.Link;
    IF tb[node].name = call THEN dataPtr.textIndex _ tb[node].info;
    bodyNesting _ 0;
    IF copying OR masterCtx = CTXNull
      THEN  copyCtx _ CTXNull
      ELSE
	BEGIN
	saveChain _ ctxb[masterCtx].seList; ctxb[masterCtx].seList _ ISENull;
	ctxb[masterCtx].level _ bb[currentEnclosing].level;
	copyCtx _ masterCtx;
	END;
    [typeIn, typeOut] _ TransferTypes[bb[currentMaster].ioType];
    substSafe _ tb[node].attr3 AND bb[currentMaster].hints.nameSafe;
    nAssigns _ IF typeIn = RecordSENull
		THEN 0
		ELSE MapArgs[seb[typeIn].fieldCtx, node];
    tb[node].son[2] _ FreeTree[tb[node].son[2]];
    IF typeOut # RecordSENull AND RequiredFields[seb[typeOut].fieldCtx] THEN
      BEGIN
      formalCtx _ seb[typeOut].fieldCtx;
      IF copyCtx = CTXNull THEN copyCtx _ NewCtx[bb[currentEnclosing].level];
      seChain _ MakeSeChain[copyCtx, CtxVars[formalCtx], TRUE];
      AppendSeChain[copyCtx, seChain];
      MapIds[formalCtx, seChain, 0];
      END;
    IF tb[masterBody].son[1] # Tree.Null THEN
      PushTree[ExpandOpens[tb[masterBody].son[1]]];
    IF masterCtx # CTXNull THEN
      IF ~copying
	THEN  AppendSeChain[copyCtx, saveChain]
	ELSE
	  IF (nVars _ CtxVars[masterCtx]) # 0 THEN
	    BEGIN
	    IF copyCtx = CTXNull
	      THEN copyCtx _ NewCtx[bb[currentEnclosing].level];
	    seChain _ MakeSeChain[copyCtx, nVars, FALSE];
	    MapIds[masterCtx, seChain, 0];
	    AppendSeChain[copyCtx, seChain];
	    END;
   -- expand the body
    IF copyCtx # CTXNull THEN  newBti _ MakeEnclosingBody[BTNull, copyCtx];
    t _ ExpandDecls[tb[masterBody].son[2]];
    PushTree[ExpandTree[tb[masterBody].son[3]]];
    IF copyCtx = CTXNull
      THEN  extendedScope _ FALSE
      ELSE
	BEGIN
	extendedScope _ nAssigns # 0 OR tb[masterBody].son[1] # Tree.Null
			  OR tb[masterBody].son[4] # Tree.Null;
	PushTree[t];  PushNode[block, -2];
	SetInfo[newBti];  SetAttr[3, extendedScope];
	WITH body: bb[newBti].info SELECT FROM
	  Internal =>
	    BEGIN  body.bodyTree _ GetNode[t _ PopTree[]];  PushTree[t]  END;
	  ENDCASE => ERROR;
	END;
    IF tb[masterBody].son[1] # Tree.Null THEN
      BEGIN  PushNode[open, 2];  SetInfo[dataPtr.textIndex]  END;
    IF tb[masterBody].son[4] # Tree.Null THEN
      BEGIN
      PushTree[ExpandTree[tb[masterBody].son[4]]];
      PushNode[lock, 2];  SetInfo[dataPtr.textIndex];
      END;
    IF masterCtx # CTXNull AND copying AND nVars # 0 THEN UnmapIds[explicit];
    IF copyCtx # CTXNull THEN currentEnclosing _ ParentBti[currentEnclosing];
    IF ~copying THEN PruneBody[masterBody];
   -- complete the setup
    IF tb[node].nSons > 2 THEN
      BEGIN
      PushTree[tb[node].son[3]];  tb[node].son[3] _ Tree.Null;
      PushNode[enable, -2];  SetInfo[dataPtr.textIndex];
      END;
    IF typeOut # RecordSENull AND RequiredFields[seb[typeOut].fieldCtx] THEN
      UnmapIds[implicit];
    IF typeIn # RecordSENull THEN UnmapIds[implicit];
    tb[node].son[2] _ MakeList[nAssigns+1];
    IF copyCtx # CTXNull AND nAssigns # 0
      THEN  UpdateBodyNesting[tb[node].son[2], newBti];
    tb[node].name _ IF tb[node].name = callx THEN substx ELSE subst;
    tb[node].attr3 _ extendedScope;
    ResetSharing[];
    END;

  RecursiveSubst: PROCEDURE [bti, parent: BTIndex] RETURNS [BOOLEAN] =
    BEGIN
    UNTIL parent = BTNull
      DO
      IF bti = parent THEN RETURN [TRUE];
      parent _ ParentBti[parent];
      ENDLOOP;
    RETURN [FALSE]
    END;

  PruneBody: PROCEDURE [node: Tree.Index] =
    BEGIN  OPEN tb[node];
    son[1] _ son[2] _ son[3] _ son[4] _ Tree.Null;  name _ procinit;
    END;


 -- argument list testing/processing

  NameSafe: PROCEDURE [sei: ISEIndex, t: Tree.Link] RETURNS [safe: BOOLEAN] =
    BEGIN
    RETURN [~bb[currentMaster].hints.argUpdated AND
      (substSafe OR
	(WITH t SELECT FROM
	  symbol => seb[index].immutable,
	  literal => TRUE,
	  subtree =>
	    SELECT tb[index].name FROM
	      cdot, uminus, loophole, clit, llit, cast, mwconst =>
		NameSafe[sei, tb[index].son[1]],
	      ENDCASE => FALSE,
	  ENDCASE => FALSE))]
    END;

  CountVars: PROCEDURE [ctx: CTXIndex, t: Tree.Link] RETURNS [CARDINAL] =
    BEGIN
    n: CARDINAL;
    sei: ISEIndex;

    CountVar: Tree.Scan =
      BEGIN
      IF sei # ISENull THEN
	BEGIN
	IF ~NameSafe[sei, t] THEN n _ n+1;
	sei _ NextSe[sei];
	END;
      END;

    n _ 0;  sei _ FirstCtxSe[ctx];  ScanList[t, CountVar];
    RETURN [n]
    END;


  RequiredFields: PROCEDURE [ctx: CTXIndex] RETURNS [BOOLEAN] =
    BEGIN
    sei: ISEIndex;
    FOR sei _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull
      DO
      IF seb[sei].hash = HTNull THEN RETURN [FALSE];
      IF seb[sei].idInfo # 0 THEN RETURN [TRUE];
      ENDLOOP;
    RETURN [FALSE]
    END;


  ExpandTree: Tree.Map =
    BEGIN
    sNode, dNode: Tree.Index;
    WITH t SELECT FROM
      subtree =>
	BEGIN  sNode _ index;
	IF tb[sNode].shared
	  THEN  v _ ExpandShared[sNode]
	  ELSE
	    SELECT tb[sNode].name FROM
	      body =>  v _ ExpandBody[sNode];
	      block =>  v _ ExpandBlock[sNode];
	      do =>  v _ ExpandDo[sNode];
	      open, bind, bindx =>  v _ ExpandBinding[sNode];
	      subst, substx =>  v _ ExpandSubst[sNode];
	      thread =>  v _ ExpandThread[sNode];
	      ENDCASE =>
		BEGIN
		v _ IF copying
		    THEN CopyTree[[baseP:@tb, link:t], ExpandTree]
		    ELSE UpdateTree[t, ExpandTree];
		WITH v SELECT FROM
		  subtree =>
		    BEGIN  dNode _ index;
		    SELECT tb[dNode].name FROM
		      return => IF bodyNesting = 0 THEN UpdateReturn[dNode];
		      call, callx =>
			IF TestTree[tb[dNode].son[1], thread]
			  THEN ThreadSubst[sNode, dNode];
		      ENDCASE => NULL;
		    END;
		  ENDCASE => NULL;
		END;
	END;
      symbol =>  v _ ExpandSei[index];
      ENDCASE =>  v _ t;
    RETURN
    END;


  ExpandBlock: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
    BEGIN
    extendedScope: BOOLEAN = tb[node].attr3;
    EnterBlock[node, extendedScope];
    PushTree[ExpandDecls[tb[node].son[1]]];
    PushTree[ExpandTree[tb[node].son[2]]];
    IF copying
      THEN
	BEGIN
	PushNode[block, 2]; SetInfo[tb[node].info]; SetAttr[3, extendedScope];
	v _ PopTree[];
	END
      ELSE
	BEGIN
	tb[node].son[2] _ PopTree[];  tb[node].son[1] _ PopTree[];
	v _ [subtree[index: node]];
	END;
    ExitBlock[GetNode[v]];
    RETURN
    END;

  ExpandBody: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
    BEGIN
    i: CARDINAL;
    EnterBody[node];
    PushTree[ExpandOpens[tb[node].son[1]]];
    PushTree[ExpandDecls[tb[node].son[2]]];
    PushTree[ExpandTree[tb[node].son[3]]];
    PushTree[ExpandTree[tb[node].son[4]]];
    IF copying
      THEN
	BEGIN
	PushNode[body, 4];  SetInfo[tb[node].info];
        SetAttr[1, tb[node].attr1];  SetAttr[2, tb[node].attr2];
	v _ PopTree[];
	END
      ELSE
	BEGIN
	FOR i DECREASING IN [1..4] DO tb[node].son[i] _ PopTree[] ENDLOOP;
	v _ [subtree[index: node]];
	END;
    ExitBody[GetNode[v]];
    RETURN
    END;

  ExpandDo: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
    BEGIN
    i: CARDINAL;
    FOR i IN [1..2] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
    PushTree[ExpandOpens[tb[node].son[3]]];
    FOR i IN [4..6] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
    IF copying
      THEN
	BEGIN
	PushNode[do, 6];  SetInfo[tb[node].info];
        SetAttr[1, tb[node].attr1];  SetAttr[2, tb[node].attr2];
	v _ PopTree[];
	END
      ELSE
	BEGIN
	FOR i DECREASING IN [1..6] DO tb[node].son[i] _ PopTree[] ENDLOOP;
	v _ [subtree[index: node]];
	END;
    RETURN
    END;

  ExpandBinding: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
    BEGIN
    i: CARDINAL;
    nSons: CARDINAL = tb[node].nSons;
    PushTree[ExpandOpens[tb[node].son[1]]];
    FOR i IN [2..nSons] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
    IF copying
      THEN
	BEGIN
	PushNode[tb[node].name, nSons];
	SetInfo[tb[node].info];     SetAttr[1, tb[node].attr1];
	SetAttr[2, tb[node].attr2]; SetAttr[3, tb[node].attr3];
	v _ PopTree[];
	END
      ELSE
	BEGIN
	FOR i DECREASING IN [1..nSons] DO tb[node].son[i] _ PopTree[] ENDLOOP;  
	v _ [subtree[index: node]];
	END;
    RETURN
    END;

  ExpandSubst: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
    BEGIN
    extendedScope: BOOLEAN = tb[node].attr3;
    PushTree[ExpandTree[tb[node].son[1]]];
    IF extendedScope THEN [] _ MapBlock[FindBlock[tb[node].son[2]]];
    PushTree[ExpandTree[tb[node].son[2]]];
    IF copying
      THEN
	BEGIN
	PushNode[tb[node].name, 2];
	SetInfo[tb[node].info]; SetAttr[3, tb[node].attr3];  v _ PopTree[];
	END
      ELSE
	BEGIN
	tb[node].son[2] _ PopTree[];  tb[node].son[1] _ PopTree[];
	v _ [subtree[index: node]];
	END;
    RETURN
    END;

  ExpandThread: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
    BEGIN
    IF ~copying
      THEN
	BEGIN
	tb[node].son[1] _ ExpandTree[tb[node].son[1]];  v _ [subtree[node]];
	END
      ELSE
	BEGIN
	PushTree[ExpandTree[tb[node].son[1]]];  PushTree[Tree.Null];
	PushNode[thread, 2];  SetInfo[tb[node].info];  v _ PopTree[];
	END;
    RETURN
    END;

  UpdateReturn: PROCEDURE [node: Tree.Index] =
    BEGIN
    typeOut: RecordSEIndex;
    sei: ISEIndex;
    n: CARDINAL;
    IF tb[node].son[1] = Tree.Null AND
     (typeOut_TransferTypes[bb[currentMaster].ioType].typeOut) # RecordSENull
      THEN
	BEGIN
	n _ 0;
	FOR sei _ FirstCtxSe[seb[typeOut].fieldCtx], NextSe[sei] UNTIL sei = ISENull
	  DO  PushTree[ExpandSei[sei]];  n _ n+1  ENDLOOP;
	tb[node].son[1] _ MakeList[n];
	END;
    tb[node].name _ result;
    END;


  ExpandDecls: Tree.Map =
    BEGIN
    n: CARDINAL;

    ExpandDecl: Tree.Scan =
      BEGIN
      node: Tree.Index;

      LinkDecl: Tree.Scan =
	BEGIN
	sei: ISEIndex;
	WITH t SELECT FROM
	  symbol =>
	    BEGIN  sei _ index;
	    seb[sei].idValue _ node;
	    IF ~seb[sei].mark4 AND tb[node].son[3] = Tree.Null
	      THEN  seb[sei].idInfo _ seb[sei].idInfo - 1;
	    END;
	  ENDCASE;
	END;

      copy: Tree.Link;
      IF ~TestTree[t, typedecl] THEN
	BEGIN
	PushTree[copy _ ExpandTree[t]];  n _ n+1;
	node _ GetNode[copy];
	ScanList[tb[node].son[1], LinkDecl];
	END;
      END;

    IF ~copying
      THEN  v _ ExpandTree[t]
      ELSE  BEGIN  n _ 0;  ScanList[t, ExpandDecl];  v _ MakeList[n]  END;
    RETURN
    END;


  SharingItem: TYPE = RECORD [old, new: Tree.Link, next: SharingList];
  SharingList: TYPE = POINTER TO SharingItem;

  sharingMap: SharingList;

  MapShared: PROCEDURE [t, v: Tree.Link] =
    BEGIN
    p: SharingList _ SystemDefs.AllocateHeapNode[SIZE[SharingItem]];
    p^ _ [old:t, new:v, next:sharingMap];  sharingMap _ p;
    SetShared[v, TRUE];
    END;

  ExpandShared: PROCEDURE [node: Tree.Index] RETURNS [v: Tree.Link] =
    BEGIN
    p: SharingList;

    UpdateCount: Tree.Map =
      BEGIN
      WITH t SELECT FROM
	symbol =>  IncrCount[index];
	subtree =>  [] _ UpdateTree[t, UpdateCount];
	ENDCASE =>  NULL;
      RETURN [t]
      END;

    t: Tree.Link = [subtree[index: node]];
    FOR p _ sharingMap, p.next UNTIL p = NIL
      DO
      IF p.old = t THEN GO TO Found;
      REPEAT
	Found =>  v _ p.new;
	FINISHED =>  v _ t;
      ENDLOOP;
    IF copying THEN [] _ UpdateCount[v];  RETURN
    END;

  ResetSharing: PROCEDURE =
    BEGIN
    p: SharingList;
    UNTIL sharingMap = NIL
      DO
      p _ sharingMap;  sharingMap _ sharingMap.next;
      SystemDefs.FreeHeapNode[p];
      ENDLOOP;
    END;


  ExpandOpens: Tree.Map =
    BEGIN
    n: CARDINAL;

    UpdateOpen: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      base: Tree.Link;
      tb[node].son[1] _ ExpandTree[tb[node].son[1]];
      IF ~Shared[base _ tb[node].son[2]]
	THEN  tb[node].son[2] _ ExpandTree[base]
	ELSE
	  BEGIN
	  SetShared[base, FALSE];  base _ ExpandTree[base];
	  SetShared[base, TRUE];  tb[node].son[2] _ base;
	  END;
      END;

    ExpandOpen: Tree.Scan =
      BEGIN
      node: Tree.Index = GetNode[t];
      base: Tree.Link = tb[node].son[2];
      copy: Tree.Link;
      PushTree[ExpandTree[tb[node].son[1]]];
      IF ~Shared[base]
	THEN  PushTree[ExpandTree[base]]
	ELSE
	  BEGIN
	  SetShared[base, FALSE];  PushTree[copy _ ExpandTree[base]];
	  SetShared[base, TRUE];  MapShared[base, copy];
	  END;
      PushNode[item, 2];  SetInfo[tb[node].info];  n _ n+1;
      END;

    IF ~copying
      THEN  BEGIN  ScanList[t, UpdateOpen];  v _ t  END
      ELSE  BEGIN  n _ 0;  ScanList[t, ExpandOpen];  v _ MakeList[n]  END;
    RETURN
    END;


 -- blocks and bodies

  FindBlock: PROCEDURE [t: Tree.Link] RETURNS [node: Tree.Index] =
    BEGIN
      DO
      node _ GetNode[t];
      SELECT tb[node].name FROM
	list =>  t _ ListTail[t];
	block =>  EXIT;
	open, enable =>  t _ tb[node].son[2];
	lock =>  t _ tb[node].son[1];
	ENDCASE => ERROR;
      ENDLOOP;
    RETURN
    END;

  EnterBlock: PROCEDURE [node: Tree.Index, extendedScope: BOOLEAN] =
    BEGIN
    oldBti: BTIndex = tb[node].info;
    oldCtx: CTXIndex = bb[oldBti].localCtx;
    newBti: BTIndex;
    newCtx: CTXIndex;
    newCtx _ SELECT TRUE FROM
      ~extendedScope =>  MapBlock[node],
      oldCtx = CTXNull, ~copying =>  oldCtx,
      aStack = NIL OR aStack.ctx # oldCtx => ERROR,
      ENDCASE =>  ImageContext[aStack];
    newBti _ MakeEnclosingBody[IF copying THEN BTNull ELSE oldBti, newCtx];
    END;

  MapBlock: PROCEDURE [node: Tree.Index] RETURNS [newCtx: CTXIndex] =
    BEGIN
    oldBti: BTIndex = tb[node].info;
    oldCtx: CTXIndex = bb[oldBti].localCtx;
    seChain: ISEIndex;
    SELECT TRUE FROM
      oldCtx = CTXNull =>
	newCtx _ CTXNull;
      ~copying =>
	BEGIN
	newCtx _ oldCtx;  ctxb[newCtx].level _ bb[currentEnclosing].level;
	END;
      ENDCASE =>
	BEGIN
	newCtx _ NewCtx[bb[currentEnclosing].level];
	seChain _ MakeSeChain[newCtx, CtxVars[oldCtx], FALSE];
	AppendSeChain[newCtx, seChain];
	MapIds[oldCtx, seChain, 0];
	END;
    RETURN
    END;

  ImageContext: PROCEDURE [aLink: AList] RETURNS [CTXIndex] =
    BEGIN
    RETURN [IF aLink.nItems = 0
      THEN  CTXNull
      ELSE  WITH aLink.map[0].val SELECT FROM
	symbol => seb[index].idCtx,
	ENDCASE => ERROR]
    END;


  ExitBlock: PROCEDURE [node: Tree.Index] =
    BEGIN
    oldBti: BTIndex = tb[node].info;
    newBti: BTIndex = currentEnclosing;
    tb[node].info _ newBti;
    WITH body: bb[newBti].info SELECT FROM
      Internal =>  body.bodyTree _ node;
      ENDCASE;
    IF copying AND bb[oldBti].localCtx # CTXNull THEN UnmapIds[explicit];
    currentEnclosing _ ParentBti[currentEnclosing];
    END;

  MakeEnclosingBody: PROCEDURE [oldBti: BTIndex, ctx: CTXIndex] RETURNS [newBti: BTIndex] =
    BEGIN
    newSon: BTIndex;
    IF oldBti = BTNull
      THEN
	BEGIN
	newBti _ Table.Allocate[bodyType, SIZE[Other BodyRecord]];
	newSon _ BTNull;
	END
      ELSE
	BEGIN
	newSon _ bb[oldBti].firstSon;  DelinkBti[oldBti];  newBti _ oldBti;
	END;
    bb[newBti] _ BodyRecord[
	link: ,
	firstSon: newSon,
	localCtx: ctx,
	level: bb[currentEnclosing].level,
	info: BodyInfo[Internal[
	  bodyTree: Tree.NullIndex,
	  sourceIndex: ,
	  thread: Tree.NullIndex,
	  frameSize: ]],
	extension: Other[]];
    LinkBti[bti: newBti, parent: currentEnclosing];
    currentEnclosing _ newBti;
    RETURN
    END;


  EnterBody: PROCEDURE [node: Tree.Index] = 
    BEGIN
    oldBti: CBTIndex = tb[node].info;
    newBti: CBTIndex;
    type: CSEIndex;
    level: ContextLevel = NextLevel[bb[currentEnclosing].level
       !StaticNestError => BEGIN Log.Error[staticNesting]; RESUME END];

    SetArgLevel: PROCEDURE [sei: RecordSEIndex] =
      BEGIN
      IF sei # RecordSENull THEN ctxb[seb[sei].fieldCtx].level _ level;
      END;

    bodyNesting _ bodyNesting + 1;
    IF ~copying THEN DelinkBti[oldBti];
    IF ~copying AND (bb[oldBti].level > lL) = (level > lL)
      THEN  BEGIN  newBti _ oldBti;  type _ bb[oldBti].ioType  END
      ELSE
	BEGIN
	id: ISEIndex;
	ctx: CTXIndex;
	IF level > lL
	  THEN
	    BEGIN
	    newBti _Table.Allocate[bodyType, SIZE[Inner Callable BodyRecord]];
	    bb[newBti] _ [,,,,, Callable[,,,,,,,,,, Inner[frameOffset: ]]];
	    END
	  ELSE
	    BEGIN
	    newBti _Table.Allocate[bodyType, SIZE[Outer Callable BodyRecord]];
	    bb[newBti] _ [,,,,, Callable[,,,,,,,,,, Outer[]]];
	    END;
	IF ~copying
	  THEN
	    BEGIN
	    id _ bb[oldBti].id;  type _ bb[oldBti].ioType;
	    ctx _ bb[oldBti].localCtx;  ctxb[ctx].level _ level;
	    bb[newBti].firstSon _ bb[oldBti].firstSon;
	    END
	  ELSE
	    BEGIN
	    oldCtx: CTXIndex;
	    IF (id _ bb[oldBti].id) # ISENull THEN
	      id _ SearchContext[seb[id].hash, bb[currentEnclosing].localCtx];
	    type _ Copier.CopyXferType[bb[oldBti].ioType];
	    MapFormals[oldType: bb[oldBti].ioType, newType: type];
	    IF (oldCtx _ bb[oldBti].localCtx) = CTXNull
	      THEN  ctx _ CTXNull
	      ELSE
		BEGIN
		ctx _ NewCtx[level];
		ctxb[ctx].seList _ MakeSeChain[ctx, CtxVars[oldCtx], FALSE];
		MapIds[oldCtx, ctxb[ctx].seList, 0];
		END;
	    bb[newBti].firstSon _ BTNull;
	    dataPtr.nBodies _ dataPtr.nBodies+1;
	    END;
	bb[newBti].localCtx _ ctx;
	bb[newBti].info _ bb[oldBti].info;
	bb[newBti].inline _ bb[oldBti].inline;
	bb[newBti].resident _ bb[oldBti].resident;
	bb[newBti].id _ id;
	bb[newBti].ioType _ type;
	bb[newBti].monitored _ bb[oldBti].monitored;
	bb[newBti].stopping _ bb[oldBti].stopping;
	bb[newBti].entry _ bb[oldBti].entry;
	bb[newBti].internal _ bb[oldBti].internal;
	bb[newBti].hints _ bb[oldBti].hints;
	END;
    bb[newBti].level _ level;
    WITH seb[type] SELECT FROM
      transfer =>
	BEGIN SetArgLevel[inRecord]; SetArgLevel[outRecord] END;
      ENDCASE;
    LinkBti[bti: newBti, parent: currentEnclosing];
    currentEnclosing _ newBti;
    END;

  ExitBody: PROCEDURE [node: Tree.Index] =
    BEGIN
    newBti: CBTIndex = LOOPHOLE[currentEnclosing];
    ExitBlock[node];
    IF copying THEN UnmapFormals[bb[newBti].ioType];
    bodyNesting _ bodyNesting - 1;
    END;


  UpdateBodyNesting: PROCEDURE [list: Tree.Link, newBti: BTIndex] =
    BEGIN
    oldBti: BTIndex = ParentBti[newBti];

    UpdateLinks: Tree.Map =
      BEGIN
      node: Tree.Index;
      WITH t SELECT FROM
	subtree =>
	  BEGIN  node _ index;
	  SELECT tb[node].name FROM
	    block =>
	      BEGIN
	      bti: BTIndex = tb[node].info;
	      IF ParentBti[bti] = oldBti
	        THEN  BEGIN  DelinkBti[bti];  LinkBti[bti, newBti]  END;
	      v _ t;
	      END;
	    thread =>
	      BEGIN
	      IF tb[node].info = oldBti THEN tb[node].info _ newBti;
	      tb[node].son[1] _ UpdateTree[tb[node].son[1], UpdateLinks];
	      v _ t;
	      END;
	    ENDCASE =>  v _ UpdateTree[t, UpdateLinks];
	  END;
	ENDCASE =>  v _ t;
      END;

    UpdateItem: Tree.Scan =
      BEGIN
      node: Tree.Index;
      WITH t SELECT FROM
	subtree =>
	  BEGIN  node _ index;
	  IF tb[node].name = assign
	    THEN  tb[node].son[2] _ UpdateTree[tb[node].son[2], UpdateLinks];
	  END;
	ENDCASE;
      END;

    ScanList[list, UpdateItem];
    END;


 -- id translation

  AppendSeChain: PROCEDURE [ctx: CTXIndex, chain: ISEIndex] =
    BEGIN
    last, next: ISEIndex;
    SELECT TRUE FROM
      chain = ISENull =>  NULL;
      (last _ ctxb[ctx].seList) = ISENull =>  ctxb[ctx].seList _ chain;
      ENDCASE =>
	BEGIN
	UNTIL (next _ NextSe[last]) = ISENull DO last _ next ENDLOOP;
	SetSeLink[last, chain];
	END;
    END;

  CtxVars: PROCEDURE [ctx: CTXIndex] RETURNS [n: CARDINAL] =
    BEGIN
    sei: ISEIndex;
    n _ 0;
    FOR sei _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull
      DO
      IF seb[sei].idType # typeTYPE THEN n _ n+1;
      ENDLOOP;
    RETURN
    END;

  AllocateAList: PROCEDURE [ctx: CTXIndex] RETURNS [aLink: AList] =
    BEGIN
    maxItems: CARDINAL = CtxEntries[ctx];
    aLink _ SystemDefs.AllocateHeapNode[SIZE[ANode] + maxItems*SIZE[AItem]];
    aLink^ _ [next:NIL, ctx:ctx, nItems:0, map:];
    END;
 
  FreeAList: PROCEDURE [aLink: AList] = SystemDefs.FreeHeapNode;


 -- mapping

  MapArgs: PROCEDURE [formalCtx: CTXIndex, node: Tree.Index] RETURNS [nAssigns: CARDINAL] =
    BEGIN
    nVars: CARDINAL;
    seChain: ISEIndex;
    sei1, sei2: ISEIndex;
    aLink: AList;

    MapArg: Tree.Map =
      BEGIN
      name: BOOLEAN;
      val: Tree.Link;
      IF sei1 = ISENull
	THEN  v _ t
	ELSE
	  BEGIN
	  IF TestTree[t, safen]
	    THEN
	      BEGIN
	      node: Tree.Index _ GetNode[t];
	      t _ tb[node].son[1];
	      tb[node].son[1] _ Tree.Null; FreeNode[node];
	      END;
	  IF NameSafe[sei1, t]
	    THEN  BEGIN  name _ TRUE;  val _ t  END
	    ELSE
	      BEGIN
	      Copier.CopyArgSe[sei2, sei1];
	      IF seb[sei2].mark4 THEN seb[sei2].idValue _ Tree.NullIndex;
	      seb[sei2].mark4 _ FALSE;  seb[sei2].idInfo _  0;
	      name _ FALSE;  val _ [symbol[index: sei2]];
	      IF t # Tree.Null THEN
		BEGIN
		PushTree[val];  PushTree[t];
		PushNode[assign, 2];  SetInfo[dataPtr.textIndex];
		IncrCount[sei2];  nAssigns _ nAssigns + 1;
		END;
	      sei2 _ NextSe[sei2];
	      END;
	  aLink.map[aLink.nItems] _ [id: sei1, name: name, val: val];
	  aLink.nItems _ aLink.nItems + 1;
	  sei1 _ NextSe[sei1];  v _ Tree.Null;
	  END;
      RETURN
      END;

    aLink _ AllocateAList[formalCtx];
    IF (nVars _ CountVars[formalCtx, tb[node].son[2]]) = 0
      THEN  seChain _ ISENull
      ELSE
	BEGIN
	IF copyCtx = CTXNull
	  THEN copyCtx _ NewCtx[bb[currentEnclosing].level];
	seChain _ MakeSeChain[copyCtx, nVars, TRUE];
	AppendSeChain[copyCtx, seChain];
	END;
    sei1 _ FirstCtxSe[formalCtx];  sei2 _ seChain;  nAssigns _ 0;
    tb[node].son[2] _ UpdateList[tb[node].son[2], MapArg];
    PushAList[aLink];
    RETURN
    END;

  MapIds: PROCEDURE [ctx: CTXIndex, chain: ISEIndex, nRefs: [0..1]] =
    BEGIN
    sei1, sei2: ISEIndex;
    aLink: AList = AllocateAList[ctx];
    sei1 _ FirstCtxSe[ctx];  sei2 _ chain;
    UNTIL sei1 = ISENull
      DO
      IF seb[sei1].idType # typeTYPE THEN
	BEGIN
	Copier.CopyArgSe[sei2, sei1];
	IF seb[sei2].mark4 THEN seb[sei2].idValue _ Tree.NullIndex;
	seb[sei2].idInfo _  nRefs;
	aLink.map[aLink.nItems] _
	  [id: sei1, name: FALSE, val: [symbol[index:sei2]]];
	aLink.nItems _ aLink.nItems + 1;
	sei2 _ NextSe[sei2];
	END;
      sei1 _ NextSe[sei1];
      ENDLOOP;
    PushAList[aLink];
    END;

  UnmapIds: PROCEDURE [decl: {implicit, explicit}] =
    BEGIN
    i: CARDINAL;
    aLink: AList _ PopAList[];
    FOR i IN [0..aLink.nItems)
      DO
      WITH aLink.map[i].val SELECT FROM
	symbol =>
	  IF decl = implicit AND ~aLink.map[i].name
	    THEN seb[index].mark4 _ TRUE;
	ENDCASE;
      aLink.map[i].val _ FreeTree[aLink.map[i].val];
      ENDLOOP;
    FreeAList[aLink];
    END;


  MapFields: PROCEDURE [oldRecord, newRecord: RecordSEIndex, nRefs: [0..1]] =
    BEGIN
    sei1, sei2: ISEIndex;
    aLink: AList;
    IF oldRecord # RecordSENull THEN
      BEGIN
      aLink _ AllocateAList[seb[oldRecord].fieldCtx];
      sei1 _ FirstCtxSe[seb[oldRecord].fieldCtx];
      sei2 _ FirstCtxSe[seb[newRecord].fieldCtx];
      UNTIL sei1 = ISENull
	DO
	seb[sei2].idInfo _  nRefs;
	aLink.map[aLink.nItems] _
	    [id: sei1, name: FALSE, val: [symbol[index:sei2]]];
	aLink.nItems _ aLink.nItems + 1;
	sei1 _ NextSe[sei1];  sei2 _ NextSe[sei2];
	ENDLOOP;
      PushAList[aLink];
      END;
    END;

  MapFormals: PROCEDURE [oldType, newType: CSEIndex] =
    BEGIN
    WITH new: seb[newType] SELECT FROM
      transfer =>
	WITH old: seb[oldType] SELECT FROM
	  transfer =>
	    BEGIN
	    MapFields[old.inRecord, new.inRecord, 1];
	    MapFields[old.outRecord, new.outRecord, 0];
	    END;
	  ENDCASE => ERROR;
      ENDCASE;
    END;

  UnmapFormals: PROCEDURE [type: CSEIndex] =
    BEGIN
    WITH seb[type] SELECT FROM
      transfer =>
	BEGIN
	IF outRecord # RecordSENull THEN UnmapIds[implicit];
	IF inRecord # RecordSENull THEN UnmapIds[implicit];
	END;
      ENDCASE;
    END;


 -- association lists

  PushAList: PROCEDURE [aLink: AList] =
    BEGIN
    aLink.next _ aStack;  aStack _ aLink;
    END;

  PopAList: PROCEDURE RETURNS [aLink: AList] =
    BEGIN
    IF aStack = NIL THEN ERROR;
    aLink _ aStack;  aStack _ aLink.next;
    END;

  ExpandSei: PROCEDURE [sei: ISEIndex] RETURNS [v: Tree.Link] =
    BEGIN
    aLink: AList;
    i: CARDINAL;
    FOR aLink _ aStack, aLink.next UNTIL aLink = NIL
      DO
      IF seb[sei].idCtx = aLink.ctx THEN
	FOR i IN [0 .. aLink.nItems)
	  DO
	  IF aLink.map[i].id = sei THEN GO TO Found;
	  ENDLOOP;
      REPEAT
	Found =>
	  BEGIN
	  saveCopying: BOOLEAN = copying;
	  copying _ TRUE;  v _ ExpandTree[aLink.map[i].val];
	  copying _ saveCopying;
	  END;
	FINISHED =>
	  BEGIN
	  IF copying THEN IncrCount[sei];
	  v _ [symbol[index:sei]];
	  END;
      ENDLOOP;
    RETURN
    END;

  IncrCount: PROCEDURE [sei: ISEIndex] =	-- modified BumpCount (Pass3I)
    BEGIN
    ctx: CTXIndex;
    IF seb[sei].idType # typeTYPE AND
     (~seb[sei].mark4
	OR (~seb[sei].constant
		AND (ctx _ seb[sei].idCtx) ~IN StandardContext
		AND ctxb[ctx].ctxType # included))
      THEN  seb[sei].idInfo _ seb[sei].idInfo + 1;
    END;


 -- nested calls

  ThreadSubst: PROCEDURE [sNode, dNode: Tree.Index] =
    BEGIN
    sThread, dThread: Tree.Index;
    dThread _ GetNode[tb[dNode].son[1]];
    IF sNode # Tree.NullIndex AND sNode # dNode THEN
      BEGIN
	DO
	sThread _ GetNode[tb[sNode].son[1]];
	IF tb[sThread].son[2] = Tree.Null THEN EXIT;
	sNode _ GetNode[tb[sThread].son[2]];
	ENDLOOP;
      tb[sThread].son[2] _ [subtree[index: dNode]];
      tb[dThread].son[2] _ Tree.Null;
      END;
    tb[dThread].info _ currentEnclosing;
    END;

  END.