
    <<Pass2.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 18, 1986 12:20:58 pm PDT>>
        <<Donahue,  9-Dec-81 12:03:59>>
        <<Russ Atkinson (RRA) March 6, 1985 11:54:58 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [AddNotify, Bounds, DropNotify, Notifier, Words],
        ComData: TYPE USING [bodyIndex, defBodyLimit, idLOCK, importCtx, interface, mainCtx, moduleCtx, monitored, nBodies, nInnerBodies, 
        nSigCodes, table, textIndex],
        CompilerUtil: TYPE USING [],
        Log: TYPE USING [Error, ErrorHti],
        SourceMap: TYPE USING [Loc, Down],
        Symbols: TYPE USING [Base, BodyInfo, BodyLink, BodyRecord, bodyType, BTIndex, BTNull, CBTIndex, CBTNull, ContextLevel, CSEIndex, 
        CSENull, CTXIndex, CTXNull, ctxType, ISEIndex, ISENull, lG, lL, lZ, Name, nullName, nullType, RecordSEIndex, RecordSENull, 
        RootBti, SERecord, seType, TransferMode, Type, typeANY, typeTYPE],
        SymbolOps: TYPE USING [BlockLevel, EncodeCard, EncodeTreeIndex, FillCtxSe, FirstCtxSe, FromBti, FromCtx, FromType, NewCtx, 
        MakeNonCtxSe, MakeSeChain, NameClash, NextLevel, NextSe, SetMainCtx, StaticNestError, ToBti],
        Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, nullIndex, Scan, treeType],
        TreeOps: TYPE USING [FreeNode, FromCard, GetInfo, GetNode, GetTag, ListHead, ListLength, NthSon, OpName, PutInfo, ScanList, ToLoc, 
        UpdateList];

    Pass2: PROGRAM
        IMPORTS Alloc, Log, SourceMap, SymbolOps, TreeOps, dataPtr: ComData
        EXPORTS CompilerUtil = {
        OPEN TreeOps, SymbolOps, Symbols;

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

        Notify: Alloc.Notifier = {
            <<called by allocator whenever tables are repacked>>
            tb _ base[Tree.treeType];
            seb _ base[seType];  ctxb _ base[ctxType];  bb _ base[bodyType]};

        ContextInfo: TYPE = RECORD[
            ctx: CTXIndex,
            staticLevel: ContextLevel,
            seChain: ISEIndex];

        current: ContextInfo;

        NewContext: PROC[level: ContextLevel, entries: NAT, unique: BOOL] = {
            OPEN c: current;
            c.staticLevel _ level;
            IF entries = 0 AND ~unique THEN {c.ctx _ CTXNull; c.seChain _ ISENull}
            ELSE {
                c.ctx _ NewCtx[level];
                ctxb[c.ctx].seList _ c.seChain _ MakeSeChain[c.ctx, entries, level=lG]}
            };


        <<main driver>>

            P2Unit: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
                node: Tree.Index;
                (dataPtr.table).AddNotify[Notify];  anySei _ CSENull;
                node _ GetNode[t];
                    BEGIN
                    ENABLE {    -- default error reporting
                        NameClash => {Log.ErrorHti[duplicateId, name]; RESUME};
                        StaticNestError => {Log.Error[staticNesting]; RESUME}};
                    dataPtr.textIndex _ ToLoc[tb[node].info];
                    dataPtr.bodyIndex _ CBTNull;
                    dataPtr.nBodies _ dataPtr.nInnerBodies _ dataPtr.nSigCodes _ 0;
                    btLink _ [which:parent, index:BTNull];
                    NewContext[
                        level: lZ,
                        entries: ListLength[tb[node].son[1]] + CountIds[tb[node].son[6]],
                        unique: FALSE];
                    dataPtr.moduleCtx _ current.ctx;
                    ScanList[tb[node].son[1], IdItem];
                    ImportList[tb[node].son[2]];
                    <<process LOCKS clause>>
                        dataPtr.monitored _ tb[node].son[5] # Tree.Null;
                        lockLambda _ Lambda[tb[node].son[5], lL];
                    MainBody[tb[node].son[6]];
                    dataPtr.defBodyLimit _ (dataPtr.table).Bounds[bodyType].size;
                    END;
                (dataPtr.table).DropNotify[Notify];
                RETURN[t]};

            ImportList: PROC[t: Tree.Link] = {
                saved: ContextInfo = current;
                NewContext[lG, ListLength[t], FALSE];
                dataPtr.importCtx _ current.ctx;
                ScanList[t, IdItem];
                current _ saved};

            MainBody: PROC[t: Tree.Link] = INLINE {
                dataPtr.interface _ (OpName[NthSon[t, 2]] = definitionTC);
                DeclList[t];
                BodyList[RootBti]};


        <<monitor lock processing>>

            lockLambda: Tree.Index;

            Lambda: PROC[item: Tree.Link, level: ContextLevel] RETURNS[node: Tree.Index] = {
                node _ GetNode[item];
                IF node # Tree.nullIndex THEN {
                    saved: ContextInfo = current;
                    NewContext[level, CountIds[tb[node].son[1]], FALSE];
                    tb[node].info _ FromCtx[current.ctx];
                    DeclList[tb[node].son[1]];  Exp[tb[node].son[2]];
                    current _ saved};
                RETURN};

            ImplicitLock: PROC = {
                sei: ISEIndex = current.seChain;
                tb[lockLambda].son[2] _ Ids[
                    list: tb[lockLambda].son[2],
                    public: tb[lockLambda].attr2,
                    link: Tree.nullIndex];
                seb[sei].idType _ dataPtr.idLOCK;  seb[sei].idInfo _ EncodeCard[1];
                seb[sei].mark3 _ TRUE};


        <<body processing>>

            btLink: BodyLink;

            AllocateBody: PROC[node: Tree.Index, id: ISEIndex] RETURNS[bti: CBTIndex] = {
                <<queue body for later processing>>
                <<force nesting message here>>
                SELECT NextLevel[current.staticLevel] FROM
                    lG, lL => {
                        bti _ (dataPtr.table).Words[bodyType, BodyRecord.Callable.Outer.SIZE];
                        bb[bti] _ [,,,,,,, Callable[,,,,,,,,,,Outer[]]]};
                    ENDCASE => {
                        bti _ (dataPtr.table).Words[bodyType, BodyRecord.Callable.Inner.SIZE];
                        bb[bti] _ [,,,,,,, Callable[,,,,,,,,,, Inner[frameOffset: ]]]};
                bb[bti].firstSon _ BTNull;
                bb[bti].sourceIndex _ dataPtr.textIndex.Down;
                bb[bti].info _ [Internal[bodyTree:node, thread:Tree.nullIndex, frameSize: ]];
                bb[bti].id _ id;
                bb[bti].entry _ bb[bti].internal _ FALSE;
                <<conservative initial approximations>>
                    bb[bti].ioType _ typeANY;
                    bb[bti].noXfers _ FALSE;
                    bb[bti].hints _ [safe:FALSE, argUpdated:TRUE, nameSafe:FALSE, noStrings:FALSE];
                LinkBody[bti];  RETURN};

            LinkBody: PROC[bti: BTIndex] = {
                IF btLink.which = parent THEN {
                    bb[bti].link _ btLink;
                    IF btLink.index # BTNull THEN bb[btLink.index].firstSon _ bti
                        ELSE IF bti # RootBti THEN ERROR}
                ELSE {
                    bb[bti].link _ bb[btLink.index].link;
                    bb[btLink.index].link _ [which:sibling, index: bti]}
                };

            SetEntryAttr: PROC[t: Tree.Link, attr: Tree.NodeName] = {
                IF OpName[t] # body OR ~dataPtr.monitored THEN Log.Error[misplacedEntry]
                ELSE {    -- see AllocateBody
                    bti: BTIndex = ToBti[GetInfo[t]];
                    WITH body: bb[bti] SELECT FROM
                        Callable =>
                            SELECT attr FROM
                                entry => body.entry _ TRUE;
                                internal => body.internal _ TRUE;
                                ENDCASE;
                        ENDCASE;
                    }
                };


            BodyList: PROC[firstBti: BTIndex] = {
                FOR bti: BTIndex _ firstBti, bb[bti].link.index UNTIL bti = BTNull DO
                    WITH bb[bti] SELECT FROM
                        Callable => Body[LOOPHOLE[bti, CBTIndex]];
                        ENDCASE => NULL;
                    IF bb[bti].link.which = parent THEN EXIT;
                    ENDLOOP
                };

            Body: PROC[bti: CBTIndex] = {
                node: Tree.Index = NARROW[bb[bti].info, BodyInfo.Internal].bodyTree;
                level: ContextLevel;
                nLocks: [0..1];
                oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
                oldBtLink: BodyLink = btLink;
                saved: ContextInfo = current;
                dataPtr.bodyIndex _ bti;
                btLink _ [which:parent, index:bti];
                level _ NextLevel[saved.staticLevel ! StaticNestError => {RESUME}];
                nLocks _ IF level = lG AND dataPtr.monitored AND tb[lockLambda].attr1
                    THEN 1
                    ELSE 0;
                NewContext[
                    level: level,
                    entries: nLocks + CountIds[tb[node].son[2]],
                    unique: level = lG];
                bb[bti].localCtx _ current.ctx;  bb[bti].level _ BlockLevel[level];
                bb[bti].monitored _ nLocks # 0;  bb[bti].inline _ tb[node].attr3;
                bb[bti].type _ IF current.ctx = CTXNull OR bb[bti].inline
                    THEN RecordSENull
                    ELSE BodyType[current.ctx, bb[bti].monitored];
                IF level = lG THEN {
                    IF bti # RootBti THEN ERROR;
                    dataPtr.mainCtx _ current.ctx;  SetMainCtx[current.ctx]};
                ExpList[tb[node].son[1]];
                IF nLocks # 0 THEN ImplicitLock[];
                DeclList[tb[node].son[2]];
                StmtList[tb[node].son[3]];
                BodyList[bb[bti].firstSon];
                current _ saved;  dataPtr.bodyIndex _ oldBodyIndex;  btLink _ oldBtLink};


            NewScope: PROC[node: Tree.Index, decls: Tree.Link] RETURNS[bti: BTIndex] = {
                level: ContextLevel = BlockLevel[current.staticLevel];
                NewContext[level:level, entries:CountIds[decls], unique:FALSE];
                bti _ (dataPtr.table).Words[bodyType, BodyRecord.Other.SIZE];
                bb[bti] _ [
                    link: ,
                    firstSon: BTNull,
                    type: IF bb[dataPtr.bodyIndex].inline
                        THEN RecordSENull ELSE BodyType[current.ctx, FALSE],
                    localCtx: current.ctx, level: level,
                    sourceIndex: ToLoc[tb[node].info].Down,
                    info: [Internal[bodyTree:node, thread:Tree.nullIndex, frameSize: ]],
                    extension: Other[relOffset: ]];
                LinkBody[bti];  btLink _ [which:parent, index:bti];
                DeclList[decls]};


            BodyType: PROC[ctx: CTXIndex, monitored: BOOL] RETURNS[rSei: RecordSEIndex] = {
                rSei _ LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]];
                seb[rSei].typeInfo _ record[
                    machineDep: FALSE, painted: TRUE, argument: FALSE,
                    hints: [
                        unifield: FALSE, variant: FALSE,
                        assignable: FALSE, comparable: FALSE, privateFields: TRUE,
                        refField: FALSE, default: FALSE, voidable: FALSE],
                    length: 0,
                    fieldCtx: ctx,
                    monitored: monitored,
                    linkPart: notLinked[]];
                RETURN};


            CodeBody: PROC[node: Tree.Index] = {
                InlineOp: Tree.Scan = {ExpList[t]};
                ScanList[tb[node].son[1], InlineOp]};


        <<declarations>>

            DeclList: PROC[t: Tree.Link, linkId: Type_nullType] = {

                DeclItem: Tree.Scan = {
                    node: Tree.Index = GetNode[t];
                    saveIndex: SourceMap.Loc = dataPtr.textIndex;
                    dataPtr.textIndex _ ToLoc[tb[node].info];
                    tb[node].son[1] _ Ids[
                        list: tb[node].son[1],
                        type: (tb[node].name = typedecl),
                        public: tb[node].attr2,
                        link: node];
                    tb[node].attr2 _ tb[node].attr3 _ FALSE;
                    SELECT tb[node].name FROM
                        typedecl => {
                            TypeExp[t:tb[node].son[2], typeId:FirstId[tb[node].son[1]], linkId:linkId];
                            ExpList[tb[node].son[3]]};
                        decl => {
                            TypeExp[t:tb[node].son[2], linkId:linkId];
                            tb[node].son[3] _ InitialValue[
                                tb[node].son[3], 
                                IF tb[node].attr1 THEN FirstId[tb[node].son[1]] ELSE ISENull]};
                        ENDCASE => Log.Error[unimplemented];
                    dataPtr.textIndex _ saveIndex};

                ScanList[t, DeclItem]};

            CountIds: PROC[declList: Tree.Link] RETURNS[n: NAT_0] = {
                NIds: Tree.Scan = {n _ n + ListLength[NthSon[t, 1]]};
                ScanList[declList, NIds];  RETURN};


            InitialValue: PROC[t: Tree.Link, id: ISEIndex] RETURNS[v: Tree.Link] = {
                v _ t;    -- the default
                IF t # Tree.Null THEN
                    WITH s: t SELECT GetTag[t] FROM
                        subtree => {
                            node: Tree.Index = s.index;
                            SELECT tb[node].name FROM
                                body => {
                                    bti: CBTIndex = AllocateBody[node, id];
                                    tb[node].info _ FromBti[bti];
                                    IF ~tb[node].attr3 THEN {
                                        dataPtr.nBodies _ dataPtr.nBodies+1;
                                        IF current.staticLevel >= lL THEN
                                            dataPtr.nInnerBodies _ dataPtr.nInnerBodies + 1};
                                    btLink _ [which:sibling, index:bti]};
                                entry, internal => {
                                    v _ InitialValue[tb[node].son[1], id];
                                    SetEntryAttr[v, tb[node].name];
                                    tb[node].son[1] _ Tree.Null;  FreeNode[node]};
                                signalinit => {
                                    tb[node].info _ FromCard[dataPtr.nSigCodes];
                                    dataPtr.nSigCodes _ dataPtr.nSigCodes+1};
                                inline => CodeBody[node];
                                ENDCASE => ExpList[t]};
                        ENDCASE => ExpList[t]
                };


            IdItem: Tree.Scan = {
                node: Tree.Index = GetNode[t];
                saveIndex: SourceMap.Loc = dataPtr.textIndex;
                dataPtr.textIndex _ ToLoc[tb[node].info];
                tb[node].son[1] _ Ids[list: tb[node].son[1], public: FALSE, link: node];
                dataPtr.textIndex _ saveIndex};


        <<id list manipulation>>

            Ids: PROC [list: Tree.Link, public: BOOL, type: BOOL _ FALSE, link: Tree.Index]
                RETURNS[Tree.Link] = {

                Id: Tree.Map = {
                    WITH t SELECT GetTag[t] FROM
                        hash, symbol => {
                            name: Name = (WITH t SELECT GetTag[t] FROM
                                hash => index,
                                symbol => seb[index].hash,
                                ENDCASE => ERROR);
                            sei: ISEIndex = current.seChain;
                            current.seChain _ NextSe[current.seChain];
                            FillCtxSe[sei, name, public];
                            seb[sei].idType _ (IF type THEN typeTYPE ELSE typeANY);
                            seb[sei].public _ public;
                            seb[sei].immutable _ seb[sei].constant _ FALSE;
                            seb[sei].idValue _ EncodeTreeIndex[link];  seb[sei].idInfo _ EncodeCard[0];
                            seb[sei].extended _ seb[sei].linkSpace _ FALSE;
                            v _ [symbol[index: sei]]};
                        subtree => {
                            node: Tree.Index = index;
                            tb[node].son[1] _ Id[tb[node].son[1]];  Position[tb[node].son[2]];
                            v _ t};
                        ENDCASE => ERROR;
                    RETURN};

                RETURN[UpdateList[list, Id]]};


            FirstId: PROC[t: Tree.Link] RETURNS[ISEIndex] = {
                head: Tree.Link = ListHead[t];
                RETURN[WITH head SELECT GetTag[head] FROM
                    symbol => index,
                    subtree => FirstId[tb[index].son[1]],
                    ENDCASE => ERROR]
                };


        <<type manipulation>>

            TypeExp: PROC[t: Tree.Link, typeId, linkId: Type_nullType] = {
                sei: CSEIndex;
                WITH s: t SELECT GetTag[t] FROM
                    subtree => {
                        node: Tree.Index = s.index;
                        SELECT tb[node].name FROM

                            enumeratedTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.enumerated.SIZE];
                                seb[sei].typeInfo _ enumerated[
                                    ordered: TRUE, sparse: FALSE,
                                    machineDep: tb[node].attr2,
                                    painted: tb[node].attr2 OR dataPtr.interface,
                                    valueCtx: Enumeration[node], empty: , range: ];
                                AssignValues[sei, IF typeId # nullType THEN typeId ELSE sei]};

                            recordTC, monitoredTC => {
                                tCtx: CTXIndex;
                                nFields: NAT;
                                sei _ MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
                                [tCtx, nFields] _ FieldList[
                                    t: tb[node].son[1],
                                    level: lZ,
                                    typeId: IF typeId # nullType THEN typeId ELSE sei];
                                seb[sei].typeInfo _ record[
                                    machineDep: tb[node].attr1,
                                    painted: tb[node].attr1 OR (dataPtr.interface AND tb[node].attr3),
                                    argument: FALSE,
                                    hints: [
                                        unifield: nFields = 1 AND ~tb[node].attr2,
                                        variant: tb[node].attr2,
                                        assignable: TRUE, comparable: FALSE, privateFields: FALSE,
                                        refField: FALSE, default: FALSE, voidable: TRUE],
                                    length: ,
                                    fieldCtx: tCtx,
                                    monitored: tb[node].name = monitoredTC,
                                    linkPart: notLinked[]];
                                IF tb[node].name = monitoredTC AND tb[node].attr1 THEN Log.Error[attrClash]};

                            variantTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.record.linked.SIZE];
                                seb[sei].typeInfo _ record[
                                    machineDep: tb[node].attr1,
                                    painted: tb[node].attr3,
                                    argument: FALSE,
                                    hints: [
                                        unifield: FALSE,
                                        variant: tb[node].attr2,
                                        assignable: TRUE, comparable: FALSE, privateFields: FALSE,
                                        refField: FALSE, default: FALSE, voidable: TRUE],
                                    length: ,
                                    fieldCtx: FieldList[t:tb[node].son[1], level:lZ, typeId:typeId].ctx,
                                    monitored: FALSE,
                                    linkPart: linked[linkId]]};

                            refTC, listTC, pointerTC, varTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.ref.SIZE];
                                seb[sei].typeInfo _ ref[
                                    counted: tb[node].name = refTC OR tb[node].name = listTC,
                                    var: tb[node].name = varTC,
                                    ordered: tb[node].attr1,
                                    basing: tb[node].attr2,
                                    list: tb[node].name = listTC,
                                    readOnly: tb[node].attr3,
                                    refType: ];
                                TypeExp[tb[node].son[1]]};

                            arrayTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.array.SIZE];
                                seb[sei].typeInfo _ array[
                                    packed: tb[node].attr3,
                                    indexType: ,
                                    componentType: ];
                                OptTypeExp[tb[node].son[1]];  TypeExp[tb[node].son[2]]};

                            arraydescTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.arraydesc.SIZE];
                                seb[sei].typeInfo _ arraydesc[
                                    readOnly: tb[node].attr3, var: FALSE, describedType: ];
                                TypeExp[tb[node].son[1]]};

                            procTC, processTC, portTC, signalTC, errorTC, programTC => {
                                modeMap: ARRAY Tree.NodeName[procTC..programTC] OF TransferMode = [
                                    procTC: proc, processTC: process, portTC: port,
                                    signalTC: signal, errorTC: error, programTC: program];
                                sei _ MakeNonCtxSe[SERecord.cons.transfer.SIZE];
                                seb[sei].typeInfo _ transfer[
                                    mode: modeMap[tb[node].name], safe: tb[node].attr3,
                                    typeIn:  ArgList[tb[node].son[1]],
                                    typeOut: ArgList[tb[node].son[2]]]};

                            anyTC => sei _ TypeAny[];

                            definitionTC => { 
                                sei _ MakeNonCtxSe[SERecord.cons.definition.SIZE];
                                seb[sei].typeInfo _ definition[nDummyGfi: 1, named: FALSE, defCtx: ]};

                            unionTC => sei _ Union[node, linkId];
                            sequenceTC => sei _ Sequence[node];

                            relativeTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.relative.SIZE];
                                seb[sei].typeInfo _ relative[baseType: , offsetType: , resultType: ];
                                TypeExp[tb[node].son[1]];  TypeExp[tb[node].son[2]]};

                            subrangeTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.subrange.SIZE];
                                seb[sei].typeInfo _ subrange[
                                    filled: FALSE,  empty: FALSE,
                                    rangeType: , biased: TRUE,
                                    origin: , range: ];
                                TypeExp[tb[node].son[1]];  Exp[tb[node].son[2]]};

                            longTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.long.SIZE];
                                seb[sei].typeInfo _ long[rangeType: ];
                                TypeExp[tb[node].son[1]]};

                            opaqueTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.opaque.SIZE];
                                seb[sei].typeInfo _ opaque[
                                    lengthKnown: tb[node].son[1] # Tree.Null,
                                    length: 0,
                                    id: WITH seb[typeId] SELECT FROM
                                        id => LOOPHOLE[typeId],
                                        ENDCASE => ISENull];
                                Exp[tb[node].son[1]]};

                            zoneTC => {
                                sei _ MakeNonCtxSe[SERecord.cons.zone.SIZE];
                                seb[sei].typeInfo _ zone[counted: ~tb[node].attr1, mds: tb[node].attr2]};

                            paintTC => {
                                sei _ CSENull;
                                TypeExp[tb[node].son[1]];  TypeExp[tb[node].son[2]]};

                            implicitTC, linkTC, frameTC => sei _ CSENull;
                            dot, discrimTC => {TypeExp[tb[node].son[1]]; sei _ CSENull};

                            apply => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]; sei _ CSENull};

                            ENDCASE => {sei _ CSENull; Log.Error[nonTypeCons]};

                        tb[node].info _ FromType[sei]};
                    ENDCASE => NULL
                };

            OptTypeExp: PROC[t: Tree.Link] = {IF t # Tree.Null THEN TypeExp[t]};


            Enumeration: PROC[node: Tree.Index] RETURNS[ctx: CTXIndex] = {
                saved: ContextInfo = current;
                NewContext[lZ, ListLength[tb[node].son[1]], TRUE];  ctx _ current.ctx;
                tb[node].son[1] _ Ids[
                    list: tb[node].son[1],
                    public: tb[node].attr1,
                    link: Tree.nullIndex];
                current _ saved;  RETURN};

            AssignValues: PROC[type: CSEIndex, valueType: Type] = {
                WITH t: seb[type] SELECT FROM
                    enumerated => {
                        i: CARD _ 0;
                        FOR sei: ISEIndex _ FirstCtxSe[t.valueCtx], NextSe[sei] UNTIL sei = ISENull DO
                            seb[sei].idType _ valueType;  seb[sei].idInfo _ EncodeCard[0];
                            seb[sei].idValue _ EncodeCard[i];  i _ i+1;
                            seb[sei].immutable _ seb[sei].constant _ TRUE;
                            seb[sei].mark3 _ seb[sei].mark4 _ TRUE;
                            ENDLOOP;
                        t.empty _ (i=0);  t.range _ (IF i=0 THEN 0 ELSE i-1)};
                    ENDCASE => ERROR
                };


            FieldList: PROC[t: Tree.Link, level: ContextLevel, typeId: Type] 
                RETURNS [ctx: CTXIndex, nFields: NAT] = {
                saved: ContextInfo = current;
                nFields _ CountIds[t];
                NewContext[level, nFields, TRUE];  ctx _ current.ctx; 
                DeclList[t, typeId];
                current _ saved;  RETURN};

            ArgList: PROC[t: Tree.Link] RETURNS [sei: CSEIndex] = {
                IF t = Tree.Null THEN sei _ RecordSENull
                ELSE IF OpName[t] = anyTC THEN sei _ TypeAny[]
                ELSE {
                    tCtx: CTXIndex;
                    nFields: NAT;
                    sei _ MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
                    [tCtx, nFields] _ FieldList[t, lZ, sei];
                    seb[sei].typeInfo _ record[
                        machineDep: FALSE,
                        painted: FALSE,
                        argument: TRUE,
                        hints: [
                            unifield: nFields = 1,
                            variant: FALSE,
                            assignable: TRUE, comparable: FALSE, privateFields: FALSE,
                            refField: FALSE, default: FALSE, voidable: TRUE],
                        length: ,
                        fieldCtx: tCtx,
                        monitored: FALSE,
                        linkPart: notLinked[]]};
                RETURN};


            anySei: CSEIndex;

            TypeAny: PROC RETURNS [CSEIndex] = {
                IF anySei = CSENull THEN {
                    anySei _ MakeNonCtxSe[SERecord.cons.any.SIZE];
                    seb[anySei] _ [mark3: TRUE, mark4: TRUE, body: cons[any[]]]};
                RETURN[anySei]};


            TagField: PROC[t: Tree.Link, MakeTagType: PROC RETURNS[CSEIndex]]
                RETURNS [tagId: ISEIndex] = {
                saved: ContextInfo = current;
                node: Tree.Index;
                current.ctx _ CTXNull;  current.seChain _ MakeSeChain[CTXNull, 1, FALSE];
                DeclList[t];
                node _ GetNode[t];
                tagId _ FirstId[tb[node].son[1]];
                IF OpName[tb[node].son[2]] = implicitTC THEN {
                    subNode: Tree.Index = GetNode[tb[node].son[2]];
                    tagType: Type;
                    IF MakeTagType # NIL THEN tagType _ MakeTagType[]
                    ELSE {Log.Error[attrClash]; tagType _ typeANY};
                    tb[subNode].info _ FromType[tagType]};
                current _ saved;  RETURN};

            Union: PROC[node: Tree.Index, linkId: Type] RETURNS[sei: CSEIndex] = {
                saved: ContextInfo = current;

                MakeTagType: PROC RETURNS [type: CSEIndex] = {
                    saved: ContextInfo = current;

                    CollectTags: Tree.Scan = {
                        node: Tree.Index = GetNode[t];
                        tb[node].son[1] _ Ids[
                            list: tb[node].son[1],
                            public: tb[node].attr2,
                            link: Tree.nullIndex
                            ! NameClash => {RESUME}]
                        };

                    NewContext[lZ, CountIds[tb[node].son[2]], TRUE];
                    type _ MakeNonCtxSe[SERecord.cons.enumerated.SIZE];
                    seb[type].typeInfo _ enumerated[
                        ordered: FALSE, sparse: FALSE,
                        machineDep: FALSE,
                        painted: dataPtr.interface,
                        valueCtx: current.ctx, empty: , range: ];
                    ScanList[tb[node].son[2], CollectTags];
                    AssignValues[type, type];
                    current _ saved;  RETURN};

                tagId: ISEIndex = TagField[tb[node].son[1], MakeTagType];
                NewContext[lZ, CountIds[tb[node].son[2]], TRUE];
                DeclList[tb[node].son[2], linkId
                    ! NameClash => {Log.ErrorHti[duplicateTag, name]; RESUME}];
                sei _ MakeNonCtxSe[SERecord.cons.union.SIZE];
                seb[sei].typeInfo _ union[
                    caseCtx: current.ctx,
                    machineDep: tb[node].attr1,
                    overlaid: tb[node].attr2,
                    controlled: seb[tagId].hash # nullName,
                    tagSei: tagId,
                    hints: [
                        equalLengths: FALSE,
                        refField: FALSE, default: FALSE, voidable: TRUE]];
                current _ saved;  RETURN};

            Sequence: PROC[node: Tree.Index] RETURNS[sei: CSEIndex] = {
                tagId: ISEIndex = TagField[tb[node].son[1], NIL];
                IF tb[node].attr2 THEN Log.Error[attrClash];
                TypeExp[tb[node].son[2]];
                sei _ MakeNonCtxSe[SERecord.cons.sequence.SIZE];
                seb[sei].typeInfo _ sequence[
                    packed: tb[node].attr3,
                    controlled: seb[tagId].hash # nullName,
                    machineDep: tb[node].attr1,
                    tagSei: tagId,
                    componentType: ];
                RETURN};


        <<statements>>

            Stmt: PROC[stmt: Tree.Link] = {
                node: Tree.Index;
                saveIndex: SourceMap.Loc = dataPtr.textIndex;
                IF stmt = Tree.Null THEN RETURN;
                WITH stmt SELECT GetTag[stmt] FROM
                    subtree => {
                        node _ index;
                        dataPtr.textIndex _ ToLoc[tb[node].info];
                        SELECT tb[node].name FROM
                            assign => {Exp[tb[node].son[1]]; Exp[tb[node].son[2]]};
                            extract => {ExpList[tb[node].son[1]]; Exp[tb[node].son[2]]};
                            apply => {
                                Exp[tb[node].son[1]];  ExpList[tb[node].son[2]];
                                IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
                            block => Block[node];
                            if => {
                                Exp[tb[node].son[1]]; StmtList[tb[node].son[2]]; StmtList[tb[node].son[3]]};
                            case => {
                                Exp[tb[node].son[1]]; SelectionList[tb[node].son[2], Stmt]; Stmt[tb[node].son[3]]};
                            bind => {
                                Exp[tb[node].son[1]];  Exp[tb[node].son[2]];
                                SelectionList[tb[node].son[3], Stmt];
                                Stmt[tb[node].son[4]]};
                            do => DoStmt[node];
                            return, resume => ExpList[tb[node].son[1]];
                            label => {StmtList[tb[node].son[1]]; StmtList[tb[node].son[2]]};
                            goto, exit, loop, reject, continue, retry, syserror, stop, null => NULL;
                            free => {
                                Exp[tb[node].son[1]];  Exp[tb[node].son[2]];
                                IF tb[node].nSons > 3 THEN CatchPhrase[tb[node].son[4]]};
                            signal, error, xerror, start, restart,
                            join, wait, notify, broadcast, dst, lst, lste, lstf =>
                                Exp[tb[node].son[1]];
                            open => {ExpList[tb[node].son[1]]; StmtList[tb[node].son[2]]};
                            enable => {CatchPhrase[tb[node].son[1]]; StmtList[tb[node].son[2]]};
                            checked => Stmt[tb[node].son[1]];
                            list => ScanList[stmt, Stmt];
                            item => Stmt[tb[node].son[2]];
                            ENDCASE => Log.Error[unimplemented]};
                    ENDCASE => NULL;
                dataPtr.textIndex _ saveIndex};

            StmtList: PROC[list: Tree.Link] = Stmt;

            Block: PROC[node: Tree.Index] = {
                saved: ContextInfo = current;
                bti: BTIndex = NewScope[node, tb[node].son[1]];
                tb[node].info _ FromBti[bti];
                StmtList[tb[node].son[2]];
                BodyList[bb[bti].firstSon];
                current _ saved;  btLink _ [which:sibling, index:bti]};

            SelectionList: PROC[t: Tree.Link, selection: Tree.Scan] = {

                Item: Tree.Scan = {
                    node: Tree.Index = GetNode[t];
                    saveIndex: SourceMap.Loc = dataPtr.textIndex;
                    dataPtr.textIndex _ ToLoc[tb[node].info];
                    IF OpName[tb[node].son[1]] # decl THEN {
                        ExpList[tb[node].son[1]]; selection[tb[node].son[2]]}
                    ELSE {
                        saved: ContextInfo = current;
                        bti: BTIndex = NewScope[node, tb[node].son[1]];
                        tb[node].name _ ditem;  tb[node].info _ FromBti[bti];  tb[node].attr3 _ FALSE;
                        selection[tb[node].son[2]];
                        current _ saved;  btLink _ [which:sibling, index:bti]};
                    dataPtr.textIndex _ saveIndex};

                ScanList[t, Item]};

            DoStmt: PROC[node: Tree.Index] = {
                OPEN tb[node];
                saved: ContextInfo = current;
                forTree: Tree.Link = tb[node].son[1];
                bti: BTIndex _ BTNull;
                IF forTree # Tree.Null THEN {
                    subTree: Tree.Link = NthSon[forTree, 1];
                    IF OpName[subTree] # decl THEN Exp[subTree]
                    ELSE bti _ NewScope[node, subTree];
                    PutInfo[forTree, FromBti[bti]];
                    SELECT OpName[forTree] FROM
                        forseq => {Exp[NthSon[forTree, 2]]; Exp[NthSon[forTree, 3]]};
                        upthru, downthru => Range[NthSon[forTree, 2]];
                        ENDCASE => ERROR};
                Exp[tb[node].son[2]];
                ExpList[tb[node].son[3]];
                StmtList[tb[node].son[4]]; StmtList[tb[node].son[5]]; StmtList[tb[node].son[6]];
                current _ saved;
                IF bti # BTNull THEN btLink _ [which:sibling, index:bti]};

            CatchPhrase: PROC[t: Tree.Link] = {
                node: Tree.Index = GetNode[t];
                saved: ContextInfo = current;
                NewContext[
                    level: NextLevel[saved.staticLevel],
                    entries: 0,
                    unique: FALSE];
                SelectionList[tb[node].son[1], Stmt];  Stmt[tb[node].son[2]];
                current _ saved};


        <<expressions>>

            Exp: PROC[exp: Tree.Link] = {
                IF exp = Tree.Null THEN RETURN;
                WITH exp SELECT GetTag[exp] FROM
                    subtree => {
                        node: Tree.Index = index;
                        SELECT tb[node].name FROM
                            apply => {
                                Exp[tb[node].son[1]];  ExpList[tb[node].son[2]];
                                IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
                            signalx, errorx, startx, fork, joinx,
                            dot, uparrow, uminus, not, addr, create, cast =>
                                Exp[tb[node].son[1]];
                            plus, minus, times, div, mod,
                            relE, relN, relL, relGE, relG, relLE, intOO, intOC, intCO, intCC,
                            or, and, assignx => {
                                Exp[tb[node].son[1]]; Exp[tb[node].son[2]]};
                            in, notin => {Exp[tb[node].son[1]]; Range[tb[node].son[2]]};
                            ifx => {Exp[tb[node].son[1]]; Exp[tb[node].son[2]]; Exp[tb[node].son[3]]};
                            casex => {
                                Exp[tb[node].son[1]]; SelectionList[tb[node].son[2], Exp]; Exp[tb[node].son[3]]};
                            bindx => {
                                Exp[tb[node].son[1]];  Exp[tb[node].son[2]];
                                SelectionList[tb[node].son[3], Exp];
                                Exp[tb[node].son[4]]};
                            extractx => {ExpList[tb[node].son[1]]; Exp[tb[node].son[2]]};
                            pred, succ, ord, lengthen, float, abs, min, max, base, length, all, val =>
                                ExpList[tb[node].son[1]];
                            arraydesc => {
                                SELECT ListLength[tb[node].son[1]] FROM
                                    1 => Exp[tb[node].son[1]];
                                    3 => {
                                        subNode: Tree.Index = GetNode[tb[node].son[1]];
                                        Exp[tb[subNode].son[1]];  Exp[tb[subNode].son[2]];
                                        OptTypeExp[tb[subNode].son[3]]};
                                    ENDCASE => ERROR};
                            void, clit, llit, atom, mwconst, syserrorx => NULL;
                            loophole => {Exp[tb[node].son[1]]; OptTypeExp[tb[node].son[2]]};
                            narrow, istype => {
                                Exp[tb[node].son[1]]; OptTypeExp[tb[node].son[2]];
                                IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
                            new => {
                                Exp[tb[node].son[1]];
                                TypeExp[tb[node].son[2]];
                                tb[node].son[3] _ InitialValue[tb[node].son[3], ISENull];
                                IF tb[node].nSons > 3 THEN CatchPhrase[tb[node].son[4]]};
                            cons, listcons => {
                                Exp[tb[node].son[1]];  ExpList[tb[node].son[2]];
                                IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
                            first, last, typecode => TypeExp[tb[node].son[1]];
                            size => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]};
                            nil => OptTypeExp[tb[node].son[1]];
                            item => Exp[tb[node].son[2]];
                            ENDCASE => Log.Error[unimplemented]};
                    ENDCASE => NULL
                };

            ExpList: PROC[list: Tree.Link] = INLINE {ScanList[list, Exp]};

            Position: PROC[t: Tree.Link] = {
                IF OpName[t] = item THEN {
                    node: Tree.Index = GetNode[t];
                    Exp[tb[node].son[1]];  Exp[tb[node].son[2]]}
                ELSE Exp[t]};

            Range: PROC[t: Tree.Link] = {
                WITH s: t SELECT GetTag[t] FROM
                    subtree => {
                        node: Tree.Index = s.index;
                        SELECT tb[node].name FROM
                            subrangeTC => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]};
                            IN [intOO .. intCC] => Exp[t];
                            ENDCASE => TypeExp[t]};
                    ENDCASE => TypeExp[t]
                };

        }.

