=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/parif.c,v retrieving revision 1.1.1.1 retrieving revision 1.29 diff -u -p -r1.1.1.1 -r1.29 --- OpenXM_contrib2/asir2000/builtin/parif.c 1999/12/03 07:39:07 1.1.1.1 +++ OpenXM_contrib2/asir2000/builtin/parif.c 2015/08/19 05:29:23 1.29 @@ -1,302 +1,266 @@ -/* $OpenXM: OpenXM/src/asir99/builtin/parif.c,v 1.2 1999/11/18 05:42:01 noro Exp $ */ +/* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.28 2015/08/18 05:35:17 noro Exp $ */ #include "ca.h" #include "parse.h" +#include "ox.h" -#if PARI -#include "genpari.h" +Q ox_pari_stream; +int ox_pari_stream_initialized = 0; +int ox_get_pari_result = 0; -extern long prec; +typedef void (*mpfr_func)(NODE,Obj *); -#if defined(THINK_C) -void patori(GEN,Obj *); -void patori_i(GEN,N *); -void ritopa(Obj,GEN *); -void ritopa_i(N,int,GEN *); -#else -void patori(); -void patori_i(); -void ritopa(); -void ritopa_i(); -#endif +void Pmpfr_ai(); +void Pmpfr_eint(), Pmpfr_erf(),Pmpfr_li2(); +void Pmpfr_zeta(); +void Pmpfr_j0(), Pmpfr_j1(); +void Pmpfr_y0(), Pmpfr_y1(); +void Pmpfr_gamma(), Pmpfr_lngamma(), Pmpfr_digamma(); +void Pmpfr_floor(), Pmpfr_round(), Pmpfr_ceil(); -void Peval(),Psetprec(),p_pi(),p_e(),p_mul(),p_gcd(); - -struct ftab pari_tab[] = { - {"eval",Peval,-2}, {"setprec",Psetprec,-1}, {0,0,0}, +struct mpfr_tab_rec { + char *name; + mpfr_func func; +} mpfr_tab[] = { + {"ai",Pmpfr_ai}, + {"zeta",Pmpfr_zeta}, + {"j0",Pmpfr_j0}, + {"j1",Pmpfr_j1}, + {"y0",Pmpfr_y0}, + {"y1",Pmpfr_y1}, + {"eint",Pmpfr_eint}, + {"erf",Pmpfr_erf}, + {"li2",Pmpfr_li2}, + {"gamma",Pmpfr_gamma}, + {"lngamma",Pmpfr_gamma}, + {"digamma",Pmpfr_gamma}, + {"floor",Pmpfr_floor}, + {"ceil",Pmpfr_ceil}, + {"round",Pmpfr_round}, }; -#define MKPREC(a,i,b) (argc(a)==(i)?mkprec(QTOS((Q)(b))):prec) - -#define CALLPARI1(f,a,p,r)\ -ritopa((Obj)a,&_pt1_); _pt2_ = f(_pt1_,p); patori(_pt2_,r); cgiv(_pt2_); cgiv(_pt1_) -#define CALLPARI2(f,a,b,p,r)\ -ritopa((Obj)a,&_pt1_); ritopa((Obj)b,&_pt2_); _pt3_ = f(_pt1_,_pt2_,p); patori(_pt3_,r); cgiv(_pt3_); cgiv(_pt2_); cgiv(_pt1_) - -#define PARIF1P(f,pf)\ -void f(NODE,Obj *);\ -void f(ar,rp) NODE ar; Obj *rp;\ -{ GEN _pt1_,_pt2_; CALLPARI1(pf,ARG0(ar),MKPREC(ar,2,ARG1(ar)),rp); } -#define PARIF2P(f,pf)\ -void f(NODE,Obj *);\ -void f(ar,rp) NODE ar; Obj *rp;\ -{ GEN _pt1_,_pt2_,_pt3_; CALLPARI2(pf,ARG0(ar),ARG1(ar),MKPREC(ar,3,ARG2(ar)),rp); } - -#if defined(LONG_IS_32BIT) -#define PREC_CONV 0.103810253 -#endif -#if defined(LONG_IS_64BIT) -#define PREC_CONV 0.051905126 -#endif - -mkprec(p) -int p; +mpfr_func mpfr_search(char *name) { - if ( p > 0 ) - return (int)(p*PREC_CONV+3); -} + int i,n; -void Peval(arg,rp) -NODE arg; -Obj *rp; -{ - asir_assert(ARG0(arg),O_R,"eval"); - evalr(CO,(Obj)ARG0(arg),argc(arg)==2?QTOS((Q)ARG1(arg)):0,rp); + n = sizeof(mpfr_tab)/sizeof(struct mpfr_tab_rec); + for ( i = 0; i < n; i++ ) + if ( !strcmp(name,mpfr_tab[i].name) ) + return mpfr_tab[i].func; + return 0; } -void Psetprec(arg,rp) -NODE arg; -Obj *rp; +Obj list_to_vect(Obj a) { - int p; - Q q; + int len,i; + VECT v; + NODE nd; - p = (int)((prec-3)/PREC_CONV); STOQ(p,q); *rp = (Obj)q; - if ( arg ) { - asir_assert(ARG0(arg),O_N,"setprec"); - prec = mkprec(QTOS((Q)ARG0(arg))); - } + if ( !a || OID(a) != O_LIST ) return a; + len = length(BDY((LIST)a)); + MKVECT(v,len); + for ( i = 0, nd = BDY((LIST)a); nd; nd = NEXT(nd), i++ ) + v->body[i] = (pointer)list_to_vect((Obj)BDY(nd)); + return (Obj)v; } -void p_pi(arg,rp) -NODE arg; -Obj *rp; +void reset_ox_pari() { - GEN x; + NODE nd; + Obj r; - x = mppi(MKPREC(arg,1,ARG0(arg))); - patori(x,rp); cgiv(x); + if ( ox_get_pari_result ) { + nd = mknode(1,ox_pari_stream); + Pox_shutdown(nd,&r); + ox_get_pari_result = 0; + ox_pari_stream_initialized = 0; + } } -void p_e(arg,rp) -NODE arg; -Obj *rp; +pointer evalparif(FUNC f,NODE arg) { - GEN x; + int ac,intarg,opt,prec; + Q q,r,narg; + NODE nd,oxarg,t,t1,n; + STRING name; + USINT ui; + Obj ret,dmy; + mpfr_func mpfr_function; - x = gexp(gun,MKPREC(arg,1,ARG0(arg))); patori(x,rp); cgiv(x); -} + if ( mpfr_function = mpfr_search(f->name) ) { + (*mpfr_function)(arg,&ret); + return (pointer) ret; + } -void p_mul(a,b,r) -Obj a,b,*r; -{ - GEN p1,p2,p3; + if ( !ox_pari_stream_initialized ) { + MKSTR(name,"ox_pari"); + nd = mknode(2,NULL,name); + Pox_launch_nox(nd,&r); + ox_pari_stream = r; + ox_pari_stream_initialized = 1; + } - ritopa((Obj)a,&p1); ritopa((Obj)b,&p2); - p3 = mulii(p1,p2); - patori(p3,r); cgiv(p3); cgiv(p2); cgiv(p1); + ac = argc(arg); + /* reverse the arg list */ + for ( n = arg, t = 0; n; n = NEXT(n) ) { + MKNODE(t1,BDY(n),t); t = t1; + } + /* push the reversed arg list */ + for ( ; t; t = NEXT(t) ) { + oxarg = mknode(2,ox_pari_stream,BDY(t)); + Pox_push_cmo(oxarg,&dmy); + } + MKSTR(name,f->name); + STOQ(ac,narg); + oxarg = mknode(3,ox_pari_stream,name,narg); + Pox_execute_function(oxarg,&dmy); + oxarg = mknode(1,ox_pari_stream); + ox_get_pari_result = 1; + Pox_pop_cmo(oxarg,&ret); + ox_get_pari_result = 0; + if ( ret && OID(ret) == O_LIST ) + ret = list_to_vect(ret); + return ret; } -void p_gcd(a,b,r) -N a,b,*r; -{ - GEN p1,p2,p3; - - ritopa_i(a,1,&p1); ritopa_i(b,1,&p2); - p3 = mppgcd(p1,p2); - patori_i(p3,r); cgiv(p3); cgiv(p2); cgiv(p1); -} - -PARIF1P(p_sin,gsin) PARIF1P(p_cos,gcos) PARIF1P(p_tan,gtan) -PARIF1P(p_asin,gasin) PARIF1P(p_acos,gacos) PARIF1P(p_atan,gatan) -PARIF1P(p_sinh,gsh) PARIF1P(p_cosh,gch) PARIF1P(p_tanh,gth) -PARIF1P(p_asinh,gash) PARIF1P(p_acosh,gach) PARIF1P(p_atanh,gath) -PARIF1P(p_exp,gexp) PARIF1P(p_log,glog) -PARIF1P(p_dilog,dilog) PARIF1P(p_erf,gerfc) -PARIF1P(p_eigen,eigen) PARIF1P(p_roots,roots) - -PARIF2P(p_pow,gpui) - -pointer evalparif(f,arg) -FUNC f; -NODE arg; -{ - GEN a,v; - long ltop,lbot; - pointer r; - int ac; - char buf[BUFSIZ]; - - if ( !f->f.binf ) { - sprintf(buf,"pari : %s undefined.",f->name); - error(buf); - } - switch ( f->type ) { - case 1: - ac = argc(arg); - if ( !ac || ( ac > 2 ) ) { - fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); - error(""); - } - ltop = avma; - ritopa((Obj)ARG0(arg),&a); -#if 1 || defined(__MWERKS__) - { - GEN (*dmy)(); - - dmy = (GEN (*)())f->f.binf; - v = (*dmy)(a,MKPREC(arg,2,ARG1(arg))); - } -#else - v = (GEN)(*f->f.binf)(a,MKPREC(arg,2,ARG1(arg))); -#endif - lbot = avma; - patori(v,(Obj *)&r); gerepile(ltop,lbot,0); - return r; - default: - error("evalparif : not implemented yet."); - } -} - struct pariftab { char *name; - GEN (*f)(); + int dmy; int type; }; +/* + * type = 1 => argc = 1, second arg = precision + * type = 2 => argc = 1, second arg = optional (long int) + * + */ +/* +{"abs",0,1}, +{"adj",0,1}, +*/ + struct pariftab pariftab[] = { -{"abs",(GEN (*)())gabs,1}, -{"adj",adj,1}, -{"arg",garg,1}, -{"bigomega",gbigomega,1}, -{"binary",binaire,1}, -{"ceil",gceil,1}, -{"centerlift",centerlift,1}, -{"cf",gcf,1}, -{"classno",classno,1}, -{"classno2",classno2,1}, -{"conj",gconj,1}, -{"content",content,1}, -{"denom",denom,1}, -{"det",det,1}, -{"det2",det2,1}, -{"dilog",dilog,1}, -{"disc",discsr,1}, -{"discf",discf,1}, -{"divisors",divisors,1}, -{"eigen",eigen,1}, -{"eintg1",eint1,1}, -{"erfc",gerfc,1}, -{"eta",eta,1}, -{"floor",gfloor,1}, -{"frac",gfrac,1}, -{"galois",galois,1}, -{"galoisconj",galoisconj,1}, -{"gamh",ggamd,1}, -{"gamma",ggamma,1}, -{"hclassno",classno3,1}, -{"hermite",hnf,1}, -{"hess",hess,1}, -{"imag",gimag,1}, -{"image",image,1}, -{"image2",image2,1}, -{"indexrank",indexrank,1}, -{"indsort",indexsort,1}, -{"initalg",initalg,1}, -{"isfund",gisfundamental,1}, -{"isprime",gisprime,1}, -{"ispsp",gispsp,1}, -{"isqrt",racine,1}, -{"issqfree",gissquarefree,1}, -{"issquare",gcarreparfait,1}, -{"jacobi",jacobi,1}, -{"jell",jell,1}, -{"ker",ker,1}, -{"keri",keri,1}, -{"kerint",kerint,1}, -{"kerintg1",kerint1,1}, -{"kerint2",kerint2,1}, -{"length",(GEN(*)())glength,1}, -{"lexsort",lexsort,1}, -{"lift",lift,1}, -{"lindep",lindep,1}, -{"lll",lll,1}, -{"lllg1",lll1,1}, -{"lllgen",lllgen,1}, -{"lllgram",lllgram,1}, -{"lllgramg1",lllgram1,1}, -{"lllgramgen",lllgramgen,1}, -{"lllgramint",lllgramint,1}, -{"lllgramkerim",lllgramkerim,1}, -{"lllgramkerimgen",lllgramkerimgen,1}, -{"lllint",lllint,1}, -{"lllkerim",lllkerim,1}, -{"lllkerimgen",lllkerimgen,1}, -{"lllrat",lllrat,1}, -{"lngamma",glngamma,1}, -{"logagm",glogagm,1}, -{"mat",gtomat,1}, -{"matrixqz2",matrixqz2,1}, -{"matrixqz3",matrixqz3,1}, -{"matsize",matsize,1}, -{"modreverse",polymodrecip,1}, -{"mu",gmu,1}, -{"nextprime",nextprime,1}, -{"norm",gnorm,1}, -{"norml2",gnorml2,1}, -{"numdiv",numbdiv,1}, -{"numer",numer,1}, -{"omega",gomega,1}, -{"order",order,1}, -{"ordred",ordred,1}, -{"phi",phi,1}, -{"pnqn",pnqn,1}, -{"polred",polred,1}, -{"polred2",polred2,1}, -{"primroot",gener,1}, -{"psi",gpsi,1}, -{"quadgen",quadgen ,1}, -{"quadpoly",quadpoly ,1}, -{"real",greal,1}, -{"recip",polrecip ,1}, -{"redreal",redreal ,1}, -{"regula",regula ,1}, -{"reorder",reorder ,1}, -{"reverse",recip ,1}, -{"rhoreal",rhoreal ,1}, -{"roots",roots,1}, -{"round",ground,1}, -{"sigma",sumdiv,1}, -{"signat",signat,1}, -{"simplify",simplify,1}, -{"smalldiscf",smalldiscf,1}, -{"smallfact",smallfact,1}, -{"smallpolred",smallpolred,1}, -{"smallpolred2",smallpolred2,1}, -{"smith",smith,1}, -{"smith2",smith2,1}, -{"sort",sort,1}, -{"sqr",gsqr,1}, -{"sqred",sqred,1}, -{"sqrt",gsqrt,1}, -{"supplement",suppl,1}, -{"trace",gtrace,1}, -{"trans",gtrans,1}, -{"trunc",gtrunc,1}, -{"unit",fundunit,1}, -{"vec",gtovec,1}, -{"wf",wf,1}, -{"wf2",wf2,1}, -{"zeta",gzeta,1}, +{"arg",0,1}, +{"bigomega",0,1}, +{"binary",0,1}, +{"ceil",0,1}, +{"centerlift",0,1}, +{"cf",0,1}, +{"classno",0,1}, +{"classno2",0,1}, +{"conj",0,1}, +{"content",0,1}, +{"denom",0,1}, +{"det",0,1}, +{"det2",0,1}, +{"dilog",0,1}, +{"disc",0,1}, +{"discf",0,1}, +{"divisors",0,1}, +{"eigen",0,1}, +{"eintg1",0,1}, +{"erfc",0,1}, +{"eta",0,1}, +{"floor",0,1}, +{"frac",0,1}, +{"galois",0,1}, +{"galoisconj",0,1}, +{"gamh",0,1}, +{"gamma",0,1}, +{"hclassno",0,1}, +{"hermite",0,1}, +{"hess",0,1}, +{"imag",0,1}, +{"image",0,1}, +{"image2",0,1}, +{"indexrank",0,1}, +{"indsort",0,1}, +{"initalg",0,1}, +{"isfund",0,1}, +{"ispsp",0,1}, +{"isqrt",0,1}, +{"issqfree",0,1}, +{"issquare",0,1}, +{"jacobi",0,1}, +{"jell",0,1}, +{"ker",0,1}, +{"keri",0,1}, +{"kerint",0,1}, +{"kerintg1",0,1}, +{"length",0,1}, +{"lexsort",0,1}, +{"lift",0,1}, +{"lindep",0,1}, +{"lll",0,1}, +{"lllgen",0,1}, +{"lllgram",0,1}, +{"lllgramgen",0,1}, +{"lllgramint",0,1}, +{"lllgramkerim",0,1}, +{"lllgramkerimgen",0,1}, +{"lllint",0,1}, +{"lllkerim",0,1}, +{"lllkerimgen",0,1}, +{"lngamma",0,1}, +{"logagm",0,1}, +{"mat",0,1}, +{"matrixqz2",0,1}, +{"matrixqz3",0,1}, +{"matsize",0,1}, +{"modreverse",0,1}, +{"mu",0,1}, +{"nextprime",0,1}, +{"norm",0,1}, +{"norml2",0,1}, +{"numdiv",0,1}, +{"numer",0,1}, +{"omega",0,1}, +{"order",0,1}, +{"ordred",0,1}, +{"phi",0,1}, +{"pnqn",0,1}, +{"polred",0,1}, +{"polred2",0,1}, +{"primroot",0,1}, +{"psi",0,1}, +{"quadgen",0,1}, +{"quadpoly",0,1}, +{"real",0,1}, +{"recip",0,1}, +{"redreal",0,1}, +{"regula",0,1}, +{"reorder",0,1}, +{"reverse",0,1}, +{"rhoreal",0,1}, +{"roots",0,1}, +{"round",0,1}, +{"sigma",0,1}, +{"signat",0,1}, +{"simplify",0,1}, +{"smalldiscf",0,1}, +{"smallfact",0,1}, +{"smallpolred",0,1}, +{"smallpolred2",0,1}, +{"smith",0,1}, +{"smith2",0,1}, +{"sort",0,1}, +{"sqr",0,1}, +{"sqred",0,1}, +{"sqrt",0,1}, +{"supplement",0,1}, +{"trace",0,1}, +{"trans",0,1}, +{"trunc",0,1}, +{"unit",0,1}, +{"vec",0,1}, +{"wf",0,1}, +{"wf2",0,1}, +{"zeta",0,1}, +{"factor",0,1}, + +{"allocatemem",0,0}, + +{"isprime",0,2}, +{"factorint",0,2}, {0,0,0}, }; @@ -304,17 +268,5 @@ void parif_init() { int i; for ( i = 0, parif = 0; pariftab[i].name; i++ ) - appendparif(&parif,pariftab[i].name, (int (*)())pariftab[i].f,pariftab[i].type); + appendparif(&parif,pariftab[i].name, 0,pariftab[i].type); } -#else /* PARI */ - -struct ftab pari_tab[] = { - {0,0,0}, -}; - -void parif_init() {} - -pointer evalparif() { - error("evalparif : PARI is not combined."); -} -#endif /*PARI */