<<>>
<<Pass3P.mesa>>
    <<Copyright Ó 1985, 1986, 1987, 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.>>
    <<Satterthwaite, June 18, 1986 12:24:03 pm PDT>>
    <<Russ Atkinson (RRA) June 5, 1990 2:57:17 pm PDT>>

    DIRECTORY
        Alloc USING [OrderedIndex, Top, Units],
        CompilerUtil USING [],
        LiteralOps USING [IsShort, Value],
        MimData USING [base, defBodyLimit, interface, nBodies, nInnerBodies, table, textIndex, idCARDINAL, idINTEGER, idNAT, idREAL],
        MimosaEvents USING [Callback, RegisterSet],
        MimosaLog USING [Error, ErrorSei],
        MimZonePort,
        MimZones USING [tempZone],
        SourceMap USING [Down, Loc, nullLoc, Up],
        SymbolOps USING [ArgCtx, CopyArgSe, CopyXferType, CtxEntries, CtxLevel, DecodeCard, DecodeInt, DelinkBti, EncodeCard, 
        EncodeTreeIndex, FindExtension, FirstCtxSe, FromBti, FromType, LinkBti, MakeNonCtxSe, MakeSeChain, NewCtx, NextLevel, 
        NextSe, NormalType, own, ParentBti, SearchContext, SetCtxLevel, SetSeLink, StaticNestError, ToBti, ToType, TransferTypes, 
        UnderType],
        Symbols USING [Base, BitOrder, BodyInfo, BodyRecord, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, CSENull, 
        CTXIndex, CTXNull, ctxType, ISEIndex, ISENull, lL, lZ, mdType, nullName, RecordSEIndex, RecordSENull, RootBti, SERecord, 
        seType, Type, typeTYPE],
        Target: TYPE MachineParms USING [bitOrder, bitsPerAU],
        Tree USING [Base, Index, Link, Map, Node, NodePtr, Null, nullIndex, Scan, treeType],
        TreeOps USING [CopyTree, FreeNode, FreeTree, FromLoc, GetNode, GetTag, ListTail, MakeList, MarkShared, NthSon, OpName, PopTree, 
        PushList, PushNode, PushTree, ScanList, ScanSons, SetAttr, SetAttrs, SetInfo, Shared, ToLoc, UpdateLeaves, UpdateList];
Pass3P: PROGRAM
    IMPORTS Alloc, LiteralOps, MimData, MimosaEvents, MimosaLog, MimZonePort, MimZones, SourceMap, SymbolOps, TreeOps
    EXPORTS CompilerUtil = {
    OPEN Symbols, TreeOps;

    targetBitOrder: Symbols.BitOrder = SELECT Target.bitOrder FROM
        msBit => msBit, lsBit => lsBit, ENDCASE => ERROR;
<<Debug options>>
    declArgs: BOOL = TRUE;
        <<Use this flag to govern declaration of formal arguments for INLINE routines.  This flag is used in ExtractArgs & MapArgs.>>
    specialHack: BOOL Ź TRUE;
        <<Governs a special hack in ExpandTree>>
<<Zones & table bases>>
    tb: Tree.Base Ź NIL;        -- tree base address (local copy)
    seb: Symbols.Base Ź NIL;    -- se table base address (local copy)
    ctxb: Symbols.Base Ź NIL;    -- context table base address (local copy)
    mdb: Symbols.Base Ź NIL;    -- module table base address (local copy)
    bb: Symbols.Base Ź NIL;    -- body table base address (local copy)

    bbZoneScratch: MimZonePort.Scratch;
    bbZone: UNCOUNTED ZONE Ź MimZonePort.MakeZone[
    alloc: BbZoneProc, free: NIL, scratch: @bbZoneScratch];
    BbZoneProc: PROC
    [self: UNCOUNTED ZONE, size: CARDINAL] RETURNS [ptr: LONG POINTER] = {
        index: Alloc.OrderedIndex = (MimData.table).Units[bodyType, size];
        ptr Ź @bb[index];
        };
    CBTRelative: PROC
    [ptr: LONG POINTER TO BodyRecord.Callable] RETURNS [CBTIndex] = INLINE {
        RETURN [LOOPHOLE[ptr-LOOPHOLE[bb, LONG POINTER TO BodyRecord.Callable]]];
        };
    BTRelative: PROC [ptr: LONG POINTER TO BodyRecord] RETURNS [BTIndex] = INLINE {
        RETURN [LOOPHOLE[ptr-LOOPHOLE[bb, LONG POINTER TO BodyRecord]]];
        };
<<driver>>
    P3Postlude: PUBLIC PROC [expand: BOOL] = {
        IF expand THEN {
            <<LinkImportedBodies>>
            next: BTIndex;
            btLimit: BTIndex = (MimData.table).Top[bodyType];
            FOR bti: BTIndex Ź RootBti + MimData.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 Ź [which: sibling, index: bti];
                            };
                        next Ź bti + BodyRecord.Callable.SIZE;
                        };
                    ENDCASE => next Ź bti + BodyRecord.Other.SIZE;
                ENDLOOP;
            ExpandInlines[RootBti];
            };
        };
<<inline expansion>>
    <<state information>>
        currentMaster: CBTIndex;
        masterBody: Tree.Index;
        copyCtx: CTXIndex;
        copying: BOOL;
        substSafe: BOOL;
        currentEnclosing: BTIndex;
        currentLevel: ContextLevel;
            <<Always should be equal to bb[currentEnclosing].level!>>
        bodyNesting: CARDINAL;

        SetEnclosing: PROC [bti: BTIndex] = {
            currentEnclosing Ź bti;
            currentLevel Ź bb[currentEnclosing].level;
            };

        aStack: AList Ź NIL;    -- current association list

        AItem: TYPE = RECORD [id: ISEIndex, name: BOOL, val: Tree.Link];
        ANode: TYPE = RECORD [
            next: AList Ź NIL,
            ctx: CTXIndex,
            nItems: CARDINAL Ź 0,
            map: SEQUENCE maxItems: CARDINAL OF AItem];
        AList: TYPE = REF ANode;
