![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to bfaux.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin|
Return to bfaux.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
1.3 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.2 2015/08/05 01:10:38 noro Exp $ */
1.1 noro 2: #include "ca.h"
3: #include "parse.h"
4:
1.3 ! noro 5: void Peval(), Psetprec(), Psetbprec(), Ptodouble();
1.1 noro 6:
7: struct ftab bf_tab[] = {
8: {"eval",Peval,-2},
9: {"setprec",Psetprec,-1},
1.3 ! noro 10: {"setbprec",Psetbprec,-1},
1.1 noro 11: {"todouble",Ptodouble,1},
12: {0,0,0},
13: };
14:
15: void Ptodouble(NODE arg,Num *rp)
16: {
17: double r,i;
18: Real real,imag;
19: Num num;
20:
21: asir_assert(ARG0(arg),O_N,"todouble");
22: num = (Num)ARG0(arg);
23: if ( !num ) {
24: *rp = 0;
25: return;
26: }
27: switch ( NID(num) ) {
28: case N_R: case N_Q: case N_B:
29: r = ToReal(num);
30: MKReal(r,real);
31: *rp = (Num)real;
32: break;
33: case N_C:
34: r = ToReal(((C)num)->r);
35: i = ToReal(((C)num)->i);
36: MKReal(r,real);
37: MKReal(i,imag);
38: reimtocplx((Num)real,(Num)imag,rp);
39: break;
40: default:
41: *rp = num;
42: break;
43: }
44: }
45:
46: void Peval(arg,rp)
47: NODE arg;
48: Obj *rp;
49: {
50: int prec;
51:
52: asir_assert(ARG0(arg),O_R,"eval");
53: if ( argc(arg) == 2 ) {
1.3 ! noro 54: prec = QTOS((Q)ARG1(arg))*3.32193;
1.1 noro 55: if ( prec < MPFR_PREC_MIN ) prec = MPFR_PREC_MIN;
56: else if ( prec > MPFR_PREC_MAX ) prec = MPFR_PREC_MAX;
57: } else
58: prec = 0;
1.2 noro 59: evalr(CO,(Obj)ARG0(arg),prec,rp);
1.1 noro 60: }
61:
1.3 ! noro 62: /* set/get decimal precision */
1.1 noro 63:
64: void Psetprec(NODE arg,Obj *rp)
65: {
66: int p;
67: Q q;
1.3 ! noro 68: int prec,dprec;
! 69:
! 70: prec = mpfr_get_default_prec();
! 71: /* decimal precision */
! 72: dprec = prec*0.30103;
! 73: STOQ(dprec,q); *rp = (Obj)q;
! 74: if ( arg ) {
! 75: asir_assert(ARG0(arg),O_N,"setprec");
! 76: prec = QTOS((Q)ARG0(arg))*3.32193;
! 77: if ( p > 0 )
! 78: prec = p;
! 79: }
! 80: if ( prec < MPFR_PREC_MIN ) prec = MPFR_PREC_MIN;
! 81: else if ( prec > MPFR_PREC_MAX ) prec = MPFR_PREC_MAX;
! 82: mpfr_set_default_prec(prec);
! 83: }
1.1 noro 84:
1.3 ! noro 85: /* set/get bit precision */
1.1 noro 86:
1.3 ! noro 87: void Psetbprec(NODE arg,Obj *rp)
! 88: {
! 89: int p;
! 90: Q q;
! 91: int prec;
! 92:
! 93: prec = mpfr_get_default_prec();
! 94: STOQ(prec,q); *rp = (Obj)q;
1.1 noro 95: if ( arg ) {
1.3 ! noro 96: asir_assert(ARG0(arg),O_N,"setbprec");
! 97: prec = QTOS((Q)ARG0(arg));
1.1 noro 98: if ( p > 0 )
99: prec = p;
100: }
101: if ( prec < MPFR_PREC_MIN ) prec = MPFR_PREC_MIN;
102: else if ( prec > MPFR_PREC_MAX ) prec = MPFR_PREC_MAX;
103: mpfr_set_default_prec(prec);
104: }
105:
106: Num tobf(Num a,int prec);
107:
108: void mp_pi(NODE arg,BF *rp)
109: {
110: int prec;
111: BF r;
112:
113: prec = arg ? QTOS((Q)ARG0(arg)) : 0;
114: NEWBF(r);
115: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
116: mpfr_const_pi(r->body,MPFR_RNDN);
117: *rp = r;
118: }
119:
120: void mp_e(NODE arg,BF *rp)
121: {
122: int prec;
123: mpfr_t one;
124: BF r;
125:
126: prec = arg ? QTOS((Q)ARG0(arg)) : 0;
127: NEWBF(r);
128: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
129: mpfr_init(one);
130: mpfr_set_ui(one,1,MPFR_RNDN);
131: mpfr_exp(r->body,one,MPFR_RNDN);
132: *rp = r;
133: }
134:
135: void mp_sin(NODE arg,BF *rp)
136: {
137: Num a;
138: int prec;
139: BF r;
140:
141: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
142: a = tobf(ARG0(arg),prec);
143: NEWBF(r);
144: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
145: mpfr_sin(r->body,((BF)a)->body,MPFR_RNDN);
146: *rp = r;
147: }
148:
149: void mp_cos(NODE arg,BF *rp)
150: {
151: Num a;
152: int prec;
153: BF r;
154:
155: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
156: a = tobf(ARG0(arg),prec);
157: NEWBF(r);
158: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
159: mpfr_cos(r->body,((BF)a)->body,MPFR_RNDN);
160: *rp = r;
161: }
162:
163: void mp_tan(NODE arg,BF *rp)
164: {
165: Num a;
166: int prec;
167: BF r;
168:
169: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
170: a = tobf(ARG0(arg),prec);
171: NEWBF(r);
172: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
173: mpfr_tan(r->body,((BF)a)->body,MPFR_RNDN);
174: *rp = r;
175: }
176:
177: void mp_asin(NODE arg,BF *rp)
178: {
179: Num a;
180: int prec;
181: BF r;
182:
183: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
184: a = tobf(ARG0(arg),prec);
185: NEWBF(r);
186: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
187: mpfr_asin(r->body,((BF)a)->body,MPFR_RNDN);
188: *rp = r;
189: }
190: void mp_acos(NODE arg,BF *rp)
191: {
192: Num a;
193: int prec;
194: BF r;
195:
196: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
197: a = tobf(ARG0(arg),prec);
198: NEWBF(r);
199: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
200: mpfr_acos(r->body,((BF)a)->body,MPFR_RNDN);
201: *rp = r;
202: }
203: void mp_atan(NODE arg,BF *rp)
204: {
205: Num a;
206: int prec;
207: BF r;
208:
209: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
210: a = tobf(ARG0(arg),prec);
211: NEWBF(r);
212: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
213: mpfr_atan(r->body,((BF)a)->body,MPFR_RNDN);
214: *rp = r;
215: }
216:
217: void mp_sinh(NODE arg,BF *rp)
218: {
219: Num a;
220: int prec;
221: BF r;
222:
223: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
224: a = tobf(ARG0(arg),prec);
225: NEWBF(r);
226: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
227: mpfr_sinh(r->body,((BF)a)->body,MPFR_RNDN);
228: *rp = r;
229: }
230:
231: void mp_cosh(NODE arg,BF *rp)
232: {
233: Num a;
234: int prec;
235: BF r;
236:
237: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
238: a = tobf(ARG0(arg),prec);
239: NEWBF(r);
240: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
241: mpfr_cosh(r->body,((BF)a)->body,MPFR_RNDN);
242: *rp = r;
243: }
244:
245: void mp_tanh(NODE arg,BF *rp)
246: {
247: Num a;
248: int prec;
249: BF r;
250:
251: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
252: a = tobf(ARG0(arg),prec);
253: NEWBF(r);
254: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
255: mpfr_tanh(r->body,((BF)a)->body,MPFR_RNDN);
256: *rp = r;
257: }
258:
259: void mp_asinh(NODE arg,BF *rp)
260: {
261: Num a;
262: int prec;
263: BF r;
264:
265: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
266: a = tobf(ARG0(arg),prec);
267: NEWBF(r);
268: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
269: mpfr_asinh(r->body,((BF)a)->body,MPFR_RNDN);
270: *rp = r;
271: }
272: void mp_acosh(NODE arg,BF *rp)
273: {
274: Num a;
275: int prec;
276: BF r;
277:
278: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
279: a = tobf(ARG0(arg),prec);
280: NEWBF(r);
281: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
282: mpfr_acosh(r->body,((BF)a)->body,MPFR_RNDN);
283: *rp = r;
284: }
285: void mp_atanh(NODE arg,BF *rp)
286: {
287: Num a;
288: int prec;
289: BF r;
290:
291: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
292: a = tobf(ARG0(arg),prec);
293: NEWBF(r);
294: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
295: mpfr_atanh(r->body,((BF)a)->body,MPFR_RNDN);
296: *rp = r;
297: }
298:
299: void mp_exp(NODE arg,BF *rp)
300: {
301: Num a;
302: int prec;
303: BF r;
304:
305: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
306: a = tobf(ARG0(arg),prec);
307: NEWBF(r);
308: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
309: mpfr_exp(r->body,((BF)a)->body,MPFR_RNDN);
310: *rp = r;
311: }
312:
313: void mp_log(NODE arg,BF *rp)
314: {
315: Num a;
316: int prec;
317: BF r;
318:
319: prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0;
320: a = tobf(ARG0(arg),prec);
321: NEWBF(r);
322: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
323: mpfr_log(r->body,((BF)a)->body,MPFR_RNDN);
324: *rp = r;
325: }
326:
327: void mp_pow(NODE arg,BF *rp)
328: {
329: Num a,e;
330: int prec;
331: BF r;
332:
333: prec = NEXT(NEXT(arg)) ? QTOS((Q)ARG2(arg)) : 0;
334: a = tobf(ARG0(arg),prec);
335: e = tobf(ARG1(arg),prec);
336: NEWBF(r);
337: prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body);
338: mpfr_pow(r->body,((BF)a)->body,((BF)e)->body,MPFR_RNDN);
339: *rp = r;
340: }