
    <<Pass4Xc.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 18, 1986 5:10:56 pm PDT>>
        <<Paul Rovner, September 8, 1983 1:49 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 11:00:23 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Notifier],
        ComData: TYPE USING [idCARDINAL, idINTEGER, interface, typeINTEGER, typeStringBody],
        LiteralOps: TYPE USING [Find, FindDescriptor],
        Log: TYPE USING [Error, ErrorTree, WarningTree],
        P4: TYPE USING [Attr, AUsForType, BiasForType, BitsForType, both, ByteSeq, CatchNest, CommonAttr, CommonProp, Exp, FillMultiWord, 
        ForceType, LiteralAttr, MakeArgRecord, MakeStructuredLiteral, MakeTreeLiteral, maxRegs, none, OperandStruct, OperandType, 
        other, Prop, RegCount, RegsForType, RelTest, RepForType, Repr, Rhs, RValue, SetType, StructuredLiteral, TreeLiteral, 
        TreeLiteralValue, TypeExp, TypeForTree, unsigned, ValueDescriptor, VAttr, voidAttr, VPop, VProp, VPush, VRegs, VRep],
        Symbols: TYPE USING [Base, BitAddress, BitCount, codeCHAR, codeINT, CSEIndex, ctxType, ISEIndex, ISENull, lZ, seType, Type],
        SymbolOps: TYPE USING [ArgRecord, BitsPerElement, Cardinality, CtxLevel, DecodeBitAddr, DecodeCard, FirstCtxSe, FromType, 
        NormalType, NextSe, PackedSize, VariantField, ToType, UnderType],
        SymLiteralOps: TYPE USING [TypeRef],
        Target: TYPE MachineParms USING [bitsPerAU, bitsPerByte, bitsPerChar, bitsPerWord, maxWord, maxLongWord],
        Tree: TYPE USING [Base, Index, Link, NodeName, Null, treeType],
        TreeOps: TYPE USING [FreeNode, FreeTree, GetNode, GetSe, GetTag, IdentityMap, MakeNode, OpName, PopTree, PushLit, PushNode, PushSe, 
        PushTree, SetAttr];

    Pass4Xc: PROGRAM
        IMPORTS Log, LiteralOps, P4, SymbolOps, SymLiteralOps, TreeOps, dataPtr: ComData
        EXPORTS P4 = {
        OPEN SymbolOps, TreeOps, P4;

        Type: TYPE = Symbols.Type;
        CSEIndex: TYPE = Symbols.CSEIndex;
        bitsPerWord: CARDINAL = Target.bitsPerWord;

        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)

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


    <<interval utilities>>

        NormalizeRange: PUBLIC PROC [t: Tree.Link] RETURNS [val: Tree.Link] = {
            next: Tree.Link;
            FOR val _ t, next DO
                WITH val SELECT GetTag[val] FROM
                    symbol => {
                        lBound: INTEGER = BiasForType[index];
                        THROUGH [1..2] DO
                            PushTree[MakeTreeLiteral[ABS[lBound]]];
                            IF lBound < 0 THEN PushNode[uminus, 1];
                            ENDLOOP;
                        PushTree[MakeTreeLiteral[Cardinality[index] - 1]];
                        PushNode[plus, 2];  SetType[dataPtr.idINTEGER];
                        next _ MakeNode[intCC, 2]};
                    subtree => {
                        node: Tree.Index = index;
                        SELECT tb[node].name FROM
                            subrangeTC, cdot => {
                                next _ tb[node].son[2]; tb[node].son[2] _ Tree.Null; FreeNode[node]};
                            IN [intOO .. intCC] => EXIT;
                            ENDCASE => ERROR};
                    ENDCASE => ERROR;
                ENDLOOP;
            RETURN};

        Interval: PUBLIC PROC [node: Tree.Index, bias: INTEGER, target: Repr]
              RETURNS [const: BOOL] = {
            OPEN tb[node];
            attr: Attr;
            nRegs: RegCount;
            son[1] _ RValue[son[1], bias, target];
            attr _ VAttr[]; nRegs _ VRegs[];
            son[2] _ RValue[son[2], bias, target];
            nRegs _ MAX[VRegs[], nRegs];  attr _ CommonAttr[attr, VAttr[]];
            VPop[];  VPop[];  VPush[bias, attr, nRegs];
            const _ StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1;
            RETURN};

        EmptyInterval: PUBLIC SIGNAL = CODE;

        ConstantInterval: PUBLIC PROC [node: Tree.Index] RETURNS [origin, range: INTEGER] = {
            OPEN tb[node];
            uBound: INTEGER;
            rep: Repr _ VRep[];
            empty: BOOL _ FALSE;
            origin _ TreeLiteralValue[son[1]];  uBound _ TreeLiteralValue[son[2]];
            SELECT name FROM
                intOO, intOC => {
                    IF RelTest[son[1], son[2], relGE, rep] THEN empty _ TRUE;
                    origin _ origin + 1;
                    son[1] _ FreeTree[son[1]];
                    name _ IF name = intOO THEN intCO ELSE intCC;
                    son[1] _ MakeTreeLiteral[origin]};
                ENDCASE;
            SELECT name FROM
                intCC => IF RelTest[son[1], son[2], relG, rep] THEN empty _ TRUE;
                intCO => {
                    IF RelTest[son[1], son[2], relGE, rep] THEN empty _ TRUE;
                    uBound _ uBound - 1;
                    son[2] _ FreeTree[son[2]];
                    name _ intCC;  son[2] _ MakeTreeLiteral[uBound]};
                ENDCASE => ERROR;
            IF ~empty THEN range _ uBound - origin ELSE {SIGNAL EmptyInterval; range _ 0};
            RETURN};


    <<type utilities (move?)>>


    <<operators on types>>

        TypeOp: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
            SELECT tb[node].name FROM

                size => val _ Size[node];
                first, last => val _ EndPoint[node];
                typecode => val _ TypeCode[node];
                ENDCASE => {
                    Log.Error[unimplemented]; VPush[0, voidAttr, 0]; val _ [subtree[node]]};

            RETURN};


        Size: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
            type: CSEIndex;

            ApplyLit: PROC [op: Tree.NodeName, val: WORD] = {
                PushTree[MakeTreeLiteral[val]];  PushNode[op, 2];
                SetType[dataPtr.idINTEGER];  SetAttr[1, FALSE];  SetAttr[2, FALSE]};

            IF OpName[tb[node].son[1]] = apply THEN {
                subNode: Tree.Index = GetNode[tb[node].son[1]];
                sei: Symbols.ISEIndex;
                bitsPerItem: Symbols.BitCount;
                TypeExp[tb[subNode].son[1]];  type _ UnderType[TypeForTree[tb[subNode].son[1]]];
                SELECT TRUE FROM
                    (type = dataPtr.typeStringBody) => bitsPerItem _ Target.bitsPerChar;
                    ((sei _ VariantField[type]) # Symbols.ISENull) => {
                        subType: CSEIndex = UnderType[seb[sei].idType];
                        bitsPerItem _ WITH t: seb[subType] SELECT FROM
                            sequence => BitsPerElement[t.componentType, t.packed],
                            ENDCASE => ERROR};
                    ENDCASE => ERROR;
                PushTree[tb[subNode].son[2]];  tb[subNode].son[2] _ Tree.Null;
                IF bitsPerItem < bitsPerWord THEN {
                    itemsPerWord: CARDINAL = bitsPerWord/CARDINAL[bitsPerItem];
                    ApplyLit[plus, itemsPerWord-1];  ApplyLit[div, itemsPerWord]}
                ELSE ApplyLit[times, bitsPerItem/bitsPerWord];
                ApplyLit[plus, P4.AUsForType[type]];
                IF tb[node].son[2] # Tree.Null THEN {
                    PushTree[tb[node].son[2]];  tb[node].son[2] _ Tree.Null;
                    PushNode[times, 2]; 
                    SetType[dataPtr.idINTEGER];  SetAttr[1, FALSE];  SetAttr[2, FALSE]}}
            ELSE {
                TypeExp[tb[node].son[1]];  type _ UnderType[TypeForTree[tb[node].son[1]]];
                IF tb[node].son[2] = Tree.Null THEN PushTree[MakeTreeLiteral[P4.AUsForType[type]]]
                ELSE {
                    nBits: CARDINAL = P4.BitsForType[type];
                    PushTree[tb[node].son[2]];  tb[node].son[2] _ Tree.Null;
                    IF nBits <= Target.bitsPerByte THEN {
                        n: CARDINAL = bitsPerWord/PackedSize[nBits];
                        ApplyLit[plus, n-1];  ApplyLit[div, n]}
                    ELSE  ApplyLit[times, P4.AUsForType[type]]}};
            val _ Rhs[PopTree[], dataPtr.idCARDINAL];  FreeNode[node]};

        EndPoint: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
            OPEN tb[node];
            type, next: CSEIndex;
            first: BOOL = (name=$first);
            v: CARD;
            TypeExp[son[1]];
            FOR type _ UnderType[TypeForTree[son[1]]], next DO
                WITH seb[type] SELECT FROM
                    basic => {
                        maxWord: CARD = Target.maxWord;
                        maxInteger: INT = Target.maxWord/2;
                        v _ SELECT code FROM
                            Symbols.codeINT => CARD[IF first THEN -maxInteger-1 ELSE maxInteger],
                            Symbols.codeCHAR => IF first THEN 0 ELSE Cardinality[type]-1,
                            ENDCASE => IF first THEN 0 ELSE maxWord;
                        GO TO short};
                    enumerated => {
                        v _ IF first THEN 0 ELSE CARDINAL[Cardinality[type]-1]; GO TO short};
                    relative => next _ UnderType[offsetType];
                    subrange => {v _ IF first THEN origin ELSE origin+range; GO TO short};
                    long => {
                        maxLongWord: CARD = Target.maxLongWord;
                        maxLongInteger: INT = Target.maxLongWord/2;
                        v _ IF UnderType[rangeType] = dataPtr.typeINTEGER
                            THEN IF first THEN -maxLongInteger-1 ELSE maxLongWord
                            ELSE IF first THEN 0 ELSE maxLongWord;
                        GO TO long};
                    ENDCASE => ERROR;
                REPEAT
                    short => val _ MakeTreeLiteral[v];
                    long => {
                        PushLit[LiteralOps.Find[v]];    -- MakeTreeLiteral[v] ?
                        PushNode[mwconst, 1];  SetType[type];  val _ PopTree[]};
                ENDLOOP;
            FreeNode[node];
            VPush[0, LiteralAttr[RepForType[type]], RegsForType[type]]; RETURN};

        TypeCode: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
            TypeExp[tb[node].son[1]];
            IF dataPtr.interface THEN val _ [subtree[index: node]]
                ELSE {
                    val _ SymLiteralOps.TypeRef[TypeForTree[tb[node].son[1]], FALSE];
                    FreeNode[node]};
            VPush[0, LiteralAttr[both], 1];  RETURN};


    <<misc transfer operators>>

        MiscXfer: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
            attr: Attr;
            SELECT tb[node].name FROM

                create => {
                    tb[node].son[1] _ RValue[tb[node].son[1], 0, none];
                    attr _ [prop: VProp[], rep: unsigned];  VPop[]};

                fork => {
                    OPEN tb[node];
                    type: CSEIndex;
                    son[1] _ Exp[son[1], none];
                    attr.prop _ VProp[]; VPop[];  type _ OperandStruct[son[1]];
                    WITH t: seb[type] SELECT FROM
                        transfer => {
                            son[2] _ MakeArgRecord[ArgRecord[t.typeIn], son[2]];
                            attr.prop _ CommonProp[attr.prop, VProp[]]; attr.rep _ other;  VPop[]};
                        ENDCASE => ERROR};

                ENDCASE => {Log.Error[unimplemented]; attr _ voidAttr};

            attr.prop.noXfer _ attr.prop.noFreeVar _ FALSE;  VPush[0, attr, maxRegs];
            IF tb[node].nSons > 2 THEN CatchNest[tb[node].son[3]];
            RETURN[[subtree[index: node]]]};


    <<NIL>>

        Nil: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
            type: Type = ToType[tb[node].info];
            n: CARDINAL;
            IF tb[node].son[1] # Tree.Null THEN TypeExp[tb[node].son[1]];
            n _ P4.AUsForType[type];
            IF n > bitsPerWord/Target.bitsPerAU THEN {
                nB: CARDINAL = n*(Target.bitsPerAU/Target.bitsPerByte);
                bytes: ValueDescriptor _ NEW[ByteSeq[nB]];
                FOR i: CARDINAL IN [0..nB) DO bytes[i] _ 0 ENDLOOP;
                PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[bytes]]];
                PushNode[mwconst, 1]; SetType[type];
                bytes _ NIL}
            ELSE PushLit[LiteralOps.Find[0]];
            FreeNode[node];
            VPush[BiasForType[type], LiteralAttr[RepForType[type]], RegsForType[type]];
            RETURN[ForceType[PopTree[], type]]};


    <<misc addressing operators>>

        AddrOp: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
            attr: Attr;
            nRegs: RegCount;
            SELECT tb[node].name FROM

                addr => val _ Addr[node];

                base => {
                    tb[node].son[1] _ Exp[tb[node].son[1], none];
                    nRegs _ VRegs[]; attr _ [prop: VProp[], rep: unsigned];  VPop[];
                    VPush[0, attr, nRegs];  val _ [subtree[index: node]]};

                length => {
                    type: CSEIndex;
                    tb[node].son[1] _ Exp[tb[node].son[1], none];
                    type _ OperandStruct[tb[node].son[1]];
                    WITH seb[type] SELECT FROM
                        array => {
                            val _ MakeTreeLiteral[Cardinality[indexType]];
                            FreeNode[node];  attr _ LiteralAttr[both];  nRegs _ 1};
                        ENDCASE => {
                            val _ [subtree[index: node]]; attr _ [prop: VProp[], rep: both]; nRegs _ VRegs[]};
                    VPop[];  VPush[0, attr, nRegs]};

                arraydesc =>
                    val _ IF OpName[tb[node].son[1]] # list THEN Desc[node] ELSE DescList[node];

                ENDCASE => {
                    Log.Error[unimplemented]; VPush[0, voidAttr, 0]; val _ [subtree[node]]};

            RETURN};


        Addr: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
            OPEN tb[node];
            v: Tree.Link;
            subNode: Tree.Index;
            type, next: CSEIndex;
            prop: Prop;
            nRegs: RegCount;
            son[1] _ Exp[son[1], none];
            nRegs _ MAX[VRegs[], RegsForType[ToType[info]]];
            prop _ VProp[];  prop.noFreeVar _ FALSE;
            FOR t: Tree.Link _ son[1], v DO
                WITH t SELECT GetTag[t] FROM
                    symbol => {
                        sei: Symbols.ISEIndex = index;
                        IF seb[sei].constant THEN GO TO fail;
                        IF CtxLevel[seb[sei].idCtx] = Symbols.lZ AND
                            (DecodeBitAddr[seb[sei].idValue].bd MOD bitsPerWord # 0 OR
                                DecodeCard[seb[sei].idInfo] MOD bitsPerWord # 0) THEN GO TO fail;
                        GO TO pass};
                    subtree => {
                        subNode _ index;
                        SELECT tb[subNode].name FROM
                            dot, dollar =>  v _ tb[subNode].son[2];
                            index, dindex, seqindex =>
                                FOR  type _ NormalType[OperandType[tb[subNode].son[1]]], next DO
                                    WITH t: seb[type] SELECT FROM
                                        array => IF t.packed THEN GO TO fail ELSE GO TO pass;
                                        sequence => IF t.packed THEN GO TO fail ELSE GO TO pass;
                                        arraydesc => next _ UnderType[t.describedType];
                                        ENDCASE => ERROR;
                                    ENDLOOP;
                            apply => GO TO fail;
                            uparrow, reloc => GO TO pass;
                            cast, chop => v _ tb[subNode].son[1];
                            base, length => GO TO pass;
                            ENDCASE => ERROR};
                    ENDCASE => ERROR;
                REPEAT
                    pass => NULL;
                    fail => Log.ErrorTree[nonAddressable, son[1]]; 
                ENDLOOP;
            val _ [subtree[index: node]];
            IF OpName[son[1]] = dot THEN {
                subNode _ GetNode[son[1]];
                IF TreeLiteral[tb[subNode].son[1]] THEN {
                    val _ MakeStructuredLiteral[
                        TreeLiteralValue[tb[subNode].son[1]] +
                            DecodeBitAddr[seb[GetSe[tb[subNode].son[2]]].idValue]/bitsPerWord,
                        ToType[info]];
                    FreeNode[node]}};
            VPop[];
            VPush[0, [prop: prop, rep: unsigned], nRegs];  RETURN};


        Desc: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
            subNode: Tree.Index = GetNode[tb[node].son[1]];
            long: BOOL = tb[subNode].attr2;
            prop: Prop;
            nRegs: RegCount;
            subType: CSEIndex;
            tb[subNode].son[1] _ Exp[tb[subNode].son[1], none];
            nRegs _ VRegs[];  prop _ VProp[];  VPop[];
            subType _ OperandStruct[tb[subNode].son[1]];
            WITH t: seb[subType] SELECT FROM
                array => {
                    n: CARDINAL = Cardinality[t.indexType];
                    IF n = 0 THEN Log.WarningTree[emptyArray, tb[subNode].son[1]];
                    IF t.packed AND (BitsForType[subType] MOD bitsPerWord # 0) THEN
                        Log.ErrorTree[nonAddressable, tb[subNode].son[1]];
                    PushTree[[subtree[subNode]]];  PushTree[MakeTreeLiteral[n]]};
                sequence => {
                    copy: Tree.Link = IdentityMap[tb[subNode].son[1]];
                    cNode: Tree.Index = GetNode[copy];
                    PushTree[tb[subNode].son[1]];  PushTree[MakeTreeLiteral[0]];
                    PushNode[seqindex, 2];  SetType[t.componentType];
                    SetAttr[2, long];  SetAttr[3, FALSE];
                    tb[subNode].son[1] _ PopTree[];  PushTree[[subtree[subNode]]];
                    tb[cNode].son[2] _ FreeTree[tb[cNode].son[2]];
                    tb[cNode].son[2] _ [symbol[index: t.tagSei]];
                    tb[cNode].info _ FromType[dataPtr.idCARDINAL];
                    PushTree[copy]};
                record => {  -- StringBody only (compatibility glitch)
                    copy: Tree.Link = IdentityMap[tb[subNode].son[1]];
                    sei: Symbols.ISEIndex = NextSe[NextSe[FirstCtxSe[t.fieldCtx]]];
                    PushTree[tb[subNode].son[1]];  PushSe[sei];  PushNode[dollar, 2];
                    SetType[seb[sei].idType];  SetAttr[2, long];
                    tb[subNode].son[1] _ PopTree[];  PushTree[[subtree[subNode]]];
                    PushTree[copy];  PushSe[NextSe[FirstCtxSe[t.fieldCtx]]];  PushNode[dollar, 2];
                    SetType[dataPtr.idCARDINAL]; SetAttr[2, long]};
                ENDCASE => {
                    PushTree[[subtree[subNode]]];  PushTree[Tree.Null]};
            PushTree[Tree.Null];  PushNode[list, 3];  tb[node].son[1] _ PopTree[];
            VPush[0, [prop: prop, rep: other], MAX[RegsForType[ToType[tb[node].info]], nRegs]];
            RETURN[[subtree[index: node]]]};

        DescList: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
            subNode: Tree.Index = GetNode[tb[node].son[1]];
            type: Type = ToType[tb[node].info];
            subType: CSEIndex;
            prop: Prop;
            nRegs: RegCount;
            tb[subNode].son[1] _ RValue[tb[subNode].son[1], 0, unsigned];
            nRegs _ VRegs[];  prop _ VProp[];  subType _ OperandStruct[tb[subNode].son[1]];
            WITH seb[subType] SELECT FROM
                ref =>
                    IF BitsForType[refType] MOD bitsPerWord # 0 THEN
                        Log.ErrorTree[nonAddressable, tb[subNode].son[1]];
                ENDCASE;
            tb[subNode].son[2] _ RValue[tb[subNode].son[2], 0, none];
            nRegs _ MAX[VRegs[], nRegs];  prop _ CommonProp[VProp[], prop];
            IF tb[subNode].son[3] # Tree.Null THEN TypeExp[tb[subNode].son[3]];
            VPop[]; VPop[];
            IF StructuredLiteral[tb[subNode].son[1]] AND TreeLiteral[tb[subNode].son[2]] THEN {
                n: CARDINAL = AUsForType[type]*(Target.bitsPerAU/Target.bitsPerByte);
                bytes: ValueDescriptor _ NEW[ByteSeq[n]];
                FillMultiWord[bytes, 0, tb[subNode].son[1]];
                bytes[n-1] _ TreeLiteralValue[tb[subNode].son[2]];
                PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[bytes]]];
                PushNode[mwconst, 1];  SetType[type];
                bytes _ NIL;
                val _ PopTree[];  FreeNode[node]}
            ELSE val _ [subtree[index: node]];
            VPush[0, [prop: prop, rep: other], MAX[RegsForType[type], nRegs]];  RETURN};

        }.