<<overall control>>
    ExpandInlines: PROC [rootBti: BTIndex] = {
        bti: BTIndex Ź rootBti;
        Pass3PReset[cleanup];
        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 = MimData.textIndex;
        sei: ISEIndex = bb[bti].id;
        current, subNode: Tree.Index;
        fromDefs: BOOL Ź seb[sei].mark4;
            <<Pass4 processing has already been performed if this INLINE is from a Defs modules, otherwise this INLINE is from the current 
            source file.>>
        IF NOT fromDefs THEN
            <<If using the current source file, then we can set the new source index, otherwise we should not, because the source index is 
            relative to a different file.  Eventually we want to be able to handle copied files.>>
            MimData.textIndex Ź SourceMap.Up[bb[bti].sourceIndex];
        WITH body: bb[bti].info SELECT FROM
            Internal => {
                currentMaster Ź bti;
                IF fromDefs
                    THEN {
                        t: Tree.Link = SymbolOps.FindExtension[SymbolOps.own, 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];
                        SetEnclosing[SymbolOps.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 (NOT MimData.interface OR bb[bti].level > lL) THEN
                        copying Ź FALSE;
                    SELECT TRUE FROM
                        discard => DiscardCall[current];
                        NOT RecursiveSubst[bti, currentEnclosing] => ExpandCall[current];
                        ENDCASE => MimosaLog.ErrorSei[recursiveInline, bb[bti].id];
                    ENDLOOP;
                };
            ENDCASE => ERROR;
        MimData.textIndex Ź saveIndex;
        };

    DiscardCall: PROC [node: Tree.Index] = INLINE {
        <<orphan subtree>>
        [] Ź DiscardTree[[subtree[node]]];
        };

    ExpandCall: PROC [node: Tree.Index] = {
        typeIn: RecordSEIndex;
        typeOut: RecordSEIndex;
        masterCtx: CTXIndex = bb[currentMaster].localCtx;
        formalCtx: CTXIndex Ź CTXNull;
        seChain: ISEIndex Ź Symbols.ISENull;
        saveChain: ISEIndex Ź Symbols.ISENull;
        nAssigns: CARDINAL Ź 0;
        nVars: CARDINAL Ź 0;
        extendedScope: BOOL Ź FALSE;
        newBti: BTIndex;
        t: Tree.Link;
        IF tb[node].name = call THEN MimData.textIndex Ź ToLoc[tb[node].info];
        bodyNesting Ź 0;
        IF copying OR masterCtx = CTXNull
            THEN copyCtx Ź CTXNull
            ELSE {
                saveChain Ź ctxb[masterCtx].seList;
                ctxb[masterCtx].seList Ź ISENull;
                SymbolOps.SetCtxLevel[masterCtx, currentLevel];
                copyCtx Ź masterCtx;
                };
        [typeIn, typeOut] Ź SymbolOps.TransferTypes[SymbolOps.own, bb[currentMaster].ioType];
        substSafe Ź tb[node].attr3 AND bb[currentMaster].hints.nameSafe;
        IF RequiredFields[typeOut] THEN {
            <<The return variables may need to be declared>>
            formalCtx Ź seb[typeOut].fieldCtx;
            IF copyCtx = CTXNull THEN copyCtx Ź SymbolOps.NewCtx[currentLevel];
            seChain Ź SymbolOps.MakeSeChain[copyCtx, CtxVars[formalCtx], TRUE];
            AppendSeChain[copyCtx, seChain];
            MapIds[formalCtx, seChain, 1];
            IF declArgs THEN {
                sei1: ISEIndex Ź seChain;
                WHILE sei1 # ISENull DO
                    id: Tree.Link Ź [symbol[index: sei1]];
                    PushTree[id];
                    PushTree[Tree.Null];
                    PushTree[Tree.Null];
                    PushNode[decl, 3];
                    SetInfo[FromLoc[MimData.textIndex]];
                    SetAttr[3, TRUE];  -- needs decl processing
                    IncrCount[sei1];
                    nAssigns Ź nAssigns+1;
                    sei1 Ź SymbolOps.NextSe[SymbolOps.own, sei1];
                    ENDLOOP;
                };
            };
        nAssigns Ź 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 tb[masterBody].son[1] # Tree.Null THEN
            PushTree[ExpandOpens[tb[masterBody].son[1]]];
        SELECT TRUE FROM
            masterCtx = CTXNull => {};
            NOT copying => AppendSeChain[copyCtx, saveChain];
            (nVars Ź CtxVars[masterCtx]) # 0 => {
                IF copyCtx = CTXNull THEN copyCtx Ź SymbolOps.NewCtx[currentLevel];
                seChain Ź SymbolOps.MakeSeChain[copyCtx, nVars, FALSE];
                MapIds[masterCtx, seChain, 0];
                AppendSeChain[copyCtx, seChain];
                };
            ENDCASE;

        <<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 Ź nAssigns # 0
            OR tb[masterBody].son[1] # Tree.Null
            OR tb[masterBody].son[4] # Tree.Null;
            PushTree[t];
            PushNode[block, -2];
            SetInfo[SymbolOps.FromBti[newBti]];
            SetAttrs[tb[masterBody].attr1, tb[masterBody].attr2, extendedScope];
            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[MimData.textIndex]];
            };
        IF tb[masterBody].son[4] # Tree.Null THEN {
            PushTree[ExpandTree[tb[masterBody].son[4]]];
            PushNode[lock, 2];
            SetInfo[FromLoc[MimData.textIndex]];
            };
        IF masterCtx # CTXNull AND copying AND nVars # 0 THEN UnmapIds[explicit];
        IF copyCtx # CTXNull THEN
            SetEnclosing[SymbolOps.ParentBti[SymbolOps.own, currentEnclosing]];
        IF NOT copying THEN {
            <<PruneBody[masterBody];>>
            tp: LONG POINTER TO Tree.Node = @tb[masterBody];
            tp.son[1] Ź Tree.Null;
            tp.son[2] Ź Tree.Null;
            tp.son[3] Ź Tree.Null;
            tp.son[4] Ź Tree.Null;
            tp.name Ź procinit;
            };

        <<complete the setup>>
        IF tb[node].nSons > 2 THEN {
            old: Tree.Link = tb[node].son[3];
            new: Tree.Link = ExpandTree[old];
            PushTree[new];
            tb[node].son[3] Ź Tree.Null;
            PushNode[enable, -2];
            SetInfo[FromLoc[MimData.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;
        ResetSharingMap[];
        };

    RecursiveSubst: PROC [bti, parent: BTIndex] RETURNS [BOOL] = INLINE {
        UNTIL parent = BTNull DO
            IF bti = parent THEN RETURN [TRUE];
            parent Ź SymbolOps.ParentBti[SymbolOps.own, parent];
            ENDLOOP;
        RETURN [FALSE];
        };
<<argument list testing/processing>>
    NameSafe: PROC [t: Tree.Link, constOnly: BOOL Ź FALSE] RETURNS [safe: BOOL] = {
        probably: BOOL Ź substSafe;
        link: Tree.Link Ź t;
        takeAddr: BOOL Ź FALSE;
        IF IsConstant[t] THEN RETURN [TRUE];
        DO
            WITH e: link SELECT GetTag[link] FROM
                symbol => {
                    IF seb[e.index].constant THEN RETURN [TRUE];
                    IF takeAddr THEN RETURN [TRUE];
                    IF constOnly THEN RETURN [FALSE];
                    RETURN [probably OR seb[e.index].immutable];
                    };
                literal => {
                    IF constOnly AND LiteralOps.Value[e.index].class = real THEN RETURN [FALSE];
                    RETURN [TRUE];
                    };
                subtree => {
                    node: Tree.Index = e.index;
                    SELECT tb[node].name FROM
                        clit, llit, mwconst, nil, atom, first, last => RETURN [TRUE];
                        loophole, cast, openx, dollar, not, lengthen => {};
                        addr => takeAddr Ź TRUE;
                        cdot => GO TO link2;
                        uminus, pred, succ, abs, shorten => {
                            <<These can fault, so not really safe to use name substitution, except for constants (which will be range checked later)>>
                            constOnly Ź TRUE;
                            };
                        power, times, div, mod, plus, minus => {
                            <<These can fault, so not really safe to use name substitution, except for constants (which will be range checked later)>>
                            IF NOT NameSafe[tb[node].son[2], TRUE] THEN RETURN [FALSE];
                            constOnly Ź TRUE;
                            };
                        or, and, relE, relN, relL, relGE, relG, relLE,
                        in, notin, intOO, intOC, intCO, intCC =>
                            <<Binary ops that can't fault>>
                            IF NOT NameSafe[tb[node].son[2], constOnly] THEN RETURN [FALSE];
                        min, max =>
                            <<N-ary ops that can't fault>>
                            FOR i: NAT IN [2..tb[node].nSons] DO
                                IF NOT NameSafe[tb[node].son[i], constOnly] THEN RETURN [FALSE];
                                ENDLOOP;
                        ENDCASE => RETURN [FALSE];
                    link Ź tb[node].son[1];
                    EXITS link2 => link Ź tb[e.index].son[2];
                    };
                ENDCASE => RETURN [FALSE];
            ENDLOOP;
        };


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

    CostEstimate: PROC [t: Tree.Link] RETURNS [CARDINAL] = {
        <<Calculates a cost estimate for the cost of evaluating the given expression compared to the cost of evaluating a local variable.  
        Constants and local variables have no penalty.>>
        link: Tree.Link Ź t;
        cost: CARDINAL Ź 0;
        WHILE cost < maxCost DO
            IF IsConstant[link] THEN EXIT;
            WITH e: link SELECT GetTag[link] FROM
                subtree => {
                    node: Tree.Index = e.index;
                    SELECT tb[e.index].name FROM
                        loophole, cast, openx => {};
                        dollar, addr => cost Ź cost + 1;
                        uparrow, dot => cost Ź cost + 2;
                        cdot => {cost Ź cost + 1; GO TO link2};
                        not, uminus, pred, succ => cost Ź cost + 1;
                        abs, lengthen, shorten => cost Ź cost + 2;
                        or, and, plus, minus => {cost Ź cost + 1; GO TO both};
                        relE, relN, relL, relGE, relG, relLE => {cost Ź cost + 2; GO TO both};
                        in, notin, intOO, intOC, intCO, intCC => {cost Ź cost + 2; GO TO both};
                        index, dindex, seqindex, reloc => {cost Ź cost + 2; GO TO both};
                        ENDCASE => RETURN [maxCost];
                    link Ź tb[e.index].son[1];
                    EXITS
                        both => {
                            cost Ź cost + CostEstimate[tb[e.index].son[2]];
                            link Ź tb[e.index].son[1];
                            };
                        link2 => link Ź tb[e.index].son[2];
                    };
                symbol => {
                    <<At some point we must do better.  After all, a global variable may be more expensive than a local variable, and an imported 
                    variable may be more expensive still.  An uplevel variable is also more expensive.>>
                    sei: ISEIndex = e.index;
                    ctx: CTXIndex Ź seb[sei].idCtx;
                    level: ContextLevel Ź SymbolOps.CtxLevel[SymbolOps.own, ctx];
                    IF level # currentLevel THEN cost Ź cost + 1;
                    EXIT;
                    };
                literal => EXIT;
                ENDCASE => RETURN [maxCost];
            ENDLOOP;
        RETURN [MIN[cost, maxCost]];
        };
        maxCost: CARDINAL = 16;

    IsConstant: PROC [t: Tree.Link, notReal: BOOL Ź FALSE] RETURNS [BOOL] = {
        <<An estimate of evaluation to a constant>>
        link: Tree.Link Ź t;
        DO
            WITH e: link SELECT GetTag[link] FROM
                subtree => {
                    tp: Tree.NodePtr Ź @tb[e.index];
                    notReal Ź TRUE;
                    {
                        SELECT tb[e.index].name FROM
                            clit, llit, mwconst, nil, atom, first, last => RETURN [TRUE];
                            loophole, cast, openx, dollar, uparrow, dot, addr, dollar => {};
                            cdot => GO TO link2;
                            not, uminus, pred, succ, abs, lengthen, shorten => {};
                            or, and, plus, minus, power, times, div, mod => GO TO both;
                            relE, relN, relL, relGE, relG, relLE, in, notin, intOO, intOC, intCO, intCC =>
                                GO TO both;
                            index, dindex, seqindex, reloc => GO TO both;
                            size => {
                                son: Tree.Link Ź tp.son[2];
                                IF son # Tree.Null THEN
                                    IF NOT IsConstant[son, TRUE] THEN RETURN [FALSE];
                                son Ź tp.son[1];
                                IF TreeOps.OpName[son] # apply THEN RETURN [TRUE];
                                link Ź TreeOps.NthSon[son, 2];
                                LOOP;
                                };
                            ENDCASE => RETURN [FALSE];
                        link Ź tp.son[1];
                        EXITS
                            both => {
                                IF NOT IsConstant[tp.son[2], TRUE] THEN RETURN [FALSE];
                                link Ź tp.son[1];
                                };
                            link2 => link Ź tp.son[2];
                        };
                    };
                literal => {
                    IF notReal AND LiteralOps.Value[e.index].class = real THEN RETURN [FALSE];
                    RETURN [TRUE];
                    };
                symbol => {
                    ut: Symbols.CSEIndex Ź SymbolOps.UnderType[SymbolOps.own, seb[e.index].idType];
                    IF notReal AND seb[ut].typeTag = real THEN RETURN [FALSE];
                    RETURN [seb[e.index].constant];
                    };
                ENDCASE => RETURN [FALSE];
            ENDLOOP;
        };

    MapByName: PROC [sei: ISEIndex, t: Tree.Link] RETURNS [BOOL] = {
        IF NOT bb[currentMaster].hints.argUpdated THEN {
            cost: CARDINAL Ź CostEstimate[t] * VarRefs[sei];
            IF cost <= limitCost AND NameSafe[t] THEN {
                IF t # Tree.Null THEN {
                    <<At this point we test for the types being good enough.  If they are not then we conservatively disallow mapping by name, since 
                    conversions can otherwise get lost!>>
                    <<RRA sez: this needs to be revisited, since we can't easily tell if we have to reduce the range in this pass (we don't really have 
                    the information until Pass 4).  Perhaps we should do by name substitution in Pass 4?>>
                    type: Symbols.Type;
                    WITH e: t SELECT TreeOps.GetTag[t] FROM
                        subtree => type Ź SymbolOps.ToType[tb[e.index].info];
                        symbol => type Ź seb[e.index].idType;
                        literal => IF LiteralOps.IsShort[e.index] THEN
                            SELECT LiteralOps.Value[e.index].class FROM
                                signed => type Ź MimData.idINTEGER;
                                unsigned => type Ź MimData.idCARDINAL;
                                either => type Ź MimData.idNAT;
                                real => type Ź MimData.idREAL;
                                ENDCASE => GO TO byValue;
                        ENDCASE => GO TO byValue;
                    IF TypesGoodEnough[type, seb[sei].idType] THEN GO TO byName;
                    };
                };
            };
        GO TO byValue;
        EXITS
            byName => RETURN [TRUE];
            byValue => RETURN [FALSE];
        };
        limitCost: CARDINAL Ź 4;

    TypesGoodEnough: PROC [actual: Type, formal: Type] RETURNS [BOOL] = {
        <<The actual should be containable within the formal>>
        fut: Symbols.CSEIndex = SymbolOps.UnderType[SymbolOps.own, formal];
        fnt: Symbols.CSEIndex = SymbolOps.NormalType[SymbolOps.own, formal];
        aut: Symbols.CSEIndex = SymbolOps.UnderType[SymbolOps.own, actual];
        IF aut = fnt OR aut = fut THEN RETURN [TRUE];
        WITH au: seb[aut] SELECT FROM
            subrange => IF au.mark4 THEN
                <<We have a subrange and the limits are known>>
                WITH fu: seb[aut] SELECT FROM
                    subrange => IF fu.mark4 THEN
                        <<The formal is also a subrange with known limits>>
                        IF au.origin = fu.origin AND au.range <= fu.range THEN RETURN [TRUE];
                    signed, unsigned, enumerated =>
                        <<The formal is an arithmetic type, we rely on other checking to validate the base type as being compatible.>>
                        IF au.origin = 0 AND au.range <= CARD[LAST[INT]] THEN RETURN [TRUE];
                    ENDCASE;
            ENDCASE;
        RETURN [FALSE];
        };

    CountVars: PROC [ctx: CTXIndex, t: Tree.Link] RETURNS [n: CARDINAL Ź 0] = {
        sei: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, ctx];
        CountVar: Tree.Scan = {
            IF sei # ISENull THEN {
                IF NOT MapByName[sei, t] THEN n Ź n+1;
                sei Ź SymbolOps.NextSe[SymbolOps.own, sei];
                };
            };
        ScanList[t, CountVar];
        };

    RequiredFields: PROC [rSei: RecordSEIndex] RETURNS [BOOL] = {
        FOR sei: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, FieldCtx[rSei]], SymbolOps.NextSe[SymbolOps.own, sei]
        UNTIL sei = ISENull DO
            IF seb[sei].extended THEN RETURN [TRUE];
                <<In this case there is a default value, so force the variable to be real>>
            IF seb[sei].hash = nullName THEN RETURN [FALSE];
            IF SymbolOps.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 =>
                            SELECT TRUE FROM
                                OpName[tb[node].son[1]] = thread => {
                                    <<mark for later discard (see DiscardCall)>>
                                    subNode: Tree.Index = GetNode[tb[node].son[1]];
                                    tb[subNode].attr1 Ź TRUE;
                                    RETURN [Tree.Null];
                                    };
                                ENDCASE;
                        ENDCASE;
                    IF NOT tb[node].shared THEN {
                        [] Ź UpdateLeaves[t, DiscardTree];
                        FreeNode[node];
                        };
                    };
                ENDCASE;
        RETURN [Tree.Null];
        };

    ExpandTree: Tree.Map = {
        v Ź t;
        WITH t SELECT GetTag[t] FROM
            symbol => v Ź ExpandSei[index];
            subtree => {
                sNode: Tree.Index Ź index;
                extendedScope: BOOL Ź FALSE;
                IF specialHack THEN
                    SELECT tb[sNode].name FROM
                        call, callx => {
                            nSons: CARDINAL = tb[sNode].nSons;
                            FOR i: CARDINAL IN [1 .. nSons] DO
                                PushTree[ExpandTree[tb[sNode].son[i]]];
                                ENDLOOP;
                            v Ź CopyOrRewrite[copying, sNode, nSons];
                            IF TreeOps.OpName[tb[sNode].son[1]] = thread THEN
                                ThreadSubst[sNode, v];
                            RETURN [v];
                            };
                        ENDCASE;
                IF tb[sNode].shared
                    THEN
                        SELECT tb[sNode].name FROM
                            call, callx => {
                                nSons: CARDINAL = tb[sNode].nSons;
                                FOR i: CARDINAL IN [1 .. nSons] DO
                                    PushTree[ExpandTree[tb[sNode].son[i]]];
                                    ENDLOOP;
                                v Ź CopyOrRewrite[copying, sNode, nSons];
                                ThreadSubst[sNode, v];
                                };
                            ENDCASE =>
                                v Ź ExpandShared[sNode]
                    ELSE {
                        SELECT tb[sNode].name FROM
                            body => {
                                EnterBody[sNode];
                                PushTree[ExpandOpens[tb[sNode].son[1]]];
                                PushTree[ExpandDecls[tb[sNode].son[2]]];
                                PushTree[ExpandTree[tb[sNode].son[3]]];
                                PushTree[ExpandTree[tb[sNode].son[4]]];
                                v Ź CopyOrRewrite[copying, sNode, 4];
                                ExitBody[GetNode[v]];
                                };
                            block => {extendedScope Ź tb[sNode].attr3; GO TO expandBlock};
                            ditem => GO TO expandBlock;
                            do => {
                                decl: BOOL Ź FALSE;
                                son1: Tree.Link Ź tb[sNode].son[1];
                                subNode: Tree.Index;
                                IF son1 # Tree.Null THEN {
                                    subNode Ź GetNode[son1];
                                    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[CopyOrRewrite[FALSE, subNode, nSons]];
                                                };
                                        }
                                    ELSE
                                        PushTree[ExpandTree[son1]];
                                PushTree[ExpandTree[tb[sNode].son[2]]];
                                PushTree[ExpandOpens[tb[sNode].son[3]]];
                                FOR i: CARDINAL IN [4..6] DO
                                    PushTree[ExpandTree[tb[sNode].son[i]]];
                                    ENDLOOP;
                                v Ź CopyOrRewrite[copying, sNode, 6];
                                IF decl THEN {
                                    newNode: Tree.Index = GetNode[v];
                                    ExitBlock[GetNode[tb[newNode].son[1]], newNode];
                                    };
                                };
                            open, bind, bindx => {
                                nSons: CARDINAL = tb[sNode].nSons;
                                PushTree[ExpandOpens[tb[sNode].son[1]]];
                                FOR i: CARDINAL IN [2..nSons] DO
                                    PushTree[ExpandTree[tb[sNode].son[i]]];
                                    ENDLOOP;
                                v Ź CopyOrRewrite[copying, sNode, nSons];
                                };
                            subst, substx => {
                                extendedScope: BOOL = tb[sNode].attr3;
                                PushTree[ExpandTree[tb[sNode].son[1]]];
                                IF extendedScope THEN MapBlock[FindBlock[tb[sNode].son[2]]];
                                PushTree[ExpandTree[tb[sNode].son[2]]];
                                v Ź CopyOrRewrite[copying, sNode, 2];
                                };
                            lock => {
                                PushTree[ExpandTree[tb[sNode].son[2]]];
                                PushTree[ExpandTree[tb[sNode].son[1]]];
                                IF copying
                                    THEN {
                                        PushNode[lock, -2];
                                        SetInfo[tb[sNode].info];
                                        v Ź PopTree[];
                                        }
                                    ELSE {
                                        tb[sNode].son[1] Ź PopTree[];
                                        tb[sNode].son[2] Ź PopTree[];
                                        v Ź [subtree[index: sNode]];
                                        };
                                };
                            thread => {
                                IF NOT copying
                                    THEN {
                                        tb[sNode].son[1] Ź ExpandTree[tb[sNode].son[1]];
                                        v Ź [subtree[sNode]];
                                        }
                                    ELSE {
                                        PushTree[ExpandTree[tb[sNode].son[1]]];
                                        PushTree[Tree.Null];
                                        PushNode[thread, 2];
                                        SetInfo[tb[sNode].info];
                                        v Ź PopTree[];
                                        };
                                };
                            catch => {
                                CatchItem: Tree.Scan = {
                                    <<[t: Tree.Link]>>
                                    node: Tree.Index = TreeOps.GetNode[t];
                                    type: CSEIndex = SymbolOps.UnderType[SymbolOps.own, SymbolOps.ToType[tb[node].info]];
                                    IF type # CSENull THEN {
                                        <<We have to copy the type and remap the identifiers>>
                                        oldCtxIn: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, SymbolOps.TransferTypes[SymbolOps.own, type].typeIn];
                                        oldCtxOut: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, SymbolOps.TransferTypes[SymbolOps.own, type].typeOut];
                                        newType: CSEIndex = SymbolOps.CopyXferType[type, NIL];
                                        newCtxIn: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, SymbolOps.TransferTypes[SymbolOps.own, newType].typeIn];
                                        newCtxOut: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, SymbolOps.TransferTypes[SymbolOps.own, newType].typeOut];
                                        SubstId: Tree.Map = {
                                            <<[t: Tree.Link] RETURNS [v: Tree.Link]>>
                                            v Ź t;
                                            WITH e: t SELECT GetTag[t] FROM
                                                symbol => {
                                                    id: ISEIndex = e.index;
                                                    ctx: CTXIndex Ź CTXNull;
                                                    SELECT seb[id].idCtx FROM
                                                        oldCtxIn => ctx Ź newCtxIn;
                                                        oldCtxOut => ctx Ź newCtxOut;
                                                        ENDCASE => RETURN;
                                                    IF ctx # CTXNull THEN {
                                                        newId: ISEIndex = SymbolOps.SearchContext[SymbolOps.own, seb[id].hash, ctx];
                                                        IF newId = ISENull THEN ERROR;
                                                        RETURN [[symbol[newId]]];
                                                        };
                                                    };
                                                subtree =>
                                                    v Ź TreeOps.UpdateLeaves[v, SubstId];
                                                ENDCASE;
                                            };
                                        tb[node].info Ź SymbolOps.FromType[newType];
                                        IF newCtxIn # CTXNull OR newCtxOut # CTXNull THEN {
                                            <<At this point we have to substitute the identifiers>>
                                            IF newCtxIn # CTXNull THEN
                                                SymbolOps.SetCtxLevel[newCtxIn, level];
                                            IF newCtxOut # CTXNull THEN
                                                SymbolOps.SetCtxLevel[newCtxOut, level];
                                            [] Ź TreeOps.UpdateLeaves[t, SubstId];
                                            };
                                        };
                                    };
                                oldLevel: ContextLevel = currentLevel;
                                level: ContextLevel = SymbolOps.NextLevel[oldLevel
                                    ! SymbolOps.StaticNestError => {MimosaLog.Error[staticNesting]; RESUME}];
                                currentLevel Ź level;
                                v Ź IF copying
                                    THEN CopyTree[[baseP: @tb, link: t], ExpandTree]
                                    ELSE UpdateLeaves[t, ExpandTree];
                                TreeOps.ScanList[TreeOps.NthSon[v, 1], CatchItem];
                                currentLevel Ź oldLevel;
                                };
                            ENDCASE => {
                                <<First, copy the tree, then do any post-processing>>
                                v Ź IF copying
                                    THEN CopyTree[[baseP: @tb, link: t], ExpandTree]
                                    ELSE UpdateLeaves[t, ExpandTree];
                                WITH e: v SELECT GetTag[v] FROM
                                    subtree => {
                                        dNode: Tree.Index = e.index;
                                        SELECT tb[dNode].name FROM
                                            return => IF bodyNesting = 0 THEN {
                                                IF tb[dNode].son[1] = Tree.Null THEN {
                                                    typeOut: RecordSEIndex = SymbolOps.TransferTypes[
                                                    SymbolOps.own,
                                                    bb[currentMaster].ioType].typeOut;
                                                    IF typeOut # RecordSENull THEN {
                                                        n: CARDINAL Ź 0;
                                                        first: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, FieldCtx[typeOut]];
                                                        FOR sei: ISEIndex Ź first,
                                                        SymbolOps.NextSe[SymbolOps.own, sei]
                                                        UNTIL sei = ISENull DO
                                                            PushTree[ExpandSei[sei]];
                                                            n Ź n+1;
                                                            ENDLOOP;
                                                        tb[dNode].son[1] Ź MakeList[n];
                                                        };
                                                    };
                                                tb[dNode].name Ź result;
                                                };
                                            xerror => IF bodyNesting = 0 THEN tb[dNode].attr3 Ź TRUE;
                                            ENDCASE;
                                        };
                                    ENDCASE;
                                };
                        EXITS expandBlock => {
                            EnterBlock[sNode, extendedScope];
                            PushTree[ExpandDecls[tb[sNode].son[1]]];
                            PushTree[ExpandTree[tb[sNode].son[2]]];
                            v Ź CopyOrRewrite[copying, sNode, 2];
                            ExitBlock[GetNode[v]];
                            };
                        };
                };
            ENDCASE;
        };

    CopyOrRewrite: PROC [copy: BOOL, node: Tree.Index, nSons: CARDINAL]
    RETURNS [Tree.Link] = {
        IF copy THEN {
            PushNode[tb[node].name, nSons];
            SetInfo[tb[node].info];
            SetAttrs[tb[node].attr1, tb[node].attr2, tb[node].attr3];
            RETURN [PopTree[]];
            };
        FOR i: CARDINAL DECREASING IN [1 .. nSons] DO
            tb[node].son[i] Ź PopTree[];
            ENDLOOP;
        RETURN [[subtree[index: node]]];
        };

    ExpandDecls: Tree.Map = {
        SELECT TRUE FROM
            OpName[t] = initlist => {
                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 Ź CopyOrRewrite[FALSE, node, 2];
                };
            copying => {
                ExpandDecl: Tree.Scan = {
                    node: Tree.Index;
                    IF OpName[t] # typedecl THEN {
                        LinkDecl: Tree.Scan = {
                            WITH t SELECT GetTag[t] FROM
                                symbol => {
                                    sei: ISEIndex = index;
                                    seb[sei].idValue Ź SymbolOps.EncodeTreeIndex[node];
                                    IF NOT seb[sei].mark4
                                    AND tb[node].son[3] = Tree.Null
                                    AND NOT seb[sei].immutable THEN
                                        seb[sei].idInfo Ź SymbolOps.EncodeCard[
                                        SymbolOps.DecodeCard[seb[sei].idInfo] - 1];
                                    };
                                ENDCASE;
                            };
                        copy: Tree.Link Ź ExpandTree[t];
                        PushTree[copy];
                        n Ź n+1;
                        node Ź GetNode[copy];
                        ScanList[tb[node].son[1], LinkDecl];
                        };
                    };
                n: CARDINAL Ź 0;
                ScanList[t, ExpandDecl];
                v Ź MakeList[n];
                };
            ENDCASE =>
                v Ź ExpandTree[t];
        };

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

    sharingMap: SharingList Ź NIL;

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

    ExpandOpens: Tree.Map = {
        ExpandOpen: Tree.Scan = {
            node: Tree.Index = GetNode[t];
            base: Tree.Link Ź tb[node].son[2];
            shared: BOOL = Shared[base];
            expand: Tree.Link Ź ExpandTree[tb[node].son[1]];
            IF copying
                THEN {
                    PushTree[expand];
                    IF NOT shared
                        THEN PushTree[ExpandTree[base]]
                        ELSE {
                            copy: Tree.Link;
                            p: SharingList Ź MimZones.tempZone.NEW[SharingItem];
                            MarkShared[base, FALSE];
                            PushTree[copy Ź ExpandTree[base]];
                            MarkShared[base, TRUE];
                            p­ Ź [old: base, new: copy, next: sharingMap];
                            sharingMap Ź p;
                            MarkShared[copy, TRUE];
                            };
                    PushNode[item, 2];
                    SetInfo[tb[node].info];
                    n Ź n+1;
                    }
                ELSE {
                    <<A simple update>>
                    tb[node].son[1] Ź expand;
                    IF shared THEN MarkShared[base, FALSE];
                    tb[node].son[2] Ź base Ź ExpandTree[base];
                    IF shared THEN MarkShared[base, TRUE];
                    };
            };
        n: CARDINAL Ź 0;
        v Ź t;
        ScanList[t, ExpandOpen];
        IF copying THEN v Ź MakeList[n];
        };
