
    <<Pass4S.mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 18, 1986 12:33:39 pm PDT>>
        <<Sweet, January 21, 1981  10:50 PM>>
        <<Donahue, 10-Dec-81  9:14:17>>
        <<Russ Atkinson (RRA) March 6, 1985 10:54:18 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Notifier],
        BcdDefs: TYPE USING [ProcLimit],
        ComData: TYPE USING [bodyIndex, globalFrameSize, idBOOL, idINTEGER, idLOCK, interface, monitored, stopping, switches, textIndex, 
        typeBOOL, typeINTEGER],
        Log: TYPE USING [Error, ErrorSei, ErrorTree],
        LiteralOps: TYPE USING [Find, ResetLocalStrings],
        P4: TYPE USING [AdjustBias, Assignment, Attr, AUsForType, BiasForType, BoolTest, BoolValue, both, Call, CheckBlock, CommonProp, 
        CommonRep, ConsState, ConstantInterval, Cover, DeclItem, DeclUpdate, EmptyInterval, Exp, Extract, Interval, LayoutBlock, 
        LayoutGlobals, LayoutInterface, LayoutLocals, MakeArgRecord, MakeTreeLiteral, NeutralExp, none, NormalizeRange, 
        OperandType, other, ProcessSymLiterals, RelTest, RepForType, Repr, Rhs, RValue, SetType, TreeLiteral, TreeLiteralValue, 
        unsigned, VAttr, VBias, voidAttr, VPop, VProp, VRep],
        Pass4: TYPE USING [implicitAttr, implicitBias, implicitType, lockNode, resident, resumeRecord, returnRecord],
        PrincOps: TYPE USING [localbase, StateVector],
        SourceMap: TYPE USING [Loc, Up],
        Symbols: TYPE USING [Base, BodyInfo, bodyType, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, 
        ctxType, ISEIndex, ISENull, lG, lL, nullType, RecordSEIndex, RecordSENull, RootBti, seType, Type, typeANY],
        SymbolOps: TYPE USING [ArgRecord, Cardinality, CtxVariant, DelinkBti, EqTypes, FirstCtxSe, FromBti, NextSe, NormalType, ToBti, 
        TransferTypes, TypeForm, TypeLink, ToType, UnderType],
        SymLiteralOps: TYPE USING [DescribeRefLits, DescribeTypes],
        Target: TYPE MachineParms USING [bitsPerAU, bitsPerWord],
        Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, nullIndex, Scan, Test, treeType],
        TreeOps: TYPE USING [FreeNode, FreeTree, FromCard, GetNode, GetSe, GetTag, IdentityMap, ListHead, ListLength, MakeList, MakeNode, 
        MarkShared, NthSon, OpName, PopTree, PushList, PushLit, PushNode, PushProperList, PushTree, ReverseScanList, 
        ReverseUpdateList, ScanList, SearchList, SetAttr, SetInfo, ToLoc, UpdateList];

    Pass4S: PROGRAM
        IMPORTS Log, LiteralOps, P4, SourceMap, SymbolOps, SymLiteralOps, TreeOps, dataPtr: ComData, passPtr: Pass4
        EXPORTS P4 = {
        OPEN SymbolOps, Symbols, P4, TreeOps;

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

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

        Repr: TYPE = P4.Repr;
            none: Repr = P4.none;

        bitsPerWord: CARDINAL = Target.bitsPerWord;


    <<bodies and blocks>>

        currentLevel: PUBLIC ContextLevel;
        currentBody: BTIndex;
        checked: PUBLIC BOOL;

        BodyList: PROC[firstBti: BTIndex] = {
            nextBti: BTIndex;
            FOR bti: BTIndex _ firstBti, nextBti UNTIL bti = BTNull DO
                nextBti _ IF bb[bti].link.which = parent THEN BTNull ELSE bb[bti].link.index;
                WITH bb[bti] SELECT FROM
                    Callable =>
                        IF ~inline OR (dataPtr.interface AND LocalBody[LOOPHOLE[bti]]) THEN
                            Body[LOOPHOLE[bti, CBTIndex]]
                        ELSE DelinkBti[bti];
                    ENDCASE => BodyList[bb[bti].firstSon];
                ENDLOOP};

        LocalBody: PROC[bti: CBTIndex] RETURNS[BOOL] = INLINE {
            sei: ISEIndex = bb[bti].id;
            RETURN[sei = ISENull OR ctxb[seb[sei].idCtx].ctxType = simple]};


        Body: PUBLIC PROC[bti: CBTIndex] = {
            oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
            oldLevel: ContextLevel = currentLevel;
            saveChecked: BOOL = checked;
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            saveCatchScope: BOOL = catchScope;
            saveRecord: RecordSEIndex = passPtr.returnRecord;
            node: Tree.Index = NARROW[bb[bti].info, BodyInfo.Internal].bodyTree;
            sei: CSEIndex = bb[bti].ioType;
            base, bound: CARDINAL;
            initTree: Tree.Link;
            inRecord: RecordSEIndex;
            catchScope _ FALSE;
            dataPtr.bodyIndex _ currentBody _ bti;
            dataPtr.textIndex _ SourceMap.Up[bb[bti].sourceIndex];
            currentLevel _ IF bti = RootBti THEN lG ELSE bb[bti].level;
            checked _ tb[node].attr1;
            IF dataPtr.interface AND bb[bti].level > lL THEN Log.ErrorSei[nonDefinition, bb[bti].id];
            [inRecord, passPtr.returnRecord] _ TransferTypes[bb[bti].ioType];
            IF ~bb[bti].hints.argUpdated THEN SetImmutable[inRecord, TRUE];
            [] _ LiteralOps.ResetLocalStrings[];
            bb[bti].hints.noStrings _ TRUE;    -- see MarkString, below
            IF tb[node].son[4] # Tree.Null THEN {
                tb[node].son[4] _ Exp[tb[node].son[4], none]; VPop[]};
            tb[node].son[1] _ UpdateList[tb[node].son[1], OpenItem];
            [init: initTree, decls: tb[node].son[2]] _ ScanDecls[tb[node].son[2]];
            IF bti = RootBti THEN {
                fragments: BOOL =
                    (SymLiteralOps.DescribeTypes[].length + SymLiteralOps.DescribeRefLits[].length) # 0;
                dataPtr.globalFrameSize _
                    (LayoutGlobals[bti, dataPtr.stopping, fragments] + (bitsPerWord-1))/bitsPerWord;
                IF bb[bti].type # RecordSENull THEN
                    seb[bb[bti].type].length _ dataPtr.globalFrameSize*bitsPerWord;
                ProcessSymLiterals[];
                base _ PrincOps.localbase*bitsPerWord;
                IF dataPtr.monitored AND tb[passPtr.lockNode].attr1 THEN {
                    PushTree[tb[passPtr.lockNode].son[2]];
                    PushLit[LiteralOps.Find[100000b]];  PushNode[cast, 1];
                    SetType[dataPtr.idLOCK];
                    PushNode[assign, 2];  SetAttr[1, TRUE];
                    initTree _ Prefix[PopTree[], initTree]}}
            ELSE {
                base _ LayoutLocals[bti];
                IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length _ base;
                IF bb[bti].firstSon # BTNull THEN
                    initTree _ Prefix[BodyInitList[bb[bti].firstSon], initTree]};
            IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].mark4 _ TRUE;
            tb[node].son[3] _ UpdateList[tb[node].son[3], Stmt];
            bound _ AssignSubBlocks[bti, base];
            WITH bb[bti].info SELECT FROM
                Internal => {
                    frameSize _ (bound + (bitsPerWord-1))/bitsPerWord;
                    thread _ LiteralOps.ResetLocalStrings[]};
                ENDCASE;
            bb[bti].resident _ passPtr.resident;
            IF bb[bti].firstSon # BTNull THEN BodyList[bb[bti].firstSon];
            tb[node].son[1] _ ReverseUpdateList[tb[node].son[1], CloseItem];
            tb[node].son[2] _ Prefix[initTree, UpdateList[tb[node].son[2], DeclUpdate]];
            IF dataPtr.interface AND bti = RootBti THEN {
                n: CARDINAL = LayoutInterface[bti];
                WITH t: seb[bb[bti].ioType] SELECT FROM
                    definition => t.nDummyGfi _ (IF n=0 THEN 1 ELSE ((n-1)/BcdDefs.ProcLimit + 1));
                    ENDCASE};
            SetImmutable[inRecord, FALSE];
            catchScope _ saveCatchScope;
            currentBody _ dataPtr.bodyIndex _ oldBodyIndex;
            currentLevel _ oldLevel;  checked _ saveChecked;
            dataPtr.textIndex _ saveIndex;  passPtr.returnRecord _ saveRecord};

        MarkString: PUBLIC PROC[local: BOOL] = {
            bb[IF local THEN dataPtr.bodyIndex ELSE RootBti].hints.noStrings _ FALSE};

        SetImmutable: PROC[rSei: RecordSEIndex, b: BOOL] = {
            IF rSei # RecordSENull THEN
                FOR sei: ISEIndex _ FirstCtxSe[seb[rSei].fieldCtx], NextSe[sei] UNTIL sei = ISENull DO
                    seb[sei].immutable _ b;
                    ENDLOOP
            };


        ScanDecls: PROC[t: Tree.Link] RETURNS[init, decls: Tree.Link] = {
            IF OpName[t] = initlist THEN {
                node: Tree.Index = GetNode[t];
                init _ UpdateList[tb[node].son[1], Stmt];  tb[node].son[1] _ Tree.Null;
                decls _ tb[node].son[2];  tb[node].son[2] _ Tree.Null;
                FreeNode[node]}
            ELSE {init _ Tree.Null; decls _ t};
            ScanList[decls, DeclItem]; RETURN};

        Prefix: PROC[first, rest: Tree.Link] RETURNS[Tree.Link] = {
            SELECT TRUE FROM
                (first = Tree.Null) => RETURN[rest];
                (rest = Tree.Null) => RETURN[first];
                ENDCASE => {PushTree[first]; PushTree[rest]; RETURN[MakeList[2]]}
            };

        BodyInitList: PROC[firstBti: BTIndex] RETURNS[Tree.Link] = {
            bti: BTIndex _ firstBti;
            n: CARDINAL _ 0;
            IF bti # BTNull THEN
                DO
                    WITH body: bb[bti] SELECT FROM
                        Callable =>
                            IF ~body.inline THEN {PushNode[procinit, 0]; SetInfo[FromBti[bti]]; n _ n+1};
                        ENDCASE => NULL;
                    IF bb[bti].link.which = parent THEN EXIT;
                    bti _ bb[bti].link.index;
                    ENDLOOP;
            RETURN[MakeList[n]]};

        AssignSubBlocks: PROC[rootBti: BTIndex, base: CARDINAL] RETURNS[bound: CARDINAL] = {
            level: ContextLevel = bb[rootBti].level;
            bti: BTIndex;
            bound _ base;
            IF (bti _ bb[rootBti].firstSon) # BTNull THEN
                DO
                    SELECT bb[bti].kind FROM
                        Other =>
                            IF bb[bti].level = level THEN {
                                length: CARDINAL = AssignBlock[bti, base];
                                bound _ MAX[length, bound]};
                        ENDCASE => NULL;
                    IF bb[bti].link.which = parent THEN EXIT;
                    bti _ bb[bti].link.index;
                    ENDLOOP;
            RETURN};


        Subst: PUBLIC PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            OPEN tb[node];
            saveRecord: RecordSEIndex = passPtr.returnRecord;
            saveChecked: BOOL = checked;
            son[1] _ NeutralExp[son[1]];
            passPtr.returnRecord _ TransferTypes[OperandType[son[1]]].typeOut;
            IF ~attr3 THEN checked _ attr1;
            son[2] _ UpdateList[son[2], Stmt];
            checked _ saveChecked;  passPtr.returnRecord _ saveRecord;
            RETURN[[subtree[index: node]]]};


        Scope: PROC[node: Tree.Index, item: Tree.Map] RETURNS[Tree.Link] = {
            OPEN tb[node];
            bti: BTIndex = ToBti[info];
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            oldBodyIndex: BTIndex = currentBody;
            oldLevel: ContextLevel = currentLevel;
            initTree: Tree.Link;
            dataPtr.textIndex _ SourceMap.Up[bb[bti].sourceIndex];
            currentBody _ bti;  currentLevel _ bb[bti].level;
            [init: initTree, decls: son[1]] _ ScanDecls[son[1]];
            IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].mark4 _ TRUE;
            CheckBlock[bti];
            son[2] _ UpdateList[son[2], item];
            son[1] _ Prefix[initTree, UpdateList[son[1], DeclUpdate]];
            IF catchScope THEN catchBound _ MAX[AssignBlock[bti, catchBase], catchBound];
            currentBody _ oldBodyIndex;  currentLevel _ oldLevel;
            dataPtr.textIndex _ saveIndex;
            RETURN[[subtree[index: node]]]};

        AssignBlock: PROC[bti: BTIndex, base: CARDINAL] RETURNS[bound: CARDINAL] = {
            node: Tree.Index;
            newBase: CARDINAL = LayoutBlock[bti, base];
            initTree: Tree.Link = IF bb[bti].firstSon # BTNull
                THEN BodyInitList[bb[bti].firstSon]
                ELSE Tree.Null;
            IF bb[bti].type # RecordSENull THEN seb[bb[bti].type].length _ newBase;
            bound _ AssignSubBlocks[bti, newBase];
            WITH bb[bti].info SELECT FROM
                Internal => {frameSize _ (bound + (bitsPerWord-1))/bitsPerWord; node _ bodyTree};
                ENDCASE => NULL;
            IF initTree # Tree.Null THEN tb[node].son[1] _ Prefix[initTree, tb[node].son[1]];
            RETURN};


    <<main dispatch>>

        Stmt: PROC[stmt: Tree.Link] RETURNS[val: Tree.Link] = {
            node: Tree.Index;
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            val _ stmt;        -- the default case
            WITH stmt SELECT GetTag[stmt] FROM
                subtree => {
                    node _ index;
                    IF node # Tree.nullIndex THEN {
                        OPEN tb[node];
                        dataPtr.textIndex _ ToLoc[info];
                        SELECT name FROM

                            assign => {val _ Assignment[node]; VPop[]};
                            extract => val _ ExtractStmt[node];

                            call, portcall, signal, error, xerror, start, join => {val _ Call[node]; VPop[]};
                            subst => val _ Subst[node];

                            block => {
                                saveChecked: BOOL = checked;
                                checked _ tb[node].attr1;  val _ Scope[node, Stmt];
                                checked _ saveChecked};

                            if => val _ IfStmt[node];
                            case => val _ CaseDriver[node, Stmt, 0];
                            bind =>
                                val _ IF attr3 THEN BindType[node, Stmt] ELSE BindCase[node, case, BindStmt];

                            do => val _ DoStmt[node];

                            return, result => Return[node, passPtr.returnRecord];
                            resume => Return[node, passPtr.resumeRecord];

                            label => {son[1] _ Stmt[son[1]]; son[2] _ UpdateList[son[2], Stmt]};

                            open => {
                                son[1] _ UpdateList[son[1], OpenItem];
                                son[2] _ UpdateList[son[2], Stmt];
                                son[1] _ ReverseUpdateList[son[1], CloseItem]};

                            checked => {
                                saveChecked: BOOL = checked;
                                checked _ attr1;  son[1] _ Stmt[son[1]];
                                checked _ saveChecked};

                            enable => {CatchPhrase[son[1]]; son[2] _ Stmt[son[2]]};
                            catchmark => son[1] _ Stmt[son[1]];

                            lock => {son[1] _ UpdateList[son[1], Stmt]; son[2] _ Exp[son[2], none]; VPop[]};
                            notify, broadcast, unlock => {son[1] _ Exp[son[1], none]; VPop[]};
                            wait => {
                                son[1] _ Exp[son[1], none];  VPop[];
                                son[2] _ Exp[son[2], none];  VPop[];
                                IF nSons > 2 THEN CatchNest[son[3]]};

                            restart => {son[1] _ NeutralExp[son[1]]; IF nSons > 2 THEN CatchNest[son[3]]};

                            dst, lst, lste, lstf => {
                                son[1] _ Exp[son[1], none];
                                IF AUsForType[OperandType[son[1]]] < PrincOps.StateVector.SIZE THEN
                                    Log.ErrorTree[sizeClash, son[1]];
                                VPop[]};

                            goto, exit, loop, syserror, reject, continue, retry, stop, null => NULL;
                            free => val _ Free[node];

                            apply => NULL;
                            item => son[2] _ Stmt[son[2]];
                            list => val _ UpdateList[stmt, Stmt];

                            ENDCASE => Log.Error[unimplemented]}};
                ENDCASE => ERROR;
            dataPtr.textIndex _ saveIndex;  RETURN};


    <<extraction>>

        ExtractStmt: PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            subNode: Tree.Index = GetNode[tb[node].son[1]];
            rType: RecordSEIndex = LOOPHOLE[UnderType[ToType[tb[subNode].info]]];
            IF rType # Symbols.RecordSENull THEN {val _ Extract[node]; VPop[]}
            ELSE {
                val _ Stmt[tb[node].son[2]];  tb[node].son[2] _ Tree.Null;
                WITH val SELECT GetTag[val] FROM subtree => tb[index].info _ tb[node].info ENDCASE;
                FreeNode[node]};
            RETURN};


    <<return>>

        Return: PROC[node: Tree.Index, type: RecordSEIndex] = {
            tb[node].son[1] _ IF tb[node].attr3 AND type # RecordSENull
                THEN Rhs[tb[node].son[1], type]
                ELSE MakeArgRecord[type, tb[node].son[1]];
            VPop[]};


    <<conditionals>>

        IfStmt: PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            son[1] _ BoolValue[son[1]];  VPop[];
            son[2] _ Stmt[son[2]];  son[3] _ Stmt[son[3]];
            IF ~TreeLiteral[son[1]] THEN val _ Tree.Link[subtree[index: node]]
            ELSE {
                IF BoolTest[son[1]] THEN {val _ son[2]; son[2] _ Tree.Null}
                ELSE {val _ son[3]; son[3] _ Tree.Null};
                FreeNode[node]};
            RETURN};


        BindStmt: PROC[t: Tree.Link, labelBias: INTEGER] RETURNS[Tree.Link] = {
            node: Tree.Index = GetNode[t];
            RETURN[CaseDriver[GetNode[t], Stmt, labelBias]]};


        <<drivers for processing selections>>

        BindType: PUBLIC PROC[node: Tree.Index, eval: Tree.Map] RETURNS[Tree.Link] = {
            OPEN tb[node];
            saveType: Type = passPtr.implicitType;
            saveBias: INTEGER = passPtr.implicitBias;
            saveAttr: Attr = passPtr.implicitAttr;

            Item: Tree.Map = {RETURN[Scope[GetNode[t], eval]]};

            subNode: Tree.Index _ GetNode[son[1]];
            type: Type = OperandType[tb[subNode].son[2]];
            PushTree[RValue[tb[subNode].son[2], BiasForType[type], RepForType[type]]];
            passPtr.implicitType _ type;
            passPtr.implicitAttr _ VAttr[];  passPtr.implicitBias _ VBias[];  VPop[];
            tb[subNode].son[2] _ Tree.Null;
            PushTree[UpdateList[son[3], Item]];  son[3] _ Tree.Null;
            PushTree[eval[son[4]]];  son[4] _ Tree.Null;
            PushNode[name, 3];  SetInfo[info];  SetAttr[1, attr1];  SetAttr[2, attr2];
            FreeNode[node];
            passPtr.implicitAttr _ saveAttr;  passPtr.implicitBias _ saveBias;
            passPtr.implicitType _ saveType;
            RETURN[PopTree[]]};

        BindCase: PUBLIC PROC[
            node: Tree.Index,
            op: Tree.NodeName,
            eval: PROC[Tree.Link, INTEGER] RETURNS[Tree.Link]]
            RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            labelBias: INTEGER = TagBias[BoundType[son[1]], TestCtx[ListHead[son[3]]]];
            subNode: Tree.Index;
            PushTree[son[2]];  son[2] _ Tree.Null;
            PushTree[son[3]];  son[3] _ Tree.Null;
            PushTree[son[4]];  son[4] _ Tree.Null;
            PushTree[OpenItem[son[1]]];  son[1] _ Tree.Null;
            PushNode[op, 4];  SetInfo[info];
            SetAttr[1, FALSE];  SetAttr[2, FALSE];  SetAttr[3, attr3];
            val _ eval[PopTree[], labelBias];  subNode _ GetNode[val];
            tb[subNode].son[4] _ CloseItem[tb[subNode].son[4]];
            FreeNode[node];
            RETURN};


        BoundType: PROC[base: Tree.Link] RETURNS[Type] = INLINE {
            RETURN[DerefType[OperandType[NthSon[base, 2]]]]};

        TestCtx: PROC[item: Tree.Link] RETURNS[CTXIndex] = INLINE {
            RETURN[IF item = Tree.Null
                THEN CTXNull
                ELSE seb[GetSe[NthSon[ListHead[NthSon[item, 1]], 2]]].idCtx]
            };

        TagBias: PROC[rType: Type, testCtx: CTXIndex] RETURNS[INTEGER] = {
            FOR subType: Type _ rType, TypeLink[subType] WHILE subType # nullType DO
                rsei: CSEIndex = UnderType[subType];
                WITH t: seb[rsei] SELECT FROM
                    record =>
                        IF t.hints.variant THEN {
                            sei: ISEIndex = CtxVariant[t.fieldCtx];
                            uType: CSEIndex = UnderType[seb[sei].idType];
                            WITH u: seb[uType] SELECT FROM
                                union =>
                                    IF u.caseCtx = testCtx OR testCtx = CTXNull THEN
                                        RETURN[BiasForType[seb[u.tagSei].idType]];
                                ENDCASE};
                    ENDCASE => EXIT;
                    ENDLOOP;
            ERROR};


        CaseDriver: PUBLIC PROC[node: Tree.Index, selection: Tree.Map, labelBias: INTEGER]
            RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            saveType: Type = passPtr.implicitType;
            saveBias: INTEGER = passPtr.implicitBias;
            saveAttr: Attr = passPtr.implicitAttr;
            type: Type = OperandType[son[1]];
            son[1] _ Exp[son[1], none];
            IF attr2 THEN {                -- not bind/bindx
                found: BOOL _ FALSE;

                EvalTest: Tree.Map = {
                    subNode: Tree.Index = GetNode[t];
                    IF tb[subNode].son[1] # Tree.Null THEN ERROR;
                    tb[subNode].son[1] _ IdentityMap[tb[node].son[1]];
                    v _ BoolValue[t];  VPop[];
                    IF BoolTest[v] THEN found _ TRUE;
                    RETURN};

                TestItem: Tree.Test = {
                    subNode: Tree.Index = GetNode[t];
                    tb[subNode].son[1] _ UpdateList[tb[subNode].son[1], EvalTest];
                    IF found THEN {val _ tb[subNode].son[2]; tb[subNode].son[2] _ Tree.Null};
                    RETURN[found]};

                SearchList[son[2], TestItem];
                IF ~found THEN {val _ son[3]; son[3] _ Tree.Null};
                FreeNode[node];
                val _ selection[val]}
            ELSE IF EqTypes[type, dataPtr.typeBOOL] AND attr1 AND TreeLiteral[son[1]] THEN {

                CaseItem: Tree.Scan = {
                    subNode: Tree.Index = GetNode[t];
                    started: BOOL;

                    PushTest: Tree.Scan = {
                        tNode: Tree.Index = GetNode[t];
                        PushTree[tb[tNode].son[2]];  tb[tNode].son[2] _ Tree.Null;
                        IF ~BoolTest[son[1]] THEN PushNode[not, 1];
                        IF started THEN PushNode[or, 2];
                        started _ TRUE;  RETURN};

                    PushTree[tb[subNode].son[2]];  tb[subNode].son[2] _ Tree.Null;
                    started _ FALSE;  ScanList[tb[subNode].son[1], PushTest];
                    IF selection = Stmt THEN {PushNode[if, -3]; SetInfo[tb[subNode].info]}
                    ELSE {PushNode[ifx, -3]; SetInfo[tb[node].info]};
                    RETURN};

                son[1] _ AdjustBias[son[1], -VBias[]];  VPop[];
                PushTree[son[3]];  son[3] _ Tree.Null;
                ReverseScanList[son[2], CaseItem];
                FreeNode[node];
                passPtr.implicitAttr _ voidAttr;
                val _ selection[PopTree[]]}
            ELSE {
                nSons: CARDINAL = ListLength[son[2]];
                i, j, first, last, next, newSons: CARDINAL;
                min, max: INT;
                minTree, maxTree: Tree.Link;
                rep: Repr;
                subNode, listNode: Tree.Index;
                switchable, copying: BOOL;
                multiword: BOOL = AUsForType[type] # Target.bitsPerWord/Target.bitsPerAU;
                count: CARDINAL;

                TestExp: Tree.Map = {
                    v _ RValue[t, 0, none];
                    passPtr.implicitAttr.prop _ CommonProp[passPtr.implicitAttr.prop, VProp[]];
                    VPop[]};

                SwitchValue: Tree.Map = {
                    val: Tree.Link;
                    tNode: Tree.Index = GetNode[t];
                    val _ tb[tNode].son[2] _ RValue[tb[tNode].son[2], passPtr.implicitBias, rep];
                    passPtr.implicitAttr.prop _ CommonProp[passPtr.implicitAttr.prop, VProp[]];
                    VPop[];
                    IF count = 0 THEN {first _ i; minTree _ maxTree _ val}
                    ELSE {
                        subRep: Repr = (SELECT rep FROM other, none => unsigned, ENDCASE => rep);
                        IF RelTest[val, minTree, relL, subRep] THEN minTree _ val;
                        IF RelTest[val, maxTree, relG, subRep] THEN maxTree _ val};
                    count _ count + 1;
                    RETURN[t]};

                passPtr.implicitType _ type;
                passPtr.implicitBias _ VBias[] - labelBias;
                passPtr.implicitAttr _ VAttr[];  rep _ passPtr.implicitAttr.rep;  VPop[];
                newSons _ nSons;
                i _ next _ 1;  copying _ FALSE;  listNode _ GetNode[son[2]];
                UNTIL i > nSons DO
                    WHILE i <= nSons DO
                        subNode _ GetNode[tb[listNode].son[i]];
                        IF tb[subNode].attr1 AND ~multiword THEN EXIT;
                        tb[subNode].son[1] _ UpdateList[tb[subNode].son[1], TestExp];
                        tb[subNode].son[2] _ selection[tb[subNode].son[2]];
                        i _ i+1;
                        ENDLOOP;
                    switchable _ FALSE;  count _ 0;
                    WHILE i <= nSons DO  -- N.B. implicitbias is never changed by this loop
                        subNode _ GetNode[tb[listNode].son[i]];
                        IF ~tb[subNode].attr1 OR multiword THEN EXIT;
                        tb[subNode].son[1] _ UpdateList[tb[subNode].son[1], SwitchValue];
                        tb[subNode].son[2] _ selection[tb[subNode].son[2]];
                        switchable _ TRUE;  last _ i;  i _ i+1;
                        ENDLOOP;
                    IF switchable
                        AND SwitchWorthy[count,
                            (max_TreeLiteralValue[maxTree])-(min_TreeLiteralValue[minTree])] THEN {
                            copying _ TRUE;
                            FOR j IN [next .. first) DO PushTree[tb[listNode].son[j]] ENDLOOP;
                            PushTree[AdjustBias[Tree.Null, min]];
                            PushTree[MakeTreeLiteral[max-min+1]];
                            FOR j IN [first .. last] DO PushTree[SwitchTree[tb[listNode].son[j], min]] ENDLOOP;
                            PushProperList[last-first+1];
                            PushNode[caseswitch, 3];
                            next _ last+1;  newSons _ newSons - (last-first)};
                    ENDLOOP;
                IF copying THEN {
                    FOR j IN [next .. nSons] DO PushTree[tb[listNode].son[j]] ENDLOOP;
                    PushProperList[newSons];  son[2] _ PopTree[]};
                son[3] _ selection[son[3]];
                val _ Tree.Link[subtree[index: node]]};
            passPtr.implicitAttr _ saveAttr;  passPtr.implicitBias _ saveBias;
            passPtr.implicitType _ saveType;
            RETURN};

        <<auxiliary routines for CaseDriver>>

            SwitchWorthy: PROC[entries, delta: CARD] RETURNS[BOOL] = {
                <<the decision function for using a switch>>
                RETURN[delta < 77777b AND delta+6 < 3*entries]};

            SwitchTree: PROC[t: Tree.Link, offset: INT] RETURNS[Tree.Link] = {
                node: Tree.Index = GetNode[t];
                count: CARDINAL;

                PushSwitchEntry: Tree.Scan = {
                    subNode: Tree.Index = GetNode[t];
                    count _ count+1;
                    PushTree[MakeTreeLiteral[TreeLiteralValue[tb[subNode].son[2]]-offset]]};

                count _ 0;  ScanList[tb[node].son[1], PushSwitchEntry];
                PushList[count];  PushTree[tb[node].son[2]];
                tb[node].son[2] _ Tree.Null;  FreeNode[node];
                RETURN[MakeNode[casetest, 2]]};


    <<iterative statements>>

        DoStmt: PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            void: BOOL _ FALSE;
            bti: BTIndex _ BTNull;
            IF son[1] # Tree.Null THEN [bti, void] _ ForClause[GetNode[son[1]]];
            IF son[2] # Tree.Null THEN {
                son[2] _ BoolValue[son[2]];
                IF TreeLiteral[son[2]] THEN {
                    IF BoolTest[son[2]] THEN son[2] _ FreeTree[son[2]] ELSE void _ TRUE};
                VPop[]};
            son[3] _ UpdateList[son[3], OpenItem];
            son[4] _ UpdateList[son[4], Stmt];
            son[5] _ UpdateList[son[5], Stmt];
            son[6] _ UpdateList[son[6], Stmt];
            son[3] _ ReverseUpdateList[son[3], CloseItem];
            IF catchScope AND bti # BTNull THEN
                catchBound _ MAX[AssignBlock[bti, catchBase], catchBound];
            IF ~void THEN val _ [subtree[index: node]]
            ELSE {val _ son[6]; son[6] _ Tree.Null; FreeNode[node]};
            RETURN};

        ForClause: PROC[node: Tree.Index] RETURNS[bti: BTIndex, void: BOOL] = {
            idBias: INTEGER;
            idRep, rep: Repr;
            idType, type1, type2: Type;
            iNode: Tree.Index;
            range: CARDINAL;
            cs: ConsState _ $first;
            void _ FALSE;  bti _ ToBti[tb[node].info];
            IF tb[node].son[1] = Tree.Null THEN {
                idType _ dataPtr.idINTEGER; idBias _ 0; idRep _ both}
            ELSE {
                IF OpName[tb[node].son[1]] = decl THEN {
                    subNode: Tree.Index _ GetNode[tb[node].son[1]];
                    ScanList[tb[node].son[1], DeclItem];
                    tb[node].son[1] _ tb[subNode].son[1];
                    tb[subNode].son[1] _ Tree.Null;  FreeNode[subNode];
                    cs _ $init};
                idType _ OperandType[tb[node].son[1]];
                tb[node].son[1] _ Exp[tb[node].son[1], none];
                idBias _ VBias[];  idRep _ VRep[]; VPop[]};
            SELECT tb[node].name FROM
                forseq => {
                    tb[node].son[2] _ Rhs[tb[node].son[2], idType, cs];      VPop[];
                    tb[node].son[3] _ Rhs[tb[node].son[3], idType, $first];  VPop[]};
                upthru, downthru => {
                    tb[node].son[2] _ NormalizeRange[tb[node].son[2]];
                    iNode _ GetNode[tb[node].son[2]];
                    type1 _ OperandType[tb[iNode].son[1]];
                    type2 _ OperandType[tb[iNode].son[2]];
                    tb[node].attr1 _ Interval[iNode, idBias, idRep].const AND TypeForm[idType] # $long;
                    IF tb[node].attr1 AND ~tb[iNode].attr2 THEN
                        [] _ ConstantInterval[iNode ! EmptyInterval => {void _ TRUE; RESUME}];
                    rep _ CommonRep[VRep[], idRep];
                    tb[iNode].attr3 _ rep # unsigned;  VPop[];
                    IF rep = none OR (rep = unsigned AND idBias > 0) THEN
                        Log.ErrorTree[mixedRepresentation, tb[node].son[2]];
                    SELECT TRUE FROM
                        void => NULL;
                        (AUsForType[idType] = 0) => Log.ErrorTree[sizeClash, tb[node].son[1]];
                        (~EqTypes[idType, dataPtr.typeINTEGER]) AND (idType # typeANY) => {
                            OPEN tb[iNode];
                            range _ Cardinality[idType];
                            IF (checked OR dataPtr.switches['b]) AND range # 0 THEN
                                IF (Cover[idType, idRep, type1, rep] # $full AND RangeTest[son[1], range] # in)
                                    OR
                                        (Cover[idType, idRep, type2, rep] # $full AND RangeTest[son[2], range] # in) THEN
                                        tb[node].son[3] _ MakeTreeLiteral[range];
                            IF name = intCC AND ~EqTypes[type2, dataPtr.typeINTEGER] THEN
                                IF TreeLiteral[son[1]] AND
                                    INTEGER[TreeLiteralValue[son[1]]]+idBias <= BiasForType[type2] THEN
                                        tb[node].attr1 _ TRUE;
                            IF tb[node].attr1 AND range # 0 THEN {    -- nonvoid interval
                                IF (name=intCC OR name=intCO) AND RangeTest[son[1], range] = out THEN
                                    Log.ErrorTree[boundsFault, son[1]];
                                IF (name=intCC OR name=intOC) AND RangeTest[son[2], range] = out THEN
                                    Log.ErrorTree[boundsFault, son[2]]}};
                        ENDCASE};
                ENDCASE => ERROR;
            RETURN};

        RangeTest: PROC[t: Tree.Link, range: CARDINAL] RETURNS[{in, out, unknown}] = {
            RETURN[IF TreeLiteral[t]
                THEN IF TreeLiteralValue[t] < range THEN in ELSE out
                ELSE unknown]
            };


    <<free>>

        Free: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            OPEN tb[node];
            vType, pType: Type;
            IF son[1] # Tree.Null THEN {son[1] _ Exp[son[1], none]; VPop[]};
            son[2] _ NeutralExp[son[2]];
            vType _ OperandType[son[2]];  pType _ DerefType[vType];
            IF OpName[son[2]] = addr THEN {
                subNode: Tree.Index = GetNode[son[2]];
                son[2] _ tb[subNode].son[1];  tb[subNode].son[1] _ Tree.Null;  FreeNode[subNode]}
            ELSE {
                PushTree[son[2]];  PushNode[uparrow, 1];  SetType[pType];
                SetAttr[1, checked OR dataPtr.switches['n]];
                SetAttr[2, TypeForm[vType] = $long];
                son[2] _ PopTree[]};
            tb[node].son[3] _ MakeTreeLiteral[AUsForType[DerefType[pType]]];
            IF nSons > 3 THEN CatchNest[son[4]];
            RETURN[[subtree[index: node]]]};


    <<basing>>

        DerefType: PROC[type: Type] RETURNS[Type] = {
            subType: CSEIndex = NormalType[type];
            RETURN[WITH seb[subType] SELECT FROM
                ref => UnderType[refType],
                ENDCASE => type]
            };

        OpenItem: Tree.Map = {
            node: Tree.Index = GetNode[t];
            IF OpName[tb[node].son[2]] # openx THEN v _ Tree.Null
            ELSE {v _ NeutralExp[tb[node].son[2]]; tb[node].son[2] _ Tree.Null};
            FreeNode[node];
            RETURN};

        CloseItem: Tree.Map = {
            node: Tree.Index;
            IF bb[currentBody].firstSon # BTNull OR OpName[t] # openx THEN v _ t
            ELSE {
                MarkShared[t, FALSE];  node _ GetNode[t];
                v _ tb[node].son[1];  tb[node].son[1] _ Tree.Null;  FreeNode[node]};
            RETURN};


    <<catch phrases>>

        CatchFrameBase: CARDINAL = (PrincOps.localbase+1)*bitsPerWord;
        catchScope: BOOL;
        catchBase: CARDINAL;
        catchBound: CARDINAL;

        CatchNest: PUBLIC PROC[t: Tree.Link] = {
            IF t # Tree.Null THEN CatchPhrase[t]};

        CatchPhrase: PROC[t: Tree.Link] = {
            node: Tree.Index = GetNode[t];
            saveCatchScope: BOOL = catchScope;
            saveCatchBase: CARDINAL = catchBase;
            saveCatchBound: CARDINAL = catchBound;
            bound: CARDINAL;

            CatchTest: Tree.Map = {
                PushTree[Tree.Null];  PushTree[Exp[t, none]];  VPop[];
                PushNode[relE, 2];  SetType[dataPtr.idBOOL];
                RETURN[PopTree[]]};

            CatchItem: Tree.Scan = {
                node: Tree.Index = GetNode[t];
                type: CSEIndex = UnderType[ToType[tb[node].info]];
                saveRecord: RecordSEIndex = passPtr.resumeRecord;
                tb[node].son[1] _ UpdateList[tb[node].son[1], CatchTest];
                catchBase _ CatchFrameBase;
                IF type = CSENull THEN passPtr.resumeRecord _ RecordSENull
                ELSE
                    WITH t: seb[type] SELECT FROM
                        transfer => {
                            passPtr.resumeRecord _ ArgRecord[t.typeOut];
                            catchBase _ catchBase +
                                ArgLength[ArgRecord[t.typeIn]] + ArgLength[passPtr.resumeRecord]};
                        ENDCASE => ERROR;
                catchBound _ catchBase;
                tb[node].son[2] _ Stmt[tb[node].son[2]];
                bound _ MAX[bound, catchBound];
                passPtr.resumeRecord _ saveRecord};

            catchScope _ TRUE;  currentLevel _ currentLevel + 1;
            bound _ CatchFrameBase + bitsPerWord;
            ScanList[tb[node].son[1], CatchItem];
            IF tb[node].nSons > 1 THEN {
                catchBound _ catchBase _ CatchFrameBase;
                tb[node].son[2] _ Stmt[tb[node].son[2]];
                bound _ MAX[bound, catchBound]};
            tb[node].info _ FromCard[(bound + (bitsPerWord-1))/bitsPerWord];
            catchBase _ saveCatchBase;  catchBound _ saveCatchBound;
            currentLevel _ currentLevel - 1;  catchScope _ saveCatchScope};

        ArgLength: PROC[rSei: RecordSEIndex] RETURNS[CARDINAL] = {
            RETURN[IF rSei # RecordSENull THEN seb[rSei].length ELSE 0]};

        }.

