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