<<>>
<<C2CDoubleImpl.mesa>>
    <<Copyright Ó 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.>>
    <<Christian Jacobi, March 15, 1989 11:41:46 am PST>>
    <<Christian Jacobi, October 5, 1990 1:49:01 pm PDT>>
    DIRECTORY
        C2CAddressing,
        C2CAddressingOps,
        C2CBasics,
        C2CDefs,
        C2CDRunTime,
        C2CDouble,
        C2CMode,
        C2CStateUtils,
        C2CTarget,
        C2CEmit,
        C2CMain,
        Rope,
        IntCodeDefs;

    C2CDoubleImpl: CEDAR PROGRAM
        IMPORTS C2CAddressing, C2CAddressingOps, C2CBasics, C2CEmit, C2CDRunTime, C2CMain, C2CMode, C2CStateUtils, C2CTarget, Rope
        EXPORTS C2CDouble =
    BEGIN
        OPEN IntCodeDefs, C2CAddressingOps, C2CBasics, C2CDefs, C2CMain, C2CMode;
    ROPE: TYPE = Rope.ROPE;


    DTemporary: PROC [] RETURNS [name: ROPE] = {
        name Ź C2CStateUtils.DeclareVariable[temporaryDeclarations, C2CTarget.bitsPerDoubleWord, "D"];
        }; 

    IsSimpleDFloatArithOp: PROC [node: IntCodeDefs.Node] RETURNS [BOOLŹFALSE] = {
        IF node.bits#C2CTarget.bitsPerDoubleWord THEN RETURN;
        WITH node SELECT FROM
            applyNode: ApplyNode => {
                IF applyNode.handler#NIL THEN RETURN [FALSE];
                WITH applyNode.proc SELECT FROM
                    operNode: OperNode => {
                        WITH operNode.oper SELECT FROM
                            arithOp: ArithOper => IF arithOp.class.precision=C2CTarget.bitsPerDoubleWord AND arithOp.class.kind=real THEN RETURN [TRUE];
                            ENDCASE => {};
                        };
                    ENDCASE => {};
                };
            ENDCASE => {};
        };

    LoadAddrRHSD: PROC [node: IntCodeDefs.Node] RETURNS [cc: CodeCont] = {
        <<--D: does not worry about not generating statement code>>
        mode: Mode Ź C2CAddressing.ProposedMode[node: node, lhs: FALSE, wrongSize: FALSE, usedSz: node.bits];
        mode Ź DSetBaseSize[mode, C2CTarget.TemporaryBits[node.bits]];
        SELECT GetAMode[mode] FROM
            <<plain => {>>
                <<cc _ GenNode[node, mode];>>
                <<cc.ec _ C2CEmit.TakeAddr[cc.ec, TRUE];>>
                <<};>>
            plain => {
                mode Ź DSetAMode[mode, getAddr];
                cc Ź GenNode[node, mode];
                };
            getAddr => {
                cc Ź GenNode[node, mode];
                };
            ENDCASE => {
                sz: INT Ź C2CTarget.TemporaryBits[node.bits];
                tempName: ROPE Ź C2CStateUtils.DeclareVariable[temporaryDeclarations, sz];
                cc Ź GenNode[node, SetAssUnits[mode, tempName, sz]];
                IF cc.ec#NIL THEN CantHappen;
                cc.ec Ź C2CEmit.IdentCode[tempName];
                cc.ec Ź C2CEmit.TakeAddr[cc.ec, TRUE];
                };
        FreeMode[mode];
        };


    GAppliedDArithOp: PUBLIC PROC [xApp: IntCodeDefs.ApplyNode, arithOp: IntCodeDefs.ArithOper, mode: C2CDefs.Mode] RETURNS [cc: 
    CodeCont]
    = {
        cc1, cc2: CodeCont; c: Code; assMode: BOOL Ź FALSE; name: ROPE; resAddr: Code;
        kind: IntCodeDefs.ArithClassKind Ź arithOp.class.kind;
        SELECT GetAMode[mode]  FROM
            assUnits => {
                name Ź GetTemplate[mode]; assMode Ź TRUE;
                };
            ENDCASE => {
                name Ź DTemporary[];
                };
        resAddr Ź C2CEmit.Cat["&", name];
        IF arithOp.class.precision#C2CTarget.bitsPerDoubleWord THEN ERROR;
        cc1 Ź LoadAddrRHSD[xApp.args.first];
        SELECT arithOp.select FROM
            min, max => {
                copy: ROPE Ź DTemporary[];
                AccessAddr: PROC [arg: Node] RETURNS [Code] = {
                    <<--never needs temporary because all double expression results in variables>>
                    ccl: CodeCont Ź LoadAddrRHSD[arg];
                    cc.sc Ź C2CEmit.Cat[cc.sc, ccl.sc]; 
                    RETURN [ccl.ec];
                    };
                cc Ź LoadArithNode[xApp.args.first];
                cc.sc Ź C2CEmit.Cat[cc.sc, copy, " = ", cc.ec, ";\n"];
                FOR m: NodeList Ź xApp.args.rest, m.rest WHILE m#NIL DO
                    <<--we could improve this by not simply using a linear list>>
                    resPtr: Code Ź C2CEmit.TakeAddr[C2CEmit.IdentCode[copy], TRUE];
                    addr: Code Ź C2CEmit.TakeAddr[C2CEmit.IdentCode[copy], TRUE];
                    c Ź AccessAddr[m.first];
                    SELECT arithOp.select FROM
                        min => c Ź C2CDRunTime.DMinI[kind, resPtr, addr, c];
                        max => c Ź C2CDRunTime.DMaxI[kind, resPtr, addr, c];
                        ENDCASE => ERROR;
                    cc.sc Ź C2CEmit.Cat[cc.sc, c, ";\n"]; 
                    c Ź NIL;
                    ENDLOOP;
                name Ź copy;
                assMode Ź FALSE;
                };
            neg => {
                c Ź C2CDRunTime.DNegI[kind, resAddr, cc1.ec];
                };
            abs => {
                c Ź C2CDRunTime.DAbsI[kind, resAddr, cc1.ec];
                };
            add, sub, mul, div, pow, mod => {
                cc2 Ź LoadAddrRHSD[xApp.args.rest.first];
                SELECT arithOp.select FROM
                    add => {c Ź C2CDRunTime.DAddI[kind, resAddr, cc1.ec, cc2.ec]};
                    sub => {c Ź C2CDRunTime.DSubI[kind, resAddr, cc1.ec, cc2.ec]};
                    mul => {c Ź C2CDRunTime.DMulI[kind, resAddr, cc1.ec, cc2.ec]};
                    div => {c Ź C2CDRunTime.DDivI[kind, resAddr, cc1.ec, cc2.ec]};
                    mod => {c Ź C2CDRunTime.DModI[kind, resAddr, cc1.ec, cc2.ec]};
                    pow => {
                        <<--no mixed mode power operation: base and exponent of same type>>
                        c Ź C2CDRunTime.DPwrI[kind, resAddr, cc1.ec, cc2.ec];
                        };
                    ENDCASE => CaseMissing;
                };
            ENDCASE => NotYetImpl;
        IF c#NIL THEN c Ź C2CEmit.Cat[c, ";\n"];
        cc.sc Ź C2CEmit.Cat[cc1.sc, cc.sc, cc2.sc, c];
        IF assMode 
            THEN cc.ec Ź NIL 
            ELSE {
                cc.ec Ź C2CEmit.IdentCode[name];
                cc Ź ModizeArithCode[cc, mode, xApp.bits];
                };
        };

    GAppliedDCompareOp: PUBLIC PROC [xApp: IntCodeDefs.ApplyNode, compOp: IntCodeDefs.CompareOper, mode: C2CDefs.Mode] RETURNS [cc: 
    CodeCont] = {
        cc1, cc2: CodeCont; 
        kind: IntCodeDefs.ArithClassKind Ź compOp.class.kind;
        IF compOp.class.precision#C2CTarget.bitsPerDoubleWord THEN NotYetImpl; --ERROR;
        cc1 Ź LoadAddrRHSD[xApp.args.first];
        cc2 Ź LoadAddrRHSD[xApp.args.rest.first];
        cc.sc Ź C2CEmit.Cat[cc1.sc, cc2.sc];
        SELECT compOp.sense FROM
            ge => {cc.ec Ź C2CDRunTime.DGeI[kind, cc1.ec, cc2.ec]};
            gt => {cc.ec Ź C2CDRunTime.DGtI[kind, cc1.ec, cc2.ec]};
            eq => {cc.ec Ź C2CDRunTime.DEqI[kind, cc1.ec, cc2.ec]};
            lt => {cc.ec Ź C2CDRunTime.DGtI[kind, cc2.ec, cc1.ec]};
            le => {cc.ec Ź C2CDRunTime.DGeI[kind, cc2.ec, cc1.ec]};
            ne => {
                cc.ec Ź C2CEmit.Cat[" ! ", C2CDRunTime.DEqI[kind, cc1.ec, cc2.ec]]; 
                cc.ec Ź C2CEmit.SetPrecedence[cc.ec, unaryPrecedence];
                };
            ENDCASE => CaseMissing;
        };

    GAppliedDConvertOp: PUBLIC PROC [xApp: IntCodeDefs.ApplyNode, convertOp: IntCodeDefs.ConvertOper, mode: C2CDefs.Mode] RETURNS [cc: 
    CodeCont] = {
        template, key: ROPE; assMode: BOOL Ź FALSE;
        IF convertOp.to.precision<convertOp.from.precision THEN {
            IF convertOp.to.precision#C2CTarget.bitsPerWord OR convertOp.from.precision#C2CTarget.bitsPerDoubleWord THEN CantHappen;
            cc Ź LoadAddrRHSD[xApp.args.first];
            SELECT convertOp.from.kind FROM
                real => {
                    SELECT convertOp.to.kind FROM
                        real => cc.ec Ź C2CDRunTime.FloatDRealI[cc.ec];
                        ENDCASE => CantHappen;
                    };
                signed => {
                    SELECT convertOp.to.kind FROM
                        signed => cc.ec Ź C2CDRunTime.IntDIntI[cc.ec];
                        unsigned => cc.ec Ź C2CDRunTime.CardDIntI[cc.ec];
                        real => cc.ec Ź C2CDRunTime.FloatDIntI[cc.ec];
                        ENDCASE => CantHappen;
                    };
                unsigned => {
                    SELECT convertOp.to.kind FROM
                        signed => cc.ec Ź C2CDRunTime.IntDCardI[cc.ec];
                        unsigned => cc.ec Ź C2CDRunTime.CardDCardI[cc.ec];
                        real => cc.ec Ź C2CDRunTime.FloatDCardI[cc.ec];
                        ENDCASE => CantHappen;
                    };
                ENDCASE => CantHappen;
            RETURN;
            };
        IF convertOp.to.precision#C2CTarget.bitsPerDoubleWord THEN CantHappen;
        SELECT GetAMode[mode]  FROM
            assUnits => {
                template Ź GetTemplate[mode]; assMode Ź TRUE;
                };
            ENDCASE => {
                template Ź DTemporary[];
                };
        IF convertOp.from.precision<=C2CTarget.bitsPerWord THEN {
            IF convertOp.from.precision<C2CTarget.bitsPerWord THEN {
                SELECT convertOp.from.kind FROM
                    unsigned => {};
                    ENDCASE => CantHappenCedar;
                };
            <<--from word to double word>>
            cc Ź LoadArithNode[node: xApp.args.first];
            cc.ec Ź C2CEmit.MinPrecedence[cc.ec, primaryPrecedence];
            SELECT convertOp.to.kind FROM
                signed => 
                    SELECT convertOp.from.kind FROM
                        signed => key Ź "DIntInt";
                        unsigned => key Ź "DIntCard";
                        ENDCASE => CantHappenCedar;
                unsigned => 
                    SELECT convertOp.from.kind FROM
                        signed => key Ź "DCardInt";
                        unsigned => key Ź "DCardCard";
                        ENDCASE => CantHappenCedar;
                real => {
                    SELECT convertOp.from.kind FROM
                        signed => key Ź "DFloatInt";
                        unsigned => key Ź "DFloatCard";
                        real => key Ź "DFloatReal";
                        ENDCASE => CantHappenCedar;
                    };
                ENDCASE => CantHappenCedar;
            }
        ELSE IF convertOp.from.precision=C2CTarget.bitsPerDoubleWord THEN {
            <<--from double to double>>
            cc Ź LoadAddrRHSD[xApp.args.first];
            cc.ec Ź C2CEmit.MinPrecedence[cc.ec, primaryPrecedence];
            SELECT convertOp.to.kind FROM
                real => {
                    SELECT convertOp.from.kind FROM
                        signed => key Ź "DFloatDIntI";
                        unsigned => key Ź "DFloatDCardI";
                        ENDCASE => CantHappen;
                    };
                signed => 
                    SELECT convertOp.from.kind FROM
                        unsigned => key Ź "DIntDCardI";
                        ENDCASE => CantHappen;
                unsigned => 
                    SELECT convertOp.from.kind FROM
                        signed => key Ź "DCardDIntI";
                        ENDCASE => CantHappen;
                ENDCASE => CantHappen;
            }
        ELSE CantHappenCedar;
        IF key=NIL THEN CantHappen;
        key Ź Rope.Concat[C2CTarget.runtimePrefix, key];
        cc.ec Ź C2CEmit.CatCall[key, "&", template, ", ", cc.ec];
        SELECT GetAMode[mode] FROM
            assUnits => {
                cc.sc Ź C2CEmit.Cat[cc.sc, cc.ec, ";\n"];
                cc.ec Ź NIL;
                }; 
            ENDCASE => { 
                cc.sc Ź C2CEmit.Cat[cc.sc, cc.ec, ";\n"];
                cc.ec Ź C2CEmit.IdentCode[template];
                cc Ź ModizeArithCode[cc, mode, convertOp.to.precision];
                };
        };

END.