Make mpfr and, or, xor, accept >= 2 arguments.

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;