<<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;
        };

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

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

    ExitBlock: PROC [node: Tree.Index, bodyNode: Tree.Index Ź Tree.nullIndex] = {
        oldBti: BTIndex = SymbolOps.ToBti[tb[node].info];
        newBti: BTIndex = currentEnclosing;
        tb[node].info Ź SymbolOps.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];
        SetEnclosing[SymbolOps.ParentBti[SymbolOps.own, currentEnclosing]];
        };

    MakeEnclosingBody: PROC
    [ctx: CTXIndex, sourceIndex: CARDŹ0, oldBti: BTIndexŹBTNull]
    RETURNS [newBti: BTIndex] = {
        newSon: BTIndex;
        IF oldBti = BTNull
            THEN {
                newBti Ź (MimData.table).Units[bodyType, BodyRecord.Other.SIZE];
                newSon Ź BTNull;
                }
            ELSE {
                newSon Ź bb[oldBti].firstSon;
                SymbolOps.DelinkBti[oldBti];
                newBti Ź oldBti;
                };
        bb[newBti] Ź BodyRecord[
            link: ,
            firstSon: newSon,
            type: BodyType[ctx],
            localCtx: ctx,
            level: currentLevel,
            class: Blank,
            sourceIndex: (IF bodyNesting = 0 THEN (SourceMap.nullLoc).Down ELSE sourceIndex),
            info: BodyInfo[cases: Internal[
                bodyTree: Tree.nullIndex,
                thread: Tree.nullIndex,
                frameSize: 0]],
            extension: Other[relOffset: ]];
        SymbolOps.LinkBti[bti: newBti, parent: currentEnclosing];
        SetEnclosing[newBti];
        };

    EnterBody: PROC [node: Tree.Index] = { 
        oldBti: CBTIndex = LOOPHOLE[SymbolOps.ToBti[tb[node].info]];
        newBti: CBTIndex Ź oldBti;
        ioType: CSEIndex Ź CSENull;
        type: RecordSEIndex Ź RecordSENull;
        ctx: CTXIndex Ź CTXNull;
        level: ContextLevel = SymbolOps.NextLevel[currentLevel
            ! SymbolOps.StaticNestError => {MimosaLog.Error[staticNesting]; RESUME}];

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

        bodyNesting Ź bodyNesting + 1;
        IF NOT copying THEN SymbolOps.DelinkBti[oldBti];
        IF NOT copying AND (bb[oldBti].level > lL) = (level > lL)
            THEN {
                ctx Ź bb[oldBti].localCtx;
                IF ctx # CTXNull THEN SymbolOps.SetCtxLevel[ctx, level];
                ioType Ź bb[oldBti].ioType;
                type Ź bb[oldBti].type;
                newBti Ź oldBti;
                }
            ELSE {
                id: ISEIndex Ź bb[oldBti].id;
                bPtr: LONG POINTER TO BodyRecord.Callable Ź bbZone.NEW[BodyRecord.Callable];
                newBti Ź CBTRelative[bPtr];
                bPtr.kind Ź IF level <= lL THEN Outer ELSE Inner;
                IF NOT copying
                    THEN {
                        ctx Ź bb[oldBti].localCtx;
                        IF ctx # CTXNull THEN SymbolOps.SetCtxLevel[ctx, level];
                        ioType Ź bb[oldBti].ioType;
                        type Ź bb[oldBti].type;
                        bb[newBti].firstSon Ź bb[oldBti].firstSon;
                        }
                    ELSE {
                        oldCtx: CTXIndex Ź CTXNull;
                        IF id # ISENull THEN
                            id Ź SymbolOps.SearchContext[
                            SymbolOps.own, seb[id].hash, bb[currentEnclosing].localCtx];
                        ioType Ź SymbolOps.CopyXferType[bb[oldBti].ioType, NIL];
                        MapFormals[oldType: bb[oldBti].ioType, newType: ioType];
                        oldCtx Ź bb[oldBti].localCtx;
                        IF oldCtx # CTXNull THEN {
                            ctx Ź SymbolOps.NewCtx[level];
                            ctxb[ctx].seList Ź SymbolOps.MakeSeChain[ctx, CtxVars[oldCtx], FALSE];
                            MapIds[oldCtx, ctxb[ctx].seList, 0];
                            };
                        type Ź BodyType[ctx];
                        bb[newBti].firstSon Ź BTNull;
                        MimData.nBodies Ź MimData.nBodies+1;
                        IF level > lL THEN MimData.nInnerBodies Ź MimData.nInnerBodies+1;
                        };
                bPtr Ź @bb[newBti];  -- just in case things moved
                bPtr.type Ź type;
                bPtr.localCtx Ź ctx;
                bPtr.frameOffset Ź 0;
                bPtr.sourceIndex Ź bb[oldBti].sourceIndex;
                bPtr.info Ź bb[oldBti].info;
                bPtr.inline Ź bb[oldBti].inline;
                bPtr.resident Ź bb[oldBti].resident;
                bPtr.id Ź id;
                bPtr.ioType Ź ioType;
                bPtr.monitored Ź bb[oldBti].monitored;
                bPtr.entry Ź bb[oldBti].entry;
                bPtr.internal Ź bb[oldBti].internal;
                bPtr.noXfers Ź bb[oldBti].noXfers;
                bPtr.hints Ź bb[oldBti].hints;
                };
        bb[newBti].level Ź level;
        WITH t: seb[ioType] SELECT FROM
            transfer => {SetArgLevel[t.typeIn]; SetArgLevel[t.typeOut]};
            ENDCASE;
        SymbolOps.LinkBti[bti: newBti, parent: currentEnclosing];
        SetEnclosing[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 = SymbolOps.ParentBti[SymbolOps.own, newBti];
        UpdateLinks: Tree.Map = {
            v Ź t;
            WITH t SELECT GetTag[t] FROM
                subtree => {
                    node: Tree.Index = index;
                    SELECT tb[node].name FROM
                        block => {
                            bti: BTIndex = SymbolOps.ToBti[tb[node].info];
                            IF SymbolOps.ParentBti[SymbolOps.own, bti] = oldBti THEN {
                                SymbolOps.DelinkBti[bti];
                                SymbolOps.LinkBti[bti, newBti];
                                };
                            };
                        thread => {
                            IF SymbolOps.ToBti[tb[node].info] = oldBti THEN
                                tb[node].info Ź SymbolOps.FromBti[newBti];
                            tb[node].son[1] Ź UpdateLeaves[tb[node].son[1], UpdateLinks];
                            };
                        ENDCASE => v Ź UpdateLeaves[t, UpdateLinks]};
                ENDCASE;
            };
        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[SymbolOps.MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]];
        seb[rSei].typeInfo Ź record[
            painted: TRUE,
            bitOrder: targetBitOrder,
            grain: Target.bitsPerAU,
            machineDep: FALSE, spare: FALSE, list: FALSE,
            argument: FALSE, packed: FALSE, monitored: FALSE,
            hints: [
                unifield: FALSE, variant: FALSE,
                assignable: FALSE, comparable: FALSE, privateFields: TRUE,
                refField: FALSE, default: FALSE, voidable: FALSE],
            length: 0,
            fieldCtx: CTXNull,
            linkPart: notLinked[]];
        seb[rSei].fieldCtx Ź ctx;
        seb[rSei].mark3 Ź TRUE;
        };
