|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* mpfr.c - routines for arbitrary-precision number support in gawk.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* Copyright (C) 2012, 2013, 2015, 2017, 2018,
|
|
Packit |
575503 |
* the Free Software Foundation, Inc.
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* This file is part of GAWK, the GNU implementation of the
|
|
Packit |
575503 |
* AWK Programming Language.
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* GAWK is free software; you can redistribute it and/or modify
|
|
Packit |
575503 |
* it under the terms of the GNU General Public License as published by
|
|
Packit |
575503 |
* the Free Software Foundation; either version 3 of the License, or
|
|
Packit |
575503 |
* (at your option) any later version.
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* GAWK is distributed in the hope that it will be useful,
|
|
Packit |
575503 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit |
575503 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
Packit |
575503 |
* GNU General Public License for more details.
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* You should have received a copy of the GNU General Public License
|
|
Packit |
575503 |
* along with this program; if not, write to the Free Software
|
|
Packit |
575503 |
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#include "awk.h"
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#ifdef HAVE_MPFR
|
|
Packit |
575503 |
|
|
Packit |
575503 |
int MPFR_round_mode = 'N'; // default value
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#if !defined(MPFR_VERSION_MAJOR) || MPFR_VERSION_MAJOR < 3
|
|
Packit |
575503 |
typedef mp_exp_t mpfr_exp_t;
|
|
Packit |
575503 |
#endif
|
|
Packit |
575503 |
|
|
Packit |
575503 |
extern NODE **fmt_list; /* declared in eval.c */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
mpz_t mpzval; /* GMP integer type, used as temporary in few places */
|
|
Packit |
575503 |
mpz_t MNR;
|
|
Packit |
575503 |
mpz_t MFNR;
|
|
Packit |
575503 |
bool do_ieee_fmt; /* IEEE-754 floating-point emulation */
|
|
Packit |
575503 |
mpfr_rnd_t ROUND_MODE;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static mpfr_prec_t default_prec;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static mpfr_rnd_t get_rnd_mode(const char rmode);
|
|
Packit |
575503 |
static NODE *mpg_force_number(NODE *n);
|
|
Packit |
575503 |
static NODE *mpg_make_number(double);
|
|
Packit |
575503 |
static NODE *mpg_format_val(const char *format, int index, NODE *s);
|
|
Packit |
575503 |
static int mpg_interpret(INSTRUCTION **cp);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static mpfr_exp_t min_exp = MPFR_EMIN_DEFAULT;
|
|
Packit |
575503 |
static mpfr_exp_t max_exp = MPFR_EMAX_DEFAULT;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* temporary MPFR floats used to hold converted GMP integer operands */
|
|
Packit |
575503 |
static mpfr_t _mpf_t1;
|
|
Packit |
575503 |
static mpfr_t _mpf_t2;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* PRECISION_MIN is the precision used to initialize _mpf_t1 and _mpf_t2.
|
|
Packit |
575503 |
* 64 bits should be enough for exact conversion of most integers to floats.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#define PRECISION_MIN 64
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mf = { _mpf_t1, _mpf_t2 } */
|
|
Packit |
575503 |
static inline mpfr_ptr mpg_tofloat(mpfr_ptr mf, mpz_ptr mz);
|
|
Packit |
575503 |
/* T = {t1, t2} */
|
|
Packit |
575503 |
#define MP_FLOAT(T) is_mpg_integer(T) ? mpg_tofloat(_mpf_##T, (T)->mpg_i) : (T)->mpg_numbr
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* init_mpfr --- set up MPFR related variables */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
init_mpfr(mpfr_prec_t prec, const char *rmode)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
mpfr_set_default_prec(default_prec = prec);
|
|
Packit |
575503 |
ROUND_MODE = get_rnd_mode(rmode[0]);
|
|
Packit |
575503 |
mpfr_set_default_rounding_mode(ROUND_MODE);
|
|
Packit |
575503 |
make_number = mpg_make_number;
|
|
Packit |
575503 |
str2number = mpg_force_number;
|
|
Packit |
575503 |
format_val = mpg_format_val;
|
|
Packit |
575503 |
cmp_numbers = mpg_cmp;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
mpz_init(MNR);
|
|
Packit |
575503 |
mpz_init(MFNR);
|
|
Packit |
575503 |
do_ieee_fmt = false;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
mpfr_init2(_mpf_t1, PRECISION_MIN);
|
|
Packit |
575503 |
mpfr_init2(_mpf_t2, PRECISION_MIN);
|
|
Packit |
575503 |
mpz_init(mpzval);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
register_exec_hook(mpg_interpret, 0);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* cleanup_mpfr --- clean stuff up, mainly for valgrind */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
cleanup_mpfr(void)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
mpfr_clear(_mpf_t1);
|
|
Packit |
575503 |
mpfr_clear(_mpf_t2);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_node --- allocate a node to store MPFR float or GMP integer */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
mpg_node(unsigned int flags)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r = make_number_node(flags);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (flags == MPFN)
|
|
Packit |
575503 |
/* Initialize, set precision to the default precision, and value to NaN */
|
|
Packit |
575503 |
mpfr_init(r->mpg_numbr);
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
/* Initialize and set value to 0 */
|
|
Packit |
575503 |
mpz_init(r->mpg_i);
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* mpg_make_number --- make a arbitrary-precision number node
|
|
Packit |
575503 |
* and initialize with a C double
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_make_number(double x)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r;
|
|
Packit |
575503 |
double ival;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if ((ival = double_to_int(x)) != x) {
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_set_d(r->mpg_numbr, x, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_set_d(r->mpg_i, ival);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_strtoui --- assign arbitrary-precision integral value from a string */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
int
|
|
Packit |
575503 |
mpg_strtoui(mpz_ptr zi, char *str, size_t len, char **end, int base)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
char *s = str;
|
|
Packit |
575503 |
char *start;
|
|
Packit |
575503 |
int ret = -1;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* mpz_set_str does not like leading 0x or 0X for hex (or 0 for octal)
|
|
Packit |
575503 |
* with a non-zero base argument.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
if (base == 16 && len >= 2 && *s == '0' && (s[1] == 'x' || s[1] == 'X')) {
|
|
Packit |
575503 |
s += 2; len -= 2;
|
|
Packit |
575503 |
} else if (base == 8 && len >= 1 && *s == '0') {
|
|
Packit |
575503 |
s++; len--;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
start = s;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
while (len > 0) {
|
|
Packit |
575503 |
switch (*s) {
|
|
Packit |
575503 |
case '0':
|
|
Packit |
575503 |
case '1':
|
|
Packit |
575503 |
case '2':
|
|
Packit |
575503 |
case '3':
|
|
Packit |
575503 |
case '4':
|
|
Packit |
575503 |
case '5':
|
|
Packit |
575503 |
case '6':
|
|
Packit |
575503 |
case '7':
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
case '8':
|
|
Packit |
575503 |
case '9':
|
|
Packit |
575503 |
if (base == 8)
|
|
Packit |
575503 |
goto done;
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
case 'a':
|
|
Packit |
575503 |
case 'b':
|
|
Packit |
575503 |
case 'c':
|
|
Packit |
575503 |
case 'd':
|
|
Packit |
575503 |
case 'e':
|
|
Packit |
575503 |
case 'f':
|
|
Packit |
575503 |
case 'A':
|
|
Packit |
575503 |
case 'B':
|
|
Packit |
575503 |
case 'C':
|
|
Packit |
575503 |
case 'D':
|
|
Packit |
575503 |
case 'E':
|
|
Packit |
575503 |
case 'F':
|
|
Packit |
575503 |
if (base == 16)
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
default:
|
|
Packit |
575503 |
goto done;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
s++; len--;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
done:
|
|
Packit |
575503 |
if (s > start) {
|
|
Packit |
575503 |
char save = *s;
|
|
Packit |
575503 |
*s = '\0';
|
|
Packit |
575503 |
ret = mpz_set_str(zi, start, base);
|
|
Packit |
575503 |
*s = save;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
if (end != NULL)
|
|
Packit |
575503 |
*end = s;
|
|
Packit |
575503 |
return ret;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_maybe_float --- test if a string may contain arbitrary-precision float */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static int
|
|
Packit |
575503 |
mpg_maybe_float(const char *str, int use_locale)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
int dec_point = '.';
|
|
Packit |
575503 |
const char *s = str;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#if defined(HAVE_LOCALE_H)
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* loc.decimal_point may not have been initialized yet,
|
|
Packit |
575503 |
* so double check it before using it.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
if (use_locale && loc.decimal_point != NULL && loc.decimal_point[0] != '\0')
|
|
Packit |
575503 |
dec_point = loc.decimal_point[0]; /* XXX --- assumes one char */
|
|
Packit |
575503 |
#endif
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (strlen(s) >= 3
|
|
Packit |
575503 |
&& ( ( (s[0] == 'i' || s[0] == 'I')
|
|
Packit |
575503 |
&& (s[1] == 'n' || s[1] == 'N')
|
|
Packit |
575503 |
&& (s[2] == 'f' || s[2] == 'F'))
|
|
Packit |
575503 |
|| ( (s[0] == 'n' || s[0] == 'N')
|
|
Packit |
575503 |
&& (s[1] == 'a' || s[1] == 'A')
|
|
Packit |
575503 |
&& (s[2] == 'n' || s[2] == 'N'))))
|
|
Packit |
575503 |
return true;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
for (; *s != '\0'; s++) {
|
|
Packit |
575503 |
if (*s == dec_point || *s == 'e' || *s == 'E')
|
|
Packit |
575503 |
return true;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
return false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_zero --- initialize with arbitrary-precision integer(GMP) and set value to zero */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static inline void
|
|
Packit |
575503 |
mpg_zero(NODE *n)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
if (is_mpg_float(n)) {
|
|
Packit |
575503 |
mpfr_clear(n->mpg_numbr);
|
|
Packit |
575503 |
n->flags &= ~MPFN;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
if (! is_mpg_integer(n)) {
|
|
Packit |
575503 |
mpz_init(n->mpg_i); /* this also sets its value to 0 */
|
|
Packit |
575503 |
n->flags |= MPZN;
|
|
Packit |
575503 |
} else
|
|
Packit |
575503 |
mpz_set_si(n->mpg_i, 0);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* force_mpnum --- force a value to be a GMP integer or MPFR float */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static int
|
|
Packit |
575503 |
force_mpnum(NODE *n, int do_nondec, int use_locale)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
char *cp, *cpend, *ptr, *cp1;
|
|
Packit |
575503 |
char save;
|
|
Packit |
575503 |
int tval, base = 10;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (n->stlen == 0) {
|
|
Packit |
575503 |
mpg_zero(n);
|
|
Packit |
575503 |
return false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
cp = n->stptr;
|
|
Packit |
575503 |
cpend = n->stptr + n->stlen;
|
|
Packit |
575503 |
while (cp < cpend && isspace((unsigned char) *cp))
|
|
Packit |
575503 |
cp++;
|
|
Packit |
575503 |
if (cp == cpend) { /* only spaces */
|
|
Packit |
575503 |
mpg_zero(n);
|
|
Packit |
575503 |
return false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
save = *cpend;
|
|
Packit |
575503 |
*cpend = '\0';
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (*cp == '+' || *cp == '-')
|
|
Packit |
575503 |
cp1 = cp + 1;
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
cp1 = cp;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (do_nondec)
|
|
Packit |
575503 |
base = get_numbase(cp1, cpend - cp1, use_locale);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (! mpg_maybe_float(cp1, use_locale)) {
|
|
Packit |
575503 |
mpg_zero(n);
|
|
Packit |
575503 |
errno = 0;
|
|
Packit |
575503 |
mpg_strtoui(n->mpg_i, cp1, cpend - cp1, & ptr, base);
|
|
Packit |
575503 |
if (*cp == '-')
|
|
Packit |
575503 |
mpz_neg(n->mpg_i, n->mpg_i);
|
|
Packit |
575503 |
goto done;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(n)) {
|
|
Packit |
575503 |
mpz_clear(n->mpg_i);
|
|
Packit |
575503 |
n->flags &= ~MPZN;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (! is_mpg_float(n)) {
|
|
Packit |
575503 |
mpfr_init(n->mpg_numbr);
|
|
Packit |
575503 |
n->flags |= MPFN;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
errno = 0;
|
|
Packit |
575503 |
tval = mpfr_strtofr(n->mpg_numbr, cp, & ptr, base, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(n->mpg_numbr, tval);
|
|
Packit |
575503 |
done:
|
|
Packit |
575503 |
/* trailing space is OK for NUMBER */
|
|
Packit |
575503 |
while (ptr < cpend && isspace((unsigned char) *ptr))
|
|
Packit |
575503 |
ptr++;
|
|
Packit |
575503 |
*cpend = save;
|
|
Packit |
575503 |
if (errno == 0 && ptr == cpend)
|
|
Packit |
575503 |
return true;
|
|
Packit |
575503 |
errno = 0;
|
|
Packit |
575503 |
return false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_force_number --- force a value to be a multiple-precision number */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_force_number(NODE *n)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
if ((n->flags & NUMCUR) != 0)
|
|
Packit |
575503 |
return n;
|
|
Packit |
575503 |
n->flags |= NUMCUR;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (force_mpnum(n, (do_non_decimal_data && ! do_traditional), true)) {
|
|
Packit |
575503 |
if ((n->flags & USER_INPUT) != 0) {
|
|
Packit |
575503 |
/* leave USER_INPUT set to indicate a strnum */
|
|
Packit |
575503 |
n->flags &= ~STRING;
|
|
Packit |
575503 |
n->flags |= NUMBER;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
} else
|
|
Packit |
575503 |
n->flags &= ~USER_INPUT;
|
|
Packit |
575503 |
return n;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_format_val --- format a numeric value based on format */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_format_val(const char *format, int index, NODE *s)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *dummy[2], *r;
|
|
Packit |
575503 |
unsigned int oflags;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* create dummy node for a sole use of format_tree */
|
|
Packit |
575503 |
dummy[1] = s;
|
|
Packit |
575503 |
oflags = s->flags;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(s) || mpfr_integer_p(s->mpg_numbr)) {
|
|
Packit |
575503 |
/* integral value, use %d */
|
|
Packit |
575503 |
r = format_tree("%d", 2, dummy, 2);
|
|
Packit |
575503 |
s->stfmt = STFMT_UNUSED;
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = format_tree(format, fmt_list[index]->stlen, dummy, 2);
|
|
Packit |
575503 |
assert(r != NULL);
|
|
Packit |
575503 |
s->stfmt = index;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
s->flags = oflags;
|
|
Packit |
575503 |
s->stlen = r->stlen;
|
|
Packit |
575503 |
if ((s->flags & (MALLOC|STRCUR)) == (MALLOC|STRCUR))
|
|
Packit |
575503 |
efree(s->stptr);
|
|
Packit |
575503 |
s->stptr = r->stptr;
|
|
Packit |
575503 |
s->flags |= STRCUR;
|
|
Packit |
575503 |
s->strndmode = MPFR_round_mode;
|
|
Packit |
575503 |
freenode(r); /* Do not unref(r)! We want to keep s->stptr == r->stpr. */
|
|
Packit |
575503 |
free_wstr(s);
|
|
Packit |
575503 |
return s;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_cmp --- compare two numbers */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
int
|
|
Packit |
575503 |
mpg_cmp(const NODE *t1, const NODE *t2)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* For the purposes of sorting, NaN is considered greater than
|
|
Packit |
575503 |
* any other value, and all NaN values are considered equivalent and equal.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_float(t1)) {
|
|
Packit |
575503 |
if (is_mpg_float(t2)) {
|
|
Packit |
575503 |
if (mpfr_nan_p(t1->mpg_numbr))
|
|
Packit |
575503 |
return ! mpfr_nan_p(t2->mpg_numbr);
|
|
Packit |
575503 |
if (mpfr_nan_p(t2->mpg_numbr))
|
|
Packit |
575503 |
return -1;
|
|
Packit |
575503 |
return mpfr_cmp(t1->mpg_numbr, t2->mpg_numbr);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
if (mpfr_nan_p(t1->mpg_numbr))
|
|
Packit |
575503 |
return 1;
|
|
Packit |
575503 |
return mpfr_cmp_z(t1->mpg_numbr, t2->mpg_i);
|
|
Packit |
575503 |
} else if (is_mpg_float(t2)) {
|
|
Packit |
575503 |
int ret;
|
|
Packit |
575503 |
if (mpfr_nan_p(t2->mpg_numbr))
|
|
Packit |
575503 |
return -1;
|
|
Packit |
575503 |
ret = mpfr_cmp_z(t2->mpg_numbr, t1->mpg_i);
|
|
Packit |
575503 |
return ret > 0 ? -1 : (ret < 0);
|
|
Packit |
575503 |
} else if (is_mpg_integer(t1)) {
|
|
Packit |
575503 |
return mpz_cmp(t1->mpg_i, t2->mpg_i);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* t1 and t2 are AWKNUMs */
|
|
Packit |
575503 |
return cmp_awknums(t1, t2);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* mpg_update_var --- update NR or FNR.
|
|
Packit |
575503 |
* NR_node->var_value(mpz_t) = MNR(mpz_t) * LONG_MAX + NR(long)
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
mpg_update_var(NODE *n)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *val = n->var_value;
|
|
Packit |
575503 |
long nr = 0;
|
|
Packit |
575503 |
mpz_ptr nq = 0;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (n == NR_node) {
|
|
Packit |
575503 |
nr = NR;
|
|
Packit |
575503 |
nq = MNR;
|
|
Packit |
575503 |
} else if (n == FNR_node) {
|
|
Packit |
575503 |
nr = FNR;
|
|
Packit |
575503 |
nq = MFNR;
|
|
Packit |
575503 |
} else
|
|
Packit |
575503 |
cant_happen();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (mpz_sgn(nq) == 0) {
|
|
Packit |
575503 |
/* Efficiency hack similar to that for AWKNUM */
|
|
Packit |
575503 |
if (is_mpg_float(val) || mpz_get_si(val->mpg_i) != nr) {
|
|
Packit |
575503 |
unref(n->var_value);
|
|
Packit |
575503 |
val = n->var_value = mpg_integer();
|
|
Packit |
575503 |
mpz_set_si(val->mpg_i, nr);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
unref(n->var_value);
|
|
Packit |
575503 |
val = n->var_value = mpg_integer();
|
|
Packit |
575503 |
mpz_set_si(val->mpg_i, nr);
|
|
Packit |
575503 |
mpz_addmul_ui(val->mpg_i, nq, LONG_MAX); /* val->mpg_i += nq * LONG_MAX */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return val;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_set_var --- set NR or FNR */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
long
|
|
Packit |
575503 |
mpg_set_var(NODE *n)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
long nr = 0;
|
|
Packit |
575503 |
mpz_ptr nq = 0, r;
|
|
Packit |
575503 |
NODE *val = n->var_value;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (n == NR_node)
|
|
Packit |
575503 |
nq = MNR;
|
|
Packit |
575503 |
else if (n == FNR_node)
|
|
Packit |
575503 |
nq = MFNR;
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
cant_happen();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(val))
|
|
Packit |
575503 |
r = val->mpg_i;
|
|
Packit |
575503 |
else {
|
|
Packit |
575503 |
/* convert float to integer */
|
|
Packit |
575503 |
mpfr_get_z(mpzval, val->mpg_numbr, MPFR_RNDZ);
|
|
Packit |
575503 |
r = mpzval;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
nr = mpz_fdiv_q_ui(nq, r, LONG_MAX); /* nq (MNR or MFNR) is quotient */
|
|
Packit |
575503 |
return nr; /* remainder (NR or FNR) */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* set_PREC --- update MPFR PRECISION related variables when PREC assigned to */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
set_PREC()
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
long prec = 0;
|
|
Packit |
575503 |
NODE *val;
|
|
Packit |
575503 |
static const struct ieee_fmt {
|
|
Packit |
575503 |
const char *name;
|
|
Packit |
575503 |
mpfr_prec_t precision;
|
|
Packit |
575503 |
mpfr_exp_t emax;
|
|
Packit |
575503 |
mpfr_exp_t emin;
|
|
Packit |
575503 |
} ieee_fmts[] = {
|
|
Packit |
575503 |
{ "half", 11, 16, -23 }, /* binary16 */
|
|
Packit |
575503 |
{ "single", 24, 128, -148 }, /* binary32 */
|
|
Packit |
575503 |
{ "double", 53, 1024, -1073 }, /* binary64 */
|
|
Packit |
575503 |
{ "quad", 113, 16384, -16493 }, /* binary128 */
|
|
Packit |
575503 |
{ "oct", 237, 262144, -262377 }, /* binary256, not in the IEEE 754-2008 standard */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* For any bitwidth = 32 * k ( k >= 4),
|
|
Packit |
575503 |
* precision = 13 + bitwidth - int(4 * log2(bitwidth))
|
|
Packit |
575503 |
* emax = 1 << bitwidth - precision - 1
|
|
Packit |
575503 |
* emin = 4 - emax - precision
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
};
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (! do_mpfr)
|
|
Packit |
575503 |
return;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
val = fixtype(PREC_node->var_value);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if ((val->flags & STRING) != 0) {
|
|
Packit |
575503 |
int i, j;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* emulate IEEE-754 binary format */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
for (i = 0, j = sizeof(ieee_fmts)/sizeof(ieee_fmts[0]); i < j; i++) {
|
|
Packit |
575503 |
if (strcasecmp(ieee_fmts[i].name, val->stptr) == 0)
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (i < j) {
|
|
Packit |
575503 |
prec = ieee_fmts[i].precision;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* We *DO NOT* change the MPFR exponent range using
|
|
Packit |
575503 |
* mpfr_set_{emin, emax} here. See format_ieee() for details.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
max_exp = ieee_fmts[i].emax;
|
|
Packit |
575503 |
min_exp = ieee_fmts[i].emin;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
do_ieee_fmt = true;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (prec <= 0) {
|
|
Packit |
575503 |
force_number(val);
|
|
Packit |
575503 |
prec = get_number_si(val);
|
|
Packit |
575503 |
if (prec < MPFR_PREC_MIN || prec > MPFR_PREC_MAX) {
|
|
Packit |
575503 |
force_string(val);
|
|
Packit |
575503 |
warning(_("PREC value `%.*s' is invalid"), (int) val->stlen, val->stptr);
|
|
Packit |
575503 |
prec = 0;
|
|
Packit |
575503 |
} else
|
|
Packit |
575503 |
do_ieee_fmt = false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (prec > 0)
|
|
Packit |
575503 |
mpfr_set_default_prec(default_prec = prec);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* get_rnd_mode --- convert string to MPFR rounding mode */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static mpfr_rnd_t
|
|
Packit |
575503 |
get_rnd_mode(const char rmode)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
switch (rmode) {
|
|
Packit |
575503 |
case 'N':
|
|
Packit |
575503 |
case 'n':
|
|
Packit |
575503 |
return MPFR_RNDN; /* round to nearest (IEEE-754 roundTiesToEven) */
|
|
Packit |
575503 |
case 'Z':
|
|
Packit |
575503 |
case 'z':
|
|
Packit |
575503 |
return MPFR_RNDZ; /* round toward zero (IEEE-754 roundTowardZero) */
|
|
Packit |
575503 |
case 'U':
|
|
Packit |
575503 |
case 'u':
|
|
Packit |
575503 |
return MPFR_RNDU; /* round toward plus infinity (IEEE-754 roundTowardPositive) */
|
|
Packit |
575503 |
case 'D':
|
|
Packit |
575503 |
case 'd':
|
|
Packit |
575503 |
return MPFR_RNDD; /* round toward minus infinity (IEEE-754 roundTowardNegative) */
|
|
Packit |
575503 |
#if defined(MPFR_VERSION_MAJOR) && MPFR_VERSION_MAJOR > 2
|
|
Packit |
575503 |
case 'A':
|
|
Packit |
575503 |
case 'a':
|
|
Packit |
575503 |
return MPFR_RNDA; /* round away from zero */
|
|
Packit |
575503 |
#endif
|
|
Packit |
575503 |
default:
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return -1;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* set_ROUNDMODE --- update MPFR rounding mode related variables
|
|
Packit |
575503 |
* when ROUNDMODE assigned to
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
set_ROUNDMODE()
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
if (do_mpfr) {
|
|
Packit |
575503 |
mpfr_rnd_t rndm = -1;
|
|
Packit |
575503 |
NODE *n;
|
|
Packit |
575503 |
n = force_string(ROUNDMODE_node->var_value);
|
|
Packit |
575503 |
if (n->stlen == 1)
|
|
Packit |
575503 |
rndm = get_rnd_mode(n->stptr[0]);
|
|
Packit |
575503 |
if (rndm != -1) {
|
|
Packit |
575503 |
mpfr_set_default_rounding_mode(rndm);
|
|
Packit |
575503 |
ROUND_MODE = rndm;
|
|
Packit |
575503 |
MPFR_round_mode = n->stptr[0];
|
|
Packit |
575503 |
} else
|
|
Packit |
575503 |
warning(_("RNDMODE value `%.*s' is invalid"), (int) n->stlen, n->stptr);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* format_ieee --- make sure a number follows IEEE-754 floating-point standard */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
int
|
|
Packit |
575503 |
format_ieee(mpfr_ptr x, int tval)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* The MPFR doc says that it's our responsibility to make sure all numbers
|
|
Packit |
575503 |
* including those previously created are in range after we've changed the
|
|
Packit |
575503 |
* exponent range. Most MPFR operations and functions require
|
|
Packit |
575503 |
* the input arguments to have exponents within the current exponent range.
|
|
Packit |
575503 |
* Any argument outside the range results in a MPFR assertion failure
|
|
Packit |
575503 |
* like this:
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* $ gawk -M 'BEGIN { x=1.0e-10000; print x+0; PREC="double"; print x+0}'
|
|
Packit |
575503 |
* 1e-10000
|
|
Packit |
575503 |
* init2.c:52: MPFR assertion failed ....
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* A "naive" approach would be to keep track of the ternary state and
|
|
Packit |
575503 |
* the rounding mode for each number, and make sure it is in the current
|
|
Packit |
575503 |
* exponent range (using mpfr_check_range) before using it in an
|
|
Packit |
575503 |
* operation or function. Instead, we adopt the following strategy.
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* When gawk starts, the exponent range is the MPFR default
|
|
Packit |
575503 |
* [MPFR_EMIN_DEFAULT, MPFR_EMAX_DEFAULT]. Any number that gawk
|
|
Packit |
575503 |
* creates must have exponent in this range (excluding infinities, NaNs and zeros).
|
|
Packit |
575503 |
* Each MPFR operation or function is performed with this default exponent
|
|
Packit |
575503 |
* range.
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* When emulating IEEE-754 format, the exponents are *temporarily* changed,
|
|
Packit |
575503 |
* mpfr_check_range is called to make sure the number is in the new range,
|
|
Packit |
575503 |
* and mpfr_subnormalize is used to round following the rules of subnormal
|
|
Packit |
575503 |
* arithmetic. The exponent range is then *restored* to the original value
|
|
Packit |
575503 |
* [MPFR_EMIN_DEFAULT, MPFR_EMAX_DEFAULT].
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
(void) mpfr_set_emin(min_exp);
|
|
Packit |
575503 |
(void) mpfr_set_emax(max_exp);
|
|
Packit |
575503 |
tval = mpfr_check_range(x, tval, ROUND_MODE);
|
|
Packit |
575503 |
tval = mpfr_subnormalize(x, tval, ROUND_MODE);
|
|
Packit |
575503 |
(void) mpfr_set_emin(MPFR_EMIN_DEFAULT);
|
|
Packit |
575503 |
(void) mpfr_set_emax(MPFR_EMAX_DEFAULT);
|
|
Packit |
575503 |
return tval;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_atan2 --- do the atan2 function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_atan2(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *t1, *t2, *res;
|
|
Packit |
575503 |
mpfr_ptr p1, p2;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
t2 = POP_SCALAR();
|
|
Packit |
575503 |
t1 = POP_SCALAR();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (do_lint) {
|
|
Packit |
575503 |
if ((fixtype(t1)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("atan2: received non-numeric first argument"));
|
|
Packit |
575503 |
if ((fixtype(t2)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("atan2: received non-numeric second argument"));
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
force_number(t1);
|
|
Packit |
575503 |
force_number(t2);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
p1 = MP_FLOAT(t1);
|
|
Packit |
575503 |
p2 = MP_FLOAT(t2);
|
|
Packit |
575503 |
res = mpg_float();
|
|
Packit |
575503 |
/* See MPFR documentation for handling of special values like +inf as an argument */
|
|
Packit |
575503 |
tval = mpfr_atan2(res->mpg_numbr, p1, p2, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(res->mpg_numbr, tval);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_func --- run an MPFR function - not inline, for debugging */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static inline NODE *
|
|
Packit |
575503 |
do_mpfr_func(const char *name,
|
|
Packit |
575503 |
int (*mpfr_func)(), /* putting argument types just gets the compiler confused */
|
|
Packit |
575503 |
int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *t1, *res;
|
|
Packit |
575503 |
mpfr_ptr p1;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
mpfr_prec_t argprec;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
t1 = POP_SCALAR();
|
|
Packit |
575503 |
if (do_lint && (fixtype(t1)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("%s: received non-numeric argument"), name);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
force_number(t1);
|
|
Packit |
575503 |
p1 = MP_FLOAT(t1);
|
|
Packit |
575503 |
res = mpg_float();
|
|
Packit |
575503 |
if ((argprec = mpfr_get_prec(p1)) > default_prec)
|
|
Packit |
575503 |
mpfr_set_prec(res->mpg_numbr, argprec); /* needed at least for sqrt() */
|
|
Packit |
575503 |
tval = mpfr_func(res->mpg_numbr, p1, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(res->mpg_numbr, tval);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#define SPEC_MATH(X) \
|
|
Packit |
575503 |
NODE *result; \
|
|
Packit |
575503 |
result = do_mpfr_func(#X, mpfr_##X, nargs); \
|
|
Packit |
575503 |
return result
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_sin --- do the sin function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_sin(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
SPEC_MATH(sin);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_cos --- do the cos function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_cos(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
SPEC_MATH(cos);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_exp --- exponential function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_exp(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
SPEC_MATH(exp);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_log --- the log function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_log(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
SPEC_MATH(log);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_sqrt --- do the sqrt function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_sqrt(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
SPEC_MATH(sqrt);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_int --- convert double to int for awk */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_int(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *tmp, *r;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
tmp = POP_SCALAR();
|
|
Packit |
575503 |
if (do_lint && (fixtype(tmp)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("int: received non-numeric argument"));
|
|
Packit |
575503 |
force_number(tmp);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(tmp)) {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_set(r->mpg_i, tmp->mpg_i);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
if (! mpfr_number_p(tmp->mpg_numbr)) {
|
|
Packit |
575503 |
/* [+-]inf or NaN */
|
|
Packit |
575503 |
return tmp;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpfr_get_z(r->mpg_i, tmp->mpg_numbr, MPFR_RNDZ);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
DEREF(tmp);
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_compl --- perform a ~ operation */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_compl(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *tmp, *r;
|
|
Packit |
575503 |
mpz_ptr zptr;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
tmp = POP_SCALAR();
|
|
Packit |
575503 |
if (do_lint && (fixtype(tmp)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("compl: received non-numeric argument"));
|
|
Packit |
575503 |
|
|
Packit |
575503 |
force_number(tmp);
|
|
Packit |
575503 |
if (is_mpg_float(tmp)) {
|
|
Packit |
575503 |
mpfr_ptr p = tmp->mpg_numbr;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (! mpfr_number_p(p)) {
|
|
Packit |
575503 |
/* [+-]inf or NaN */
|
|
Packit |
575503 |
return tmp;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
if (mpfr_sgn(p) < 0)
|
|
Packit |
575503 |
fatal("%s",
|
|
Packit |
575503 |
mpg_fmt(_("compl(%Rg): negative value is not allowed"), p)
|
|
Packit |
575503 |
);
|
|
Packit |
575503 |
if (do_lint) {
|
|
Packit |
575503 |
if (! mpfr_integer_p(p))
|
|
Packit |
575503 |
lintwarn("%s",
|
|
Packit |
575503 |
mpg_fmt(_("comp(%Rg): fractional value will be truncated"), p)
|
|
Packit |
575503 |
);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
mpfr_get_z(mpzval, p, MPFR_RNDZ); /* float to integer conversion */
|
|
Packit |
575503 |
zptr = mpzval;
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
/* (tmp->flags & MPZN) != 0 */
|
|
Packit |
575503 |
zptr = tmp->mpg_i;
|
|
Packit |
575503 |
if (mpz_sgn(zptr) < 0)
|
|
Packit |
575503 |
fatal("%s",
|
|
Packit |
575503 |
mpg_fmt(_("compl(%Zd): negative values are not allowed"), zptr)
|
|
Packit |
575503 |
);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_com(r->mpg_i, zptr);
|
|
Packit |
575503 |
DEREF(tmp);
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* get_intval --- get the (converted) integral operand of a binary function. */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static mpz_ptr
|
|
Packit |
575503 |
get_intval(NODE *t1, int argnum, const char *op)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
mpz_ptr pz;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (do_lint && (fixtype(t1)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("%s: received non-numeric argument #%d"), op, argnum);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
(void) force_number(t1);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_float(t1)) {
|
|
Packit |
575503 |
mpfr_ptr left = t1->mpg_numbr;
|
|
Packit |
575503 |
if (! mpfr_number_p(left)) {
|
|
Packit |
575503 |
/* inf or NaN */
|
|
Packit |
575503 |
if (do_lint)
|
|
Packit |
575503 |
lintwarn("%s",
|
|
Packit |
575503 |
mpg_fmt(_("%s: argument #%d has invalid value %Rg, using 0"),
|
|
Packit |
575503 |
op, argnum, left)
|
|
Packit |
575503 |
);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
emalloc(pz, mpz_ptr, sizeof (mpz_t), "get_intval");
|
|
Packit |
575503 |
mpz_init(pz);
|
|
Packit |
575503 |
return pz; /* should be freed */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (mpfr_sgn(left) < 0)
|
|
Packit |
575503 |
fatal("%s",
|
|
Packit |
575503 |
mpg_fmt(_("%s: argument #%d negative value %Rg is not allowed"),
|
|
Packit |
575503 |
op, argnum, left)
|
|
Packit |
575503 |
);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (do_lint) {
|
|
Packit |
575503 |
if (! mpfr_integer_p(left))
|
|
Packit |
575503 |
lintwarn("%s",
|
|
Packit |
575503 |
mpg_fmt(_("%s: argument #%d fractional value %Rg will be truncated"),
|
|
Packit |
575503 |
op, argnum, left)
|
|
Packit |
575503 |
);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
emalloc(pz, mpz_ptr, sizeof (mpz_t), "get_intval");
|
|
Packit |
575503 |
mpz_init(pz);
|
|
Packit |
575503 |
mpfr_get_z(pz, left, MPFR_RNDZ); /* float to integer conversion */
|
|
Packit |
575503 |
return pz; /* should be freed */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
/* (t1->flags & MPZN) != 0 */
|
|
Packit |
575503 |
pz = t1->mpg_i;
|
|
Packit |
575503 |
if (mpz_sgn(pz) < 0)
|
|
Packit |
575503 |
fatal("%s",
|
|
Packit |
575503 |
mpg_fmt(_("%s: argument #%d negative value %Zd is not allowed"),
|
|
Packit |
575503 |
op, argnum, pz)
|
|
Packit |
575503 |
);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
return pz; /* must not be freed */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* free_intval --- free the converted integer value returned by get_intval() */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static inline void
|
|
Packit |
575503 |
free_intval(NODE *t, mpz_ptr pz)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
if ((t->flags & MPZN) == 0) {
|
|
Packit |
575503 |
mpz_clear(pz);
|
|
Packit |
575503 |
efree(pz);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_lshift --- perform a << operation */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_lshift(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *t1, *t2, *res;
|
|
Packit |
575503 |
unsigned long shift;
|
|
Packit |
575503 |
mpz_ptr pz1, pz2;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
t2 = POP_SCALAR();
|
|
Packit |
575503 |
t1 = POP_SCALAR();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
pz1 = get_intval(t1, 1, "lshift");
|
|
Packit |
575503 |
pz2 = get_intval(t2, 2, "lshift");
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* mpz_get_ui: If op is too big to fit an unsigned long then just
|
|
Packit |
575503 |
* the least significant bits that do fit are returned.
|
|
Packit |
575503 |
* The sign of op is ignored, only the absolute value is used.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
shift = mpz_get_ui(pz2); /* GMP integer => unsigned long conversion */
|
|
Packit |
575503 |
res = mpg_integer();
|
|
Packit |
575503 |
mpz_mul_2exp(res->mpg_i, pz1, shift); /* res = pz1 * 2^shift */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
free_intval(t1, pz1);
|
|
Packit |
575503 |
free_intval(t2, pz2);
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_rshift --- perform a >> operation */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_rshift(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *t1, *t2, *res;
|
|
Packit |
575503 |
unsigned long shift;
|
|
Packit |
575503 |
mpz_ptr pz1, pz2;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
t2 = POP_SCALAR();
|
|
Packit |
575503 |
t1 = POP_SCALAR();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
pz1 = get_intval(t1, 1, "rshift");
|
|
Packit |
575503 |
pz2 = get_intval(t2, 2, "rshift");
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* N.B: See do_mpfp_lshift. */
|
|
Packit |
575503 |
shift = mpz_get_ui(pz2); /* GMP integer => unsigned long conversion */
|
|
Packit |
575503 |
res = mpg_integer();
|
|
Packit |
575503 |
mpz_fdiv_q_2exp(res->mpg_i, pz1, shift); /* res = pz1 / 2^shift, round towards -inf */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
free_intval(t1, pz1);
|
|
Packit |
575503 |
free_intval(t2, pz2);
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_and --- perform an & operation */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_and(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *t1, *t2, *res;
|
|
Packit |
575503 |
mpz_ptr pz1, pz2;
|
|
Packit |
575503 |
int i;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (nargs < 2)
|
|
Packit |
575503 |
fatal(_("and: called with less than two arguments"));
|
|
Packit |
575503 |
|
|
Packit |
575503 |
t2 = POP_SCALAR();
|
|
Packit |
575503 |
pz2 = get_intval(t2, nargs, "and");
|
|
Packit |
575503 |
|
|
Packit |
575503 |
res = mpg_integer();
|
|
Packit |
575503 |
for (i = 1; i < nargs; i++) {
|
|
Packit |
575503 |
t1 = POP_SCALAR();
|
|
Packit |
575503 |
pz1 = get_intval(t1, nargs - i, "and");
|
|
Packit |
575503 |
mpz_and(res->mpg_i, pz1, pz2);
|
|
Packit |
575503 |
free_intval(t1, pz1);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (i == 1) {
|
|
Packit |
575503 |
free_intval(t2, pz2);
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
pz2 = res->mpg_i;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_or --- perform an | operation */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_or(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *t1, *t2, *res;
|
|
Packit |
575503 |
mpz_ptr pz1, pz2;
|
|
Packit |
575503 |
int i;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (nargs < 2)
|
|
Packit |
575503 |
fatal(_("or: called with less than two arguments"));
|
|
Packit |
575503 |
|
|
Packit |
575503 |
t2 = POP_SCALAR();
|
|
Packit |
575503 |
pz2 = get_intval(t2, nargs, "or");
|
|
Packit |
575503 |
|
|
Packit |
575503 |
res = mpg_integer();
|
|
Packit |
575503 |
for (i = 1; i < nargs; i++) {
|
|
Packit |
575503 |
t1 = POP_SCALAR();
|
|
Packit |
575503 |
pz1 = get_intval(t1, nargs - i, "or");
|
|
Packit |
575503 |
mpz_ior(res->mpg_i, pz1, pz2);
|
|
Packit |
575503 |
free_intval(t1, pz1);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (i == 1) {
|
|
Packit |
575503 |
free_intval(t2, pz2);
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
pz2 = res->mpg_i;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_xor --- perform an ^ operation */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_xor(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *t1, *t2, *res;
|
|
Packit |
575503 |
mpz_ptr pz1, pz2;
|
|
Packit |
575503 |
int i;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (nargs < 2)
|
|
Packit |
575503 |
fatal(_("xor: called with less than two arguments"));
|
|
Packit |
575503 |
|
|
Packit |
575503 |
t2 = POP_SCALAR();
|
|
Packit |
575503 |
pz2 = get_intval(t2, nargs, "xor");
|
|
Packit |
575503 |
|
|
Packit |
575503 |
res = mpg_integer();
|
|
Packit |
575503 |
for (i = 1; i < nargs; i++) {
|
|
Packit |
575503 |
t1 = POP_SCALAR();
|
|
Packit |
575503 |
pz1 = get_intval(t1, nargs - i, "xor");
|
|
Packit |
575503 |
mpz_xor(res->mpg_i, pz1, pz2);
|
|
Packit |
575503 |
free_intval(t1, pz1);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (i == 1) {
|
|
Packit |
575503 |
free_intval(t2, pz2);
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
pz2 = res->mpg_i;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_strtonum --- the strtonum function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_strtonum(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *tmp, *r;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
tmp = fixtype(POP_SCALAR());
|
|
Packit |
575503 |
if ((tmp->flags & NUMBER) == 0) {
|
|
Packit |
575503 |
r = mpg_integer(); /* will be changed to MPFR float if necessary in force_mpnum() */
|
|
Packit |
575503 |
r->stptr = tmp->stptr;
|
|
Packit |
575503 |
r->stlen = tmp->stlen;
|
|
Packit |
575503 |
force_mpnum(r, true, use_lc_numeric);
|
|
Packit |
575503 |
r->stptr = NULL;
|
|
Packit |
575503 |
r->stlen = 0;
|
|
Packit |
575503 |
r->wstptr = NULL;
|
|
Packit |
575503 |
r->wstlen = 0;
|
|
Packit |
575503 |
} else if (is_mpg_float(tmp)) {
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_set(r->mpg_numbr, tmp->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_set(r->mpg_i, tmp->mpg_i);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
DEREF(tmp);
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static bool firstrand = true;
|
|
Packit |
575503 |
static gmp_randstate_t state;
|
|
Packit |
575503 |
static mpz_t seed; /* current seed */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_rand --- do the rand function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_rand(int nargs ATTRIBUTE_UNUSED)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *res;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (firstrand) {
|
|
Packit |
575503 |
#if 0
|
|
Packit |
575503 |
/* Choose the default algorithm */
|
|
Packit |
575503 |
gmp_randinit_default(state);
|
|
Packit |
575503 |
#endif
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* Choose a specific (Mersenne Twister) algorithm in case the default
|
|
Packit |
575503 |
* changes in the future.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
gmp_randinit_mt(state);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
mpz_init(seed);
|
|
Packit |
575503 |
mpz_set_ui(seed, 1);
|
|
Packit |
575503 |
/* seed state */
|
|
Packit |
575503 |
gmp_randseed(state, seed);
|
|
Packit |
575503 |
firstrand = false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
res = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_urandomb(res->mpg_numbr, state);
|
|
Packit |
575503 |
IEEE_FMT(res->mpg_numbr, tval);
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do_mpfr_srand --- seed the random number generator */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_srand(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *res;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (firstrand) {
|
|
Packit |
575503 |
#if 0
|
|
Packit |
575503 |
/* Choose the default algorithm */
|
|
Packit |
575503 |
gmp_randinit_default(state);
|
|
Packit |
575503 |
#endif
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* Choose a specific algorithm (Mersenne Twister) in case default
|
|
Packit |
575503 |
* changes in the future.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
gmp_randinit_mt(state);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
mpz_init(seed);
|
|
Packit |
575503 |
mpz_set_ui(seed, 1);
|
|
Packit |
575503 |
/* No need to seed state, will change it below */
|
|
Packit |
575503 |
firstrand = false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
res = mpg_integer();
|
|
Packit |
575503 |
mpz_set(res->mpg_i, seed); /* previous seed */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (nargs == 0)
|
|
Packit |
575503 |
mpz_set_ui(seed, (unsigned long) time((time_t *) 0));
|
|
Packit |
575503 |
else {
|
|
Packit |
575503 |
NODE *tmp;
|
|
Packit |
575503 |
tmp = POP_SCALAR();
|
|
Packit |
575503 |
if (do_lint && (fixtype(tmp)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("srand: received non-numeric argument"));
|
|
Packit |
575503 |
force_number(tmp);
|
|
Packit |
575503 |
if (is_mpg_float(tmp))
|
|
Packit |
575503 |
mpfr_get_z(seed, tmp->mpg_numbr, MPFR_RNDZ);
|
|
Packit |
575503 |
else /* MP integer */
|
|
Packit |
575503 |
mpz_set(seed, tmp->mpg_i);
|
|
Packit |
575503 |
DEREF(tmp);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
gmp_randseed(state, seed);
|
|
Packit |
575503 |
return res;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#ifdef SUPPLY_INTDIV
|
|
Packit |
575503 |
/* do_mpfr_intdiv --- do integer division, return quotient and remainder in dest array */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* We define the semantics as:
|
|
Packit |
575503 |
* numerator = int(numerator)
|
|
Packit |
575503 |
* denominator = int(denonmator)
|
|
Packit |
575503 |
* quotient = int(numerator / denomator)
|
|
Packit |
575503 |
* remainder = int(numerator % denomator)
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
NODE *
|
|
Packit |
575503 |
do_mpfr_intdiv(int nargs)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *numerator, *denominator, *result;
|
|
Packit |
575503 |
NODE *num, *denom;
|
|
Packit |
575503 |
NODE *quotient, *remainder;
|
|
Packit |
575503 |
NODE *sub, **lhs;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
result = POP_PARAM();
|
|
Packit |
575503 |
if (result->type != Node_var_array)
|
|
Packit |
575503 |
fatal(_("intdiv: third argument is not an array"));
|
|
Packit |
575503 |
assoc_clear(result);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
denominator = POP_SCALAR();
|
|
Packit |
575503 |
numerator = POP_SCALAR();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (do_lint) {
|
|
Packit |
575503 |
if ((fixtype(numerator)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("intdiv: received non-numeric first argument"));
|
|
Packit |
575503 |
if ((fixtype(denominator)->flags & NUMBER) == 0)
|
|
Packit |
575503 |
lintwarn(_("intdiv: received non-numeric second argument"));
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
(void) force_number(numerator);
|
|
Packit |
575503 |
(void) force_number(denominator);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* convert numerator and denominator to integer */
|
|
Packit |
575503 |
if (is_mpg_integer(numerator)) {
|
|
Packit |
575503 |
num = mpg_integer();
|
|
Packit |
575503 |
mpz_set(num->mpg_i, numerator->mpg_i);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
if (! mpfr_number_p(numerator->mpg_numbr)) {
|
|
Packit |
575503 |
/* [+-]inf or NaN */
|
|
Packit |
575503 |
unref(numerator);
|
|
Packit |
575503 |
unref(denominator);
|
|
Packit |
575503 |
return make_number((AWKNUM) -1);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
num = mpg_integer();
|
|
Packit |
575503 |
mpfr_get_z(num->mpg_i, numerator->mpg_numbr, MPFR_RNDZ);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(denominator)) {
|
|
Packit |
575503 |
denom = mpg_integer();
|
|
Packit |
575503 |
mpz_set(denom->mpg_i, denominator->mpg_i);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
if (! mpfr_number_p(denominator->mpg_numbr)) {
|
|
Packit |
575503 |
/* [+-]inf or NaN */
|
|
Packit |
575503 |
unref(numerator);
|
|
Packit |
575503 |
unref(denominator);
|
|
Packit |
575503 |
unref(num);
|
|
Packit |
575503 |
return make_number((AWKNUM) -1);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
denom = mpg_integer();
|
|
Packit |
575503 |
mpfr_get_z(denom->mpg_i, denominator->mpg_numbr, MPFR_RNDZ);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (mpz_sgn(denom->mpg_i) == 0)
|
|
Packit |
575503 |
fatal(_("intdiv: division by zero attempted"));
|
|
Packit |
575503 |
|
|
Packit |
575503 |
quotient = mpg_integer();
|
|
Packit |
575503 |
remainder = mpg_integer();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* do the division */
|
|
Packit |
575503 |
mpz_tdiv_qr(quotient->mpg_i, remainder->mpg_i, num->mpg_i, denom->mpg_i);
|
|
Packit |
575503 |
unref(num);
|
|
Packit |
575503 |
unref(denom);
|
|
Packit |
575503 |
unref(numerator);
|
|
Packit |
575503 |
unref(denominator);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
sub = make_string("quotient", 8);
|
|
Packit |
575503 |
lhs = assoc_lookup(result, sub);
|
|
Packit |
575503 |
unref(*lhs);
|
|
Packit |
575503 |
*lhs = quotient;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
sub = make_string("remainder", 9);
|
|
Packit |
575503 |
lhs = assoc_lookup(result, sub);
|
|
Packit |
575503 |
unref(*lhs);
|
|
Packit |
575503 |
*lhs = remainder;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
return make_number((AWKNUM) 0.0);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
#endif /* SUPPLY_INTDIV */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* mpg_tofloat --- convert an arbitrary-precision integer operand to
|
|
Packit |
575503 |
* a float without loss of precision. It is assumed that the
|
|
Packit |
575503 |
* MPFR variable has already been initialized.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static inline mpfr_ptr
|
|
Packit |
575503 |
mpg_tofloat(mpfr_ptr mf, mpz_ptr mz)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
size_t prec;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* When implicitely converting a GMP integer operand to a MPFR float, use
|
|
Packit |
575503 |
* a precision sufficiently large to hold the converted value exactly.
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* $ ./gawk -M 'BEGIN { print 13 % 2 }'
|
|
Packit |
575503 |
* 1
|
|
Packit |
575503 |
* If the user-specified precision is used to convert the integer 13 to a
|
|
Packit |
575503 |
* float, one will get:
|
|
Packit |
575503 |
* $ ./gawk -M 'BEGIN { PREC=2; print 13 % 2.0 }'
|
|
Packit |
575503 |
* 0
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
prec = mpz_sizeinbase(mz, 2); /* most significant 1 bit position starting at 1 */
|
|
Packit |
575503 |
if (prec > PRECISION_MIN) {
|
|
Packit |
575503 |
prec -= (size_t) mpz_scan1(mz, 0); /* least significant 1 bit index starting at 0 */
|
|
Packit |
575503 |
if (prec > MPFR_PREC_MAX)
|
|
Packit |
575503 |
prec = MPFR_PREC_MAX;
|
|
Packit |
575503 |
else if (prec < PRECISION_MIN)
|
|
Packit |
575503 |
prec = PRECISION_MIN;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
prec = PRECISION_MIN;
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* Always set the precision to avoid hysteresis, since do_mpfr_func
|
|
Packit |
575503 |
* may copy our precision.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
if (prec != mpfr_get_prec(mf))
|
|
Packit |
575503 |
mpfr_set_prec(mf, prec);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
mpfr_set_z(mf, mz, ROUND_MODE);
|
|
Packit |
575503 |
return mf;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_add --- add arbitrary-precision numbers */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_add(NODE *t1, NODE *t2)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_add(r->mpg_i, t1->mpg_i, t2->mpg_i);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
if (is_mpg_integer(t2))
|
|
Packit |
575503 |
tval = mpfr_add_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, ROUND_MODE);
|
|
Packit |
575503 |
else if (is_mpg_integer(t1))
|
|
Packit |
575503 |
tval = mpfr_add_z(r->mpg_numbr, t2->mpg_numbr, t1->mpg_i, ROUND_MODE);
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
tval = mpfr_add(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_sub --- subtract arbitrary-precision numbers */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_sub(NODE *t1, NODE *t2)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_sub(r->mpg_i, t1->mpg_i, t2->mpg_i);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
if (is_mpg_integer(t2))
|
|
Packit |
575503 |
tval = mpfr_sub_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, ROUND_MODE);
|
|
Packit |
575503 |
else if (is_mpg_integer(t1)) {
|
|
Packit |
575503 |
#if (!defined(MPFR_VERSION) || (MPFR_VERSION < MPFR_VERSION_NUM(3,1,0)))
|
|
Packit |
575503 |
NODE *tmp = t1;
|
|
Packit |
575503 |
t1 = t2;
|
|
Packit |
575503 |
t2 = tmp;
|
|
Packit |
575503 |
tval = mpfr_sub_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, ROUND_MODE);
|
|
Packit |
575503 |
tval = mpfr_neg(r->mpg_numbr, r->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
t2 = t1;
|
|
Packit |
575503 |
t1 = tmp;
|
|
Packit |
575503 |
#else
|
|
Packit |
575503 |
tval = mpfr_z_sub(r->mpg_numbr, t1->mpg_i, t2->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
#endif
|
|
Packit |
575503 |
} else
|
|
Packit |
575503 |
tval = mpfr_sub(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_mul --- multiply arbitrary-precision numbers */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_mul(NODE *t1, NODE *t2)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_mul(r->mpg_i, t1->mpg_i, t2->mpg_i);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
if (is_mpg_integer(t2))
|
|
Packit |
575503 |
tval = mpfr_mul_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, ROUND_MODE);
|
|
Packit |
575503 |
else if (is_mpg_integer(t1))
|
|
Packit |
575503 |
tval = mpfr_mul_z(r->mpg_numbr, t2->mpg_numbr, t1->mpg_i, ROUND_MODE);
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
tval = mpfr_mul(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_pow --- exponentiation involving arbitrary-precision numbers */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_pow(NODE *t1, NODE *t2)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
|
|
Packit |
575503 |
if (mpz_sgn(t2->mpg_i) >= 0 && mpz_fits_ulong_p(t2->mpg_i)) {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_pow_ui(r->mpg_i, t1->mpg_i, mpz_get_ui(t2->mpg_i));
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
mpfr_ptr p1, p2;
|
|
Packit |
575503 |
p1 = MP_FLOAT(t1);
|
|
Packit |
575503 |
p2 = MP_FLOAT(t2);
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_pow(r->mpg_numbr, p1, p2, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
if (is_mpg_integer(t2))
|
|
Packit |
575503 |
tval = mpfr_pow_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, ROUND_MODE);
|
|
Packit |
575503 |
else {
|
|
Packit |
575503 |
mpfr_ptr p1;
|
|
Packit |
575503 |
p1 = MP_FLOAT(t1);
|
|
Packit |
575503 |
tval = mpfr_pow(r->mpg_numbr, p1, t2->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_div --- arbitrary-precision division */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_div(NODE *t1, NODE *t2)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1) && is_mpg_integer(t2)
|
|
Packit |
575503 |
&& (mpz_sgn(t2->mpg_i) != 0) /* not dividing by 0 */
|
|
Packit |
575503 |
&& mpz_divisible_p(t1->mpg_i, t2->mpg_i)
|
|
Packit |
575503 |
) {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_divexact(r->mpg_i, t1->mpg_i, t2->mpg_i);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
mpfr_ptr p1, p2;
|
|
Packit |
575503 |
p1 = MP_FLOAT(t1);
|
|
Packit |
575503 |
p2 = MP_FLOAT(t2);
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_div(r->mpg_numbr, p1, p2, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_mod --- modulus operation with arbitrary-precision numbers */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static NODE *
|
|
Packit |
575503 |
mpg_mod(NODE *t1, NODE *t2)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
NODE *r;
|
|
Packit |
575503 |
int tval;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* 8/2014: Originally, this was just
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* r = mpg_integer();
|
|
Packit |
575503 |
* mpz_mod(r->mpg_i, t1->mpg_i, t2->mpg_i);
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* But that gave very strange results with negative numerator:
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* $ ./gawk -M 'BEGIN { print -15 % 7 }'
|
|
Packit |
575503 |
* 6
|
|
Packit |
575503 |
*
|
|
Packit |
575503 |
* So instead we use mpz_tdiv_qr() to get the correct result
|
|
Packit |
575503 |
* and just throw away the quotient. We could not find any
|
|
Packit |
575503 |
* reason why mpz_mod() wasn't working correctly.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
NODE *dummy_quotient;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
dummy_quotient = mpg_integer();
|
|
Packit |
575503 |
mpz_tdiv_qr(dummy_quotient->mpg_i, r->mpg_i, t1->mpg_i, t2->mpg_i);
|
|
Packit |
575503 |
unref(dummy_quotient);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
mpfr_ptr p1, p2;
|
|
Packit |
575503 |
p1 = MP_FLOAT(t1);
|
|
Packit |
575503 |
p2 = MP_FLOAT(t2);
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_fmod(r->mpg_numbr, p1, p2, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
return r;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* mpg_interpret --- pre-exec hook in the interpreter. Handles
|
|
Packit |
575503 |
* arithmetic operations with MPFR/GMP numbers.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
static int
|
|
Packit |
575503 |
mpg_interpret(INSTRUCTION **cp)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
INSTRUCTION *pc = *cp; /* current instruction */
|
|
Packit |
575503 |
OPCODE op; /* current opcode */
|
|
Packit |
575503 |
NODE *r = NULL;
|
|
Packit |
575503 |
NODE *t1, *t2;
|
|
Packit |
575503 |
NODE **lhs;
|
|
Packit |
575503 |
int tval; /* the ternary value returned by a MPFR function */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
switch ((op = pc->opcode)) {
|
|
Packit |
575503 |
case Op_plus_i:
|
|
Packit |
575503 |
t2 = force_number(pc->memory);
|
|
Packit |
575503 |
goto plus;
|
|
Packit |
575503 |
case Op_plus:
|
|
Packit |
575503 |
t2 = POP_NUMBER();
|
|
Packit |
575503 |
plus:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
r = mpg_add(t1, t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (op == Op_plus)
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_minus_i:
|
|
Packit |
575503 |
t2 = force_number(pc->memory);
|
|
Packit |
575503 |
goto minus;
|
|
Packit |
575503 |
case Op_minus:
|
|
Packit |
575503 |
t2 = POP_NUMBER();
|
|
Packit |
575503 |
minus:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
r = mpg_sub(t1, t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (op == Op_minus)
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_times_i:
|
|
Packit |
575503 |
t2 = force_number(pc->memory);
|
|
Packit |
575503 |
goto times;
|
|
Packit |
575503 |
case Op_times:
|
|
Packit |
575503 |
t2 = POP_NUMBER();
|
|
Packit |
575503 |
times:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
r = mpg_mul(t1, t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (op == Op_times)
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_exp_i:
|
|
Packit |
575503 |
t2 = force_number(pc->memory);
|
|
Packit |
575503 |
goto exp;
|
|
Packit |
575503 |
case Op_exp:
|
|
Packit |
575503 |
t2 = POP_NUMBER();
|
|
Packit |
575503 |
exp:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
r = mpg_pow(t1, t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (op == Op_exp)
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_quotient_i:
|
|
Packit |
575503 |
t2 = force_number(pc->memory);
|
|
Packit |
575503 |
goto quotient;
|
|
Packit |
575503 |
case Op_quotient:
|
|
Packit |
575503 |
t2 = POP_NUMBER();
|
|
Packit |
575503 |
quotient:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
r = mpg_div(t1, t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (op == Op_quotient)
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_mod_i:
|
|
Packit |
575503 |
t2 = force_number(pc->memory);
|
|
Packit |
575503 |
goto mod;
|
|
Packit |
575503 |
case Op_mod:
|
|
Packit |
575503 |
t2 = POP_NUMBER();
|
|
Packit |
575503 |
mod:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
r = mpg_mod(t1, t2);
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
if (op == Op_mod)
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_preincrement:
|
|
Packit |
575503 |
case Op_predecrement:
|
|
Packit |
575503 |
lhs = TOP_ADDRESS();
|
|
Packit |
575503 |
t1 = *lhs;
|
|
Packit |
575503 |
force_number(t1);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1)) {
|
|
Packit |
575503 |
if (t1->valref == 1 && t1->flags == (MALLOC|MPZN|NUMCUR|NUMBER))
|
|
Packit |
575503 |
/* Efficiency hack. Big speed-up (> 30%) in a tight loop */
|
|
Packit |
575503 |
r = t1;
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
r = *lhs = mpg_integer();
|
|
Packit |
575503 |
if (op == Op_preincrement)
|
|
Packit |
575503 |
mpz_add_ui(r->mpg_i, t1->mpg_i, 1);
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
mpz_sub_ui(r->mpg_i, t1->mpg_i, 1);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/*
|
|
Packit |
575503 |
* An optimization like the one above is not going to work
|
|
Packit |
575503 |
* for a floating-point number. With it,
|
|
Packit |
575503 |
* gawk -M 'BEGIN { PREC=53; i=2^53+0.0; PREC=113; ++i; print i}'
|
|
Packit |
575503 |
* will output 2^53 instead of 2^53+1.
|
|
Packit |
575503 |
*/
|
|
Packit |
575503 |
|
|
Packit |
575503 |
r = *lhs = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_add_si(r->mpg_numbr, t1->mpg_numbr,
|
|
Packit |
575503 |
op == Op_preincrement ? 1 : -1,
|
|
Packit |
575503 |
ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
if (r != t1)
|
|
Packit |
575503 |
unref(t1);
|
|
Packit |
575503 |
UPREF(r);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_postincrement:
|
|
Packit |
575503 |
case Op_postdecrement:
|
|
Packit |
575503 |
lhs = TOP_ADDRESS();
|
|
Packit |
575503 |
t1 = *lhs;
|
|
Packit |
575503 |
force_number(t1);
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (is_mpg_integer(t1)) {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_set(r->mpg_i, t1->mpg_i);
|
|
Packit |
575503 |
if (t1->valref == 1 && t1->flags == (MALLOC|MPZN|NUMCUR|NUMBER))
|
|
Packit |
575503 |
/* Efficiency hack. Big speed-up (> 30%) in a tight loop */
|
|
Packit |
575503 |
t2 = t1;
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
t2 = *lhs = mpg_integer();
|
|
Packit |
575503 |
if (op == Op_postincrement)
|
|
Packit |
575503 |
mpz_add_ui(t2->mpg_i, t1->mpg_i, 1);
|
|
Packit |
575503 |
else
|
|
Packit |
575503 |
mpz_sub_ui(t2->mpg_i, t1->mpg_i, 1);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_set(r->mpg_numbr, t1->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
t2 = *lhs = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_add_si(t2->mpg_numbr, t1->mpg_numbr,
|
|
Packit |
575503 |
op == Op_postincrement ? 1 : -1,
|
|
Packit |
575503 |
ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(t2->mpg_numbr, tval);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
if (t2 != t1)
|
|
Packit |
575503 |
unref(t1);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_unary_minus:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
if (is_mpg_float(t1)) {
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_neg(r->mpg_numbr, t1->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_neg(r->mpg_i, t1->mpg_i);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_unary_plus:
|
|
Packit |
575503 |
t1 = TOP_NUMBER();
|
|
Packit |
575503 |
if (is_mpg_float(t1)) {
|
|
Packit |
575503 |
r = mpg_float();
|
|
Packit |
575503 |
tval = mpfr_set(r->mpg_numbr, t1->mpg_numbr, ROUND_MODE);
|
|
Packit |
575503 |
IEEE_FMT(r->mpg_numbr, tval);
|
|
Packit |
575503 |
} else {
|
|
Packit |
575503 |
r = mpg_integer();
|
|
Packit |
575503 |
mpz_set(r->mpg_i, t1->mpg_i);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
DEREF(t1);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
case Op_assign_plus:
|
|
Packit |
575503 |
case Op_assign_minus:
|
|
Packit |
575503 |
case Op_assign_times:
|
|
Packit |
575503 |
case Op_assign_quotient:
|
|
Packit |
575503 |
case Op_assign_mod:
|
|
Packit |
575503 |
case Op_assign_exp:
|
|
Packit |
575503 |
lhs = POP_ADDRESS();
|
|
Packit |
575503 |
t1 = *lhs;
|
|
Packit |
575503 |
force_number(t1);
|
|
Packit |
575503 |
t2 = TOP_NUMBER();
|
|
Packit |
575503 |
|
|
Packit |
575503 |
switch (op) {
|
|
Packit |
575503 |
case Op_assign_plus:
|
|
Packit |
575503 |
r = mpg_add(t1, t2);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
case Op_assign_minus:
|
|
Packit |
575503 |
r = mpg_sub(t1, t2);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
case Op_assign_times:
|
|
Packit |
575503 |
r = mpg_mul(t1, t2);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
case Op_assign_quotient:
|
|
Packit |
575503 |
r = mpg_div(t1, t2);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
case Op_assign_mod:
|
|
Packit |
575503 |
r = mpg_mod(t1, t2);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
case Op_assign_exp:
|
|
Packit |
575503 |
r = mpg_pow(t1, t2);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
default:
|
|
Packit |
575503 |
cant_happen();
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
DEREF(t2);
|
|
Packit |
575503 |
unref(*lhs);
|
|
Packit |
575503 |
*lhs = r;
|
|
Packit |
575503 |
UPREF(r);
|
|
Packit |
575503 |
REPLACE(r);
|
|
Packit |
575503 |
break;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
default:
|
|
Packit |
575503 |
return true; /* unhandled */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
*cp = pc->nexti; /* next instruction to execute */
|
|
Packit |
575503 |
return false;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpg_fmt --- output formatted string with special MPFR/GMP conversion specifiers */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
const char *
|
|
Packit |
575503 |
mpg_fmt(const char *mesg, ...)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
static char *tmp = NULL;
|
|
Packit |
575503 |
int ret;
|
|
Packit |
575503 |
va_list args;
|
|
Packit |
575503 |
|
|
Packit |
575503 |
if (tmp != NULL) {
|
|
Packit |
575503 |
mpfr_free_str(tmp);
|
|
Packit |
575503 |
tmp = NULL;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
va_start(args, mesg);
|
|
Packit |
575503 |
ret = mpfr_vasprintf(& tmp, mesg, args);
|
|
Packit |
575503 |
va_end(args);
|
|
Packit |
575503 |
if (ret >= 0 && tmp != NULL)
|
|
Packit |
575503 |
return tmp;
|
|
Packit |
575503 |
return mesg;
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
/* mpfr_unset --- clear out the MPFR values */
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
mpfr_unset(NODE *n)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
if (is_mpg_float(n))
|
|
Packit |
575503 |
mpfr_clear(n->mpg_numbr);
|
|
Packit |
575503 |
else if (is_mpg_integer(n))
|
|
Packit |
575503 |
mpz_clear(n->mpg_i);
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
#else
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
set_PREC()
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
/* dummy function */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
set_ROUNDMODE()
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
/* dummy function */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
|
|
Packit |
575503 |
void
|
|
Packit |
575503 |
mpfr_unset(NODE *n)
|
|
Packit |
575503 |
{
|
|
Packit |
575503 |
/* dummy function */
|
|
Packit |
575503 |
}
|
|
Packit |
575503 |
#endif
|