haskell-mpfr-0.1: cbits/mpfr-wrappers.cmm
#include "Cmm.h"
#include "MpfrDerivedConstants.h"
/*
TODO: check if MPFR_DECL_INIT gives better results than mpfr_init2
*/
#define MPFR_REBUILD(X, Y, Z, mpfr) \
if (X >> PREC_SHIFT == 0) { \
MPFR__mpfr_sign(mpfr) = 1; \
} else { \
MPFR__mpfr_sign(mpfr) = -1; \
} \
\
MPFR__mpfr_prec(mpfr) = X & ~(1 << PREC_SHIFT); \
MPFR__mpfr_exp(mpfr) = Y; \
MPFR__mpfr_d(mpfr) = MPFR_MANGLE_PTR(BYTE_ARR_CTS(Z));
#define MPFR_RETURN1(mpfr, rets...) \
W_ sign_prec; \
if (MPFR__mpfr_sign(mpfr) <= 1) { \
sign_prec = MPFR__mpfr_prec(mpfr); \
} else { \
sign_prec = MPFR__mpfr_prec(mpfr) | (1 << PREC_SHIFT); \
} \
\
return( \
sign_prec, \
MPFR__mpfr_exp(mpfr), \
MPFR_UNMANGLE_PTR(MPFR__mpfr_d(mpfr)) - SIZEOF_StgArrWords, \
## rets);
#define MPFR_RETURN2(mpfr1, mpfr2, rets...) \
W_ sign_prec1; \
if (MPFR__mpfr_sign(mpfr1) <= 1) { \
sign_prec1 = MPFR__mpfr_prec(mpfr1); \
} else { \
sign_prec1 = MPFR__mpfr_prec(mpfr1) | (1 << PREC_SHIFT); \
} \
W_ sign_prec2; \
if (MPFR__mpfr_sign(mpfr2) <= 1) { \
sign_prec2 = MPFR__mpfr_prec(mpfr2); \
} else { \
sign_prec2 = MPFR__mpfr_prec(mpfr2) | (1 << PREC_SHIFT); \
} \
\
return( \
sign_prec1, \
MPFR__mpfr_exp(mpfr1), \
MPFR_UNMANGLE_PTR(MPFR__mpfr_d(mpfr1)) - SIZEOF_StgArrWords, \
sign_prec2, \
MPFR__mpfr_exp(mpfr2), \
MPFR_UNMANGLE_PTR(MPFR__mpfr_d(mpfr2)) - SIZEOF_StgArrWords, \
## rets);
mpfr_cmm_init_si(W_ rnd, W_ prec, W_ i)
{
/* arguments: R1 = rounding, R2 = precision, R3 = int */
W_ mpfr;
STK_CHK_GEN_N(SIZEOF_MPFR);
mpfr = Sp - SIZEOF_MPFR;
ccall mpfr_init2(mpfr "ptr", prec);
ccall mpfr_set_si(mpfr "ptr", i, rnd);
MPFR_RETURN1(mpfr);
}
mpfr_cmm_init_z(W_ rnd, W_ prec, W_ sz, P_ d)
{
/* arguments: R1 = rounding, R2 = precision, R3 = size, R4 = limbs */
CInt s;
W_ mpfr, mpz;
s = W_TO_INT(sz);
again:
STK_CHK_GEN_N(SIZEOF_MPFR + SIZEOF_MP_INT);
MAYBE_GC(again);
mpfr = Sp - SIZEOF_MPFR;
mpz = Sp - SIZEOF_MPFR - SIZEOF_MP_INT;
MP_INT__mp_alloc(mpz) = W_TO_INT(BYTE_ARR_WDS(d));
MP_INT__mp_size(mpz) = (s);
MP_INT__mp_d(mpz) = BYTE_ARR_CTS(d);
ccall mpfr_init2(mpfr "ptr", prec);
ccall mpfr_set_z(mpfr "ptr", mpz, rnd);
MPFR_RETURN1(mpfr);
}
mpfr_cmm_init_q(W_ rnd, W_ prec, W_ sz1, P_ d1, W_ sz2, P_ d2)
{
/* arguments: R1 = rounding, R2 = precision,
R3 = numerator size, R4 = numerator limbs
R5 = denominator size, R6 = denominator limbs */
CInt s1, s2;
W_ mpfr, mpq;
rnd = R1;
prec = R2;
s1 = W_TO_INT(sz1);
d1 = R4;
s2 = W_TO_INT(sz2);
d2 = R6;
again:
STK_CHK_GEN_N(SIZEOF_MPFR + SIZEOF_MP_RAT);
MAYBE_GC(again);
mpfr = Sp - SIZEOF_MPFR;
mpq = Sp - SIZEOF_MPFR - SIZEOF_MP_RAT;
MP_RAT__mp_num__mp_alloc(mpq) = W_TO_INT(BYTE_ARR_WDS(d1));
MP_RAT__mp_num__mp_size(mpq) = (s1);
MP_RAT__mp_num__mp_d(mpq) = BYTE_ARR_CTS(d1);
MP_RAT__mp_den__mp_alloc(mpq) = W_TO_INT(BYTE_ARR_WDS(d2));
MP_RAT__mp_den__mp_size(mpq) = (s2);
MP_RAT__mp_den__mp_d(mpq) = BYTE_ARR_CTS(d2);
ccall mpfr_init2(mpfr "ptr", prec);
ccall mpfr_set_q(mpfr "ptr", mpq "ptr", rnd);
MPFR_RETURN1(mpfr);
}
mpfr_cmm_init_d(W_ rnd, W_ prec, D_ dbl)
{
/* arguments: R1 = rounding, R2 = precision
D1 = double */
W_ mpfr;
STK_CHK_GEN_N(SIZEOF_MPFR);
mpfr = Sp - 1 * SIZEOF_MPFR;
ccall mpfr_init2(mpfr "ptr", prec);
ccall mpfr_set_d(mpfr "ptr", dbl, rnd);
MPFR_RETURN1(mpfr);
}
mpfr_cmm_init_z_2exp(W_ rnd, W_ prec, W_ exp, W_ sz, P_ d)
{
/* arguments: R1 = rounding, R2 = precision, R3 = exponent,
R4 = mpz size, R5 = mpz limbs */
CInt s;
W_ mpfr, mpz;
s = W_TO_INT(sz);
again:
STK_CHK_GEN_N(SIZEOF_MPFR + SIZEOF_MP_INT);
MAYBE_GC(again);
mpfr = Sp - SIZEOF_MPFR;
mpz = Sp - SIZEOF_MPFR - SIZEOF_MP_INT;
MP_INT__mp_alloc(mpz) = W_TO_INT(BYTE_ARR_WDS(d));
MP_INT__mp_size(mpz) = (s);
MP_INT__mp_d(mpz) = BYTE_ARR_CTS(d);
ccall mpfr_init2(mpfr "ptr", prec);
ccall mpfr_set_z_2exp(mpfr "ptr", mpz "ptr", exp, rnd);
MPFR_RETURN1(mpfr);
}
mpfr_cmm_get_d(W_ rnd, W_ ps, W_ exp, P_ limbs)
{
D_ ret;
W_ mpfr;
again:
STK_CHK_GEN_N(SIZEOF_MPFR);
MAYBE_GC(again);
mpfr = Sp - 1 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, mpfr);
(ret) = ccall mpfr_get_d(mpfr "ptr", rnd);
return (ret);
}
mpfr_cmm_get_d_2exp(W_ rnd, W_ ps, W_ exp, P_ limbs)
{
D_ ret;
W_ mpfr;
W_ rexp;
again:
STK_CHK_GEN_N(SIZEOF_MPFR + WDS(1));
MAYBE_GC(again);
mpfr = Sp - 1 * SIZEOF_MPFR;
rexp = Sp - 1 * SIZEOF_MPFR - WDS(1);
MPFR_REBUILD(ps, exp, limbs, mpfr);
(ret) = ccall mpfr_get_d_2exp(rexp "ptr", mpfr "ptr", rnd);
return (ret, W_[rexp]);
}
// arguments: R1 = prec * sign, R2 = exp, R3 = limbs
mpfr_cmm_get_z_2exp(W_ ps, W_ exp, P_ limbs)
{
W_ mpz, mpfr;
again:
STK_CHK_GEN_N(SIZEOF_MP_INT + SIZEOF_MPFR);
MAYBE_GC(again);
mpz = Sp - 1 * SIZEOF_MP_INT;
mpfr = Sp - 1 * SIZEOF_MP_INT - 1 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, mpfr);
ccall __gmpz_init(mpz "ptr");
// Since we're immutable, we could really just reuse the limbs, but I haven't figured
// out how to do that reliably yet.
(exp) = ccall mpfr_get_z_2exp(mpz "ptr", mpfr "ptr");
return(
exp,
TO_W_(MP_INT__mp_size(mpz)),
MP_INT__mp_d(mpz) - SIZEOF_StgArrWords);
}
mpfr_cmm_cmp(W_ ps1, W_ exp1, P_ limbs1, W_ ps2, W_ exp2, P_ limbs2)
{
/* arguments: R1 = prec * sign, R2 = exp, R3 = limbs
R4 = prec * sign, R5 = exp, R6 = limbs
*/
W_ ret, err, op1, op2;
again:
STK_CHK_GEN_N(SIZEOF_MPFR * 2);
MAYBE_GC(again);
op1 = Sp - 1 * SIZEOF_MPFR;
op2 = Sp - 2 * SIZEOF_MPFR;
MPFR_REBUILD(ps1, exp1, limbs1, op1);
MPFR_REBUILD(ps2, exp2, limbs2, op2);
ccall mpfr_clear_erangeflag();
(ret) = ccall mpfr_cmp(op1 "ptr",op2 "ptr");
if (ret == 0) {
(err) = ccall mpfr_erangeflag_p();
if (err != 0) {
ccall mpfr_clear_erangeflag();
}
ret = err;
}
return (ret);
}
mpfr_cmm_cmpabs(W_ ps1, W_ exp1, P_ limbs1, W_ ps2, W_ exp2, P_ limbs2)
{
/* arguments: R1 = prec * sign, R2 = exp, R3 = limbs
R4 = prec * sign, R5 = exp, R6 = limbs
*/
W_ ret, err, op1, op2;
again:
STK_CHK_GEN_N(SIZEOF_MPFR * 2);
MAYBE_GC(again);
op1 = Sp - 1 * SIZEOF_MPFR;
op2 = Sp - 2 * SIZEOF_MPFR;
MPFR_REBUILD(ps1, exp1, limbs1, op1);
MPFR_REBUILD(ps2, exp2, limbs2, op2);
ccall mpfr_clear_erangeflag();
(ret) = ccall mpfr_cmpabs(op1 "ptr",op2 "ptr");
if (ret == 0) {
(err) = ccall mpfr_erangeflag_p();
if (err != 0) {
ccall mpfr_clear_erangeflag();
}
ret = err;
}
return (ret);
}
mpfr_cmm_get_str(W_ rnd, W_ n, W_ base, W_ ps, W_ exp, P_ limbs)
{
// arguments: R1 = rounding mode, R2 = output precision,R3 = output number base, R4 = prec * sign, R5 = exp, R6 = limbs
W_ ret;
W_ mpfr;
again:
STK_CHK_GEN_N(SIZEOF_MPFR + WDS(1));
MAYBE_GC(again);
mpfr = Sp - 1 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, mpfr)
W_ dec;
dec = Sp - 1 * SIZEOF_MPFR - WDS(1);
// Free the memory...
(ret) = ccall mpfr_get_str(0, dec "ptr", base, n, mpfr "ptr", rnd);
return (W_[dec], ret - SIZEOF_StgArrWords);
}
mpfr_cmm_readbackstr(W_ ps, W_ exp, P_ limbs)
{
W_ ret;
W_ mpfr;
again:
STK_CHK_GEN_N(SIZEOF_MPFR + WDS(1));
MAYBE_GC(again);
mpfr = Sp - 1 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, mpfr)
W_ ret;
ret = Sp - 1 * SIZEOF_MPFR - WDS(1);
ccall mpfr_asprintf(ret "ptr", "%Re", mpfr "ptr");
return (W_[ret] - SIZEOF_StgArrWords);
}
mpfr_cmm_asprintf(P_ format, W_ precision, W_ rnd, W_ ps, W_ exp, P_ limbs)
{
W_ ret;
W_ mpfr;
again:
STK_CHK_GEN_N(SIZEOF_MPFR + WDS(1));
MAYBE_GC(again);
mpfr = Sp - 1 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, mpfr)
W_ ret;
ret = Sp - 1 * SIZEOF_MPFR - WDS(1);
ccall mpfr_asprintf(ret "ptr", format "ptr", precision, rnd, mpfr "ptr");
return (W_[ret] - SIZEOF_StgArrWords);
}
#define MPFR_COMPARISON(name,cmp) \
name(W_ ps1, W_ exp1, P_ limbs1, W_ ps2, W_ exp2, P_ limbs2) \
{ \
W_ ret, op1, op2; \
again: \
STK_CHK_GEN_N(SIZEOF_MPFR * 2); \
MAYBE_GC(again); \
op1 = Sp - 1 * SIZEOF_MPFR; \
op2 = Sp - 2 * SIZEOF_MPFR; \
MPFR_REBUILD(ps1, exp1, limbs1, op1); \
MPFR_REBUILD(ps2, exp2, limbs2, op2); \
(ret) = ccall cmp(op1 "ptr", op2 "ptr"); \
return (ret); \
}
#define MPFR_RTEST(name,test) \
name(W_ rnd, W_ ps1, W_ exp1, P_ limbs1) \
{ \
W_ op1, ret; \
again: \
STK_CHK_GEN_N(SIZEOF_MPFR * 1); \
MAYBE_GC(again); \
op1 = Sp - 1 * SIZEOF_MPFR; \
MPFR_REBUILD(ps1, exp1, limbs1, op1); \
(ret) = ccall test(rnd, op1 "ptr"); \
return (ret); \
}
#define MPFR_TEST(name,tst) \
name(W_ ps, W_ exp, P_ limbs) \
{ \
W_ ret, op; \
again: \
STK_CHK_GEN_N(SIZEOF_MPFR); \
MAYBE_GC(again); \
op = Sp - 1 * SIZEOF_MPFR; \
MPFR_REBUILD(ps, exp, limbs, op); \
(ret) = ccall tst(op "ptr"); \
return (ret); \
}
MPFR_TEST(mpfr_cmm_nan_p, mpfr_nan_p)
MPFR_TEST(mpfr_cmm_inf_p, mpfr_inf_p)
MPFR_TEST(mpfr_cmm_zero_p, mpfr_zero_p)
#define MPFR_TAKE2_RET1(name,mpfr_fun) \
name(W_ rnd, W_ prec, W_ ps1, W_ exp1, P_ limbs1, W_ ps2, W_ exp2, P_ limbs2) \
{ \
W_ op1, op2, ret; \
\
again: \
STK_CHK_GEN_N(3 * SIZEOF_MPFR); \
MAYBE_GC(again); \
\
op1 = Sp - 1 * SIZEOF_MPFR; \
op2 = Sp - 2 * SIZEOF_MPFR; \
ret = Sp - 3 * SIZEOF_MPFR; \
\
MPFR_REBUILD(ps1, exp1, limbs1, op1); \
MPFR_REBUILD(ps2, exp2, limbs2, op2); \
\
ccall mpfr_init2(ret "ptr", prec); \
ccall mpfr_fun(ret "ptr", op1 "ptr", op2 "ptr", rnd); \
\
MPFR_RETURN1(ret); \
}
#define MPFR_TAKE3_RET1(name,mpfr_fun) \
name(W_ rnd, W_ prec, W_ ps1, W_ exp1, P_ limbs1, W_ ps2, W_ exp2, P_ limbs2, W_ ps3, W_ exp3, P_ limbs3) \
{ \
W_ op1, op2, op3, ret; \
\
again: \
STK_CHK_GEN_N(4 * SIZEOF_MPFR); \
MAYBE_GC(again); \
\
op1 = Sp - 1 * SIZEOF_MPFR; \
op2 = Sp - 2 * SIZEOF_MPFR; \
op3 = Sp - 3 * SIZEOF_MPFR; \
ret = Sp - 4 * SIZEOF_MPFR; \
\
MPFR_REBUILD(ps1, exp1, limbs1, op1); \
MPFR_REBUILD(ps2, exp2, limbs2, op2); \
MPFR_REBUILD(ps3, exp3, limbs3, op3); \
\
ccall mpfr_init2(ret "ptr", prec); \
ccall mpfr_fun(ret "ptr", op1 "ptr", op2 "ptr", op3 "ptr", rnd); \
\
MPFR_RETURN1(ret); \
}
#define MPFR_INPLACE(name,mpfr_fun) \
name(W_ ps, W_ exp, P_ limbs) \
{ \
W_ prec, ret; \
\
prec = ps & ~(1 << PREC_SHIFT); \
\
again: \
STK_CHK_GEN_N(SIZEOF_MPFR); \
MAYBE_GC(again); \
\
ret = Sp - 1 * SIZEOF_MPFR; \
MPFR_REBUILD(ps, exp, limbs, ret); \
\
ccall mpfr_fun(ret "ptr"); \
\
MPFR_RETURN1(ret); \
}
MPFR_INPLACE(mpfr_cmm_nextabove, mpfr_nextabove)
MPFR_INPLACE(mpfr_cmm_nextbelow, mpfr_nextbelow)
mpfr_cmm_nexttoward(W_ ps, W_ exp, P_ limbs, W_ ps2, W_ exp2, P_ limbs2)
{
W_ o1, o2;
again:
STK_CHK_GEN_N(SIZEOF_MPFR * 2);
MAYBE_GC(again);
o1 = Sp - 1 * SIZEOF_MPFR;
o2 = Sp - 2 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, o1);
MPFR_REBUILD(ps2, exp2, limbs2, o2);
ccall mpfr_nexttoward(o1 "ptr", o2 "ptr");
MPFR_RETURN1(o1);
}
mpfr_cmm_copysign(W_ ps, W_ exp, P_ limbs, W_ ps2, W_ exp2, P_ limbs2)
{
W_ o1, o2;
again:
STK_CHK_GEN_N(SIZEOF_MPFR * 2);
MAYBE_GC(again);
o1 = Sp - 1 * SIZEOF_MPFR;
o2 = Sp - 2 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, o1);
MPFR_REBUILD(ps2, exp2, limbs2, o2);
ccall mpfr_copysign(o1 "ptr", o1 "ptr", o2 "ptr", 0);
MPFR_RETURN1(o1);
}
#define MPFR_TAKE1_RET1(name,mpfr_fun) \
name(W_ rnd, W_ prec, W_ ps, W_ exp, P_ limbs) \
{ \
W_ rnd, op1, ret; \
\
again: \
STK_CHK_GEN_N(2 * SIZEOF_MPFR); \
MAYBE_GC(again); \
\
op1 = Sp - 1 * SIZEOF_MPFR; \
ret = Sp - 2 * SIZEOF_MPFR; \
\
MPFR_REBUILD(ps, exp, limbs, op1); \
\
ccall mpfr_init2(ret "ptr", prec); \
ccall mpfr_fun(ret "ptr", op1 "ptr", rnd); \
\
MPFR_RETURN1(ret); \
} \
name##_(W_ rnd, W_ prec, W_ ps, W_ exp, P_ limbs) \
{ \
W_ rnd, op1, ret, ternary; \
\
again: \
STK_CHK_GEN_N(2 * SIZEOF_MPFR); \
MAYBE_GC(again); \
\
op1 = Sp - 1 * SIZEOF_MPFR; \
ret = Sp - 2 * SIZEOF_MPFR; \
\
MPFR_REBUILD(ps, exp, limbs, op1); \
\
ccall mpfr_init2(ret "ptr", prec); \
(ternary) = ccall mpfr_fun(ret "ptr", op1 "ptr", rnd); \
\
MPFR_RETURN1(ret, ternary); \
}
#define MPFR_CONSTANT(name,mpfr_constant) \
name(W_ rnd, W_ prec) \
{ \
W_ mpfr; \
STK_CHK_GEN_N(SIZEOF_MPFR); \
mpfr = Sp - 1 * SIZEOF_MPFR; \
ccall mpfr_init2(mpfr "ptr", prec); \
ccall mpfr_constant(mpfr "ptr", rnd); \
\
MPFR_RETURN1(mpfr); \
}
#define MPFR_TAKE1_RET2(name,mpfr_fun) \
name(W_ rnd, W_ prec1, W_ prec2, W_ ps, W_ exp, P_ limbs) \
{ \
W_ rnd, op1, ret1, ret2; \
\
again: \
STK_CHK_GEN_N(3 * SIZEOF_MPFR); \
MAYBE_GC(again); \
\
op1 = Sp - 1 * SIZEOF_MPFR; \
ret1 = Sp - 2 * SIZEOF_MPFR; \
ret2 = Sp - 3 * SIZEOF_MPFR; \
\
MPFR_REBUILD(ps, exp, limbs, op1); \
\
ccall mpfr_init2(ret1 "ptr", prec1); \
ccall mpfr_init2(ret2 "ptr", prec2); \
ccall mpfr_fun(ret1 "ptr", ret2 "ptr", op1 "ptr", rnd); \
\
MPFR_RETURN2(ret1,ret2); \
}
#define MPFR_ROUNDING(name,mpfr_fun) \
name(W_ prec, W_ ps, W_ exp, P_ limbs) \
{ \
W_ op1, ret; \
\
again: \
STK_CHK_GEN_N(2 * SIZEOF_MPFR); \
MAYBE_GC(again); \
\
op1 = Sp - 1 * SIZEOF_MPFR; \
ret = Sp - 2 * SIZEOF_MPFR; \
\
MPFR_REBUILD(ps, exp, limbs, op1); \
\
ccall mpfr_init2(ret "ptr", prec); \
ccall mpfr_fun(ret "ptr", op1 "ptr"); \
\
MPFR_RETURN1(ret); \
}
MPFR_TAKE1_RET1(mpfr_cmm_set, mpfr_set)
#define UNARY_(hname,cname) MPFR_TAKE1_RET1(mpfr_cmm_##cname, mpfr_##cname)
#define UNARY(name) MPFR_TAKE1_RET1(mpfr_cmm_##name, mpfr_##name)
#define BINARY(name) MPFR_TAKE2_RET1(mpfr_cmm_##name, mpfr_##name)
#define CONST(hname, cname) MPFR_CONSTANT(mpfr_cmm_##cname, mpfr_##cname)
#define UNARY2(hname,cname) MPFR_TAKE1_RET2(mpfr_cmm_##cname, mpfr_##cname)
#define TERNARY(name) MPFR_TAKE3_RET1(mpfr_cmm_##name, mpfr_##name)
#define COMPARISON(hname,cname) MPFR_COMPARISON(mpfr_cmm_##cname, mpfr_##cname)
#define ROUNDING(name) MPFR_ROUNDING(mpfr_cmm_##name, mpfr_##name)
#define RTEST(hname,cname) MPFR_RTEST(mpfr_cmm_##cname, mpfr_##cname)
#define TEST(hname,cname) MPFR_TEST(mpfr_cmm_##cname, mpfr_##cname)
TEST(sgn, sgn)
#include "Data/Approximate/MPFR/special.h"
#include "Data/Approximate/MPFR/arithmetics.h"
#include "Data/Approximate/MPFR/comparison.h"
#include "Data/Approximate/MPFR/integer.h"
#include "Data/Approximate/MPFR/conversion.h"
mpfr_cmm_fac(W_ rnd, W_ prec, W_ x)
{
W_ ret;
W_ ternary;
again:
STK_CHK_GEN_N(1 * SIZEOF_MPFR);
MAYBE_GC(again);
ret = Sp - 1 * SIZEOF_MPFR;
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_fac_ui(ret "ptr", x, rnd);
MPFR_RETURN1(ret);
}
mpfr_cmm_zetaw(W_ rnd, W_ prec, W_ x)
{
W_ ret;
W_ ternary;
again:
STK_CHK_GEN_N(1 * SIZEOF_MPFR);
MAYBE_GC(again);
ret = Sp - 1 * SIZEOF_MPFR;
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_zeta_ui(ret "ptr", x, rnd);
MPFR_RETURN1(ret);
}
mpfr_cmm_root(W_ rnd, W_ prec, W_ x, W_ ps, W_ exp, P_ limbs)
{
W_ op, ret;
W_ ternary;
again:
STK_CHK_GEN_N(1 * SIZEOF_MPFR);
MAYBE_GC(again);
op = Sp - 1 * SIZEOF_MPFR;
ret = Sp - 2 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, op);
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_root(ret "ptr", op, x, rnd);
MPFR_RETURN1(ret);
}
mpfr_cmm_jn(W_ rnd, W_ prec, W_ x, W_ ps, W_ exp, P_ limbs)
{
W_ op, ret;
W_ ternary;
again:
STK_CHK_GEN_N(1 * SIZEOF_MPFR);
MAYBE_GC(again);
op = Sp - 1 * SIZEOF_MPFR;
ret = Sp - 2 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, op);
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_jn(ret "ptr", x, op, rnd);
MPFR_RETURN1(ret);
}
mpfr_cmm_yn(W_ rnd, W_ prec, W_ x, W_ ps, W_ exp, P_ limbs)
{
W_ op, ret;
W_ ternary;
again:
STK_CHK_GEN_N(1 * SIZEOF_MPFR);
MAYBE_GC(again);
op = Sp - 1 * SIZEOF_MPFR;
ret = Sp - 2 * SIZEOF_MPFR;
MPFR_REBUILD(ps, exp, limbs, op);
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_yn(ret "ptr", x, op, rnd);
MPFR_RETURN1(ret);
}
mpfr_cmm_lgamma(W_ rnd, W_ prec, W_ ps, W_ exp, P_ limbs)
{
W_ op, ret, signp;
W_ ternary;
again:
STK_CHK_GEN_N(2 * SIZEOF_MPFR + WDS(1));
MAYBE_GC(again);
op = Sp - 1 * SIZEOF_MPFR;
ret = Sp - 2 * SIZEOF_MPFR;
signp = Sp - 2 * SIZEOF_MPFR - WDS(1);
MPFR_REBUILD(ps, exp, limbs, op);
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_lgamma(ret "ptr", signp "ptr", op "ptr", rnd);
MPFR_RETURN1(ret, W_[signp]);
}
mpfr_cmm_remquo(W_ rnd, W_ prec, W_ ps, W_ exp, P_ limbs, W_ ps2, W_ exp2, P_ limbs2)
{
W_ op, op2, ret, quop;
W_ ternary;
again:
STK_CHK_GEN_N(3 * SIZEOF_MPFR + WDS(1));
MAYBE_GC(again);
op = Sp - 1 * SIZEOF_MPFR;
op2 = Sp - 2 * SIZEOF_MPFR;
ret = Sp - 3 * SIZEOF_MPFR;
quop = Sp - 3 * SIZEOF_MPFR - WDS(1);
MPFR_REBUILD(ps, exp, limbs, op);
MPFR_REBUILD(ps2, exp2, limbs2, op2);
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_remquo(ret "ptr", quop "ptr", op, op2, rnd);
MPFR_RETURN1(ret, W_[quop]);
}
mpfr_cmm_strtofr(W_ rnd, W_ prec, W_ base, P_ nptr)
{
W_ endptr;
W_ ret;
W_ ternary;
again:
STK_CHK_GEN_N(SIZEOF_MPFR + WDS(1));
MAYBE_GC(again);
ret = Sp - 1 * SIZEOF_MPFR;
endptr = Sp - 1 * SIZEOF_MPFR - WDS(1);
ccall mpfr_init2(ret "ptr", prec);
(ternary) = ccall mpfr_strtofr(ret "ptr", nptr "ptr", endptr "ptr", base, rnd);
MPFR_RETURN1(ret, W_[endptr], ternary);
}