OpenXM_contrib2/asir2000/builtin/parif.c - diff

Return to parif.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/parif.c between version 1.8 and 1.17

version 1.8, 2001/07/05 09:26:43

version 1.17, 2011/08/10 04:51:57

Line 45

* 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.7 2000/12/22 09:58:32 saito Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.16 2009/03/27 14:42:29 ohara Exp $

#include "ca.h"

#include "parse.h"

#if PARI

#if defined(PARI)

#include "genpari.h"

// PARI_VERSION(2,2,8) == 131592

#if PARI_VERSION_CODE >= 131592

#define mppgcd(a,b) (gcdii((a),(b)))

#endif

extern long prec;

long get_pariprec();

void set_pariprec(long p);

void patori(GEN,Obj *);

void patori_i(GEN,N *);

void ritopa(Obj,GEN *);

void ritopa_i(N,int,GEN *);

void Ptodouble();

void Peval(),Psetprec(),p_pi(),p_e(),p_mul(),p_gcd();

void asir_cgiv(GEN);

Line 70 void Psetprecword();

Line 76 void Psetprecword();

struct ftab pari_tab[] = {

{"eval",Peval,-2},

{"setprec",Psetprec,-1},

{"todouble",Ptodouble,1},

#if defined(INTERVAL) || 1

{"setprecword",Psetprecword,-1},

#endif

{0,0,0},

};

#define MKPREC(a,i,b) (argc(a)==(i)?mkprec(QTOS((Q)(b))):prec)

#define MKPREC(a,i,b) (argc(a)==(i)?mkprec(QTOS((Q)(b))):get_pariprec())

#define CALLPARI1(f,a,p,r)\

ritopa((Obj)a,&_pt1_); _pt2_ = f(_pt1_,p); patori(_pt2_,r); asir_cgiv(_pt2_); asir_cgiv(_pt1_)

Line 93 void f(ar,rp) NODE ar; Obj *rp;\

Line 100 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(INTERVAL)

#define PREC_CONV pariK1

#define PREC_CONV (0.103810253/(BYTES_IN_LONG/4)) /* log(10)/(SL*log(2)) */

#else

#elif SIZEOF_LONG == 4

#if defined(LONG_IS_32BIT)

#define PREC_CONV 0.103810253

#endif

#elif SIZEOF_LONG == 8

#if defined(LONG_IS_64BIT)

#define PREC_CONV 0.051905126

#endif

/* XXX : we should be more careful when we free PARI pointers. */

Line 117 GEN ptr;

Line 121 GEN ptr;

mkprec(p)

int p;

{

if ( p > 0 )

if ( p <= 0 )

return (int)(p*PREC_CONV+3);

p = 1;

return (int)(p*PREC_CONV+3);

}

void Ptodouble(arg,rp)

NODE arg;

Num *rp;

{

double r,i;

Real real,imag;

Num num;

asir_assert(ARG0(arg),O_N,"todouble");

num = (Num)ARG0(arg);

if ( !num ) {

*rp = 0;

return;

}

switch ( NID(num) ) {

case N_R: case N_Q: case N_B:

r = ToReal(num);

MKReal(r,real);

*rp = (Num)real;

break;

case N_C:

r = ToReal(((C)num)->r);

i = ToReal(((C)num)->i);

MKReal(r,real);

MKReal(i,imag);

reimtocplx((Num)real,(Num)imag,rp);

break;

default:

*rp = num;

break;

}

void Peval(arg,rp)

NODE arg;

Obj *rp;

Line 135 Obj *rp;

Line 173 Obj *rp;

{

int p;

Q q;

long prec = get_pariprec();

#if defined(INTERVAL) || 1

p = (int)((prec-2)/PREC_CONV); STOQ(p,q); *rp = (Obj)q;

Line 151 Obj *rp;

Line 190 Obj *rp;

prec = mkprec(QTOS((Q)ARG0(arg)));

}

#endif

set_pariprec(prec);

}

#if defined(INTERVAL) || 1

Line 160 Obj *rp;

Line 200 Obj *rp;

{

int p;

Q q;

long prec = get_pariprec();

p = (int)((prec-2)); STOQ(p,q); *rp = (Obj)q;

if ( arg ) {

Line 169 Obj *rp;

Line 210 Obj *rp;

prec = p + 2;

}

set_pariprec(prec);

}

#endif

Line 228 NODE arg;

Line 270 NODE arg;

GEN a,v;

long ltop,lbot;

pointer r;

int ac,opt;

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);

Line 256 NODE arg;

Line 317 NODE arg;

if ( !ac || ( ac > 2 ) ) {

fprintf(stderr,"argument mismatch in %s()\n",NAME(f));

error("");

/* NOTREACHED */

return 0;

}

if ( ac == 1 )

opt = 0;

Line 271 NODE arg;

Line 334 NODE arg;

default:

error("evalparif : not implemented yet.");

/* NOTREACHED */

return 0;

}

Line 287 struct pariftab {

Line 352 struct pariftab {

struct pariftab pariftab[] = {

{"allocatemem",(GEN(*)())allocatemoremem,0},

{"abs",(GEN (*)())gabs,1},

{"adj",adj,1},

{"arg",garg,1},

Line 326 struct pariftab pariftab[] = {

Line 392 struct pariftab pariftab[] = {

{"indsort",indexsort,1},

{"initalg",initalg,1},

{"isfund",gisfundamental,1},

{"isprime",gisprime,1},

{"isprime",gisprime,2},

{"ispsp",gispsp,1},

{"isqrt",racine,1},

{"issqfree",gissquarefree,1},

Line 337 struct pariftab pariftab[] = {

Line 403 struct pariftab pariftab[] = {

{"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},

Line 354 struct pariftab pariftab[] = {

Line 417 struct pariftab pariftab[] = {

{"lllint",lllint,1},

{"lllkerim",lllkerim,1},

{"lllkerimgen",lllkerimgen,1},

{"lllrat",lllrat,1},

{"lngamma",glngamma,1},

{"logagm",glogagm,1},

{"mat",gtomat,1},

Line 410 struct pariftab pariftab[] = {

Line 472 struct pariftab pariftab[] = {

{"wf",wf,1},

{"wf2",wf2,1},

{"zeta",gzeta,1},

{"factor",factor,1},

{"factorint",factorint,2},

{0,0,0},

};

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>