<<>>
<<Pass3M.mesa>>
    <<Copyright Ó 1985, 1986, 1987, 1991 by Xerox Corporation.  All rights reserved.>>
    <<Satterthwaite, June 18, 1986 12:30:20 pm PDT>>
    <<Russ Atkinson (RRA) July 18, 1988 3:32:49 pm PDT>>

    DIRECTORY
        Alloc USING [Notifier, Top],
        ConvertUnsafe USING [SubString],
        MimData USING [bitsToAlignment, bodyIndex, idLOCK, idUNWIND, ownSymbols, seAnon, table, textIndex, typeCONDITION, typeListANY, 
        typeLOCK, worstAlignment],
        MimosaCopier USING [CompleteContext],
        MimosaLog USING [Error, ErrorNode, ErrorSei, ErrorTree, ErrorTreeOp],
        MimP3 USING [And, Apply, AssignDefaults, Attr, BindTree, BoundNP, BumpArgRefs, CheckLength, CheckLocals, CheckScope, ClearRefStack, 
        EnterComposite, EnterType, Exp, FieldVoid, FirstId, fullAttr, InitialExp, KeyedList, lockNode, MakeLongType, MakeRefType, 
        MatchFields, MergeNP, NPUse, pathNP, phraseNP, PopCtx, PushCtx, RAttrPop, Rhs, RPop, RPush, RType, Safety, SafetyAttr, 
        SealRefStack, SearchCtxList, SequenceNP, SetNP, SetSafety, SetType, Stmt, TextForm, TypeAppl, UnsealRefStack, 
        UpdateTreeAttr, UType, VoidComponent, VoidExp],
        MimP3S USING [BodyData, continued, currentBody, markCatch, safety],
        Pass3Attributes USING [AssignableType, Bundling, CanonicalType, DefaultInit, LongPath, LongType, NewableType, OperandInternal, 
        OperandLhs, OperandType, TargetType, TypeForTree, Unbundle, Voidable],
        SourceMap USING [Loc],
        Symbols USING [Base, BitOrder, BodyRecord, bodyType, BTFirst, BTIndex, CBTIndex, CBTNull, CSEIndex, CSENull, CTXIndex, CTXNull, 
        ctxType, HTIndex, HTNull, ISEIndex, ISENull, lG, lZ, mdType, nullType, RecordSEIndex, RecordSENull, RefSEIndex, RootBti, 
        SERecord, seType, Type, typeANY],
        SymbolOps USING [ArgCtx, ArgRecord, CopyXferType, CtxLevel, DecodeBti, EnterString, EqTypes, FindString, FirstCtxSe, FromType, 
        MakeNonCtxSe, NextSe, NormalType, own, ReferentType, SetCtxLevel, TransferTypes, TypeForm, TypeRoot, UnderType, XferMode],
        Target: TYPE MachineParms USING [bitOrder, bitsPerAU, bitsPerLongWord, bitsPerProcess, bitsPerProgram, bitsPerRef, bitsPerWord],
        Tree USING [Base, Index, Link, Map, NodeName, Null, nullIndex, Scan, treeType],
        TreeOps USING [FreeNode, FreeTree, FromLoc, GetNode, GetTag, IdentityMap, MakeList, MakeNode, NthSon, PopTree, PushTree, PushSe, 
        PushNode, PutAttr, OpName, ReverseUpdateList, ScanList, SetAttr, SetInfo, ToLoc, UpdateList],
        Types USING [Assignable, Equivalent];
