Annotation of OpenXM_contrib2/asir2000/builtin/parif.c, Revision 1.38
1.38 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.37 2017/08/30 09:40:30 ohara Exp $ */
1.1 noro 2: #include "ca.h"
3: #include "parse.h"
1.19 noro 4: #include "ox.h"
1.1 noro 5:
1.19 noro 6: Q ox_pari_stream;
7: int ox_pari_stream_initialized = 0;
1.29 noro 8: int ox_get_pari_result = 0;
1.33 ohara 9: P ox_pari_starting_function = 0;
1.1 noro 10:
1.24 noro 11: typedef void (*mpfr_func)(NODE,Obj *);
12:
13: void Pmpfr_ai();
14: void Pmpfr_eint(), Pmpfr_erf(),Pmpfr_li2();
15: void Pmpfr_zeta();
16: void Pmpfr_j0(), Pmpfr_j1();
17: void Pmpfr_y0(), Pmpfr_y1();
18: void Pmpfr_gamma(), Pmpfr_lngamma(), Pmpfr_digamma();
19: void Pmpfr_floor(), Pmpfr_round(), Pmpfr_ceil();
20:
21: struct mpfr_tab_rec {
22: char *name;
23: mpfr_func func;
24: } mpfr_tab[] = {
1.38 ! noro 25: {"ai",Pmpfr_ai},
! 26: {"zeta",Pmpfr_zeta},
! 27: {"j0",Pmpfr_j0},
! 28: {"j1",Pmpfr_j1},
! 29: {"y0",Pmpfr_y0},
! 30: {"y1",Pmpfr_y1},
! 31: {"eint",Pmpfr_eint},
! 32: {"erf",Pmpfr_erf},
! 33: {"li2",Pmpfr_li2},
! 34: {"gamma",Pmpfr_gamma},
! 35: {"lngamma",Pmpfr_gamma},
! 36: {"digamma",Pmpfr_gamma},
! 37: {"floor",Pmpfr_floor},
! 38: {"ceil",Pmpfr_ceil},
! 39: {"round",Pmpfr_round},
1.24 noro 40: };
41:
42: mpfr_func mpfr_search(char *name)
43: {
44: int i,n;
45:
46: n = sizeof(mpfr_tab)/sizeof(struct mpfr_tab_rec);
47: for ( i = 0; i < n; i++ )
48: if ( !strcmp(name,mpfr_tab[i].name) )
49: return mpfr_tab[i].func;
50: return 0;
51: }
52:
1.28 noro 53: Obj list_to_vect(Obj a)
54: {
55: int len,i;
56: VECT v;
57: NODE nd;
58:
59: if ( !a || OID(a) != O_LIST ) return a;
60: len = length(BDY((LIST)a));
61: MKVECT(v,len);
62: for ( i = 0, nd = BDY((LIST)a); nd; nd = NEXT(nd), i++ )
63: v->body[i] = (pointer)list_to_vect((Obj)BDY(nd));
64: return (Obj)v;
65: }
66:
1.30 noro 67: Obj vect_to_mat(VECT v)
68: {
69: MAT m;
70: int len,col,i,j;
71:
72: len = v->len;
73: if ( v->body[0] && OID((Obj)v->body[0]) == O_VECT ) {
74: col = ((VECT)v->body[0])->len;
1.38 ! noro 75: for ( i = 1; i < len; i++ )
! 76: if ( !v->body[i] || OID((Obj)v->body[i]) != O_VECT
! 77: || ((VECT)v->body[i])->len != col )
! 78: break;
1.30 noro 79: if ( i == len ) {
1.38 ! noro 80: /* convert to a matrix */
! 81: MKMAT(m,len,col);
! 82: for ( i = 0; i < len; i++ )
! 83: for ( j = 0; j < col; j++ )
! 84: m->body[i][j] = ((VECT)v->body[i])->body[j];
! 85: return (Obj)m;
! 86: }
1.30 noro 87: }
88: return (Obj)v;
89: }
90:
1.29 noro 91: void reset_ox_pari()
92: {
93: NODE nd;
94: Obj r;
95:
96: if ( ox_get_pari_result ) {
1.38 ! noro 97: nd = mknode(1,ox_pari_stream);
! 98: Pox_shutdown(nd,&r);
1.29 noro 99: ox_get_pari_result = 0;
1.38 ! noro 100: ox_pari_stream_initialized = 0;
1.29 noro 101: }
102: }
103:
1.19 noro 104: pointer evalparif(FUNC f,NODE arg)
1.1 noro 105: {
1.19 noro 106: int ac,intarg,opt,prec;
1.37 ohara 107: Q q,r,narg,cmd;
108: Real sec;
1.25 noro 109: NODE nd,oxarg,t,t1,n;
1.19 noro 110: STRING name;
111: USINT ui;
1.37 ohara 112: LIST list;
1.19 noro 113: Obj ret,dmy;
1.24 noro 114: mpfr_func mpfr_function;
1.33 ohara 115: V v;
1.19 noro 116:
1.32 noro 117: if ( arg && ARG0(arg) && NID((Num)ARG0(arg)) != N_C
118: && (mpfr_function = mpfr_search(f->name)) ) {
119: (*mpfr_function)(arg,&ret);
120: return (pointer) ret;
1.20 takayama 121: }
1.24 noro 122:
1.19 noro 123: if ( !ox_pari_stream_initialized ) {
1.38 ! noro 124: if ( ox_pari_starting_function && OID(ox_pari_starting_function) == O_P ) {
! 125: v = VR(ox_pari_starting_function);
! 126: if ( (int)v->attr != V_SR ) {
! 127: error("pari : no handler.");
! 128: }
! 129: MKNODE(nd,0,0);
! 130: r = (Q)bevalf((FUNC)v->priv,0);
! 131: }else {
! 132: #if !defined(VISUAL)
! 133: MKSTR(name,"ox_pari");
! 134: nd = mknode(2,NULL,name);
! 135: Pox_launch_nox(nd,&r);
1.36 ohara 136: #else
1.38 ! noro 137: error("Please load names.rr from latest asir-contrib library before using pari functions.");
1.36 ohara 138: #endif
1.38 ! noro 139: }
! 140: ox_pari_stream = r;
1.19 noro 141: ox_pari_stream_initialized = 1;
142: }
1.25 noro 143:
1.38 ! noro 144: ac = argc(arg);
1.25 noro 145: /* reverse the arg list */
146: for ( n = arg, t = 0; n; n = NEXT(n) ) {
147: MKNODE(t1,BDY(n),t); t = t1;
148: }
149: /* push the reversed arg list */
150: for ( ; t; t = NEXT(t) ) {
151: oxarg = mknode(2,ox_pari_stream,BDY(t));
152: Pox_push_cmo(oxarg,&dmy);
153: }
154: MKSTR(name,f->name);
155: STOQ(ac,narg);
156: oxarg = mknode(3,ox_pari_stream,name,narg);
157: Pox_execute_function(oxarg,&dmy);
1.37 ohara 158: ox_get_pari_result = 1;
159: #if defined(VISUAL) || defined(__MINGW32__)
160: #define SM_popCMO 262
161: STOQ(SM_popCMO,cmd);
162: oxarg = mknode(2,ox_pari_stream,cmd);
163: Pox_push_cmd(oxarg,&dmy);
164: nd = mknode(1,ox_pari_stream);
165: MKLIST(list,nd);
166: MKReal(1.0/8,sec);
167: oxarg = mknode(2,list,sec);
168: ret=0;
169: do {
1.38 ! noro 170: check_intr();
! 171: Pox_select(oxarg,&list);
! 172: oxarg = mknode(1,list);
! 173: Plength(oxarg,&ret);
1.37 ohara 174: }while (!ret);
175: oxarg = mknode(1,ox_pari_stream);
176: Pox_get(oxarg,&ret);
177: #else
1.25 noro 178: oxarg = mknode(1,ox_pari_stream);
1.28 noro 179: Pox_pop_cmo(oxarg,&ret);
1.37 ohara 180: #endif
1.29 noro 181: ox_get_pari_result = 0;
1.31 noro 182: if ( ret && OID(ret) == O_ERR ) {
183: char buf[BUFSIZ];
184: soutput_init(buf);
185: sprintexpr(CO,((ERR)ret)->body);
186: error(buf);
187: }
1.30 noro 188: if ( ret && OID(ret) == O_LIST ) {
1.28 noro 189: ret = list_to_vect(ret);
1.38 ! noro 190: ret = vect_to_mat((VECT)ret);
1.30 noro 191: }
1.28 noro 192: return ret;
1.1 noro 193: }
194:
195: struct pariftab {
1.38 ! noro 196: char *name;
1.19 noro 197: int dmy;
1.38 ! noro 198: int type;
1.1 noro 199: };
200:
1.8 noro 201: /*
202: * type = 1 => argc = 1, second arg = precision
1.34 noro 203: * type = 2 => argc = 1, second arg = (long int)0
1.8 noro 204: *
205: */
1.19 noro 206: /*
207: {"abs",0,1},
208: {"adj",0,1},
209: */
1.8 noro 210:
1.1 noro 211: struct pariftab pariftab[] = {
1.19 noro 212: {"arg",0,1},
213: {"bigomega",0,1},
214: {"binary",0,1},
215: {"ceil",0,1},
216: {"centerlift",0,1},
217: {"cf",0,1},
218: {"classno",0,1},
219: {"classno2",0,1},
220: {"conj",0,1},
221: {"content",0,1},
222: {"denom",0,1},
223: {"det",0,1},
224: {"det2",0,1},
225: {"dilog",0,1},
226: {"disc",0,1},
227: {"discf",0,1},
228: {"divisors",0,1},
229: {"eigen",0,1},
230: {"eintg1",0,1},
231: {"erfc",0,1},
232: {"eta",0,1},
233: {"floor",0,1},
234: {"frac",0,1},
235: {"galois",0,1},
236: {"galoisconj",0,1},
237: {"gamh",0,1},
238: {"gamma",0,1},
239: {"hclassno",0,1},
240: {"hermite",0,1},
241: {"hess",0,1},
242: {"imag",0,1},
243: {"image",0,1},
244: {"image2",0,1},
245: {"indexrank",0,1},
246: {"indsort",0,1},
247: {"initalg",0,1},
248: {"isfund",0,1},
249: {"ispsp",0,1},
250: {"isqrt",0,1},
251: {"issqfree",0,1},
252: {"issquare",0,1},
253: {"jacobi",0,1},
254: {"jell",0,1},
255: {"ker",0,1},
256: {"keri",0,1},
257: {"kerint",0,1},
258: {"kerintg1",0,1},
259: {"length",0,1},
260: {"lexsort",0,1},
261: {"lift",0,1},
262: {"lindep",0,1},
263: {"lll",0,1},
264: {"lllgen",0,1},
265: {"lllgram",0,1},
266: {"lllgramgen",0,1},
267: {"lllgramint",0,1},
268: {"lllgramkerim",0,1},
269: {"lllgramkerimgen",0,1},
270: {"lllint",0,1},
271: {"lllkerim",0,1},
272: {"lllkerimgen",0,1},
273: {"lngamma",0,1},
274: {"logagm",0,1},
275: {"mat",0,1},
276: {"matrixqz2",0,1},
277: {"matrixqz3",0,1},
278: {"matsize",0,1},
279: {"modreverse",0,1},
280: {"mu",0,1},
281: {"nextprime",0,1},
282: {"norm",0,1},
283: {"norml2",0,1},
284: {"numdiv",0,1},
285: {"numer",0,1},
286: {"omega",0,1},
287: {"order",0,1},
288: {"ordred",0,1},
289: {"phi",0,1},
290: {"pnqn",0,1},
291: {"polred",0,1},
292: {"polred2",0,1},
293: {"primroot",0,1},
294: {"psi",0,1},
295: {"quadgen",0,1},
296: {"quadpoly",0,1},
297: {"real",0,1},
298: {"recip",0,1},
299: {"redreal",0,1},
300: {"regula",0,1},
301: {"reorder",0,1},
302: {"reverse",0,1},
303: {"rhoreal",0,1},
304: {"roots",0,1},
305: {"round",0,1},
306: {"sigma",0,1},
307: {"signat",0,1},
308: {"simplify",0,1},
309: {"smalldiscf",0,1},
310: {"smallfact",0,1},
311: {"smallpolred",0,1},
312: {"smallpolred2",0,1},
313: {"smith",0,1},
314: {"smith2",0,1},
315: {"sort",0,1},
316: {"sqr",0,1},
317: {"sqred",0,1},
318: {"sqrt",0,1},
319: {"supplement",0,1},
320: {"trace",0,1},
321: {"trans",0,1},
322: {"trunc",0,1},
323: {"unit",0,1},
324: {"vec",0,1},
325: {"wf",0,1},
326: {"wf2",0,1},
327: {"zeta",0,1},
328: {"factor",0,1},
329:
330: {"allocatemem",0,0},
331:
332: {"isprime",0,2},
333: {"factorint",0,2},
1.1 noro 334: {0,0,0},
335: };
336:
337: void parif_init() {
1.38 ! noro 338: int i;
1.1 noro 339:
1.38 ! noro 340: for ( i = 0, parif = 0; pariftab[i].name; i++ )
! 341: appendparif(&parif,pariftab[i].name, 0,pariftab[i].type);
1.1 noro 342: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to parif.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin