Annotation of OpenXM_contrib2/asir2000/builtin/parif.c, Revision 1.1
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/parif.c,v 1.2 1999/11/18 05:42:01 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "parse.h"
! 4:
! 5: #if PARI
! 6: #include "genpari.h"
! 7:
! 8: extern long prec;
! 9:
! 10: #if defined(THINK_C)
! 11: void patori(GEN,Obj *);
! 12: void patori_i(GEN,N *);
! 13: void ritopa(Obj,GEN *);
! 14: void ritopa_i(N,int,GEN *);
! 15: #else
! 16: void patori();
! 17: void patori_i();
! 18: void ritopa();
! 19: void ritopa_i();
! 20: #endif
! 21:
! 22: void Peval(),Psetprec(),p_pi(),p_e(),p_mul(),p_gcd();
! 23:
! 24: struct ftab pari_tab[] = {
! 25: {"eval",Peval,-2}, {"setprec",Psetprec,-1}, {0,0,0},
! 26: };
! 27:
! 28: #define MKPREC(a,i,b) (argc(a)==(i)?mkprec(QTOS((Q)(b))):prec)
! 29:
! 30: #define CALLPARI1(f,a,p,r)\
! 31: ritopa((Obj)a,&_pt1_); _pt2_ = f(_pt1_,p); patori(_pt2_,r); cgiv(_pt2_); cgiv(_pt1_)
! 32: #define CALLPARI2(f,a,b,p,r)\
! 33: ritopa((Obj)a,&_pt1_); ritopa((Obj)b,&_pt2_); _pt3_ = f(_pt1_,_pt2_,p); patori(_pt3_,r); cgiv(_pt3_); cgiv(_pt2_); cgiv(_pt1_)
! 34:
! 35: #define PARIF1P(f,pf)\
! 36: void f(NODE,Obj *);\
! 37: void f(ar,rp) NODE ar; Obj *rp;\
! 38: { GEN _pt1_,_pt2_; CALLPARI1(pf,ARG0(ar),MKPREC(ar,2,ARG1(ar)),rp); }
! 39: #define PARIF2P(f,pf)\
! 40: void f(NODE,Obj *);\
! 41: void f(ar,rp) NODE ar; Obj *rp;\
! 42: { GEN _pt1_,_pt2_,_pt3_; CALLPARI2(pf,ARG0(ar),ARG1(ar),MKPREC(ar,3,ARG2(ar)),rp); }
! 43:
! 44: #if defined(LONG_IS_32BIT)
! 45: #define PREC_CONV 0.103810253
! 46: #endif
! 47: #if defined(LONG_IS_64BIT)
! 48: #define PREC_CONV 0.051905126
! 49: #endif
! 50:
! 51: mkprec(p)
! 52: int p;
! 53: {
! 54: if ( p > 0 )
! 55: return (int)(p*PREC_CONV+3);
! 56: }
! 57:
! 58: void Peval(arg,rp)
! 59: NODE arg;
! 60: Obj *rp;
! 61: {
! 62: asir_assert(ARG0(arg),O_R,"eval");
! 63: evalr(CO,(Obj)ARG0(arg),argc(arg)==2?QTOS((Q)ARG1(arg)):0,rp);
! 64: }
! 65:
! 66: void Psetprec(arg,rp)
! 67: NODE arg;
! 68: Obj *rp;
! 69: {
! 70: int p;
! 71: Q q;
! 72:
! 73: p = (int)((prec-3)/PREC_CONV); STOQ(p,q); *rp = (Obj)q;
! 74: if ( arg ) {
! 75: asir_assert(ARG0(arg),O_N,"setprec");
! 76: prec = mkprec(QTOS((Q)ARG0(arg)));
! 77: }
! 78: }
! 79:
! 80: void p_pi(arg,rp)
! 81: NODE arg;
! 82: Obj *rp;
! 83: {
! 84: GEN x;
! 85:
! 86: x = mppi(MKPREC(arg,1,ARG0(arg)));
! 87: patori(x,rp); cgiv(x);
! 88: }
! 89:
! 90: void p_e(arg,rp)
! 91: NODE arg;
! 92: Obj *rp;
! 93: {
! 94: GEN x;
! 95:
! 96: x = gexp(gun,MKPREC(arg,1,ARG0(arg))); patori(x,rp); cgiv(x);
! 97: }
! 98:
! 99: void p_mul(a,b,r)
! 100: Obj a,b,*r;
! 101: {
! 102: GEN p1,p2,p3;
! 103:
! 104: ritopa((Obj)a,&p1); ritopa((Obj)b,&p2);
! 105: p3 = mulii(p1,p2);
! 106: patori(p3,r); cgiv(p3); cgiv(p2); cgiv(p1);
! 107: }
! 108:
! 109: void p_gcd(a,b,r)
! 110: N a,b,*r;
! 111: {
! 112: GEN p1,p2,p3;
! 113:
! 114: ritopa_i(a,1,&p1); ritopa_i(b,1,&p2);
! 115: p3 = mppgcd(p1,p2);
! 116: patori_i(p3,r); cgiv(p3); cgiv(p2); cgiv(p1);
! 117: }
! 118:
! 119: PARIF1P(p_sin,gsin) PARIF1P(p_cos,gcos) PARIF1P(p_tan,gtan)
! 120: PARIF1P(p_asin,gasin) PARIF1P(p_acos,gacos) PARIF1P(p_atan,gatan)
! 121: PARIF1P(p_sinh,gsh) PARIF1P(p_cosh,gch) PARIF1P(p_tanh,gth)
! 122: PARIF1P(p_asinh,gash) PARIF1P(p_acosh,gach) PARIF1P(p_atanh,gath)
! 123: PARIF1P(p_exp,gexp) PARIF1P(p_log,glog)
! 124: PARIF1P(p_dilog,dilog) PARIF1P(p_erf,gerfc)
! 125: PARIF1P(p_eigen,eigen) PARIF1P(p_roots,roots)
! 126:
! 127: PARIF2P(p_pow,gpui)
! 128:
! 129: pointer evalparif(f,arg)
! 130: FUNC f;
! 131: NODE arg;
! 132: {
! 133: GEN a,v;
! 134: long ltop,lbot;
! 135: pointer r;
! 136: int ac;
! 137: char buf[BUFSIZ];
! 138:
! 139: if ( !f->f.binf ) {
! 140: sprintf(buf,"pari : %s undefined.",f->name);
! 141: error(buf);
! 142: }
! 143: switch ( f->type ) {
! 144: case 1:
! 145: ac = argc(arg);
! 146: if ( !ac || ( ac > 2 ) ) {
! 147: fprintf(stderr,"argument mismatch in %s()\n",NAME(f));
! 148: error("");
! 149: }
! 150: ltop = avma;
! 151: ritopa((Obj)ARG0(arg),&a);
! 152: #if 1 || defined(__MWERKS__)
! 153: {
! 154: GEN (*dmy)();
! 155:
! 156: dmy = (GEN (*)())f->f.binf;
! 157: v = (*dmy)(a,MKPREC(arg,2,ARG1(arg)));
! 158: }
! 159: #else
! 160: v = (GEN)(*f->f.binf)(a,MKPREC(arg,2,ARG1(arg)));
! 161: #endif
! 162: lbot = avma;
! 163: patori(v,(Obj *)&r); gerepile(ltop,lbot,0);
! 164: return r;
! 165: default:
! 166: error("evalparif : not implemented yet.");
! 167: }
! 168: }
! 169:
! 170: struct pariftab {
! 171: char *name;
! 172: GEN (*f)();
! 173: int type;
! 174: };
! 175:
! 176: struct pariftab pariftab[] = {
! 177: {"abs",(GEN (*)())gabs,1},
! 178: {"adj",adj,1},
! 179: {"arg",garg,1},
! 180: {"bigomega",gbigomega,1},
! 181: {"binary",binaire,1},
! 182: {"ceil",gceil,1},
! 183: {"centerlift",centerlift,1},
! 184: {"cf",gcf,1},
! 185: {"classno",classno,1},
! 186: {"classno2",classno2,1},
! 187: {"conj",gconj,1},
! 188: {"content",content,1},
! 189: {"denom",denom,1},
! 190: {"det",det,1},
! 191: {"det2",det2,1},
! 192: {"dilog",dilog,1},
! 193: {"disc",discsr,1},
! 194: {"discf",discf,1},
! 195: {"divisors",divisors,1},
! 196: {"eigen",eigen,1},
! 197: {"eintg1",eint1,1},
! 198: {"erfc",gerfc,1},
! 199: {"eta",eta,1},
! 200: {"floor",gfloor,1},
! 201: {"frac",gfrac,1},
! 202: {"galois",galois,1},
! 203: {"galoisconj",galoisconj,1},
! 204: {"gamh",ggamd,1},
! 205: {"gamma",ggamma,1},
! 206: {"hclassno",classno3,1},
! 207: {"hermite",hnf,1},
! 208: {"hess",hess,1},
! 209: {"imag",gimag,1},
! 210: {"image",image,1},
! 211: {"image2",image2,1},
! 212: {"indexrank",indexrank,1},
! 213: {"indsort",indexsort,1},
! 214: {"initalg",initalg,1},
! 215: {"isfund",gisfundamental,1},
! 216: {"isprime",gisprime,1},
! 217: {"ispsp",gispsp,1},
! 218: {"isqrt",racine,1},
! 219: {"issqfree",gissquarefree,1},
! 220: {"issquare",gcarreparfait,1},
! 221: {"jacobi",jacobi,1},
! 222: {"jell",jell,1},
! 223: {"ker",ker,1},
! 224: {"keri",keri,1},
! 225: {"kerint",kerint,1},
! 226: {"kerintg1",kerint1,1},
! 227: {"kerint2",kerint2,1},
! 228: {"length",(GEN(*)())glength,1},
! 229: {"lexsort",lexsort,1},
! 230: {"lift",lift,1},
! 231: {"lindep",lindep,1},
! 232: {"lll",lll,1},
! 233: {"lllg1",lll1,1},
! 234: {"lllgen",lllgen,1},
! 235: {"lllgram",lllgram,1},
! 236: {"lllgramg1",lllgram1,1},
! 237: {"lllgramgen",lllgramgen,1},
! 238: {"lllgramint",lllgramint,1},
! 239: {"lllgramkerim",lllgramkerim,1},
! 240: {"lllgramkerimgen",lllgramkerimgen,1},
! 241: {"lllint",lllint,1},
! 242: {"lllkerim",lllkerim,1},
! 243: {"lllkerimgen",lllkerimgen,1},
! 244: {"lllrat",lllrat,1},
! 245: {"lngamma",glngamma,1},
! 246: {"logagm",glogagm,1},
! 247: {"mat",gtomat,1},
! 248: {"matrixqz2",matrixqz2,1},
! 249: {"matrixqz3",matrixqz3,1},
! 250: {"matsize",matsize,1},
! 251: {"modreverse",polymodrecip,1},
! 252: {"mu",gmu,1},
! 253: {"nextprime",nextprime,1},
! 254: {"norm",gnorm,1},
! 255: {"norml2",gnorml2,1},
! 256: {"numdiv",numbdiv,1},
! 257: {"numer",numer,1},
! 258: {"omega",gomega,1},
! 259: {"order",order,1},
! 260: {"ordred",ordred,1},
! 261: {"phi",phi,1},
! 262: {"pnqn",pnqn,1},
! 263: {"polred",polred,1},
! 264: {"polred2",polred2,1},
! 265: {"primroot",gener,1},
! 266: {"psi",gpsi,1},
! 267: {"quadgen",quadgen ,1},
! 268: {"quadpoly",quadpoly ,1},
! 269: {"real",greal,1},
! 270: {"recip",polrecip ,1},
! 271: {"redreal",redreal ,1},
! 272: {"regula",regula ,1},
! 273: {"reorder",reorder ,1},
! 274: {"reverse",recip ,1},
! 275: {"rhoreal",rhoreal ,1},
! 276: {"roots",roots,1},
! 277: {"round",ground,1},
! 278: {"sigma",sumdiv,1},
! 279: {"signat",signat,1},
! 280: {"simplify",simplify,1},
! 281: {"smalldiscf",smalldiscf,1},
! 282: {"smallfact",smallfact,1},
! 283: {"smallpolred",smallpolred,1},
! 284: {"smallpolred2",smallpolred2,1},
! 285: {"smith",smith,1},
! 286: {"smith2",smith2,1},
! 287: {"sort",sort,1},
! 288: {"sqr",gsqr,1},
! 289: {"sqred",sqred,1},
! 290: {"sqrt",gsqrt,1},
! 291: {"supplement",suppl,1},
! 292: {"trace",gtrace,1},
! 293: {"trans",gtrans,1},
! 294: {"trunc",gtrunc,1},
! 295: {"unit",fundunit,1},
! 296: {"vec",gtovec,1},
! 297: {"wf",wf,1},
! 298: {"wf2",wf2,1},
! 299: {"zeta",gzeta,1},
! 300: {0,0,0},
! 301: };
! 302:
! 303: void parif_init() {
! 304: int i;
! 305:
! 306: for ( i = 0, parif = 0; pariftab[i].name; i++ )
! 307: appendparif(&parif,pariftab[i].name, (int (*)())pariftab[i].f,pariftab[i].type);
! 308: }
! 309: #else /* PARI */
! 310:
! 311: struct ftab pari_tab[] = {
! 312: {0,0,0},
! 313: };
! 314:
! 315: void parif_init() {}
! 316:
! 317: pointer evalparif() {
! 318: error("evalparif : PARI is not combined.");
! 319: }
! 320: #endif /*PARI */
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