![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to real.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 real.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / engine |
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/engine/real.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */
2: #include "ca.h"
3: #include "base.h"
4: #include <math.h>
5:
6: #if defined(THINK_C)
7: double RatnToReal(a)
8: Q a;
9: {
10: double nm,dn,t;
11: int enm,edn;
12: char buf[BUFSIZ];
13:
14: nm = NatToReal(NM(a),&enm);
15: if ( INT(a) )
16: if ( enm >= 1 )
17: error("RatnToReal : Overflow");
18: else
19: return SGN(a)>0 ? nm : -nm;
20: else {
21: dn = NatToReal(DN(a),&edn);
22: sprintf(buf,"1.0E%d",enm-edn);
23: sscanf(buf,"%lf",&t);
24: if ( SGN(a) < 0 )
25: t = -t;
26: return nm/dn*t;
27: }
28: }
29:
30: double NatToReal(a,expo)
31: N a;
32: int *expo;
33: {
34: int *p;
35: int l,all,i,j,s,tb,top,tail;
36: unsigned int t,m[2];
37:
38: p = BD(a); l = PL(a) - 1;
39: for ( top = 0, t = p[l]; t; t >>= 1, top++ );
40: all = top + BSH*l; tail = (53-top)%BSH; i = l-(53-top)/BSH-1;
41: m[1] = i < 0 ? 0 : p[i]>>(BSH-tail);
42: for ( j = 1, i++, tb = tail; i <= l; i++ ) {
43: s = 32-tb; t = i < 0 ? 0 : p[i];
44: if ( BSH > s ) {
45: m[j] |= ((t&((1<<s)-1))<<tb);
46: if ( !j )
47: break;
48: else {
49: j--; m[j] = t>>s; tb = BSH-s;
50: }
51: } else {
52: m[j] |= (t<<tb); tb += BSH;
53: }
54: }
55: s = (all-1)+1023;
56: m[0] = (m[0]&((1<<20)-1))|(MIN(2046,s)<<20); *expo = MAX(s-2046,0);
57: #ifdef vax
58: t = m[0]; m[0] = m[1]; m[1] = t; itod(m);
59: #endif
60: #if defined(MIPSEL)
61: t = m[0]; m[0] = m[1]; m[1] = t;
62: #endif
63: return (double)(*((short double *)m));
64: }
65: #else
66: double RatnToReal(a)
67: Q a;
68: {
69: double nm,dn,t,man;
70: int enm,edn,e;
71: unsigned int *p,s;
72:
73: nm = NatToReal(NM(a),&enm);
74: if ( INT(a) )
75: if ( enm >= 1 )
76: error("RatnToReal : Overflow");
77: else
78: return SGN(a)>0 ? nm : -nm;
79: else {
80: dn = NatToReal(DN(a),&edn);
81: man = nm/dn;
82: if ( SGN(a) < 0 )
83: man = -man;
84: if ( ((e = enm - edn) >= 1024) || (e <= -1023) )
85: error("RatnToReal : Overflow"); /* XXX */
86: else if ( !e )
87: return man;
88: else
89: return man*pow(2,e);
90: }
91: }
92:
93: double NatToReal(a,expo)
94: N a;
95: int *expo;
96: {
97: unsigned int *p;
98: int l,all,i,j,s,tb,top,tail;
99: unsigned int t,m[2];
100:
101: p = BD(a); l = PL(a) - 1;
102: for ( top = 0, t = p[l]; t; t >>= 1, top++ );
103: all = top + BSH*l; tail = (53-top)%BSH; i = l-(53-top)/BSH-1;
104: m[1] = i < 0 ? 0 : p[i]>>(BSH-tail);
105: for ( j = 1, i++, tb = tail; i <= l; i++ ) {
106: s = 32-tb; t = i < 0 ? 0 : p[i];
107: if ( BSH > s ) {
108: m[j] |= ((t&((1<<s)-1))<<tb);
109: if ( !j )
110: break;
111: else {
112: j--; m[j] = t>>s; tb = BSH-s;
113: }
114: } else {
115: m[j] |= (t<<tb); tb += BSH;
116: }
117: }
118: s = (all-1)+1023;
119: m[0] = (m[0]&((1<<20)-1))|(MIN(2046,s)<<20); *expo = MAX(s-2046,0);
120: #ifdef vax
121: t = m[0]; m[0] = m[1]; m[1] = t; itod(m);
122: #endif
123: #if defined(i386) || defined(MIPSEL) || defined(VISUAL) || defined(linux) || defined(__alpha) || defined(__FreeBSD__) || defined(__NetBSD__)
124: t = m[0]; m[0] = m[1]; m[1] = t;
125: #endif
126: return *((double *)m);
127: }
128: #endif
129:
130: void addreal(a,b,c)
131: Num a,b;
132: Real *c;
133: {
134: double t;
135:
136: t = ToReal(a)+ToReal(b); MKReal(t,*c);
137: }
138:
139: void subreal(a,b,c)
140: Num a,b;
141: Real *c;
142: {
143: double t;
144:
145: t = ToReal(a)-ToReal(b); MKReal(t,*c);
146: }
147:
148: void mulreal(a,b,c)
149: Num a,b;
150: Real *c;
151: {
152: double t;
153:
154: if ( !a || !b )
155: *c = 0;
156: else {
157: t = ToReal(a)*ToReal(b);
158: if ( !t )
159: error("mulreal : Underflow"); /* XXX */
160: else
161: MKReal(t,*c);
162: }
163: }
164:
165: void divreal(a,b,c)
166: Num a,b;
167: Real *c;
168: {
169: double t;
170:
171: if ( !a )
172: *c = 0;
173: else {
174: t = ToReal(a)/ToReal(b);
175: if ( !t )
176: error("divreal : Underflow"); /* XXX */
177: else
178: MKReal(t,*c);
179: }
180: }
181:
182: void chsgnreal(a,c)
183: Num a,*c;
184: {
185: double t;
186: Real s;
187:
188: if ( !a )
189: *c = 0;
190: else if ( NID(a) == N_Q )
191: chsgnq((Q)a,(Q *)c);
192: else {
193: t = -ToReal(a); MKReal(t,s); *c = (Num)s;
194: }
195: }
196:
197: void pwrreal(a,b,c)
198: Num a,b;
199: Real *c;
200: {
201: double t;
202: double pwrreal0();
203:
204: if ( !b )
205: MKReal(1.0,*c);
206: else if ( !a )
207: *c = 0;
208: else if ( !RATN(b) || !INT(b) || (PL(NM((Q)b)) > 1) ) {
209: t = (double)pow((double)ToReal(a),(double)ToReal(b));
210: if ( !t )
211: error("pwrreal : Underflow"); /* XXX */
212: else
213: MKReal(t,*c);
214: } else {
215: t = pwrreal0(BDY((Real)a),BD(NM((Q)b))[0]);
216: t = SGN((Q)b)>0?t:1/t;
217: if ( !t )
218: error("pwrreal : Underflow"); /* XXX */
219: else
220: MKReal(t,*c);
221: }
222: }
223:
224: double pwrreal0(n,e)
225: double n;
226: int e;
227: {
228: double t;
229:
230: if ( e == 1 )
231: return n;
232: else {
233: t = pwrreal0(n,e / 2);
234: return e%2 ? t*t*n : t*t;
235: }
236: }
237:
238: int cmpreal(a,b)
239: Real a,b;
240: {
241: double t;
242:
243: t = ToReal(a)-ToReal(b);
244: return t>0.0 ? 1 : t<0.0?-1 : 0;
245: }