
    <<Pass3Xc.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 17, 1986 3:18:13 pm PDT>>
        <<Russ Atkinson (RRA) March 6, 1985 10:47:43 pm PST>>

    DIRECTORY
        A3: TYPE USING [BaseType, CanonicalType, LongPath, OperandLhs, OperandType, OrderedType, TargetType, TypeForTree],
        Alloc: TYPE USING [Notifier],
        ComData: TYPE USING [idCARDINAL, idCHAR, idINTEGER, typeStringBody],
        Copier: TYPE USING [SEToken, nullSEToken, CtxFirst, CtxNext, CtxValue],
        Log: TYPE USING [Error, ErrorN, ErrorNode, ErrorNodeOp, ErrorTree, ErrorTreeOp],
        P3: TYPE USING [Attr, fullAttr, NPUse, MergeNP, phraseNP, And, Exp, ForceType, Interval, MakeLongType, MakeRefType, RAttr, Rhs, 
        RPop, RPush, RType, SequenceField, SetType, TypeExp, VoidExp],
        P3S: TYPE USING [safety],
        Symbols: TYPE USING [Base, SERecord, Type, ISEIndex, CSEIndex, CTXIndex, nullType, ISENull, typeANY, seType],
        SymbolOps: TYPE USING [DecodeCard, DecodeTreeIndex, EqTypes, MakeNonCtxSe, NormalType, RCType, ReferentType, TypeForm, UnderType],
        Tree: TYPE USING [Base, Index, Link, Null, treeType],
        TreeOps: TYPE USING [FreeNode, GetNode, GetTag, IdentityMap, ListLength, NthSon, OpName, PopTree, PushSe, PushTree, PushNode, 
        SetAttr, UpdateList];

    Pass3Xc: PROGRAM
        IMPORTS A3, Copier, Log, P3, P3S, SymbolOps, TreeOps, dataPtr: ComData
        EXPORTS P3 = {
        OPEN SymbolOps, Symbols, TreeOps, A3, P3;

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

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


    <<ranges>>

        Range: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[val: Tree.Link] = {
            subType: Type;
            SELECT OpName[t] FROM
                subrangeTC => {
                    val _ RewriteSubrange[GetNode[t]];
                    Interval[val, IF type # typeANY THEN type ELSE dataPtr.idINTEGER, FALSE]};
                IN [intOO .. intCC] => {
                    val _ t;
                    Interval[val, IF type # typeANY THEN type ELSE dataPtr.idINTEGER, FALSE]};
                ENDCASE =>
                    IF TypeForm[type] # $long THEN {
                        val _ TypeExp[t];
                        RPush[TargetType[TypeForTree[val]], fullAttr];  phraseNP _ none}
                    ELSE {
                        val _ MakeEndPoints[t];
                        Interval[val, type, FALSE]};
            subType _ RType[];
            IF ~OrderedType[subType] AND subType # typeANY THEN Log.Error[nonOrderedType];
            RETURN};

        RewriteSubrange: PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            subNode: Tree.Index = GetNode[tb[node].son[2]];
            PushTree[tb[subNode].son[1]];  PushTree[IdentityMap[tb[node].son[1]]];
            PushNode[apply, -2];  tb[subNode].son[1] _ PopTree[];
            PushTree[tb[subNode].son[2]];  PushTree[tb[node].son[1]];
            PushNode[apply, -2];  tb[subNode].son[2] _ PopTree[];
            tb[node].son[1] _ tb[node].son[2] _ Tree.Null;  FreeNode[node];
            RETURN[[subtree[subNode]]]};

        MakeEndPoints: PROC[t: Tree.Link] RETURNS[Tree.Link] = {
            PushTree[t];  PushNode[first, 1];
            PushTree[IdentityMap[t]];  PushNode[last, 1];
            PushNode[intCC, 2];  RETURN[PopTree[]]};


    <<operations on enumerated types>>

        SEToken: TYPE = Copier.SEToken;

        Span: PUBLIC PROC[type: CSEIndex] RETURNS[first, last: SEToken] = {
            subType: CSEIndex = UnderType[TargetType[type]];
            vCtx: CTXIndex = WITH s: seb[subType] SELECT FROM
                enumerated => s.valueCtx,
                ENDCASE => ERROR;
            WITH t: seb[type] SELECT FROM
                enumerated => {first _ CtxFirst[vCtx]; last _ CtxLast[vCtx]};
                subrange => {
                    IF t.mark4 THEN {
                        first _ Copier.CtxValue[vCtx, t.origin];
                        last _ Copier.CtxValue[vCtx, t.origin + t.range]}
                    ELSE {
                        node: Tree.Index = LOOPHOLE[t.range];
                        subNode: Tree.Index = GetNode[tb[node].son[2]];
                        first _ EnumeratedValue[tb[subNode].son[1], vCtx];
                        last _ EnumeratedValue[tb[subNode].son[2], vCtx];
                        SELECT tb[subNode].name FROM
                            intOO, intOC => first _ CtxSucc[vCtx, first];
                            ENDCASE;
                        SELECT tb[subNode].name FROM
                            intOO, intCO => last _ CtxPred[vCtx, last];
                            ENDCASE}};
                ENDCASE => first _ last _ Copier.nullSEToken;
            RETURN};

        EnumeratedValue: PROC[t: Tree.Link, vCtx: CTXIndex] RETURNS[SEToken] = {
            WITH t SELECT GetTag[t] FROM
                symbol => {
                    sei: ISEIndex = index;
                    RETURN[SELECT TRUE FROM
                        ~seb[sei].constant => Copier.nullSEToken,
                        (seb[sei].idCtx = vCtx) OR seb[sei].mark4 =>
                            Copier.CtxValue[vCtx, DecodeCard[seb[sei].idValue]],
                        ENDCASE => EnumeratedValue[InitTree[sei], vCtx]]};
                subtree => {
                    node: Tree.Index = index;
                    RETURN[SELECT tb[node].name FROM
                        first => Span[UnderType[TypeForTree[tb[node].son[1]]]].first,
                        last => Span[UnderType[TypeForTree[tb[node].son[1]]]].last,
                        pred => CtxPred[vCtx, EnumeratedValue[tb[node].son[1], vCtx]],
                        succ => CtxSucc[vCtx, EnumeratedValue[tb[node].son[1], vCtx]],
                        ENDCASE => Copier.nullSEToken]};
                ENDCASE => RETURN[Copier.nullSEToken]};

        CtxFirst: PROC[ctx: CTXIndex] RETURNS[SEToken] = Copier.CtxFirst;

        CtxLast: PROC[ctx: CTXIndex] RETURNS[last: SEToken] = {
            last _ Copier.nullSEToken;
            FOR t: SEToken _ Copier.CtxFirst[ctx], Copier.CtxNext[ctx, t] UNTIL t = Copier.nullSEToken DO
                last _ t ENDLOOP;
            RETURN};

        CtxSucc: PROC[ctx: CTXIndex, t: SEToken] RETURNS[SEToken] = Copier.CtxNext;

        CtxPred: PROC[ctx: CTXIndex, t: SEToken] RETURNS[pred: SEToken] = {
            next: SEToken;
            pred _ Copier.nullSEToken;
            IF t # Copier.nullSEToken THEN {
                next _ Copier.CtxFirst[ctx];
                UNTIL next = t OR next = Copier.nullSEToken DO
                    pred _ next; next _ Copier.CtxNext[ctx, next] ENDLOOP};
            RETURN};

        InitTree: PROC[sei: ISEIndex] RETURNS[Tree.Link] = INLINE {
            RETURN[tb[DecodeTreeIndex[seb[sei].idValue]].son[3]]};

    <<operations on addresses>>

        AddrOp: PUBLIC PROC[node: Tree.Index, target: Type] = {
            SELECT tb[node].name FROM
                addr => Addr[node, target];
                base => Base[node, target];
                length => Length[node];
                arraydesc => Desc[node, target];
                ENDCASE => ERROR};


        Addr: PROC[node: Tree.Index, target: Type] = {
            OPEN tb[node];
            type: Type;
            attr: Attr;
            subType: CSEIndex = NormalType[target];
            var: BOOL = WITH t: seb[subType] SELECT FROM
                ref => t.var,
                ENDCASE => FALSE;
            counted: BOOL _ FALSE;
            IF P3S.safety = checked AND ~(var OR attr1) THEN Log.ErrorNodeOp[unsafeOp, node, addr];
            son[1] _ Exp[son[1], typeANY];
            FOR t: Tree.Link _ son[1], NthSon[t, 1] DO
                SELECT OpName[t] FROM
                    uparrow => {
                        subType: CSEIndex = NormalType[OperandType[NthSon[t, 1]]];
                        WITH p: seb[subType] SELECT FROM
                            ref => IF p.counted THEN counted _ TRUE;
                            ENDCASE;
                        EXIT};
                    cast, openx => NULL;
                    ENDCASE => EXIT;
                ENDLOOP;
            SELECT OperandLhs[son[1]] FROM
                counted =>
                    IF var THEN {
                        son[1] _ SafenRef[son[1]];
                        IF RCType[RType[]] # none THEN Log.ErrorTree[unimplemented, son[1]]};
                none => Log.ErrorTree[nonAddressable, son[1]];
                ENDCASE;
            type _ MakeRefType[
                cType: RType[], hint: subType, counted: counted AND ~var, var: var];
            IF var THEN {Log.ErrorNode[unimplemented, node]; attr2 _ FALSE}
            ELSE IF (attr2 _ LongPath[son[1]]) THEN type _ MakeLongType[type, target];
            attr _ RAttr[];  RPop[];  RPush[type, attr]};

        SafenRef: PROC[t: Tree.Link] RETURNS[v: Tree.Link] = {
            WITH t SELECT GetTag[t] FROM
                subtree => {
                    node: Tree.Index = index;
                    SELECT tb[node].name FROM
                        dot, uparrow, dindex, reloc => {
                            PushTree[tb[node].son[1]];
                            PushNode[safen, 1];
                            SetType[OperandType[tb[node].son[1]]];
                            tb[node].son[1] _ PopTree[];  v _ t};
                        dollar, index, seqindex, loophole, cast, openx, pad, chop => {
                            tb[node].son[1] _ SafenRef[tb[node].son[1]]; v _ t};
                        cdot => {
                            tb[node].son[2] _ SafenRef[tb[node].son[2]]; v _ t};
                        apply, safen => v _ t;
                        ENDCASE => ERROR};
                ENDCASE => v _ t;
            RETURN};


        StripRelative: PROC[rType: Type] RETURNS[type, baseType: Type] = {
            rSei: CSEIndex = UnderType[rType];
            WITH r: seb[rSei] SELECT FROM
                relative => {type _ r.offsetType; baseType _ r.baseType};
                ENDCASE => {type _ rType; baseType _ nullType};
            RETURN};

        MakeRelativeType: PROC[type: Type, bType: Type, hint: Type] RETURNS[Type] = {
            tType: Type;
            rType: CSEIndex;
            protoType: CSEIndex = UnderType[hint];
            WITH p: seb[protoType] SELECT FROM
                relative =>
                    IF EqTypes[p.offsetType, type] AND EqTypes[p.baseType, bType] THEN RETURN[hint];
                ENDCASE;
            tType _ IF TypeForm[bType] = $long OR TypeForm[type] = $long
                THEN MakeLongType[BaseType[type], type]
                ELSE type;
            rType _ MakeNonCtxSe[SERecord.cons.relative.SIZE];
            seb[rType].typeInfo _ relative[
                baseType: bType,
                offsetType: type,
                resultType: tType];
            seb[rType].mark3 _ seb[rType].mark4 _ TRUE;
            RETURN[rType]};


        Base: PROC[node: Tree.Index, target: Type] = {
            OPEN tb[node];
            type, aType, bType, subTarget: Type;
            nType: CSEIndex;
            attr: Attr;
            long: BOOL;
            IF P3S.safety = checked THEN Log.ErrorNodeOp[unsafeOp, node, base];
            IF ListLength[son[1]] = 1 THEN {
                son[1] _ Exp[son[1], typeANY];
                [aType, bType] _ StripRelative[CanonicalType[RType[]]];
                attr _ RAttr[];  RPop[];
                nType _ NormalType[aType];  [subTarget, ] _ StripRelative[target];
                WITH n: seb[nType] SELECT FROM
                    array => {
                        name _ addr;
                        IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonAddressable, son[1]];
                        long _ LongPath[son[1]]};
                    arraydesc => {
                        long _ (TypeForm[aType] = $long); nType _ UnderType[n.describedType];
                        attr1 _ TRUE};
                    ENDCASE => IF nType # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], base]}
            ELSE {
                Log.ErrorN[listLong, ListLength[son[1]]-1];
                son[1] _ UpdateList[son[1], VoidExp];  long _ FALSE};
            type _ MakeRefType[nType, BaseType[subTarget]];
            IF (attr2 _ long) THEN type _ MakeLongType[type, subTarget];
            IF bType # nullType THEN type _ MakeRelativeType[type, bType, target];
            attr.const _ FALSE;  RPush[type, attr];  RETURN};

        Length: PROC[node: Tree.Index] = {
            OPEN tb[node];
            type: Type;
            subType: CSEIndex;
            attr: Attr;
            IF ListLength[son[1]] = 1 THEN {
                son[1] _ Exp[son[1], typeANY];
                type _ RType[];  attr _ RAttr[];  RPop[];
                subType _ IF seb[type].mark3
                    THEN NormalType[StripRelative[CanonicalType[type]].type]
                    ELSE typeANY;
                WITH seb[subType] SELECT FROM
                    array => {
                        IF ~EqTypes[subType, type] THEN son[1] _ ForceType[son[1], subType];
                        attr.const _ TRUE};
                    arraydesc => {attr.const _ FALSE; attr1 _ TRUE};
                    ENDCASE => {
                        attr.const _ TRUE;
                        IF type # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], length]}}
            ELSE {
                attr.const _ TRUE;
                Log.ErrorN[listLong, ListLength[son[1]]-1];
                son[1] _ UpdateList[son[1], VoidExp]};
            RPush[dataPtr.idINTEGER, attr];  RETURN};

        Desc: PROC[node: Tree.Index, target: Type] = {
            OPEN tb[node];
            type, subType: Type;
            attr: Attr;
            saveNP: NPUse;
            aType, bType: Type _ nullType;
            cType, iType: Type;
            fixed: {none, range, both} _ none;
            packed: BOOL _ FALSE;
            long: BOOL;
            subTarget: Type = StripRelative[target].type;
            cSei: CSEIndex;
            nTarget: CSEIndex = NormalType[subTarget];
            IF P3S.safety = checked THEN Log.ErrorNodeOp[unsafeOp, node, arraydesc];
            SELECT ListLength[son[1]] FROM
                1 => {
                    rType: Type;
                    nType: CSEIndex;
                    nDerefs: CARDINAL _ 0;
                    son[1] _ Exp[son[1], typeANY];
                    IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonAddressable, son[1]];
                    long _ LongPath[son[1]];
                    cSei _ UnderType[CanonicalType[RType[]]];  attr _ RAttr[];
                    IF ~EqTypes[cSei, RType[]] THEN son[1] _ ForceType[son[1], cSei];  RPop[];
                    nType _ NormalType[cSei];
                    WHILE seb[nType].typeTag = ref AND (nDerefs _ nDerefs+1) < 64 DO
                        long _ seb[cSei].typeTag = long;
                        cSei _ UnderType[CanonicalType[ReferentType[nType]]];
                        PushTree[son[1]];  PushNode[uparrow, 1];
                        SetType[cSei];  SetAttr[2, long];  SetAttr[3, FALSE];
                        son[1] _ PopTree[];
                        nType _ NormalType[cSei];
                        ENDLOOP;
                    PushTree[son[1]];
                    IF seb[cSei].typeTag = record THEN {
                        sei: ISEIndex = SequenceField[LOOPHOLE[cSei]];
                        SELECT TRUE FROM
                            (sei # ISENull) => {
                                cSei _ UnderType[seb[sei].idType];
                                WITH s: seb[cSei] SELECT FROM
                                    sequence => {
                                        PushSe[sei]; PushNode[dollar, 2];
                                        SetType[cSei]; SetAttr[2, long]};
                                    ENDCASE => ERROR};
                            (cSei = dataPtr.typeStringBody) => NULL;    -- fake sequence
                            ENDCASE => {
                                Log.ErrorTreeOp[missingOp, son[1], arraydesc]; cSei _ typeANY}
                            };
                    WITH t: seb[cSei] SELECT FROM
                        array => {rType _ aType _ OperandType[son[1]]; fixed _ both};
                        sequence => {
                            rType _ cType _ t.componentType;  packed _ t.packed;
                            iType _ seb[t.tagSei].idType;  fixed _ both;
                            IF ~t.controlled THEN Log.ErrorTreeOp[missingOp, son[1], arraydesc]};
                        record => { -- StringBody
                            rType _ cType _ dataPtr.idCHAR;  packed _ TRUE;
                            iType _ dataPtr.idCARDINAL;  fixed _ both};
                        ENDCASE => {
                            rType _ cType _ typeANY;
                            IF cSei # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], arraydesc]};
                    subType _ MakeRefType[rType, typeANY];
                    IF long THEN subType _ MakeLongType[subType, typeANY];
                    PushNode[addr, 1];  SetType[subType];  SetAttr[2, long];
                    son[1] _ PopTree[]};
                3 => {
                    subNode: Tree.Index = GetNode[son[1]];
                    tb[subNode].son[1] _ Exp[tb[subNode].son[1], typeANY];
                    [subType, bType] _ StripRelative[CanonicalType[RType[]]];
                    attr _ RAttr[];  RPop[];  saveNP _ phraseNP;
                    SELECT TypeForm[NormalType[subType]] FROM
                        $basic, $ref => NULL;
                        ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]];
                    long _ (TypeForm[subType] = $long);
                    tb[subNode].son[2] _ Rhs[tb[subNode].son[2], dataPtr.idINTEGER];
                    attr _ And[RAttr[], attr];  RPop[];
                    phraseNP _ MergeNP[saveNP][phraseNP];
                    IF tb[subNode].son[3] # Tree.Null THEN {
                        tb[subNode].son[3] _ TypeExp[tb[subNode].son[3]];
                        cType _ TypeForTree[tb[subNode].son[3]];  fixed _ range}};
                ENDCASE;
            IF aType = nullType THEN {
                WITH n: seb[nTarget] SELECT FROM
                    arraydesc => {
                        cSei _ UnderType[n.describedType];
                        WITH t: seb[cSei] SELECT FROM
                            array =>
                                IF fixed = none
                                    OR (fixed = range AND EqTypes[t.componentType, cType]) THEN {
                                        aType _ n.describedType; GO TO old};
                            ENDCASE};
                    ENDCASE;
                GO TO new;
                EXITS
                    old => NULL;
                    new => {
                        aType _ MakeNonCtxSe[SERecord.cons.array.SIZE];
                        seb[aType] _ [mark3: TRUE, mark4: TRUE,
                            body: cons[array[
                                packed: packed,
                                indexType: IF fixed < both THEN dataPtr.idCARDINAL ELSE iType,
                                componentType: IF fixed > none THEN cType ELSE typeANY]]]}};
            <<make type description>>
                BEGIN
                WITH t: seb[nTarget] SELECT FROM
                    arraydesc =>
                        IF EqTypes[t.describedType, aType] THEN GO TO old;
                    ENDCASE =>
                        IF fixed = none AND target = typeANY THEN Log.ErrorNode[noTarget, node];
                GO TO new;
                EXITS
                    old => type _ nTarget;
                    new => {
                        type _ MakeNonCtxSe[SERecord.cons.arraydesc.SIZE];
                        seb[type] _ [mark3: TRUE, mark4: TRUE,
                            body: cons[arraydesc[readOnly: FALSE, var: FALSE, describedType: aType]]];
                        };
                END;
            IF (attr2 _ long) THEN type _ MakeLongType[type, subTarget];
            IF bType # nullType THEN type _ MakeRelativeType[type, bType, target];
            attr.const _ FALSE;  RPush[type, attr];  RETURN};

        }.

