
    <<Pass4Xa.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 11, 1986 10:56:44 am PST>>
        <<Paul Rovner, September 8, 1983 1:57 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 11:55:28 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Notifier],
        Basics: TYPE USING [BITAND, BITOR, BITSHIFT, bitsPerByte, bitsPerWord],
        ComData: TYPE USING [
            idCARDINAL, ownSymbols, switches, typeINT, typeCARDINAL, typeCHAR],
        Literals: TYPE USING [Base, LitDescriptor, ltType],
        LiteralOps: TYPE USING [FindDescriptor, MasterString],
        Log: TYPE USING [Error, ErrorN, ErrorTree, ErrorType],
        P4: TYPE USING [
            AdjustBias, Attr, BiasForType, BitsForType, both, CatchNest, checked,  CommonProp,
            ComputeIndexRegs, ConsState, Covering, emptyProp, Exp, ForceType, MakeStructuredLiteral,
            MakeTreeLiteral, MaxCardinality, maxRegs, NeutralExp, none, OperandType,
            OpWordCount, other, Prop, RegCount, RegsForType, RepForType, Repr, RValue,
            signed, StructuredLiteral, Subst, TreeLiteral, TreeLiteralDesc, TreeLiteralValue, TypeExp,
            TypeForTree, unsigned, ValueDescriptor, VAttr, VBias, voidAttr, voidProp,
            VPop, VProp, VPush, VRegs, VRep, WordSeq, WordsForType, ZeroP],
        Pass4: TYPE USING [implicitAttr, implicitBias, implicitType],
        Symbols: TYPE USING [
            ArraySEIndex, Base, BitAddress, CSEIndex, ctxType, ISEIndex, ISENull, 
            RecordSEIndex, RecordSENull, seType, Type, typeANY, WordCount],
        SymbolOps: TYPE USING [
            ArgRecord, BitsPerElement, Cardinality, EqTypes, FirstCtxSe, FirstVisibleSe, FnField,
            NextSe, RCType, RecordRoot, ReferentType, TypeForm, UnderType, VariantField],
        Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, treeType],
        TreeOps: TYPE USING [
            FreeNode, FreeTree, GetAttr, GetNode, ListLength, NthSon, OpName, PopTree,
            PushLit, PushNode, PushTree, ScanList, SetAttr, SetInfo, UpdateList],
        Types: TYPE USING [Assignable];

    Pass4Xa: PROGRAM
        IMPORTS
            Basics, Log, LiteralOps, P4, SymbolOps, TreeOps, Types, dataPtr: ComData, passPtr: Pass4
        EXPORTS P4 = {
        OPEN SymbolOps, TreeOps, P4;

    <<pervasive definitions from Symbols>>

        Type: TYPE = Symbols.Type;
        ISEIndex: TYPE = Symbols.ISEIndex;
        CSEIndex: TYPE = Symbols.CSEIndex;
        RecordSEIndex: TYPE = Symbols.RecordSEIndex;

        BitAddress: TYPE = Symbols.BitAddress;


        tb: Tree.Base;    -- tree base address (local copy)
        ltb: Literals.Base;    -- literal base address (local copy)
        seb: Symbols.Base;    -- se table base address (local copy)
        ctxb: Symbols.Base;    -- context table base address (local copy)

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

        OperandStruct: PUBLIC PROC[t: Tree.Link] RETURNS[CSEIndex] = {
            RETURN[UnderType[OperandType[t]]]};

    <<expression list manipulation>>

        FieldRhs: PROC[t: Tree.Link, type: Type, cs: ConsState] RETURNS[Tree.Link] = {
            v: Tree.Link = Rhs[t, type, cs];
            RETURN[Safen[v, VProp[], cs, type]]};

        ConsOp: PROC[t: Tree.Link] RETURNS[BOOL] = {
            RETURN[SELECT OpName[t] FROM
                construct, union, rowcons, all => TRUE,
                cast, pad => ConsOp[NthSon[t, 1]],
                ENDCASE => FALSE]};

        Safen: PROC[t: Tree.Link, prop: Prop, cs: ConsState, type: Type] RETURNS[Tree.Link] = {
            PushTree[t];
            IF ~prop.noXfer OR (~prop.noAssign AND RCType[type] # none)
                OR (cs=$rest AND ~prop.noSelect AND ~prop.immutable) THEN
                    IF ~ConsOp[t] THEN {
                        PushNode[safen, 1]; SetInfo[type]; SetAttr[1, cs=$rest]; SetAttr[2, ~prop.noXfer]};
            RETURN[PopTree[]]};


        MakeRecord: PROC[record: RecordSEIndex, expList: Tree.Link, cs: ConsState]
              RETURNS[val: Tree.Link] = {
            sei: ISEIndex;
            const: BOOL _ TRUE;
            prop: Prop _ voidProp;
            nRegs: RegCount _ 0;

            EvaluateField: Tree.Map = {
                type: Type = seb[sei].idType;
                IF t = Tree.Null THEN {
                    v _ Tree.Null;
                    IF BitsForType[type] # 0 OR VariantType[type] THEN const _ FALSE}
                ELSE {
                    v _ FieldRhs[t, type, cs];
                    IF ~TreeLiteral[v] THEN
                        WITH v SELECT FROM
                            subtree =>
                                SELECT tb[index].name FROM
                                    mwconst => NULL;
                                    union => IF ~tb[index].attr1 THEN const _ FALSE;
                                    ENDCASE => const _ FALSE;
                            ENDCASE => const _ FALSE;
                    prop _ CommonProp[VProp[], prop];  nRegs _ MAX[VRegs[], nRegs];  VPop[];
                    IF cs = $first THEN cs _ $rest};
                sei _ NextSe[sei];
                RETURN};

            sei _ FirstVisibleSe[seb[record].fieldCtx];
            val _ UpdateList[expList, EvaluateField];
            IF OpName[val] = list THEN {
                subNode: Tree.Index = GetNode[val];
                tb[subNode].attr1 _ const};
            VPush[BiasForType[record], [prop: prop, rep: other], nRegs];
            RETURN};

            VariantType: PROC[type: Type] RETURNS[BOOL] = INLINE {
                RETURN[SELECT TypeForm[type] FROM
                    $union, $sequence => TRUE,
                    ENDCASE => FALSE]};

        MakeArgRecord: PUBLIC PROC[record: RecordSEIndex, expList: Tree.Link]
              RETURNS[val: Tree.Link] = {
            SELECT TRUE FROM
                (expList = Tree.Null) => {val _ Tree.Null; VPush[0, voidAttr, 0]};
                (record = Symbols.RecordSENull) => {val _ FreeTree[expList]; VPush[0, voidAttr, 0]};
                (OpName[expList] = list) => val _ MakeRecord[record, expList, $init];
                ENDCASE => {
                    type: Type = seb[FirstVisibleSe[seb[record].fieldCtx]].idType;
                    val _ FieldRhs[expList, type, $init]};
            RETURN};


    <<construction of packed values (machine dependent)>>

        WordLength: CARDINAL = Basics.bitsPerWord;
        ByteLength: CARDINAL = Basics.bitsPerByte;


        FillMultiWord: PUBLIC PROC[words: ValueDescriptor, origin: CARDINAL, t: Tree.Link] = {
            desc: Literals.LitDescriptor = TreeLiteralDesc[t];
            IF origin + desc.length <= words.length THEN
                FOR i: CARDINAL IN [0 .. desc.length) DO words[origin+i] _ ltb[desc.offset][i] ENDLOOP};

        PackRecord: PROC[record: RecordSEIndex, expList: Tree.Link] RETURNS[Tree.Link] = {
            n: CARDINAL = WordsForType[record];
            root, type: RecordSEIndex;
            list: Tree.Link;
            sei: ISEIndex;
            offset: CARDINAL;
            words: ValueDescriptor;
            more: BOOL;

            StoreBits: PROC[sei: ISEIndex, value: WORD] = {
                OPEN Basics;
                Masks: ARRAY [0..WordLength] OF WORD =
                    [0b, 1b, 3b, 7b, 17b, 37b, 77b, 177b, 377b, 777b,
                        1777b, 3777b, 7777b, 17777b, 37777b, 77777b, 177777b];
                address: BitAddress;
                size, w, shift: CARDINAL;
                IF seb[root].argument THEN [address, size] _ FnField[sei]
                ELSE {address _ seb[sei].idValue; size _ seb[sei].idInfo};
                w _ address.wd;
                shift _ (WordLength-offset) - (address.bd+size);
                words[w] _ BITOR[words[w], BITSHIFT[BITAND[value, Masks[size]], shift]]};

            PackField: Tree.Scan = {
                node: Tree.Index;
                address: BitAddress;
                typeId: ISEIndex;
                subType: CSEIndex;
                SELECT TRUE FROM
                    t = Tree.Null => NULL;
                    TreeLiteral[t] => StoreBits[sei, TreeLiteralValue[t]];
                    ENDCASE => {
                        node _ GetNode[t];
                        SELECT tb[node].name FROM
                            mwconst => {
                                address _ IF seb[root].argument
                                    THEN FnField[sei].offset
                                    ELSE seb[sei].idValue;
                                FillMultiWord[words, address.wd, tb[node].son[1]]};
                            union => {
                                typeId _ NARROW[tb[node].son[1], Tree.Link.symbol].index;
                                subType _ UnderType[seb[sei].idType];
                                WITH seb[subType] SELECT FROM
                                    union => IF controlled THEN StoreBits[tagSei, seb[typeId].idValue];
                                    ENDCASE => ERROR;
                                type _ LOOPHOLE[UnderType[typeId], RecordSEIndex];
                                list _ tb[node].son[2];  more _ TRUE};
                            ENDCASE => ERROR};
                sei _ NextSe[sei]};

            words _ NEW[WordSeq[n]];
            FOR i: CARDINAL IN [0 .. n) DO words[i] _ 0 ENDLOOP;
            root _ type _ RecordRoot[record];
            offset _ IF seb[record].length < WordLength
                THEN WordLength - seb[record].length
                ELSE 0;
            list _ expList;  more _ TRUE;
            WHILE more DO
                more _ FALSE;  sei _ FirstVisibleSe[seb[type].fieldCtx];
                ScanList[list, PackField];
                ENDLOOP;
            PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], n]]];
            PushNode[IF n=1 THEN cast ELSE mwconst, 1];  SetInfo[record];
            words _ NIL;
            RETURN[PopTree[]]};


        PadRecord: PUBLIC PROC[t: Tree.Link, lType: Type] RETURNS[Tree.Link] = {
            IF StructuredLiteral[t] THEN {
                nW: CARDINAL = WordsForType[lType];
                words: ValueDescriptor;
                node: Tree.Index;
                words _ NEW[WordSeq[nW]];
                FOR w: CARDINAL IN [0 .. nW) DO words[w] _ 0 ENDLOOP;
                IF TreeLiteral[t] THEN words[0] _ TreeLiteralValue[t]
                ELSE {
                    node _ GetNode[t];
                    SELECT tb[node].name FROM
                        mwconst => FillMultiWord[words, 0, tb[node].son[1]];
                        ENDCASE => ERROR;
                    FreeNode[node]};
                PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], nW]]];  PushNode[mwconst, 1];
                words _ NIL}
            ELSE {PushTree[t]; PushNode[pad, 1]};
            SetInfo[lType];
            RETURN[PopTree[]]};


        ExtractValue: PROC[t: Tree.Link, addr: BitAddress, size: CARDINAL, type: Type]
              RETURNS[val: Tree.Link] = {
            words: ValueDescriptor;
            desc: Literals.LitDescriptor = TreeLiteralDesc[t];
            n: CARDINAL = size/WordLength;
            IF n > 1 THEN {
                IF addr.bd # 0 THEN Log.Error[unimplemented];
                words _ NEW[WordSeq[n]];
                FOR i: CARDINAL IN [0..n) DO words[i] _ ltb[desc.offset][addr.wd+i] ENDLOOP;
                PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], n]]];
                PushNode[mwconst, 1];  SetInfo[type];
                words _ NIL;
                val _ PopTree[]}
            ELSE
                val _ MakeStructuredLiteral[
                    Basics.BITSHIFT[
                        Basics.BITSHIFT[ltb[desc.offset][addr.wd], addr.bd],
                        -(WordLength - size)],
                    type];
            RETURN};


        UnpackField: PROC[t: Tree.Link, field: ISEIndex] RETURNS[val: Tree.Link] = {
            rType: CSEIndex = OperandStruct[t];
            addr: BitAddress;
            addr _ seb[field].idValue;
            WITH r: seb[rType] SELECT FROM
                record =>
                    IF r.length < WordLength THEN addr.bd _ addr.bd + (WordLength - r.length);
                ENDCASE => ERROR;
            RETURN[ExtractValue[t, addr, seb[field].idInfo, seb[field].idType]]};

        UnpackElement: PROC[t: Tree.Link, i: CARDINAL] RETURNS[val: Tree.Link] = {
            aType: CSEIndex = OperandStruct[t];
            cType: Type;
            addr: BitAddress;
            nB, nW: CARDINAL;
            WITH a: seb[aType] SELECT FROM
                array => {
                    cType _ a.componentType;
                    nB _ BitsPerElement[cType, a.packed];
                    IF nB > ByteLength THEN {
                        nW _ (nB+(WordLength-1))/WordLength;
                        addr _ [wd:i*nW, bd:0];  nB _ nW*WordLength}
                    ELSE {
                        itemsPerWord: CARDINAL = WordLength/nB;
                        offset: CARDINAL = IF WordsForType[aType] = 1
                            THEN WordLength - CARDINAL[BitsForType[aType]]
                            ELSE 0;
                        addr _ [wd: i/itemsPerWord, bd: offset + (i MOD itemsPerWord)*nB]}};
                ENDCASE => ERROR;
            RETURN[ExtractValue[t, addr, nB, cType]]};


    <<operators>>

        Substx: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            type: Type = tb[node].info;
            IF OpName[tb[node].son[2]] = result THEN {
                saveChecked: BOOL = checked;
                subNode: Tree.Index = GetNode[tb[node].son[2]];
                IF ~tb[node].attr3 THEN checked _ tb[node].attr1;
                tb[node].son[1] _ NeutralExp[tb[node].son[1]];
                SELECT ListLength[tb[subNode].son[1]] FROM
                    0 => ERROR;
                    1 =>
                        val _ --IF tb[subNode].attr3
                            <<THEN tb[subNode].son[1]>>
                            --ELSE-- ForceType[tb[subNode].son[1], type];
                    ENDCASE => {
                        PushTree[Tree.Null];  PushTree[tb[subNode].son[1]];
                        PushNode[construct, 2];  SetInfo[type];  val _ PopTree[]};
                tb[subNode].son[1] _ Tree.Null;  FreeNode[node];
                val _ Rhs[val, type, $init];
                checked _ saveChecked}
            ELSE {
                val _ Subst[node];
                VPush[BiasForType[type], [prop: emptyProp, rep: RepForType[type]], maxRegs]};
            RETURN};


        Call: PUBLIC PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            OPEN tb[node];
            type: CSEIndex;
            prop: Prop;
            son[1] _ Exp[son[1], none];  prop _ VProp[];  VPop[];
            type _ OperandStruct[son[1]];
            WITH t: seb[type] SELECT FROM
                transfer => {
                    IF attr1 AND name # xerror AND t.typeIn # Symbols.RecordSENull THEN
                        son[2] _ Rhs[son[2], t.typeIn, $init]
                    ELSE son[2] _ MakeArgRecord[ArgRecord[t.typeIn], son[2]];
                    prop _ CommonProp[prop, VProp[]]; VPop[];
                    prop.noXfer _ prop.noAssign _ prop.noFreeVar _ FALSE;
                    IF nSons > 2 THEN CatchNest[son[3]];
                    VPush[BiasForType[t.typeOut], [prop: prop, rep: RepForType[t.typeOut]], maxRegs]};
                ENDCASE => ERROR;
            RETURN[[subtree[index: node]]]};


        Construct: PUBLIC PROC[node: Tree.Index, cs: ConsState] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            type: RecordSEIndex = LOOPHOLE[UnderType[info]];
            record: RecordSEIndex = RecordRoot[type];
            prop: Prop;
            nRegs: RegCount;
            k: RegCount = RegsForType[type];
            SELECT TRUE FROM
                (OpName[son[2]] = list) => {
                    subNode: Tree.Index;
                    son[2] _ MakeRecord[record, son[2], cs];  nRegs _ VRegs[];  prop _ VProp[];
                    subNode _ GetNode[son[2]];
                    IF ~tb[subNode].attr1 THEN {    -- ~all fields constant
                        tb[node].attr3 _ tb[subNode].attr3;
                        val _ [subtree[index: node]]; nRegs _ MAX[nRegs, k]}
                    ELSE {val _ PackRecord[type, son[2]]; FreeNode[node]; nRegs _ k};
                    VPop[];  VPush[0, [prop: prop, rep: other], nRegs]};
                (son[2] = Tree.Null) => {
                    val _ Tree.Null;  VPush[0, [prop: voidProp, rep: other], k]};
                (OpName[son[2]] = union) => {
                    son[2] _ Union[GetNode[son[2]], cs];
                    IF OpName[son[2]] = union THEN {
                        subNode: Tree.Index = GetNode[son[2]];
                        IF tb[subNode].attr1 THEN {val _ PackRecord[type, son[2]]; FreeNode[node]}
                        ELSE val _ [subtree[index: node]]}
                    ELSE {val _ ForceType[son[2], type]; son[2] _ Tree.Null; FreeNode[node]}};
                ENDCASE => val _ CastUniList[node, type, cs, record];
            RETURN};

        Union: PUBLIC PROC[node: Tree.Index, cs: ConsState] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            vSei: ISEIndex = NARROW[son[1], Tree.Link.symbol].index;
            type: RecordSEIndex = LOOPHOLE[UnderType[vSei]];
            tSei: CSEIndex = UnderType[info];
            tagged: BOOL = (WITH t: seb[tSei] SELECT FROM union => t.controlled, ENDCASE => FALSE);
            attr: Attr;
            nRegs: RegCount;
            attr2 _ tagged;
            SELECT TRUE FROM
                (OpName[son[2]] = list OR OpName[son[2]] = union) => {
                    son[2] _ MakeRecord[type, son[2], cs];  nRegs _ VRegs[];  attr _ VAttr[];
                    attr1 _ WITH son[2] SELECT FROM subtree => tb[index].attr1, ENDCASE => FALSE;
                    val _ [subtree[index: node]];  VPop[];  attr.rep _ other;  VPush[0, attr, nRegs]};
                (son[2] = Tree.Null) => {
                    attr1 _ TRUE; val _ [subtree[index: node]];
                    VPush[0, [prop: voidProp, rep: other], 1]};
                ENDCASE =>
                    IF (~tagged OR seb[vSei].idValue = 0) AND WordsForType[type] = 1
                        AND ZeroOffset[IF tagged THEN TagSei[tSei] ELSE FirstVisibleSe[seb[type].fieldCtx]]
                        THEN val _ CastUniList[node, tSei, cs, type]
                    ELSE {
                        son[2] _ MakeRecord[type, son[2], cs];  attr _ VAttr[];
                        attr1 _ StructuredLiteral[son[2]];
                        val _ [subtree[index: node]];
                        VPop[];  attr.rep _ other;  VPush[0, attr, RegsForType[type]]};
            RETURN};

        TagSei: PROC[tSei: CSEIndex] RETURNS[ISEIndex] = INLINE {
            RETURN[WITH seb[tSei] SELECT FROM union => tagSei, ENDCASE => Symbols.ISENull]};

        ZeroOffset: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
            RETURN[sei # Symbols.ISENull AND seb[sei].idValue = BitAddress[0, 0]]};

        CastUniList: PROC[node: Tree.Index, type: CSEIndex, cs: ConsState, rType: RecordSEIndex]
              RETURNS[val: Tree.Link] = {
            target: Type = seb[FirstVisibleSe[seb[rType].fieldCtx]].idType;
            prop: Prop;
            nRegs: RegCount;
            val _ ForceType[FieldRhs[tb[node].son[2], target, cs], type];
            prop _ VProp[];  nRegs _ VRegs[];  VPop[];
            tb[node].son[2] _ Tree.Null;  FreeNode[node];
            VPush[BiasForType[type], [prop: prop, rep: RepForType[type]], nRegs];
            RETURN};


        RowConstruct: PUBLIC PROC[node: Tree.Index, cs: ConsState] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            aType: Symbols.ArraySEIndex = LOOPHOLE[UnderType[info]];
            cType: Type = seb[aType].componentType;
            n: CARDINAL = Cardinality[seb[aType].indexType];
            const, strings, lstrings: BOOL;
            prop: Prop _ voidProp;
            nRegs: RegCount _ 0;
            l: CARDINAL;

            EvalElement: Tree.Map = {
                IF t = Tree.Null THEN {v _ Tree.Null; const _ strings _ lstrings _ FALSE}
                ELSE {
                    v _ FieldRhs[t, cType, cs];
                    IF TreeLiteral[v] THEN strings _ lstrings _ FALSE
                    ELSE
                        WITH v SELECT FROM
                            subtree =>
                                SELECT tb[index].name FROM
                                    mwconst => strings _ lstrings _ FALSE;
                                    ENDCASE => const _ strings _ lstrings _ FALSE;
                            literal =>
                                WITH index SELECT FROM
                                    string => {
                                        const _ FALSE;
                                        IF LiteralOps.MasterString[sti] = sti THEN lstrings _ FALSE
                                        ELSE strings _ FALSE};
                                    ENDCASE;
                            ENDCASE => const _ strings _ lstrings _ FALSE;
                    prop _ CommonProp[VProp[], prop];  nRegs _ MAX[VRegs[], nRegs];  VPop[];
                    IF cs = $first THEN cs _ $rest};
                RETURN};

            w, nW: CARDINAL;
            words: ValueDescriptor;
            bitsLeft: CARDINAL;
            bitCount: CARDINAL;

            PackElement: Tree.Scan = {
                IF TreeLiteral[t] THEN {
                    bitsLeft _ bitsLeft - bitCount;
                    words[w] _ Basics.BITOR[words[w],
                        Basics.BITSHIFT[TreeLiteralValue[t], bitsLeft]];
                    IF bitsLeft < bitCount THEN {w _ w+1; bitsLeft _ WordLength}}
                ELSE {
                    node: Tree.Index = GetNode[t];
                    SELECT tb[node].name FROM
                        mwconst => {
                            FillMultiWord[words, w, tb[node].son[1]];
                            w _ w + WordsForType[cType]};
                        ENDCASE => ERROR}};

            SELECT (l _ ListLength[son[2]]) FROM
                = n => NULL;
                > n => Log.ErrorN[listLong, l-n];
                < n => Log.ErrorN[listShort, n-l];
                ENDCASE;
            const _ strings _ lstrings _ TRUE;  nRegs _ 0;
            son[2] _ UpdateList[son[2], EvalElement];
            IF const AND l = n THEN {
                nW _ WordsForType[aType];
                words _ NEW[WordSeq[nW]];
                FOR w: CARDINAL IN [0 .. nW) DO words[w] _ 0 ENDLOOP;
                bitCount _ BitsPerElement[cType, seb[aType].packed];
                w _ 0;  bitsLeft _ IF nW = 1 THEN CARDINAL[BitsForType[aType]] ELSE WordLength;
                ScanList[son[2], PackElement];  FreeNode[node];
                PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], nW]]];
                PushNode[IF nW = 1 THEN cast ELSE mwconst, 1];  SetInfo[aType];
                words _ NIL;
                val _ PopTree[];  nRegs _ RegsForType[aType]}
            ELSE {
                IF (attr1 _ strings # lstrings) THEN prop.noFreeVar _ FALSE;
                val _ [subtree[index: node]]};
            VPush[0, [prop: prop, rep: other], nRegs];  RETURN};

        All: PUBLIC PROC[node: Tree.Index, cs: ConsState] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            aType: Symbols.ArraySEIndex = LOOPHOLE[UnderType[info]];
            cType: Type = seb[aType].componentType;
            prop: Prop;
            val _ [subtree[index: node]];
            IF son[1] = Tree.Null THEN prop _ voidProp
            ELSE {
                son[1] _ FieldRhs[son[1], cType, cs];
                IF TreeLiteral[son[1]] AND WordsForType[aType] = 1 THEN {
                    nB: CARDINAL = BitsPerElement[cType, seb[aType].packed];
                    v, w: WORD;
                    v _ TreeLiteralValue[son[1]];  w _ 0;
                    THROUGH [1 .. Cardinality[seb[aType].indexType]] DO
                        w _ Basics.BITOR[Basics.BITSHIFT[w, nB], v] ENDLOOP;
                    val _ ForceType[MakeTreeLiteral[w], aType];  FreeNode[node]}
                ELSE IF OperandType[son[1]] # cType THEN son[1] _ ForceType[son[1], cType];
                prop _ VProp[];  VPop[]};
            VPush[0, [prop: prop, rep: other], RegsForType[aType]];
            RETURN};


        Dot: PUBLIC PROC[node: Tree.Index, target: Repr] RETURNS[Tree.Link] = {
            OPEN tb[node];
            prop: Prop;
            attr: Attr;
            bias: INTEGER;
            nRegs: RegCount;
            son[1] _ RValue[son[1], 0, unsigned];
            prop _ VProp[];  prop.noSelect _ prop.noFreeVar _ FALSE;
            nRegs _ MAX[RegsForType[info], VRegs[]];  VPop[];
            son[2] _ Exp[son[2], target];
            attr _ VAttr[];  bias _ VBias[];  VPop[];
            attr.prop _ CommonProp[attr.prop, prop];
            attr1 _ ~attr3 AND (checked OR dataPtr.switches['n]);
            VPush[bias, attr, nRegs];
            RETURN[[subtree[index: node]]]};

        Dollar: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            attr: Attr;
            immutable: BOOL;
            bias: INTEGER;
            nRegs: RegCount;
            k: RegCount = RegsForType[info];
            son[1] _ RValue[son[1], BiasForType[OperandType[son[1]]], none];
            nRegs _ VRegs[]; attr.prop _ VProp[]; immutable _ attr.prop.immutable; VPop[];
            son[2] _ Exp[son[2], none];  attr.rep _ VRep[];  bias _ VBias[];
            IF ~StructuredLiteral[son[1]] THEN {
                val _ [subtree[index: node]]; nRegs _ MAX[nRegs, k];
                attr.prop _ CommonProp[attr.prop, VProp[]];
                attr.prop.noSelect _ FALSE; attr.prop.immutable _ immutable}
            ELSE {
                val _ UnpackField[son[1], NARROW[son[2], Tree.Link.symbol].index];
                FreeNode[node]; nRegs _ k};
            VPop[];
            VPush[bias, attr, nRegs];  RETURN};


        Index: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            OPEN tb[node];
            iType, cType: Type;
            next: Type;
            prop: Prop;
            immutable: BOOL;
            nRegs: RegCount;
            son[1] _ Exp[son[1], none];  prop _ VProp[];  immutable _ prop.immutable;
            FOR aType: CSEIndex _ OperandStruct[son[1]], UnderType[next] DO
                WITH seb[aType] SELECT FROM
                    array => {iType _ indexType; cType _ componentType; EXIT};
                    arraydesc => next _ describedType;
                    long => next _ rangeType;
                    ENDCASE => ERROR;
                ENDLOOP;
            IF WordsForType[cType] > OpWordCount.LAST THEN
                Log.ErrorTree[operandSize, [subtree[node]]];
            IF name = dindex THEN {
                son[2] _ RValue[son[2], BiasForType[iType], unsigned];
                attr1 _ checked OR dataPtr.switches['n];
                attr3 _ checked OR dataPtr.switches['b]}
            ELSE son[2] _ Rhs[son[2], iType, $init, TRUE];
            prop _ CommonProp[prop, VProp[]];
            SELECT TRUE FROM
                (TreeLiteral[son[2]] AND OpName[son[1]] = all) => {
                    subNode: Tree.Index = GetNode[son[1]];
                    val _ tb[subNode].son[1];
                    tb[subNode].son[1] _ Tree.Null;  FreeNode[node];
                    nRegs _ RegsForType[cType]};
                (TreeLiteral[son[2]] AND StructuredLiteral[son[1]] AND name = index) => {
                    val _ UnpackElement[son[1], TreeLiteralValue[son[2]]]; FreeNode[node];
                    nRegs _ RegsForType[cType]};
                ENDCASE => {
                    val _ [subtree[index:node]];
                    nRegs _ ComputeIndexRegs[node];
                    prop.noSelect _ FALSE; prop.immutable _ immutable};
            VPop[]; VPop[];
            VPush[BiasForType[cType], [prop: prop, rep: RepForType[cType]], nRegs];
            RETURN};

        SeqIndex: PUBLIC PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            OPEN tb[node];
            sType: CSEIndex;
            iType, cType: Type;
            prop: Prop;
            nRegs: RegCount;
            son[1] _ Exp[son[1], none];  prop _ VProp[];
            sType _ OperandStruct[son[1]];
            WITH t: seb[sType] SELECT FROM
                sequence => {
                    iType _ seb[t.tagSei].idType; cType _ t.componentType;
                    attr3 _ t.controlled AND (checked OR dataPtr.switches['b])};
                array => {
                    iType _ UnderType[t.indexType]; cType _ UnderType[t.componentType];
                    attr3 _ checked OR dataPtr.switches['b]};
                ENDCASE;
            IF WordsForType[cType] > OpWordCount.LAST THEN
                Log.ErrorTree[operandSize, [subtree[node]]];
            son[2] _ RValue[son[2], BiasForType[iType], TargetRep[RepForType[iType]]];
            nRegs _ ComputeIndexRegs[node];
            prop _ CommonProp[prop, VProp[]]; prop.noSelect _ FALSE;  VPop[]; VPop[];
            VPush[BiasForType[cType], [prop: prop, rep: RepForType[cType]], nRegs];
            RETURN[[subtree[index:node]]]};

        Reloc: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            prop: Prop;
            nRegs: RegCount;
            type: Type = tb[node].info;
            tb[node].son[1] _ RValue[tb[node].son[1], 0, unsigned];  prop _ VProp[];
            tb[node].son[2] _ RValue[tb[node].son[2], 0, unsigned];  prop _ CommonProp[prop, VProp[]];
            nRegs _ ComputeIndexRegs[node];  VPop[]; VPop[];
            IF ~tb[node].attr1 AND ZeroP[tb[node].son[1]] THEN {
                rType: Type;
                subType, next: CSEIndex;
                FOR subType _ OperandStruct[tb[node].son[2]], next DO    -- CanonicalType
                    WITH r: seb[subType] SELECT FROM
                        relative => {
                            rType _ r.resultType;
                            PushTree[tb[node].son[2]];  tb[node].son[2] _ Tree.Null;
                            IF tb[node].attr2 AND seb[UnderType[r.offsetType]].typeTag # long THEN {
                                PushNode[lengthen, 1];
                                SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE]}
                            ELSE PushNode[cast, 1];
                            EXIT};
                        record => next _ UnderType[seb[FirstVisibleSe[r.fieldCtx]].idType];
                        ENDCASE => ERROR;
                    ENDLOOP;
                SetInfo[rType];
                PushNode[uparrow, 1];  SetInfo[type];
                SetAttr[1, dataPtr.switches['n]];  SetAttr[2, tb[node].attr2];
                val _ PopTree[];  FreeNode[node]}
            ELSE val _ [subtree[node]];
            prop.noSelect _ FALSE;
            VPush[BiasForType[type], [prop: prop, rep: RepForType[type]], nRegs];
            RETURN};


        Assignment: PUBLIC PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            OPEN tb[node];
            lhsType: Type;
            bias: INTEGER;
            attr: Attr;
            nRegs: RegCount;
            son[1] _ Exp[son[1], none];
            bias _ VBias[]; attr _ VAttr[]; nRegs _ VRegs[];
            lhsType _ OperandType[son[1]];
            son[2] _ Rhs[son[2], lhsType, $first];
            attr.prop _ CommonProp[attr.prop, VProp[]]; attr.prop.noAssign _ FALSE;
            VPop[]; VPop[];  VPush[bias, attr, nRegs];
            RETURN[RewriteAssign[node, lhsType]]};

        Extract: PUBLIC PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            subNode: Tree.Index = GetNode[tb[node].son[1]];
            rType: RecordSEIndex = LOOPHOLE[UnderType[tb[subNode].info]];
            prop: Prop _ voidProp;
            sei: ISEIndex;

            AssignItem: Tree.Map = {
                type: Type;
                saveType: Type = passPtr.implicitType;
                saveBias: INTEGER = passPtr.implicitBias;
                saveAttr: Attr = passPtr.implicitAttr;
                IF t = Tree.Null THEN v _ Tree.Null
                ELSE {
                    subNode: Tree.Index = GetNode[t];
                    type _ seb[sei].idType;
                    passPtr.implicitType _ type;
                    passPtr.implicitBias _ BiasForType[type];  passPtr.implicitAttr.rep _ RepForType[type];
                    v _ IF tb[subNode].name = extract THEN Extract[subNode] ELSE Assignment[subNode];
                    prop _ CommonProp[prop, VProp[]];  VPop[]};
                sei _ NextSe[sei];
                passPtr.implicitAttr _ saveAttr;  passPtr.implicitBias _ saveBias;
                passPtr.implicitType _ saveType;  RETURN};

            sei _ FirstVisibleSe[seb[rType].fieldCtx];
            tb[subNode].son[1] _ UpdateList[tb[subNode].son[1], AssignItem];
            tb[node].son[2] _ Exp[tb[node].son[2], none];  prop _ CommonProp[prop, VProp[]];  VPop[];
            VPush[BiasForType[rType], [prop: prop, rep: RepForType[rType]], maxRegs];
            RETURN[[subtree[index:node]]]};


        New: PUBLIC PROC[node: Tree.Index] RETURNS[Tree.Link] = {
            OPEN tb[node];
            prop: Prop _ voidProp;
            IF son[1] # Tree.Null THEN {son[1] _ Exp[son[1], none]; prop _ VProp[]; VPop[]};
            IF OpName[son[2]] = apply THEN {
                subNode: Tree.Index = GetNode[son[2]];
                type: Type;
                vSei: ISEIndex;
                TypeExp[tb[subNode].son[1]];  type _ TypeForTree[tb[subNode].son[1]];
                tb[subNode].son[2] _ Rhs[tb[subNode].son[2], dataPtr.idCARDINAL, $init];
                prop _ CommonProp[prop, VProp[]];  VPop[];
                vSei _ VariantField[UnderType[type]];
                IF vSei # Symbols.ISENull THEN {
                    vType: CSEIndex = UnderType[seb[vSei].idType];
                    subType: Type = OperandType[tb[subNode].son[2]];
                    n: LONG CARDINAL = WITH t: seb[vType] SELECT FROM
                        sequence => MIN[
                            Cardinality[seb[t.tagSei].idType],
                            MaxCardinality[t.componentType, t.packed, OpWordCount.LAST-WordsForType[type]]]
                        ENDCASE => 0;
                    IF EqTypes[subType, dataPtr.typeINT] OR ~(Cardinality[subType] IN [1..n]) THEN  -- (0..n]
                        tb[subNode].son[2] _ CheckRange[tb[subNode].son[2], n, dataPtr.idCARDINAL]}}
            ELSE {
                TypeExp[son[2], OpName[son[3]] = body];
                IF WordsForType[UnderType[TypeForTree[son[2]]]] > OpWordCount.LAST THEN
                    Log.ErrorTree[operandSize, [subtree[node]]]};
            SELECT OpName[son[3]] FROM
                body => {
                    expNode: Tree.Index = GetNode[son[3]];
                    PushNode[body, 0];  SetInfo[tb[expNode].info];  son[3] _ PopTree[]};
                signalinit => NULL;
                ENDCASE =>
                    IF son[3] # Tree.Null THEN {
                        type: Type = TypeForTree[son[2]];
                        subProp: Prop;
                        son[3] _ Rhs[son[3], type, $init];  subProp _ VProp[];  VPop[];
                        IF attr3 THEN son[3] _ Safen[son[3], subProp, $init, type];
                        prop _ CommonProp[prop, subProp]};
            IF nSons > 3 THEN CatchNest[son[4]];
            prop.noXfer _ prop.noFreeVar _ FALSE;  VPush[0, [prop: prop, rep: unsigned], maxRegs];
            RETURN[[subtree[index:node]]]};


        ListCons: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            OPEN tb[node];

            ItemType: PROC[nType: Type] RETURNS[Type] = INLINE {
                sei: CSEIndex = UnderType[nType];
                RETURN[WITH r: seb[sei] SELECT FROM
                    record => seb[FirstCtxSe[r.fieldCtx]].idType,
                    ENDCASE =>  Symbols.typeANY]
                };

            cType: Type = ItemType[ReferentType[info]];
            prop: Prop _ voidProp;

            EvalElement: Tree.Map = {
                IF t = Tree.Null THEN v _ Tree.Null
                ELSE {
                    subProp: Prop;
                    v _ Rhs[t, cType, $init];  subProp _ VProp[];  VPop[];
                    IF attr3 THEN v _ Safen[v, subProp, $init, cType];
                    prop _ CommonProp[prop, subProp]};
                RETURN};

            IF son[1] # Tree.Null THEN {son[1] _ Exp[son[1], none]; prop _ VProp[]; VPop[]};
            IF WordsForType[cType] > OpWordCount.LAST THEN
                Log.ErrorTree[operandSize, [subtree[node]]];
            IF ListLength[son[2]] = 0 THEN {
                PushTree[Tree.Null];  PushNode[nil, 1];  SetInfo[info];
                val _ Exp[PopTree[], RepForType[UnderType[info]]];
                FreeNode[node]}
            ELSE {
                son[2] _ UpdateList[son[2], EvalElement];
                prop.noXfer _ prop.noFreeVar _ FALSE;  VPush[0, [prop: prop, rep: unsigned], maxRegs];
                val _ [subtree[index:node]]};
            RETURN};


        Narrow: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            type: Type = tb[node].info;
            IF tb[node].son[2] # Tree.Null THEN TypeExp[tb[node].son[2]];
            IF tb[node].attr2 OR tb[node].attr3 THEN {
                OPEN tb[node];
                prop: Prop;
                son[1] _ RValue[son[1], 0, RepForType[OperandType[son[1]]]];
                prop _ VProp[];  prop.noXfer _ FALSE;  VPop[];
                IF nSons > 2 THEN CatchNest[son[3]];
                val _ [subtree[index: node]];
                VPush[BiasForType[type], [prop: prop, rep: RepForType[type]], maxRegs]}
            ELSE {
                val _ Rhs[tb[node].son[1], type, $init];
                tb[node].son[1] _ Tree.Null;  FreeNode[node];
                IF ~EqTypes[OperandType[val], type] THEN val _ ForceType[val, type]}
            };


        TargetRep: --PUBLIC-- PROC[rep: Repr] RETURNS[Repr] = INLINE {
            RETURN[--IF rep = both THEN signed ELSE-- rep]};


        Rhs: PUBLIC PROC[exp: Tree.Link, lhsType: Type, cs: ConsState, voidOK: BOOL_FALSE]
              RETURNS[val: Tree.Link] = {
            lType: CSEIndex = UnderType[lhsType];
            rType: CSEIndex = OperandStruct[exp];
            lBias: INTEGER = BiasForType[lType];
            lRep: Repr = RepForType[lType];
            nw: Symbols.WordCount = WordsForType[lType];
            rRep: Repr;
            WITH exp SELECT FROM
                subtree => {
                    node: Tree.Index = index;
                    val _ SELECT tb[node].name FROM
                        construct => Construct[node, cs],
                        union => Union[node, cs],
                        rowcons => RowConstruct[node, cs],
                        all => All[node, cs],
                        ENDCASE => RValue[exp, lBias, TargetRep[lRep]]};
                ENDCASE => val _ RValue[exp, lBias, TargetRep[lRep]];
            rRep _ VRep[];
            IF ~Types.Assignable[[dataPtr.ownSymbols, lType], [dataPtr.ownSymbols, rType]] THEN
                Log.ErrorType[typeClash, val, [dataPtr.ownSymbols, lhsType]];
            IF ~(IF nw = 0 THEN voidOK ELSE WordsForType[rType] = nw) THEN
                SELECT TRUE FROM
                    (seb[lType].typeTag = record) AND (seb[rType].typeTag = record) =>
                        val _ PadRecord[val, lType];
                    (seb[lType].typeTag = union) AND (seb[rType].typeTag = union) => NULL;
                    ENDCASE => Log.ErrorTree[sizeClash, val];
            IF nw > OpWordCount.LAST THEN Log.ErrorTree[operandSize, val];
            IF (lType = dataPtr.typeINT AND rRep = unsigned) OR
                ((rType = dataPtr.typeINT AND rRep = signed) AND lRep = unsigned) THEN
                val _ CheckRange[val, CARDINAL[INTEGER.LAST-lBias]+1, lType]
            ELSE
                SELECT seb[lType].typeTag FROM
                    subrange, enumerated, relative =>
                        SELECT Cover[lType, lRep, rType, rRep] FROM
                            $full => NULL;
                            $partial => val _ CheckRange[val, Cardinality[lType], lType];
                            ENDCASE => IF nw # 0 THEN val _ BoundsFault[val, lType];
                    basic =>
                        IF lType = dataPtr.typeCHAR AND (rRep # both OR TreeLiteral[val]) THEN
                            val _ CheckRange[val, Cardinality[lType], lType];
                    long =>
                        IF (lRep=signed AND rRep=unsigned) OR (lRep=unsigned AND rRep=signed) THEN
                            val _ CheckRange[val, CARDINAL[INTEGER.LAST]+1, lType];
                    ENDCASE => NULL;
            RETURN};


        Cover: PUBLIC PROC[lType: Type, lRep: Repr, rType: Type, rRep: Repr]
              RETURNS[Covering] = {
            lLb, lUb, rLb, rUb: LONG INTEGER;
            [lLb, lUb] _ Bounds[lType, lRep];
            [rLb, rUb] _ Bounds[rType, rRep];
            RETURN[
                IF lLb <= rLb
                    THEN IF lUb < rLb THEN $none ELSE IF lUb < rUb THEN $partial ELSE $full
                    ELSE IF lLb <= rUb THEN $partial ELSE $none]
            };

        Bounds: PROC[type: Type, rep: Repr] RETURNS[lb, ub: LONG INTEGER] = {
            sei: CSEIndex = UnderType[type];
            WITH t: seb[sei] SELECT FROM
                subrange => {lb _ t.origin; ub _ lb + t.range};
                enumerated => {lb _ 0; ub _ t.nValues-1};
                relative => [lb, ub] _ Bounds[UnderType[t.offsetType], rep];
                ENDCASE =>
                    SELECT rep FROM
                        signed => {lb _ -INTEGER.LAST-1; ub _ INTEGER.LAST};
                        both => {lb _ 0;  ub _ INTEGER.LAST};
                        ENDCASE => {lb _ 0;  ub _ CARDINAL.LAST};
            RETURN};

        CheckRange: PUBLIC PROC[t: Tree.Link, bound: CARDINAL, type: Type]
              RETURNS[val: Tree.Link] = {
            SELECT TRUE FROM
                (bound = 0) => val _ t;
                TreeLiteral[t] =>
                    val _ IF TreeLiteralValue[t] >= bound THEN BoundsFault[t,type] ELSE t;
                (checked OR dataPtr.switches['b]) AND ~Bounded[t, bound] => {
                    PushTree[MakeTreeLiteral[bound]];  PushTree[t];
                    PushNode[check,-2];  SetInfo[type];  val _ PopTree[]};
                ENDCASE => val _ t;
            RETURN};

        Bounded: PROC[t: Tree.Link, bound: CARDINAL] RETURNS[BOOL] = INLINE {
            IF OpName[t] = mod AND ~GetAttr[t, 3] THEN {
                t2: Tree.Link = NthSon[t, 2];
                RETURN[TreeLiteral[t2] AND TreeLiteralValue[t2] IN [0..bound]]}
            ELSE RETURN[FALSE]};

        BoundsFault: PROC[t: Tree.Link, type: Type] RETURNS[Tree.Link] = {
            Log.ErrorTree[boundsFault, AdjustBias[t, -BiasForType[type]]];
            PushTree[t];
            <<-- PushTree[MakeTreeLiteral[0]]; PushNode[check, 2]; SetInfo[type];>>
            RETURN[PopTree[]]};


        RewriteAssign: PUBLIC PROC[node: Tree.Index, lType: Type] RETURNS[Tree.Link] = {
            IF TypeForm[lType] = $union THEN {
                WITH tb[node].son[1] SELECT FROM
                    subtree => {
                        subNode: Tree.Index = index;
                        SELECT tb[subNode].name FROM
                            dot => {
                                PushTree[tb[subNode].son[1]];  PushNode[uparrow, 1];
                                SetInfo[ReferentType[OperandType[tb[subNode].son[1]]]];
                                tb[subNode].son[1] _ PopTree[];
                                tb[subNode].name _ dollar};
                            dollar => NULL;
                            ENDCASE => NULL};    -- flagged by code generators for now
                    ENDCASE => NULL};    -- flagged by code generators for now
            IF tb[node].name = assignx THEN tb[node].info _ OperandType[tb[node].son[1]];
            RETURN[[subtree[index: node]]]};

        }.