Pass3M: PROGRAM
    IMPORTS Alloc, MimData, MimosaCopier, MimosaLog, MimP3, MimP3S, Pass3Attributes, SymbolOps, TreeOps, Types
    EXPORTS MimP3 = {
    OPEN MimP3, Pass3Attributes, Symbols, TreeOps;

    targetBitOrder: Symbols.BitOrder = SELECT Target.bitOrder FROM
        msBit => msBit, lsBit => lsBit, ENDCASE => ERROR;

    checkLong: BOOL = Target.bitsPerLongWord # Target.bitsPerWord;

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

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

    MiscNotify: PUBLIC Alloc.Notifier = {
        <<called by allocator whenever table area is repacked>>
        tb Ź base[Tree.treeType];
        seb Ź base[seType];
        ctxb Ź base[ctxType];
        mdb Ź base[mdType];
        bb Ź base[bodyType];
        };

    current: POINTER TO MimP3S.BodyData = @MimP3S.currentBody;
<<Statements>>
    MiscStmt: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
        name: Tree.NodeName = tb[node].name;
        val Ź [subtree[index: node]];    -- the default
        SELECT name FROM
            signal, error, start, join, wait => {
                new: Tree.Link;
                IF name = wait
                    THEN {
                        son1: Tree.Link Ź SampleAndFree[node, 1];
                        subNode: Tree.Index;
                        saveNP: NPUse;
                        IF NOT current.lockHeld THEN MimosaLog.Error[misplacedMonitorRef];
                        subNode Ź Apply[GetNode[ForceApplication[son1]], typeANY, TRUE];
                        SELECT tb[subNode].name FROM
                            wait, apply => NULL;
                            ENDCASE => MimosaLog.ErrorTreeOp[missingOp, tb[subNode].son[1], wait];
                        IF OperandLhs[tb[subNode].son[1]] = none THEN
                            MimosaLog.ErrorTree[nonLHS, tb[subNode].son[1]];
                        [] Ź FreeTree[tb[subNode].son[2]];
                        saveNP Ź phraseNP;
                        tb[subNode].son[2] Ź tb[subNode].son[1];
                        tb[subNode].son[1] Ź CopyLock[];
                        phraseNP Ź MergeNP[saveNP][phraseNP];
                        new Ź [subtree[subNode]];
                        }
                    ELSE new Ź MiscXfer[node, typeANY];
                PushTree[new];
                SELECT RType[] FROM
                    CSENull, typeANY => NULL;
                    ENDCASE => MimosaLog.Error[nonVoidStmt];
                SetInfo[FromLoc[MimData.textIndex]];
                val Ź PopTree[];
                RPop[];
                pathNP Ź SequenceNP[pathNP][phraseNP];
                IF name = error THEN current.reachable Ź FALSE;
                };
            xerror => {
                subNode: Tree.Index;
                IF current.catchDepth # 0 THEN MimosaLog.Error[misplacedReturn];
                tb[node].name Ź error;
                val Ź MiscStmt[node];  subNode Ź GetNode[val];
                IF tb[subNode].attr1 THEN MimosaLog.ErrorTree[typeClash, val];
                SELECT tb[subNode].name FROM
                    error, errorx => tb[subNode].name Ź xerror;
                    ENDCASE;
                tb[subNode].attr1 Ź current.entry;
                tb[subNode].attr3 Ź FALSE;
                IF current.entry THEN tb[subNode].attr2 Ź CheckLocals[tb[subNode].son[2]];
                IF tb[subNode].nSons > 2 THEN MimosaLog.Error[misplacedCatch];
                current.reachable Ź FALSE;
                };

            resume => {
                rSei: RecordSEIndex = current.resumeRecord;
                son: Tree.Link Ź tb[node].son[1];
                IF NOT current.resumeFlag THEN MimosaLog.Error[misplacedResume];
                IF rSei # RecordSENull AND son = Tree.Null
                    THEN {
                        n: CARDINAL Ź 0;
                        BumpArgRefs[rSei, FALSE];
                        FOR sei: ISEIndex Ź SymbolOps.FirstCtxSe[SymbolOps.own, seb[rSei].fieldCtx], SymbolOps.NextSe[SymbolOps.own, sei]
                        UNTIL sei = ISENull DO
                            n Ź n+1; 
                            IF n=1 AND seb[sei].hash = HTNull THEN MimosaLog.Error[illDefinedReturn];
                            PushSe[sei];
                            ENDLOOP;
                        tb[node].son[1] Ź son Ź MakeList[n];
                        }
                    ELSE {
                        tb[node].son[1] Ź son Ź IF tb[node].attr1 AND rSei # RecordSENull
                            THEN Rhs[son, rSei]
                            ELSE MatchFields[rSei, son];
                        RPop[];
                        pathNP Ź SequenceNP[pathNP][phraseNP];
                        };
                current.reachable Ź FALSE;
                };

            reject => {  
                IF current.catchDepth = 0 THEN MimosaLog.Error[misplacedResume];
                current.reachable Ź FALSE;
                };

            continue, retry => {
                SIGNAL InsertCatchLabel[catchSeen: FALSE, exit: name=continue];
                current.reachable Ź FALSE;
                };

            notify, broadcast => {
                type: Type;
                son1: Tree.Link Ź tb[node].son[1];
                IF ~current.lockHeld THEN MimosaLog.Error[misplacedMonitorRef];
                son1 Ź tb[node].son[1] Ź Exp[son1, typeANY];
                IF OperandLhs[son1] = none THEN MimosaLog.ErrorTree[nonLHS, son1];
                type Ź RType[];
                RPop[];
                pathNP Ź SequenceNP[pathNP][phraseNP];
                IF ~SymbolOps.EqTypes[SymbolOps.own, type, MimData.typeCONDITION] THEN
                    MimosaLog.ErrorTreeOp[missingOp, son1, name]
                };

            free => {
                type: Type;
                subType, nType: CSEIndex;
                long, counted: BOOL;
                son1: Tree.Link Ź tb[node].son[1];
                son2: Tree.Link Ź tb[node].son[2];
                [v: son1, long: long, counted: counted] Ź EvalZone[son1];
                tb[node].son[1] Ź son1;
                RPop[];
                IF counted AND OpName[son2] = addr THEN PutAttr[son2, 1, TRUE];
                son2 Ź tb[node].son[2] Ź Exp[son2, typeANY];
                type Ź RType[];
                RPop[];
                subType Ź SymbolOps.NormalType[SymbolOps.own, type];
                WITH s: seb[subType] SELECT FROM
                    ref => {
                        IF s.readOnly THEN MimosaLog.ErrorTree[typeClash, son2];
                        IF checkLong AND long # LongType[s.refType] THEN GO TO fail;
                        nType Ź SymbolOps.NormalType[SymbolOps.own, s.refType];
                        WITH t: seb[nType] SELECT FROM
                            ref => IF t.counted # counted THEN GO TO fail;
                            ENDCASE => GO TO fail;
                        IF MimP3S.safety = checked AND ~counted THEN
                            MimosaLog.ErrorNode[unsafeOperation, node];
                        EXITS
                            fail => MimosaLog.ErrorTree[typeClash, son2];
                        };
                    ENDCASE => MimosaLog.ErrorTree[typeClash, son2];
                IF tb[node].nSons > 3 THEN {
                    saveNP: NPUse = phraseNP;
                    [] Ź CatchPhrase[tb[node].son[4]];
                    phraseNP Ź MergeNP[saveNP][phraseNP];
                    };
                tb[node].attr2 Ź long;
                tb[node].attr3 Ź counted;
                SELECT TRUE FROM
                    NOT counted =>
                        tb[node].attr1 Ź FALSE;
                    (OpName[son2] # addr) => {
                        MimosaLog.ErrorTree[nonVar, son2];
                        tb[node].attr1 Ź FALSE;
                        };
                    ENDCASE =>
                        tb[node].attr1 Ź OperandLhs[NthSon[son2, 1]] = counted;
                };

            enable => {
                saveEnabled: BOOL = current.unwindEnabled;
                IF CatchPhrase[tb[node].son[1]].unwindCaught THEN current.unwindEnabled Ź TRUE;
                IF phraseNP # none THEN pathNP Ź unsafe;
                tb[node].son[2] Ź UpdateList[tb[node].son[2], Stmt];
                tb[node].attr3 Ź FALSE;
                current.unwindEnabled Ź saveEnabled;
                };

            ENDCASE => MimosaLog.Error[unimplemented];
        };
