Add GMP and MPFR support to rwarray extension.

7 files changed, 181 insertions, 52 deletions

diff --git a/ChangeLog b/ChangeLog
index 710fdc1b..26eb7cd0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2021-11-18         Arnold D. Robbins     <arnold@skeeve.com>
+
+	* gawkapi.c (awk_value_to_node): Fix handling of MPFR values
+	coming back from an extension.
+
 2021-11-07         Arnold D. Robbins     <arnold@skeeve.com>
 
 	* mkinstalldirs: Removed, it wasn't used.
diff --git a/NEWS b/NEWS
index 17fc9ee2..b4f3a72d 100644
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,9 @@ Changes from 5.1.1 to 5.1.2
 
 1. Infrastructure upgrades: Automake 1.16.5, Texinfo 6.8.
 
+2. The rwarray extension now supports writing and reading GMP and
+    MPFR values. As a result, a bug in the API code was fixed.
+
 Changes from 5.1.0 to 5.1.1
 ---------------------------
 
diff --git a/extension/ChangeLog b/extension/ChangeLog
index 91cdf48e..c2624e6e 100644
--- a/extension/ChangeLog
+++ b/extension/ChangeLog
@@ -1,3 +1,9 @@
+2021-11-18         Arnold D. Robbins     <arnold@skeeve.com>
+
+	* rwarray.c: Add support for writing/reading GMP and MPFR values.
+	Rework usage of constants while we're at it and bump version
+	numbers.
+
 2021-11-07         Arnold D. Robbins     <arnold@skeeve.com>
 
 	* rwarray0.c: Removed, it wasn't used.
diff --git a/extension/rwarray.c b/extension/rwarray.c
index 45f9c734..9a8d15e9 100644
--- a/extension/rwarray.c
+++ b/extension/rwarray.c
@@ -5,10 +5,11 @@
  * May 2009
  * Redone June 2012
  * Improved September 2017
+ * GMP/MPFR support added November 2021
  */
 
 /*
- * Copyright (C) 2009-2014, 2017, 2018, 2020 the Free Software Foundation, Inc.
+ * Copyright (C) 2009-2014, 2017, 2018, 2020, 2021 the Free Software Foundation, Inc.
  *
  * This file is part of GAWK, the GNU implementation of the
  * AWK Programming Language.
@@ -49,6 +50,11 @@
 #include <sys/types.h>
 #include <sys/stat.h>
 
+#ifdef HAVE_MPFR
+#include <gmp.h>
+#include <mpfr.h>
+#endif
+
 #include "gawkapi.h"
 
 #include "gettext.h"
@@ -56,12 +62,12 @@
 #define N_(msgid) msgid
 
 #define MAGIC "awkrulz\n"
-#define MAJOR 3
-#define MINOR 1
+#define MAJOR 4
+#define MINOR 0
 
 static const gawk_api_t *api;	/* for convenience macros to work */
 static awk_ext_id_t ext_id;
-static const char *ext_version = "rwarray extension: version 1.2";
+static const char *ext_version = "rwarray extension: version 2.0";
 static awk_bool_t (*init_func)(void) = NULL;
 
 int plugin_is_GPL_compatible;
@@ -69,10 +75,12 @@ int plugin_is_GPL_compatible;
 static awk_bool_t write_array(FILE *fp, awk_array_t array);
 static awk_bool_t write_elem(FILE *fp, awk_element_t *element);
 static awk_bool_t write_value(FILE *fp, awk_value_t *val);
+static awk_bool_t write_number(FILE *fp, awk_value_t *val);
 
 static awk_bool_t read_array(FILE *fp, awk_array_t array);
 static awk_bool_t read_elem(FILE *fp, awk_element_t *element);
 static awk_bool_t read_value(FILE *fp, awk_value_t *value);
+static awk_bool_t read_number(FILE *fp, awk_value_t *value, uint32_t code);
 
 /*
  * Format of array info:
@@ -86,7 +94,7 @@ static awk_bool_t read_value(FILE *fp, awk_value_t *value);
  * For each element:
  * Length of index val:	4 bytes - network order
  * Index val as characters (N bytes)
- * Value type		4 bytes (0 = string, 1 = number, 2 = array, 3 = regex, 4 = strnum, 5 = undefined)
+ * Value type		4 bytes (see list below)
  * IF string:
  * 	Length of value	4 bytes
  * 	Value as characters (N bytes)
@@ -98,6 +106,15 @@ static awk_bool_t read_value(FILE *fp, awk_value_t *value);
  * END IF
  */
 
+#define VT_STRING	1
+#define VT_NUMBER	2
+#define VT_GMP		3
+#define VT_MPFR		4
+#define VT_ARRAY	5
+#define VT_REGEX	6
+#define VT_STRNUM	7
+#define VT_UNDEFINED	20
+
 /* do_writea --- write an array */
 
 static awk_value_t *
