
    <<Pass4Ops.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 17, 1986 10:45:04 am PST>>
        <<Russ Atkinson (RRA) March 6, 1985 10:54:56 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Notifier],
        Literals: TYPE USING [Base, LitDescriptor, ltType],
        LiteralOps: TYPE USING [DescriptorValue, Find, FindDescriptor, Value],
        Log: TYPE USING [ErrorTree, WarningTree],
        P4: TYPE USING [RelOp, Repr, none, unsigned, both, other, CommonRep],
        Pass4: TYPE USING [tFALSE, tTRUE],
        Real: TYPE USING [Abs, RealException, Negate, PairToReal],
        Symbols: TYPE USING [Type],
        Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType],
        TreeOps: TYPE USING [FreeNode, GetNode, PopTree, PushLit, PushNode, ScanList, SetInfo, UpdateList];

    Pass4Ops: PROGRAM
        IMPORTS LiteralOps, Log, P4, Real, TreeOps, passPtr: Pass4
        EXPORTS P4 = {
        OPEN TreeOps;

        LS: TYPE = LONG INTEGER;
        LU: TYPE = LONG CARDINAL;

        RelOp: TYPE = P4.RelOp;
        Repr: TYPE = P4.Repr;

        tb: Tree.Base;    -- tree base address (local copy)
        ltb: Literals.Base;    -- literal table base address (local copy)

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


    <<literals>>

        TreeLiteral: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
            RETURN[WITH t SELECT FROM
                literal => index.litTag = word,
                subtree =>
                    SELECT tb[index].name FROM
                        cast => TreeLiteral[tb[index].son[1]],
                        ENDCASE => FALSE,
                ENDCASE => FALSE]};

        TreeLiteralValue: PUBLIC PROC[t: Tree.Link] RETURNS[WORD] = {
            WITH e:t SELECT FROM
                literal =>
                    WITH e.index SELECT FROM
                        word => RETURN[LiteralOps.Value[lti]];
                        ENDCASE;
                subtree => {
                    node: Tree.Index = e.index;
                    SELECT tb[node].name FROM
                        cast => RETURN[TreeLiteralValue[tb[node].son[1]]];
                        ENDCASE};
                ENDCASE;
            ERROR};

        MakeTreeLiteral: PUBLIC PROC[val: WORD] RETURNS[Tree.Link] = {
            RETURN[[literal[LiteralOps.Find[val]]]]};


        StructuredLiteral: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
            RETURN[WITH t SELECT FROM
                literal => index.litTag = word,
                subtree =>
                    SELECT tb[index].name FROM
                        mwconst => TRUE,
                        cast => StructuredLiteral[tb[index].son[1]],
                        ENDCASE => FALSE,
                ENDCASE => FALSE]};


        TreeLiteralDesc: PUBLIC PROC[t: Tree.Link] RETURNS[Literals.LitDescriptor] = {
            WITH t SELECT FROM
                literal =>
                    WITH index SELECT FROM
                        word => RETURN[LiteralOps.DescriptorValue[lti]];
                        ENDCASE;
                subtree => {
                    node: Tree.Index = index;
                    SELECT tb[node].name FROM
                        mwconst, cast => RETURN[TreeLiteralDesc[tb[node].son[1]]];
                        ENDCASE};
                ENDCASE;
            ERROR};


        LongLiteralValue: PROC[t: Tree.Link] RETURNS[LONG UNSPECIFIED] = {
            w: ARRAY [0..1] OF WORD;
            desc: Literals.LitDescriptor = TreeLiteralDesc[t];
            IF desc.length # 2 THEN ERROR;
            w[0] _ ltb[desc.offset][0];  w[1] _ ltb[desc.offset][1];
            RETURN[LOOPHOLE[w]]};

        MakeLongLiteral: PROC[val: LONG UNSPECIFIED, type: Symbols.Type] RETURNS[Tree.Link] = {
            w: ARRAY [0..1] OF WORD _ LOOPHOLE[val];
            PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[w]]];
            PushNode[mwconst, 1];  SetInfo[type];
            RETURN[PopTree[]]};


        LiteralRep: PUBLIC PROC[t: Tree.Link, rep: Repr] RETURNS[Repr] = {
            desc: Literals.LitDescriptor;
            RETURN[SELECT TRUE FROM
                rep = P4.other, rep = P4.none => rep,
                TreeLiteral[t] => 
                    IF TreeLiteralValue[t] > 77777b
                        THEN IF rep = P4.both THEN P4.unsigned ELSE rep
                        ELSE P4.both,
                StructuredLiteral[t] =>
                    IF (desc_TreeLiteralDesc[t]).length = 2
                        THEN
                            IF ltb[desc.offset][1] > 77777b
                                THEN IF rep = P4.both THEN P4.unsigned ELSE rep
                                ELSE P4.both
                        ELSE P4.other,
                ENDCASE => rep]};


        BoolTest: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
            RETURN[TreeLiteralValue[t] # 0]};


        IntToReal: PUBLIC PROC[node: Tree.Index] RETURNS[val: Tree.Link] = {
            v: LS = LongLiteralValue[tb[node].son[1]];
            overflow: BOOL _ FALSE;
            r: REAL = Real.PairToReal[v, 0
                ! Real.RealException => {overflow _ TRUE; RESUME}];
            IF overflow THEN {val _ [subtree[node]]; Log.ErrorTree[overflow, val]}
            ELSE {val _ MakeLongLiteral[r, tb[node].info]; FreeNode[node]};
            RETURN};

        signWord: WORD = CARDINAL.LAST;

        ShortToLong: PUBLIC PROC[node: Tree.Index, rep: Repr] RETURNS[val: Tree.Link] = {
            v: WORD = TreeLiteralValue[tb[node].son[1]];
            w: ARRAY [0..1] OF WORD _ [
                v, IF P4.CommonRep[rep, P4.unsigned]#P4.none OR v<=maxSS THEN 0 ELSE signWord];
            PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[w]]];
            PushNode[mwconst, 1];  SetInfo[tb[node].info];  FreeNode[node];
            RETURN[PopTree[]]};

        LongToShort: PUBLIC PROC[node: Tree.Index, rep: Repr] RETURNS[val: Tree.Link] = {
            v, w: WORD;
            desc: Literals.LitDescriptor = TreeLiteralDesc[tb[node].son[1]];
            IF desc.length # 2 THEN ERROR;
            v _ ltb[desc.offset][0];  w _ ltb[desc.offset][1];
            IF P4.CommonRep[rep, P4.unsigned] # P4.none THEN {
                IF w # 0 THEN GO TO Overflow}
            ELSE IF (v <= maxSS AND w # 0) OR (v > maxSS AND w # signWord) THEN
                GO TO Overflow;
            val _ MakeTreeLiteral[v];  FreeNode[node];
            EXITS
                Overflow => {val _ [subtree[node]]; Log.ErrorTree[boundsFault, tb[node].son[1]]}};


        ZeroP: PUBLIC PROC[t: Tree.Link] RETURNS[zero: BOOL] = {
            IF ~StructuredLiteral[t] THEN zero _ FALSE
            ELSE {
                desc: Literals.LitDescriptor = TreeLiteralDesc[t];
                zero _ TRUE;
                FOR i: CARDINAL IN [0..desc.length) WHILE (zero_(ltb[desc.offset][i] = 0)) DO
                    NULL ENDLOOP};
            RETURN};


    <<dispatch>>

        Mode: TYPE = {ss, su, ls, lu, other};

        ModeMap: ARRAY Repr OF Mode = [
            ss, ss, su, ss, ls, ls, lu, ls,
            other, ss, su, ss, other, ls, lu, ls];

        InOp: TYPE = Tree.NodeName [in .. notin];
        IntOp: TYPE = Tree.NodeName [intOO .. intCC];

        Test: ARRAY Mode OF PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = [
            TestSS, TestSU, TestLS, TestLU, TestOther];

        UnaryOp: ARRAY Mode OF PROC[node: Tree.Index] RETURNS[Tree.Link] = [
            UnarySS, UnarySU, UnaryLS, UnaryLU, UnaryOther];

        BinaryOp: ARRAY Mode OF PROC[node: Tree.Index] RETURNS[Tree.Link] = [
            BinarySS, BinarySU, BinaryLS, BinaryLU, OpError];

        FoldExpr: PUBLIC PROC[node: Tree.Index, rep: Repr] RETURNS[val: Tree.Link] = {
            SELECT tb[node].name FROM
                plus, minus, times, div, mod => val _ BinaryOp[ModeMap[rep]][node];
                abs, uminus => val _ UnaryOp[ModeMap[rep]][node];
                relE, relN, relL, relGE, relG, relLE => {
                    val _ IF RelTest [
                        l: tb[node].son[1], r: tb[node].son[2],
                        op: tb[node].name,
                        rep: rep]
                        THEN passPtr.tTRUE
                        ELSE passPtr.tFALSE;
                    FreeNode[node]};
                in, notin => {
                    val _ IF
                        IntervalTest [l: tb[node].son[1], r: tb[node].son[2], rep: rep]
                            =
                        (tb[node].name = in)
                        THEN passPtr.tTRUE
                        ELSE passPtr.tFALSE;
                    FreeNode[node]};
                min, max => {
                    VoidItem: Tree.Map = {RETURN[IF t=val THEN Tree.Null ELSE t]};
                    val _ Choose[
                        list: tb[node].son[1],
                        test: IF tb[node].name = min THEN relL ELSE relG,
                        rep: rep];
                    tb[node].son[1] _ UpdateList[tb[node].son[1], VoidItem];
                    FreeNode[node]};
                ENDCASE => ERROR};

        RelTest: PUBLIC PROC[l, r: Tree.Link, op: RelOp, rep: Repr] RETURNS[BOOL] = {
            OpMap: ARRAY RelOp OF RECORD [map: RelOp, sense: BOOL] = [
                [relE, TRUE], [relE, FALSE], [relL, TRUE], [relL, FALSE],
                [relG, TRUE], [relG, FALSE]];
            RETURN[Test[ModeMap[rep]][l, r, OpMap[op].map] = OpMap[op].sense]};

        IntervalTest: PUBLIC PROC[l, r: Tree.Link, rep: Repr] RETURNS[BOOL] = {
            InTest: ARRAY IntOp OF RECORD [lb, ub: RelOp] = [
                [relG, relL], [relG, relLE], [relGE, relL], [relGE, relLE]];
            subNode: Tree.Index = GetNode[r];
            op: IntOp = tb[subNode].name;
            RETURN[
                RelTest[l, tb[subNode].son[1], InTest[op].lb, rep]
                    AND
                RelTest[l, tb[subNode].son[2], InTest[op].ub, rep] ]};


        Choose: PROC[list: Tree.Link, test: RelOp, rep: Repr] RETURNS[val: Tree.Link] = {
            started: BOOL _ FALSE;

            Item: Tree.Scan = {
                SELECT TRUE FROM
                    ~started => {started _ TRUE; val _ t};
                    RelTest[t, val, test, rep] => val _ t;
                    ENDCASE};

            ScanList[list, Item];  RETURN};


    <<operations>>

        minSS: INTEGER = INTEGER.FIRST;
        maxSS: INTEGER = INTEGER.LAST;

        TestSS: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
            v1: INTEGER = TreeLiteralValue[t1];
            v2: INTEGER = TreeLiteralValue[t2];
            RETURN[SELECT op FROM
                relE => v1 = v2,
                relL => v1 < v2,
                relG => v1 > v2,
                ENDCASE => ERROR]};

        UnarySS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v: INTEGER;
            v1: INTEGER = TreeLiteralValue[tb[node].son[1]];
            SELECT tb[node].name FROM
                uminus => IF v1 # minSS THEN v _ -v1 ELSE GO TO Overflow;
                abs => IF v1 # minSS THEN v _ IF v1 < 0 THEN -v1 ELSE v1 ELSE GO TO Overflow;
                ENDCASE => ERROR;
            t _ MakeTreeLiteral[v];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ TRUE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };

        BinarySS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v: INTEGER;
            v1: INTEGER = TreeLiteralValue[tb[node].son[1]];
            v2: INTEGER = TreeLiteralValue[tb[node].son[2]];
            SELECT tb[node].name FROM
                plus =>
                    IF (IF v1 >= 0 THEN v2 <= maxSS-v1 ELSE v2 >= minSS-v1) THEN v _ v1 + v2
                    ELSE GO TO Overflow;
                minus =>
                    IF (IF v1 >= 0 THEN v1-maxSS <= v2 ELSE v1-minSS >= v2) THEN v _ v1 - v2
                    ELSE GO TO Overflow;
                times =>
                    IF (SELECT TRUE FROM
                        (v1 > 0) AND (v2 > 0) => v2 <= maxSS / v1,
                        (v1 > 0) AND (v2 < 0) => v2 >= minSS / v1,
                        (v1 < 0) AND (v2 > 0) => v1 >= minSS / v2,
                        (v1 < 0) AND (v2 < 0) =>
                            v1 # minSS AND v2 # minSS AND v2 >= maxSS / v1,
                        ENDCASE => TRUE) THEN
                            v _ v1 * v2
                    ELSE GO TO Overflow;
                div =>
                    IF v2 # 0 AND (v2 # -1 OR v1 # minSS) THEN v _ v1 / v2
                    ELSE GO TO Overflow;
                mod => IF v2 # 0 THEN v _ v1 MOD v2 ELSE GO TO Overflow;
                ENDCASE => ERROR;
            t _ MakeTreeLiteral[v];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ TRUE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };


        maxSU: CARDINAL = CARDINAL.LAST;

        TestSU: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
            v1: CARDINAL = TreeLiteralValue[t1];
            v2: CARDINAL = TreeLiteralValue[t2];
            RETURN[SELECT op FROM
                relE => v1 = v2,
                relL => v1 < v2,
                relG => v1 > v2,
                ENDCASE => ERROR]};

        UnarySU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v1: CARDINAL = TreeLiteralValue[tb[node].son[1]];
            SELECT tb[node].name FROM
                uminus => IF v1 # 0 THEN GO TO Overflow;
                abs => NULL;
                ENDCASE => ERROR;
            t _ MakeTreeLiteral[v1];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ FALSE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };

        BinarySU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v: CARDINAL;
            v1: CARDINAL = TreeLiteralValue[tb[node].son[1]];
            v2: CARDINAL = TreeLiteralValue[tb[node].son[2]];
            SELECT tb[node].name FROM
                plus => IF v2 <= maxSU-v1 THEN v _ v1 + v2 ELSE GO TO Overflow;
                minus => IF v1 >= v2 THEN v _ v1 - v2 ELSE GO TO Overflow;
                times => IF v1 = 0 OR v2 <= maxSU/v1 THEN v _ v1 * v2 ELSE GO TO Overflow;
                div => IF v2 # 0 THEN v _ v1 / v2 ELSE GO TO Overflow;
                mod => IF v2 # 0 THEN v _ v1 MOD v2 ELSE GO TO Overflow;
                ENDCASE => ERROR;
            t _ MakeTreeLiteral[v];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ FALSE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };


        minLS: LS = LS.FIRST;
        maxLS: LS = LS.LAST;

        TestLS: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
            v1: LS = LongLiteralValue[t1];
            v2: LS = LongLiteralValue[t2];
            RETURN[SELECT op FROM
                relE => v1 = v2,
                relL => v1 < v2,
                relG => v1 > v2,
                ENDCASE => ERROR]};

        UnaryLS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v: LS;
            v1: LS = LongLiteralValue[tb[node].son[1]];
            SELECT tb[node].name FROM
                uminus => IF v1 # minLS THEN v _ -v1 ELSE GO TO Overflow;
                abs => IF v1 # minLS THEN v _ IF v1 < 0 THEN -v1 ELSE v1 ELSE GO TO Overflow;
                ENDCASE => ERROR;
            t _ MakeLongLiteral[v, tb[node].info];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ TRUE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };

        BinaryLS: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v: LS;
            v1: LS = LongLiteralValue[tb[node].son[1]];
            v2: LS = LongLiteralValue[tb[node].son[2]];
            SELECT tb[node].name FROM
                plus =>
                    IF (IF v1 >= 0 THEN v2 <= maxLS-v1 ELSE v2 >= minLS-v1) THEN v _ v1 + v2
                    ELSE GO TO Overflow;
                minus =>
                    IF (IF v1 >= 0 THEN v1-maxLS <= v2 ELSE v1-minLS >= v2) THEN v _ v1 - v2
                    ELSE GO TO Overflow;
                times =>
                    IF (SELECT TRUE FROM
                        (v1 > 0) AND (v2 > 0) => v2 <= maxLS / v1,
                        (v1 > 0) AND (v2 < 0) => v2 >= minLS / v1,
                        (v1 < 0) AND (v2 > 0) => v1 >= minLS / v2,
                        (v1 < 0) AND (v2 < 0) =>
                            v1 # minLS AND v2 # minLS AND v2 >= maxLS / v1,
                        ENDCASE => TRUE) THEN
                        v _ v1 * v2
                    ELSE GO TO Overflow;
                div =>
                    IF v2 # 0 AND (v2 # -1 OR v1 # minLS) THEN v _ v1 / v2
                    ELSE GO TO Overflow;
                mod => IF v2 # 0 THEN v _ v1 MOD v2 ELSE GO TO Overflow;
                ENDCASE => ERROR;
            t _ MakeLongLiteral[v, tb[node].info];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ TRUE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };


        maxLU: LU = LU.LAST;

        TestLU: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
            v1: LU = LongLiteralValue[t1];
            v2: LU = LongLiteralValue[t2];
            RETURN[SELECT op FROM
                relE => v1 = v2,
                relL => v1 < v2,
                relG => v1 > v2,
                ENDCASE => ERROR]};

        UnaryLU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v1: LU = LongLiteralValue[tb[node].son[1]];
            SELECT tb[node].name FROM
                uminus => IF v1 # 0 THEN GO TO Overflow;
                abs => NULL;
                ENDCASE => ERROR;
            t _ MakeLongLiteral[v1, tb[node].info];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ FALSE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };

        BinaryLU: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            v: LU;
            v1: LU = LongLiteralValue[tb[node].son[1]];
            v2: LU = LongLiteralValue[tb[node].son[2]];
            SELECT tb[node].name FROM
                plus => IF v2 <= maxLU-v1 THEN v _ v1 + v2 ELSE GO TO Overflow;
                minus => IF v1 >= v2 THEN v _ v1 - v2 ELSE GO TO Overflow;
                times => IF v1 = 0 OR v2 <= maxLU/v1 THEN v _ v1 * v2 ELSE GO TO Overflow;
                div => IF v2 # 0 THEN v _ v1 / v2 ELSE GO TO Overflow;
                mod => IF v2 # 0 THEN v _ v1 MOD v2 ELSE GO TO Overflow;
                ENDCASE => ERROR;
            t _ MakeLongLiteral[v, tb[node].info];  FreeNode[node];
            EXITS
                Overflow => {
                    tb[node].attr3 _ FALSE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}
            };


        TestOther: PROC[t1, t2: Tree.Link, op: RelOp] RETURNS[BOOL] = {
            RETURN[SELECT op FROM
                relE => TreeLiteralDesc[t1] = TreeLiteralDesc[t2],
                ENDCASE => ERROR]};

        UnaryOther: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {
            fail: BOOL _ FALSE;
            IF tb[node].attr1    -- REAL
                THEN {
                    ENABLE Real.RealException => {fail _ TRUE; RESUME};
                    v: REAL;
                    v1: REAL = LongLiteralValue[tb[node].son[1]];
                    SELECT tb[node].name FROM
                        uminus => v _ Real.Negate[v1];
                        abs => v _ Real.Abs[v1];
                        ENDCASE => ERROR;
                    IF fail THEN GO TO Overflow;
                    t _ MakeLongLiteral[v, tb[node].info];  FreeNode[node];
                    EXITS
                        Overflow => {
                            tb[node].attr3 _ TRUE; t _ [subtree[node]]; Log.ErrorTree[overflow, t]}}
                ELSE ERROR};

        OpError: PROC[node: Tree.Index] RETURNS[t: Tree.Link] = {ERROR};

        }.