<<Dynamic storage allocation>>
    New: PUBLIC PROC [node: Tree.Index, target: Type] = {
        pType: RefSEIndex;
        subType: Type;
        attr: Attr;
        saveNP: NPUse;
        long, counted: BOOL;
        zoneTree: Tree.Link Ź tb[node].son[1];
        typeTree: Tree.Link Ź tb[node].son[2];
        initTree: Tree.Link Ź tb[node].son[3];
        [v: zoneTree, long: long, counted: counted] Ź EvalZone[zoneTree];
        tb[node].son[1] Ź zoneTree;
        attr Ź RAttrPop[];
        saveNP Ź phraseNP;
        current.noXfers Ź attr.noXfer Ź attr.const Ź FALSE;
        tb[node].son[2] Ź typeTree Ź TypeAppl[typeTree];
        attr Ź And[attr, RAttrPop[]];
        saveNP Ź MergeNP[saveNP][phraseNP];
        subType Ź TypeForTree[typeTree];
        IF NOT NewableType[subType] THEN MimosaLog.ErrorTree[typeLength, typeTree];
        IF counted THEN EnterType[SymbolOps.TypeRoot[SymbolOps.own, subType], FALSE];
        IF initTree = Tree.Null
            THEN
                <<No explicit initialization>>
                initTree Ź DefaultInit[subType]
            ELSE {
                StringInit: PROC [t: Tree.Link] RETURNS [BOOL] = INLINE {
                    RETURN [SELECT OpName[t] FROM
                        stringinit => TRUE,
                        lengthen => (OpName[NthSon[t, 1]] = stringinit),
                        ENDCASE => FALSE]
                    };
                extFlag: BOOL;
                [initTree, extFlag] Ź InitialExp[initTree, subType];
                SELECT TRUE FROM
                    extFlag => MimosaLog.ErrorTree[misusedInline, initTree];
                    StringInit[initTree] => MimosaLog.ErrorTree[defaultForm, initTree];
                    ENDCASE => initTree Ź CheckInit[initTree, subType, counted];
                };
        tb[node].son[3] Ź initTree;
        attr Ź And[attr, RAttrPop[]];
        phraseNP Ź SequenceNP[saveNP][phraseNP];
        pType Ź MakeRefType[
            cType: subType,
            bits: Target.bitsPerRef,
            readOnly: tb[node].attr1, counted: counted,
            hint: SymbolOps.NormalType[SymbolOps.own, target]];
        IF initTree = Tree.Null
            THEN {
                <<No explicit or default initialization>>
                IF NOT Voidable[subType] THEN MimosaLog.ErrorNode[missingInit, node];
                }
            ELSE {
                <<Explicit initialization>>
                IF counted THEN
                    EnterComposite[SymbolOps.UnderType[SymbolOps.own, subType], initTree, TRUE];
                };
        IF tb[node].nSons > 3 THEN {
            saveNP: NPUse = phraseNP;
            [] Ź CatchPhrase[tb[node].son[4]];
            phraseNP Ź MergeNP[saveNP][phraseNP];
            };
        tb[node].attr2 Ź long;
        tb[node].attr3 Ź counted;
        RPush[IF checkLong AND long THEN MakeLongType[pType, target] ELSE pType, attr];
        };

    EvalZone: PROC [t: Tree.Link] RETURNS [v: Tree.Link, long, counted: BOOL] = {
        long Ź counted Ź TRUE;
        IF t = Tree.Null
            THEN {v Ź Tree.Null;  RPush[typeANY, fullAttr]}
            ELSE {
                nDerefs: CARDINAL Ź 0;
                type: Type;
                v Ź Exp[t, typeANY];
                type Ź RType[];
                DO
                    nType: CSEIndex Ź SymbolOps.NormalType[SymbolOps.own, type];
                    WITH s: seb[nType] SELECT FROM
                        zone => {
                            long Ź ~s.mds;
                            counted Ź s.counted;
                            GO TO success;
                            };
                        ref => {
                            IF (nDerefs Ź nDerefs + 1) > 16 THEN GO TO failure;
                            PushTree[v];
                            PushNode[uparrow, 1];
                            SetAttr[2, LongType[type]];
                            type Ź s.refType;
                            SetType[type];
                            v Ź PopTree[];
                            };
                        record =>
                            IF Bundling[nType] # 0
                                THEN type Ź Unbundle[LOOPHOLE[nType, RecordSEIndex]]
                                ELSE GO TO failure;
                        ENDCASE => GO TO failure;
                    ENDLOOP;
                EXITS
                    success => {};
                    failure => MimosaLog.ErrorTree[typeClash, v];
                };
        };