@@ -222,51 +239,95 @@ write_value(FILE *fp, awk_value_t *val)
 	uint32_t code, len;
 
 	if (val->val_type == AWK_ARRAY) {
-		code = htonl(2);
+		code = htonl(VT_ARRAY);
 		if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
 			return awk_false;
 		return write_array(fp, val->array_cookie);
 	}
 
-	if (val->val_type == AWK_NUMBER) {
-		code = htonl(1);
-		if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
-			return awk_false;
+	if (val->val_type == AWK_NUMBER)
+		return write_number(fp, val);
+
+	switch (val->val_type) {
+	case AWK_STRING:
+		code = htonl(VT_STRING);
+		break;
+	case AWK_STRNUM:
+		code = htonl(VT_STRNUM);
+		break;
+	case AWK_REGEX:
+		code = htonl(VT_REGEX);
+		break;
+	case AWK_UNDEFINED:
+		code = htonl(VT_UNDEFINED);
+		break;
+	default:
+		/* XXX can this happen? */
+		code = htonl(VT_UNDEFINED);
+		warning(ext_id, _("array value has unknown type %d"), val->val_type);
+		break;
+	}
+	if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
+		return awk_false;
 
-		if (fwrite(& val->num_value, 1, sizeof(val->num_value), fp) != sizeof(val->num_value))
-			return awk_false;
-	} else {
-		switch (val->val_type) {
-		case AWK_STRING:
-			code = htonl(0);
-			break;
-		case AWK_STRNUM:
-			code = htonl(4);
-			break;
-		case AWK_REGEX:
-			code = htonl(3);
-			break;
-		case AWK_UNDEFINED:
-			code = htonl(5);
-			break;
-		default:
-			/* XXX can this happen? */
-			code = htonl(0);
-			warning(ext_id, _("array value has unknown type %d"), val->val_type);
-			break;
-		}
+	len = htonl(val->str_value.len);
+	if (fwrite(& len, 1, sizeof(len), fp) != sizeof(len))
+		return awk_false;
+
+	if (fwrite(val->str_value.str, 1, val->str_value.len, fp)
+			!= (ssize_t) val->str_value.len)
+		return awk_false;
+
+	return awk_true;
+}
+
+/* write_number --- write a double, GMP or MPFR number */
+
+static awk_bool_t
+write_number(FILE *fp, awk_value_t *val)
+{
+	uint32_t len, code;
+	char buffer[BUFSIZ];
+
+	if (val->num_type == AWK_NUMBER_TYPE_DOUBLE) {
+		uint32_t network_order_len;
+
+		code = htonl(VT_NUMBER);
 		if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
 			return awk_false;
 
-		len = htonl(val->str_value.len);
-		if (fwrite(& len, 1, sizeof(len), fp) != sizeof(len))
+		// for portability, save double precision number as a string
+		sprintf(buffer, "%.17g", val->num_value);
+		len = strlen(buffer) + 1;	// get trailing '\0' too...
+		network_order_len = htonl(len);
+
+		if (fwrite(& network_order_len, 1, sizeof(len), fp) != sizeof(len))
 			return awk_false;
 
-		if (fwrite(val->str_value.str, 1, val->str_value.len, fp)
-				!= (ssize_t) val->str_value.len)
+		if (fwrite(buffer, 1, len, fp) != len)
 			return awk_false;
-	}
+	} else {
+#ifdef HAVE_MPFR
+		if (val->num_type == AWK_NUMBER_TYPE_MPFR) {
+			code = htonl(VT_MPFR);
+			if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
+				return awk_false;
 
+			if (mpfr_fpif_export(fp, val->num_ptr) != 0)
+				return awk_false;
+		} else {
+			code = htonl(VT_GMP);
+			if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
+				return awk_false;
+
+			if (mpz_out_raw(fp, val->num_ptr) == 0)
+				return awk_false;
+		}
+#else
+		fatal(ext_id, _("rwarray extension: received GMP/MPFR value but compiled without GMP/MPFR support."));
+#endif
+	}
+	// all the OK cases fall through to here
 	return awk_true;
 }
 
@@ -448,7 +509,7 @@ read_value(FILE *fp, awk_value_t *value)
 
 	code = ntohl(code);
 
