
    <<Pass3D.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 8, 1986 12:35:35 pm PST>>
        <<Donahue, 10-Dec-81 10:22:58>>
        <<Maxwell, August 1, 1983 3:42 pm>>

    DIRECTORY
        A3: TYPE USING [AssignableType, ComponentType, Default, DefaultInit, IndexType, OrderedType, TargetType, TypeForTree, Voidable, 
        VoidItem],
        Alloc: TYPE USING [Notifier],
        ComData: TYPE USING [idANY, idCARDINAL, idINT, interface, mainCtx, moduleCtx, seAnon, textIndex, typeStringBody],
        Log: TYPE USING [Error, ErrorHti, ErrorSei, ErrorTree],
        P3: TYPE USING [Attr, NPUse, SequenceNP, fullAttr, voidAttr, mark, pathNP, phraseNP, CheckDisjoint, ClearRefStack, CopyTree, 
        EnterComposite, Exp, FindSe, InterfaceCtx, MakeFrameRecord, PopCtx, PushCtx, RAttr, RecordLhs, RecordMention, Rhs, RPop, 
        RPush, RType, SafetyAttr, SealRefStack, SearchCtxList, SelectVariantType, TopCtx, UnsealRefStack, VariantUnionType, 
        VoidExp],
        PrincOpsUtils: TYPE USING [BITOR],
        SourceMap: TYPE USING [Loc],
        Symbols: TYPE USING [Base, SERecord, Name, Type, ISEIndex, CSEIndex, RecordSEIndex, RefSEIndex, CTXIndex, CBTIndex, nullType, 
        ISENull, CSENull, CTXNull, codeANY, codeINT, lG, lZ, typeANY, typeTYPE, seType, ctxType, mdType, bodyType],
        SymbolOps: TYPE USING [ArgCtx, CopyXferType, CtxLevel, EnterExtension, EqTypes, LinkMode, MakeNonCtxSe, NormalType, RCType, 
        ReferentType, TypeForm, TypeLink, UnderType, XferMode],
        Tree: TYPE USING [Base, Index, Link, Map, Null, NullIndex, Scan, treeType],
        TreeOps: TYPE USING [FreeTree, GetHash, GetNode, GetSe, IdentityMap, ListHead, ListLength, NthSon, OpName, ScanList, UpdateList];

    Pass3D: PROGRAM
        IMPORTS A3, Log, P3, PrincOpsUtils, SymbolOps, TreeOps, dataPtr: ComData
        EXPORTS P3 = {
        OPEN TreeOps, SymbolOps, Symbols, A3, P3;

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

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


    <<signals for type loop detection>>

        CheckTypeLoop: SIGNAL[loopNode: Tree.Index] RETURNS[BOOL] = CODE;
        LogTypeLoop: SIGNAL[loopNode: Tree.Index] = CODE;


    <<declaration processing>>

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

        FirstId: PUBLIC PROC[node: Tree.Index] RETURNS[ISEIndex] = {
            RETURN[ItemId[ListHead[tb[node].son[1]]]]};


        DeclList: PUBLIC Tree.Scan = {ScanList[t, DeclA]; ScanList[t, DeclBInit]};

        DeclA: Tree.Scan = {
            node: Tree.Index = GetNode[t];
            type: Type;
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            IF tb[node].attr3 = P3.mark THEN RETURN;    -- already processed
            tb[node].attr3 _ P3.mark;
            dataPtr.textIndex _ tb[node].info;
            tb[node].son[2] _ TypeLink[tb[node].son[2]
                ! CheckTypeLoop => {IF loopNode = node THEN RESUME [TRUE]};
                    LogTypeLoop => {IF loopNode = node THEN RESUME}];
            type _ TypeForTree[tb[node].son[2]];
            SELECT tb[node].name FROM
                typedecl => DefineTypeSe[tb[node].son[1], type];
                decl => DefineSeType[tb[node].son[1], type, tb[node].attr1];
                ENDCASE => ERROR;
            ClearRefStack[];
            dataPtr.textIndex _ saveIndex};

        DeclBField: Tree.Scan = {DeclBDefault[t, FALSE]};

        DeclBVarField: Tree.Scan = {DeclBDefault[t, TRUE]};

        DeclBDefault: PROC[t: Tree.Link, varOK: BOOL_FALSE] = {
            node: Tree.Index = GetNode[t];
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            IF tb[node].attr2 = P3.mark THEN RETURN;    -- already processed
            tb[node].attr2 _ P3.mark;
            dataPtr.textIndex _ tb[node].info;
            TypeAttr[typeExp: tb[node].son[2], varOK: varOK];
            SELECT tb[node].name FROM
                typedecl => NULL;
                decl => {
                    type: Type = TypeForTree[tb[node].son[2]];
                    IF ~ComponentType[type] THEN Log.ErrorTree[typeLength, tb[node].son[2]];
                    IF tb[node].son[3] # Tree.Null THEN {
                        ScanList[tb[node].son[1], RecordDeclInit];
                        tb[node].son[3] _ DefaultExp[t:tb[node].son[3], type:type, ids:tb[node].son[1]]};
                    DefineSeValue[tb[node].son[1], FALSE]};
                ENDCASE => ERROR;
            ClearRefStack[];
            dataPtr.textIndex _ saveIndex};

        DeclBInit: Tree.Scan = {
            node: Tree.Index = GetNode[t];
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            IF tb[node].attr2 = P3.mark THEN RETURN;    -- already processed
            tb[node].attr2 _ P3.mark;
            dataPtr.textIndex _ tb[node].info;
            [] _ CheckPositions[tb[node].son[1], FieldAttrs[]];
            SELECT tb[node].name FROM
                typedecl => {
                    TypeAttr[tb[node].son[2]];
                    IF tb[node].son[3] # Tree.Null THEN {
                        tb[node].son[3] _ DefaultExp[
                            t:tb[node].son[3], type:TypeForTree[tb[node].son[2]], ids:tb[node].son[1]];
                        [] _ ProcessDefault[node]}
                    };
                decl => {
                    type: Type;
                    constFlag, extFlag: BOOL;
                    ctx: CTXIndex = TopCtx[];
                    TypeAttr[typeExp: tb[node].son[2], varOK: InterfaceContext[ctx]];
                    type _ TypeForTree[tb[node].son[2]];
                    IF ~ComponentType[type] THEN Log.ErrorTree[typeLength, tb[node].son[2]];
                    IF tb[node].son[3] = Tree.Null THEN {
                        IF ~InterfaceContext[ctx] AND ~tb[node].attr1 THEN {
                            tb[node].son[3] _  DefaultInit[type];
                            pathNP _ SequenceNP[pathNP][phraseNP]; RPop[]};
                        constFlag _ FALSE}
                    ELSE {
                        [tb[node].son[3], extFlag] _ InitialExp[tb[node].son[3], type];
                        IF extFlag AND ~tb[node].attr1 THEN Log.ErrorTree[misusedInline, tb[node].son[3]];
                        pathNP _ SequenceNP[pathNP][phraseNP];
                        constFlag _ tb[node].attr1 AND RAttr[].const;  RPop[];
                        IF tb[node].son[3] # Tree.Null THEN ScanList[tb[node].son[1], RecordDeclInit]};
                    SELECT TRUE FROM
                        (tb[node].son[3] = Tree.Null) =>
                            IF ~InterfaceContext[ctx] AND ~Voidable[type] THEN
                                Log.ErrorSei[missingInit, FirstId[node]];
                        GlobalContext[ctx] =>
                            SELECT RCType[type] FROM
                                composite => EnterComposite[UnderType[type], tb[node].son[3], TRUE];
                                ENDCASE => NULL;
                        ENDCASE => NULL;
                    DefineSeValue[tb[node].son[1], constFlag]};
                ENDCASE => ERROR;
            ClearRefStack[];
            dataPtr.textIndex _ saveIndex};


        RecordDeclInit: Tree.Scan = {
            sei: ISEIndex = ItemId[t]; RecordMention[sei]; RecordLhs[sei]};


        DefaultExp: PROC[t: Tree.Link, type: Type, ids: Tree.Link] RETURNS[v: Tree.Link] = {
            subType: Type = TargetType[type];

            ExpInit: PROC[t: Tree.Link] RETURNS[val: Tree.Link] = {
                val _ Rhs[t, subType];  RPop[];  RETURN};

            v _ UpdateList[t, ExpInit];
            IF VoidItem[v] AND ~Voidable[type] THEN Log.ErrorSei[defaultForm, ItemId[ids]];
            RETURN};

        InitialExp: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[v: Tree.Link, extended: BOOL] = {
            v _ t;  extended _ FALSE;  phraseNP _ none;
            SELECT OpName[t] FROM
                body => {
                    <<defer processing of bodies (see Body)>>
                    subType: CSEIndex = UnderType[type];
                    expNode: Tree.Index = GetNode[t];
                    bti: CBTIndex = tb[expNode].info;
                    attr: Attr _ voidAttr;
                    SELECT XferMode[type] FROM
                        proc, program => NULL;
                        ENDCASE =>
                            IF TypeForm[type] = $definition THEN attr _ fullAttr ELSE Log.Error[bodyType];
                    bb[bti].ioType _ SELECT seb[type].seTag FROM
                        cons => subType,
                        ENDCASE => CopyXferType[subType, IdentityMap];
                    RPush[type, attr];  extended _ tb[expNode].attr3;  -- inline
                    CheckBodyType[subType, expNode]};
                inline => {
                    expNode: Tree.Index = GetNode[t];

                    CodeBody: Tree.Map = {RETURN[UpdateList[t, NumericConst]]};

                    IF XferMode[type] # proc THEN Log.Error[inlineType];
                    IF tb[expNode].attr1 THEN Log.Error[inlineChecked];
                    tb[expNode].son[1] _ UpdateList[tb[expNode].son[1], CodeBody];
                    RPush[type, fullAttr];  extended _ TRUE;
                    CheckBodyType[UnderType[type], expNode]};
                apply => {
                    expNode: Tree.Index = GetNode[t];
                    IF tb[expNode].son[1] = Tree.Null
                        AND EqTypes[ReferentType[type], dataPtr.typeStringBody]
                        AND ListLength[tb[expNode].son[2]] = 1 THEN
                            tb[expNode].name _ stringinit;
                    v _ Rhs[t, TargetType[type]]};
                signalinit => RPush[type, voidAttr];
                void => {v _ FreeTree[t];  RPush[type, voidAttr]};
                ENDCASE => v _ Rhs[t, TargetType[type]];
            RETURN};


        RecordField: PROC[ctx: CTXIndex] RETURNS[BOOL] = INLINE {
            RETURN[ctx = CTXNull OR (CtxLevel[ctx] = lZ AND ctx # dataPtr.moduleCtx)]};

        GlobalContext: PROC[ctx: CTXIndex] RETURNS[BOOL] = INLINE {
            RETURN[~dataPtr.interface AND CtxLevel[ctx] = lG]};

        InterfaceContext: PROC[ctx: CTXIndex] RETURNS[BOOL] = INLINE {
            RETURN[dataPtr.interface AND ctx = dataPtr.mainCtx]};

        InterfaceSe: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
            RETURN[InterfaceContext[seb[sei].idCtx]]};


        CheckBodyType: PROC[type: CSEIndex, node: Tree.Index] = {
            WITH t: seb[type] SELECT FROM
                transfer => {
                    IF TypeForm[t.typeIn] = $any OR TypeForm[t.typeOut] = $any THEN
                        Log.Error[bodyType];
                    IF t.safe AND SafetyAttr[node] = none THEN Log.Error[unsafeBlock]};
                ENDCASE
            };


        DefineTypeSe: PROC[t: Tree.Link, info: Type] = {
            first: BOOL _ TRUE;

            UpdateSe: Tree.Scan = {
                sei: ISEIndex = ItemId[t];
                seb[sei].idType _ typeTYPE;  seb[sei].idInfo _ info;
                seb[sei].immutable _ seb[sei].constant _ TRUE;
                IF first THEN {info _ sei; first _ FALSE};
                seb[sei].mark3 _ TRUE};

            ScanList[t, UpdateSe]};

        DefineSeType: PROC[t: Tree.Link, type: Type, fixed: BOOL] = {

            UpdateSe: Tree.Scan = {
                sei: ISEIndex = ItemId[t];
                seb[sei].idType _ type;  seb[sei].constant _ FALSE;
                IF InterfaceSe[sei] THEN seb[sei].immutable _ seb[sei].immutable OR fixed
                ELSE seb[sei].immutable _ fixed;
                seb[sei].mark3 _ TRUE};

            ScanList[t, UpdateSe]};

        DefineSeValue: PROC[t: Tree.Link, const: BOOL] = {

            UpdateSe: Tree.Scan = {
                sei: ISEIndex = ItemId[t];
                seb[sei].constant _ const;
                IF InterfaceSe[sei] AND LinkMode[sei] = val THEN seb[sei].immutable _ TRUE};

            ScanList[t, UpdateSe]};


        ProcessDefault: PROC[node: Tree.Index] RETURNS[nonVoid: BOOL] = {
            copy: BOOL;
            v: Tree.Link = tb[node].son[3];

            DefineDefault: Tree.Scan = {
                EnterExtension[ItemId[t], default, IF copy THEN CopyTree[v] ELSE v];
                copy _ TRUE};

            SELECT OpName[v] FROM
                stringinit => Log.ErrorSei[defaultForm, FirstId[node]];
                lengthen =>
                    IF OpName[NthSon[v, 1]] = stringinit THEN
                        Log.ErrorSei[defaultForm, FirstId[node]];
                void => nonVoid _ FALSE;
                ENDCASE => nonVoid _ TRUE;
            copy _ FALSE;  ScanList[tb[node].son[1], DefineDefault];
            tb[node].son[3] _ Tree.Null};


    <<forward reference resolution>>

        ResolveType: PUBLIC PROC[sei: ISEIndex] = {
            currentCtx: CTXIndex = TopCtx[];
            IF seb[sei].idCtx # currentCtx THEN {PopCtx[]; ResolveType[sei]; PushCtx[currentCtx]}
            ELSE {SealRefStack[]; DeclA[[subtree[index: seb[sei].idValue]]]; UnsealRefStack[]}};

        ResolveValue: PUBLIC PROC[sei: ISEIndex] = {
            currentCtx: CTXIndex = TopCtx[];
            IF seb[sei].idCtx # currentCtx THEN {PopCtx[]; ResolveValue[sei]; PushCtx[currentCtx]}
            ELSE {
                SealRefStack[];
                IF RecordField[currentCtx] THEN DeclBDefault[[subtree[index: seb[sei].idValue]]]
                ELSE  DeclBInit[[subtree[index: seb[sei].idValue]]];
                UnsealRefStack[]}
            };


    <<type expressions>>

        CheckTypeId: PROC[sei: ISEIndex] RETURNS[BOOL] = {
            SELECT TRUE FROM
                (sei = ISENull) => RETURN[FALSE];
                seb[sei].mark3 => RETURN[seb[sei].idType = typeTYPE];
                ENDCASE => {
                    node: Tree.Index = seb[sei].idValue;
                    RETURN[node = Tree.NullIndex OR tb[node].name = typedecl]}
            };

        TypeSymbol: PROC[sei: ISEIndex] RETURNS[val: Tree.Link] = {
            entryIndex: SourceMap.Loc = dataPtr.textIndex;
            circular: BOOL _ FALSE;
            IF ~seb[sei].mark3 THEN {
                ENABLE
                    LogTypeLoop => {
                        saveIndex: SourceMap.Loc = dataPtr.textIndex;
                        dataPtr.textIndex _ entryIndex;
                        Log.ErrorSei[circularType, sei];  circular _ TRUE;
                        dataPtr.textIndex _ saveIndex};
                declNode: Tree.Index = seb[sei].idValue;
                IF tb[declNode].attr3 # P3.mark THEN ResolveType[sei]
                ELSE IF SIGNAL CheckTypeLoop[declNode] THEN SIGNAL LogTypeLoop[declNode]};
            IF CheckTypeId[sei] AND ~circular THEN val _ [symbol[index: sei]]
            ELSE {
                IF ~circular AND sei # dataPtr.seAnon THEN Log.ErrorSei[nonTypeId, sei];
                val _ [symbol[index: dataPtr.idANY]]};
            RETURN};


        PushArgCtx: PROC[sei: CSEIndex] = {
            ctx: CTXIndex = ArgCtx[sei];
            IF ctx # CTXNull THEN PushCtx[ctx]};

        PopArgCtx: PROC[sei: CSEIndex] = {
            IF ArgCtx[sei] # CTXNull THEN PopCtx[]};


        TypeExp: PUBLIC PROC[typeExp: Tree.Link] RETURNS[val: Tree.Link] = {
            val _ TypeLink[typeExp]; TypeAttr[val]; RETURN};

        TypeAppl: PUBLIC PROC[typeExp: Tree.Link] RETURNS[val: Tree.Link] = {
            attr: Attr;
            IF OpName[typeExp] = apply THEN {
                node: Tree.Index = GetNode[typeExp];
                rType: Type;
                tb[node].son[1] _ TypeExp[tb[node].son[1]];
                tb[node].info _ rType _ TypeForTree[tb[node].son[1]];
                SELECT TRUE FROM
                    (UnderType[rType] = dataPtr.typeStringBody),
                    (TypeForm[VariantUnionType[rType]] = $sequence) => {
                        tb[node].son[2] _ Rhs[tb[node].son[2], dataPtr.idINT]; attr _ RAttr[]; RPop[]};
                    (TypeForm[VariantUnionType[rType]] = $union) => {
                        TypeDiscrim[rType, node];  phraseNP _ none; attr _ fullAttr};
                    ENDCASE => {
                        Log.ErrorTree[noApplication, tb[node].son[1]];
                        tb[node].son[2] _ Exp[tb[node].son[2], typeANY]; attr _ RAttr[]; RPop[]};
                val _ typeExp}
            ELSE {val _ TypeExp[typeExp]; phraseNP _ none; attr _ fullAttr};
            RPush[typeTYPE, attr]};


        ClusterExp: PROC[t: Tree.Link] RETURNS[val: Tree.Link] = {
            WITH t SELECT FROM
                hash => {
                    sei: ISEIndex = FindSe[index].symbol;
                    IF ~CheckTypeId[sei] THEN        -- prevent duplicate error messages
                        val _ Exp[IF sei = dataPtr.seAnon THEN [symbol[sei]] ELSE t, typeANY]
                    ELSE {val _ TypeSymbol[sei]; RPush[typeTYPE, fullAttr]}};
                symbol => {
                    sei: ISEIndex = index;
                    IF ~CheckTypeId[sei] THEN val _ Exp[t, typeANY]
                    ELSE {val _ TypeSymbol[sei]; RPush[typeTYPE, fullAttr]}};
                ENDCASE => {val _ TypeLink[t]; RPush[typeTYPE, fullAttr]};
            RETURN};

        TypeDot: PROC[rType: Type, node: Tree.Index] = TypeDiscrim;
            <<for now, should do other possible cluster items>>

        TypeDiscrim: PROC[rType: Type, node: Tree.Index] = {
            t2: Tree.Link = tb[node].son[2];
            WITH h: t2 SELECT FROM
                hash => {
                    iSei: ISEIndex = SelectVariantType[rType, h.index];
                    IF iSei # ISENull THEN {
                        tb[node].info _ iSei;  tb[node].son[2] _ [symbol[index: iSei]];
                        tb[node].name _ discrimTC}
                    ELSE {
                        IF rType # typeANY THEN Log.ErrorTree[unknownVariant, t2];
                        tb[node].info _ dataPtr.idANY}};
                ENDCASE => {
                    Log.ErrorTree[unknownVariant, t2]; tb[node].son[2] _ VoidExp[t2]}
            };


        FindLinkType: SIGNAL RETURNS[CSEIndex] = CODE;    -- to find list link type

        TypeLink: PROC[typeExp: Tree.Link] RETURNS[val: Tree.Link] = {
            WITH typeExp SELECT FROM
                hash => {
                    sei: ISEIndex = FindSe[index].symbol;
                    IF sei # ISENull THEN val _ TypeSymbol[sei]
                    ELSE {Log.ErrorHti[nonTypeId, index]; val _ [symbol[dataPtr.idANY]]}};
                symbol => val _ TypeSymbol[index];
                subtree => {
                    node: Tree.Index = index;
                    iSei: ISEIndex;
                    SELECT tb[node].name FROM
                        discrimTC => {
                            tb[node].son[1] _ TypeLink[tb[node].son[1]];
                            TypeDiscrim[TypeForTree[tb[node].son[1]], node]};
                        apply => {
                            rType: Type;
                            tb[node].son[1] _ TypeLink[tb[node].son[1]];
                            tb[node].info _ rType _ TypeForTree[tb[node].son[1]];
                            SELECT TypeForm[VariantUnionType[rType]] FROM
                                $union => TypeDiscrim[rType, node];
                                $sequence => Log.ErrorTree[unimplemented, typeExp];
                                ENDCASE => Log.ErrorTree[noApplication, tb[node].son[1]]
                            };
                        dot => {
                            id: Name = GetHash[tb[node].son[2]];
                            nDerefs: CARDINAL _ 0;
                            found: BOOL;
                            next: Type;
                            ctx: CTXIndex _ CTXNull;
                            tb[node].son[1] _ ClusterExp[tb[node].son[1]];
                            FOR type: Type _ RType[], next DO
                                sei: CSEIndex = UnderType[type];
                                WITH t: seb[sei] SELECT FROM
                                    mode => GOTO type;
                                    definition, transfer => {
                                        ctx _ InterfaceCtx[sei, tb[node].son[1]]; GO TO cluster};
                                    record => {ctx _ t.fieldCtx; GO TO cluster};
                                    ref => {IF (nDerefs _ nDerefs+1) > 63 THEN GO TO cluster; next _ t.refType};
                                    long => next _ t.rangeType;
                                    subrange => next _ t.rangeType;
                                    ENDCASE => GO TO cluster;
                                REPEAT
                                    type => TypeDot[TypeForTree[tb[node].son[1]], node];
                                    cluster => {
                                        [found, iSei] _ SearchCtxList[id, ctx];
                                        IF ~found THEN {iSei _ dataPtr.idANY; Log.ErrorHti[unknownField, id]};
                                        tb[node].name _ cdot;
                                        tb[node].info _ iSei;  tb[node].son[2] _ TypeSymbol[iSei]};
                                ENDLOOP;
                            RPop[]};
                        paintTC => {
                            tb[node].son[1] _ TypeLink[tb[node].son[1]];
                            tb[node].son[2] _ TypeLink[tb[node].son[2]];
                            tb[node].info _ TypeForTree[tb[node].son[2]]};
                        linkTC => tb[node].info _ SIGNAL FindLinkType[];
                        implicitTC => NULL;
                        frameTC => {
                            tb[node].son[1] _ Exp[tb[node].son[1], typeANY];  RPop[];
                            tb[node].info _ MakeFrameRecord[tb[node].son[1]]};
                        ENDCASE => {
                            OPEN tb[node];
                            type: CSEIndex = info;
                            WITH t: seb[type] SELECT FROM
                                enumerated => NULL;
                                record => {PushCtx[t.fieldCtx]; ScanList[son[1], DeclA]; PopCtx[]};
                                ref => {
                                    son[1] _ TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}];
                                    t.refType _ TypeForTree[son[1]]};
                                array => {
                                    IF son[1] = Tree.Null THEN t.indexType _ dataPtr.idCARDINAL
                                    ELSE {son[1] _ TypeLink[son[1]]; t.indexType _ TypeForTree[son[1]]};
                                    son[2] _ TypeLink[son[2]];  t.componentType _ TypeForTree[son[2]]};
                                arraydesc => {
                                    son[1] _ TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}];
                                    t.describedType _ TypeForTree[son[1]]};
                                transfer => {
                                    ENABLE  CheckTypeLoop => {RESUME [FALSE]};
                                    CheckDisjoint[ArgCtx[t.typeIn], ArgCtx[t.typeOut]];
                                    PushArgCtx[t.typeIn];
                                    IF OpName[son[1]] # anyTC THEN ScanList[son[1], DeclA];
                                    PushArgCtx[t.typeOut];
                                    IF OpName[son[2]] # anyTC THEN ScanList[son[2], DeclA];
                                    PopArgCtx[t.typeOut];  PopArgCtx[t.typeIn]};
                                definition => t.defCtx _ dataPtr.mainCtx;
                                union => {DeclA[son[1]]; ScanList[son[2], DeclA]};
                                sequence => {
                                    DeclA[son[1]];
                                    son[2] _ TypeLink[son[2]];  t.componentType _ TypeForTree[son[2]]};
                                relative => {
                                    son[1] _ TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}];
                                    t.baseType _ TypeForTree[son[1]];
                                    son[2] _ TypeLink[son[2]];
                                    t.resultType _ t.offsetType _ TypeForTree[son[2]]};
                                opaque =>
                                    IF t.id = ISENull OR ~InterfaceSe[t.id] THEN Log.Error[misplacedType];
                                zone => NULL;
                                subrange => {
                                    t.range _ LOOPHOLE[node];    -- to allow symbolic evaluation
                                    son[1] _ TypeLink[son[1]]; t.rangeType _ TypeForTree[son[1]]};
                                long => {
                                    son[1] _ TypeLink[son[1] ! FindLinkType => {RESUME [type]}];
                                    t.rangeType _ TypeForTree[son[1]]};
                                any => NULL;
                                ENDCASE => ERROR;
                            seb[type].mark3 _ TRUE};
                    val _ typeExp};
                ENDCASE => ERROR;
            RETURN};


        TypeAttr: PROC[typeExp: Tree.Link, indirect, varOK: BOOL _ FALSE] = {
            WITH typeExp SELECT FROM
                symbol =>
                    IF ~indirect THEN {
                        sei: ISEIndex = index;
                        IF seb[sei].mark3 AND ~seb[sei].mark4 THEN {
                            declNode: Tree.Index = seb[sei].idValue;
                            IF tb[declNode].attr2 # P3.mark THEN ResolveValue[sei]}
                        };
                subtree => {
                    node: Tree.Index = index;
                    SELECT tb[node].name FROM
                        discrimTC => TypeAttr[tb[node].son[1], indirect];
                        cdot => TypeAttr[tb[node].son[2], indirect];
                        paintTC => {
                            TypeAttr[tb[node].son[1]]; TypeAttr[tb[node].son[2], indirect];
                            Log.Error[unimplemented]};
                        implicitTC, linkTC => NULL;
                        frameTC => NULL;
                        apply => tb[node].son[2] _ VoidExp[tb[node].son[2]];
                        dot => NULL;
                        ENDCASE => {
                            OPEN tb[node];
                            type: CSEIndex = info;
                            WITH t: seb[type] SELECT FROM
                                enumerated =>
                                    IF AssignedEnumeration[son[1]] AND ~t.machineDep THEN Log.Error[machDep];
                                record => {
                                    saveNP: NPUse = pathNP;
                                    PushCtx[t.fieldCtx];  pathNP _ none;
                                    ScanList[son[1], DeclBField];
                                    WITH s: t SELECT FROM
                                        linked => CheckDisjointPrefix[t.fieldCtx, s.linkType];
                                        notLinked => {
                                            attrs: FieldAttrs = CollectAttrs[
                                                son[1], FieldAttrs[positionValid: t.machineDep]];
                                            UpdateHints[LOOPHOLE[type], attrs];
                                            attr1 _ AssignedPositions[attrs]};
                                        ENDCASE => ERROR;
                                    PopCtx[];  pathNP _ saveNP};
                                ref => {
                                    IF t.var AND ~varOK THEN Log.Error[var];
                                    TypeAttr[son[1], TRUE]};
                                array => {
                                    IF son[1] # Tree.Null THEN TypeAttr[son[1]];
                                    IF ~IndexType[t.indexType] THEN {
                                        t.indexType _ typeANY; Log.Error[nonOrderedType]}
                                    ELSE IF TypeForm[t.indexType] = $long THEN Log.Error[indexType];
                                    TypeAttr[son[2], indirect];
                                    IF ~ComponentType[t.componentType] THEN
                                        Log.ErrorTree[typeLength, son[2]]
                                    };
                                arraydesc => {
                                    TypeAttr[son[1], TRUE];
                                    IF TypeForm[t.describedType] # $array THEN Log.Error[descriptor]};
                                transfer => {
                                    saveNP: NPUse = pathNP;
                                    IF t.mode = error THEN t.safe _ FALSE;
                                    PushArgCtx[t.typeIn];
                                    ArgAttr[t.typeIn, son[1], t.mode = proc OR t.mode = signal];
                                    PushArgCtx[t.typeOut];
                                    ArgAttr[t.typeOut, son[2], FALSE];
                                    PopArgCtx[t.typeOut];  PopArgCtx[t.typeIn];
                                    pathNP _ saveNP};
                                definition => NULL;
                                union => {
                                    tagType: CSEIndex;
                                    DeclBDefault[son[1]];
                                    seb[t.tagSei].immutable _ TRUE;
                                    tagType _ UnderType[TargetType[seb[t.tagSei].idType]];
                                    IF seb[tagType].typeTag # enumerated THEN {
                                        Log.ErrorSei[nonTagType, t.tagSei]; tagType _ typeANY};
                                    VariantList[son[2], tagType]};
                                sequence => {
                                    DeclBDefault[son[1]];
                                    seb[t.tagSei].immutable _ TRUE;
                                    IF ~IndexType[seb[t.tagSei].idType] THEN Log.ErrorSei[nonTagType, t.tagSei]
                                    ELSE IF TypeForm[seb[t.tagSei].idType] = $long THEN Log.Error[indexType];
                                    TypeAttr[son[2], indirect];
                                    IF ~ComponentType[t.componentType] THEN
                                        Log.ErrorTree[typeLength, son[2]]
                                    };
                                relative => {
                                    subType, vType: CSEIndex;
                                    TypeAttr[son[1], TRUE];
                                    IF TypeForm[NormalType[t.baseType]] # $ref THEN Log.Error[relative];
                                    TypeAttr[son[2]];
                                    vType _ UnderType[t.offsetType];  subType _ NormalType[vType];
                                    SELECT TypeForm[subType] FROM
                                        $ref, $arraydesc => NULL;
                                        ENDCASE => {Log.Error[relative]; subType _ typeANY};
                                    IF TypeForm[t.baseType] = $long OR TypeForm[vType] = $long THEN
                                        t.resultType _ MakeLongType[subType, vType]
                                    ELSE t.resultType _ subType};
                                zone => NULL;
                                opaque =>
                                    IF son[1] # Tree.Null THEN {
                                        son[1] _ Rhs[son[1], dataPtr.idINT];
                                        IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, son[1]];
                                        RPop[]
                                    };
                                subrange => {
                                    target: Type;
                                    subNode: Tree.Index = GetNode[son[2]];
                                    TypeAttr[son[1], indirect];  target _ t.rangeType;
                                    SELECT TRUE FROM
                                        (TypeForm[target] = $ref) => target _ dataPtr.idINT;
                                        OrderedType[target] => {
                                            subType: CSEIndex = UnderType[target];
                                            WITH s: seb[subType] SELECT FROM
                                                long => target _ t.rangeType _ s.rangeType;
                                                real => Log.Error[subrangeNesting];
                                                ENDCASE;
                                            target _ TargetType[target]};
                                        ENDCASE => {Log.Error[nonOrderedType]; target _ typeANY};
                                    tb[subNode].son[1] _ EndPoint[tb[subNode].son[1], target];
                                    tb[subNode].son[2] _ EndPoint[tb[subNode].son[2], target]};
                                long => {
                                    subType: CSEIndex;
                                    TypeAttr[son[1], indirect, varOK];
                                    subType _ UnderType[t.rangeType];
                                    WITH s: seb[subType] SELECT FROM
                                        basic =>
                                            SELECT s.code FROM
                                                codeINT, codeANY => NULL;
                                                ENDCASE => Log.Error[long];
                                        ref, arraydesc => NULL;
                                        subrange => IF t.rangeType # dataPtr.idCARDINAL THEN Log.Error[long];
                                        ENDCASE => Log.Error[long]};
                                any => NULL;
                                ENDCASE => ERROR}
                            };
                ENDCASE => ERROR};

                EndPoint: PROC[t: Tree.Link, target: Type] RETURNS[v: Tree.Link] = {
                    v _ Rhs[t, target];
                    IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, v];
                    RPop[]};


    <<record attribute collection>>

        FieldAttrs: TYPE = RECORD[
            positionValid: BOOL_FALSE,
            noAssign: BOOL_FALSE,
            refField, unVoidable, default: BOOL_FALSE,
            positions: PACKED ARRAY {implicit, explicit} OF BOOL_[FALSE, FALSE]];

        MergeAttrs: PROC[attr1, attr2: FieldAttrs] RETURNS[FieldAttrs] =
            LOOPHOLE[PrincOpsUtils.BITOR];

        UpdateHints: PROC[rSei: RecordSEIndex, attrs: FieldAttrs] = {
            seb[rSei].hints.assignable _ ~attrs.noAssign;
            seb[rSei].hints.refField _ attrs.refField;
            seb[rSei].hints.voidable _ ~attrs.unVoidable;
            seb[rSei].hints.default _ attrs.default};

        AssignedPositions: PROC[attrs: FieldAttrs] RETURNS[assigned: BOOL] = {
            IF attrs.positionValid THEN {
                IF attrs.positions = [TRUE, TRUE] THEN Log.Error[mixedPositions];
                assigned _ attrs.positions[explicit]}
            ELSE assigned _ FALSE;
            RETURN};

        CollectAttrs: PROC[t: Tree.Link, attrs: FieldAttrs] RETURNS[FieldAttrs] = {

            ProcessField: Tree.Scan = {
                node: Tree.Index = GetNode[t];
                type: Type = TypeForTree[tb[node].son[2]];
                subType: CSEIndex = UnderType[type];
                attrs _ CheckPositions[tb[node].son[1], attrs];
                IF (IF tb[node].son[3] = Tree.Null
                    THEN Default[type] = nonVoid
                    ELSE ProcessDefault[node]) THEN attrs.default _ TRUE;
                WITH t: seb[subType] SELECT FROM
                    union => {
                        subNode: Tree.Index = GetNode[tb[node].son[2]];
                        IF t.controlled THEN ProcessField[tb[subNode].son[1]];
                        attrs _ MergeVariantAttrs[tb[subNode].son[2], attrs];
                        t.hints.refField _ attrs.refField; t.hints.voidable _ ~attrs.unVoidable;
                        t.hints.default _ attrs.default;
                        tb[subNode].attr1 _ attrs.positions[explicit]};
                    sequence => {
                        subNode: Tree.Index = GetNode[tb[node].son[2]];
                        IF t.controlled THEN ProcessField[tb[subNode].son[1]];
                        IF RCType[t.componentType] # none THEN {
                            IF ~t.controlled THEN Log.Error[attrClash];
                            attrs.refField _ --attrs.unVoidable _-- TRUE};
                        attrs.noAssign _ TRUE;
                        tb[subNode].attr1 _ attrs.positions[explicit]};
                    ENDCASE => {
                        IF ~attrs.refField AND RCType[subType] # none THEN
                            attrs.refField _ attrs.unVoidable _ TRUE;
                        IF ~attrs.unVoidable AND ~Voidable[type] THEN attrs.unVoidable _ TRUE;
                        IF ~AssignableType[subType, FALSE] THEN attrs.noAssign _ TRUE}
                };

            ScanList[t, ProcessField];
            RETURN[attrs]};

        ArgAttr: PROC[rSei: CSEIndex, t: Tree.Link, varOK: BOOL] = {
            IF rSei # CSENull THEN
                WITH seb[rSei] SELECT FROM
                    record => {
                        ScanList[t, IF varOK THEN DeclBVarField ELSE DeclBField];
                        UpdateHints[LOOPHOLE[rSei], CollectAttrs[t, FieldAttrs[]]]};
                    ENDCASE
            };


    <<machine dependent layout>>

        NumericConst: Tree.Map = {v _ Rhs[t, dataPtr.idINT];  RPop[];  RETURN};

        AssignedEnumeration: PROC[t: Tree.Link] RETURNS[assigned: BOOL] = {

            AssignElement: Tree.Scan = {
                WITH t SELECT FROM
                    subtree => {
                        node: Tree.Index = index;
                        tb[node].son[2] _ NumericConst[tb[node].son[2]];  assigned _ TRUE};
                    ENDCASE => NULL;
                RETURN};

            assigned _ FALSE;  ScanList[t, AssignElement];  RETURN};

        CheckPositions: PROC[t: Tree.Link, attrs: FieldAttrs] RETURNS[FieldAttrs] = {

            CheckPosition: Tree.Scan = {
                WITH t SELECT FROM
                    subtree => {
                        node: Tree.Index = GetNode[tb[index].son[2]];
                        IF ~attrs.positionValid THEN Log.ErrorSei[position, ItemId[tb[index].son[1]]];
                        tb[node].son[1] _ NumericConst[tb[node].son[1]];
                        IF tb[node].son[2] # Tree.Null THEN {
                            subNode: Tree.Index = GetNode[tb[node].son[2]];
                            tb[subNode].son[1] _ NumericConst[tb[subNode].son[1]];
                            tb[subNode].son[2] _ NumericConst[tb[subNode].son[2]]};
                        attrs.positions[explicit] _ TRUE};
                    ENDCASE => attrs.positions[implicit] _ TRUE
                };

            ScanList[t, CheckPosition]; RETURN[attrs]};


    <<variants>>

        CheckDisjointPrefix: PROC[ctx: CTXIndex, link: Type] = {
            FOR sei: Type _ link, SymbolOps.TypeLink[sei] UNTIL sei = nullType DO
                type: CSEIndex = UnderType[sei];
                WITH t: seb[type] SELECT FROM
                    record => CheckDisjoint[ctx, t.fieldCtx];
                    ENDCASE;
                ENDLOOP
            };


        VariantList: PROC[t: Tree.Link, tagType: CSEIndex] = {

            DefineTag: Tree.Scan = {
                sei: ISEIndex = GetSe[t];
                seb[sei].idValue _ TagValue[seb[sei].hash, tagType]};

            VariantItem: Tree.Scan = {
                node: Tree.Index = GetNode[t];
                saveIndex: SourceMap.Loc = dataPtr.textIndex;
                dataPtr.textIndex _ tb[node].info;
                ScanList[tb[node].son[1], DefineTag];
                DeclBDefault[t];
                dataPtr.textIndex _ saveIndex};

            ScanList[t, VariantItem]};

        TagValue: PROC[tag: Name, tagType: CSEIndex] RETURNS[CARDINAL] = {
            matched: BOOL;
            sei: ISEIndex;
            WITH t: seb[tagType] SELECT FROM
                enumerated => {
                    [matched, sei] _ SearchCtxList[tag, t.valueCtx];
                    IF matched THEN RETURN[seb[sei].idValue]};
                ENDCASE;
            Log.ErrorHti[unknownTag, tag];  RETURN[0]};

        MergeVariantAttrs: PROC[list: Tree.Link, prefixAttrs: FieldAttrs]
            RETURNS[mergedAttrs: FieldAttrs] = {

            ProcessVariant: Tree.Scan = {
                node: Tree.Index = GetNode[t];

                ProcessLabel: Tree.Scan = {
                    sei: ISEIndex = GetSe[t];
                    type: Type = seb[sei].idInfo;
                    WITH v: seb[type] SELECT FROM
                        cons =>
                            WITH r: v SELECT FROM
                                record => {
                                    subNode: Tree.Index = GetNode[tb[node].son[2]];
                                    attrs: FieldAttrs = CollectAttrs[tb[subNode].son[1], prefixAttrs];
                                    UpdateHints[LOOPHOLE[type], attrs];
                                    r.hints.default _ TRUE;
                                    tb[subNode].attr1 _ attrs.positions[explicit];
                                    mergedAttrs _ MergeAttrs[mergedAttrs, attrs]};
                                ENDCASE;
                        id => NULL;
                        ENDCASE
                    };

                ScanList[tb[node].son[1], ProcessLabel]};

            mergedAttrs _ prefixAttrs;
            ScanList[list, ProcessVariant];  mergedAttrs.default _ prefixAttrs.default;
            RETURN};

    <<type construction>>

        MakeLongType: PUBLIC PROC[rType, hint: Type] RETURNS[type: Type] = {
            subType: CSEIndex = UnderType[rType];
            protoType: CSEIndex = UnderType[hint];
            WITH p: seb[protoType] SELECT FROM
                long =>
                    IF EqTypes[TargetType[p.rangeType], TargetType[subType]] THEN RETURN[hint];
                ENDCASE;
            WITH t: seb[subType] SELECT FROM
                relative => {
                    oType: Type = MakeLongType[t.offsetType, t.resultType];
                    type _ MakeNonCtxSe[SERecord.cons.relative.SIZE];
                    seb[type] _ [mark3: TRUE, mark4: TRUE,
                        body: cons[relative[baseType: t.baseType, offsetType: oType, resultType: oType]]]};
                ENDCASE => {
                    type _ MakeNonCtxSe[SERecord.cons.long.SIZE];
                    seb[type] _ [mark3: TRUE, mark4: TRUE, body: cons[long[rangeType: rType]]]};
            RETURN};

        MakeRefType: PUBLIC PROC[cType, hint: Type, readOnly, counted, var: BOOL]
              RETURNS[type: RefSEIndex] = {
            protoType: CSEIndex = UnderType[hint];
            WITH p: seb[protoType] SELECT FROM
                ref =>
                    IF ~p.ordered
                        AND p.readOnly = readOnly AND p.counted = counted AND p.var = var
                        AND EqTypes[p.refType, cType] THEN RETURN[LOOPHOLE[protoType]];
                ENDCASE;
            type _ LOOPHOLE[MakeNonCtxSe[SERecord.cons.ref.SIZE]];
            seb[type] _ [mark3: TRUE, mark4: TRUE,
                body: cons[ref[
                    counted: counted,
                    var: var,
                    readOnly: readOnly, ordered: FALSE, list: FALSE, basing: FALSE,
                    refType: cType]]];
            RETURN};

        }.