version 1.7, 2015/08/07 08:00:30 |
version 1.9, 2015/08/17 05:18:36 |
|
|
/* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.6 2015/08/07 06:15:00 takayama Exp $ */ |
/* $OpenXM: OpenXM_contrib2/asir2000/builtin/bfaux.c,v 1.8 2015/08/16 03:12:09 noro Exp $ */ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
void Peval(), Psetprec(), Psetbprec(), Ptodouble(), Psetround(); |
void Peval(), Psetprec(), Psetbprec(), Ptodouble(), Psetround(); |
void Pmpfr_gamma(), Pmpfr_floor(), Pmpfr_round(); |
void Pmpfr_ai(); |
|
void Pmpfr_eint(), Pmpfr_erf(), Pmpfr_erfc(), 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(); |
|
|
struct ftab bf_tab[] = { |
struct ftab bf_tab[] = { |
{"eval",Peval,-2}, |
{"eval",Peval,-2}, |
Line 11 struct ftab bf_tab[] = { |
|
Line 17 struct ftab bf_tab[] = { |
|
{"setbprec",Psetbprec,-1}, |
{"setbprec",Psetbprec,-1}, |
{"setround",Psetround,-1}, |
{"setround",Psetround,-1}, |
{"todouble",Ptodouble,1}, |
{"todouble",Ptodouble,1}, |
|
{"mpfr_ai",Pmpfr_ai,-2}, |
|
{"mpfr_zeta",Pmpfr_zeta,-2}, |
|
{"mpfr_j0",Pmpfr_j0,-2}, |
|
{"mpfr_j1",Pmpfr_j1,-2}, |
|
{"mpfr_y0",Pmpfr_y0,-2}, |
|
{"mpfr_y1",Pmpfr_y1,-2}, |
|
{"mpfr_eint",Pmpfr_eint,-2}, |
|
{"mpfr_erf",Pmpfr_erf,-2}, |
|
{"mpfr_erfc",Pmpfr_erfc,-2}, |
|
{"mpfr_li2",Pmpfr_li2,-2}, |
{"mpfr_gamma",Pmpfr_gamma,-2}, |
{"mpfr_gamma",Pmpfr_gamma,-2}, |
{"mpfr_floor",Pmpfr_floor,-1}, |
{"mpfr_lngamma",Pmpfr_gamma,-2}, |
{"mpfr_round",Pmpfr_round,-1}, |
{"mpfr_digamma",Pmpfr_gamma,-2}, |
|
{"mpfr_floor",Pmpfr_floor,-2}, |
|
{"mpfr_ceil",Pmpfr_ceil,-2}, |
|
{"mpfr_round",Pmpfr_round,-2}, |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|
Line 381 void mp_pow(NODE arg,BF *rp) |
|
Line 400 void mp_pow(NODE arg,BF *rp) |
|
*rp = r; |
*rp = r; |
} |
} |
|
|
|
#define SETPREC \ |
|
(prec)=NEXT(arg)?QTOS((Q)ARG1(arg)):0;\ |
|
(prec)*=3.32193;\ |
|
(a)=tobf(ARG0(arg),prec);\ |
|
NEWBF(r);\ |
|
prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body); |
|
|
|
|
void Pmpfr_gamma(NODE arg,BF *rp) |
void Pmpfr_gamma(NODE arg,BF *rp) |
{ |
{ |
Num a; |
Num a; |
int prec; |
int prec; |
BF r; |
BF r; |
|
|
prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0; |
SETPREC |
prec *= 3.32193; |
|
a = tobf(ARG0(arg),prec); |
|
NEWBF(r); |
|
prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body); |
|
mpfr_gamma(r->body,((BF)a)->body,mpfr_roundmode); |
mpfr_gamma(r->body,((BF)a)->body,mpfr_roundmode); |
*rp = r; |
*rp = r; |
} |
} |
|
|
|
void Pmpfr_lngamma(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_lngamma(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_digamma(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_digamma(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_zeta(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_zeta(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_eint(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_eint(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_erf(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_erf(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_erfc(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_erfc(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_j0(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_j0(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_j1(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_j1(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_y0(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_y0(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_y1(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_y1(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_li2(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_li2(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
|
void Pmpfr_ai(NODE arg,BF *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
|
|
SETPREC |
|
mpfr_ai(r->body,((BF)a)->body,mpfr_roundmode); |
|
*rp = r; |
|
} |
|
|
void Pmpfr_floor(NODE arg,Q *rp) |
void Pmpfr_floor(NODE arg,Q *rp) |
{ |
{ |
Num a; |
Num a; |
Line 404 void Pmpfr_floor(NODE arg,Q *rp) |
|
Line 559 void Pmpfr_floor(NODE arg,Q *rp) |
|
mpz_t t; |
mpz_t t; |
GZ rz; |
GZ rz; |
|
|
prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0; |
SETPREC |
prec *= 3.32193; |
|
a = tobf(ARG0(arg),prec); |
|
NEWBF(r); |
|
prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body); |
|
mpfr_floor(r->body,((BF)a)->body); |
mpfr_floor(r->body,((BF)a)->body); |
mpz_init(t); |
mpz_init(t); |
mpfr_get_z(t,r->body,mpfr_roundmode); |
mpfr_get_z(t,r->body,mpfr_roundmode); |
Line 416 void Pmpfr_floor(NODE arg,Q *rp) |
|
Line 567 void Pmpfr_floor(NODE arg,Q *rp) |
|
*rp = gztoz(rz); |
*rp = gztoz(rz); |
} |
} |
|
|
|
void Pmpfr_ceil(NODE arg,Q *rp) |
|
{ |
|
Num a; |
|
int prec; |
|
BF r; |
|
mpz_t t; |
|
GZ rz; |
|
|
|
SETPREC |
|
mpfr_ceil(r->body,((BF)a)->body); |
|
mpz_init(t); |
|
mpfr_get_z(t,r->body,mpfr_roundmode); |
|
MPZTOGZ(t,rz); |
|
*rp = gztoz(rz); |
|
} |
|
|
void Pmpfr_round(NODE arg,Q *rp) |
void Pmpfr_round(NODE arg,Q *rp) |
{ |
{ |
Num a; |
Num a; |
Line 424 void Pmpfr_round(NODE arg,Q *rp) |
|
Line 591 void Pmpfr_round(NODE arg,Q *rp) |
|
mpz_t t; |
mpz_t t; |
GZ rz; |
GZ rz; |
|
|
prec = NEXT(arg) ? QTOS((Q)ARG1(arg)) : 0; |
SETPREC |
prec *= 3.32193; |
|
a = tobf(ARG0(arg),prec); |
|
NEWBF(r); |
|
prec ? mpfr_init2(r->body,prec) : mpfr_init(r->body); |
|
mpfr_round(r->body,((BF)a)->body); |
mpfr_round(r->body,((BF)a)->body); |
mpz_init(t); |
mpz_init(t); |
mpfr_get_z(t,r->body,mpfr_roundmode); |
mpfr_get_z(t,r->body,mpfr_roundmode); |