<<List allocation>>
    Cons: PUBLIC PROC [node: Tree.Index, target: Type] RETURNS [Tree.Link] = {
        type: Type = SymbolOps.ReferentType[SymbolOps.own, ListType[target, [subtree[node]]]];
        PushTree[tb[node].son[1]];
        tb[node].son[1] Ź Tree.Null;
        PushNode[implicitTC, 0];
        SetType[SymbolOps.UnderType[SymbolOps.own, type]];
        CheckLength[tb[node].son[2], 2];
        PushTree[tb[node].son[2]];
        tb[node].son[2] Ź Tree.Null;
        PushTree[Tree.Null];
        PushNode[apply, -2];
        SetAttr[1, FALSE];
        IF tb[node].nSons > 2
            THEN {
                PushTree[tb[node].son[3]];
                tb[node].son[3] Ź Tree.Null;
                PushNode[new, 4];
                }
            ELSE PushNode[new, 3];
        FreeNode[node];
        RETURN [Exp[PopTree[], target]];
        };

    ListCons: PUBLIC PROC [node: Tree.Index, target: Type] = {
        lType: CSEIndex = ListType[target, [subtree[node]]];
        nType: Type = SymbolOps.ReferentType[SymbolOps.own, lType];
        componentType: Type = ItemType[nType];
        cType: Type = TargetType[componentType];
        attr: Attr;
        exitNP: NPUse;
        long, counted: BOOL;
        started: BOOL Ź FALSE;
        MapValue: Tree.Map = {
            type: Type;
            subAttr: Attr;
            IF ~started AND KeyedList[t] THEN MimosaLog.Error[keys];
            v Ź SELECT TRUE FROM
                (t = Tree.Null) => DefaultInit[componentType],
                (OpName[t] = void) => FieldVoid[t],
                ENDCASE => Rhs[t, cType];
            type Ź RType[];
            subAttr Ź RAttrPop[];
            SELECT TRUE FROM
                v = Tree.Null =>
                    VoidComponent[componentType];
                counted =>
                    EnterComposite[SymbolOps.UnderType[SymbolOps.own, componentType], v, TRUE];
                ENDCASE;
            v Ź CheckInit[v, type, TRUE];
            exitNP Ź MergeNP[exitNP][phraseNP];
            attr Ź And[attr, subAttr];
            started Ź TRUE;
            };
        [v: tb[node].son[1], long: long, counted: counted] Ź EvalZone[tb[node].son[1]];
        attr Ź RAttrPop[];
        exitNP Ź phraseNP;
        current.noXfers Ź attr.noXfer Ź attr.const Ź FALSE;
        IF counted THEN EnterType[SymbolOps.TypeRoot[SymbolOps.own, nType], FALSE];
        tb[node].son[2] Ź ReverseUpdateList[tb[node].son[2], MapValue];
        tb[node].attr2 Ź long;
        tb[node].attr3 Ź counted;
        RPush[lType, attr];
        phraseNP Ź exitNP;
        };

    ListType: PROC [target: Type, t: Tree.Link] RETURNS [lType: CSEIndex] = {
        subType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, target];
        WITH r: seb[subType] SELECT FROM
            ref => {
                rType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, r.refType];
                IF ~r.list AND (seb[rType].typeTag = any OR rType = typeANY)
                    THEN
                        lType Ź MimData.typeListANY
                    ELSE {
                        IF ~r.list
                            THEN {MimosaLog.ErrorTree[typeClash, t]; lType Ź typeANY}
                            ELSE lType Ź SymbolOps.UnderType[SymbolOps.own, target];
                        };
                };
            ENDCASE =>
                IF subType = typeANY
                    THEN lType Ź MimData.typeListANY
                    ELSE {MimosaLog.ErrorTree[typeClash, t]; lType Ź typeANY};
        };

    ItemType: PUBLIC PROC [nType: Type] RETURNS [Type] = {
        sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, nType];
        WITH r: seb[sei] SELECT FROM
            record => RETURN [seb[SymbolOps.FirstCtxSe[SymbolOps.own, r.fieldCtx]].idType];
            ENDCASE =>  RETURN [typeANY];
        };
