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