<<id translation>>
    AppendSeChain: PROC [ctx: CTXIndex, chain: ISEIndex] = {
        last, next: ISEIndex;
        SELECT TRUE FROM
            chain = ISENull => {};
            (last Ź ctxb[ctx].seList) = ISENull => ctxb[ctx].seList Ź chain;
            ENDCASE => {
                UNTIL (next Ź SymbolOps.NextSe[SymbolOps.own, last]) = ISENull DO
                    last Ź next;
                    ENDLOOP;
                SymbolOps.SetSeLink[last, chain];
                };
        };

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

    AllocateAList: PROC [ctx: CTXIndex] RETURNS [aLink: AList] = {
        maxItems: CARDINAL = SymbolOps.CtxEntries[SymbolOps.own, ctx];
        aLink Ź MimZones.tempZone.NEW[ANode[maxItems]];
        aLink.ctx Ź ctx;
        };
<<mapping>>
    AllocateCopyEntries: PROC [nVars: CARDINAL] RETURNS [seChain: ISEIndex Ź ISENull] = {
        IF nVars # 0 THEN {
            IF copyCtx = CTXNull THEN copyCtx Ź SymbolOps.NewCtx[currentLevel];
            seChain Ź SymbolOps.MakeSeChain[copyCtx, nVars, TRUE];
            AppendSeChain[copyCtx, seChain];
            };
        };

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

    ExtractArgs: PROC
    [argType: RecordSEIndex, formalCtx: CTXIndex, node: Tree.Index]
    RETURNS [nAssigns: CARDINAL Ź 0] = {
        aLink: AList = AllocateAList[formalCtx];
        immutableArgs: BOOL = NOT ctxb[formalCtx].varUpdated;
        nVars: CARDINAL = SymbolOps.CtxEntries[SymbolOps.own, formalCtx];
        seChain: ISEIndex = AllocateCopyEntries[nVars];
        sei2: ISEIndex Ź seChain;
        IF declArgs THEN {
            vsei: ISEIndex Ź seChain;
            FOR sei1: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, formalCtx], SymbolOps.NextSe[SymbolOps.own, sei1] UNTIL sei1 = ISENull DO
                var: Tree.Link = [symbol[index: vsei]];
                IF immutableArgs THEN seb[vsei].immutable Ź TRUE;
                PushTree[var];
                PushTree[Tree.Null];
                PushTree[Tree.Null];
                PushNode[decl, 3];
                SetInfo[FromLoc[MimData.textIndex]];
                SetAttr[1, immutableArgs];
                SetAttr[3, TRUE];  -- needs decl processing
                vsei Ź SymbolOps.NextSe[SymbolOps.own, vsei];
                ENDLOOP;
            };
        FOR sei1: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, formalCtx], SymbolOps.NextSe[SymbolOps.own, 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[MimData.textIndex]];
            IncrCount[sei2];
            aLink.map[aLink.nItems] Ź [id: sei1, name: FALSE, val: val];
            aLink.nItems Ź aLink.nItems + 1;
            sei2 Ź SymbolOps.NextSe[SymbolOps.own, sei2];
            ENDLOOP;
        IF nVars # 0 THEN {
            PushList[nVars];
            PushNode[exlist, 1];
            SetInfo[SymbolOps.FromType[argType]];
            PushTree[tb[node].son[2]];
            tb[node].son[2] Ź Tree.Null;
            PushNode[extract, 2];
            SetInfo[FromLoc[MimData.textIndex]];
            nAssigns Ź 1;
            };
        PushAList[aLink];
        };

    MapArgs: PROC
    [formalCtx: CTXIndex, node: Tree.Index] RETURNS [nAssigns: CARDINAL Ź 0] = {
        MapArg: Tree.Map = {
            IF sei1 = ISENull
                THEN v Ź t
                ELSE {
                    name: BOOL Ź MapByName[sei1, t];
                    val: Tree.Link;
                    IF name
                        THEN {
                            AdjustForName[t];
                            val Ź t;
                            }
                        ELSE {
                            FillArgSe[copy: sei2, master: sei1];
                            val Ź [symbol[index: sei2]];
                            SELECT TRUE FROM
                                declArgs => {
                                    IF immutableArgs THEN seb[sei2].immutable Ź TRUE;
                                    PushTree[val];
                                    PushTree[Tree.Null];
                                    PushTree[t];
                                    PushNode[decl, 3];
                                    SetInfo[FromLoc[MimData.textIndex]];
                                    SetAttr[1, immutableArgs];
                                    SetAttr[3, TRUE];  -- needs decl processing
                                    IncrCount[sei2];  nAssigns Ź nAssigns + 1;
                                    };
                                t # Tree.Null => {
                                    PushTree[val];
                                    PushTree[t];
                                    PushNode[assign, 2];
                                    SetInfo[FromLoc[MimData.textIndex]];
                                    IncrCount[sei2];
                                    nAssigns Ź nAssigns + 1;
                                    };
                                ENDCASE;
                            sei2 Ź SymbolOps.NextSe[SymbolOps.own, sei2];
                            };
                    aLink.map[aLink.nItems] Ź [id: sei1, name: name, val: val];
                    aLink.nItems Ź aLink.nItems + 1;
                    sei1 Ź SymbolOps.NextSe[SymbolOps.own, sei1];
                    v Ź Tree.Null;
                    };
            };
        aLink: AList = AllocateAList[formalCtx];
        nVars: CARDINAL = CountVars[formalCtx, tb[node].son[2]];
        seChain: ISEIndex = AllocateCopyEntries[nVars];
        immutableArgs: BOOL = NOT ctxb[formalCtx].varUpdated;
        sei1: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, formalCtx];
        sei2: ISEIndex Ź seChain;
        tb[node].son[2] Ź UpdateList[tb[node].son[2], MapArg];
        PushAList[aLink];
        };

    MapIds: PROC [ctx: CTXIndex, chain: ISEIndex, nRefs: [0..1]] = {
        aLink: AList = AllocateAList[ctx];
        sei1: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, ctx];
        sei2: ISEIndex Ź chain;
        UNTIL sei1 = ISENull DO
            IF seb[sei1].idType # typeTYPE THEN {
                SymbolOps.CopyArgSe[sei2, sei1];
                IF seb[sei2].mark4 THEN
                    seb[sei2].idValue Ź SymbolOps.EncodeTreeIndex[Tree.nullIndex];
                seb[sei2].idInfo Ź  SymbolOps.EncodeCard[nRefs];
                aLink.map[aLink.nItems] Ź [id: sei1, name: FALSE, val: [symbol[index: sei2]]];
                aLink.nItems Ź aLink.nItems + 1;
                sei2 Ź SymbolOps.NextSe[SymbolOps.own, sei2]};
            sei1 Ź SymbolOps.NextSe[SymbolOps.own, 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 NOT aLink.map[i].name THEN seb[index].mark4 Ź TRUE;
                ENDCASE;
            aLink.map[i].val Ź DiscardTree[aLink.map[i].val];
            ENDLOOP;
        MimZones.tempZone.FREE[@aLink];
        };

    MapFields: PROC [oldRecord, newRecord: CSEIndex, nRefs: [0..1]] = {
        oldCtx: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, oldRecord];
        IF oldCtx # CTXNull THEN {
            aLink: AList = AllocateAList[oldCtx];
            sei1: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, oldCtx];
            sei2: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own,
            SymbolOps.ArgCtx[SymbolOps.own, newRecord]];
            UNTIL sei1 = ISENull DO
                seb[sei2].idInfo Ź  SymbolOps.EncodeCard[nRefs];
                aLink.map[aLink.nItems] Ź [id: sei1, name: FALSE, val: [symbol[index: sei2]]];
                aLink.nItems Ź aLink.nItems + 1;
                sei1 Ź SymbolOps.NextSe[SymbolOps.own, sei1];
                sei2 Ź SymbolOps.NextSe[SymbolOps.own, 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 SymbolOps.ArgCtx[SymbolOps.own, t.typeOut] # CTXNull THEN UnmapIds[implicit];
                IF SymbolOps.ArgCtx[SymbolOps.own, t.typeIn] # CTXNull THEN UnmapIds[implicit];
                };
            ENDCASE;
        };
