=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/parif.c,v retrieving revision 1.7 retrieving revision 1.10 diff -u -p -r1.7 -r1.10 --- OpenXM_contrib2/asir2000/builtin/parif.c 2000/12/22 09:58:32 1.7 +++ OpenXM_contrib2/asir2000/builtin/parif.c 2001/10/09 01:36:06 1.10 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.6 2000/12/05 01:24:51 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.9 2001/10/03 01:47:30 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -117,8 +117,9 @@ GEN ptr; mkprec(p) int p; { - if ( p > 0 ) - return (int)(p*PREC_CONV+3); + if ( p <= 0 ) + p = 1; + return (int)(p*PREC_CONV+3); } void Peval(arg,rp) @@ -228,37 +229,72 @@ NODE arg; GEN a,v; long ltop,lbot; pointer r; - int ac; + int ac,opt,intarg,ret; char buf[BUFSIZ]; + Q q; + GEN (*dmy)(); if ( !f->f.binf ) { sprintf(buf,"pari : %s undefined.",f->name); error(buf); + /* NOTREACHED */ + return 0; } switch ( f->type ) { + case 0: /* in/out : integer */ + ac = argc(arg); + if ( ac > 2 ) { + fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); + error(""); + /* NOTREACHED */ + return 0; + } + intarg = !ac ? 0 : QTOS((Q)ARG0(arg)); + dmy = (GEN (*)())f->f.binf; + ret = (int)(*dmy)(intarg); + STOQ(ret,q); + return (pointer)q; + case 1: ac = argc(arg); if ( !ac || ( ac > 2 ) ) { fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); error(""); + /* NOTREACHED */ + return 0; } 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; + + case 2: + ac = argc(arg); + if ( !ac || ( ac > 2 ) ) { + fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); + error(""); + /* NOTREACHED */ + return 0; + } + if ( ac == 1 ) + opt = 0; + else + opt = QTOS((Q)ARG1(arg)); + ltop = avma; + ritopa((Obj)ARG0(arg),&a); + dmy = (GEN (*)())f->f.binf; + v = (*dmy)(a,opt); + lbot = avma; + patori(v,(Obj *)&r); gerepile(ltop,lbot,0); + return r; + default: error("evalparif : not implemented yet."); + /* NOTREACHED */ + return 0; } } @@ -268,7 +304,14 @@ struct pariftab { int type; }; +/* + * type = 1 => argc = 1, second arg = precision + * type = 2 => argc = 1, second arg = optional (long int) + * + */ + struct pariftab pariftab[] = { +{"allocatemem",(GEN(*)())allocatemoremem,0}, {"abs",(GEN (*)())gabs,1}, {"adj",adj,1}, {"arg",garg,1}, @@ -392,6 +435,8 @@ struct pariftab pariftab[] = { {"wf",wf,1}, {"wf2",wf2,1}, {"zeta",gzeta,1}, +{"factor",factor,1}, +{"factorint",factorint,2}, {0,0,0}, };