aboutsummaryrefslogtreecommitdiffstats
path: root/builtin.c
diff options
context:
space:
mode:
Diffstat (limited to 'builtin.c')
-rw-r--r--builtin.c326
1 files changed, 253 insertions, 73 deletions
diff --git a/builtin.c b/builtin.c
index 1da8a4f5..62d62e7c 100644
--- a/builtin.c
+++ b/builtin.c
@@ -3,7 +3,7 @@
*/
/*
- * Copyright (C) 1986, 1988, 1989, 1991-2011 the Free Software Foundation, Inc.
+ * Copyright (C) 1986, 1988, 1989, 1991-2012 the Free Software Foundation, Inc.
*
* This file is part of GAWK, the GNU implementation of the
* AWK Programming Language.
@@ -135,7 +135,7 @@ do_exp(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("exp: received non-numeric argument"));
- d = force_number(tmp);
+ d = force_number(tmp)->numbr;
DEREF(tmp);
errno = 0;
res = exp(d);
@@ -459,7 +459,7 @@ do_int(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("int: received non-numeric argument"));
- d = force_number(tmp);
+ d = force_number(tmp)->numbr;
d = double_to_int(d);
DEREF(tmp);
return make_number((AWKNUM) d);
@@ -537,7 +537,7 @@ do_log(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("log: received non-numeric argument"));
- arg = (double) force_number(tmp);
+ arg = force_number(tmp)->numbr;
if (arg < 0.0)
warning(_("log: received negative argument %g"), arg);
d = log(arg);
@@ -546,6 +546,42 @@ do_log(int nargs)
}
+#ifdef HAVE_MPFR
+
+/*
+ * mpz2mpfr --- convert an arbitrary-precision integer to a float
+ * without any loss of precision. The returned value is only
+ * good for temporary use.
+ */
+
+
+static mpfr_ptr
+mpz2mpfr(mpz_ptr zi)
+{
+ size_t prec;
+ static mpfr_t mpfrval;
+ static int inited = FALSE;
+ int tval;
+
+ /* estimate minimum precision for exact conversion */
+ prec = mpz_sizeinbase(zi, 2); /* most significant 1 bit position starting at 1 */
+ prec -= (size_t) mpz_scan1(zi, 0); /* least significant 1 bit index starting at 0 */
+ if (prec < MPFR_PREC_MIN)
+ prec = MPFR_PREC_MIN;
+ else if (prec > MPFR_PREC_MAX)
+ prec = MPFR_PREC_MAX;
+
+ if (! inited) {
+ mpfr_init2(mpfrval, prec);
+ inited = TRUE;
+ } else
+ mpfr_set_prec(mpfrval, prec);
+ tval = mpfr_set_z(mpfrval, zi, ROUND_MODE);
+ IEEE_FMT(mpfrval, tval);
+ return mpfrval;
+}
+#endif
+
/*
* format_tree() formats arguments of sprintf,
* and accordingly to a fmt_string providing a format like in
@@ -603,7 +639,7 @@ format_tree(
size_t cur_arg = 0;
NODE *r = NULL;
- int i;
+ int i, nc;
int toofew = FALSE;
char *obuf, *obufout;
size_t osiz, ofre;
@@ -617,7 +653,7 @@ format_tree(
long *cur = NULL;
uintmax_t uval;
int sgn;
- int base = 0;
+ int base;
/*
* Although this is an array, the elements serve two different
* purposes. The first element is the general buffer meant
@@ -635,7 +671,7 @@ format_tree(
char *cend = &cpbufs[0].stackbuf[sizeof(cpbufs[0].stackbuf)];
char *cp;
const char *fill;
- AWKNUM tmpval;
+ AWKNUM tmpval = 0.0;
char signchar = FALSE;
size_t len;
int zero_flag = FALSE;
@@ -643,6 +679,12 @@ format_tree(
int ii, jj;
char *chp;
size_t copy_count, char_count;
+#ifdef HAVE_MPFR
+ mpz_ptr zi;
+ mpfr_ptr mf;
+#endif
+ enum { MP_INT_WITH_PREC = 1, MP_INT_WITHOUT_PREC, MP_FLOAT } fmt_type;
+
static const char sp[] = " ";
static const char zero_string[] = "0";
static const char lchbuf[] = "0123456789abcdef";
@@ -728,11 +770,19 @@ format_tree(
cur = &fw;
fw = 0;
prec = 0;
+ base = 0;
argnum = 0;
+ base = 0;
have_prec = FALSE;
signchar = FALSE;
zero_flag = FALSE;
quote_flag = FALSE;
+#ifdef HAVE_MPFR
+ mf = NULL;
+ zi = NULL;
+#endif
+ fmt_type = 0;
+
lj = alt = big_flag = bigbig_flag = small_flag = FALSE;
fill = sp;
cp = cend;
@@ -864,7 +914,8 @@ check_pos:
} else {
parse_next_arg();
}
- *cur = force_number(arg);
+ (void) force_number(arg);
+ *cur = get_number_si(arg);
if (*cur < 0 && cur == &fw) {
*cur = -*cur;
lj++;
@@ -972,7 +1023,7 @@ check_pos:
if ((arg->flags & (MAYBE_NUM|NUMBER)) == MAYBE_NUM)
(void) force_number(arg);
if (arg->flags & NUMBER) {
- uval = (uintmax_t) arg->numbr;
+ uval = get_number_uj(arg);
#if MBS_SUPPORT
if (gawk_mb_cur_max > 1) {
char buf[100];
@@ -1055,7 +1106,16 @@ out2:
case 'i':
need_format = FALSE;
parse_next_arg();
- tmpval = force_number(arg);
+ (void) force_number(arg);
+#ifdef HAVE_MPFR
+ if (is_mpg_float(arg))
+ goto mpf0;
+ else if (is_mpg_integer(arg))
+ goto mpz0;
+ else
+#endif
+ tmpval = arg->numbr;
+
/*
* Check for Nan or Inf.
*/
@@ -1166,7 +1226,78 @@ out2:
base += 8;
need_format = FALSE;
parse_next_arg();
- tmpval = force_number(arg);
+ (void) force_number(arg);
+#ifdef HAVE_MPFR
+ if (is_mpg_integer(arg)) {
+mpz0:
+ zi = arg->mpg_i;
+
+ if (cs1 != 'd' && cs1 != 'i') {
+ if (mpz_sgn(zi) <= 0) {
+ /*
+ * Negative value or 0 requires special handling.
+ * Unlike MPFR, GMP does not allow conversion
+ * to (u)intmax_t. So we first convert GMP type to
+ * a MPFR type.
+ */
+ mf = mpz2mpfr(zi);
+ goto mpf1;
+ }
+ signchar = FALSE; /* Don't print '+' */
+ }
+
+ /* See comments above about when to fill with zeros */
+ zero_flag = (! lj
+ && ((zero_flag && ! have_prec)
+ || (fw == 0 && have_prec)));
+
+ fmt_type = have_prec ? MP_INT_WITH_PREC : MP_INT_WITHOUT_PREC;
+ goto fmt0;
+
+ } else if (is_mpg_float(arg)) {
+mpf0:
+ mf = arg->mpg_numbr;
+ if (! mpfr_number_p(mf)) {
+ /* inf or NaN */
+ cs1 = 'g';
+ fmt_type = MP_FLOAT;
+ goto fmt1;
+ }
+
+ if (cs1 != 'd' && cs1 != 'i') {
+mpf1:
+ /*
+ * The output of printf("%#.0x", 0) is 0 instead of 0x, hence <= in
+ * the comparison below.
+ */
+ if (mpfr_sgn(mf) <= 0) {
+ if (! mpfr_fits_intmax_p(mf, ROUND_MODE)) {
+ /* -ve number is too large */
+ cs1 = 'g';
+ fmt_type = MP_FLOAT;
+ goto fmt1;
+ }
+
+ tmpval = uval = (uintmax_t) mpfr_get_sj(mf, ROUND_MODE);
+ if (! alt && have_prec && prec == 0 && tmpval == 0)
+ goto pr_tail; /* printf("%.0x", 0) is no characters */
+ goto int0;
+ }
+ signchar = FALSE; /* Don't print '+' */
+ }
+
+ /* See comments above about when to fill with zeros */
+ zero_flag = (! lj
+ && ((zero_flag && ! have_prec)
+ || (fw == 0 && have_prec)));
+
+ (void) mpfr_get_z(mpzval, mf, MPFR_RNDZ); /* convert to GMP integer */
+ fmt_type = have_prec ? MP_INT_WITH_PREC : MP_INT_WITHOUT_PREC;
+ zi = mpzval;
+ goto fmt0;
+ } else
+#endif
+ tmpval = arg->numbr;
/*
* ``The result of converting a zero value with a
@@ -1185,14 +1316,16 @@ out2:
if (tmpval < 0) {
uval = (uintmax_t) (intmax_t) tmpval;
- if ((AWKNUM)(intmax_t)uval !=
- double_to_int(tmpval))
+ if ((AWKNUM)(intmax_t)uval != double_to_int(tmpval))
goto out_of_range;
} else {
uval = (uintmax_t) tmpval;
if ((AWKNUM)uval != double_to_int(tmpval))
goto out_of_range;
}
+#ifdef HAVE_MPFR
+ int0:
+#endif
/*
* When to fill with zeroes is of course not simple.
* First: No zero fill if left-justifying.
@@ -1275,7 +1408,7 @@ out2:
lintwarn(_("[s]printf: value %g is out of range for `%%%c' format"),
(double) tmpval, cs1);
cs1 = 'g';
- goto format_float;
+ goto fmt1;
case 'F':
#if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1
@@ -1289,11 +1422,28 @@ out2:
case 'E':
need_format = FALSE;
parse_next_arg();
- tmpval = force_number(arg);
- format_float:
+ (void) force_number(arg);
+
+ if (! is_mpg_number(arg))
+ tmpval = arg->numbr;
+#ifdef HAVE_MPFR
+ else if (is_mpg_float(arg)) {
+ mf = arg->mpg_numbr;
+ fmt_type = MP_FLOAT;
+ } else {
+ /* arbitrary-precision integer, convert to MPFR float */
+ assert(mf == NULL);
+ mf = mpz2mpfr(arg->mpg_i);
+ fmt_type = MP_FLOAT;
+ }
+#endif
+ fmt1:
if (! have_prec)
prec = DEFAULT_G_PRECISION;
- chksize(fw + prec + 9); /* 9 == slop */
+#ifdef HAVE_MPFR
+ fmt0:
+#endif
+ chksize(fw + prec + 11); /* 11 == slop */
cp = cpbuf;
*cp++ = '%';
if (lj)
@@ -1306,25 +1456,46 @@ out2:
*cp++ = '0';
if (quote_flag)
*cp++ = '\'';
- strcpy(cp, "*.*");
- cp += 3;
- *cp++ = cs1;
- *cp = '\0';
+
#if defined(LC_NUMERIC)
if (quote_flag && ! use_lc_numeric)
setlocale(LC_NUMERIC, "");
#endif
- {
- int n;
- while ((n = snprintf(obufout, ofre, cpbuf,
- (int) fw, (int) prec,
- (double) tmpval)) >= ofre)
- chksize(n)
+
+ switch (fmt_type) {
+#ifdef HAVE_MPFR
+ case MP_INT_WITH_PREC:
+ sprintf(cp, "*.*Z%c", cs1);
+ while ((nc = mpfr_snprintf(obufout, ofre, cpbuf,
+ (int) fw, (int) prec, zi)) >= ofre)
+ chksize(nc)
+ break;
+ case MP_INT_WITHOUT_PREC:
+ sprintf(cp, "*Z%c", cs1);
+ while ((nc = mpfr_snprintf(obufout, ofre, cpbuf,
+ (int) fw, zi)) >= ofre)
+ chksize(nc)
+ break;
+ case MP_FLOAT:
+ sprintf(cp, "*.*R*%c", cs1);
+ while ((nc = mpfr_snprintf(obufout, ofre, cpbuf,
+ (int) fw, (int) prec, ROUND_MODE, mf)) >= ofre)
+ chksize(nc)
+ break;
+#endif
+ default:
+ sprintf(cp, "*.*%c", cs1);
+ while ((nc = snprintf(obufout, ofre, cpbuf,
+ (int) fw, (int) prec,
+ (double) tmpval)) >= ofre)
+ chksize(nc)
}
+
#if defined(LC_NUMERIC)
if (quote_flag && ! use_lc_numeric)
setlocale(LC_NUMERIC, "C");
#endif
+
len = strlen(obufout);
ofre -= len;
obufout += len;
@@ -1365,6 +1536,7 @@ out:
if (obuf != NULL)
efree(obuf);
}
+
if (r == NULL)
gawk_exit(EXIT_FATAL);
return r;
@@ -1476,7 +1648,7 @@ do_sqrt(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("sqrt: received non-numeric argument"));
- arg = (double) force_number(tmp);
+ arg = (double) force_number(tmp)->numbr;
DEREF(tmp);
if (arg < 0.0)
warning(_("sqrt: called with negative argument %g"), arg);
@@ -1495,9 +1667,16 @@ do_substr(int nargs)
double d_index = 0, d_length = 0;
size_t src_len;
- if (nargs == 3)
- POP_NUMBER(d_length);
- POP_NUMBER(d_index);
+ if (nargs == 3) {
+ t1 = POP_NUMBER();
+ d_length = get_number_d(t1);
+ DEREF(t1);
+ }
+
+ t1 = POP_NUMBER();
+ d_index = get_number_d(t1);
+ DEREF(t1);
+
t1 = POP_STRING();
if (nargs == 3) {
@@ -1681,7 +1860,8 @@ do_strftime(int nargs)
t2 = POP_SCALAR();
if (do_lint && (t2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("strftime: received non-numeric second argument"));
- clock_val = (long) force_number(t2);
+ (void) force_number(t2);
+ clock_val = get_number_si(t2);
if (clock_val < 0)
fatal(_("strftime: second argument less than 0 or too big for time_t"));
fclock = (time_t) clock_val;
@@ -2099,8 +2279,8 @@ do_atan2(int nargs)
if ((t2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("atan2: received non-numeric second argument"));
}
- d1 = force_number(t1);
- d2 = force_number(t2);
+ d1 = force_number(t1)->numbr;
+ d2 = force_number(t2)->numbr;
DEREF(t1);
DEREF(t2);
return make_number((AWKNUM) atan2(d1, d2));
@@ -2117,7 +2297,7 @@ do_sin(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("sin: received non-numeric argument"));
- d = sin((double) force_number(tmp));
+ d = sin((double) force_number(tmp)->numbr);
DEREF(tmp);
return make_number((AWKNUM) d);
}
@@ -2133,7 +2313,7 @@ do_cos(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("cos: received non-numeric argument"));
- d = cos((double) force_number(tmp));
+ d = cos((double) force_number(tmp)->numbr);
DEREF(tmp);
return make_number((AWKNUM) d);
}
@@ -2186,7 +2366,7 @@ do_srand(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("srand: received non-numeric argument"));
- srandom((unsigned int) (save_seed = (long) force_number(tmp)));
+ srandom((unsigned int) (save_seed = (long) force_number(tmp)->numbr));
DEREF(tmp);
}
return make_number((AWKNUM) ret);
@@ -2463,15 +2643,16 @@ do_sub(int nargs, unsigned int flags)
if (t1->stlen > 0 && (t1->stptr[0] == 'g' || t1->stptr[0] == 'G'))
how_many = -1;
else {
- d = force_number(t1);
-
+ (void) force_number(t1);
+ d = get_number_d(t1);
if ((t1->flags & NUMCUR) != 0)
goto set_how_many;
how_many = 1;
}
} else {
- d = force_number(t1);
+ (void) force_number(t1);
+ d = get_number_d(t1);
set_how_many:
if (d < 1)
how_many = 1;
@@ -2777,15 +2958,15 @@ do_lshift(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("lshift: received non-numeric second argument"));
}
- val = force_number(s1);
- shift = force_number(s2);
+ val = force_number(s1)->numbr;
+ shift = force_number(s2)->numbr;
if (do_lint) {
if (val < 0 || shift < 0)
- lintwarn(_("lshift(%lf, %lf): negative values will give strange results"), val, shift);
+ lintwarn(_("lshift(%f, %f): negative values will give strange results"), val, shift);
if (double_to_int(val) != val || double_to_int(shift) != shift)
- lintwarn(_("lshift(%lf, %lf): fractional values will be truncated"), val, shift);
+ lintwarn(_("lshift(%f, %f): fractional values will be truncated"), val, shift);
if (shift >= sizeof(uintmax_t) * CHAR_BIT)
- lintwarn(_("lshift(%lf, %lf): too large shift value will give strange results"), val, shift);
+ lintwarn(_("lshift(%f, %f): too large shift value will give strange results"), val, shift);
}
DEREF(s1);
@@ -2814,15 +2995,15 @@ do_rshift(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("rshift: received non-numeric second argument"));
}
- val = force_number(s1);
- shift = force_number(s2);
+ val = force_number(s1)->numbr;
+ shift = force_number(s2)->numbr;
if (do_lint) {
if (val < 0 || shift < 0)
- lintwarn(_("rshift(%lf, %lf): negative values will give strange results"), val, shift);
+ lintwarn(_("rshift(%f, %f): negative values will give strange results"), val, shift);
if (double_to_int(val) != val || double_to_int(shift) != shift)
- lintwarn(_("rshift(%lf, %lf): fractional values will be truncated"), val, shift);
+ lintwarn(_("rshift(%f, %f): fractional values will be truncated"), val, shift);
if (shift >= sizeof(uintmax_t) * CHAR_BIT)
- lintwarn(_("rshift(%lf, %lf): too large shift value will give strange results"), val, shift);
+ lintwarn(_("rshift(%f, %f): too large shift value will give strange results"), val, shift);
}
DEREF(s1);
@@ -2851,13 +3032,13 @@ do_and(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("and: received non-numeric second argument"));
}
- left = force_number(s1);
- right = force_number(s2);
+ left = force_number(s1)->numbr;
+ right = force_number(s2)->numbr;
if (do_lint) {
if (left < 0 || right < 0)
- lintwarn(_("and(%lf, %lf): negative values will give strange results"), left, right);
+ lintwarn(_("and(%f, %f): negative values will give strange results"), left, right);
if (double_to_int(left) != left || double_to_int(right) != right)
- lintwarn(_("and(%lf, %lf): fractional values will be truncated"), left, right);
+ lintwarn(_("and(%f, %f): fractional values will be truncated"), left, right);
}
DEREF(s1);
@@ -2886,13 +3067,13 @@ do_or(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("or: received non-numeric second argument"));
}
- left = force_number(s1);
- right = force_number(s2);
+ left = force_number(s1)->numbr;
+ right = force_number(s2)->numbr;
if (do_lint) {
if (left < 0 || right < 0)
- lintwarn(_("or(%lf, %lf): negative values will give strange results"), left, right);
+ lintwarn(_("or(%f, %f): negative values will give strange results"), left, right);
if (double_to_int(left) != left || double_to_int(right) != right)
- lintwarn(_("or(%lf, %lf): fractional values will be truncated"), left, right);
+ lintwarn(_("or(%f, %f): fractional values will be truncated"), left, right);
}
DEREF(s1);
@@ -2915,8 +3096,6 @@ do_xor(int nargs)
AWKNUM left, right;
POP_TWO_SCALARS(s1, s2);
- left = force_number(s1);
- right = force_number(s2);
if (do_lint) {
if ((s1->flags & (NUMCUR|NUMBER)) == 0)
@@ -2924,13 +3103,13 @@ do_xor(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("xor: received non-numeric second argument"));
}
- left = force_number(s1);
- right = force_number(s2);
+ left = force_number(s1)->numbr;
+ right = force_number(s2)->numbr;
if (do_lint) {
if (left < 0 || right < 0)
- lintwarn(_("xor(%lf, %lf): negative values will give strange results"), left, right);
+ lintwarn(_("xor(%f, %f): negative values will give strange results"), left, right);
if (double_to_int(left) != left || double_to_int(right) != right)
- lintwarn(_("xor(%lf, %lf): fractional values will be truncated"), left, right);
+ lintwarn(_("xor(%f, %f): fractional values will be truncated"), left, right);
}
DEREF(s1);
@@ -2955,16 +3134,14 @@ do_compl(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("compl: received non-numeric argument"));
- d = force_number(tmp);
+ d = force_number(tmp)->numbr;
DEREF(tmp);
if (do_lint) {
- if ((tmp->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("compl: received non-numeric argument"));
if (d < 0)
- lintwarn(_("compl(%lf): negative value will give strange results"), d);
+ lintwarn(_("compl(%f): negative value will give strange results"), d);
if (double_to_int(d) != d)
- lintwarn(_("compl(%lf): fractional value will be truncated"), d);
+ lintwarn(_("compl(%f): fractional value will be truncated"), d);
}
uval = (uintmax_t) d;
@@ -2982,11 +3159,11 @@ do_strtonum(int nargs)
tmp = POP_SCALAR();
if ((tmp->flags & (NUMBER|NUMCUR)) != 0)
- d = (AWKNUM) force_number(tmp);
- else if (isnondecimal(tmp->stptr, use_lc_numeric))
+ d = (AWKNUM) force_number(tmp)->numbr;
+ else if (get_numbase(tmp->stptr, use_lc_numeric) != 10)
d = nondec2awknum(tmp->stptr, tmp->stlen);
else
- d = (AWKNUM) force_number(tmp);
+ d = (AWKNUM) force_number(tmp)->numbr;
DEREF(tmp);
return make_number((AWKNUM) d);
@@ -3236,7 +3413,10 @@ do_dcngettext(int nargs)
}
#endif
- POP_NUMBER(d); /* third argument */
+ t2 = POP_NUMBER(); /* third argument */
+ d = get_number_d(t2);
+ DEREF(t2);
+
number = (unsigned long) double_to_int(d);
t2 = POP_STRING(); /* second argument */
string2 = t2->stptr;
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-05 19:02:13 +0000