1 /*
2 * rwarray.c - Builtin functions to binary read / write arrays to a file.
3 *
4 * Arnold Robbins
5 * May 2009
6 * Redone June 2012
7 * Improved September 2017
8 * GMP/MPFR support added November 2021
9 */
10
11 /*
12 * Copyright (C) 2009-2014, 2017, 2018, 2020-2022
13 * the Free Software Foundation, Inc.
14 *
15 * This file is part of GAWK, the GNU implementation of the
16 * AWK Programming Language.
17 *
18 * GAWK is free software; you can redistribute it and/or modify
19 * it under the terms of the GNU General Public License as published by
20 * the Free Software Foundation; either version 3 of the License, or
21 * (at your option) any later version.
22 *
23 * GAWK is distributed in the hope that it will be useful,
24 * but WITHOUT ANY WARRANTY; without even the implied warranty of
25 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26 * GNU General Public License for more details.
27 *
28 * You should have received a copy of the GNU General Public License
29 * along with this program; if not, write to the Free Software
30 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
31 */
32
33 #ifdef HAVE_CONFIG_H
34 #include <config.h>
35 #endif
36
37 #include <stdio.h>
38 #include <assert.h>
39 #include <errno.h>
40 #include <fcntl.h>
41 #include <stdbool.h>
42 #include <stdlib.h>
43 #include <string.h>
44 #include <unistd.h>
45
46 #ifdef __MINGW32__
47 #include <winsock2.h>
48 #include <stdint.h>
49 #else
50 #include <arpa/inet.h>
51 #endif
52 #include <sys/types.h>
53 #include <sys/stat.h>
54
55 #ifdef HAVE_MPFR
56 #include <gmp.h>
57 #include <mpfr.h>
58 #endif
59
60 #include "gawkapi.h"
61
62 #include "gettext.h"
63 #define _(msgid) gettext(msgid)
64 #define N_(msgid) msgid
65
66 #define MAGIC "awkrulz\n"
67 #define MAJOR 4
68 #define MINOR 1
69
70 static const gawk_api_t *api; /* for convenience macros to work */
71 static awk_ext_id_t ext_id;
72 static const char *ext_version = "rwarray extension: version 2.1";
73 static awk_bool_t (*init_func)(void) = NULL;
74
75 int plugin_is_GPL_compatible;
76
77 static awk_bool_t write_array(FILE *fp, awk_array_t array);
78 static awk_bool_t write_elem(FILE *fp, awk_element_t *element);
79 static awk_bool_t write_value(FILE *fp, awk_value_t *val);
80 static awk_bool_t write_number(FILE *fp, awk_value_t *val);
81
82 #ifdef HAVE_MPFR
83 typedef union {
84 mpz_t mpz_val;
85 mpfr_t mpfr_val;
86 } value_storage;
87 #else
88 typedef int value_storage; // should not be used
89 #endif /* HAVE_MPFR */
90
91 static awk_bool_t read_array(FILE *fp, awk_array_t array);
92 static awk_bool_t read_elem(FILE *fp, awk_element_t *element, value_storage *);
93 static awk_bool_t read_value(FILE *fp, awk_value_t *value, awk_value_t *idx, value_storage *vs);
94 static awk_bool_t read_number(FILE *fp, awk_value_t *value, uint32_t code, value_storage *);
95
96 /*
97 * Format of array info:
98 *
99 * MAGIC 8 bytes
100 * Major version 4 bytes - network order
101 * Minor version 4 bytes - network order
102 * Element count 4 bytes - network order
103 * Elements
104 *
105 * For each element:
106 * Length of index val: 4 bytes - network order
107 * Index val as characters (N bytes)
108 * Value type 4 bytes (see list below)
109 * IF string:
110 * Length of value 4 bytes
111 * Value as characters (N bytes)
112 * ELSE IF number:
113 * 8 bytes as native double
114 * ELSE
115 * Element count
116 * Elements
117 * END IF
118 */
119
120 #define VT_STRING 1
121 #define VT_NUMBER 2
122 #define VT_GMP 3
123 #define VT_MPFR 4
124 #define VT_ARRAY 5
125 #define VT_REGEX 6
126 #define VT_STRNUM 7
127 #define VT_BOOL 8
128 #define VT_UNDEFINED 20
129
130 /* write_backend --- write an array */
131
132 static awk_value_t *
133 write_backend(awk_value_t *result, awk_array_t array, const char *name)
134 {
135 awk_value_t filename;
136 FILE *fp = NULL;
137 uint32_t major = MAJOR;
138 uint32_t minor = MINOR;
139
140 assert(result != NULL);
141 make_number(0.0, result);
142
143 /* filename is first arg */
144 if (! get_argument(0, AWK_STRING, & filename)) {
145 warning(ext_id, _("%s: first argument is not a string"), name);
146 errno = EINVAL;
147 goto done1;
148 }
149
150 /* open the file, if error, set ERRNO and return */
151 fp = fopen(filename.str_value.str, "wb");
152 if (fp == NULL)
153 goto done1;
154
155 if (fwrite(MAGIC, 1, strlen(MAGIC), fp) != strlen(MAGIC))
156 goto done1;
157
158 major = htonl(major);
159 if (fwrite(& major, 1, sizeof(major), fp) != sizeof(major))
160 goto done1;
161
162 minor = htonl(minor);
163 if (fwrite(& minor, 1, sizeof(minor), fp) != sizeof(minor))
164 goto done1;
165
166 if (write_array(fp, array)) {
167 make_number(1.0, result);
168 fclose(fp);
169 return result;
170 }
171
172 done1:
173 update_ERRNO_int(errno);
174 if (fp != NULL) {
175 fclose(fp);
176 unlink(filename.str_value.str);
177 }
178 return result;
179 }
180
181 /* do_writea --- write an array */
182
183 static awk_value_t *
184 do_writea(int nargs, awk_value_t *result, struct awk_ext_func *unused)
185 {
186 awk_value_t array;
187
188 if (! get_argument(1, AWK_ARRAY, & array)) {
189 warning(ext_id, _("writea: second argument is not an array"));
190 errno = EINVAL;
191 update_ERRNO_int(errno);
192 make_number(0.0, result);
193 return result;
194 }
195 return write_backend(result, array.array_cookie, "writea");
196 }
197
198 /* do_writeall --- write out SYMTAB */
199
200 static awk_value_t *
201 do_writeall(int nargs, awk_value_t *result, struct awk_ext_func *unused)
202 {
203 awk_value_t array;
204
205 if (! sym_lookup("SYMTAB", AWK_ARRAY, & array)) {
206 warning(ext_id, _("writeall: unable to find SYMTAB array"));
207 errno = EINVAL;
208 update_ERRNO_int(errno);
209 make_number(0.0, result);
210 return result;
211 }
212 return write_backend(result, array.array_cookie, "writeall");
213 }
214
215
216 /* write_array --- write out an array or a sub-array */
217
218 static awk_bool_t
219 write_array(FILE *fp, awk_array_t array)
220 {
221 uint32_t i;
222 uint32_t count;
223 awk_flat_array_t *flat_array;
224
225 if (! flatten_array(array, & flat_array)) {
226 warning(ext_id, _("write_array: could not flatten array"));
227 return awk_false;
228 }
229
230 count = htonl(flat_array->count);
231 if (fwrite(& count, 1, sizeof(count), fp) != sizeof(count))
232 return awk_false;
233
234 for (i = 0; i < flat_array->count; i++) {
235 if (! write_elem(fp, & flat_array->elements[i])) {
236 (void) release_flattened_array(array, flat_array);
237 return awk_false;
238 }
239 }
240
241 if (! release_flattened_array(array, flat_array)) {
242 warning(ext_id, _("write_array: could not release flattened array"));
243 return awk_false;
244 }
245
246 return awk_true;
247 }
248
249 /* write_elem --- write out a single element */
250
251 static awk_bool_t
252 write_elem(FILE *fp, awk_element_t *element)
253 {
254 uint32_t indexval_len;
255 ssize_t write_count;
256
257 indexval_len = htonl(element->index.str_value.len);
258 if (fwrite(& indexval_len, 1, sizeof(indexval_len), fp) != sizeof(indexval_len))
259 return awk_false;
260
261 if (element->index.str_value.len > 0) {
262 write_count = fwrite(element->index.str_value.str,
263 1, element->index.str_value.len, fp);
264 if (write_count != (ssize_t) element->index.str_value.len)
265 return awk_false;
266 }
267
268 return write_value(fp, & element->value);
269 }
270
271 /* write_value --- write a number or a string or a strnum or a regex or an array */
272
273 static awk_bool_t
274 write_value(FILE *fp, awk_value_t *val)
275 {
276 uint32_t code, len;
277
278 if (val->val_type == AWK_ARRAY) {
279 code = htonl(VT_ARRAY);
280 if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
281 return awk_false;
282 return write_array(fp, val->array_cookie);
283 }
284
285 if (val->val_type == AWK_NUMBER)
286 return write_number(fp, val);
287
288 switch (val->val_type) {
289 case AWK_STRING:
290 code = htonl(VT_STRING);
291 break;
292 case AWK_STRNUM:
293 code = htonl(VT_STRNUM);
294 break;
295 case AWK_REGEX:
296 code = htonl(VT_REGEX);
297 break;
298 case AWK_BOOL:
299 code = htonl(VT_BOOL);
300 break;
301 case AWK_UNDEFINED:
302 code = htonl(VT_UNDEFINED);
303 break;
304 default:
305 /* XXX can this happen? */
306 code = htonl(VT_UNDEFINED);
307 warning(ext_id, _("array value has unknown type %d"), val->val_type);
308 break;
309 }
310
311 if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
312 return awk_false;
313
314 if (code == ntohl(VT_BOOL)) {
315 len = (val->bool_value == awk_true ? 4 : 5);
316 len = htonl(len);
317 const char *s = (val->bool_value == awk_true ? "TRUE" : "FALSE");
318
319 if (fwrite(& len, 1, sizeof(len), fp) != sizeof(len))
320 return awk_false;
321
322 if (fwrite(s, 1, strlen(s), fp) != (ssize_t) strlen(s))
323 return awk_false;
324 } else {
325 len = htonl(val->str_value.len);
326 if (fwrite(& len, 1, sizeof(len), fp) != sizeof(len))
327 return awk_false;
328
329 if (fwrite(val->str_value.str, 1, val->str_value.len, fp)
330 != (ssize_t) val->str_value.len)
331 return awk_false;
332 }
333 return awk_true;
334 }
335
336 /* write_number --- write a double, GMP or MPFR number */
337
338 static awk_bool_t
339 write_number(FILE *fp, awk_value_t *val)
340 {
341 uint32_t len, code;
342 char buffer[BUFSIZ];
343
344 if (val->num_type == AWK_NUMBER_TYPE_DOUBLE) {
345 uint32_t network_order_len;
346
347 code = htonl(VT_NUMBER);
348 if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
349 return awk_false;
350
351 // for portability, save double precision number as a string
352 sprintf(buffer, "%.17g", val->num_value);
353 len = strlen(buffer) + 1; // get trailing '\0' too...
354 network_order_len = htonl(len);
355
356 if (fwrite(& network_order_len, 1, sizeof(len), fp) != sizeof(len))
357 return awk_false;
358
359 if (fwrite(buffer, 1, len, fp) != len)
360 return awk_false;
361 } else {
362 #ifdef HAVE_MPFR
363 if (val->num_type == AWK_NUMBER_TYPE_MPFR) {
364 code = htonl(VT_MPFR);
365 if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
366 return awk_false;
367
368 #ifdef USE_MPFR_FPIF
369 /*
370 * This would be preferable, but it is not available
371 * on older platforms with mpfr 3.x. It's also marked
372 * experimental in mpfr 4.1, so perhaps not ready for
373 * production use yet.
374 */
375 if (mpfr_fpif_export(fp, val->num_ptr) != 0)
376 #else
377 #define MPFR_STR_BASE 62 /* maximize base to minimize string len */
378 #define MPFR_STR_ROUND mpfr_get_default_rounding_mode()
379 /*
380 * Does the choice of rounding mode matter, given
381 * that the precision is 0, so we should be rendering
382 * in full precision?
383 */
384 // We need to write a terminating space, since
385 // mpfr_inp_str reads until it hits a space or EOF
386 if ((mpfr_out_str(fp, MPFR_STR_BASE, 0, val->num_ptr, MPFR_STR_ROUND) == 0) || (putc(' ', fp) == EOF))
387 #endif
388 return awk_false;
389 } else {
390 code = htonl(VT_GMP);
391 if (fwrite(& code, 1, sizeof(code), fp) != sizeof(code))
392 return awk_false;
393
394 if (mpz_out_raw(fp, val->num_ptr) == 0)
395 return awk_false;
396 }
397 #else
398 fatal(ext_id, _("rwarray extension: received GMP/MPFR value but compiled without GMP/MPFR support."));
399 #endif
400 }
401 // all the OK cases fall through to here
402 return awk_true;
403 }
404
405 /* free_value --- release memory for ignored global variables */
406
407 static void
408 free_value(awk_value_t *v)
409 {
410 switch (v->val_type) {
411 case AWK_ARRAY:
412 destroy_array(v->array_cookie);
413 break;
414 case AWK_STRING:
415 case AWK_REGEX:
416 case AWK_STRNUM:
417 case AWK_UNDEFINED:
418 gawk_free(v->str_value.str);
419 break;
420 case AWK_BOOL:
421 /* no memory allocated */
422 break;
423 case AWK_NUMBER:
424 switch (v->num_type) {
425 case AWK_NUMBER_TYPE_DOUBLE:
426 /* no memory allocated */
427 break;
428 #ifdef HAVE_MPFR
429 case AWK_NUMBER_TYPE_MPZ:
430 mpz_clear(v->num_ptr);
431 break;
432 case AWK_NUMBER_TYPE_MPFR:
433 mpfr_clear(v->num_ptr);
434 break;
435 #endif /* HAVE_MPFR */
436 default:
437 warning(ext_id, _("cannot free number with unknown type %d"), v->num_type);
438 break;
439 }
440 break;
441 default:
442 warning(ext_id, _("cannot free value with unhandled type %d"), v->val_type);
443 break;
444 }
445 }
446
447 /* do_poke --- create a global variable */
448
449 static awk_bool_t
450 do_poke(awk_element_t *e)
451 {
452 awk_value_t t;
453
454 if (e->index.val_type != AWK_STRING)
455 return awk_false;
456 /*
457 * So this is a bit tricky. If the program refers to the variable,
458 * then it will already exist in an undefined state after parsing.
459 * If the program never refers to it, then the lookup fails.
460 * We still need to create it in case the program accesses it via
461 * indirection through the SYMTAB table.
462 */
463 // it's even trickier, we need to handle foo::bar as well
464 char *p = strstr(e->index.str_value.str, "::");
465 char *ns, *ident;
466 if (p != NULL) {
467 ns = e->index.str_value.str;
468 ident = p + 2;
469 *p = '\0';
470 } else {
471 ns = "";
472 ident = e->index.str_value.str;
473 }
474
475 if (sym_lookup_ns(ns, ident, AWK_UNDEFINED, & t)
476 && (t.val_type != AWK_UNDEFINED))
477 return awk_false;
478
479 if (! sym_update_ns(ns, ident, & e->value)) {
480 if (ns[0])
481 warning(ext_id, _("readall: unable to set %s::%s"), ns, ident);
482 else
483 warning(ext_id, _("readall: unable to set %s"), ident);
484 return awk_false;
485 }
486 return awk_true;
487 }
488
489 /* read_global --- read top-level variables dumped from SYMTAB */
490
491 static awk_bool_t
492 read_global(FILE *fp, awk_array_t unused)
493 {
494 uint32_t i;
495 uint32_t count;
496 awk_element_t new_elem;
497 value_storage vs;
498
499 if (fread(& count, 1, sizeof(count), fp) != sizeof(count))
500 return awk_false;
501
502 count = ntohl(count);
503
504 for (i = 0; i < count; i++) {
505 if (read_elem(fp, & new_elem, &vs)) {
506 if (! do_poke(& new_elem))
507 free_value(& new_elem.value);
508 if (new_elem.index.str_value.len)
509 /* free string allocated by make_const_string */
510 gawk_free(new_elem.index.str_value.str);
511 } else
512 return awk_false;
513 }
514
515 return awk_true;
516 }
517
518 /* read_one --- read one array */
519
520 static awk_bool_t
521 read_one(FILE *fp, awk_array_t array)
522 {
523 if (! clear_array(array)) {
524 errno = ENOMEM;
525 warning(ext_id, _("reada: clear_array failed"));
526 return awk_false;
527 }
528
529 return read_array(fp, array);
530 }
531
532 /* read_backend --- common code for reada and readall */
533
534 static awk_value_t *
535 read_backend(awk_value_t *result, awk_array_t array, const char *name, awk_bool_t (*func)(FILE *, awk_array_t))
536 {
537 awk_value_t filename;
538 FILE *fp = NULL;
539 uint32_t major;
540 uint32_t minor;
541 char magic_buf[30];
542
543 assert(result != NULL);
544 make_number(0.0, result);
545
546 /* filename is first arg */
547 if (! get_argument(0, AWK_STRING, & filename)) {
548 warning(ext_id, _("%s: first argument is not a string"), name);
549 errno = EINVAL;
550 goto done1;
551 }
552
553 fp = fopen(filename.str_value.str, "rb");
554 if (fp == NULL)
555 goto done1;
556
557 memset(magic_buf, '\0', sizeof(magic_buf));
558 if (fread(magic_buf, 1, strlen(MAGIC), fp) != strlen(MAGIC)) {
559 errno = EBADF;
560 goto done1;
561 }
562
563 if (strcmp(magic_buf, MAGIC) != 0) {
564 errno = EBADF;
565 goto done1;
566 }
567
568 if (fread(& major, 1, sizeof(major), fp) != sizeof(major)) {
569 errno = EBADF;
570 goto done1;
571 }
572 major = ntohl(major);
573
574 if (major != MAJOR) {
575 errno = EBADF;
576 goto done1;
577 }
578
579 if (fread(& minor, 1, sizeof(minor), fp) != sizeof(minor)) {
580 /* read() sets errno */
581 goto done1;
582 }
583
584 minor = ntohl(minor);
585 if (minor != MINOR) {
586 errno = EBADF;
587 goto done1;
588 }
589
590 if ((*func)(fp, array)) {
591 make_number(1.0, result);
592 goto done0;
593 }
594
595 done1:
596 update_ERRNO_int(errno);
597 done0:
598 if (fp != NULL)
599 fclose(fp);
600 return result;
601 }
602
603 /* do_reada --- read an array */
604
605 static awk_value_t *
606 do_reada(int nargs, awk_value_t *result, struct awk_ext_func *unused)
607 {
608 awk_value_t array;
609
610 if (! get_argument(1, AWK_ARRAY, & array)) {
611 warning(ext_id, _("reada: second argument is not an array"));
612 errno = EINVAL;
613 update_ERRNO_int(errno);
614 make_number(0.0, result);
615 return result;
616 }
617 return read_backend(result, array.array_cookie, "read", read_one);
618 }
619
620 /* do_readall --- read top-level variables */
621
622 static awk_value_t *
623 do_readall(int nargs, awk_value_t *result, struct awk_ext_func *unused)
624 {
625 return read_backend(result, NULL, "readall", read_global);
626 }
627
628
629 /* read_array --- read in an array or sub-array */
630
631 static awk_bool_t
632 read_array(FILE *fp, awk_array_t array)
633 {
634 uint32_t i;
635 uint32_t count;
636 awk_element_t new_elem;
637 value_storage vs;
638
639 if (fread(& count, 1, sizeof(count), fp) != sizeof(count))
640 return awk_false;
641
642 count = ntohl(count);
643
644 for (i = 0; i < count; i++) {
645 if (read_elem(fp, & new_elem, &vs)) {
646 /* add to array */
647 if (! set_array_element_by_elem(array, & new_elem)) {
648 warning(ext_id, _("read_array: set_array_element failed"));
649 return awk_false;
650 }
651 } else
652 break;
653 }
654
655 if (i != count)
656 return awk_false;
657
658 return awk_true;
659 }
660
661 /* read_elem --- read in a single element */
662
663 static awk_bool_t
664 read_elem(FILE *fp, awk_element_t *element, value_storage *vs)
665 {
666 uint32_t index_len;
667 static char *buffer;
668 static uint32_t buflen;
669 ssize_t ret;
670
671 if ((ret = fread(& index_len, 1, sizeof(index_len), fp)) != sizeof(index_len)) {
672 return awk_false;
673 }
674 index_len = ntohl(index_len);
675
676 memset(element, 0, sizeof(*element));
677
678 if (index_len > 0) {
679 if (buffer == NULL) {
680 /* allocate buffer */
681 emalloc(buffer, char *, index_len, "read_elem");
682 buflen = index_len;
683 } else if (buflen < index_len) {
684 /* reallocate buffer */
685 char *cp = gawk_realloc(buffer, index_len);
686
687 if (cp == NULL)
688 return awk_false;
689
690 buffer = cp;
691 buflen = index_len;
692 }
693
694 if (fread(buffer, 1, index_len, fp) != (ssize_t) index_len) {
695 return awk_false;
696 }
697 make_const_string(buffer, index_len, & element->index);
698 } else {
699 make_null_string(& element->index);
700 }
701
702 if (! read_value(fp, & element->value, & element->index, vs))
703 return awk_false;
704
705 return awk_true;
706 }
707
708 /* read_value --- read a number or a string */
709
710 static awk_bool_t
711 read_value(FILE *fp, awk_value_t *value, awk_value_t *idx, value_storage *vs)
712 {
713 uint32_t code, len;
714
715 if (fread(& code, 1, sizeof(code), fp) != sizeof(code))
716 return awk_false;
717
718 code = ntohl(code);
719
720 if (code == VT_ARRAY) {
721 awk_array_t array = create_array();
722
723 if (! read_array(fp, array))
724 return awk_false;
725
726 /* hook into value */
727 value->val_type = AWK_ARRAY;
728 value->array_cookie = array;
729 } else if (code == VT_NUMBER
730 || code == VT_GMP
731 || code == VT_MPFR) {
732 return read_number(fp, value, code, vs);
733 } else {
734 if (fread(& len, 1, sizeof(len), fp) != sizeof(len)) {
735 return awk_false;
736 }
737 len = ntohl(len);
738 switch (code) {
739 case VT_STRING:
740 value->val_type = AWK_STRING;
741 break;
742 case VT_REGEX:
743 value->val_type = AWK_REGEX;
744 break;
745 case VT_STRNUM:
746 value->val_type = AWK_STRNUM;
747 break;
748 case VT_UNDEFINED:
749 value->val_type = AWK_UNDEFINED;
750 break;
751 case VT_BOOL:
752 value->val_type = AWK_BOOL;
753 break;
754 default:
755 /* this cannot happen! */
756 warning(ext_id, _("treating recovered value with unknown type code %d as a string"), code);
757 value->val_type = AWK_STRING;
758 break;
759 }
760 value->str_value.len = len;
761 value->str_value.str = gawk_malloc(len + 1);
762
763 if (fread(value->str_value.str, 1, len, fp) != (ssize_t) len) {
764 gawk_free(value->str_value.str);
765 return awk_false;
766 }
767 value->str_value.str[len] = '\0';
768 value->str_value.len = len;
769
770 if (code == VT_BOOL) {
771 bool val = (strcmp(value->str_value.str, "TRUE") == 0);
772
773 gawk_free(value->str_value.str);
774 value->str_value.str = NULL;
775 value->bool_value = val ? awk_true : awk_false;
776 }
777 }
778
779 return awk_true;
780 }
781
782 /* read_number --- read a double, GMP, or MPFR number */
783
784 static awk_bool_t
785 read_number(FILE *fp, awk_value_t *value, uint32_t code, value_storage *vs)
786 {
787 uint32_t len;
788
789 if (code == VT_NUMBER) {
790 char buffer[BUFSIZ];
791 double d;
792
793 if (fread(& len, 1, sizeof(len), fp) != sizeof(len))
794 return awk_false;
795
796 len = ntohl(len);
797 if (fread(buffer, 1, len, fp) != len)
798 return awk_false;
799
800 (void) sscanf(buffer, "%lg", & d);
801
802 /* hook into value */
803 value = make_number(d, value);
804 } else {
805 #ifdef HAVE_MPFR
806 if (code == VT_GMP) {
807 mpz_init(vs->mpz_val);
808 if (mpz_inp_raw(vs->mpz_val, fp) == 0)
809 return awk_false;
810
811 value = make_number_mpz(vs->mpz_val, value);
812 } else {
813 mpfr_init(vs->mpfr_val);
814 #ifdef USE_MPFR_FPIF
815 /* preferable if widely available and stable */
816 if (mpfr_fpif_import(vs->mpfr_val, fp) != 0)
817 #else
818 // N.B. need to consume the terminating space we wrote
819 // after mpfr_out_str
820 if ((mpfr_inp_str(vs->mpfr_val, fp, MPFR_STR_BASE, MPFR_STR_ROUND) == 0) || (getc(fp) != ' '))
821 #endif
822 return awk_false;
823
824 value = make_number_mpfr(vs->mpfr_val, value);
825 }
826 #else
827 fatal(ext_id, _("rwarray extension: GMP/MPFR value in file but compiled without GMP/MPFR support."));
828 #endif
829 }
830
831 return awk_true;
832 }
833
834 static awk_ext_func_t func_table[] = {
835 { "writea", do_writea, 2, 2, awk_false, NULL },
836 { "reada", do_reada, 2, 2, awk_false, NULL },
837 { "writeall", do_writeall, 1, 1, awk_false, NULL },
838 { "readall", do_readall, 1, 1, awk_false, NULL },
839 };
840
841
842 /* define the dl_load function using the boilerplate macro */
843
844 dl_load_func(func_table, rwarray, "")