version 1.7, 2000/12/22 09:58:32 |
version 1.10, 2001/10/09 01:36:06 |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* 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 "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
mkprec(p) |
mkprec(p) |
int p; |
int p; |
{ |
{ |
if ( p > 0 ) |
if ( p <= 0 ) |
return (int)(p*PREC_CONV+3); |
p = 1; |
|
return (int)(p*PREC_CONV+3); |
} |
} |
|
|
void Peval(arg,rp) |
void Peval(arg,rp) |
|
|
GEN a,v; |
GEN a,v; |
long ltop,lbot; |
long ltop,lbot; |
pointer r; |
pointer r; |
int ac; |
int ac,opt,intarg,ret; |
char buf[BUFSIZ]; |
char buf[BUFSIZ]; |
|
Q q; |
|
GEN (*dmy)(); |
|
|
if ( !f->f.binf ) { |
if ( !f->f.binf ) { |
sprintf(buf,"pari : %s undefined.",f->name); |
sprintf(buf,"pari : %s undefined.",f->name); |
error(buf); |
error(buf); |
|
/* NOTREACHED */ |
|
return 0; |
} |
} |
switch ( f->type ) { |
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: |
case 1: |
ac = argc(arg); |
ac = argc(arg); |
if ( !ac || ( ac > 2 ) ) { |
if ( !ac || ( ac > 2 ) ) { |
fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); |
fprintf(stderr,"argument mismatch in %s()\n",NAME(f)); |
error(""); |
error(""); |
|
/* NOTREACHED */ |
|
return 0; |
} |
} |
ltop = avma; |
ltop = avma; |
ritopa((Obj)ARG0(arg),&a); |
ritopa((Obj)ARG0(arg),&a); |
#if 1 || defined(__MWERKS__) |
|
{ |
|
GEN (*dmy)(); |
|
|
|
dmy = (GEN (*)())f->f.binf; |
dmy = (GEN (*)())f->f.binf; |
v = (*dmy)(a,MKPREC(arg,2,ARG1(arg))); |
v = (*dmy)(a,MKPREC(arg,2,ARG1(arg))); |
} |
|
#else |
|
v = (GEN)(*f->f.binf)(a,MKPREC(arg,2,ARG1(arg))); |
|
#endif |
|
lbot = avma; |
lbot = avma; |
patori(v,(Obj *)&r); gerepile(ltop,lbot,0); |
patori(v,(Obj *)&r); gerepile(ltop,lbot,0); |
return r; |
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: |
default: |
error("evalparif : not implemented yet."); |
error("evalparif : not implemented yet."); |
|
/* NOTREACHED */ |
|
return 0; |
} |
} |
} |
} |
|
|
Line 268 struct pariftab { |
|
Line 304 struct pariftab { |
|
int type; |
int type; |
}; |
}; |
|
|
|
/* |
|
* type = 1 => argc = 1, second arg = precision |
|
* type = 2 => argc = 1, second arg = optional (long int) |
|
* |
|
*/ |
|
|
struct pariftab pariftab[] = { |
struct pariftab pariftab[] = { |
|
{"allocatemem",(GEN(*)())allocatemoremem,0}, |
{"abs",(GEN (*)())gabs,1}, |
{"abs",(GEN (*)())gabs,1}, |
{"adj",adj,1}, |
{"adj",adj,1}, |
{"arg",garg,1}, |
{"arg",garg,1}, |
Line 392 struct pariftab pariftab[] = { |
|
Line 435 struct pariftab pariftab[] = { |
|
{"wf",wf,1}, |
{"wf",wf,1}, |
{"wf2",wf2,1}, |
{"wf2",wf2,1}, |
{"zeta",gzeta,1}, |
{"zeta",gzeta,1}, |
|
{"factor",factor,1}, |
|
{"factorint",factorint,2}, |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|