<<Control transfers>>
    MiscXfer: PUBLIC PROC [node: Tree.Index, target: Type] RETURNS [val: Tree.Link] = {
        val Ź [subtree[node]];
        SELECT tb[node].name FROM
            signal, error, signalx, errorx => val Ź Signal[node];
            create => val Ź Create[node, target];
            start, startx => {
                subNode: Tree.Index Ź Apply[
                GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
                SELECT tb[subNode].name FROM
                    start, startx, apply => NULL;
                    ENDCASE => MimosaLog.ErrorTreeOp[missingOp, tb[subNode].son[1], start];
                tb[node].son[1] Ź Tree.Null;
                FreeNode[node];
                val Ź [subtree[subNode]];
                };
            fork => val Ź Fork[node, target];
            join, joinx => {
                son1: Tree.Link Ź SampleAndFree[node, 1];
                subNode: Tree.Index Ź Apply[GetNode[ForceApplication[son1]], typeANY, TRUE];
                SELECT tb[subNode].name FROM
                    join, joinx, apply => {};
                    ENDCASE => MimosaLog.ErrorTreeOp[missingOp, tb[subNode].son[1], join];
                val Ź [subtree[subNode]];
                };
            ENDCASE => MimosaLog.Error[unimplemented];
        };

    MakeFrameRecord: PUBLIC PROC [t: Tree.Link] RETURNS [rSei: CSEIndex Ź typeANY] = {
        bti: CBTIndex = XferBody[t];
        IF bti # CBTNull
            THEN {
                argType: Type = SymbolOps.TransferTypes[SymbolOps.own, bb[bti].ioType].typeIn;
                rSei Ź bb[bti].type;
                IF rSei = RecordSENull OR argType # nullType THEN {
                    <<Allocate the frame record>>
                    rSei Ź LOOPHOLE[SymbolOps.MakeNonCtxSe[SERecord.cons.record.linked.SIZE]];
                    seb[rSei] Ź SERecord[mark3: TRUE, mark4: FALSE, body: cons[
                        align: MimData.worstAlignment,
                        typeInfo: record[
                            painted: TRUE,
                            machineDep: FALSE, argument: FALSE, packed: FALSE, spare: FALSE, list: FALSE,
                            bitOrder: targetBitOrder,
                            grain: Target.bitsPerAU,
                            hints: [
                                unifield: FALSE, variant: FALSE,
                                assignable: FALSE, comparable: FALSE, privateFields: TRUE,
                                refField: TRUE, default: FALSE, voidable: FALSE],
                            fieldCtx: bb[bti].localCtx,
                            length: IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length ELSE 0,
                            monitored: bb[bti].monitored,
                            linkPart: linked[argType]]]];
                    };
                WITH r: seb[rSei] SELECT FROM
                    record => {
                        ctx: CTXIndex Ź r.fieldCtx;
                        WITH ct: ctxb[ctx] SELECT FROM
                            included => MimosaCopier.CompleteContext[LOOPHOLE[ctx], rc];
                            ENDCASE;
                        };
                    ENDCASE => ERROR;
                }
            ELSE MimosaLog.Error[nonTypeCons];
        };

    XferBody: PROC [t: Tree.Link] RETURNS [bti: CBTIndex Ź CBTNull] = {
        WITH t SELECT GetTag[t] FROM
            symbol => {
                sei: ISEIndex = index;
                type: Type = seb[sei].idType;
                SELECT SymbolOps.TypeForm[SymbolOps.own, type] FROM
                    $transfer =>
                        IF seb[sei].immutable THEN
                            SELECT SymbolOps.XferMode[SymbolOps.own, type] FROM
                                $program =>
                                    SELECT TRUE FROM
                                        ~ seb[sei].mark4 => bti Ź RootBti;
                                        seb[sei].constant => bti Ź SymbolOps.DecodeBti[seb[sei].idInfo];
                                        ENDCASE;
                                $proc =>
                                    IF sei = bb[MimData.bodyIndex].id THEN bti Ź MimData.bodyIndex;
                                ENDCASE;
                    ENDCASE;
                };
            ENDCASE;
        };

    XferForFrame: PUBLIC PROC [ctx: CTXIndex] RETURNS [CSEIndex] = {
        bti: BTIndex Ź BTFirst;
        btLimit: BTIndex = (MimData.table).Top[bodyType];
        UNTIL bti = btLimit DO
            WITH entry: bb[bti] SELECT FROM
                Callable => {
                    IF entry.localCtx = ctx THEN RETURN [entry.ioType];
                    bti Ź bti + BodyRecord.Callable.SIZE;
                    };
                ENDCASE => bti Ź bti + BodyRecord.Other.SIZE;
            ENDLOOP;
        RETURN [CSENull];
        };

    Create: PROC [node: Tree.Index, target: Type] RETURNS [val: Tree.Link] = {
        subNode: Tree.Index Ź GetNode[
            val Ź ForceApplication[SampleAndFree[node, 1]]
            ];
        type, mType, rType: CSEIndex;
        attr: Attr;
        CreateError: PROC = {
            MimosaLog.ErrorTreeOp[missingOp, tb[subNode].son[1], create];
            type Ź typeANY;
            };
        tb[subNode].name Ź create;
        tb[subNode].attr1 Ź TRUE;
        tb[subNode].son[1] Ź Exp[tb[subNode].son[1], typeANY];
        mType Ź UType[];
        attr Ź RAttrPop[];
        phraseNP Ź SetNP[phraseNP];
        WITH m: seb[mType] SELECT FROM
            transfer =>
                IF m.mode = program
                    THEN
                        SELECT XferBody[tb[subNode].son[1]] FROM
                            CBTNull => type Ź mType;
                            RootBti => {
                                type Ź (IF SymbolOps.TypeForm[SymbolOps.own, target] = $ref
                                    THEN MakeRefType[
                                        cType: MakeFrameRecord[tb[subNode].son[1]],
                                        hint: target,
                                        bits: Target.bitsPerProgram]
                                    ELSE mType);
                                tb[subNode].attr1 Ź FALSE};
                            ENDCASE => CreateError[]
                    ELSE CreateError[];
            ref => {
                type Ź mType;
                rType Ź SymbolOps.UnderType[SymbolOps.own, m.refType];
                WITH r: seb[rType] SELECT FROM
                    record =>
                        SELECT TRUE FROM
                            (SymbolOps.CtxLevel[SymbolOps.own, r.fieldCtx] # lG) => CreateError[];
                            (SymbolOps.TypeForm[SymbolOps.own, target] = $transfer) => {
                                type Ź XferForFrame[r.fieldCtx];
                                IF type = CSENull THEN {
                                    MimosaLog.Error[unimplemented];
                                    type Ź typeANY;
                                    };
                                };
                            ENDCASE;
                    ENDCASE =>  IF m.refType # typeANY THEN CreateError[];
                };
            ENDCASE => IF mType = typeANY THEN type Ź typeANY ELSE CreateError[];
        IF tb[subNode].son[2] # Tree.Null THEN {
            MimosaLog.ErrorTree[noApplication, tb[subNode].son[1]];
            tb[subNode].son[2] Ź UpdateList[tb[subNode].son[2], VoidExp];
            };
        IF tb[subNode].nSons > 2 THEN [] Ź CatchPhrase[tb[subNode].son[3]];
        current.noXfers Ź attr.noXfer Ź attr.const Ź FALSE;
        RPush[type, attr];
        };

    Fork: PROC [node: Tree.Index, target: Type] RETURNS [Tree.Link] = {
        subNode: Tree.Index;
        type: CSEIndex;
        attr: Attr;
        t: Tree.Link Ź ForceApplication[SampleAndFree[node, 1]];
        subNode Ź Apply[GetNode[t], typeANY, TRUE];
        attr Ź RAttrPop[];
        SELECT tb[subNode].name FROM
            call, callx => {
                s: Tree.Link Ź tb[subNode].son[1];
                subType: CSEIndex;
                IF OpName[s] = thread THEN {
                    s Ź NthSon[s, 1];
                    MimosaLog.ErrorTree[misusedInline, s];
                    };
                IF current.lockHeld AND OperandInternal[s] THEN
                    MimosaLog.ErrorTree[internalCall, s];
                subType Ź SymbolOps.UnderType[SymbolOps.own, OperandType[s]];
                WITH procType: seb[subType] SELECT FROM
                    transfer => {
                        type Ź SymbolOps.MakeNonCtxSe[SERecord.cons.transfer.SIZE];
                        seb[type] Ź SERecord[mark3: TRUE, mark4: TRUE, body: cons[
                            align: MimData.bitsToAlignment[Target.bitsPerProcess],
                            typeInfo: transfer[
                                mode: process,
                                safe: procType.safe,
                                typeIn: RecordSENull,
                                typeOut: procType.typeOut,
                                length: Target.bitsPerProcess]]];
                        IF MimP3S.safety = checked THEN {
                            CheckArg: Tree.Map = {
                                argType: Type = OperandType[t];
                                subType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, argType];
                                WITH s: seb[subType] SELECT FROM
                                    ref => {IF s.var THEN MimosaLog.ErrorTreeOp[unsafeOp, t, fork]; v Ź t};
                                    transfer => v Ź CheckScope[t, argType];
                                    ENDCASE => v Ź t;
                                };
                            tb[subNode].son[1] Ź CheckScope[s, subType];
                            tb[subNode].son[2] Ź UpdateList[tb[subNode].son[2], CheckArg];
                            };
                        };
                    ENDCASE => ERROR;
                tb[subNode].name Ź fork;
                };
            apply => type Ź typeANY;
            ENDCASE => {
                MimosaLog.ErrorTreeOp[missingOp, tb[subNode].son[1], fork];
                type Ź typeANY;
                };
        tb[subNode].info Ź SymbolOps.FromType[type];
        RPush[type, attr];
        RETURN [[subtree[subNode]]];
        };
