Return to R.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / engine

Annotation of OpenXM_contrib2/asir2000/engine/R.c, Revision 1.1

1.1     ! noro        1: /* $OpenXM: OpenXM/src/asir99/engine/R.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */
        !             2: #include "ca.h"
        !             3:
        !             4: void addr(vl,a,b,c)
        !             5: VL vl;
        !             6: Obj a,b,*c;
        !             7: {
        !             8:        P t,s,u;
        !             9:        R r;
        !            10:
        !            11:        if ( !a )
        !            12:                *c = b;
        !            13:        else if ( !b )
        !            14:                *c = a;
        !            15:        else if ( !RAT(a) )
        !            16:                if ( !RAT(b) )
        !            17:                        addp(vl,(P)a,(P)b,(P *)c);
        !            18:                else {
        !            19:                        mulp(vl,(P)a,DN((R)b),&t); addp(vl,t,NM((R)b),&s);
        !            20:                        if ( s )
        !            21:                                MKRAT(s,DN((R)b),((R)b)->reduced,r);
        !            22:                        else
        !            23:                                r = 0;
        !            24:                        *c = (Obj)r;
        !            25:                }
        !            26:        else if ( !RAT(b) ) {
        !            27:                mulp(vl,DN((R)a),(P)b,&t); addp(vl,NM((R)a),t,&s);
        !            28:                if ( s )
        !            29:                        MKRAT(s,DN((R)a),((R)a)->reduced,r);
        !            30:                else
        !            31:                        r = 0;
        !            32:                *c = (Obj)r;
        !            33:        } else {
        !            34:                mulp(vl,NM((R)a),DN((R)b),&t); mulp(vl,NM((R)b),DN((R)a),&s);
        !            35:                addp(vl,t,s,&u);
        !            36:                if ( u ) {
        !            37:                        mulp(vl,DN((R)a),DN((R)b),&t); MKRAT(u,t,0,r); *c = (Obj)r;
        !            38:                } else
        !            39:                        *c = 0;
        !            40:        }
        !            41: }
        !            42:
        !            43: void subr(vl,a,b,c)
        !            44: VL vl;
        !            45: Obj a,b,*c;
        !            46: {
        !            47:        P t,s,u;
        !            48:        R r;
        !            49:
        !            50:        if ( !a )
        !            51:                chsgnr(b,c);
        !            52:        else if ( !b )
        !            53:                *c = a;
        !            54:        else if ( !RAT(a) )
        !            55:                if ( !RAT(b) )
        !            56:                        subp(vl,(P)a,(P)b,(P *)c);
        !            57:                else {
        !            58:                        mulp(vl,(P)a,DN((R)b),&t); subp(vl,t,NM((R)b),&s);
        !            59:                        if ( s )
        !            60:                                MKRAT(s,DN((R)b),((R)b)->reduced,r);
        !            61:                        else
        !            62:                                r = 0;
        !            63:                        *c = (Obj)r;
        !            64:                }
        !            65:        else if ( !RAT(b) ) {
        !            66:                mulp(vl,DN((R)a),(P)b,&t); subp(vl,NM((R)a),t,&s);
        !            67:                if ( s )
        !            68:                        MKRAT(s,DN((R)a),((R)a)->reduced,r);
        !            69:                else
        !            70:                        r = 0;
        !            71:                *c = (Obj)r;
        !            72:        } else {
        !            73:                mulp(vl,NM((R)a),DN((R)b),&t); mulp(vl,NM((R)b),DN((R)a),&s);
        !            74:                subp(vl,t,s,&u);
        !            75:                if ( u ) {
        !            76:                        mulp(vl,DN((R)a),DN((R)b),&t); MKRAT(u,t,0,r); *c = (Obj)r;
        !            77:                } else
        !            78:                        *c = 0;
        !            79:        }
        !            80: }
        !            81:
        !            82: void mulr(vl,a,b,c)
        !            83: VL vl;
        !            84: Obj a,b,*c;
        !            85: {
        !            86:        P t,s;
        !            87:        R r;
        !            88:
        !            89:        if ( !a || !b )
        !            90:                *c = 0;
        !            91:        else if ( !RAT(a) )
        !            92:                if ( !RAT(b) )
        !            93:                        mulp(vl,(P)a,(P)b,(P *)c);
        !            94:                else {
        !            95:                        mulp(vl,(P)a,NM((R)b),&t); MKRAT(t,DN((R)b),0,r); *c = (Obj)r;
        !            96:                }
        !            97:        else if ( !RAT(b) ) {
        !            98:                mulp(vl,NM((R)a),(P)b,&t); MKRAT(t,DN((R)a),0,r); *c = (Obj)r;
        !            99:        } else {
        !           100:                mulp(vl,NM((R)a),NM((R)b),&t); mulp(vl,DN((R)a),DN((R)b),&s);
        !           101:                MKRAT(t,s,0,r); *c = (Obj)r;
        !           102:        }
        !           103: }
        !           104:
        !           105: void divr(vl,a,b,c)
        !           106: VL vl;
        !           107: Obj a,b,*c;
        !           108: {
        !           109:        P t,s;
        !           110:        R r;
        !           111:
        !           112:        if ( !b )
        !           113:                error("divr : division by 0");
        !           114:        else if ( !a )
        !           115:                *c = 0;
        !           116:        else if ( !RAT(a) )
        !           117:                if ( !RAT(b) )
        !           118:                        if ( NUM(b) )
        !           119:                                divsp(vl,(P)a,(P)b,(P *)c);
        !           120:                        else {
        !           121:                                MKRAT((P)a,(P)b,0,r); *c = (Obj)r;
        !           122:                        }
        !           123:                else {
        !           124:                        mulp(vl,(P)a,DN((R)b),&t); MKRAT(t,NM((R)b),0,r); *c = (Obj)r;
        !           125:                }
        !           126:        else if ( !RAT(b) ) {
        !           127:                mulp(vl,DN((R)a),(P)b,&t); MKRAT(NM((R)a),t,0,r); *c = (Obj)r;
        !           128:        } else {
        !           129:                mulp(vl,NM((R)a),DN((R)b),&t); mulp(vl,DN((R)a),NM((R)b),&s);
        !           130:                MKRAT(t,s,0,r); *c = (Obj)r;
        !           131:        }
        !           132: }
        !           133:
        !           134: void pwrr(vl,a,q,c)
        !           135: VL vl;
        !           136: Obj a,q,*c;
        !           137: {
        !           138:        P t,s;
        !           139:        R r;
        !           140:        Q q1;
        !           141:
        !           142:        if ( !q )
        !           143:                *c = (Obj)ONE;
        !           144:        else if ( !a )
        !           145:                *c = 0;
        !           146:        else if ( !RAT(a) )
        !           147:                pwrp(vl,(P)a,(Q)q,(P *)c);
        !           148:        else if ( !NUM(q) || !RATN(q) || !INT(q) )
        !           149:                notdef(vl,a,q,c);
        !           150:        else {
        !           151:                if ( SGN((Q)q) < 0 ) {
        !           152:                        chsgnq((Q)q,&q1); pwrp(vl,DN((R)a),q1,&t); pwrp(vl,NM((R)a),q1,&s);
        !           153:                } else {
        !           154:                        pwrp(vl,NM((R)a),(Q)q,&t); pwrp(vl,DN((R)a),(Q)q,&s);
        !           155:                }
        !           156:                MKRAT(t,s,((R)a)->reduced,r); *c = (Obj)r;
        !           157:        }
        !           158: }
        !           159:
        !           160: void chsgnr(a,b)
        !           161: Obj a,*b;
        !           162: {
        !           163:        P t;
        !           164:        R r;
        !           165:
        !           166:        if ( !a )
        !           167:                *b = 0;
        !           168:        else if ( !RAT(a) )
        !           169:                chsgnp((P)a,(P *)b);
        !           170:        else {
        !           171:                chsgnp(NM((R)a),&t); MKRAT(t,DN((R)a),((R)a)->reduced,r); *b = (Obj)r;
        !           172:        }
        !           173: }
        !           174:
        !           175: int compr(vl,a,b)
        !           176: VL vl;
        !           177: Obj a,b;
        !           178: {
        !           179:        int t;
        !           180:
        !           181:        if ( !a )
        !           182:                return b ? -1 : 0;
        !           183:        else if ( !b )
        !           184:                return 1;
        !           185:        else if ( !RAT(a) )
        !           186:                return !RAT(b) ? compp(vl,(P)a,(P)b) : -1;
        !           187:        else if ( !RAT(b) )
        !           188:                return 1;
        !           189:        else {
        !           190:                t = compp(vl,NM((R)a),NM((R)b));
        !           191:                if ( !t )
        !           192:                        t = compp(vl,DN((R)a),DN((R)b));
        !           193:                return t;
        !           194:        }
        !           195: }