![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to R.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / engine|
Return to R.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / engine |
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: }