
    <<Attr3b.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 7, 1986 1:01:07 pm PST>>
        <<Donahue, 10-Dec-81 11:23:00>>
        <<Russ Atkinson (RRA) March 6, 1985 10:38:47 pm PST>>

    DIRECTORY
        A3: TYPE USING [AccessMode, CanonicalType, LhsMode, LifeTime],
        Alloc: TYPE USING [Notifier],
        ComData: TYPE USING [typeINT, typeSTRING],
        P3: TYPE USING [phraseNP, RecordLhs, SetNP],
        P3S: TYPE USING [currentBody],
        Symbols: TYPE USING [Base, Type, ISEIndex, CSEIndex, ContextLevel, CTXIndex, CBTIndex, CSENull, CTXNull, CBTNull, lG, lZ, typeANY, 
        bodyType, ctxType, seType],
        SymbolOps: TYPE USING [CtxLevel, XferMode],
        Tree: TYPE USING [Base, Index, Link, NullIndex, treeType],
        TreeOps: TYPE USING [GetInfo, ListLength, NthSon, OpName];

    Attr3b: PROGRAM
        IMPORTS A3, P3, P3S, SymbolOps, TreeOps, dataPtr: ComData
        EXPORTS A3 = {
        OPEN SymbolOps, Symbols, TreeOps, A: A3;

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

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


    <<tree manipulation utilities>>

        TypeForTree: PUBLIC PROC[t: Tree.Link] RETURNS[Type] = {
            <<N.B. assumes t evaluated by P3.TypeLink or P3.Exp>>
            RETURN[WITH t SELECT FROM
                symbol => index,
                subtree =>
                    SELECT tb[index].name FROM
                        cdot, discrimTC => TypeForTree[tb[index].son[2]],
                        ENDCASE => tb[index].info,
                ENDCASE => typeANY]};


        InterfaceVar: PROC[t: Tree.Link] RETURNS[BOOL] = INLINE {
            RETURN[WITH t SELECT FROM
                symbol => (ctxb[seb[index].idCtx].ctxType = imported),
                ENDCASE => FALSE]};

        WritableRef: PROC[t: Tree.Link] RETURNS[A.LhsMode] = {
            P3.phraseNP _ P3.SetNP[P3.phraseNP];
            RETURN[A.AccessMode[A.CanonicalType[OperandType[t]]]]};

        VarLhsMode: ARRAY A.LhsMode OF A.LhsMode = [
            none: $none, uncounted: $counted, counted: $counted];

        OperandLhs: PUBLIC PROC[t: Tree.Link] RETURNS[A.LhsMode] = {
            WITH t SELECT FROM
                symbol => {
                    sei: ISEIndex = index;
                    ctx: CTXIndex = seb[sei].idCtx;
                    level: ContextLevel;
                    IF ctx = CTXNull THEN level _ lZ
                    ELSE {
                        ctxb[ctx].varUpdated _ TRUE;
                        IF (level _ CtxLevel[ctx]) < P3S.currentBody.level THEN
                            P3.phraseNP _ P3.SetNP[P3.phraseNP]};
                    P3.RecordLhs[sei];
                    RETURN[SELECT TRUE FROM
                        seb[sei].immutable => $none,
                        (level = lG) => $counted,
                        ENDCASE => $uncounted]};
                subtree => {
                    node: Tree.Index = index;
                    RETURN[IF node = Tree.NullIndex THEN $none ELSE
                        SELECT tb[node].name FROM
                            $dot =>
                                WITH tb[node].son[2] SELECT FROM
                                    symbol =>
                                        SELECT TRUE FROM
                                            seb[index].immutable => $none,
                                            (CtxLevel[seb[index].idCtx] = lG) =>
                                                VarLhsMode[WritableRef[tb[node].son[1]]],
                                            ENDCASE => WritableRef[tb[node].son[1]],
                                    ENDCASE => none,
                            $uparrow =>
                                IF InterfaceVar[tb[node].son[1]]
                                    THEN VarLhsMode[WritableRef[tb[node].son[1]]]
                                    ELSE WritableRef[tb[node].son[1]],
                            $dindex => WritableRef[tb[node].son[1]],
                            $reloc => WritableRef[tb[node].son[2]],
                            $dollar =>
                                WITH tb[node].son[2] SELECT FROM
                                    symbol =>
                                        IF ~seb[index].immutable
                                            THEN OperandLhs[tb[node].son[1]]
                                            ELSE $none,
                                    ENDCASE => $none,
                            $index, $seqindex, $loophole, $cast, $openx, $pad, $chop =>
                                OperandLhs[tb[node].son[1]],
                            $base, $length =>
                                IF ~tb[node].attr1 THEN $none ELSE OperandLhs[tb[node].son[1]],
                            $cdot => OperandLhs[tb[node].son[2]],
                            $apply => IF ListLength[tb[node].son[1]] = 1 THEN $uncounted ELSE $none,
                            ENDCASE => $none]};
                ENDCASE => RETURN[$none]};

        OperandInline: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
            bti: CBTIndex;
            RETURN[SELECT XferMode[OperandType[t]] FROM
                $proc => (bti_BodyForTree[t]) # CBTNull AND bb[bti].inline,
                ENDCASE => FALSE]};

        OperandLevel: PUBLIC PROC[t: Tree.Link] RETURNS[level: A.LifeTime] = {
            SELECT OpName[t] FROM
                $cdot, $nil => level _ $global;
                ENDCASE => {
                    bti: CBTIndex = BodyForTree[t];
                    level _ SELECT TRUE FROM
                        (bti = CBTNull) => $unknown,
                        (bb[bti].level <= lG+1) => $global,
                        ENDCASE => $local};
            RETURN};

        OperandInternal: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
            WITH t SELECT FROM
                symbol => {
                    bti: CBTIndex = BodyForTree[t];
                    RETURN[bti # CBTNull AND bb[bti].internal]};
                subtree =>
                    RETURN[SELECT OpName[t] FROM
                        $dot, $cdot, $assignx => OperandInternal[NthSon[t, 2]],
                        $ifx => OperandInternal[NthSon[t, 2]] OR OperandInternal[NthSon[t, 3]],
                        ENDCASE => FALSE];    -- should check casex, bindx also
                ENDCASE => RETURN[FALSE]};


        OperandType: PUBLIC PROC[t: Tree.Link] RETURNS[Type] = {
            RETURN[WITH e:t SELECT FROM
                symbol => seb[e.index].idType,
                literal =>
                    WITH e.index SELECT FROM
                        string => dataPtr.typeSTRING,
                        ENDCASE => dataPtr.typeINT,
                subtree => tb[e.index].info,
                ENDCASE => CSENull]
            };


        LongPath: PUBLIC PROC[t: Tree.Link] RETURNS[long: BOOL] = {
            WITH t SELECT FROM
                subtree => {
                    node: Tree.Index = index;
                    long _ IF node = Tree.NullIndex
                        THEN FALSE
                        ELSE SELECT tb[node].name FROM
                            $loophole, $cast, $openx, $pad, $chop => LongPath[tb[node].son[1]],
                            -- $dot, $uparrow, $dindex, $reloc, $seqindex, $dollar, $index => --
                            ENDCASE => tb[node].attr2};
                ENDCASE => long _ FALSE;
            RETURN};


        BodyForTree: PUBLIC PROC[t: Tree.Link] RETURNS[CBTIndex] = {
            node: Tree.Index;
            WITH t SELECT FROM
                symbol => {
                    sei: ISEIndex = index;
                    SELECT TRUE FROM
                        seb[sei].mark4 =>
                            RETURN[IF seb[sei].constant THEN seb[sei].idInfo ELSE CBTNull]; 
                        seb[sei].immutable => {
                            node _ seb[sei].idValue;
                            IF OpName[tb[node].son[3]] = $body THEN RETURN[GetInfo[tb[node].son[3]]]};
                        ENDCASE};
                subtree => {
                    node _ index;
                    SELECT tb[node].name FROM
                        $cdot, $dot, $dollar => RETURN[BodyForTree[tb[node].son[2]]];
                        ENDCASE};
                ENDCASE;
            RETURN[CBTNull]};

        }.