void
ovm_q_hypot(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = fabs(mpq_get_d(oqr(l)));
}
else {
mpfr_set_ui(orr(r), 0, thr_rnd);
goto mpr;
}
break;
case t_word:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), r->v.w);
}
else {
mpfr_set_si(orr(r), r->v.w, thr_rnd);
goto mpr;
}
break;
case t_float:
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), r->v.d);
break;
case t_mpz:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), mpz_get_d(ozr(r)));
}
else {
mpfr_set_z(orr(r), ozr(r), thr_rnd);
goto mpr;
}
break;
case t_rat:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), rat_get_d(r->v.r));
}
else {
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpq:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), mpq_get_d(oqr(r)));
}
else {
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpr:
mpr:
l->t = t_mpr;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_hypot(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
cdd:
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)),
hypot(real(r->v.dd), imag(r->v.dd)));
break;
case t_cqq:
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
}
mpc_set_q_q(occ(r), oqr(r), oqi(r), thr_rndc);
case t_mpc:
l->t = t_mpr;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpfr_hypot(ori(l), orr(l), ori(l), thr_rnd);
mpfr_hypot(orr(l), orr(r), ori(r), thr_rnd);
mpfr_hypot(orr(l), ori(l), orr(l), thr_rnd);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_q_atan2(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), 0.0);
}
else {
mpfr_set_ui(orr(r), 0, thr_rnd);
goto mpr;
}
break;
case t_word:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), r->v.w);
}
else {
mpfr_set_si(orr(r), r->v.w, thr_rnd);
goto mpr;
}
break;
case t_float:
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), r->v.d);
break;
case t_mpz:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), mpz_get_d(ozr(r)));
}
else {
mpfr_set_z(orr(r), ozr(r), thr_rnd);
goto mpr;
}
break;
case t_rat:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), rat_get_d(r->v.r));
}
else {
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpq:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), mpq_get_d(oqr(r)));
}
else {
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpr:
mpr:
mpfr_set_q(orr(l), oqr(l), thr_rnd);
l->t = t_mpr;
mpfr_atan2(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
cdd:
l->t = t_cdd;
real(l->v.dd) = mpq_get_d(oqr(l));
imag(l->v.dd) = 0.0;
l->v.dd = catan(l->v.dd / r->v.dd);
check_cdd(l);
break;
case t_cqq:
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
}
mpc_set_q_q(occ(r), oqr(r), oqi(r), thr_rndc);
case t_mpc:
l->t = t_mpc;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpc_div(occ(l), occ(l), occ(r), thr_rndc);
mpc_atan(occ(l), occ(l), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_q_pow(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = 1.0;
}
else {
l->t = t_mpr;
mpfr_set_ui(orr(l), 1, thr_rnd);
}
break;
case t_word:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), r->v.w);
}
else {
mpfr_set_si(orr(r), r->v.w, thr_rnd);
goto mpr;
}
break;
case t_float:
if (mpq_sgn(oqr(l)) < 0 &&
finite(r->v.d) && rint(r->v.d) != r->v.d) {
real(r->v.dd) = r->v.d;
imag(r->v.dd) = 0.0;
goto cdd;
}
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), r->v.d);
break;
case t_mpz:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), mpz_get_d(ozr(r)));
}
else {
mpfr_set_z(orr(r), ozr(r), thr_rnd);
goto mpr;
}
break;
case t_rat:
if (mpq_sgn(oqr(l)) < 0) {
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = 0.0;
goto cdd;
}
mpc_set_q(occ(r), oqr(r), thr_rndc);
goto mpc;
}
else {
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), rat_get_d(r->v.r));
}
else {
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
}
break;
case t_mpq:
if (mpq_sgn(oqr(r)) < 0) {
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = 0.0;
goto cdd;
}
mpc_set_q(occ(r), oqr(r), thr_rndc);
goto mpc;
}
else {
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), mpq_get_d(oqr(r)));
}
else {
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
}
break;
case t_mpr:
if (mpq_sgn(oqr(l)) < 0 &&
mpfr_number_p(orr(r)) && !mpfr_integer_p(orr(r))) {
mpc_set_q(occ(r), oqr(r), thr_rndc);
goto mpc;
}
mpr:
l->t = t_mpr;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_pow(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
cdd:
l->t = t_cdd;
real(l->v.dd) = mpq_get_d(oqr(l));
imag(l->v.dd) = 0.0;
l->v.dd = cpow(l->v.dd, r->v.dd);
check_cdd(l);
break;
case t_cqq:
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
}
mpc_set_q_q(occ(r), oqr(r), oqi(r), thr_rndc);
case t_mpc:
mpc:
l->t = t_mpc;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpc_pow(occ(l), occ(l), occ(r), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
static void
check_set (void)
{
long int lo;
mpz_t mpz;
mpq_t mpq;
mpf_t mpf;
mpfr_t fr;
mpc_t x, z;
mpfr_prec_t prec;
mpz_init (mpz);
mpq_init (mpq);
mpf_init2 (mpf, 1000);
mpfr_init2 (fr, 1000);
mpc_init2 (x, 1000);
mpc_init2 (z, 1000);
mpz_set_ui (mpz, 0x4217);
mpq_set_si (mpq, -1, 0x4321);
mpf_set_q (mpf, mpq);
for (prec = 2; prec <= 1000; prec++)
{
unsigned long int u = (unsigned long int) prec;
mpc_set_prec (z, prec);
mpfr_set_prec (fr, prec);
lo = -prec;
mpfr_set_d (fr, 1.23456789, GMP_RNDN);
mpc_set_d (z, 1.23456789, MPC_RNDNN);
if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp_si (MPC_IM(z), 0) != 0)
PRINT_ERROR ("mpc_set_d", prec, z);
#if defined _MPC_H_HAVE_COMPLEX
mpc_set_dc (z, I*1.23456789+1.23456789, MPC_RNDNN);
if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
PRINT_ERROR ("mpc_set_c", prec, z);
#endif
mpc_set_ui (z, u, MPC_RNDNN);
if (mpfr_cmp_ui (MPC_RE(z), u) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0)
PRINT_ERROR ("mpc_set_ui", prec, z);
mpc_set_d_d (z, 1.23456789, 1.23456789, MPC_RNDNN);
if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
PRINT_ERROR ("mpc_set_d_d", prec, z);
mpc_set_si (z, lo, MPC_RNDNN);
if (mpfr_cmp_si (MPC_RE(z), lo) != 0 || mpfr_cmp_ui (MPC_IM(z), 0) != 0)
PRINT_ERROR ("mpc_set_si", prec, z);
mpfr_set_ld (fr, 1.23456789L, GMP_RNDN);
mpc_set_ld_ld (z, 1.23456789L, 1.23456789L, MPC_RNDNN);
if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
PRINT_ERROR ("mpc_set_ld_ld", prec, z);
#if defined _MPC_H_HAVE_COMPLEX
mpc_set_ldc (z, I*1.23456789L+1.23456789L, MPC_RNDNN);
if (mpfr_cmp (MPC_RE(z), fr) != 0 || mpfr_cmp (MPC_IM(z), fr) != 0)
PRINT_ERROR ("mpc_set_lc", prec, z);
#endif
mpc_set_ui_ui (z, u, u, MPC_RNDNN);
if (mpfr_cmp_ui (MPC_RE(z), u) != 0
|| mpfr_cmp_ui (MPC_IM(z), u) != 0)
PRINT_ERROR ("mpc_set_ui_ui", prec, z);
mpc_set_ld (z, 1.23456789L, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_ld", prec, z);
mpc_set_prec (x, prec);
mpfr_set_ui(fr, 1, GMP_RNDN);
mpfr_div_ui(fr, fr, 3, GMP_RNDN);
mpfr_set(MPC_RE(x), fr, GMP_RNDN);
mpfr_set(MPC_IM(x), fr, GMP_RNDN);
mpc_set (z, x, MPC_RNDNN);
mpfr_clear_flags (); /* mpc_cmp set erange flag when an operand is a
NaN */
if (mpc_cmp (z, x) != 0 || mpfr_erangeflag_p())
{
printf ("Error in mpc_set for prec = %lu\n",
(unsigned long int) prec);
MPC_OUT(z);
MPC_OUT(x);
exit (1);
}
mpc_set_si_si (z, lo, lo, MPC_RNDNN);
if (mpfr_cmp_si (MPC_RE(z), lo) != 0
|| mpfr_cmp_si (MPC_IM(z), lo) != 0)
PRINT_ERROR ("mpc_set_si_si", prec, z);
mpc_set_fr (z, fr, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_fr", prec, z);
mpfr_set_z (fr, mpz, GMP_RNDN);
mpc_set_z_z (z, mpz, mpz, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp (MPC_IM(z), fr) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_z_z", prec, z);
mpc_set_fr_fr (z, fr, fr, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp (MPC_IM(z), fr) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_fr_fr", prec, z);
mpc_set_z (z, mpz, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_z", prec, z);
mpfr_set_q (fr, mpq, GMP_RNDN);
mpc_set_q_q (z, mpq, mpq, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp (MPC_IM(z), fr) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_q_q", prec, z);
mpc_set_ui_fr (z, u, fr, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp_ui (MPC_RE (z), u) != 0
|| mpfr_cmp (MPC_IM (z), fr) != 0
|| mpfr_erangeflag_p ())
PRINT_ERROR ("mpc_set_ui_fr", prec, z);
mpc_set_fr_ui (z, fr, u, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE (z), fr) != 0
|| mpfr_cmp_ui (MPC_IM (z), u) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_fr_ui", prec, z);
mpc_set_q (z, mpq, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_q", prec, z);
mpfr_set_f (fr, mpf, GMP_RNDN);
mpc_set_f_f (z, mpf, mpf, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp (MPC_IM(z), fr) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_f_f", prec, z);
mpc_set_f (z, mpf, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE(z), fr) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0
|| mpfr_erangeflag_p())
PRINT_ERROR ("mpc_set_f", prec, z);
mpc_set_f_si (z, mpf, lo, MPC_RNDNN);
mpfr_clear_flags ();
if (mpfr_cmp (MPC_RE (z), fr) != 0
|| mpfr_cmp_si (MPC_IM (z), lo) != 0
|| mpfr_erangeflag_p ())
PRINT_ERROR ("mpc_set_f", prec, z);
mpc_set_nan (z);
if (!mpfr_nan_p (MPC_RE(z)) || !mpfr_nan_p (MPC_IM(z)))
PRINT_ERROR ("mpc_set_nan", prec, z);
#ifdef _MPC_H_HAVE_INTMAX_T
{
uintmax_t uim = (uintmax_t) prec;
intmax_t im = (intmax_t) prec;
mpc_set_uj (z, uim, MPC_RNDNN);
if (mpfr_cmp_ui (MPC_RE(z), u) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0)
PRINT_ERROR ("mpc_set_uj", prec, z);
mpc_set_sj (z, im, MPC_RNDNN);
if (mpfr_cmp_ui (MPC_RE(z), u) != 0
|| mpfr_cmp_ui (MPC_IM(z), 0) != 0)
PRINT_ERROR ("mpc_set_sj (1)", prec, z);
mpc_set_uj_uj (z, uim, uim, MPC_RNDNN);
if (mpfr_cmp_ui (MPC_RE(z), u) != 0
|| mpfr_cmp_ui (MPC_IM(z), u) != 0)
PRINT_ERROR ("mpc_set_uj_uj", prec, z);
mpc_set_sj_sj (z, im, im, MPC_RNDNN);
if (mpfr_cmp_ui (MPC_RE(z), u) != 0
|| mpfr_cmp_ui (MPC_IM(z), u) != 0)
PRINT_ERROR ("mpc_set_sj_sj (1)", prec, z);
im = LONG_MAX;
if (sizeof (intmax_t) == 2 * sizeof (unsigned long))
im = 2 * im * im + 4 * im + 1; /* gives 2^(2n-1)-1 from 2^(n-1)-1 */
mpc_set_sj (z, im, MPC_RNDNN);
if (mpfr_get_sj (MPC_RE(z), GMP_RNDN) != im ||
mpfr_cmp_ui (MPC_IM(z), 0) != 0)
PRINT_ERROR ("mpc_set_sj (2)", im, z);
mpc_set_sj_sj (z, im, im, MPC_RNDNN);
if (mpfr_get_sj (MPC_RE(z), GMP_RNDN) != im ||
mpfr_get_sj (MPC_IM(z), GMP_RNDN) != im)
PRINT_ERROR ("mpc_set_sj_sj (2)", im, z);
}
#endif /* _MPC_H_HAVE_INTMAX_T */
#if defined _MPC_H_HAVE_COMPLEX
{
double _Complex c = 1.0 - 2.0*I;
long double _Complex lc = c;
mpc_set_dc (z, c, MPC_RNDNN);
if (mpc_get_dc (z, MPC_RNDNN) != c)
PRINT_ERROR ("mpc_get_c", prec, z);
mpc_set_ldc (z, lc, MPC_RNDNN);
if (mpc_get_ldc (z, MPC_RNDNN) != lc)
PRINT_ERROR ("mpc_get_lc", prec, z);
}
#endif
}
mpz_clear (mpz);
mpq_clear (mpq);
mpf_clear (mpf);
mpfr_clear (fr);
mpc_clear (x);
mpc_clear (z);
}
