aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog12
-rw-r--r--awk.h2
-rw-r--r--awkgram.c2
-rw-r--r--awkgram.y2
-rw-r--r--mpfr.c301
5 files changed, 175 insertions, 144 deletions
diff --git a/ChangeLog b/ChangeLog
index 0c794280..e958e8ca 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2013-01-11 John Haque <j.eh@mchsi.com>
+
+ * awk.h (do_mpfr_rshift): Renamed from do_mpfr_rhift.
+ * awkgram.y (do_mpfr_rshift): Renamed from do_mpfr_rhift.
+ * mpfr.c (_tz1, _tz2, _mpz1, _mpz2, mpz1, mpz2, get_bit_ops, free_bit_ops):
+ Removed.
+ (init_mpfr): Remove calls to mpz_init.
+ (get_intval, free_intval): New functions.
+ (do_mpfr_rshift, do_mpfr_lshift): Rework code.
+ (do_mpfr_and, do_mpfr_or, do_mpfr_xor): Accept two or more arguments to match
+ regular functions.
+
2013-01-11 Arnold D. Robbins <arnold@skeeve.com>
* bisonfix.awk: Adjust ARGV / ARGC to force reading of standard
diff --git a/awk.h b/awk.h
index 0f9b2ec1..6a97a447 100644
--- a/awk.h
+++ b/awk.h
@@ -1552,7 +1552,7 @@ extern NODE *do_mpfr_log(int);
extern NODE *do_mpfr_lshift(int);
extern NODE *do_mpfr_or(int);
extern NODE *do_mpfr_rand(int);
-extern NODE *do_mpfr_rhift(int);
+extern NODE *do_mpfr_rshift(int);
extern NODE *do_mpfr_sin(int);
extern NODE *do_mpfr_sqrt(int);
extern NODE *do_mpfr_srand(int);
diff --git a/awkgram.c b/awkgram.c
index 228fd66d..07a6dce8 100644
--- a/awkgram.c
+++ b/awkgram.c
@@ -4428,7 +4428,7 @@ static const struct token tokentab[] = {
{"printf", Op_K_printf, LEX_PRINTF, 0, 0, 0},
{"rand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0), do_rand, MPF(rand)},
{"return", Op_K_return, LEX_RETURN, NOT_OLD, 0, 0},
-{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(rhift)},
+{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(rshift)},
{"sin", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_sin, MPF(sin)},
{"split", Op_builtin, LEX_BUILTIN, A(2)|A(3)|A(4), do_split, 0},
{"sprintf", Op_builtin, LEX_BUILTIN, 0, do_sprintf, 0},
diff --git a/awkgram.y b/awkgram.y
index 6a707cbc..83187e1b 100644
--- a/awkgram.y
+++ b/awkgram.y
@@ -1892,7 +1892,7 @@ static const struct token tokentab[] = {
{"printf", Op_K_printf, LEX_PRINTF, 0, 0, 0},
{"rand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0), do_rand, MPF(rand)},
{"return", Op_K_return, LEX_RETURN, NOT_OLD, 0, 0},
-{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(rhift)},
+{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(rshift)},
{"sin", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_sin, MPF(sin)},
{"split", Op_builtin, LEX_BUILTIN, A(2)|A(3)|A(4), do_split, 0},
{"sprintf", Op_builtin, LEX_BUILTIN, 0, do_sprintf, 0},
diff --git a/mpfr.c b/mpfr.c
index 48fa072c..df8a8d41 100644
--- a/mpfr.c
+++ b/mpfr.c
@@ -48,17 +48,6 @@ static int mpg_interpret(INSTRUCTION **cp);
static mpfr_exp_t min_exp = MPFR_EMIN_DEFAULT;
static mpfr_exp_t max_exp = MPFR_EMAX_DEFAULT;
-/* temporaries used in bit ops */
-static NODE *_tz1;
-static NODE *_tz2;
-static mpz_t _mpz1;
-static mpz_t _mpz2;
-static mpz_ptr mpz1;
-static mpz_ptr mpz2;
-
-static NODE *get_bit_ops(const char *op);
-#define free_bit_ops() (DEREF(_tz1), DEREF(_tz2))
-
/* temporary MPFR floats used to hold converted GMP integer operands */
static mpfr_t _mpf_t1;
static mpfr_t _mpf_t2;
@@ -93,8 +82,6 @@ init_mpfr(mpfr_prec_t prec, const char *rmode)
mpz_init(MFNR);
do_ieee_fmt = false;
- mpz_init(_mpz1);
- mpz_init(_mpz2);
mpfr_init2(_mpf_t1, PRECISION_MIN);
mpfr_init2(_mpf_t2, PRECISION_MIN);
mpz_init(mpzval);
@@ -837,181 +824,228 @@ do_mpfr_compl(int nargs)
return r;
}
+/* get_intval --- get the (converted) integral operand of a binary function. */
-/*
- * get_bit_ops --- get the numeric operands of a binary function.
- * Returns a copy of the operand if either is inf or nan. Otherwise
- * each operand is converted to an integer if necessary, and
- * the results are placed in the variables mpz1 and mpz2.
- */
-
-static NODE *
-get_bit_ops(const char *op)
+static mpz_ptr
+get_intval(NODE *t1, int argnum, const char *op)
{
- _tz2 = POP_SCALAR();
- _tz1 = POP_SCALAR();
+ mpz_ptr pz;
- if (do_lint) {
- if ((_tz1->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("%s: received non-numeric first argument"), op);
- if ((_tz2->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("%s: received non-numeric second argument"), op);
- }
+ if (do_lint && (t1->flags & (NUMCUR|NUMBER)) == 0)
+ lintwarn(_("%s: received non-numeric argument #%d"), op, argnum);
- force_number(_tz1);
- force_number(_tz2);
+ (void) force_number(t1);
- if (is_mpg_float(_tz1)) {
- mpfr_ptr left = _tz1->mpg_numbr;
+ if (is_mpg_float(t1)) {
+ mpfr_ptr left = t1->mpg_numbr;
if (! mpfr_number_p(left)) {
/* inf or NaN */
- NODE *res;
- res = mpg_float();
- mpfr_set(res->mpg_numbr, _tz1->mpg_numbr, ROUND_MODE);
- return res;
+ if (do_lint)
+ lintwarn("%s",
+ mpg_fmt(_("%s: argument #%d has invalid value %Rg, using 0"),
+ op, argnum, left)
+ );
+
+ emalloc(pz, mpz_ptr, sizeof (mpz_t), "get_intval");
+ mpz_init(pz);
+ return pz; /* should be freed */
}
if (do_lint) {
if (mpfr_sgn(left) < 0)
lintwarn("%s",
- mpg_fmt(_("%s(%Rg, ..): negative values will give strange results"),
- op, left)
- );
+ mpg_fmt(_("%s: argument #%d negative value %Rg will give strange results"),
+ op, argnum, left)
+ );
+
if (! mpfr_integer_p(left))
lintwarn("%s",
- mpg_fmt(_("%s(%Rg, ..): fractional values will be truncated"),
- op, left)
+ mpg_fmt(_("%s: argument #%d fractional value %Rg will be truncated"),
+ op, argnum, left)
);
}
-
- mpfr_get_z(_mpz1, left, MPFR_RNDZ); /* float to integer conversion */
- mpz1 = _mpz1;
- } else {
- /* (_tz1->flags & MPZN) != 0 */
- mpz1 = _tz1->mpg_i;
- if (do_lint) {
- if (mpz_sgn(mpz1) < 0)
- lintwarn("%s",
- mpg_fmt(_("%s(%Zd, ..): negative values will give strange results"),
- op, mpz1)
- );
- }
+
+ emalloc(pz, mpz_ptr, sizeof (mpz_t), "get_intval");
+ mpz_init(pz);
+ mpfr_get_z(pz, left, MPFR_RNDZ); /* float to integer conversion */
+ return pz; /* should be freed */
+ }
+ /* (t1->flags & MPZN) != 0 */
+ pz = t1->mpg_i;
+ if (do_lint) {
+ if (mpz_sgn(pz) < 0)
+ lintwarn("%s",
+ mpg_fmt(_("%s: argument #%d negative value %Zd will give strange results"),
+ op, argnum, pz)
+ );
}
+ return pz; /* must not be freed */
+}
- if (is_mpg_float(_tz2)) {
- mpfr_ptr right = _tz2->mpg_numbr;
- if (! mpfr_number_p(right)) {
- /* inf or NaN */
- NODE *res;
- res = mpg_float();
- mpfr_set(res->mpg_numbr, _tz2->mpg_numbr, ROUND_MODE);
- return res;
- }
- if (do_lint) {
- if (mpfr_sgn(right) < 0)
- lintwarn("%s",
- mpg_fmt(_("%s(.., %Rg): negative values will give strange results"),
- op, right)
- );
- if (! mpfr_integer_p(right))
- lintwarn("%s",
- mpg_fmt(_("%s(.., %Rg): fractional values will be truncated"),
- op, right)
- );
- }
+/* free_intval --- free the converted integer value returned by get_intval() */
- mpfr_get_z(_mpz2, right, MPFR_RNDZ); /* float to integer conversion */
- mpz2 = _mpz2;
- } else {
- /* (_tz2->flags & MPZN) != 0 */
- mpz2 = _tz2->mpg_i;
- if (do_lint) {
- if (mpz_sgn(mpz2) < 0)
- lintwarn("%s",
- mpg_fmt(_("%s(.., %Zd): negative values will give strange results"),
- op, mpz2)
- );
- }
+static inline void
+free_intval(NODE *t, mpz_ptr pz)
+{
+ if ((t->flags & MPZN) == 0) {
+ mpz_clear(pz);
+ efree(pz);
}
-
- return NULL;
}
+
/* do_mpfr_lshift --- perform a << operation */
NODE *
do_mpfr_lshift(int nargs)
{
- NODE *res;
+ NODE *t1, *t2, *res;
unsigned long shift;
+ mpz_ptr pz1, pz2;
+
+ t2 = POP_SCALAR();
+ t1 = POP_SCALAR();
- if ((res = get_bit_ops("lshift")) == NULL) {
+ pz1 = get_intval(t1, 1, "lshift");
+ pz2 = get_intval(t2, 2, "lshift");
- /*
- * mpz_get_ui: If op is too big to fit an unsigned long then just
- * the least significant bits that do fit are returned.
- * The sign of op is ignored, only the absolute value is used.
- */
+ /*
+ * mpz_get_ui: If op is too big to fit an unsigned long then just
+ * the least significant bits that do fit are returned.
+ * The sign of op is ignored, only the absolute value is used.
+ */
- shift = mpz_get_ui(mpz2); /* GMP integer => unsigned long conversion */
- res = mpg_integer();
- mpz_mul_2exp(res->mpg_i, mpz1, shift); /* res = mpz1 * 2^shift */
- }
- free_bit_ops();
+ shift = mpz_get_ui(pz2); /* GMP integer => unsigned long conversion */
+ res = mpg_integer();
+ mpz_mul_2exp(res->mpg_i, pz1, shift); /* res = pz1 * 2^shift */
+
+ free_intval(t1, pz1);
+ free_intval(t2, pz2);
+ DEREF(t2);
+ DEREF(t1);
return res;
}
/* do_mpfr_rshift --- perform a >> operation */
NODE *
-do_mpfr_rhift(int nargs)
+do_mpfr_rshift(int nargs)
{
- NODE *res;
+ NODE *t1, *t2, *res;
unsigned long shift;
+ mpz_ptr pz1, pz2;
+
+ t2 = POP_SCALAR();
+ t1 = POP_SCALAR();
- if ((res = get_bit_ops("rshift")) == NULL) {
- /*
- * mpz_get_ui: If op is too big to fit an unsigned long then just
- * the least significant bits that do fit are returned.
- * The sign of op is ignored, only the absolute value is used.
- */
+ pz1 = get_intval(t1, 1, "rshift");
+ pz2 = get_intval(t2, 2, "rshift");
- shift = mpz_get_ui(mpz2); /* GMP integer => unsigned long conversion */
- res = mpg_integer();
- mpz_fdiv_q_2exp(res->mpg_i, mpz1, shift); /* res = mpz1 / 2^shift, round towards −inf */
- }
- free_bit_ops();
+ /* N.B: See do_mpfp_lshift. */
+ shift = mpz_get_ui(pz2); /* GMP integer => unsigned long conversion */
+ res = mpg_integer();
+ mpz_fdiv_q_2exp(res->mpg_i, pz1, shift); /* res = pz1 / 2^shift, round towards −inf */
+
+ free_intval(t1, pz1);
+ free_intval(t2, pz2);
+ DEREF(t2);
+ DEREF(t1);
return res;
}
+
/* do_mpfr_and --- perform an & operation */
NODE *
do_mpfr_and(int nargs)
{
- NODE *res;
+ NODE *t1, *t2, *res;
+ mpz_ptr pz1, pz2;
+ int i;
+
+ if (nargs < 2)
+ fatal(_("and: called with less than two arguments"));
+
+ t2 = POP_SCALAR();
+ pz2 = get_intval(t2, nargs, "and");
- if ((res = get_bit_ops("and")) == NULL) {
- res = mpg_integer();
- mpz_and(res->mpg_i, mpz1, mpz2);
+ res = mpg_integer();
+ for (i = 1; i < nargs; i++) {
+ t1 = POP_SCALAR();
+ pz1 = get_intval(t1, nargs - i, "and");
+ mpz_and(res->mpg_i, pz1, pz2);
+ free_intval(t1, pz1);
+ DEREF(t1);
+ if (i == 1) {
+ free_intval(t2, pz2);
+ DEREF(t2);
+ }
+ pz2 = res->mpg_i;
}
- free_bit_ops();
return res;
}
+
/* do_mpfr_or --- perform an | operation */
NODE *
do_mpfr_or(int nargs)
{
- NODE *res;
+ NODE *t1, *t2, *res;
+ mpz_ptr pz1, pz2;
+ int i;
+
+ if (nargs < 2)
+ fatal(_("or: called with less than two arguments"));
+
+ t2 = POP_SCALAR();
+ pz2 = get_intval(t2, nargs, "or");
+
+ res = mpg_integer();
+ for (i = 1; i < nargs; i++) {
+ t1 = POP_SCALAR();
+ pz1 = get_intval(t1, nargs - i, "or");
+ mpz_ior(res->mpg_i, pz1, pz2);
+ free_intval(t1, pz1);
+ DEREF(t1);
+ if (i == 1) {
+ free_intval(t2, pz2);
+ DEREF(t2);
+ }
+ pz2 = res->mpg_i;
+ }
+ return res;
+}
- if ((res = get_bit_ops("or")) == NULL) {
- res = mpg_integer();
- mpz_ior(res->mpg_i, mpz1, mpz2);
+/* do_mpfr_xor --- perform an ^ operation */
+
+NODE *
+do_mpfr_xor(int nargs)
+{
+ NODE *t1, *t2, *res;
+ mpz_ptr pz1, pz2;
+ int i;
+
+ if (nargs < 2)
+ fatal(_("xor: called with less than two arguments"));
+
+ t2 = POP_SCALAR();
+ pz2 = get_intval(t2, nargs, "xor");
+
+ res = mpg_integer();
+ for (i = 1; i < nargs; i++) {
+ t1 = POP_SCALAR();
+ pz1 = get_intval(t1, nargs - i, "xor");
+ mpz_xor(res->mpg_i, pz1, pz2);
+ free_intval(t1, pz1);
+ DEREF(t1);
+ if (i == 1) {
+ free_intval(t2, pz2);
+ DEREF(t2);
+ }
+ pz2 = res->mpg_i;
}
- free_bit_ops();
return res;
}
@@ -1047,21 +1081,6 @@ do_mpfr_strtonum(int nargs)
return r;
}
-/* do_mpfr_xor --- perform an ^ operation */
-
-NODE *
-do_mpfr_xor(int nargs)
-{
- NODE *res;
-
- if ((res = get_bit_ops("xor")) == NULL) {
- res = mpg_integer();
- mpz_xor(res->mpg_i, mpz1, mpz2);
- }
- free_bit_ops();
- return res;
-}
-
static bool firstrand = true;
static gmp_randstate_t state;
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-05 20:46:03 +0000