
    <<Pass3P.mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 18, 1986 12:24:03 pm PDT>>
        <<Paul Rovner, September 7, 1983 4:47 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 10:48:35 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Notifier, AddNotify, DropNotify, Top, Words],
        ComData: TYPE USING [defBodyLimit, interface, nBodies, nInnerBodies, table, textIndex],
        CompilerUtil: TYPE USING [],
        Log: TYPE USING [Error, ErrorSei],
        SourceMap: TYPE USING [Loc, nullLoc, Down, Up],
        Symbols: TYPE USING [Base, BodyInfo, BodyRecord, ContextLevel, SERecord, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, BTIndex, 
        CBTIndex, nullName, ISENull, RecordSENull, CTXNull, BTNull, lL, lZ, RootBti, typeTYPE, seType, ctxType, mdType, bodyType],
        SymbolOps: TYPE USING [ArgCtx, CopyArgSe, CopyXferType, CtxEntries, CtxLevel, DecodeCard, DelinkBti, EncodeCard, EncodeTreeIndex, 
        FindExtension, FirstCtxSe, FromBti, FromType, LinkBti, MakeNonCtxSe, MakeSeChain, NewCtx, NextLevel, NextSe, ParentBti, 
        SetCtxLevel, SetSeLink, SearchContext, ToBti, TransferTypes, StaticNestError],
        Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, nullIndex, treeType],
        TreeOps: TYPE USING [CopyTree, FreeNode, FreeTree, FromLoc, GetNode, GetTag, ListTail, MakeList, MarkShared, NthSon, OpName, 
        PopTree, PushList, PushNode, PushTree, ScanList, ScanSons, SetAttr, SetInfo, Shared, ToLoc, UpdateList, UpdateLeaves];

    Pass3P: PROGRAM
        IMPORTS Alloc, Log, SourceMap, SymbolOps, TreeOps, dataPtr: ComData
        EXPORTS CompilerUtil = {
        OPEN TreeOps, SymbolOps, Symbols;

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

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


    <<driver>>

        P3Postlude: PUBLIC PROC[expand: BOOL] = {
            (dataPtr.table).AddNotify[PostNotify];
            IF expand THEN {LinkImportedBodies[]; ExpandInlines[RootBti]};
            (dataPtr.table).DropNotify[PostNotify]};


    <<included body copying>>

        LinkImportedBodies: PROC = {
            next: BTIndex;
            btLimit: BTIndex = (dataPtr.table).Top[bodyType];
            FOR bti: BTIndex _ RootBti + dataPtr.defBodyLimit, next UNTIL bti = btLimit DO
                WITH body: bb[bti] SELECT FROM
                    Callable => {
                        IF body.inline THEN {body.link _ bb[RootBti].link; bb[RootBti].link _ [sibling, bti]};
                        next _ bti + (SELECT body.nesting FROM
                            Inner => BodyRecord.Callable.Inner.SIZE,
                            ENDCASE => BodyRecord.Callable.Outer.SIZE)};
                    ENDCASE => next _ bti + BodyRecord.Other.SIZE;
                ENDLOOP};


    <<inline expansion>>

        <<state information>>

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

            aStack: AList;    -- current association list

            AItem: TYPE = RECORD [id: ISEIndex, name: BOOL, val: Tree.Link];
            ANode: TYPE = RECORD [
                next: AList,
                ctx: CTXIndex,
                nItems: CARDINAL,
                map: SEQUENCE maxItems: CARDINAL OF AItem];
            AList: TYPE = REF ANode;


    <<overall control>>

        ExpandInlines: PROC[rootBti: BTIndex] = {
            bti: BTIndex _ rootBti;
            aStack _ NIL;  sharingMap _ NIL;
            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};

        ExpandCalls: PROC[bti: CBTIndex] = {
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            sei: ISEIndex = bb[bti].id;
            current, subNode: Tree.Index;
            dataPtr.textIndex _ SourceMap.Up[bb[bti].sourceIndex];
            WITH body: bb[bti].info SELECT FROM
                Internal => {
                    currentMaster _ bti;
                    IF seb[sei].mark4 THEN {
                        t: Tree.Link = FindExtension[sei].tree;
                        ComputeArgCounts[bb[bti].ioType, t];
                        masterBody _ GetNode[t]}
                    ELSE masterBody _ body.bodyTree;
                    copying _ TRUE;
                    UNTIL (current _ body.thread) = Tree.nullIndex DO
                        discard: BOOL;
                        <<process the thread (son[1])>>
                            subNode _ GetNode[tb[current].son[1]];
                            discard _ tb[subNode].attr1;
                            tb[current].son[1] _ tb[subNode].son[1];
                            currentEnclosing _ ToBti[tb[subNode].info];
                            body.thread _ GetNode[tb[subNode].son[2]];
                            tb[subNode].son[1] _ tb[subNode].son[2] _ Tree.Null;
                            FreeNode[subNode];
                            tb[current].shared _ FALSE;
                        IF body.thread = Tree.nullIndex
                            AND (~dataPtr.interface OR bb[bti].level > lL) THEN copying _ FALSE;
                        SELECT TRUE FROM
                            discard => DiscardCall[current];
                            ~RecursiveSubst[bti, currentEnclosing] => ExpandCall[current]
                            ENDCASE => Log.ErrorSei[recursiveInline, bb[bti].id];
                        ENDLOOP};
                ENDCASE => ERROR;
            dataPtr.textIndex _ saveIndex};

        DiscardCall: PROC[node: Tree.Index] = INLINE {    -- orphan subtree
            [] _ DiscardTree[[subtree[node]]]};

        ExpandCall: PROC[node: Tree.Index] = {
            typeIn, typeOut: RecordSEIndex;
            masterCtx: CTXIndex = bb[currentMaster].localCtx;
            formalCtx: CTXIndex;
            seChain, saveChain: ISEIndex;
            nAssigns, nVars: CARDINAL;
            extendedScope: BOOL;
            newBti: BTIndex;
            t: Tree.Link;
            IF tb[node].name = call THEN dataPtr.textIndex _ ToLoc[tb[node].info];
            bodyNesting _ 0;
            IF copying OR masterCtx = CTXNull THEN copyCtx _ CTXNull
            ELSE {
                saveChain _ ctxb[masterCtx].seList; ctxb[masterCtx].seList _ ISENull;
                SetCtxLevel[masterCtx, bb[currentEnclosing].level];
                copyCtx _ masterCtx};
            [typeIn, typeOut] _ TransferTypes[bb[currentMaster].ioType];
            substSafe _ tb[node].attr3 AND bb[currentMaster].hints.nameSafe;
            nAssigns _ SELECT TRUE FROM
                (typeIn = RecordSENull) => 0,
                tb[node].attr1 => ExtractArgs[typeIn, seb[typeIn].fieldCtx, node],
                ENDCASE => MapArgs[seb[typeIn].fieldCtx, node];
            tb[node].son[2] _ FreeTree[tb[node].son[2]];
            IF RequiredFields[typeOut] THEN {
                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]};
            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 {
                IF copyCtx = CTXNull THEN copyCtx _ NewCtx[bb[currentEnclosing].level];
                seChain _ MakeSeChain[copyCtx, nVars, FALSE];
                MapIds[masterCtx, seChain, 0];
                AppendSeChain[copyCtx, seChain]};
            <<expand the body>>
                IF copyCtx # CTXNull THEN newBti _ MakeEnclosingBody[copyCtx];
                t _ ExpandDecls[tb[masterBody].son[2]];
                PushTree[ExpandTree[tb[masterBody].son[3]]];
                IF copyCtx = CTXNull THEN extendedScope _ FALSE
                ELSE {
                    extendedScope _ nAssigns # 0 OR tb[masterBody].son[1] # Tree.Null
                        OR tb[masterBody].son[4] # Tree.Null;
                    PushTree[t];  PushNode[block, -2];
                    SetInfo[FromBti[newBti]];  SetAttr[3, extendedScope];
                    SetAttr[1, tb[masterBody].attr1]; SetAttr[2, tb[masterBody].attr2];
                    WITH body: bb[newBti].info SELECT FROM
                        Internal => {body.bodyTree _ GetNode[t_PopTree[]]; PushTree[t]};
                        ENDCASE => ERROR};
                IF tb[masterBody].son[1] # Tree.Null THEN {
                    PushNode[open, 2];  SetInfo[FromLoc[dataPtr.textIndex]]};
                IF tb[masterBody].son[4] # Tree.Null THEN {
                    PushTree[ExpandTree[tb[masterBody].son[4]]];
                    PushNode[lock, 2];  SetInfo[FromLoc[dataPtr.textIndex]]};
                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 {
                    PushTree[tb[node].son[3]];  tb[node].son[3] _ Tree.Null;
                    PushNode[enable, -2];  SetInfo[FromLoc[dataPtr.textIndex]]; SetAttr[3, TRUE]};
                IF RequiredFields[typeOut] 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].attr1 _ tb[masterBody].attr1; tb[node].attr2 _ tb[masterBody].attr2;
                tb[node].attr3 _ extendedScope;
                sharingMap _ NIL
            };

        RecursiveSubst: PROC[bti, parent: BTIndex] RETURNS[BOOL] = {
            UNTIL parent = BTNull DO
                IF bti = parent THEN RETURN[TRUE];
                parent _ ParentBti[parent];
                ENDLOOP;
            RETURN[FALSE]};

        PruneBody: PROC[node: Tree.Index] = {
            OPEN tb[node];
            son[1] _ son[2] _ son[3] _ son[4] _ Tree.Null;  name _ procinit};


    <<argument list testing/processing>>

        NameSafe: PROC[t: Tree.Link] RETURNS[safe: BOOL] = {
            RETURN[~bb[currentMaster].hints.argUpdated AND
                (substSafe OR
                    (WITH t SELECT GetTag[t] FROM
                        symbol => seb[index].immutable,
                        literal => TRUE,
                        ENDCASE =>
                            SELECT OpName[t] FROM
                                IN [relE..relLE], IN [plus..mod] =>
                                    NameSafe[NthSon[t, 1]] AND NameSafe[NthSon[t, 2]],
                                not, uminus, abs, pred, succ => NameSafe[NthSon[t, 1]],
                                loophole, cast, check, lengthen, shorten, float => NameSafe[NthSon[t, 1]],
                                clit, llit, mwconst, nil, atom => TRUE,
                                cdot => NameSafe[NthSon[t, 2]],
                                ENDCASE => FALSE))]
            };

        VarRefs: PROC[sei: ISEIndex] RETURNS[CARDINAL] = INLINE {
            RETURN[DecodeCard[seb[sei].idInfo]]};

        CheapEval: PROC[t: Tree.Link, top: BOOL_TRUE] RETURNS[BOOL] = {
            RETURN[WITH t SELECT GetTag[t] FROM
                subtree => 
                    SELECT OpName[t] FROM
                        clit, llit, mwconst, nil, atom => TRUE,
                        loophole, cast, openx => CheapEval[NthSon[t, 1], top],
                        addr, uparrow, dot, dollar => CheapEval[NthSon[t, 1], top],
                        IN [index .. reloc] =>
                            CheapEval[NthSon[t, 1], FALSE] AND CheapEval[NthSon[t, 2], FALSE],
                        IN [or .. mod] =>
                            top AND CheapEval[NthSon[t, 1], FALSE]
                                AND CheapEval[NthSon[t, 2], FALSE],
                        not, uminus, abs, pred, succ, lengthen, shorten =>
                            top AND CheapEval[NthSon[t, 1], FALSE],
                        cdot => CheapEval[NthSon[t, 2], top],
                        ENDCASE => FALSE,
                ENDCASE => TRUE]};


        MapByName: PROC[sei: ISEIndex, t: Tree.Link] RETURNS[BOOL] = {
            n: CARDINAL = VarRefs[sei];
            RETURN[NameSafe[t] AND (n <= 2 OR CheapEval[t])]};


        CountVars: PROC[ctx: CTXIndex, t: Tree.Link] RETURNS[n: CARDINAL _ 0] = {
            sei: ISEIndex _ FirstCtxSe[ctx];

            CountVar: Tree.Scan = {
                IF sei # ISENull THEN {IF ~MapByName[sei, t] THEN n _ n+1; sei _ NextSe[sei]}};

            ScanList[t, CountVar];  RETURN};


        RequiredFields: PROC[rSei: RecordSEIndex] RETURNS[BOOL] = {
            FOR sei: ISEIndex _ FirstCtxSe[FieldCtx[rSei]], NextSe[sei] UNTIL sei = ISENull DO
                IF seb[sei].hash = nullName THEN RETURN[FALSE];
                IF DecodeCard[seb[sei].idInfo] # 0 THEN RETURN[TRUE];
                ENDLOOP;
            RETURN[FALSE]};


    <<tree manipulation>>

        DiscardTree: Tree.Map = {
            IF t # Tree.Null THEN
                WITH t SELECT GetTag[t] FROM
                    subtree => {
                        node: Tree.Index _ index;
                        SELECT tb[node].name FROM
                            call, callx =>
                                IF OpName[tb[node].son[1]] = thread THEN {
                                    <<mark for later discard (see DiscardCall)>>
                                    subNode: Tree.Index = GetNode[tb[node].son[1]];
                                    tb[subNode].attr1 _ TRUE}
                                ELSE {
                                    [] _ UpdateLeaves[t, DiscardTree]; FreeNode[node]};
                            ENDCASE =>
                                IF ~tb[node].shared THEN {
                                    [] _ UpdateLeaves[t, DiscardTree]; FreeNode[node]}};
                    ENDCASE;
            RETURN[Tree.Null]};

        ExpandTree: Tree.Map = {
            WITH t SELECT GetTag[t] FROM
                symbol => v _ ExpandSei[index];
                subtree => {
                    sNode: Tree.Index = index;
                    IF tb[sNode].shared THEN
                        v _ SELECT tb[sNode].name FROM
                            call, callx => ExpandThreadedCall[sNode],
                            ENDCASE => ExpandShared[sNode]
                    ELSE
                        SELECT tb[sNode].name FROM
                            body => v _ ExpandBody[sNode];
                            block => v _ ExpandBlock[sNode, tb[sNode].attr3];
                            ditem => v _ ExpandBlock[sNode, FALSE];
                            do => v _ ExpandDo[sNode];
                            open, bind, bindx => v _ ExpandBinding[sNode];
                            subst, substx => v _ ExpandSubst[sNode];
                            lock => v _ ExpandLock[sNode];
                            thread => v _ ExpandThread[sNode];
                            ENDCASE => {
                                v _ IF copying
                                    THEN CopyTree[[baseP:@tb, link:t], ExpandTree]
                                    ELSE UpdateLeaves[t, ExpandTree];
                                WITH v SELECT GetTag[v] FROM
                                    subtree => {
                                        dNode: Tree.Index = index;
                                        SELECT tb[dNode].name FROM
                                            return => IF bodyNesting = 0 THEN UpdateReturn[dNode];
                                            xerror => IF bodyNesting = 0 THEN tb[dNode].attr3 _ TRUE;
                                            ENDCASE => NULL};
                                    ENDCASE => NULL}};
                ENDCASE => v _ t;
            RETURN};


        RewriteNode: PROC[node: Tree.Index, nSons: CARDINAL] RETURNS[Tree.Link] = {
            FOR i: CARDINAL DECREASING IN [1 .. nSons] DO tb[node].son[i] _ PopTree[] ENDLOOP;
            RETURN[[subtree[index: node]]]};

        CopyNode: PROC[node: Tree.Index, nSons: CARDINAL] RETURNS[Tree.Link] = {
            PushNode[tb[node].name, nSons];  SetInfo[tb[node].info];
            SetAttr[1, tb[node].attr1]; SetAttr[2, tb[node].attr2]; SetAttr[3, tb[node].attr3];
            RETURN[PopTree[]]};

        ExpandBlock: PROC[node: Tree.Index, extendedScope: BOOL] RETURNS[v: Tree.Link] = {
            EnterBlock[node, extendedScope];
            PushTree[ExpandDecls[tb[node].son[1]]];
            PushTree[ExpandTree[tb[node].son[2]]];
            v _ IF copying THEN CopyNode[node, 2] ELSE RewriteNode[node, 2];
            ExitBlock[GetNode[v]];
            RETURN};

        ExpandBody: PROC[node: Tree.Index] RETURNS[v: Tree.Link] = {
            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]]];
            v _ IF copying THEN CopyNode[node, 4] ELSE RewriteNode[node, 4];
            ExitBody[GetNode[v]];
            RETURN};

        ExpandDo: PROC[node: Tree.Index] RETURNS[v: Tree.Link] = {
            decl: BOOL;
            subNode: Tree.Index;
            IF tb[node].son[1] = Tree.Null THEN decl _ FALSE
            ELSE {subNode _ GetNode[tb[node].son[1]]; decl _ OpName[tb[subNode].son[1]] = decl};
            IF decl THEN {
                nSons: CARDINAL = tb[subNode].nSons;
                EnterBlock[subNode, FALSE];
                PushTree[ExpandDecls[tb[subNode].son[1]]];
                FOR i: CARDINAL IN [2..nSons] DO PushTree[ExpandTree[tb[subNode].son[i]]] ENDLOOP;
                IF copying THEN {PushNode[tb[subNode].name, nSons];  SetInfo[tb[subNode].info]}
                ELSE PushTree[RewriteNode[subNode, nSons]]}
            ELSE PushTree[ExpandTree[tb[node].son[1]]];
            PushTree[ExpandTree[tb[node].son[2]]];
            PushTree[ExpandOpens[tb[node].son[3]]];
            FOR i: CARDINAL IN [4..6] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
            v _ IF copying THEN CopyNode[node, 6] ELSE RewriteNode[node, 6];
            IF decl THEN {
                newNode: Tree.Index = GetNode[v];
                ExitBlock[GetNode[tb[newNode].son[1]], newNode]};
            RETURN};

        ExpandBinding: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            nSons: CARDINAL = tb[node].nSons;
            PushTree[ExpandOpens[tb[node].son[1]]];
            FOR i: CARDINAL IN [2..nSons] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
            RETURN[IF copying THEN CopyNode[node, nSons] ELSE RewriteNode[node, nSons]]};

        ExpandSubst: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            extendedScope: BOOL = tb[node].attr3;
            PushTree[ExpandTree[tb[node].son[1]]];
            IF extendedScope THEN MapBlock[FindBlock[tb[node].son[2]]];
            PushTree[ExpandTree[tb[node].son[2]]];
            RETURN[IF copying THEN CopyNode[node, 2] ELSE RewriteNode[node, 2]]};

        ExpandThreadedCall: PROC[node: Tree.Index] RETURNS[v: Tree.Link] = {
            nSons: CARDINAL = tb[node].nSons;
            FOR i: CARDINAL IN [1 .. nSons] DO PushTree[ExpandTree[tb[node].son[i]]] ENDLOOP;
            v _ IF copying THEN CopyNode[node, nSons] ELSE RewriteNode[node, nSons];
            ThreadSubst[node, v];
            RETURN};

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


        ExpandLock: PROC[node: Tree.Index] RETURNS[v: Tree.Link] = {
            PushTree[ExpandTree[tb[node].son[2]]];
            PushTree[ExpandTree[tb[node].son[1]]];
            IF copying THEN {PushNode[lock, -2]; SetInfo[tb[node].info]; v _ PopTree[]}
            ELSE {
                tb[node].son[1] _ PopTree[];  tb[node].son[2] _ PopTree[];
                v _ [subtree[index: node]]};
            RETURN};

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


        ExpandDecls: Tree.Map = {
            n: CARDINAL;

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

                LinkDecl: Tree.Scan = {
                    WITH t SELECT GetTag[t] FROM
                        symbol => {
                            sei: ISEIndex = index;
                            seb[sei].idValue _ EncodeTreeIndex[node];
                            IF ~seb[sei].mark4 AND tb[node].son[3] = Tree.Null AND ~seb[sei].immutable THEN
                                seb[sei].idInfo _ EncodeCard[DecodeCard[seb[sei].idInfo] - 1]};
                        ENDCASE};

                copy: Tree.Link;
                IF OpName[t] # typedecl THEN {
                    PushTree[copy _ ExpandTree[t]];  n _ n+1;
                    node _ GetNode[copy];
                    ScanList[tb[node].son[1], LinkDecl]}};

            IF OpName[t] = initlist THEN {
                node: Tree.Index = GetNode[t];
                PushTree[ExpandTree[tb[node].son[1]]];
                PushTree[ExpandDecls[tb[node].son[2]]];
                IF copying THEN {PushNode[initlist, 2];  SetInfo[tb[node].info];  v _ PopTree[]}
                ELSE v _ RewriteNode[node, 2]}
            ELSE
                IF copying THEN {n _ 0; ScanList[t, ExpandDecl]; v _ MakeList[n]}
                ELSE v _ ExpandTree[t];
            RETURN};


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

        sharingMap: SharingList;

        MapShared: PROC[t, v: Tree.Link] = {
            p: SharingList _ NEW[SharingItem];
            p^ _ [old:t, new:v, next:sharingMap];  sharingMap _ p;
            MarkShared[v, TRUE]};

        ExpandShared: PROC[node: Tree.Index] RETURNS[v: Tree.Link] = {
            target: Tree.Link = [subtree[index: node]];

            UpdateCount: Tree.Scan = {
                WITH t SELECT GetTag[t] FROM
                    symbol => IncrCount[index];
                    subtree => ScanSons[t, UpdateCount];
                    ENDCASE => NULL};

            FOR p: SharingList _ sharingMap, p.next UNTIL p = NIL DO
                IF p.old = target THEN GO TO Found;
                REPEAT
                    Found => v _ p.new;
                    FINISHED => v _ target;
                ENDLOOP;
            IF copying THEN UpdateCount[v];  RETURN};

        ExpandOpens: Tree.Map = {
            n: CARDINAL;

            UpdateOpen: Tree.Scan = {
                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 {
                    MarkShared[base, FALSE];  base _ ExpandTree[base];
                    MarkShared[base, TRUE];  tb[node].son[2] _ base}};

            ExpandOpen: Tree.Scan = {
                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 {
                    MarkShared[base, FALSE];  PushTree[copy _ ExpandTree[base]];
                    MarkShared[base, TRUE];  MapShared[base, copy]};
                PushNode[item, 2];  SetInfo[tb[node].info];  n _ n+1};

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


    <<blocks and bodies>>

        FindBlock: PROC[t: Tree.Link] RETURNS[node: Tree.Index] = {
            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};

        EnterBlock: PROC[node: Tree.Index, extendedScope: BOOL] = INLINE {
            IF ~extendedScope THEN MapBlock[node]};

        MapBlock: PROC[node: Tree.Index] = {
            oldBti: BTIndex = ToBti[tb[node].info];
            oldCtx: CTXIndex = bb[oldBti].localCtx;
            seChain: ISEIndex;
            newCtx: CTXIndex;
            SELECT TRUE FROM
                oldCtx = CTXNull => newCtx _ CTXNull;
                ~copying => {newCtx _ oldCtx;  SetCtxLevel[newCtx, bb[currentEnclosing].level]};
                ENDCASE => {
                    newCtx _ NewCtx[bb[currentEnclosing].level];
                    seChain _ MakeSeChain[newCtx, CtxVars[oldCtx], FALSE];
                    AppendSeChain[newCtx, seChain];
                    MapIds[oldCtx, seChain, 0]};
            [] _ MakeEnclosingBody[
                newCtx, bb[oldBti].sourceIndex, IF copying THEN BTNull ELSE oldBti];
            RETURN};


        ExitBlock: PROC[node: Tree.Index, bodyNode: Tree.Index _ Tree.nullIndex] = {
            oldBti: BTIndex = ToBti[tb[node].info];
            newBti: BTIndex = currentEnclosing;
            tb[node].info _ FromBti[newBti];
            WITH body: bb[newBti].info SELECT FROM
                Internal => body.bodyTree _ IF bodyNode = Tree.nullIndex THEN node ELSE bodyNode;
                ENDCASE;
            IF copying AND bb[oldBti].localCtx # CTXNull THEN UnmapIds[explicit];
            currentEnclosing _ ParentBti[currentEnclosing]};

        MakeEnclosingBody: PROC[
                ctx: CTXIndex, sourceIndex: CARDINAL_TRASH, oldBti: BTIndex_BTNull]
              RETURNS[newBti: BTIndex] = {
            newSon: BTIndex;
            IF oldBti = BTNull THEN {
                newBti _ (dataPtr.table).Words[bodyType, BodyRecord.Other.SIZE]; newSon _ BTNull}
            ELSE {newSon _ bb[oldBti].firstSon; DelinkBti[oldBti]; newBti _ oldBti};
            bb[newBti] _ BodyRecord[
                link: ,
                firstSon: newSon,
                type: BodyType[ctx],
                localCtx: ctx,  level: bb[currentEnclosing].level,
                sourceIndex: (IF bodyNesting = 0 THEN (SourceMap.nullLoc).Down ELSE sourceIndex),
                info: BodyInfo[Internal[
                    bodyTree: Tree.nullIndex,
                    thread: Tree.nullIndex,
                    frameSize: ]],
                extension: Other[relOffset: ]];
            LinkBti[bti: newBti, parent: currentEnclosing];
            currentEnclosing _ newBti;
            RETURN};


        EnterBody: PROC[node: Tree.Index] = { 
            oldBti: CBTIndex = LOOPHOLE[ToBti[tb[node].info]];
            newBti: CBTIndex;
            ioType: CSEIndex;
            type: RecordSEIndex;
            level: ContextLevel = NextLevel[bb[currentEnclosing].level
                ! StaticNestError => {Log.Error[staticNesting]; RESUME}];

            SetArgLevel: PROC[sei: CSEIndex] = {
                ctx: CTXIndex = ArgCtx[sei];
                IF ctx # CTXNull THEN SetCtxLevel[ctx, level]};

            ctx: CTXIndex;
            bodyNesting _ bodyNesting + 1;
            IF ~copying THEN DelinkBti[oldBti];
            IF ~copying AND (bb[oldBti].level > lL) = (level > lL) THEN {
                ctx _ bb[oldBti].localCtx;
                IF ctx # CTXNull THEN SetCtxLevel[ctx, level];
                ioType _ bb[oldBti].ioType; type _ bb[oldBti].type;
                newBti _ oldBti}
            ELSE {
                id: ISEIndex;
                IF level > lL THEN {
                    newBti _ (dataPtr.table).Words[bodyType, BodyRecord.Callable.Inner.SIZE];
                    bb[newBti] _ [,,,,,,, Callable[,,,,,,,,,, Inner[frameOffset: ]]]}
                ELSE {
                    newBti _ (dataPtr.table).Words[bodyType, BodyRecord.Callable.Outer.SIZE];
                    bb[newBti] _ [,,,,,,, Callable[,,,,,,,,,, Outer[]]]};
                IF ~copying THEN {
                    ctx _ bb[oldBti].localCtx;
                    IF ctx # CTXNull THEN SetCtxLevel[ctx, level];
                    id _ bb[oldBti].id;  ioType _ bb[oldBti].ioType;  type _ bb[oldBti].type;
                    bb[newBti].firstSon _ bb[oldBti].firstSon}
                ELSE {
                    oldCtx: CTXIndex;
                    IF (id _ bb[oldBti].id) # ISENull THEN
                        id _ SearchContext[seb[id].hash, bb[currentEnclosing].localCtx];
                    ioType _ CopyXferType[bb[oldBti].ioType, NIL];
                    MapFormals[oldType: bb[oldBti].ioType, newType: ioType];
                    IF (oldCtx _ bb[oldBti].localCtx) = CTXNull THEN ctx _ CTXNull
                    ELSE {
                        ctx _ NewCtx[level];
                        ctxb[ctx].seList _ MakeSeChain[ctx, CtxVars[oldCtx], FALSE];
                        MapIds[oldCtx, ctxb[ctx].seList, 0]};
                    type _ BodyType[ctx];
                    bb[newBti].firstSon _ BTNull;
                    dataPtr.nBodies _ dataPtr.nBodies+1;
                    IF level > lL THEN dataPtr.nInnerBodies _ dataPtr.nInnerBodies+1};
                bb[newBti].type _ type;
                bb[newBti].localCtx _ ctx;
                bb[newBti].sourceIndex _ bb[oldBti].sourceIndex;
                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 _ ioType;
                bb[newBti].monitored _ bb[oldBti].monitored;
                bb[newBti].entry _ bb[oldBti].entry; bb[newBti].internal _ bb[oldBti].internal;
                bb[newBti].noXfers _ bb[oldBti].noXfers;
                bb[newBti].hints _ bb[oldBti].hints};
            bb[newBti].level _ level;
            WITH t: seb[ioType] SELECT FROM
                transfer => {SetArgLevel[t.typeIn]; SetArgLevel[t.typeOut]};
                ENDCASE;
            LinkBti[bti: newBti, parent: currentEnclosing];
            currentEnclosing _ newBti};

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


        UpdateBodyNesting: PROC[list: Tree.Link, newBti: BTIndex] = {
            oldBti: BTIndex = ParentBti[newBti];

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

            UpdateItem: Tree.Scan = {
                WITH t SELECT GetTag[t] FROM
                    subtree => {
                        node: Tree.Index = index;
                        SELECT tb[node].name FROM
                            assign, extract =>
                                tb[node].son[2] _ UpdateLeaves[tb[node].son[2], UpdateLinks];
                            ENDCASE};
                    ENDCASE};

            ScanList[list, UpdateItem]};

        BodyType: PROC[ctx: CTXIndex] RETURNS[rSei: RecordSEIndex] = {
            rSei _ LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]];
            seb[rSei].typeInfo _ record[
                machineDep: FALSE, painted: TRUE, argument: FALSE,
                hints: [
                    unifield: FALSE, variant: FALSE,
                    assignable: FALSE, comparable: FALSE, privateFields: TRUE,
                    refField: FALSE, default: FALSE, voidable: FALSE],
                length: 0,
                fieldCtx: CTXNull,
                monitored: FALSE,
                linkPart: notLinked[]];
            seb[rSei].fieldCtx _ ctx;  seb[rSei].mark3 _ TRUE;
            RETURN};


    <<id translation>>

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

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

        AllocateAList: PROC[ctx: CTXIndex] RETURNS[aLink: AList] = {
            maxItems: CARDINAL = CtxEntries[ctx];
            aLink _ NEW[ANode[maxItems] _ [next:NIL, ctx:ctx, nItems:0, map:]]};


    <<mapping>>

        AllocateCopyEntries: PROC[nVars: CARDINAL] RETURNS[seChain: ISEIndex] = {
            IF nVars = 0 THEN seChain _ ISENull
            ELSE {
                IF copyCtx = CTXNull THEN copyCtx _ NewCtx[bb[currentEnclosing].level];
                seChain _ MakeSeChain[copyCtx, nVars, TRUE];
                AppendSeChain[copyCtx, seChain]};
            RETURN};

        FillArgSe: PROC[copy, master: ISEIndex] = {
            CopyArgSe[copy, master];
            IF seb[copy].mark4 THEN seb[copy].idValue _ EncodeTreeIndex[Tree.nullIndex];
            seb[copy].mark4 _ FALSE;  seb[copy].idInfo _  EncodeCard[0]};

        ExtractArgs: PROC[argType: RecordSEIndex, formalCtx: CTXIndex, node: Tree.Index]
              RETURNS[nAssigns: CARDINAL] = {
            aLink: AList = AllocateAList[formalCtx];
            nVars: CARDINAL = CtxEntries[formalCtx];
            seChain: ISEIndex = AllocateCopyEntries[nVars];
            sei1: ISEIndex;
            sei2: ISEIndex _ seChain;
            FOR sei1 _ FirstCtxSe[formalCtx], NextSe[sei1] UNTIL sei1 = ISENull DO
                val: Tree.Link = [symbol[index: sei2]];
                FillArgSe[copy: sei2, master: sei1];
                PushTree[val];  PushTree[Tree.Null];
                PushNode[assign, 2];  SetInfo[FromLoc[dataPtr.textIndex]];
                IncrCount[sei2];
                aLink.map[aLink.nItems] _ [id: sei1, name: FALSE, val: val];
                aLink.nItems _ aLink.nItems + 1;
                sei2 _ NextSe[sei2];
                ENDLOOP;
            IF nVars = 0 THEN nAssigns _ 0
            ELSE {
                PushList[nVars];  PushNode[exlist, 1]; SetInfo[FromType[argType]];
                PushTree[tb[node].son[2]];  tb[node].son[2] _ Tree.Null;
                PushNode[extract, 2];  SetInfo[FromLoc[dataPtr.textIndex]];
                nAssigns _ 1};
            PushAList[aLink];
            RETURN};

        MapArgs: PROC[formalCtx: CTXIndex, node: Tree.Index] RETURNS[nAssigns: CARDINAL _ 0] = {
            aLink: AList = AllocateAList[formalCtx];
            nVars: CARDINAL = CountVars[formalCtx, tb[node].son[2]];
            seChain: ISEIndex = AllocateCopyEntries[nVars];
            sei1, sei2: ISEIndex;

            MapArg: Tree.Map = {
                name: BOOL;
                val: Tree.Link;
                IF sei1 = ISENull THEN v _ t
                ELSE {
                    IF MapByName[sei1, t] THEN {
                        name _ TRUE; AdjustForName[t]; val _ t}
                    ELSE {
                        FillArgSe[copy: sei2, master: sei1];
                        name _ FALSE;  val _ [symbol[index: sei2]];
                        IF t # Tree.Null THEN {
                            PushTree[val];  PushTree[t];
                            PushNode[assign, 2];  SetInfo[FromLoc[dataPtr.textIndex]];
                            IncrCount[sei2];  nAssigns _ nAssigns + 1};
                            sei2 _ NextSe[sei2]};
                    aLink.map[aLink.nItems] _ [id: sei1, name: name, val: val];
                    aLink.nItems _ aLink.nItems + 1;
                    sei1 _ NextSe[sei1];  v _ Tree.Null};
                RETURN};

            sei1 _ FirstCtxSe[formalCtx];  sei2 _ seChain;
            tb[node].son[2] _ UpdateList[tb[node].son[2], MapArg];
            PushAList[aLink];
            RETURN};

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

        UnmapIds: PROC[decl: {implicit, explicit}] = {
            aLink: AList _ PopAList[];
            FOR i: CARDINAL IN [0..aLink.nItems) DO
                t: Tree.Link = aLink.map[i].val;
                WITH t SELECT GetTag[t] FROM
                    symbol =>
                        IF decl = implicit AND ~aLink.map[i].name THEN seb[index].mark4 _ TRUE;
                    ENDCASE;
                aLink.map[i].val _ DiscardTree[aLink.map[i].val];
                ENDLOOP;
            aLink _ NIL};


        MapFields: PROC[oldRecord, newRecord: CSEIndex, nRefs: [0..1]] = {
            oldCtx: CTXIndex = ArgCtx[oldRecord];
            IF oldCtx # CTXNull THEN {
                aLink: AList = AllocateAList[oldCtx];
                sei1: ISEIndex _ FirstCtxSe[oldCtx];
                sei2: ISEIndex _ FirstCtxSe[ArgCtx[newRecord]];
                UNTIL sei1 = ISENull DO
                    seb[sei2].idInfo _  EncodeCard[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]}};

        MapFormals: PROC[oldType, newType: CSEIndex] = {
            WITH new: seb[newType] SELECT FROM
                transfer =>
                    WITH old: seb[oldType] SELECT FROM
                        transfer => {
                            MapFields[old.typeIn, new.typeIn, 1];
                            MapFields[old.typeOut, new.typeOut, 0]};
                        ENDCASE => ERROR;
                ENDCASE};

        UnmapFormals: PROC[type: CSEIndex] = {
            WITH t: seb[type] SELECT FROM
                transfer => {
                    IF ArgCtx[t.typeOut] # CTXNull THEN UnmapIds[implicit];
                    IF ArgCtx[t.typeIn] # CTXNull THEN UnmapIds[implicit]};
                ENDCASE};


    <<reference count adjustment>>

        CountedSei: PROC[sei: ISEIndex] RETURNS[BOOL] = {
            ctx: CTXIndex = seb[sei].idCtx;
            RETURN[~seb[sei].constant AND CtxLevel[ctx] # lZ AND ctxb[ctx].ctxType # included]};

        IncrCount: PROC[sei: ISEIndex] = {    -- modified BumpCount (Pass3I)
            IF seb[sei].idType # typeTYPE AND (~seb[sei].mark4 OR CountedSei[sei]) THEN
                seb[sei].idInfo _ EncodeCard[DecodeCard[seb[sei].idInfo] + 1]
            };

        DecrCount: PROC[sei: ISEIndex] = {
            IF seb[sei].idType # typeTYPE AND (~seb[sei].mark4 OR CountedSei[sei]) THEN {
                nRefs: CARD = DecodeCard[seb[sei].idInfo];
                IF nRefs # 0 THEN seb[sei].idInfo _ EncodeCard[nRefs - 1]}
            };

        AdjustForName: Tree.Scan = {
            WITH t SELECT GetTag[t] FROM
                symbol => DecrCount[index];
                subtree => {
                    node: Tree.Index = index;
                    SELECT tb[node].name FROM
                        thread => AdjustForName[tb[node].son[1]];
                        ENDCASE => ScanSons[t, AdjustForName]};
                ENDCASE};

        SetCtxCounts: PROC[ctx: CTXIndex, nRefs: [0..1]] = {
            FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
                IF ~seb[sei].constant THEN seb[sei].idInfo _ EncodeCard[nRefs];
                ENDLOOP};

        BumpCtxCounts: PROC[ctx: CTXIndex, incr: CARDINAL] = {
            FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
                IF ~seb[sei].constant THEN
                    seb[sei].idInfo _ EncodeCard[DecodeCard[seb[sei].idInfo] + incr];
                ENDLOOP
            };

        ComputeArgCounts: PROC[type: CSEIndex, body: Tree.Link] = {
            typeIn, typeOut: RecordSEIndex;
            argCtx, resultCtx: CTXIndex;
            [typeIn, typeOut] _ TransferTypes[type];
            argCtx _ FieldCtx[typeIn];  resultCtx _ FieldCtx[typeOut];
            IF argCtx # CTXNull OR resultCtx # CTXNull THEN {

                UpdateCount: Tree.Scan = {
                    WITH t SELECT GetTag[t] FROM
                        symbol => {
                            sei: ISEIndex = index;
                            SELECT seb[sei].idCtx FROM
                                CTXNull => NULL;
                                argCtx, resultCtx =>
                                    seb[sei].idInfo _ EncodeCard[DecodeCard[seb[sei].idInfo] + 1];
                                ENDCASE};
                        subtree => {
                            node: Tree.Index = index;
                            IF tb[node].name = return AND tb[node].son[1] = Tree.Null THEN
                                BumpCtxCounts[resultCtx, 1];
                            ScanSons[t, UpdateCount]};
                        ENDCASE => NULL};

                SetCtxCounts[argCtx, 1];  SetCtxCounts[resultCtx, 0];
                ScanSons[body, UpdateCount]}};

        FieldCtx: PROC[rSei: RecordSEIndex] RETURNS[CTXIndex] = {
            RETURN[IF rSei = RecordSENull THEN CTXNull ELSE seb[rSei].fieldCtx]};


    <<association lists>>

        PushAList: PROC[aLink: AList] = {aLink.next _ aStack; aStack _ aLink};

        PopAList: PROC RETURNS[aLink: AList] = {
            IF aStack = NIL THEN ERROR;  aLink _ aStack; aStack _ aLink.next};

        ExpandSei: PROC[sei: ISEIndex] RETURNS[v: Tree.Link] = {
            i: CARDINAL;
            FOR aLink: AList _ 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 => {
                        saveCopying: BOOL = copying;
                        copying _ TRUE;  v _ ExpandTree[aLink.map[i].val];
                        copying _ saveCopying};
                    FINISHED => {IF copying THEN IncrCount[sei]; v _ [symbol[index:sei]]};
                ENDLOOP;
            RETURN};


    <<nested calls>>

        ThreadSubst: PROC[node: Tree.Index, dest: Tree.Link] = {
            dThread: Tree.Index = GetNode[NthSon[dest, 1]];
            IF copying THEN {
                sThread: Tree.Index;
                DO
                    sThread _ GetNode[tb[node].son[1]];
                    IF tb[sThread].name # thread THEN ERROR;
                    IF tb[sThread].son[2] = Tree.Null THEN EXIT;
                    node _ GetNode[tb[sThread].son[2]];
                    ENDLOOP;
                tb[dThread].son[2] _ Tree.Null;
                tb[sThread].son[2] _ dest;  MarkShared[dest, TRUE]};
            tb[dThread].info _ FromBti[currentEnclosing]};

        }.