<<Monitors>>
    LockVar: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Link] = {
        nDerefs: NAT Ź 0;
        val: Tree.Link Ź Exp[t, typeANY];
        long: BOOL Ź LongPath[val];
        type: Type Ź RType[];
        Dereference: PROC [type: Type] = {
            PushTree[val];
            PushNode[uparrow, 1];
            SetType[type];
            SetAttr[2, long];
            val Ź PopTree[];
            };
        RPop[];
        DO
            nType: CSEIndex;
            IF SymbolOps.EqTypes[SymbolOps.own, type, MimData.typeLOCK] THEN {
                IF nDerefs # 0 THEN Dereference[type];
                EXIT;
                };
            type Ź SymbolOps.TypeRoot[SymbolOps.own, type];
            nType Ź SymbolOps.NormalType[SymbolOps.own, type];
            WITH seb[nType] SELECT FROM
                record => {
                    IF monitored THEN {
                        b: BOOL;
                        sei: ISEIndex;
                        desc: ConvertUnsafe.SubString Ź ["LOCK"L, 0, ("LOCK"L).length];
                        [b, sei] Ź SearchCtxList[SymbolOps.EnterString[desc], fieldCtx];
                        IF ~b THEN {MimosaLog.Error[noAccess]; sei Ź MimData.seAnon};
                        PushTree[val];
                        PushSe[sei];
                        PushNode[IF nDerefs = 0 THEN dollar ELSE dot, 2];
                        SetType[MimData.idLOCK];
                        SetAttr[2, long];
                        val Ź PopTree[];
                        EXIT;
                        };
                    GO TO failure;
                    };
                ref => {
                    IF (nDerefs Ź nDerefs + 1) > 16 THEN GO TO failure;
                    long Ź LongType[type];
                    IF nDerefs > 1 THEN Dereference[type];
                    type Ź refType;
                    };
                ENDCASE => GO TO failure;
            REPEAT
                failure => MimosaLog.ErrorTreeOp[missingOp, val, lock];
            ENDLOOP;
        IF OperandLhs[val] = none THEN MimosaLog.ErrorTree[nonLHS, val];
        RETURN [val];
        };

    FindLockParams: PUBLIC PROC RETURNS [formal, actual: ISEIndex Ź ISENull] = {
        node: Tree.Index = GetNode[tb[MimP3.lockNode].son[1]];
        IF node # Tree.nullIndex THEN {
            formal Ź FirstId[node];
            IF current.inputRecord # RecordSENull THEN {
                found: BOOL;
                [found, actual] Ź SearchCtxList[
                    seb[formal].hash,
                    seb[current.inputRecord].fieldCtx];
                IF ~found THEN actual Ź ISENull;
                };
            };
        };

    CopyLock: PUBLIC PROC RETURNS [val: Tree.Link Ź Tree.Null] = {
        formal: ISEIndex Ź ISENull;
        actual: ISEIndex Ź ISENull;
        BindFormal: PROC [sei: ISEIndex] RETURNS [Tree.Link] = {
            RETURN [[symbol[index: IF sei = formal THEN actual ELSE sei]]];
            };
        SELECT TRUE FROM
            MimP3.lockNode = Tree.nullIndex => RETURN [Tree.Null];
            tb[current.bodyNode].son[4] # Tree.Null =>
                val Ź tb[current.bodyNode].son[4];
            ENDCASE => {
                [formal: formal, actual: actual] Ź FindLockParams[];
                IF formal # ISENull THEN {
                    IF actual = ISENull THEN {
                        MimosaLog.ErrorSei[missingLock, formal];
                        actual Ź MimData.seAnon;
                        };
                    IF ~Types.Assignable[
                        [MimData.ownSymbols,
                        SymbolOps.UnderType[SymbolOps.own, seb[formal].idType]],
                        [MimData.ownSymbols,
                        SymbolOps.UnderType[SymbolOps.own, seb[actual].idType]]] THEN
                        MimosaLog.ErrorSei[typeClash, actual];
                    };
                val Ź tb[MimP3.lockNode].son[2];
                };
        val Ź BindTree[val, BindFormal];
        [] Ź UpdateTreeAttr[val];
        };
