
    <<Selection.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, May 5, 1986 3:56:47 pm PDT>>
        <<Paul Rovner, September 8, 1983 8:30 am>>
        <<Russ Atkinson (RRA) March 6, 1985 11:25:00 pm PST>>
        <<Sweet May 5, 1986 11:57:21 am PDT>>

    DIRECTORY
        Alloc USING [Notifier],
        Code USING [caseCVState, codeptr, mwCaseCV, xtracting],
        CodeDefs USING [Base, BoVarIndex, CaseCVState, CCIndex, CCItem, codeType, JumpCCNull, LabelCCIndex, LabelCCNull, Lexeme, NullLex, 
        OpWordCount, OtherCCIndex, VarComponent, VarIndex, VarNull],
        ComData USING [typeBOOL],
        FOpCodes USING [qGCRT, qLP, qPOP, qPUSH],
        P5 USING [CallCatch, EnterBlock, ExitBlock, Exp, FlowTree, GenAnonLex, LogHeapFree, PurgePendTempList, PushLex, PushRhs, 
        ReleaseTempLex, SAssign, StatementTree, SysCallN],
        P5L USING [ComponentForLex, CopyLex, CopyToTemp, EasyToLoad, FieldOfVarOnly, LoadVar, MakeBo, NormalizeExp, NormalLex, OVarItem, 
        ReleaseLex, TOSLex, VarForLex, Words],
        P5S USING [Assign],
        P5U USING [CCellAlloc, EnumerateCaseArms, FreeChunk, InsertLabel, LabelAlloc, MakeTreeLiteral, MarkedType, NilTree, OperandType, 
        Out0, OutJump, PushLitVal, ReferentType, TreeLiteral, TreeLiteralValue, TypeForTree, VariantTag, WordsForOperand],
        RTSD USING [sCheckForNarrowRefFault, sGetCanonicalProcType, sGetCanonicalSignalType, sRaiseNarrowFault],
        Stack USING [Decr, DeleteToMark, Dump, Incr, Mark, Off, On, ResetToMark],
        SymbolOps USING [RCType, TypeLink, UnderType, VariantField, WordsForType, XferMode],
        Symbols USING [Base, BTIndex, CSEIndex, ISEIndex, ISENull, seType, Type],
        SymLiteralOps USING [TypeRef],
        Tree USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType],
        TreeOps USING [FreeTree, GetNode, GetSe, ListLength, MarkShared, PopTree, PushNode, PushSe, PushTree, ScanList, SetAttr, SetInfo, 
        UpdateList];

    Selection: PROGRAM
        IMPORTS MPtr: ComData, CPtr: Code, P5U, P5L, P5, P5S,  Stack, SymbolOps, SymLiteralOps, TreeOps 
        EXPORTS CodeDefs, P5 = BEGIN OPEN CodeDefs;

        <<imported definitions>>

        Type: TYPE = Symbols.Type;
        ISEIndex: TYPE = Symbols.ISEIndex;
        ISENull: ISEIndex = Symbols.ISENull;
        CSEIndex: TYPE = Symbols.CSEIndex;
        BTIndex: TYPE = Symbols.BTIndex;

        tb: Tree.Base;        -- tree base (local copy)
        seb: Symbols.Base;        -- semantic entry base (local copy)
        cb: CodeDefs.Base;        -- code base (local copy)

        SelectionNotify: PUBLIC Alloc.Notifier =
            BEGIN  -- called by allocator whenever table area is repacked
            seb _ base[Symbols.seType];
            tb _ base[Tree.treeType];
            cb _ base[codeType];
            END;


        CaseDriver: PROC [
            node: Tree.Index,
            isExp: BOOL,
            item: PROC [
                node: Tree.Index, isExp: BOOL, tempSei: ISEIndex, failLabel: LabelCCIndex]
                RETURNS [VarIndex, ISEIndex],
            endCaseLabel: LabelCCIndex _ LabelCCNull]
            RETURNS [lex: Lexeme] =
            BEGIN
            caseEndLabel: LabelCCIndex = P5U.LabelAlloc[];
            caseLPEndLabel: LabelCCIndex = P5U.LabelAlloc[];
            nWords: CARDINAL =
                IF isExp THEN OpWordCount[SymbolOps.WordsForType[tb[node].info]] ELSE 0;
            longExpValue: BOOL;
            valTsei: ISEIndex _ ISENull;

            allConst: BOOL;
            CheckConst: Tree.Scan = {allConst _ allConst AND P5U.TreeLiteral[t]};

            CaseItem: Tree.Map =
                BEGIN
                failLabel: LabelCCIndex = P5U.LabelAlloc[];
                long: BOOL _ FALSE;
                r: VarIndex;
                [r, valTsei] _ item[TreeOps.GetNode[t], isExp, valTsei, failLabel];
                IF isExp THEN
                    BEGIN
                    [long: long, tsei: valTsei] _ P5L.NormalizeExp[r, valTsei, allConst];
                    Stack.ResetToMark[];
                    END;
                P5U.OutJump[Jump, IF long THEN caseLPEndLabel ELSE caseEndLabel];
                P5U.InsertLabel[failLabel];
                RETURN [TreeOps.FreeTree[t]]
                END;

            IF isExp THEN {allConst _ TRUE;  P5U.EnumerateCaseArms[node, CheckConst]}
            ELSE P5.PurgePendTempList[];

                BEGIN
                ENABLE P5.LogHeapFree => {RESUME [FALSE, NullLex]};
                tb[node].son[2] _ TreeOps.FreeTree[TreeOps.UpdateList[tb[node].son[2], CaseItem]];
                IF CPtr.caseCVState = singleLoaded THEN P5U.Out0[FOpCodes.qPOP];
                IF endCaseLabel # LabelCCNull THEN P5U.InsertLabel[endCaseLabel];
                IF isExp THEN
                    BEGIN
                    r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[3]]];
                    long: BOOL = P5L.NormalizeExp[r, valTsei, allConst].long;
                    P5U.OutJump[Jump, IF long THEN caseLPEndLabel ELSE caseEndLabel];
                    Stack.DeleteToMark[];
                    END
                ELSE tb[node].son[3] _ P5.StatementTree[tb[node].son[3]];
                END;

            P5U.InsertLabel[caseEndLabel];
            longExpValue _ cb[caseLPEndLabel].jumplist # JumpCCNull;
            IF longExpValue THEN
                {Stack.Off[]; P5U.Out0[FOpCodes.qLP]; Stack.On[]}; -- unreached if all arms long
            P5U.InsertLabel[caseLPEndLabel];
            IF valTsei # ISENull THEN P5.ReleaseTempLex[[se[valTsei]]];
            IF isExp THEN
                BEGIN
                Stack.Incr[SELECT TRUE FROM
                    nWords <= 2 => nWords,
                    longExpValue => 2,
                    ENDCASE => 1];
                lex _ P5L.NormalLex[nWords, longExpValue, allConst];
                END
            ELSE lex _ NullLex;
            RETURN
            END;


        CaseStmtExp: PUBLIC PROC [rootNode: Tree.Index, isExp: BOOL] RETURNS [lex: Lexeme] =
            BEGIN -- generate code for CASE statment and expression
            cvSize: CARDINAL = P5U.WordsForOperand[tb[rootNode].son[1]];
            saveMwCaseCV: Lexeme = CPtr.mwCaseCV;
            saveExtracting: BOOL = CPtr.xtracting;
            saveCaseCVState: CaseCVState = CPtr.caseCVState;
            cvTlex: Lexeme.se _ NullLex;
            cvr: VarIndex;
            CPtr.xtracting _ FALSE;
            IF isExp THEN Stack.Mark[];
            cvr _ P5L.VarForLex[P5.Exp[tb[rootNode].son[1]
                ! P5.LogHeapFree => {RESUME [FALSE, NullLex]}]];
            IF cvSize = 1 THEN {P5L.LoadVar[cvr]; CPtr.caseCVState _ singleLoaded}
            ELSE
                BEGIN
                cvTlex _ P5.GenAnonLex[cvSize];
                CPtr.mwCaseCV _ [bdo[P5L.OVarItem[P5L.CopyToTemp[cvr, cvTlex.lexsei].var]]];
                CPtr.caseCVState _ multi;
                END;
            lex _ CaseDriver[rootNode, isExp, CaseItem];
            IF cvTlex # NullLex THEN {P5.ReleaseTempLex[cvTlex]; P5L.ReleaseLex[CPtr.mwCaseCV]};
            CPtr.mwCaseCV _ saveMwCaseCV;
            CPtr.caseCVState _ saveCaseCVState;
            CPtr.xtracting _ saveExtracting;
            tb[rootNode].son[1] _ TreeOps.FreeTree[tb[rootNode].son[1]];
            tb[rootNode].son[2] _ TreeOps.FreeTree[tb[rootNode].son[2]];
            tb[rootNode].son[3] _ TreeOps.FreeTree[tb[rootNode].son[3]];
            IF tb[rootNode].nSons > 3 THEN TreeOps.MarkShared[tb[rootNode].son[4], FALSE];
            RETURN
            END;

        CaseItem: PROC [
            node: Tree.Index, isExp: BOOL, tempSei: ISEIndex, failLabel: LabelCCIndex]
            RETURNS [r: VarIndex, tSei: ISEIndex] =
            BEGIN -- generate code for a CASE item
            IF tb[node].name = caseswitch THEN [r, tSei] _ Branch[node, isExp, tempSei, failLabel]
            ELSE
                BEGIN
                tSei _ tempSei;
                CaseTest[tb[node].son[1], failLabel];
                IF isExp THEN r _ P5L.VarForLex[P5.Exp[tb[node].son[2]]]
                ELSE {
                    P5.PurgePendTempList[];
                    tb[node].son[2] _ P5.StatementTree[tb[node].son[2]]; r _ VarNull};
                END;
            RETURN
            END;


        CaseTest: PUBLIC PROC [t: Tree.Link, failLabel: LabelCCIndex] =
            BEGIN
            n: CARDINAL = TreeOps.ListLength[t];
            IF n = 1 THEN P5.FlowTree[t, FALSE, failLabel]
            ELSE
                BEGIN
                lastSon: CARDINAL = n-1;
                thisSon: CARDINAL _ 0;
                itemLabel: LabelCCIndex = P5U.LabelAlloc[];

                Test: PROC [t: Tree.Link] =
                    BEGIN
                    IF thisSon # lastSon THEN {P5.FlowTree[t, TRUE, itemLabel]; thisSon _ thisSon+1}
                    ELSE {P5.FlowTree[t, FALSE, failLabel]; P5U.InsertLabel[itemLabel]};
                    END;

                TreeOps.ScanList[t, Test];
                END;
            END;


        BranchTable: TYPE = RECORD [SEQUENCE length: CARDINAL OF LabelCCIndex];

        NewBranches: PROC [
            t: Tree.Link,
            itemLabel, failLabel: LabelCCIndex,
            bt: REF BranchTable]
            RETURNS [new: BOOL] =
            BEGIN -- sees if any new branches need to be added to branch table

            AddEntry: PROC [t: Tree.Link] =
                BEGIN
                i: CARDINAL = P5U.TreeLiteralValue[t];
                IF bt[i] = failLabel THEN {bt[i] _ itemLabel; new _ TRUE};
                END;

            new _ FALSE;  TreeOps.ScanList[t, AddEntry];
            RETURN
            END;

        Branch: PROC [
            node: Tree.Index, isExp: BOOL, tempSei: ISEIndex, failLabel: LabelCCIndex]
            RETURNS [r: VarIndex, tSei: ISEIndex] =
            BEGIN -- generate code for case switch if range is densely packed
            nWords, range, i: CARDINAL;
            btcp, saveCodePtr: CCIndex;
            valLabel, valLPLabel: LabelCCIndex;
            bt: REF BranchTable;
            first: BOOL _ TRUE;
            allConst: BOOL;
            longExp: BOOL;

            LookForConst: Tree.Scan =
                BEGIN -- t is a casetest node
                WITH t SELECT FROM
                    subtree => allConst _ allConst AND P5U.TreeLiteral[tb[index].son[2]];
                    ENDCASE => ERROR;
                END;

            CaseItem: Tree.Map =
                BEGIN
                itemLabel: LabelCCIndex;
                WITH t SELECT FROM
                    subtree =>
                        BEGIN -- is an item
                        bNode: Tree.Index = index;
                        long: BOOL _ FALSE;
                        itemLabel _ P5U.LabelAlloc[];
                        IF NewBranches[tb[bNode].son[1], itemLabel, failLabel, bt] THEN
                            BEGIN
                            P5U.InsertLabel[itemLabel];
                            IF isExp THEN
                                BEGIN
                                tr: VarIndex;
                                IF first THEN first _ FALSE ELSE Stack.ResetToMark[];
                                tr _ P5L.VarForLex[P5.Exp[tb[bNode].son[2]]];
                                [nwords: nWords, long: long, tsei: tSei] _ P5L.NormalizeExp[tr, tSei, allConst];
                                END
                            ELSE tb[bNode].son[2] _ P5.StatementTree[tb[bNode].son[2]];
                            P5U.OutJump[Jump, IF long THEN valLPLabel ELSE valLabel];
                            END
                        ELSE P5U.FreeChunk[itemLabel, CCItem.label.SIZE];
                        END;
                    ENDCASE;
                RETURN [TreeOps.FreeTree[t]]
                END;

            tSei _ tempSei;
            IF isExp THEN {allConst _ TRUE; TreeOps.ScanList[tb[node].son[3], LookForConst]};
            range _ P5U.TreeLiteralValue[tb[node].son[2]];
            valLabel _ P5U.LabelAlloc[];
            valLPLabel _ P5U.LabelAlloc[];
            P5.PushRhs[tb[node].son[1]];
            P5U.PushLitVal[range];
            Stack.Decr[2];
            P5U.CCellAlloc[other];
            cb[LOOPHOLE[CPtr.codeptr, OtherCCIndex]].obody _ 
                table[btab: , tablecodebytes: 3, taboffset: ];
            btcp _ CPtr.codeptr;
            P5U.OutJump[JumpCA, failLabel];
            bt _ NEW[BranchTable[range]];
            FOR i IN [0..range) DO bt[i] _ failLabel ENDLOOP;
            tb[node].son[3] _ TreeOps.FreeTree[TreeOps.UpdateList[tb[node].son[3], CaseItem]];
            saveCodePtr _ CPtr.codeptr;
            CPtr.codeptr _ btcp;
            FOR i IN [0..range) DO P5U.OutJump[JumpC, bt[i]] ENDLOOP;
            CPtr.codeptr _ saveCodePtr;
            P5U.InsertLabel[valLabel];
            longExp _ cb[valLPLabel].jumplist # JumpCCNull;
            IF longExp THEN P5U.Out0[FOpCodes.qLP];
            P5U.InsertLabel[valLPLabel];
            bt _ NIL;
            IF isExp THEN RETURN [P5L.VarForLex[P5L.NormalLex[nWords, longExp, allConst]], tSei]
            ELSE RETURN [VarNull, tSei];
            END;


        BindStmtExp: PUBLIC PROC [rootNode: Tree.Index, isExp: BOOL] RETURNS [lex: Lexeme] =
            BEGIN -- discrimination with copying
            saveMwCaseCV: Lexeme = CPtr.mwCaseCV;
            saveExtracting: BOOL = CPtr.xtracting;
            saveCaseCVState: CaseCVState = CPtr.caseCVState;
            typeTemp: BOOL _ FALSE;
            typeLex: Lexeme.se _ NullLex;
            cvTemp: Lexeme.se _ NullLex;
            pushableTag: BOOL _ FALSE;
            nItems: CARDINAL _ 0;
            sourceType: CSEIndex = P5U.OperandType[tb[rootNode].son[1]];

            BindItem: PROC [
                node: Tree.Index, isExp: BOOL, tempSei: ISEIndex, failLabel: LabelCCIndex]
                RETURNS [r: VarIndex, tSei: ISEIndex] =
                BEGIN
                bti: BTIndex = tb[node].info;
                subNode: Tree.Index = TreeOps.GetNode[tb[node].son[1]];
                type: Type = seb[TreeOps.GetSe[tb[subNode].son[1]]].idType;
                indirect: BOOL = tb[node].attr1;
                subType: Type;
                nItems _ nItems + 1;
                tSei _ tempSei;
                P5.EnterBlock[bti];
                IF tb[rootNode].attr2 THEN
                    BEGIN
                    subType _ P5U.MarkedType[type];
                    IF tb[node].attr3    -- will destroy type code
                        AND typeLex = NullLex AND nItems < TreeOps.ListLength[tb[rootNode].son[2]] THEN
                            BEGIN
                            typeLex _ P5.GenAnonLex[1];
                            IF CPtr.caseCVState # singleLoaded THEN P5U.Out0[FOpCodes.qPUSH];
                            P5.SAssign[typeLex.lexsei];
                            CPtr.caseCVState _ single;
                            END;
                    IF tb[node].attr2 THEN
                        BEGIN
                        t: Tree.Link;
                        IF typeTemp THEN {PushCopy[typeLex]; CPtr.caseCVState _ singleLoaded};
                        TreeOps.PushTree[Tree.Null];
                        TreeOps.PushTree[SymLiteralOps.TypeRef[subType]];
                        TreeOps.PushNode[relE, 2];  TreeOps.SetInfo[MPtr.typeBOOL];  t _ TreeOps.PopTree[];
                        P5.FlowTree[t, FALSE, failLabel];  t _ TreeOps.FreeTree[t];
                        END
                    ELSE IF CPtr.caseCVState = singleLoaded THEN
                        BEGIN P5U.Out0[FOpCodes.qPOP]; CPtr.caseCVState _ single END;
                    pushableTag _ FALSE;
                    IF tb[node].attr3 THEN typeTemp _ TRUE;
                    END
                ELSE subType _ IF indirect THEN P5U.ReferentType[sourceType] ELSE sourceType;
                BEGIN
                saveCVState: CaseCVState = CPtr.caseCVState;
                CPtr.caseCVState _ multi;    -- the value being discriminated
                IF tb[node].attr3 THEN
                    pushableTag _ TestTag[
                        type: subType,
                        target: IF indirect THEN P5U.ReferentType[type] ELSE type,
                        failLabel: failLabel,
                        indirect: indirect,
                        long: indirect AND SymbolOps.WordsForType[sourceType] # 1,
                        onStack: pushableTag];
                P5S.Assign[subNode];
                CPtr.caseCVState _ saveCVState;
                END;
                IF isExp THEN r _ P5L.VarForLex[P5.Exp[tb[node].son[2]]]
                ELSE {tb[node].son[2] _ P5.StatementTree[tb[node].son[2]];  r _ VarNull};
                P5.ExitBlock[bti];
                RETURN
                END;

            endCaseLabel: LabelCCIndex _ LabelCCNull;
            CPtr.xtracting _ FALSE;
            Stack.Dump[];
            IF isExp THEN Stack.Mark[];
            [CPtr.mwCaseCV, cvTemp] _ SelectArg[tb[rootNode].son[1], tb[rootNode].attr1];
            SELECT TRUE FROM
                tb[rootNode].attr2 =>
                    BEGIN
                    IF tb[rootNode].attr1 THEN
                        BEGIN
                        PushCopy[CPtr.mwCaseCV];  P5U.Out0[FOpCodes.qGCRT];
                        END
                    ELSE
                        BEGIN
                        Stack.Dump[]; Stack.Mark[];
                        PushCopy[CPtr.mwCaseCV];
                        P5.SysCallN[GetTypeEntry[sourceType], 1];
                        END;
                    CPtr.caseCVState _ singleLoaded;
                    END;
                tb[rootNode].attr1 =>
                    BEGIN
                    t: Tree.Link _ NilPredicate[sourceType];
                    endCaseLabel _ P5U.LabelAlloc[];
                    CPtr.caseCVState _ multi;
                    P5.FlowTree[t, TRUE, endCaseLabel];  t _ TreeOps.FreeTree[t];
                    END;
                ENDCASE;
            lex _ CaseDriver[rootNode, isExp, BindItem, endCaseLabel];
            IF typeLex # NullLex THEN P5.ReleaseTempLex[typeLex];
            P5L.ReleaseLex[CPtr.mwCaseCV];
            CPtr.mwCaseCV _ saveMwCaseCV;  CPtr.caseCVState _ saveCaseCVState;
            CPtr.xtracting _ saveExtracting;
            IF cvTemp # NullLex THEN P5.ReleaseTempLex[cvTemp];
            RETURN
            END;


        SelectArg: PROC [t: Tree.Link, indirect: BOOL] RETURNS [lex: Lexeme, anon: Lexeme.se] =
            BEGIN -- much stolen from EasilyLoadable and ReusableCopies, but to anon temp.
            l: Lexeme;
            r: VarIndex;
            StableCopy: PROC [var: VarComponent] RETURNS [cvar: VarComponent, anon: Lexeme.se] = {
                size: CARDINAL _ P5L.Words[var.wSize, var.bSize];
                IF P5L.EasyToLoad[var, load] THEN RETURN [var, NullLex];
                anon _ P5.GenAnonLex[size];
                cvar _ P5L.CopyToTemp[P5L.OVarItem[var], anon.lexsei].var;
                };

            l _ P5.Exp[t ! P5.LogHeapFree => {RESUME [FALSE, NullLex]}];
            IF indirect THEN {
                var: VarComponent;
                [var, anon] _ StableCopy[P5L.ComponentForLex[l]];
                RETURN[[bdo[P5L.OVarItem[var]]], anon]}
            ELSE {
                r _ P5L.VarForLex[l];
                WITH cc: cb[r] SELECT FROM
                    o => [cc.var, anon] _ StableCopy[cc.var];
                    bo => [cc.base, anon] _ StableCopy[cc.base];
                    ENDCASE => {
                        bor: BoVarIndex _ P5L.MakeBo[r];
                        [cb[bor].base, anon] _ StableCopy[cb[bor].base];
                        r _ bor};
                RETURN [[bdo[r]], anon];
                };
            END;

        PushCopy: PROC [l: Lexeme] = {P5.PushLex[P5L.CopyLex[l]]};


        TestTag: PROC [
            type, target: Type, failLabel: LabelCCIndex, indirect, long, onStack: BOOL]
            RETURNS [pushable: BOOL] =
            BEGIN  OPEN SymbolOps;
            link: Type = TypeLink[target];
            subLink: CSEIndex = SymbolOps.UnderType[link];
            uType: CSEIndex = SymbolOps.UnderType[seb[SymbolOps.VariantField[subLink]].idType];
            IF SymbolOps.UnderType[type] # subLink THEN        -- discriminate to the link type
                BEGIN
                [] _ TestTag[type, link, failLabel, indirect, long, onStack];
                onStack _ pushable _ FALSE;
                END
            ELSE pushable _ TRUE;        -- should force non-commutativity
            WITH u: seb[uType] SELECT FROM
                union =>
                    BEGIN OPEN TreeOps;
                    saveCVState: CaseCVState = CPtr.caseCVState;
                    tagSei: ISEIndex = u.tagSei;
                    t: Tree.Link;
                    PushTree[Tree.Null];
                    IF onStack THEN CPtr.caseCVState _ single
                    ELSE    -- CPtr.caseCVState = multi
                        BEGIN
                        IF indirect THEN {PushNode[uparrow, 1]; SetAttr[1, FALSE]; SetAttr[2, long]}
                        ELSE PushNode[cast, 1];
                        SetInfo[subLink];
                        PushSe[tagSei];  PushNode[dollar, 2];
                        SetInfo[SymbolOps.UnderType[seb[tagSei].idType]];  SetAttr[2, long];
                        END;
                    PushTree[P5U.MakeTreeLiteral[P5U.VariantTag[target, u.caseCtx]]];
                    PushNode[relE, 2];  SetInfo[MPtr.typeBOOL];
                    t _ PopTree[];  P5.FlowTree[t, FALSE, failLabel];  t _ FreeTree[t];
                    CPtr.caseCVState _ saveCVState;
                    END;
                ENDCASE => ERROR;
            RETURN
            END;


        TagPredicate: PROC [type, target: Type, indirect, long: BOOL] RETURNS [Tree.Link] =
            BEGIN OPEN SymbolOps, TreeOps;
            link: Type = TypeLink[target];
            subLink: CSEIndex = SymbolOps.UnderType[link];
            uType: CSEIndex = SymbolOps.UnderType[seb[SymbolOps.VariantField[subLink]].idType];
            WITH u: seb[uType] SELECT FROM
                union =>
                    BEGIN
                    tagSei: ISEIndex = u.tagSei;
                    PushTree[Tree.Null];
                    IF indirect THEN {PushNode[uparrow, 1]; SetAttr[1, FALSE]; SetAttr[2, long]}
                    ELSE PushNode[cast, 1];
                    SetInfo[subLink];
                    PushSe[tagSei];  PushNode[dollar, 2];
                    SetInfo[SymbolOps.UnderType[seb[tagSei].idType]];  SetAttr[2, long];
                    PushTree[P5U.MakeTreeLiteral[P5U.VariantTag[target, u.caseCtx]]];
                    PushNode[relE, 2];  SetInfo[MPtr.typeBOOL];
                    END;
                ENDCASE => ERROR;
            IF SymbolOps.UnderType[type] # subLink THEN        -- discriminate to the link type
                BEGIN
                PushTree[TagPredicate[type, link, indirect, long]];  PushNode[and, -2];
                END;
            RETURN [PopTree[]]
            END;

        TypePredicate: PROC [
            source: CSEIndex, dest: Type, node: Tree.Index] RETURNS [t: Tree.Link_Tree.Null] =
            BEGIN OPEN TreeOps;    -- attrs, son[1] as in narrow, istype
            indirect: BOOL = tb[node].attr1;
            long: BOOL = indirect AND SymbolOps.WordsForType[source] = 2;
            type: Type;
            IF tb[node].attr2 THEN
                BEGIN
                type _ P5U.MarkedType[dest];
                PushTree[Tree.Null];
                IF ~indirect THEN {PushNode[cast, 1]; SetInfo[source]};
                PushNode[gcrt, 1];  SetAttr[2, indirect];
                PushTree[SymLiteralOps.TypeRef[type]];
                PushNode[relE, 2];  SetInfo[MPtr.typeBOOL];
                t _ PopTree[];
                END
            ELSE type _ IF indirect THEN P5U.ReferentType[source] ELSE source;
            IF tb[node].attr3 THEN
                BEGIN
                <<add NIL test here if not attr2?>>
                PushTree[
                    TagPredicate[type, IF indirect THEN P5U.ReferentType[dest] ELSE dest, indirect, long]];
                IF t # Tree.Null THEN {PushTree[t]; PushNode[and, -2]};
                t _ PopTree[];
                END;
            RETURN
            END;

        NilPredicate: PROC [type: CSEIndex] RETURNS [Tree.Link] =
            BEGIN OPEN TreeOps;
            PushTree[Tree.Null];
            PushTree[P5U.NilTree[type]];
            PushNode[relE, 2];  SetInfo[MPtr.typeBOOL];
            RETURN [PopTree[]]
            END;

        OrTest: PROC [t1, t2: Tree.Link] RETURNS [Tree.Link] =
            BEGIN OPEN TreeOps;
            PushTree[t1];  PushTree[t2];  PushNode[or, 2];  SetInfo[MPtr.typeBOOL];
            RETURN [PopTree[]]
            END;


        NarrowExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Lexeme] =
            BEGIN
            saveMwCaseCV: Lexeme = CPtr.mwCaseCV;
            saveExtracting: BOOL = CPtr.xtracting;
            saveCaseCVState: CaseCVState = CPtr.caseCVState;
            eLabel: LabelCCIndex = P5U.LabelAlloc[];
            cvTemp: Lexeme.se _ NullLex;
            indirect: BOOL = tb[node].attr1;
            sourceType: CSEIndex = P5U.OperandType[tb[node].son[1]];
            targetType: Type =
                IF tb[node].son[2] # Tree.Null THEN P5U.TypeForTree[tb[node].son[2]] ELSE tb[node].info;
            nWords: CARDINAL = SymbolOps.WordsForType[sourceType];
            counted: BOOL = indirect AND (SymbolOps.RCType[sourceType] = simple);
            t: Tree.Link;
            CPtr.xtracting _ FALSE;
            Stack.Dump[];  Stack.Mark[];
            t _ TypePredicate[sourceType, targetType, node];
            IF indirect # tb[node].attr2 THEN t _ OrTest[NilPredicate[sourceType], t];
            [CPtr.mwCaseCV, cvTemp] _ SelectArg[tb[node].son[1], indirect];  CPtr.caseCVState _ multi;
            IF indirect THEN PushCopy[CPtr.mwCaseCV];
            P5.FlowTree[t, TRUE, eLabel];  t _ TreeOps.FreeTree[t];
            IF indirect THEN
                BEGIN
                IF counted THEN
                    BEGIN
                    t _ SymLiteralOps.TypeRef[P5U.ReferentType[targetType], FALSE];
                    P5.PushRhs[t];  t _ TreeOps.FreeTree[t];
                    P5.SysCallN[RTSD.sCheckForNarrowRefFault, nWords];
                    END
                ELSE P5.SysCallN[RTSD.sRaiseNarrowFault, nWords];
                P5L.ReleaseLex[CPtr.mwCaseCV];
                l _ P5L.TOSLex[nWords];
                END
            ELSE
                BEGIN
                len: CARDINAL = SymbolOps.WordsForType[SymbolOps.UnderType[targetType]];
                P5.SysCallN[RTSD.sRaiseNarrowFault, 0];
                IF len = nWords THEN l _ CPtr.mwCaseCV
                ELSE    -- simulate a chop
                    BEGIN
                    r: VarIndex = P5L.VarForLex[CPtr.mwCaseCV];
                    P5L.FieldOfVarOnly[r: r, wSize: len];
                    l _ [bdo[r]];
                    END;
                END;
            CPtr.mwCaseCV _ saveMwCaseCV;  CPtr.caseCVState _ saveCaseCVState;
            CPtr.xtracting _ saveExtracting;
            P5.CallCatch[IF tb[node].nSons > 2 THEN tb[node].son[3] ELSE Tree.Null];
            P5U.InsertLabel[eLabel];
            IF cvTemp # NullLex THEN P5.ReleaseTempLex[cvTemp];
            RETURN
            END;


        TypeRel: PUBLIC PROC [node: Tree.Index, tf: BOOL, label: LabelCCIndex]  =
            BEGIN
            saveMwCaseCV: Lexeme = CPtr.mwCaseCV;
            saveExtracting: BOOL = CPtr.xtracting;
            saveCaseCVState: CaseCVState = CPtr.caseCVState;
            cvTemp: Lexeme.se;
            sourceType: CSEIndex = P5U.OperandType[tb[node].son[1]];
            t: Tree.Link;
            CPtr.xtracting _ FALSE;
            Stack.Dump[];
            t _ TypePredicate[sourceType, P5U.TypeForTree[tb[node].son[2]], node];
            IF tb[node].attr1 OR tb[node].attr2 THEN
                t _ OrTest[NilPredicate[sourceType], t];
            [CPtr.mwCaseCV, cvTemp] _ SelectArg[tb[node].son[1], tb[node].attr1];  CPtr.caseCVState _ multi;
            P5.FlowTree[t, tf, label];  t _ TreeOps.FreeTree[t];
            P5L.ReleaseLex[CPtr.mwCaseCV];
            CPtr.mwCaseCV _ saveMwCaseCV;  CPtr.caseCVState _ saveCaseCVState;
            IF cvTemp # NullLex THEN P5.ReleaseTempLex[cvTemp];
            CPtr.xtracting _ saveExtracting;
            END;

        GetCanonicalType: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
            BEGIN
            IF tb[node].attr2 THEN
                BEGIN
                P5.PushRhs[tb[node].son[1]];  P5U.Out0[FOpCodes.qGCRT];
                END
            ELSE
                BEGIN
                Stack.Dump[]; Stack.Mark[];
                P5.PushRhs[tb[node].son[1]];
                P5.SysCallN[GetTypeEntry[P5U.OperandType[tb[node].son[1]]], 1];
                END;
            RETURN [P5L.TOSLex[1]]
            END;

        GetTypeEntry: PROC [type: CSEIndex] RETURNS [CARDINAL] =
            BEGIN
            RETURN [SELECT SymbolOps.XferMode[type] FROM
                proc => RTSD.sGetCanonicalProcType,
                signal, error => RTSD.sGetCanonicalSignalType,
                ENDCASE => 0]
            END;

        END.