-	if (code == 2) {
+	if (code == VT_ARRAY) {
 		awk_array_t array = create_array();
 
 		if (! read_array(fp, array))
@@ -457,31 +518,26 @@ read_value(FILE *fp, awk_value_t *value)
 		/* hook into value */
 		value->val_type = AWK_ARRAY;
 		value->array_cookie = array;
-	} else if (code == 1) {
-		double d;
-
-		if (fread(& d, 1, sizeof(d), fp) != sizeof(d))
-			return awk_false;
-
-		/* hook into value */
-		value->val_type = AWK_NUMBER;
-		value->num_value = d;
+	} else if (code == VT_NUMBER
+		   || code == VT_GMP
+		   || code == VT_MPFR) {
+		return read_number(fp, value, code);
 	} else {
 		if (fread(& len, 1, sizeof(len), fp) != sizeof(len)) {
 			return awk_false;
 		}
 		len = ntohl(len);
 		switch (code) {
-		case 0:
+		case VT_STRING:
 			value->val_type = AWK_STRING;
 			break;
-		case 3:
+		case VT_REGEX:
 			value->val_type = AWK_REGEX;
 			break;
-		case 4:
+		case VT_STRNUM:
 			value->val_type = AWK_STRNUM;
 			break;
-		case 5:
+		case VT_UNDEFINED:
 			value->val_type = AWK_UNDEFINED;
 			break;
 		default:
@@ -503,6 +559,55 @@ read_value(FILE *fp, awk_value_t *value)
 	return awk_true;
 }
 
+/* read_number --- read a double, GMP, or MPFR number */
+
+static awk_bool_t
+read_number(FILE *fp, awk_value_t *value, uint32_t code)
+{
+	uint32_t len;
+
+	if (code == VT_NUMBER) {
+		char buffer[BUFSIZ];
+		double d;
+
+		if (fread(& len, 1, sizeof(len), fp) != sizeof(len))
+			return awk_false;
+
+		len = ntohl(len);
+		if (fread(buffer, 1, len, fp) != len)
+			return awk_false;
+
+		(void) sscanf(buffer, "%lg", & d);
+
+		/* hook into value */
+		value = make_number(d, value);
+	} else {
+#ifdef HAVE_MPFR
+		if (code == VT_GMP) {
+			mpz_t mp_ptr;
+
+			mpz_init(mp_ptr);
+    			if (mpz_inp_raw(mp_ptr, fp) == 0)
+				return awk_false;
+
+			value = make_number_mpz(mp_ptr, value);
+		} else {
+			mpfr_t mpfr_val;
+			mpfr_init(mpfr_val);
+
+			if (mpfr_fpif_import(mpfr_val, fp) != 0)
+				return awk_false;
+
+			value = make_number_mpfr(& mpfr_val, value);
+		}
+#else
+		fatal(ext_id(_("rwarray extension: GMP/MPFR value in file but compiled without GMP/MPFR support."));
+#endif
+	}
+
+	return awk_true;
+}
+
 static awk_ext_func_t func_table[] = {
 	{ "writea", do_writea, 2, 2, awk_false, NULL },
 	{ "reada", do_reada, 2, 2, awk_false, NULL },
diff --git a/gawkapi.c b/gawkapi.c
index a60549dd..4435ad10 100644
--- a/gawkapi.c
+++ b/gawkapi.c
@@ -170,7 +170,8 @@ awk_value_to_node(const awk_value_t *retval)
 			if (! do_mpfr)
 				fatal(_("awk_value_to_node: not in MPFR mode"));
 			ext_ret_val = make_number_node(MPFN);
-			tval = mpfr_set(ext_ret_val->mpg_numbr, (mpfr_ptr) retval->num_ptr, ROUND_MODE);
+			mpfr_init(ext_ret_val->mpg_numbr);
+			tval = mpfr_set(ext_ret_val->mpg_numbr, (mpfr_srcptr) retval->num_ptr, ROUND_MODE);
 			IEEE_FMT(ext_ret_val->mpg_numbr, tval);
 #else
 			fatal(_("awk_value_to_node: MPFR not supported"));
diff --git a/test/ChangeLog b/test/ChangeLog
index 299e55c9..8384b5db 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,7 @@
+2021-11-18         Arnold D. Robbins     <arnold@skeeve.com>
+
+	* rwarray.awk: Improve test, add string and numbers.
+
 2021-11-14         Arnold D. Robbins     <arnold@skeeve.com>
 
 	* iolint.awk: Disable test with race condition. Thanks to
diff --git a/test/rwarray.awk b/test/rwarray.awk
index 86a4b589..c06fec21 100644
--- a/test/rwarray.awk
+++ b/test/rwarray.awk
@@ -11,6 +11,11 @@ BEGIN {
 	split("-2.4", f)
 	dict[strnum_sub] = f[1]
 
+	dict["x"] = "x"
+
+	dict["42"] = 42
+	dict["42.42"] = 42.42
+
 	n = asorti(dict, dictindices)
 	for (i = 1; i <= n; i++)
 		printf("dict[%s] = %s\n", dictindices[i], dict[dictindices[i]]) > "orig.out"