<<Signals>>
    Signal: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
        nodeTag: Tree.NodeName = tb[node].name;
        son1: Tree.Link Ź SampleAndFree[node, 1];
        subNode: Tree.Index Ź Apply[GetNode[ForceApplication[son1]], typeANY, TRUE];
        SELECT tb[subNode].name FROM
            signal, signalx => tb[subNode].name Ź nodeTag;
            error, errorx => {
                SELECT nodeTag FROM 
                    signal, signalx =>
                        MimosaLog.ErrorTreeOp[missingOp, tb[subNode].son[1], nodeTag];
                    ENDCASE;
                tb[subNode].name Ź nodeTag;
                };
            apply => {};
            ENDCASE => MimosaLog.ErrorTree[typeClash, tb[subNode].son[1]];
        RETURN [[subtree[subNode]]];
        };

    ForceApplication: PROC [t: Tree.Link] RETURNS [Tree.Link] = {
        IF OpName[t] = apply THEN RETURN [t];
        PushTree[t];
        PushTree[Tree.Null];
        RETURN [MakeNode[apply, 2]];
        };
<<Catch phrases>>
    CatchPhrase: PUBLIC PROC [t: Tree.Link] RETURNS [unwindCaught: BOOL Ź FALSE] = {
        saveReachable: BOOL = current.reachable;
        savePathNP: NPUse = pathNP;
        saveSafety: Safety = MimP3S.safety;
        enclosingSafe: BOOL = (saveSafety = checked);
        entryNP, exitNP: NPUse Ź none;
        CatchItem: Tree.Scan = {
            node: Tree.Index = GetNode[t];
            type: CSEIndex Ź typeANY;
            mixed, safe, error: BOOL Ź FALSE;
            saveIndex: SourceMap.Loc = MimData.textIndex;
            CatchLabel: Tree.Map = {
                subType: CSEIndex;
                oops: BOOL Ź FALSE;
                v Ź Exp[t, typeANY];
                subType Ź SymbolOps.UnderType[SymbolOps.own, CanonicalType[RType[]]];
                RPop[];
                entryNP Ź SequenceNP[entryNP][phraseNP];
                WITH t: seb[subType] SELECT FROM
                    transfer =>
                        SELECT t.mode FROM
                            signal, error => {
                                SELECT TRUE FROM
                                    type = typeANY => type Ź subType;
                                    NOT Types.Equivalent[
                                    [MimData.ownSymbols, type],
                                    [MimData.ownSymbols, subType]] =>
                                        mixed Ź TRUE;
                                    ENDCASE;
                                IF t.safe THEN safe Ź TRUE;
                                IF t.mode = error THEN error Ź TRUE;
                                };
                            ENDCASE => oops Ź TRUE;
                    ENDCASE => oops Ź TRUE;
                SELECT TreeOps.OpName[v] FROM
                    errorx, signalx => oops Ź TRUE;
                        <<This also checks for errors & signals raised in the selectors>>
                    ENDCASE;
                IF oops THEN MimosaLog.ErrorTree[typeClash, v];
                };
            MimData.textIndex Ź ToLoc[tb[node].info];
            tb[node].son[1] Ź UpdateList[tb[node].son[1], CatchLabel];
            IF mixed THEN type Ź typeANY;
            IF type # typeANY AND type # nullType THEN {
                <<RRA: we need to copy the context, perhaps this will work?>>
                type Ź SymbolOps.CopyXferType[type, TreeOps.IdentityMap];
                };
            tb[node].son[2] Ź CatchBody[
                tb[node].son[2], type, safe OR (error AND enclosingSafe)];
            IF tb[node].son[1] = Tree.Link[symbol[index: MimData.idUNWIND]] THEN {
                unwindCaught Ź TRUE;
                IF current.entry AND ~current.unwindEnabled AND current.catchDepth = 0 THEN {
                    PushTree[tb[node].son[2]];  PushTree[CopyLock[]];
                    PushNode[unlock, 1];  SetInfo[FromLoc[MimData.textIndex]];
                    tb[node].son[2] Ź MakeList[2]}};
            tb[node].info Ź SymbolOps.FromType[IF type # typeANY THEN type ELSE nullType];
            MimData.textIndex Ź saveIndex;
            };
        CatchBody: PROC
        [body: Tree.Link, type: CSEIndex, safe: BOOL] RETURNS [Tree.Link] = {
            saveRecord: RecordSEIndex = current.resumeRecord;
            saveFlag: BOOL = current.resumeFlag;
            inType: CSEIndex Ź CSENull;
            outType: CSEIndex Ź CSENull;
            current.resumeFlag Ź FALSE;
            current.resumeRecord Ź RecordSENull;
            current.catchDepth Ź current.catchDepth + 1;
            WITH t: seb[type] SELECT FROM
                transfer => {
                    inType Ź t.typeIn;
                    outType Ź t.typeOut;
                    current.resumeFlag Ź t.mode = signal;
                    PushArgCtx[inType];
                    BumpArgRefs[SymbolOps.ArgRecord[SymbolOps.own, inType], TRUE];
                    current.resumeRecord Ź SymbolOps.ArgRecord[SymbolOps.own, outType];
                    PushArgCtx[current.resumeRecord];
                    ClearRefStack[];
                    };
                ENDCASE;
            current.reachable Ź TRUE;
            pathNP Ź entryNP;
            SELECT OpName[body] FROM
                block, checked => SetSafety[SafetyAttr[GetNode[body]]];
                ENDCASE;
            IF safe AND MimP3S.safety = none THEN MimosaLog.Error[unsafeBlock];
            body Ź UpdateList[body, Stmt ! InsertCatchLabel => {IF catchSeen THEN RESUME}];
            IF current.resumeRecord # RecordSENull THEN {
                <<We must declare the default resume values.  This was left out of previous versions of the compiler, leading to both incorrect 
                code and a safety violation.>>
            <<FURTHER NOTE!  This code inserts a tree already processed by Pass3.  Therefore we have to slip it in AFTER we have done the 
            UpdateList operation just above.  Otherwise we can see construct, union, and rowcons nodes in MimP3.Exp processing, 
            which is not kosher (results in "unimplemented construct" errors).>>
                ctx: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, outType];
                assigns: Tree.Link = MimP3.AssignDefaults[ctx, FALSE];
                bodyName: Tree.NodeName = OpName[body];
                SELECT bodyName FROM
                    block, checked => {
                        whichSon: NAT = IF bodyName = checked THEN 1 ELSE 2;
                        bodyNode: Tree.Index Ź GetNode[body];
                        PushTree[assigns];
                        PushTree[tb[bodyNode].son[whichSon]];
                        PushNode[list, 2];
                        tb[bodyNode].son[whichSon] Ź PopTree[];
                        };
                    ENDCASE => {
                        PushTree[assigns];
                        PushTree[body];
                        PushNode[list, 2];
                        body Ź PopTree[];
                        };
                };
            exitNP Ź BoundNP[exitNP][pathNP];
            WITH t: seb[type] SELECT FROM
                transfer => {PopArgCtx[outType]; PopArgCtx[inType]};
                ENDCASE;
            current.catchDepth Ź current.catchDepth - 1;
            current.resumeRecord Ź saveRecord;
            current.resumeFlag Ź saveFlag;
            SetSafety[saveSafety];
            RETURN [body];
            };
        setLabel, continued: BOOL Ź FALSE;
        node: Tree.Index = GetNode[t];
        SealRefStack[];
        {
            ENABLE InsertCatchLabel => {
                IF ~catchSeen THEN {
                    setLabel Ź TRUE;
                    IF exit THEN continued Ź TRUE;
                    SIGNAL InsertCatchLabel[catchSeen: TRUE, exit: exit]; RESUME}};
            ScanList[tb[node].son[1], CatchItem];
            IF tb[node].nSons > 1 THEN
                tb[node].son[2] Ź CatchBody[tb[node].son[2], typeANY, enclosingSafe];
            };
        IF setLabel THEN {MimP3S.markCatch Ź TRUE; MimP3S.continued Ź continued};
        UnsealRefStack[];
        current.reachable Ź saveReachable;
        phraseNP Ź exitNP;
        pathNP Ź savePathNP;
        };

    PushArgCtx: PROC [sei: CSEIndex] = INLINE {
        ctx: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, sei];
        IF ctx # CTXNull THEN {
            SymbolOps.SetCtxLevel[ctx, current.level + current.catchDepth];
            PushCtx[ctx];
            };
        };

    PopArgCtx: PROC [sei: CSEIndex] = INLINE {
        ctx: CTXIndex = SymbolOps.ArgCtx[SymbolOps.own, sei];
        IF ctx # CTXNull THEN {
            PopCtx[];
            SymbolOps.SetCtxLevel[ctx, lZ];
            };
        };
