===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/parif.c,v
retrieving revision 1.1.1.1
retrieving revision 1.25
diff -u -p -r1.1.1.1 -r1.25
--- OpenXM_contrib2/asir2000/builtin/parif.c	1999/12/03 07:39:07	1.1.1.1
+++ OpenXM_contrib2/asir2000/builtin/parif.c	2015/08/17 05:18:36	1.25
@@ -1,302 +1,234 @@
-/* $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.24 2015/08/16 03:12:09 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;
 
-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;
+pointer evalparif(FUNC f,NODE arg)
 {
-	int p;
-	Q q;
+  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;
 
-	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 ( mpfr_function = mpfr_search(f->name) ) {
+     (*mpfr_function)(arg,&ret);
+     return (pointer) ret;
+  }
 
-void p_pi(arg,rp)
-NODE arg;
-Obj *rp;
-{
-	GEN x;
+  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;
+  }
 
-	x = mppi(MKPREC(arg,1,ARG0(arg)));
-	patori(x,rp); cgiv(x);
+	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);
+  Pox_pop_cmo(oxarg,&r);
+  return r;
 }
 
-void p_e(arg,rp)
-NODE arg;
-Obj *rp;
-{
-	GEN x;
-
-	x = gexp(gun,MKPREC(arg,1,ARG0(arg))); patori(x,rp); cgiv(x);
-}
-
-void p_mul(a,b,r)
-Obj a,b,*r;
-{
-	GEN p1,p2,p3;
-
-	ritopa((Obj)a,&p1); ritopa((Obj)b,&p2);
-	p3 = mulii(p1,p2);
-	patori(p3,r); cgiv(p3); cgiv(p2); cgiv(p1);
-}
-
-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 +236,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 */