
    <<Pass3M.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 11, 1986 8:46:03 am PST>>
        <<Donahue,  9-Dec-81 14:45:35>>
        <<Maxwell, July 28, 1983 11:46 am>>
        <<Russ Atkinson (RRA) March 6, 1985 10:43:05 pm PST>>

    DIRECTORY
        A3: TYPE USING [Bundling, CanonicalType, DefaultInit, LongPath, NewableType, OperandInternal, OperandLhs, OperandType, TargetType, 
        TypeForTree, Unbundle, Voidable],
        Alloc: TYPE USING [Notifier, Top],
        ComData: TYPE USING [bodyIndex, idLOCK, idUNWIND, ownSymbols, seAnon, stopping, table, textIndex, typeCONDITION, typeListANY, 
        typeLOCK],
        ConvertUnsafe: TYPE USING [SubString],
        Log: TYPE USING [Error, ErrorNode, ErrorSei, ErrorTree, ErrorTreeOp],
        Pass3: TYPE USING [lockNode],
        P3: TYPE USING [Attr, fullAttr, NPUse, Safety, TextForm, pathNP, phraseNP, BoundNP, MergeNP, SequenceNP, SetNP, And, Apply, 
        BindTree, BumpArgRefs, CheckLength, CheckLocals, CheckScope, ClearRefStack, CopyTree, EnterType, EnterComposite, Exp, 
        FieldVoid, FirstId, InitialExp, KeyedList, MakeLongType, MakeRefType, MatchFields, PopCtx, PushCtx, RAttr, Rhs, RPop, 
        RPush, RType, SafetyAttr, SetSafety, SealRefStack, SearchCtxList, Stmt, TypeAppl, UnsealRefStack, UpdateTreeAttr, UType, 
        VoidComponent, VoidExp],
        P3S: TYPE USING [BodyData, continued, currentBody, markCatch, safety],
        SourceMap: TYPE USING [Loc],
        Symbols: TYPE USING [Base, HTIndex, SERecord, Type, ISEIndex, CSEIndex, RecordSEIndex, RefSEIndex, CTXIndex, BodyRecord, BTIndex, 
        CBTIndex, HTNull, nullType, ISENull, CSENull, RecordSENull, CTXNull, CBTNull, lG, lZ, RootBti, typeANY, seType, ctxType, 
        mdType, bodyType],
        SymbolOps: TYPE USING [ArgCtx, ArgRecord, CtxLevel, EnterString, EqTypes, FindString, FirstCtxSe, MakeNonCtxSe, NextSe, NormalType, 
        ReferentType, SetCtxLevel, TransferTypes, TypeForm, TypeRoot, UnderType, XferMode],
        Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, NullIndex, Scan, treeType],
        TreeOps: TYPE USING [FreeNode, FreeTree, GetNode, ListLength, MakeList, MakeNode, NthSon, PopTree, PushList, PushTree, PushSe, 
        PushNode, PutAttr, OpName, ReverseUpdateList, ScanList, SetAttr, SetInfo, UpdateList],
        Types: TYPE USING [Assignable, Equivalent];

    Pass3M: PROGRAM
        IMPORTS A3, Alloc, Log, P3, P3S, SymbolOps, TreeOps, Types, dataPtr: ComData, passPtr: Pass3
        EXPORTS P3 = {
        OPEN SymbolOps, Symbols, A3, P3, TreeOps;

        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 P3S.BodyData = @P3S.currentBody;

    <<statements>>

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

                signal, error, start, join, wait => {
                    PushTree[SELECT tb[node].name FROM
                        start => Start[node],
                        join => Join[node],
                        wait => Wait[node],
                        ENDCASE => Signal[node]];
                    SELECT RType[] FROM
                        CSENull, typeANY => NULL;
                        ENDCASE => Log.Error[nonVoidStmt];
                    SetInfo[dataPtr.textIndex];  val _ PopTree[];  RPop[];
                    pathNP _ SequenceNP[pathNP][phraseNP];
                    IF OpName[val] = error THEN current.reachable _ FALSE};

                xerror => {
                    subNode: Tree.Index;
                    IF current.catchDepth # 0 THEN Log.Error[misplacedReturn];
                    tb[node].name _ error;
                    val _ MiscStmt[node];  subNode _ GetNode[val];
                    IF tb[subNode].attr1 THEN Log.ErrorTree[typeClash, val];
                    SELECT tb[subNode].name FROM
                        error, errorx => tb[subNode].name _ xerror;
                        ENDCASE => NULL;
                    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 Log.Error[misplacedCatch];
                    current.reachable _ FALSE};

                resume => Resume[node];

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

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

                restart => {val _ Restart[node]; pathNP _ SequenceNP[pathNP][phraseNP]};

                stop => {
                    IF dataPtr.bodyIndex # RootBti OR current.catchDepth # 0
                        OR current.returnRecord # CSENull THEN Log.Error[misplacedStop];
                    dataPtr.stopping _ TRUE;  pathNP _ SetNP[pathNP]};

                notify, broadcast => {
                    OPEN tb[node];
                    type: Type;
                    IF ~current.lockHeld THEN Log.Error[misplacedMonitorRef];
                    son[1] _ Exp[son[1], typeANY];
                    IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonLHS, son[1]];
                    type _ RType[];  RPop[];  pathNP _ SequenceNP[pathNP][phraseNP];
                    IF ~EqTypes[type, dataPtr.typeCONDITION] THEN
                        Log.ErrorTreeOp[missingOp, son[1], name]
                    };

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

                dst, lst, lste, lstf => {
                    OPEN tb[node];
                    v: Tree.Link;
                    v _ son[1] _ Exp[son[1], typeANY];  RPop[];
                    SELECT name FROM
                        dst => IF OperandLhs[son[1]] = none THEN GO TO fail;
                        lst => NULL;
                        lste => current.noXfers _ FALSE;
                        lstf => current.reachable _ FALSE;
                        ENDCASE;
                    IF name = lste OR name = lstf THEN phraseNP _ SetNP[phraseNP];
                    pathNP _ SequenceNP[pathNP][phraseNP];
                    <<check for simple addressability>>
                    DO
                        WITH v SELECT FROM
                            symbol => IF seb[index].constant THEN GO TO fail ELSE EXIT;
                            subtree =>
                                SELECT tb[index].name FROM
                                    dollar, loophole => v _ tb[index].son[1]
                                    ENDCASE => GO TO fail;
                            ENDCASE => GO TO fail;
                        ENDLOOP;
                    IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node];
                    EXITS
                        fail => Log.ErrorTree[nonLHS, tb[node].son[1]]
                    };

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

                ENDCASE => Log.Error[unimplemented];

            RETURN};


    <<dynamic storage allocation>>

        New: PUBLIC PROC[node: Tree.Index, target: Type] = {
            OPEN tb[node];
            pType: RefSEIndex;
            subType: Type;
            attr: Attr;
            saveNP: NPUse;
            long, counted: BOOL;
            [v: son[1], long: long, counted: counted] _ EvalZone[son[1]];
            attr _ RAttr[];  RPop[];  saveNP _ phraseNP;
            current.noXfers _ attr.noXfer _ FALSE;  attr.const _ FALSE;
            son[2] _ TypeAppl[son[2]];
            attr _ And[attr, RAttr[]];  saveNP _ MergeNP[saveNP][phraseNP];  RPop[];
            subType _ TypeForTree[son[2]];
            IF ~NewableType[subType] THEN Log.ErrorTree[typeLength, son[2]];
            IF counted THEN EnterType[TypeRoot[subType], FALSE];
            IF son[3] = Tree.Null THEN son[3] _ 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;
                [son[3], extFlag] _ InitialExp[son[3], subType];
                SELECT TRUE FROM
                    extFlag => Log.ErrorTree[misusedInline, son[3]];
                    StringInit[son[3]] => Log.ErrorTree[defaultForm, son[3]];
                    ENDCASE};
            attr _ And[attr, RAttr[]];  phraseNP _ SequenceNP[saveNP][phraseNP];  RPop[];
            pType _ MakeRefType[
                cType: subType, readOnly: tb[node].attr1, counted: counted,
                hint: NormalType[target]];
            IF counted AND son[3] # Tree.Null THEN
                EnterComposite[UnderType[subType], son[3], TRUE];
            IF son[3] = Tree.Null AND ~Voidable[subType] THEN Log.ErrorNode[missingInit, node];
            IF nSons > 3 THEN {
                saveNP: NPUse = phraseNP;
                [] _ CatchPhrase[son[4]];  phraseNP _ MergeNP[saveNP][phraseNP]};
            attr2 _ long;  attr3 _ counted;
            RPush[IF long THEN MakeLongType[pType, target] ELSE pType, attr]};

        EvalZone: PROC[t: Tree.Link] RETURNS[v: Tree.Link, long, counted: BOOL] = {
            type: Type;
            nType: CSEIndex;
            nDerefs: CARDINAL;
            long _ counted _ TRUE;
            IF t = Tree.Null THEN {v _ Tree.Null;  RPush[typeANY, fullAttr]}
            ELSE {
                v _ Exp[t, typeANY];  type _ RType[];  nDerefs _ 0;
                DO
                    nType _ NormalType[type];
                    WITH s: seb[nType] SELECT FROM
                        zone => {long _ ~s.mds; counted _ s.counted; GO TO success};
                        ref => {
                            IF (nDerefs _ nDerefs + 1) > 63 THEN GO TO failure;
                            PushTree[v];  PushNode[uparrow, 1];  SetAttr[2, TypeForm[type] = $long];
                            type _ s.refType;  SetInfo[type];  v _ PopTree[]};
                        record =>
                            IF Bundling[nType] # 0 THEN type _ Unbundle[LOOPHOLE[nType, RecordSEIndex]]
                            ELSE GO TO failure;
                        ENDCASE => GO TO failure;
                    REPEAT
                        success => NULL;
                        failure => Log.ErrorTree[typeClash, v];
                    ENDLOOP};
            RETURN};

    <<list allocation>>

        Cons: PUBLIC PROC[node: Tree.Index, target: Type] RETURNS[Tree.Link] = {
            nType: Type = ReferentType[ListType[target, [subtree[node]]]];
            PushTree[tb[node].son[1]];  tb[node].son[1] _ Tree.Null;
            PushNode[implicitTC, 0];  SetInfo[UnderType[nType]];
            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 = ReferentType[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 Log.Error[keys];
                v _ SELECT TRUE FROM
                    (t = Tree.Null) => DefaultInit[componentType],
                    (OpName[t] = void) => FieldVoid[t],
                    ENDCASE => Rhs[t, cType];
                subAttr _ RAttr[];  type _ RType[];  RPop[];
                IF v = Tree.Null THEN VoidComponent[componentType]
                ELSE IF counted THEN EnterComposite[UnderType[componentType], v, TRUE];
                IF P3S.safety = checked AND TypeForm[type] = $transfer THEN
                    v _ CheckScope[v, type];
                exitNP _ MergeNP[exitNP][phraseNP];  attr _ And[attr, subAttr];
                started _ TRUE;  RETURN};

            [v: tb[node].son[1], long: long, counted: counted] _ EvalZone[tb[node].son[1]];
            attr _ RAttr[];  RPop[];  exitNP _ phraseNP;
            current.noXfers _ attr.noXfer _ FALSE;  attr.const _ FALSE;
            IF counted THEN EnterType[TypeRoot[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;
            RETURN};

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

        ItemType: PUBLIC PROC[nType: Type] RETURNS[Type] = {
            sei: CSEIndex = UnderType[nType];
            RETURN[WITH r: seb[sei] SELECT FROM
                record => seb[FirstCtxSe[r.fieldCtx]].idType,
                ENDCASE =>  typeANY]
            };


    <<control transfers>>

        MiscXfer: PUBLIC PROC[node: Tree.Index, target: Type] RETURNS[val: Tree.Link] = {
            SELECT tb[node].name FROM
                signalx, errorx => val _ Signal[node];
                create => val _ Create[node, target];
                startx => val _ Start[node];
                fork => val _ Fork[node, target];
                joinx => val _ Join[node];
                ENDCASE => {Log.Error[unimplemented]; val _ [subtree[node]]};
            RETURN};


        MakeFrameRecord: PUBLIC PROC[t: Tree.Link] RETURNS[rSei: CSEIndex] = {
            bti: CBTIndex = XferBody[t];
            IF bti # CBTNull THEN {
                argType: Type = TransferTypes[bb[bti].ioType].typeIn;
                rSei _ IF bb[bti].type # RecordSENull AND argType = nullType
                    THEN bb[bti].type
                    ELSE AllocFrameRecord[bti, argType]}
            ELSE {Log.Error[nonTypeCons]; rSei _ typeANY};
            RETURN};

        AllocFrameRecord: PROC[bti: CBTIndex, link: Type] RETURNS[sei: RecordSEIndex] = {
            sei _ LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.linked.SIZE]];
            seb[sei] _ SERecord[mark3: TRUE, mark4: FALSE,
                body: cons[record[
                    machineDep: FALSE,
                    painted: TRUE, argument: FALSE,
                    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[link]]]];
            RETURN};


        XferBody: PROC[t: Tree.Link] RETURNS[bti: CBTIndex] = {
            WITH t SELECT FROM
                symbol => {
                    sei: ISEIndex = index;
                    type: Type = seb[sei].idType;
                    bti _ SELECT TypeForm[type] FROM
                        $transfer =>
                            IF ~seb[sei].immutable
                                THEN CBTNull
                                ELSE
                                    SELECT XferMode[type] FROM
                                        $program =>
                                            IF seb[sei].mark4
                                                THEN (IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull)
                                                ELSE RootBti,
                                        $proc =>
                                            IF sei = bb[dataPtr.bodyIndex].id THEN dataPtr.bodyIndex ELSE CBTNull,
                                        ENDCASE => CBTNull,
                        ENDCASE => CBTNull
                    };
                ENDCASE => bti _ CBTNull;
            RETURN};

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


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

                CreateError: PROC = {Log.ErrorTreeOp[missingOp, son[1], create]; type _ typeANY};

                name _ create;  attr1 _ TRUE;
                son[1] _ Exp[son[1], typeANY];
                mType _ UType[];  attr _ RAttr[];  RPop[];  phraseNP _ SetNP[phraseNP];
                WITH m: seb[mType] SELECT FROM
                    transfer =>
                        IF m.mode = program THEN
                            SELECT XferBody[son[1]] FROM
                                CBTNull => type _ mType;
                                RootBti => {
                                    type _ (IF TypeForm[target] = $ref
                                        THEN MakeRefType[MakeFrameRecord[son[1]], target]
                                        ELSE mType);
                                    attr1 _ FALSE};
                                ENDCASE => CreateError[]
                        ELSE CreateError[];
                    ref => {
                        type _ mType; rType _ UnderType[m.refType];
                        WITH r: seb[rType] SELECT FROM
                            record =>
                                SELECT TRUE FROM
                                    (CtxLevel[r.fieldCtx] # lG) => CreateError[];
                                    (TypeForm[target] = $transfer) => {
                                        type _ XferForFrame[r.fieldCtx];
                                        IF type = CSENull THEN {Log.Error[unimplemented]; type _ typeANY}};
                                    ENDCASE;
                            ENDCASE =>  IF m.refType # typeANY THEN CreateError[]};
                    ENDCASE => IF mType = typeANY THEN type _ typeANY ELSE CreateError[];
                IF son[2] # Tree.Null THEN {
                    Log.ErrorTree[noApplication, son[1]]; son[2] _ UpdateList[son[2], VoidExp]};
                IF nSons > 2 THEN [] _ CatchPhrase[son[3]];
                current.noXfers _ attr.noXfer _ FALSE;  attr.const _ FALSE;
                RPush[type, attr];
                END;
            RETURN};


        Start: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            subNode: Tree.Index;
            subNode _ Apply[GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
            SELECT tb[subNode].name FROM
                start, startx, apply => NULL;
                ENDCASE => Log.ErrorTreeOp[missingOp, tb[subNode].son[1], start];
            tb[node].son[1] _ Tree.Null;  FreeNode[node];
            RETURN[[subtree[subNode]]]};


        Restart: PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            subNode: Tree.Index;
            type: Type;
            val _ ForceApplication[tb[node].son[1]];
            subNode _ GetNode[val];
                BEGIN  OPEN tb[subNode];
                name _ tb[node].name;  info _ tb[node].info;
                son[1] _ Exp[son[1], typeANY];  type _ RType[];  RPop[];
                phraseNP _ SetNP[phraseNP];
                SELECT TypeForm[type] FROM
                    $ref => NULL;        -- a weak check for now
                    $transfer =>
                        IF XferMode[type] # $program OR XferBody[son[1]] # CBTNull THEN
                            Log.ErrorTreeOp[missingOp, son[1], restart];
                    ENDCASE => IF type # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], restart];
                IF son[2] # Tree.Null THEN {
                    Log.ErrorTree[noApplication, son[1]]; son[2] _ UpdateList[son[2], VoidExp]};
                IF nSons > 2 THEN [] _ CatchPhrase[son[3]];
                END;
            current.noXfers _ FALSE;
            tb[node].son[1] _ Tree.Null;  FreeNode[node];  RETURN};


        Fork: PROC[node: Tree.Index, target: Type] RETURNS[Tree.Link] = {
            subNode: Tree.Index;
            type: CSEIndex;
            attr: Attr;
            t: Tree.Link _ ForceApplication[tb[node].son[1]];
            tb[node].son[1] _ Tree.Null;  FreeNode[node];
            subNode _ Apply[GetNode[t], typeANY, TRUE];  attr _ RAttr[];  RPop[];
            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]; Log.ErrorTree[misusedInline, s]};
                    IF current.lockHeld AND OperandInternal[s] THEN
                        Log.ErrorTree[internalCall, s];
                    subType _ UnderType[OperandType[s]];
                    WITH procType: seb[subType] SELECT FROM
                        transfer => {
                            type _ MakeNonCtxSe[SERecord.cons.transfer.SIZE];
                            seb[type] _ SERecord[mark3: TRUE, mark4: TRUE,
                                body: cons[transfer[
                                    mode: process, safe: procType.safe,
                                    typeIn: RecordSENull,
                                    typeOut: procType.typeOut]]];
                            IF P3S.safety = checked THEN {

                                CheckArg: Tree.Map = {
                                    argType: Type = OperandType[t];
                                    subType: CSEIndex = NormalType[argType];
                                    WITH s: seb[subType] SELECT FROM
                                        ref => {IF s.var THEN Log.ErrorTreeOp[unsafeOp, t, fork]; v _ t};
                                        transfer => v _ CheckScope[t, argType];
                                        ENDCASE => v _ t;
                                    RETURN};

                                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 => {Log.ErrorTreeOp[missingOp, tb[subNode].son[1], fork]; type _ typeANY};
            tb[subNode].info _ type;  RPush[type, attr];
            RETURN[[subtree[subNode]]]};

        Join: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            subNode: Tree.Index;
            subNode _ Apply[GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
            SELECT tb[subNode].name FROM
                join, joinx => NULL;
                apply => NULL;
                ENDCASE => Log.ErrorTreeOp[missingOp, tb[subNode].son[1], join];
            tb[node].son[1] _ Tree.Null;  FreeNode[node];
            RETURN[[subtree[subNode]]]};

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


    <<monitors>>

        LockVar: PUBLIC PROC[t: Tree.Link] RETURNS[val: Tree.Link] = {
            type: Type;
            nType: CSEIndex;
            desc: ConvertUnsafe.SubString;
            sei: ISEIndex;
            nDerefs: CARDINAL;
            long, b: BOOL;

            Dereference: PROC [type: Type] = {
                PushTree[val];  PushNode[uparrow, 1];  SetInfo[type];  SetAttr[2, long];
                val _ PopTree[]};

            val _ Exp[t, typeANY];  long _ LongPath[val];
            type _ RType[];  RPop[];  nDerefs _ 0;
            DO
                IF EqTypes[type, dataPtr.typeLOCK] THEN {
                    IF nDerefs # 0 THEN Dereference[type]; GO TO success};
                type _ TypeRoot[type];  nType _ NormalType[type];
                WITH seb[nType] SELECT FROM
                    record => {
                        IF monitored THEN {
                            desc _ ["LOCK"L, 0, ("LOCK"L).length];
                            [b, sei] _ SearchCtxList[EnterString[desc], fieldCtx];
                            IF ~b THEN {Log.Error[noAccess]; sei _ dataPtr.seAnon};
                            PushTree[val];  PushSe[sei];
                            PushNode[IF nDerefs = 0 THEN dollar ELSE dot, 2];
                            SetInfo[dataPtr.idLOCK];  SetAttr[2, long];  val _ PopTree[];
                            GO TO success};
                        GO TO failure};
                    ref => {
                        IF (nDerefs _ nDerefs + 1) > 63 THEN GO TO failure;
                        long _ TypeForm[type] = $long;
                        IF nDerefs > 1 THEN Dereference[type];
                        type _ refType};
                    ENDCASE => GO TO failure;
                REPEAT
                    success => NULL;
                    failure => Log.ErrorTreeOp[missingOp, val, lock];
                ENDLOOP;
            IF OperandLhs[val] = none THEN Log.ErrorTree[nonLHS, val];
            RETURN};

        FindLockParams: PUBLIC PROC RETURNS[formal, actual: ISEIndex] = {
            node: Tree.Index = GetNode[tb[passPtr.lockNode].son[1]];
            found: BOOL;
            IF node = Tree.NullIndex THEN formal _ actual _ ISENull
            ELSE {
                formal _ FirstId[node];
                IF current.inputRecord = RecordSENull THEN found _ FALSE
                ELSE [found, actual] _ SearchCtxList[
                    seb[formal].hash,
                    seb[current.inputRecord].fieldCtx];
                IF ~found THEN actual _ ISENull};
            RETURN};


        LambdaApply: PROC[t: Tree.Link, formal, actual: ISEIndex] RETURNS[v: Tree.Link] = {

            BindFormal: PROC [sei: ISEIndex] RETURNS [Tree.Link] = {
                RETURN[[symbol[index: IF sei = formal THEN actual ELSE sei]]]};

            v _ BindTree[t, BindFormal];
            [] _ UpdateTreeAttr[v];
            RETURN};

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


    <<signals>>

        Signal: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            subNode: Tree.Index;
            nodeTag: Tree.NodeName = tb[node].name;
            subNode _ Apply[GetNode[ForceApplication[tb[node].son[1]]], typeANY, TRUE];
            SELECT tb[subNode].name FROM
                signal, signalx => tb[subNode].name _ nodeTag;
                error, errorx => {
                    SELECT nodeTag FROM 
                        signal, signalx => Log.ErrorTreeOp[missingOp, tb[subNode].son[1], nodeTag];
                        ENDCASE => NULL;
                    tb[subNode].name _ nodeTag};
                apply => NULL;
                ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
            tb[node].son[1] _ Tree.Null;  FreeNode[node];
            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] = {
            saveReachable: BOOL = current.reachable;
            savePathNP: NPUse = pathNP;
            saveSafety: Safety = P3S.safety;
            enclosingSafe: BOOL = (saveSafety = checked);
            entryNP, exitNP: NPUse;

            CatchItem: Tree.Scan = {
                node: Tree.Index = GetNode[t];
                type: CSEIndex _ typeANY;
                mixed, safe, error: BOOL _ FALSE;
                saveIndex: SourceMap.Loc = dataPtr.textIndex;

                CatchLabel: Tree.Map = {
                    subType: CSEIndex;
                    v _ Exp[t, typeANY];  subType _ UnderType[CanonicalType[RType[]]];  RPop[];
                    entryNP _ SequenceNP[entryNP][phraseNP];
                    WITH t: seb[subType] SELECT FROM
                        transfer =>
                            IF t.mode = signal OR t.mode = error THEN {
                                IF type = typeANY THEN type _ subType
                                ELSE IF ~Types.Equivalent[
                                    [dataPtr.ownSymbols, type], [dataPtr.ownSymbols, subType]] THEN
                                    mixed _ TRUE;
                                IF t.safe THEN safe _ TRUE;
                                IF t.mode = error THEN error _ TRUE}
                            ELSE Log.ErrorTree[typeClash, v];
                        ENDCASE => IF subType # typeANY THEN Log.ErrorTree[typeClash, v];
                    RETURN};

                dataPtr.textIndex _ tb[node].info;
                tb[node].son[1] _ UpdateList[tb[node].son[1], CatchLabel];
                IF mixed THEN type _ typeANY;
                tb[node].son[2] _ CatchBody[
                    tb[node].son[2], type, safe OR (error AND enclosingSafe)];
                IF tb[node].son[1] = Tree.Link[symbol[index: dataPtr.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[dataPtr.textIndex];
                        tb[node].son[2] _ MakeList[2]}};
                tb[node].info _ IF type # typeANY THEN type ELSE nullType;
                dataPtr.textIndex _ saveIndex;  RETURN};

            CatchBody: PROC [body: Tree.Link, type: CSEIndex, safe: BOOL]
                RETURNS [val: Tree.Link] = {
                saveRecord:  RecordSEIndex = current.resumeRecord;
                saveFlag: BOOL = current.resumeFlag;
                current.catchDepth _ current.catchDepth + 1;
                WITH t: seb[type] SELECT FROM
                    transfer => {
                        current.resumeFlag _ t.mode = signal;
                        PushArgCtx[t.typeIn];
                        BumpArgRefs[ArgRecord[t.typeIn], TRUE];
                        PushArgCtx[current.resumeRecord _ ArgRecord[t.typeOut]];
                        ClearRefStack[]};
                    ENDCASE => {
                        current.resumeFlag _ FALSE; current.resumeRecord _ RecordSENull};
                current.reachable _ TRUE;  pathNP _ entryNP;
                SELECT OpName[body] FROM
                    block, checked => SetSafety[SafetyAttr[GetNode[body]]]; 
                    ENDCASE;
                IF safe AND P3S.safety = none THEN Log.Error[unsafeBlock];
                val _ UpdateList[body, Stmt ! InsertCatchLabel => {IF catchSeen THEN RESUME}];
                exitNP _ BoundNP[exitNP][pathNP];
                WITH t: seb[type] SELECT FROM
                    transfer => {PopArgCtx[t.typeOut]; PopArgCtx[t.typeIn]};
                    ENDCASE;
                current.catchDepth _ current.catchDepth - 1;
                current.resumeRecord _ saveRecord;  current.resumeFlag _ saveFlag;
                SetSafety[saveSafety];  RETURN};

            setLabel, continued: BOOL;
            node: Tree.Index = GetNode[t];
            SealRefStack[];
            setLabel _ continued _ unwindCaught _ FALSE;  entryNP _ exitNP _ none;
                BEGIN
                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];
                END;
            IF setLabel THEN {P3S.markCatch _ TRUE; P3S.continued _ continued};
            UnsealRefStack[];  current.reachable _ saveReachable;
            phraseNP _ exitNP;  pathNP _ savePathNP;  RETURN};

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

        PopArgCtx: PROC[sei: CSEIndex] = {
            ctx: CTXIndex = ArgCtx[sei];
            IF ctx # CTXNull THEN {PopCtx[]; SetCtxLevel[ctx, lZ]}};


        Resume: PROC[node: Tree.Index] = {
            OPEN tb[node];
            rSei: RecordSEIndex = current.resumeRecord;
            IF ~current.resumeFlag THEN Log.Error[misplacedResume];
            IF rSei # RecordSENull AND son[1] = Tree.Null THEN {
                n: CARDINAL _ 0;
                BumpArgRefs[rSei, FALSE];
                FOR sei: ISEIndex _ FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
                    n _ n+1; 
                    IF n=1 AND seb[sei].hash = HTNull THEN Log.Error[illDefinedReturn];
                    PushSe[sei];
                    ENDLOOP;
                son[1] _ MakeList[n]}
            ELSE {
                son[1] _ IF attr1 AND rSei # RecordSENull
                    THEN Rhs[son[1], rSei]
                    ELSE MatchFields[rSei, son[1]];
                RPop[];
                pathNP _ SequenceNP[pathNP][phraseNP]};
            current.reachable _ FALSE};


    <<Rope identification (temporary)>>

        CheckHash: PROC[hti: HTIndex, s: LONG STRING] RETURNS[BOOL] = {
            desc: ConvertUnsafe.SubString;
            desc _ [base: s, offset: 0, length: s.length];
            RETURN[FindString[desc] = hti]};

        TextRep: PUBLIC PROC[rType: Type] RETURNS[form: TextForm _ text] = {
            type: CSEIndex = UnderType[rType];
            rope: STRING = "Rope"L;
            ropeRep: STRING = "RopeRep"L;
            textRep: STRING = "TextRep"L;
            WITH se: seb[rType] SELECT FROM
                id =>
                    IF CheckHash[se.hash, ropeRep] THEN form _ $rope
                    ELSE IF CheckHash[se.hash, textRep] THEN form _ $ropeText;
                ENDCASE;
            WITH t: seb[type] SELECT FROM
                record =>
                    WITH c: ctxb[t.fieldCtx] SELECT FROM
                        included => IF ~CheckHash[mdb[c.module].moduleId, rope] THEN form _ $text;
                        ENDCASE => form _ $text;
                ENDCASE => form _ $text;
            RETURN};

        }.