<<Recent utilities>>
    CheckInit: PROC [t: Tree.Link, type: Type, safe: BOOL] RETURNS [Tree.Link] = {
        ut: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type];
        IF NOT AssignableType[ut, FALSE] THEN
            SELECT TreeOps.OpName[t] FROM
                construct, rowcons => {};
                ENDCASE => MimosaLog.ErrorTreeOp[missingOp, t, assign];
        SELECT SymbolOps.TypeForm[SymbolOps.own, ut] FROM
            $transfer =>
                IF MimP3S.safety = checked THEN RETURN [CheckScope[t, ut]];
            ENDCASE;
        RETURN [t];
        };

    SampleAndFree: PROC [node: Tree.Index, index: NAT] RETURNS [v: Tree.Link] = INLINE {
        v Ź tb[node].son[index];
        tb[node].son[index] Ź Tree.Null;
        FreeNode[node]; 
        };
<<Rope identification (temporary)>>
    CheckHash: PROC [hti: HTIndex, s: LONG STRING] RETURNS [BOOL] = INLINE {
        desc: ConvertUnsafe.SubString = [base: s, offset: 0, length: s.length];
        RETURN [SymbolOps.FindString[SymbolOps.own, desc] = hti];
        };

    TextRep: PUBLIC PROC [rType: Type] RETURNS [form: TextForm Ź text] = {
        type: CSEIndex = SymbolOps.UnderType[SymbolOps.own, rType];
        WITH t: seb[type] SELECT FROM
            record =>
                WITH c: ctxb[t.fieldCtx] SELECT FROM
                    included => {
                        IF CheckHash[mdb[c.module].moduleId, "Rope"L] THEN
                            <<The type originally comes from the Rope interface>>
                            WITH se: seb[rType] SELECT FROM
                                id => {
                                    SELECT TRUE FROM
                                        CheckHash[se.hash, "RopeRep"L] => RETURN [$rope];
                                        CheckHash[se.hash, "TextRep"L] => RETURN [$ropeText];
                                        ENDCASE;
                                    };
                                ENDCASE;
                        };
                    ENDCASE;
            ENDCASE;
        };

    }.