<<reference count adjustment>>
    CountedSei: PROC [sei: ISEIndex] RETURNS [BOOL] = {
        ctx: CTXIndex = seb[sei].idCtx;
        RETURN [NOT seb[sei].constant
        AND SymbolOps.CtxLevel[SymbolOps.own, ctx] # lZ
        AND ctxb[ctx].ctxType # included];
        };

    SampleCount: PROC [sei: ISEIndex] RETURNS [INT] = {
        IF seb[sei].idType # typeTYPE AND (NOT seb[sei].mark4 OR CountedSei[sei]) THEN
            RETURN [SymbolOps.DecodeInt[seb[sei].idInfo]];
        RETURN [-1];
        };

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

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

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

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

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

    ComputeArgCounts: PROC [type: CSEIndex, body: Tree.Link] = {
        typeIn, typeOut: RecordSEIndex;
        argCtx, resultCtx: CTXIndex;
        [typeIn, typeOut] Ź SymbolOps.TransferTypes[SymbolOps.own, 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 => {};
                            argCtx, resultCtx =>
                                seb[sei].idInfo Ź SymbolOps.EncodeCard[
                                SymbolOps.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;
                };
            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;
        };
<<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 Ź SymbolOps.FromBti[currentEnclosing];
        };
<<recovery>>
    Pass3PReset: MimosaEvents.Callback = {
        SELECT class FROM
            relocate => {
                tb Ź MimData.base[Tree.treeType];
                seb Ź MimData.base[seType];
                ctxb Ź MimData.base[ctxType];
                mdb Ź MimData.base[mdType];
                bb Ź MimData.base[bodyType];
                };
            zoneReset, cleanup => {
                WHILE aStack # NIL DO
                    next: AList Ź aStack.next;
                    MimZones.tempZone.FREE[@aStack];
                    aStack Ź next;
                    ENDLOOP;
                ResetSharingMap[];
                };
            ENDCASE;
        currentEnclosing Ź BTNull;
        currentLevel Ź 0;
        };

    ResetSharingMap: PROC = {
        WHILE sharingMap # NIL DO
            next: SharingList Ź sharingMap.next;
            MimZones.tempZone.FREE[@sharingMap];
            sharingMap Ź next;
            ENDLOOP;
        };
<<initialization>>
    MimosaEvents.RegisterSet[Pass3PReset, ALL[TRUE]];
}.