aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--README_d/README.mpfr10
-rw-r--r--array.c74
-rw-r--r--awk.h65
-rw-r--r--awkgram.c341
-rw-r--r--awkgram.y77
-rw-r--r--builtin.c220
-rw-r--r--command.c13
-rw-r--r--command.y13
-rw-r--r--debug.c6
-rw-r--r--eval.c58
-rw-r--r--field.c7
-rw-r--r--interpret.h12
-rw-r--r--io.c22
-rw-r--r--main.c18
-rw-r--r--mpfr.c1246
-rw-r--r--msg.c11
-rw-r--r--node.c37
-rw-r--r--profile.c4
-rw-r--r--str_array.c2
-rwxr-xr-xtest/Gentests5
-rw-r--r--test/Makefile.am23
-rw-r--r--test/Makefile.in36
-rw-r--r--test/Maketests13
-rw-r--r--test/mpfrbigint.awk11
-rw-r--r--test/mpfrbigint.ok5
-rw-r--r--test/mpfrsort.awk8
-rw-r--r--test/mpfrsort.ok11
-rw-r--r--test/rand-mpfr1.ok1
28 files changed, 1552 insertions, 797 deletions
diff --git a/README_d/README.mpfr b/README_d/README.mpfr
new file mode 100644
index 00000000..9d815a43
--- /dev/null
+++ b/README_d/README.mpfr
@@ -0,0 +1,10 @@
+Sat Mar 17 07:32:01 CDT 2012
+=============================
+
+The MPFR and GMP versions known to work for Mac OS X on PPC:
+GNU MPFR 3.1.0, GNU MP 4.3.1
+
+Gawk has been compiled and tested using the following combinations
+of MPFR and GMP versions on GNU/Linux:
+GNU MPFR 2.4.2, GNU MP 4.3.2
+GNU MPFR 3.1.0, GNU MP 5.0.3
diff --git a/array.c b/array.c
index 9d2f56fc..384d1476 100644
--- a/array.c
+++ b/array.c
@@ -678,9 +678,11 @@ value_info(NODE *n)
fprintf(output_fp, "\"%.*s\"", PREC_STR, n->stptr);
if ((n->flags & (NUMBER|NUMCUR)) != 0) {
#ifdef HAVE_MPFR
- if (n->flags & MPFN)
- fprintf(output_fp, "%s",
- mpg_fmt("<%.*R*g>", PREC_NUM, RND_MODE, n->mpg_numbr));
+ if (is_mpg_float(n))
+ fprintf(output_fp, ":%s",
+ mpg_fmt("%.*R*g", PREC_NUM, RND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ fprintf(output_fp, ":%s", mpg_fmt("%Zd", n->mpg_i));
else
#endif
fprintf(output_fp, ":%.*g", PREC_NUM, n->numbr);
@@ -688,9 +690,11 @@ value_info(NODE *n)
fprintf(output_fp, ">");
} else {
#ifdef HAVE_MPFR
- if (n->flags & MPFN)
- fprintf(output_fp, "%s",
- mpg_fmt("<%.*R*g>", PREC_NUM, RND_MODE, n->mpg_numbr));
+ if (is_mpg_float(n))
+ fprintf(output_fp, "<%s>",
+ mpg_fmt("%.*R*g", PREC_NUM, RND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ fprintf(output_fp, "<%s>", mpg_fmt("%Zd", n->mpg_i));
else
#endif
fprintf(output_fp, "<%.*g>", PREC_NUM, n->numbr);
@@ -733,7 +737,7 @@ assoc_info(NODE *subs, NODE *val, NODE *ndump, const char *aname)
indent_level++;
indent(indent_level);
fprintf(output_fp, "I: [%s:", aname);
- if ((subs->flags & (MPFN|INTIND)) == INTIND)
+ if ((subs->flags & (MPFN|MPZN|INTIND)) == INTIND)
fprintf(output_fp, "<%ld>", (long) subs->numbr);
else
value_info(subs);
@@ -940,13 +944,13 @@ do_asorti(int nargs)
/*
- * cmp_string --- compare two strings; logic similar to cmp_nodes() in eval.c
+ * cmp_strings --- compare two strings; logic similar to cmp_nodes() in eval.c
* except the extra case-sensitive comparison when the case-insensitive
* result is a match.
*/
static int
-cmp_string(const NODE *n1, const NODE *n2)
+cmp_strings(const NODE *n1, const NODE *n2)
{
char *s1, *s2;
size_t len1, len2;
@@ -992,33 +996,6 @@ cmp_string(const NODE *n1, const NODE *n2)
return (len1 < len2) ? -1 : 1;
}
-/* cmp_number --- compare two numbers */
-
-static inline int
-cmp_number(const NODE *n1, const NODE *n2)
-{
-#ifdef HAVE_MPFR
- if (n1->flags & MPFN) {
- assert((n2->flags & MPFN) != 0);
-
- /*
- * N.B.: For non-MPFN, gawk returns 1 if either t1 or t2 is NaN.
- * The results of == and < comparisons below are false with NaN(s).
- */
-
- if (mpfr_nan_p(n1->mpg_numbr) || mpfr_nan_p(n2->mpg_numbr))
- return 1;
- return mpfr_cmp(n1->mpg_numbr, n2->mpg_numbr);
- }
-#endif
- if (n1->numbr == n2->numbr)
- return 0;
- else if (n1->numbr < n2->numbr)
- return -1;
- else
- return 1;
-}
-
/* sort_up_index_string --- qsort comparison function; ascending index strings. */
static int
@@ -1029,7 +1006,7 @@ sort_up_index_string(const void *p1, const void *p2)
/* Array indices are strings */
t1 = *((const NODE *const *) p1);
t2 = *((const NODE *const *) p2);
- return cmp_string(t1, t2);
+ return cmp_strings(t1, t2);
}
@@ -1062,14 +1039,14 @@ sort_up_index_number(const void *p1, const void *p2)
t1 = *((const NODE *const *) p1);
t2 = *((const NODE *const *) p2);
- ret = cmp_number(t1, t2);
+ ret = cmp_numbers(t1, t2);
if (ret != 0)
return ret;
/* break a tie with the index string itself */
t1 = force_string((NODE *) t1);
t2 = force_string((NODE *) t2);
- return cmp_string(t1, t2);
+ return cmp_strings(t1, t2);
}
/* sort_down_index_number --- qsort comparison function; descending index numbers */
@@ -1099,7 +1076,7 @@ sort_up_value_string(const void *p1, const void *p2)
return -1; /* t1 (scalar) < t2 (sub-array) */
/* t1 and t2 both have string values */
- return cmp_string(t1, t2);
+ return cmp_strings(t1, t2);
}
@@ -1130,7 +1107,7 @@ sort_up_value_number(const void *p1, const void *p2)
if (t2->type == Node_var_array)
return -1; /* t1 (scalar) < t2 (sub-array) */
- ret = cmp_number(t1, t2);
+ ret = cmp_numbers(t1, t2);
if (ret != 0)
return ret;
@@ -1140,7 +1117,7 @@ sort_up_value_number(const void *p1, const void *p2)
*/
t1 = force_string(t1);
t2 = force_string(t2);
- return cmp_string(t1, t2);
+ return cmp_strings(t1, t2);
}
@@ -1187,7 +1164,7 @@ sort_up_value_type(const void *p1, const void *p2)
(void) force_string(n2);
if ((n1->flags & NUMBER) != 0 && (n2->flags & NUMBER) != 0) {
- return cmp_number(n1, n2);
+ return cmp_numbers(n1, n2);
}
/* 3. All numbers are less than all strings. This is aribitrary. */
@@ -1198,7 +1175,7 @@ sort_up_value_type(const void *p1, const void *p2)
}
/* 4. Two strings */
- return cmp_string(n1, n2);
+ return cmp_strings(n1, n2);
}
/* sort_down_value_type --- qsort comparison function; descending value type */
@@ -1244,9 +1221,14 @@ sort_user_func(const void *p1, const void *p2)
/* return value of the comparison function */
r = POP_NUMBER();
#ifdef HAVE_MPFR
- /* mpfr_sgn: Return a positive value if op > 0, zero if op = 0, and a negative value if op < 0. */
- if (r->flags & MPFN)
+ /*
+ * mpfr_sgn(mpz_sgn): Returns a positive value if op > 0,
+ * zero if op = 0, and a negative value if op < 0.
+ */
+ if (is_mpg_float(r))
ret = mpfr_sgn(r->mpg_numbr);
+ else if (is_mpg_integer(r))
+ ret = mpz_sgn(r->mpg_i);
else
#endif
ret = (r->numbr < 0.0) ? -1 : (r->numbr > 0.0);
diff --git a/awk.h b/awk.h
index fe9eab45..bf49fb62 100644
--- a/awk.h
+++ b/awk.h
@@ -381,14 +381,17 @@ typedef struct exp_node {
} nodep;
struct {
- union {
- AWKNUM fltnum; /* this is here for optimal packing of
- * the structure on many machines
- */
#ifdef HAVE_MPFR
+ union {
+ AWKNUM fltnum;
mpfr_t mpnum;
-#endif
+ mpz_t mpi;
} nm;
+#else
+ AWKNUM fltnum; /* this is here for optimal packing of
+ * the structure on many machines
+ */
+#endif
char *sp;
size_t slen;
long sref;
@@ -419,13 +422,14 @@ typedef struct exp_node {
* lazy conversion to string.
*/
# define WSTRCUR 0x0400 /* wide str value is current */
-# define MPFN 0x0800 /* multiple precision floating-point number */
+# define MPFN 0x0800 /* arbitrary-precision floating-point number */
+# define MPZN 0x1000 /* arbitrary-precision integer */
/* type = Node_var_array */
-# define ARRAYMAXED 0x1000 /* array is at max size */
-# define HALFHAT 0x2000 /* half-capacity Hashed Array Tree;
+# define ARRAYMAXED 0x2000 /* array is at max size */
+# define HALFHAT 0x4000 /* half-capacity Hashed Array Tree;
* See cint_array.c */
-# define XARRAY 0x4000
+# define XARRAY 0x8000
} NODE;
#define vname sub.nodep.name
@@ -464,9 +468,12 @@ typedef struct exp_node {
#define stfmt sub.val.idx
#define wstptr sub.val.wsp
#define wstlen sub.val.wslen
-#define numbr sub.val.nm.fltnum
#ifdef HAVE_MPFR
#define mpg_numbr sub.val.nm.mpnum
+#define mpg_i sub.val.nm.mpi
+#define numbr sub.val.nm.fltnum
+#else
+#define numbr sub.val.fltnum
#endif
/* Node_arrayfor */
@@ -1021,6 +1028,7 @@ extern int (*interpret)(INSTRUCTION *); /* interpreter routine */
extern NODE *(*make_number)(double); /* double instead of AWKNUM on purpose */
extern NODE *(*str2number)(NODE *);
extern NODE *(*format_val)(const char *, int, NODE *);
+extern int (*cmp_numbers)(const NODE *, const NODE *);
typedef int (*Func_pre_exec)(INSTRUCTION **);
typedef void (*Func_post_exec)(INSTRUCTION *);
@@ -1108,8 +1116,8 @@ extern struct lconv loc;
#ifdef HAVE_MPFR
extern mpfr_prec_t PRECISION;
extern mpfr_rnd_t RND_MODE;
-extern mpfr_t MNR;
-extern mpfr_t MFNR;
+extern mpz_t MNR;
+extern mpz_t MFNR;
extern mpz_t mpzval;
extern int do_ieee_fmt; /* emulate IEEE 754 floating-point format */
#endif
@@ -1205,24 +1213,39 @@ extern STACK_ITEM *stack_top;
#ifdef HAVE_MPFR
/* conversion to C types */
#define get_number_ui(n) (((n)->flags & MPFN) ? mpfr_get_ui((n)->mpg_numbr, RND_MODE) \
+ : ((n)->flags & MPZN) ? mpz_get_ui((n)->mpg_i) \
: (unsigned long) (n)->numbr)
#define get_number_si(n) (((n)->flags & MPFN) ? mpfr_get_si((n)->mpg_numbr, RND_MODE) \
+ : ((n)->flags & MPZN) ? mpz_get_si((n)->mpg_i) \
: (long) (n)->numbr)
#define get_number_d(n) (((n)->flags & MPFN) ? mpfr_get_d((n)->mpg_numbr, RND_MODE) \
+ : ((n)->flags & MPZN) ? mpz_get_d((n)->mpg_i) \
: (double) (n)->numbr)
#define get_number_uj(n) (((n)->flags & MPFN) ? mpfr_get_uj((n)->mpg_numbr, RND_MODE) \
+ : ((n)->flags & MPZN) ? (uintmax_t) mpz_get_d((n)->mpg_i) \
: (uintmax_t) (n)->numbr)
-#define is_nonzero_num(n) (((n)->flags & MPFN) ? (! mpfr_zero_p((n)->mpg_numbr)) \
- : ((n)->numbr != 0.0))
+#define iszero(n) (((n)->flags & MPFN) ? mpfr_zero_p((n)->mpg_numbr) \
+ : ((n)->flags & MPZN) ? (mpz_sgn((n)->mpg_i) == 0) \
+ : ((n)->numbr == 0.0))
+
#define IEEE_FMT(r, t) do_ieee_fmt && format_ieee(r, t)
+
+#define mpg_float() mpg_node(MPFN)
+#define mpg_integer() mpg_node(MPZN)
+#define is_mpg_float(n) (((n)->flags & MPFN) != 0)
+#define is_mpg_integer(n) (((n)->flags & MPZN) != 0)
+#define is_mpg_number(n) (((n)->flags & (MPZN|MPFN)) != 0)
#else
#define get_number_ui(n) (unsigned long) (n)->numbr
#define get_number_si(n) (long) (n)->numbr
#define get_number_d(n) (double) (n)->numbr
#define get_number_uj(n) (uintmax_t) (n)->numbr
-#define is_nonzero_num(n) ((n)->numbr != 0.0)
+#define is_mpg_number(n) 0
+#define is_mpg_float(n) 0
+#define is_mpg_integer(n) 0
+#define iszero(n) ((n)->numbr == 0.0)
#endif
#define is_identchar(c) (isalnum(c) || (c) == '_')
@@ -1423,7 +1446,8 @@ extern int strncasecmpmbs(const unsigned char *,
extern void PUSH_CODE(INSTRUCTION *cp);
extern INSTRUCTION *POP_CODE(void);
extern void init_interpret(void);
-extern int cmp_nodes(NODE *p1, NODE *p2);
+extern int cmp_nodes(NODE *t1, NODE *t2);
+extern int cmp_awknums(const NODE *t1, const NODE *t2);
extern void set_IGNORECASE(void);
extern void set_OFS(void);
extern void set_ORS(void);
@@ -1524,8 +1548,9 @@ extern long getenv_long(const char *name);
extern void set_PREC(void);
extern void set_RNDMODE(void);
#ifdef HAVE_MPFR
+extern int mpg_cmp(const NODE *t1, const NODE *t2);
extern int format_ieee(mpfr_ptr, int);
-extern void mpg_update_var(NODE *);
+extern NODE *mpg_update_var(NODE *);
extern long mpg_set_var(NODE *);
extern NODE *do_mpfr_and(int);
extern NODE *do_mpfr_atan2(int);
@@ -1544,8 +1569,9 @@ extern NODE *do_mpfr_srand(int);
extern NODE *do_mpfr_strtonum(int);
extern NODE *do_mpfr_xor(int);
extern void init_mpfr(const char *);
-extern NODE *mpg_node();
-const char *mpg_fmt(const char *mesg, ...);
+extern NODE *mpg_node(unsigned int);
+extern const char *mpg_fmt(const char *mesg, ...);
+extern int mpg_strtoui(mpz_ptr zi, char *str, size_t len, char **end, int base);
#endif
/* msg.c */
extern void gawk_exit(int status);
@@ -1575,7 +1601,6 @@ extern void pp_string_fp(Func_print print_func, FILE *fp, const char *str,
extern NODE *r_force_number(NODE *n);
extern NODE *r_format_val(const char *format, int index, NODE *s);
extern NODE *r_dupnode(NODE *n);
-extern NODE *r_make_number(AWKNUM x);
extern NODE *r_make_str_node(const char *s, size_t len, int flags);
extern void *more_blocks(int id);
extern void r_unref(NODE *tmp);
diff --git a/awkgram.c b/awkgram.c
index 30b43ce5..df5d6b18 100644
--- a/awkgram.c
+++ b/awkgram.c
@@ -708,20 +708,20 @@ static const yytype_uint16 yyrline[] =
318, 327, 337, 339, 341, 347, 352, 353, 357, 376,
375, 409, 411, 416, 417, 430, 435, 436, 440, 442,
444, 451, 541, 583, 625, 738, 745, 752, 762, 771,
- 780, 789, 804, 820, 819, 843, 855, 855, 950, 950,
- 975, 998, 1004, 1005, 1011, 1012, 1019, 1024, 1036, 1050,
- 1052, 1060, 1065, 1067, 1075, 1077, 1086, 1087, 1095, 1100,
- 1100, 1111, 1115, 1123, 1124, 1127, 1129, 1134, 1135, 1144,
- 1145, 1150, 1155, 1161, 1163, 1165, 1172, 1173, 1179, 1180,
- 1185, 1187, 1192, 1194, 1196, 1198, 1204, 1211, 1213, 1215,
- 1231, 1241, 1248, 1250, 1255, 1257, 1259, 1267, 1269, 1274,
- 1276, 1281, 1283, 1285, 1335, 1337, 1339, 1341, 1343, 1345,
- 1347, 1349, 1372, 1377, 1382, 1407, 1413, 1415, 1417, 1419,
- 1421, 1423, 1428, 1432, 1464, 1466, 1472, 1478, 1491, 1492,
- 1493, 1498, 1503, 1507, 1511, 1528, 1541, 1546, 1582, 1600,
- 1601, 1607, 1608, 1613, 1615, 1622, 1639, 1656, 1658, 1665,
- 1670, 1678, 1688, 1700, 1709, 1713, 1717, 1721, 1725, 1729,
- 1732, 1734, 1738, 1742, 1746
+ 780, 789, 804, 820, 819, 843, 855, 855, 953, 953,
+ 978, 1001, 1007, 1008, 1014, 1015, 1022, 1027, 1039, 1053,
+ 1055, 1063, 1068, 1070, 1078, 1080, 1089, 1090, 1098, 1103,
+ 1103, 1114, 1118, 1126, 1127, 1130, 1132, 1137, 1138, 1147,
+ 1148, 1153, 1158, 1164, 1166, 1168, 1175, 1176, 1182, 1183,
+ 1188, 1190, 1195, 1197, 1199, 1201, 1207, 1214, 1216, 1218,
+ 1234, 1244, 1251, 1253, 1258, 1260, 1262, 1270, 1272, 1277,
+ 1279, 1284, 1286, 1288, 1338, 1340, 1342, 1344, 1346, 1348,
+ 1350, 1352, 1375, 1380, 1385, 1410, 1416, 1418, 1420, 1422,
+ 1424, 1426, 1431, 1435, 1467, 1469, 1475, 1481, 1494, 1495,
+ 1496, 1501, 1506, 1510, 1514, 1531, 1544, 1549, 1585, 1603,
+ 1604, 1610, 1611, 1616, 1618, 1625, 1642, 1659, 1661, 1668,
+ 1673, 1681, 1691, 1703, 1712, 1716, 1720, 1724, 1728, 1732,
+ 1735, 1737, 1741, 1745, 1749
};
#endif
@@ -2651,16 +2651,16 @@ yyreduce:
} else {
INSTRUCTION *tbreak, *tcont;
- /* [ Op_push_array a ]
- * [ Op_arrayfor_init | ib ]
- * ic:[ Op_arrayfor_incr | ib ]
- * [ Op_var_assign if any ]
- *
- * body
- *
- * [Op_jmp | ic ]
- * ib:[Op_arrayfor_final ]
- */
+ /* [ Op_push_array a ]
+ * [ Op_arrayfor_init | ib ]
+ * ic:[ Op_arrayfor_incr | ib ]
+ * [ Op_var_assign if any ]
+ *
+ * body
+ *
+ * [Op_jmp | ic ]
+ * ib:[Op_arrayfor_final ]
+ */
regular_loop:
ip = (yyvsp[(5) - (8)]);
ip->nexti->opcode = Op_push_array;
@@ -2892,9 +2892,7 @@ regular_loop:
|| ((yyvsp[(3) - (4)])->lasti->opcode == Op_field_spec
&& (yyvsp[(3) - (4)])->nexti->nexti->nexti == (yyvsp[(3) - (4)])->lasti
&& (yyvsp[(3) - (4)])->nexti->nexti->opcode == Op_push_i
- && (yyvsp[(3) - (4)])->nexti->nexti->memory->type == Node_val
- && ((yyvsp[(3) - (4)])->nexti->nexti->memory->flags & MPFN) == 0
- && (yyvsp[(3) - (4)])->nexti->nexti->memory->numbr == 0.0)
+ && (yyvsp[(3) - (4)])->nexti->nexti->memory->type == Node_val)
)
) {
static short warned = FALSE;
@@ -2908,11 +2906,16 @@ regular_loop:
*/
if ((yyvsp[(3) - (4)]) != NULL) {
- bcfree((yyvsp[(3) - (4)])->lasti); /* Op_field_spec */
- unref((yyvsp[(3) - (4)])->nexti->nexti->memory); /* Node_val */
+ NODE *n = (yyvsp[(3) - (4)])->nexti->nexti->memory;
+
+ if (! iszero(n))
+ goto regular_print;
+
+ bcfree((yyvsp[(3) - (4)])->lasti); /* Op_field_spec */
+ unref(n); /* Node_val */
bcfree((yyvsp[(3) - (4)])->nexti->nexti); /* Op_push_i */
- bcfree((yyvsp[(3) - (4)])->nexti); /* Op_list */
- bcfree((yyvsp[(3) - (4)])); /* Op_list */
+ bcfree((yyvsp[(3) - (4)])->nexti); /* Op_list */
+ bcfree((yyvsp[(3) - (4)])); /* Op_list */
} else {
if (do_lint && (rule == BEGIN || rule == END) && ! warned) {
warned = TRUE;
@@ -2944,7 +2947,7 @@ regular_loop:
* [$1 | NULL | redir_type | expr_count]
*
*/
-
+regular_print:
if ((yyvsp[(4) - (4)]) == NULL) { /* no redirection */
if ((yyvsp[(3) - (4)]) == NULL) { /* printf without arg */
(yyvsp[(1) - (4)])->expr_count = 0;
@@ -2978,14 +2981,14 @@ regular_loop:
case 58:
/* Line 1821 of yacc.c */
-#line 950 "awkgram.y"
+#line 953 "awkgram.y"
{ sub_counter = 0; }
break;
case 59:
/* Line 1821 of yacc.c */
-#line 951 "awkgram.y"
+#line 954 "awkgram.y"
{
char *arr = (yyvsp[(2) - (4)])->lextok;
@@ -3015,7 +3018,7 @@ regular_loop:
case 60:
/* Line 1821 of yacc.c */
-#line 980 "awkgram.y"
+#line 983 "awkgram.y"
{
static short warned = FALSE;
char *arr = (yyvsp[(3) - (4)])->lextok;
@@ -3039,35 +3042,35 @@ regular_loop:
case 61:
/* Line 1821 of yacc.c */
-#line 999 "awkgram.y"
+#line 1002 "awkgram.y"
{ (yyval) = optimize_assignment((yyvsp[(1) - (1)])); }
break;
case 62:
/* Line 1821 of yacc.c */
-#line 1004 "awkgram.y"
+#line 1007 "awkgram.y"
{ (yyval) = NULL; }
break;
case 63:
/* Line 1821 of yacc.c */
-#line 1006 "awkgram.y"
+#line 1009 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 64:
/* Line 1821 of yacc.c */
-#line 1011 "awkgram.y"
+#line 1014 "awkgram.y"
{ (yyval) = NULL; }
break;
case 65:
/* Line 1821 of yacc.c */
-#line 1013 "awkgram.y"
+#line 1016 "awkgram.y"
{
if ((yyvsp[(1) - (2)]) == NULL)
(yyval) = list_create((yyvsp[(2) - (2)]));
@@ -3079,14 +3082,14 @@ regular_loop:
case 66:
/* Line 1821 of yacc.c */
-#line 1020 "awkgram.y"
+#line 1023 "awkgram.y"
{ (yyval) = NULL; }
break;
case 67:
/* Line 1821 of yacc.c */
-#line 1025 "awkgram.y"
+#line 1028 "awkgram.y"
{
INSTRUCTION *casestmt = (yyvsp[(5) - (5)]);
if ((yyvsp[(5) - (5)]) == NULL)
@@ -3103,7 +3106,7 @@ regular_loop:
case 68:
/* Line 1821 of yacc.c */
-#line 1037 "awkgram.y"
+#line 1040 "awkgram.y"
{
INSTRUCTION *casestmt = (yyvsp[(4) - (4)]);
if ((yyvsp[(4) - (4)]) == NULL)
@@ -3119,14 +3122,14 @@ regular_loop:
case 69:
/* Line 1821 of yacc.c */
-#line 1051 "awkgram.y"
+#line 1054 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 70:
/* Line 1821 of yacc.c */
-#line 1053 "awkgram.y"
+#line 1056 "awkgram.y"
{
NODE *n = (yyvsp[(2) - (2)])->memory;
(void) force_number(n);
@@ -3139,7 +3142,7 @@ regular_loop:
case 71:
/* Line 1821 of yacc.c */
-#line 1061 "awkgram.y"
+#line 1064 "awkgram.y"
{
bcfree((yyvsp[(1) - (2)]));
(yyval) = (yyvsp[(2) - (2)]);
@@ -3149,14 +3152,14 @@ regular_loop:
case 72:
/* Line 1821 of yacc.c */
-#line 1066 "awkgram.y"
+#line 1069 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 73:
/* Line 1821 of yacc.c */
-#line 1068 "awkgram.y"
+#line 1071 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_push_re;
(yyval) = (yyvsp[(1) - (1)]);
@@ -3166,21 +3169,21 @@ regular_loop:
case 74:
/* Line 1821 of yacc.c */
-#line 1076 "awkgram.y"
+#line 1079 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 75:
/* Line 1821 of yacc.c */
-#line 1078 "awkgram.y"
+#line 1081 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 77:
/* Line 1821 of yacc.c */
-#line 1088 "awkgram.y"
+#line 1091 "awkgram.y"
{
(yyval) = (yyvsp[(2) - (3)]);
}
@@ -3189,7 +3192,7 @@ regular_loop:
case 78:
/* Line 1821 of yacc.c */
-#line 1095 "awkgram.y"
+#line 1098 "awkgram.y"
{
in_print = FALSE;
in_parens = 0;
@@ -3200,14 +3203,14 @@ regular_loop:
case 79:
/* Line 1821 of yacc.c */
-#line 1100 "awkgram.y"
+#line 1103 "awkgram.y"
{ in_print = FALSE; in_parens = 0; }
break;
case 80:
/* Line 1821 of yacc.c */
-#line 1101 "awkgram.y"
+#line 1104 "awkgram.y"
{
if ((yyvsp[(1) - (3)])->redir_type == redirect_twoway
&& (yyvsp[(3) - (3)])->lasti->opcode == Op_K_getline_redir
@@ -3220,7 +3223,7 @@ regular_loop:
case 81:
/* Line 1821 of yacc.c */
-#line 1112 "awkgram.y"
+#line 1115 "awkgram.y"
{
(yyval) = mk_condition((yyvsp[(3) - (6)]), (yyvsp[(1) - (6)]), (yyvsp[(6) - (6)]), NULL, NULL);
}
@@ -3229,7 +3232,7 @@ regular_loop:
case 82:
/* Line 1821 of yacc.c */
-#line 1117 "awkgram.y"
+#line 1120 "awkgram.y"
{
(yyval) = mk_condition((yyvsp[(3) - (9)]), (yyvsp[(1) - (9)]), (yyvsp[(6) - (9)]), (yyvsp[(7) - (9)]), (yyvsp[(9) - (9)]));
}
@@ -3238,14 +3241,14 @@ regular_loop:
case 87:
/* Line 1821 of yacc.c */
-#line 1134 "awkgram.y"
+#line 1137 "awkgram.y"
{ (yyval) = NULL; }
break;
case 88:
/* Line 1821 of yacc.c */
-#line 1136 "awkgram.y"
+#line 1139 "awkgram.y"
{
bcfree((yyvsp[(1) - (2)]));
(yyval) = (yyvsp[(2) - (2)]);
@@ -3255,21 +3258,21 @@ regular_loop:
case 89:
/* Line 1821 of yacc.c */
-#line 1144 "awkgram.y"
+#line 1147 "awkgram.y"
{ (yyval) = NULL; }
break;
case 90:
/* Line 1821 of yacc.c */
-#line 1146 "awkgram.y"
+#line 1149 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]) ; }
break;
case 91:
/* Line 1821 of yacc.c */
-#line 1151 "awkgram.y"
+#line 1154 "awkgram.y"
{
(yyvsp[(1) - (1)])->param_count = 0;
(yyval) = list_create((yyvsp[(1) - (1)]));
@@ -3279,7 +3282,7 @@ regular_loop:
case 92:
/* Line 1821 of yacc.c */
-#line 1156 "awkgram.y"
+#line 1159 "awkgram.y"
{
(yyvsp[(3) - (3)])->param_count = (yyvsp[(1) - (3)])->lasti->param_count + 1;
(yyval) = list_append((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]));
@@ -3290,63 +3293,63 @@ regular_loop:
case 93:
/* Line 1821 of yacc.c */
-#line 1162 "awkgram.y"
+#line 1165 "awkgram.y"
{ (yyval) = NULL; }
break;
case 94:
/* Line 1821 of yacc.c */
-#line 1164 "awkgram.y"
+#line 1167 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 95:
/* Line 1821 of yacc.c */
-#line 1166 "awkgram.y"
+#line 1169 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (3)]); }
break;
case 96:
/* Line 1821 of yacc.c */
-#line 1172 "awkgram.y"
+#line 1175 "awkgram.y"
{ (yyval) = NULL; }
break;
case 97:
/* Line 1821 of yacc.c */
-#line 1174 "awkgram.y"
+#line 1177 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 98:
/* Line 1821 of yacc.c */
-#line 1179 "awkgram.y"
+#line 1182 "awkgram.y"
{ (yyval) = NULL; }
break;
case 99:
/* Line 1821 of yacc.c */
-#line 1181 "awkgram.y"
+#line 1184 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 100:
/* Line 1821 of yacc.c */
-#line 1186 "awkgram.y"
+#line 1189 "awkgram.y"
{ (yyval) = mk_expression_list(NULL, (yyvsp[(1) - (1)])); }
break;
case 101:
/* Line 1821 of yacc.c */
-#line 1188 "awkgram.y"
+#line 1191 "awkgram.y"
{
(yyval) = mk_expression_list((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]));
yyerrok;
@@ -3356,35 +3359,35 @@ regular_loop:
case 102:
/* Line 1821 of yacc.c */
-#line 1193 "awkgram.y"
+#line 1196 "awkgram.y"
{ (yyval) = NULL; }
break;
case 103:
/* Line 1821 of yacc.c */
-#line 1195 "awkgram.y"
+#line 1198 "awkgram.y"
{ (yyval) = NULL; }
break;
case 104:
/* Line 1821 of yacc.c */
-#line 1197 "awkgram.y"
+#line 1200 "awkgram.y"
{ (yyval) = NULL; }
break;
case 105:
/* Line 1821 of yacc.c */
-#line 1199 "awkgram.y"
+#line 1202 "awkgram.y"
{ (yyval) = NULL; }
break;
case 106:
/* Line 1821 of yacc.c */
-#line 1205 "awkgram.y"
+#line 1208 "awkgram.y"
{
if (do_lint && (yyvsp[(3) - (3)])->lasti->opcode == Op_match_rec)
lintwarn_ln((yyvsp[(2) - (3)])->source_line,
@@ -3396,21 +3399,21 @@ regular_loop:
case 107:
/* Line 1821 of yacc.c */
-#line 1212 "awkgram.y"
+#line 1215 "awkgram.y"
{ (yyval) = mk_boolean((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 108:
/* Line 1821 of yacc.c */
-#line 1214 "awkgram.y"
+#line 1217 "awkgram.y"
{ (yyval) = mk_boolean((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 109:
/* Line 1821 of yacc.c */
-#line 1216 "awkgram.y"
+#line 1219 "awkgram.y"
{
if ((yyvsp[(1) - (3)])->lasti->opcode == Op_match_rec)
warning_ln((yyvsp[(2) - (3)])->source_line,
@@ -3431,7 +3434,7 @@ regular_loop:
case 110:
/* Line 1821 of yacc.c */
-#line 1232 "awkgram.y"
+#line 1235 "awkgram.y"
{
if (do_lint_old)
warning_ln((yyvsp[(2) - (3)])->source_line,
@@ -3446,7 +3449,7 @@ regular_loop:
case 111:
/* Line 1821 of yacc.c */
-#line 1242 "awkgram.y"
+#line 1245 "awkgram.y"
{
if (do_lint && (yyvsp[(3) - (3)])->lasti->opcode == Op_match_rec)
lintwarn_ln((yyvsp[(2) - (3)])->source_line,
@@ -3458,35 +3461,35 @@ regular_loop:
case 112:
/* Line 1821 of yacc.c */
-#line 1249 "awkgram.y"
+#line 1252 "awkgram.y"
{ (yyval) = mk_condition((yyvsp[(1) - (5)]), (yyvsp[(2) - (5)]), (yyvsp[(3) - (5)]), (yyvsp[(4) - (5)]), (yyvsp[(5) - (5)])); }
break;
case 113:
/* Line 1821 of yacc.c */
-#line 1251 "awkgram.y"
+#line 1254 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 114:
/* Line 1821 of yacc.c */
-#line 1256 "awkgram.y"
+#line 1259 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 115:
/* Line 1821 of yacc.c */
-#line 1258 "awkgram.y"
+#line 1261 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 116:
/* Line 1821 of yacc.c */
-#line 1260 "awkgram.y"
+#line 1263 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_assign_quotient;
(yyval) = (yyvsp[(2) - (2)]);
@@ -3496,49 +3499,49 @@ regular_loop:
case 117:
/* Line 1821 of yacc.c */
-#line 1268 "awkgram.y"
+#line 1271 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 118:
/* Line 1821 of yacc.c */
-#line 1270 "awkgram.y"
+#line 1273 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 119:
/* Line 1821 of yacc.c */
-#line 1275 "awkgram.y"
+#line 1278 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 120:
/* Line 1821 of yacc.c */
-#line 1277 "awkgram.y"
+#line 1280 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 121:
/* Line 1821 of yacc.c */
-#line 1282 "awkgram.y"
+#line 1285 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 122:
/* Line 1821 of yacc.c */
-#line 1284 "awkgram.y"
+#line 1287 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 123:
/* Line 1821 of yacc.c */
-#line 1286 "awkgram.y"
+#line 1289 "awkgram.y"
{
int count = 2;
int is_simple_var = FALSE;
@@ -3590,49 +3593,49 @@ regular_loop:
case 125:
/* Line 1821 of yacc.c */
-#line 1338 "awkgram.y"
+#line 1341 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 126:
/* Line 1821 of yacc.c */
-#line 1340 "awkgram.y"
+#line 1343 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 127:
/* Line 1821 of yacc.c */
-#line 1342 "awkgram.y"
+#line 1345 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 128:
/* Line 1821 of yacc.c */
-#line 1344 "awkgram.y"
+#line 1347 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 129:
/* Line 1821 of yacc.c */
-#line 1346 "awkgram.y"
+#line 1349 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 130:
/* Line 1821 of yacc.c */
-#line 1348 "awkgram.y"
+#line 1351 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 131:
/* Line 1821 of yacc.c */
-#line 1350 "awkgram.y"
+#line 1353 "awkgram.y"
{
/*
* In BEGINFILE/ENDFILE, allow `getline var < file'
@@ -3660,7 +3663,7 @@ regular_loop:
case 132:
/* Line 1821 of yacc.c */
-#line 1373 "awkgram.y"
+#line 1376 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_postincrement;
(yyval) = mk_assignment((yyvsp[(1) - (2)]), NULL, (yyvsp[(2) - (2)]));
@@ -3670,7 +3673,7 @@ regular_loop:
case 133:
/* Line 1821 of yacc.c */
-#line 1378 "awkgram.y"
+#line 1381 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_postdecrement;
(yyval) = mk_assignment((yyvsp[(1) - (2)]), NULL, (yyvsp[(2) - (2)]));
@@ -3680,7 +3683,7 @@ regular_loop:
case 134:
/* Line 1821 of yacc.c */
-#line 1383 "awkgram.y"
+#line 1386 "awkgram.y"
{
if (do_lint_old) {
warning_ln((yyvsp[(4) - (5)])->source_line,
@@ -3705,7 +3708,7 @@ regular_loop:
case 135:
/* Line 1821 of yacc.c */
-#line 1408 "awkgram.y"
+#line 1411 "awkgram.y"
{
(yyval) = mk_getline((yyvsp[(3) - (4)]), (yyvsp[(4) - (4)]), (yyvsp[(1) - (4)]), (yyvsp[(2) - (4)])->redir_type);
bcfree((yyvsp[(2) - (4)]));
@@ -3715,49 +3718,49 @@ regular_loop:
case 136:
/* Line 1821 of yacc.c */
-#line 1414 "awkgram.y"
+#line 1417 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 137:
/* Line 1821 of yacc.c */
-#line 1416 "awkgram.y"
+#line 1419 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 138:
/* Line 1821 of yacc.c */
-#line 1418 "awkgram.y"
+#line 1421 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 139:
/* Line 1821 of yacc.c */
-#line 1420 "awkgram.y"
+#line 1423 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 140:
/* Line 1821 of yacc.c */
-#line 1422 "awkgram.y"
+#line 1425 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 141:
/* Line 1821 of yacc.c */
-#line 1424 "awkgram.y"
+#line 1427 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 142:
/* Line 1821 of yacc.c */
-#line 1429 "awkgram.y"
+#line 1432 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3766,7 +3769,7 @@ regular_loop:
case 143:
/* Line 1821 of yacc.c */
-#line 1433 "awkgram.y"
+#line 1436 "awkgram.y"
{
if ((yyvsp[(2) - (2)])->opcode == Op_match_rec) {
(yyvsp[(2) - (2)])->opcode = Op_nomatch;
@@ -3777,7 +3780,7 @@ regular_loop:
} else {
if (do_optimize > 1 && (yyvsp[(2) - (2)])->nexti == (yyvsp[(2) - (2)])->lasti
&& (yyvsp[(2) - (2)])->nexti->opcode == Op_push_i
- && ((yyvsp[(2) - (2)])->nexti->memory->flags & MPFN) == 0
+ && ((yyvsp[(2) - (2)])->nexti->memory->flags & (MPFN|MPZN)) == 0
) {
NODE *n = (yyvsp[(2) - (2)])->nexti->memory;
if ((n->flags & (STRCUR|STRING)) != 0) {
@@ -3803,14 +3806,14 @@ regular_loop:
case 144:
/* Line 1821 of yacc.c */
-#line 1465 "awkgram.y"
+#line 1468 "awkgram.y"
{ (yyval) = (yyvsp[(2) - (3)]); }
break;
case 145:
/* Line 1821 of yacc.c */
-#line 1467 "awkgram.y"
+#line 1470 "awkgram.y"
{
(yyval) = snode((yyvsp[(3) - (4)]), (yyvsp[(1) - (4)]));
if ((yyval) == NULL)
@@ -3821,7 +3824,7 @@ regular_loop:
case 146:
/* Line 1821 of yacc.c */
-#line 1473 "awkgram.y"
+#line 1476 "awkgram.y"
{
(yyval) = snode((yyvsp[(3) - (4)]), (yyvsp[(1) - (4)]));
if ((yyval) == NULL)
@@ -3832,7 +3835,7 @@ regular_loop:
case 147:
/* Line 1821 of yacc.c */
-#line 1479 "awkgram.y"
+#line 1482 "awkgram.y"
{
static short warned1 = FALSE;
@@ -3850,7 +3853,7 @@ regular_loop:
case 150:
/* Line 1821 of yacc.c */
-#line 1494 "awkgram.y"
+#line 1497 "awkgram.y"
{
(yyvsp[(1) - (2)])->opcode = Op_preincrement;
(yyval) = mk_assignment((yyvsp[(2) - (2)]), NULL, (yyvsp[(1) - (2)]));
@@ -3860,7 +3863,7 @@ regular_loop:
case 151:
/* Line 1821 of yacc.c */
-#line 1499 "awkgram.y"
+#line 1502 "awkgram.y"
{
(yyvsp[(1) - (2)])->opcode = Op_predecrement;
(yyval) = mk_assignment((yyvsp[(2) - (2)]), NULL, (yyvsp[(1) - (2)]));
@@ -3870,7 +3873,7 @@ regular_loop:
case 152:
/* Line 1821 of yacc.c */
-#line 1504 "awkgram.y"
+#line 1507 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3879,7 +3882,7 @@ regular_loop:
case 153:
/* Line 1821 of yacc.c */
-#line 1508 "awkgram.y"
+#line 1511 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3888,7 +3891,7 @@ regular_loop:
case 154:
/* Line 1821 of yacc.c */
-#line 1512 "awkgram.y"
+#line 1515 "awkgram.y"
{
if ((yyvsp[(2) - (2)])->lasti->opcode == Op_push_i
&& ((yyvsp[(2) - (2)])->lasti->memory->flags & (STRCUR|STRING)) == 0
@@ -3910,7 +3913,7 @@ regular_loop:
case 155:
/* Line 1821 of yacc.c */
-#line 1529 "awkgram.y"
+#line 1532 "awkgram.y"
{
/*
* was: $$ = $2
@@ -3925,7 +3928,7 @@ regular_loop:
case 156:
/* Line 1821 of yacc.c */
-#line 1542 "awkgram.y"
+#line 1545 "awkgram.y"
{
func_use((yyvsp[(1) - (1)])->lasti->func_name, FUNC_USE);
(yyval) = (yyvsp[(1) - (1)]);
@@ -3935,7 +3938,7 @@ regular_loop:
case 157:
/* Line 1821 of yacc.c */
-#line 1547 "awkgram.y"
+#line 1550 "awkgram.y"
{
/* indirect function call */
INSTRUCTION *f, *t;
@@ -3973,7 +3976,7 @@ regular_loop:
case 158:
/* Line 1821 of yacc.c */
-#line 1583 "awkgram.y"
+#line 1586 "awkgram.y"
{
param_sanity((yyvsp[(3) - (4)]));
(yyvsp[(1) - (4)])->opcode = Op_func_call;
@@ -3992,42 +3995,42 @@ regular_loop:
case 159:
/* Line 1821 of yacc.c */
-#line 1600 "awkgram.y"
+#line 1603 "awkgram.y"
{ (yyval) = NULL; }
break;
case 160:
/* Line 1821 of yacc.c */
-#line 1602 "awkgram.y"
+#line 1605 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 161:
/* Line 1821 of yacc.c */
-#line 1607 "awkgram.y"
+#line 1610 "awkgram.y"
{ (yyval) = NULL; }
break;
case 162:
/* Line 1821 of yacc.c */
-#line 1609 "awkgram.y"
+#line 1612 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 163:
/* Line 1821 of yacc.c */
-#line 1614 "awkgram.y"
+#line 1617 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 164:
/* Line 1821 of yacc.c */
-#line 1616 "awkgram.y"
+#line 1619 "awkgram.y"
{
(yyval) = list_merge((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
}
@@ -4036,7 +4039,7 @@ regular_loop:
case 165:
/* Line 1821 of yacc.c */
-#line 1623 "awkgram.y"
+#line 1626 "awkgram.y"
{
INSTRUCTION *ip = (yyvsp[(1) - (1)])->lasti;
int count = ip->sub_count; /* # of SUBSEP-seperated expressions */
@@ -4055,7 +4058,7 @@ regular_loop:
case 166:
/* Line 1821 of yacc.c */
-#line 1640 "awkgram.y"
+#line 1643 "awkgram.y"
{
INSTRUCTION *t = (yyvsp[(2) - (3)]);
if ((yyvsp[(2) - (3)]) == NULL) {
@@ -4074,14 +4077,14 @@ regular_loop:
case 167:
/* Line 1821 of yacc.c */
-#line 1657 "awkgram.y"
+#line 1660 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 168:
/* Line 1821 of yacc.c */
-#line 1659 "awkgram.y"
+#line 1662 "awkgram.y"
{
(yyval) = list_merge((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
}
@@ -4090,14 +4093,14 @@ regular_loop:
case 169:
/* Line 1821 of yacc.c */
-#line 1666 "awkgram.y"
+#line 1669 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 170:
/* Line 1821 of yacc.c */
-#line 1671 "awkgram.y"
+#line 1674 "awkgram.y"
{
char *var_name = (yyvsp[(1) - (1)])->lextok;
@@ -4110,7 +4113,7 @@ regular_loop:
case 171:
/* Line 1821 of yacc.c */
-#line 1679 "awkgram.y"
+#line 1682 "awkgram.y"
{
char *arr = (yyvsp[(1) - (2)])->lextok;
(yyvsp[(1) - (2)])->memory = variable((yyvsp[(1) - (2)])->source_line, arr, Node_var_new);
@@ -4122,7 +4125,7 @@ regular_loop:
case 172:
/* Line 1821 of yacc.c */
-#line 1689 "awkgram.y"
+#line 1692 "awkgram.y"
{
INSTRUCTION *ip = (yyvsp[(1) - (1)])->nexti;
if (ip->opcode == Op_push
@@ -4139,7 +4142,7 @@ regular_loop:
case 173:
/* Line 1821 of yacc.c */
-#line 1701 "awkgram.y"
+#line 1704 "awkgram.y"
{
(yyval) = list_append((yyvsp[(2) - (3)]), (yyvsp[(1) - (3)]));
if ((yyvsp[(3) - (3)]) != NULL)
@@ -4150,7 +4153,7 @@ regular_loop:
case 174:
/* Line 1821 of yacc.c */
-#line 1710 "awkgram.y"
+#line 1713 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_postincrement;
}
@@ -4159,7 +4162,7 @@ regular_loop:
case 175:
/* Line 1821 of yacc.c */
-#line 1714 "awkgram.y"
+#line 1717 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_postdecrement;
}
@@ -4168,49 +4171,49 @@ regular_loop:
case 176:
/* Line 1821 of yacc.c */
-#line 1717 "awkgram.y"
+#line 1720 "awkgram.y"
{ (yyval) = NULL; }
break;
case 178:
/* Line 1821 of yacc.c */
-#line 1725 "awkgram.y"
+#line 1728 "awkgram.y"
{ yyerrok; }
break;
case 179:
/* Line 1821 of yacc.c */
-#line 1729 "awkgram.y"
+#line 1732 "awkgram.y"
{ yyerrok; }
break;
case 182:
/* Line 1821 of yacc.c */
-#line 1738 "awkgram.y"
+#line 1741 "awkgram.y"
{ yyerrok; }
break;
case 183:
/* Line 1821 of yacc.c */
-#line 1742 "awkgram.y"
+#line 1745 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); yyerrok; }
break;
case 184:
/* Line 1821 of yacc.c */
-#line 1746 "awkgram.y"
+#line 1749 "awkgram.y"
{ yyerrok; }
break;
/* Line 1821 of yacc.c */
-#line 4226 "awkgram.c"
+#line 4229 "awkgram.c"
default: break;
}
/* User semantic actions sometimes alter yychar, and that requires
@@ -4441,7 +4444,7 @@ yyreturn:
/* Line 2067 of yacc.c */
-#line 1748 "awkgram.y"
+#line 1751 "awkgram.y"
struct token {
@@ -4460,7 +4463,7 @@ struct token {
# define CONTINUE 0x2000 /* continue allowed inside */
NODE *(*ptr)(int); /* function that implements this keyword */
- NODE *(*ptr2)(int); /* alternate MPFR function implementing this keyword */
+ NODE *(*ptr2)(int); /* alternate arbitrary-precision function */
};
#if 'a' == 0x81 /* it's EBCDIC */
@@ -4603,10 +4606,12 @@ void
negate_num(NODE *n)
{
#ifdef HAVE_MPFR
- if (n->flags & MPFN) {
+ if (is_mpg_float(n)) {
int tval;
- tval = mpfr_setsign(n->mpg_numbr, n->mpg_numbr, TRUE, RND_MODE);
+ tval = mpfr_neg(n->mpg_numbr, n->mpg_numbr, RND_MODE);
IEEE_FMT(n->mpg_numbr, tval);
+ } else if (is_mpg_integer(n)) {
+ mpz_neg(n->mpg_i, n->mpg_i);
} else
#endif
n->numbr = -n->numbr;
@@ -6081,12 +6086,18 @@ retry:
#ifdef HAVE_MPFR
if (do_mpfr) {
NODE *r;
- int tval;
- r = mpg_node();
- tval = mpfr_strtofr(r->mpg_numbr, tokstart, NULL, base, RND_MODE);
- errno = 0;
- IEEE_FMT(r->mpg_numbr, tval);
+ if (! seen_point && ! seen_e) {
+ r = mpg_integer();
+ mpg_strtoui(r->mpg_i, tokstart, strlen(tokstart), NULL, base);
+ errno = 0;
+ } else {
+ int tval;
+ r = mpg_float();
+ tval = mpfr_strtofr(r->mpg_numbr, tokstart, NULL, base, RND_MODE);
+ errno = 0;
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
yylval->memory = r;
return lasttok = YNUMBER;
}
@@ -6593,8 +6604,10 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
print_func(fp, "\n");
} else if (n->flags & NUMBER) {
#ifdef HAVE_MPFR
- if (n->flags & MPFN)
+ if (is_mpg_float(n))
print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ print_func(fp, "%s\n", mpg_fmt("%Zd", n->mpg_i));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
@@ -6603,8 +6616,10 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
print_func(fp, "\n");
} else if (n->flags & NUMCUR) {
#ifdef HAVE_MPFR
- if (n->flags & MPFN)
+ if (is_mpg_float(n))
print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ print_func(fp, "%s\n", mpg_fmt("%Zd", n->mpg_i));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
@@ -7155,8 +7170,8 @@ mk_binary(INSTRUCTION *s1, INSTRUCTION *s2, INSTRUCTION *op)
ip1 = s1->nexti;
if (do_optimize > 1
&& ip1 == s1->lasti && ip1->opcode == Op_push_i
- && (ip1->memory->flags & (MPFN|STRCUR|STRING)) == 0
- && (ip2->memory->flags & (MPFN|STRCUR|STRING)) == 0
+ && (ip1->memory->flags & (MPFN|MPZN|STRCUR|STRING)) == 0
+ && (ip2->memory->flags & (MPFN|MPZN|STRCUR|STRING)) == 0
) {
NODE *n1 = ip1->memory, *n2 = ip2->memory;
res = force_number(n1)->numbr;
diff --git a/awkgram.y b/awkgram.y
index 5187a696..04d2e089 100644
--- a/awkgram.y
+++ b/awkgram.y
@@ -673,16 +673,16 @@ statement
} else {
INSTRUCTION *tbreak, *tcont;
- /* [ Op_push_array a ]
- * [ Op_arrayfor_init | ib ]
- * ic:[ Op_arrayfor_incr | ib ]
- * [ Op_var_assign if any ]
- *
- * body
- *
- * [Op_jmp | ic ]
- * ib:[Op_arrayfor_final ]
- */
+ /* [ Op_push_array a ]
+ * [ Op_arrayfor_init | ib ]
+ * ic:[ Op_arrayfor_incr | ib ]
+ * [ Op_var_assign if any ]
+ *
+ * body
+ *
+ * [Op_jmp | ic ]
+ * ib:[Op_arrayfor_final ]
+ */
regular_loop:
ip = $5;
ip->nexti->opcode = Op_push_array;
@@ -865,9 +865,7 @@ simple_stmt
|| ($3->lasti->opcode == Op_field_spec
&& $3->nexti->nexti->nexti == $3->lasti
&& $3->nexti->nexti->opcode == Op_push_i
- && $3->nexti->nexti->memory->type == Node_val
- && ($3->nexti->nexti->memory->flags & MPFN) == 0
- && $3->nexti->nexti->memory->numbr == 0.0)
+ && $3->nexti->nexti->memory->type == Node_val)
)
) {
static short warned = FALSE;
@@ -881,11 +879,16 @@ simple_stmt
*/
if ($3 != NULL) {
- bcfree($3->lasti); /* Op_field_spec */
- unref($3->nexti->nexti->memory); /* Node_val */
+ NODE *n = $3->nexti->nexti->memory;
+
+ if (! iszero(n))
+ goto regular_print;
+
+ bcfree($3->lasti); /* Op_field_spec */
+ unref(n); /* Node_val */
bcfree($3->nexti->nexti); /* Op_push_i */
- bcfree($3->nexti); /* Op_list */
- bcfree($3); /* Op_list */
+ bcfree($3->nexti); /* Op_list */
+ bcfree($3); /* Op_list */
} else {
if (do_lint && (rule == BEGIN || rule == END) && ! warned) {
warned = TRUE;
@@ -917,7 +920,7 @@ simple_stmt
* [$1 | NULL | redir_type | expr_count]
*
*/
-
+regular_print:
if ($4 == NULL) { /* no redirection */
if ($3 == NULL) { /* printf without arg */
$1->expr_count = 0;
@@ -1440,7 +1443,7 @@ non_post_simp_exp
} else {
if (do_optimize > 1 && $2->nexti == $2->lasti
&& $2->nexti->opcode == Op_push_i
- && ($2->nexti->memory->flags & MPFN) == 0
+ && ($2->nexti->memory->flags & (MPFN|MPZN)) == 0
) {
NODE *n = $2->nexti->memory;
if ((n->flags & (STRCUR|STRING)) != 0) {
@@ -1763,7 +1766,7 @@ struct token {
# define CONTINUE 0x2000 /* continue allowed inside */
NODE *(*ptr)(int); /* function that implements this keyword */
- NODE *(*ptr2)(int); /* alternate MPFR function implementing this keyword */
+ NODE *(*ptr2)(int); /* alternate arbitrary-precision function */
};
#if 'a' == 0x81 /* it's EBCDIC */
@@ -1906,10 +1909,12 @@ void
negate_num(NODE *n)
{
#ifdef HAVE_MPFR
- if (n->flags & MPFN) {
+ if (is_mpg_float(n)) {
int tval;
- tval = mpfr_setsign(n->mpg_numbr, n->mpg_numbr, TRUE, RND_MODE);
+ tval = mpfr_neg(n->mpg_numbr, n->mpg_numbr, RND_MODE);
IEEE_FMT(n->mpg_numbr, tval);
+ } else if (is_mpg_integer(n)) {
+ mpz_neg(n->mpg_i, n->mpg_i);
} else
#endif
n->numbr = -n->numbr;
@@ -3384,12 +3389,18 @@ retry:
#ifdef HAVE_MPFR
if (do_mpfr) {
NODE *r;
- int tval;
- r = mpg_node();
- tval = mpfr_strtofr(r->mpg_numbr, tokstart, NULL, base, RND_MODE);
- errno = 0;
- IEEE_FMT(r->mpg_numbr, tval);
+ if (! seen_point && ! seen_e) {
+ r = mpg_integer();
+ mpg_strtoui(r->mpg_i, tokstart, strlen(tokstart), NULL, base);
+ errno = 0;
+ } else {
+ int tval;
+ r = mpg_float();
+ tval = mpfr_strtofr(r->mpg_numbr, tokstart, NULL, base, RND_MODE);
+ errno = 0;
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
yylval->memory = r;
return lasttok = YNUMBER;
}
@@ -3896,8 +3907,10 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
print_func(fp, "\n");
} else if (n->flags & NUMBER) {
#ifdef HAVE_MPFR
- if (n->flags & MPFN)
+ if (is_mpg_float(n))
print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ print_func(fp, "%s\n", mpg_fmt("%Zd", n->mpg_i));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
@@ -3906,8 +3919,10 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
print_func(fp, "\n");
} else if (n->flags & NUMCUR) {
#ifdef HAVE_MPFR
- if (n->flags & MPFN)
+ if (is_mpg_float(n))
print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ print_func(fp, "%s\n", mpg_fmt("%Zd", n->mpg_i));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
@@ -4458,8 +4473,8 @@ mk_binary(INSTRUCTION *s1, INSTRUCTION *s2, INSTRUCTION *op)
ip1 = s1->nexti;
if (do_optimize > 1
&& ip1 == s1->lasti && ip1->opcode == Op_push_i
- && (ip1->memory->flags & (MPFN|STRCUR|STRING)) == 0
- && (ip2->memory->flags & (MPFN|STRCUR|STRING)) == 0
+ && (ip1->memory->flags & (MPFN|MPZN|STRCUR|STRING)) == 0
+ && (ip2->memory->flags & (MPFN|MPZN|STRCUR|STRING)) == 0
) {
NODE *n1 = ip1->memory, *n2 = ip2->memory;
res = force_number(n1)->numbr;
diff --git a/builtin.c b/builtin.c
index f91a2f9f..5a63977e 100644
--- a/builtin.c
+++ b/builtin.c
@@ -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, RND_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;
@@ -644,8 +680,11 @@ format_tree(
char *chp;
size_t copy_count, char_count;
#ifdef HAVE_MPFR
- enum { MPFR_INT_WITH_PREC = 1, MPFR_INT_WITHOUT_PREC, MPFR_FLOAT } mpfr_fmt_type;
+ 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";
@@ -732,10 +771,16 @@ format_tree(
fw = 0;
prec = 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;
@@ -1062,8 +1107,10 @@ out2:
parse_next_arg();
(void) force_number(arg);
#ifdef HAVE_MPFR
- if (arg->flags & MPFN)
- goto mpfr_int;
+ if (is_mpg_float(arg))
+ goto mpf0;
+ else if (is_mpg_integer(arg))
+ goto mpz0;
else
#endif
tmpval = arg->numbr;
@@ -1180,25 +1227,60 @@ out2:
parse_next_arg();
(void) force_number(arg);
#ifdef HAVE_MPFR
- if (arg->flags & MPFN) {
- mpfr_ptr mt;
-mpfr_int:
- mt = arg->mpg_numbr;
- if (! mpfr_number_p(mt)) {
+ 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';
- goto format_float;
+ fmt_type = MP_FLOAT;
+ goto fmt1;
}
if (cs1 != 'd' && cs1 != 'i') {
- if (mpfr_sgn(mt) < 0) {
- if (! mpfr_fits_intmax_p(mt, RND_MODE)) {
+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, RND_MODE)) {
/* -ve number is too large */
cs1 = 'g';
- goto format_float;
+ fmt_type = MP_FLOAT;
+ goto fmt1;
}
- uval = (uintmax_t) mpfr_get_sj(mt, RND_MODE);
- goto format_fixed_int;
+
+ tmpval = uval = (uintmax_t) mpfr_get_sj(mf, RND_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 '+' */
}
@@ -1207,10 +1289,11 @@ mpfr_int:
zero_flag = (! lj
&& ((zero_flag && ! have_prec)
|| (fw == 0 && have_prec)));
-
- (void) mpfr_get_z(mpzval, mt, MPFR_RNDZ); /* convert to GMP int */
- mpfr_fmt_type = have_prec ? MPFR_INT_WITH_PREC : MPFR_INT_WITHOUT_PREC;
- goto format_int;
+
+ (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;
@@ -1239,7 +1322,7 @@ mpfr_int:
if ((AWKNUM)uval != double_to_int(tmpval))
goto out_of_range;
}
- format_fixed_int:
+ int0:
/*
* When to fill with zeroes is of course not simple.
* First: No zero fill if left-justifying.
@@ -1322,7 +1405,7 @@ mpfr_int:
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
@@ -1337,16 +1420,24 @@ mpfr_int:
need_format = FALSE;
parse_next_arg();
(void) force_number(arg);
- format_float:
- if ((arg->flags & MPFN) == 0)
+
+ if (! is_mpg_number(arg))
tmpval = arg->numbr;
#ifdef HAVE_MPFR
- else
- mpfr_fmt_type = MPFR_FLOAT;
+ 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;
- format_int:
+ fmt0:
chksize(fw + prec + 11); /* 11 == slop */
cp = cpbuf;
*cp++ = '%';
@@ -1361,62 +1452,49 @@ mpfr_int:
if (quote_flag)
*cp++ = '\'';
-#ifdef HAVE_MPFR
- if (arg->flags & MPFN) {
- if (mpfr_fmt_type == MPFR_INT_WITH_PREC) {
- strcpy(cp, "*.*Z");
- cp += 4;
- } else if (mpfr_fmt_type == MPFR_INT_WITHOUT_PREC) {
- strcpy(cp, "*Z");
- cp += 2;
- } else {
- strcpy(cp, "*.*R*");
- cp += 5;
- }
- } else
-#endif
- {
- strcpy(cp, "*.*");
- cp += 3;
- }
-
- *cp++ = cs1;
- *cp = '\0';
#if defined(LC_NUMERIC)
if (quote_flag && ! use_lc_numeric)
setlocale(LC_NUMERIC, "");
#endif
- {
- int n;
+
+ switch (fmt_type) {
+ case MP_INT_WITH_PREC:
#ifdef HAVE_MPFR
- if (arg->flags & MPFN) {
- if (mpfr_fmt_type == MPFR_INT_WITH_PREC) {
- while ((n = mpfr_snprintf(obufout, ofre, cpbuf,
- (int) fw, (int) prec, mpzval)) >= ofre)
- chksize(n)
- } else if (mpfr_fmt_type == MPFR_INT_WITHOUT_PREC) {
- while ((n = mpfr_snprintf(obufout, ofre, cpbuf,
- (int) fw, mpzval)) >= ofre)
- chksize(n)
- } else {
- while ((n = mpfr_snprintf(obufout, ofre, cpbuf,
- (int) fw, (int) prec, RND_MODE,
- arg->mpg_numbr)) >= ofre)
- chksize(n)
- }
- } else
+ sprintf(cp, "*.*Z%c", cs1);
+ while ((nc = mpfr_snprintf(obufout, ofre, cpbuf,
+ (int) fw, (int) prec, zi)) >= ofre)
+ chksize(nc)
#endif
- {
- while ((n = snprintf(obufout, ofre, cpbuf,
- (int) fw, (int) prec,
- (double) tmpval)) >= ofre)
- chksize(n)
- }
+ break;
+ case MP_INT_WITHOUT_PREC:
+#ifdef HAVE_MPFR
+ sprintf(cp, "*Z%c", cs1);
+ while ((nc = mpfr_snprintf(obufout, ofre, cpbuf,
+ (int) fw, zi)) >= ofre)
+ chksize(nc)
+#endif
+ break;
+ case MP_FLOAT:
+#ifdef HAVE_MPFR
+ sprintf(cp, "*.*R*%c", cs1);
+ while ((nc = mpfr_snprintf(obufout, ofre, cpbuf,
+ (int) fw, (int) prec, RND_MODE, mf)) >= ofre)
+ chksize(nc)
+#endif
+ break;
+ 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;
diff --git a/command.c b/command.c
index 81c601d6..11175561 100644
--- a/command.c
+++ b/command.c
@@ -3260,8 +3260,17 @@ err:
errno = 0;
#ifdef HAVE_MPFR
if (do_mpfr) {
- r = mpg_node();
- (void) mpfr_strtofr(r->mpg_numbr, tokstart, & lexptr, 0, RND_MODE);
+ int tval;
+ r = mpg_float();
+ tval = mpfr_strtofr(r->mpg_numbr, tokstart, & lexptr, 0, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ if (mpfr_integer_p(r->mpg_numbr)) {
+ /* integral value, convert to a GMP type. */
+ NODE *tmp = r;
+ r = mpg_integer();
+ mpfr_get_z(r->mpg_i, tmp->mpg_numbr, MPFR_RNDZ);
+ unref(tmp);
+ }
} else
#endif
r = make_number(strtod(tokstart, & lexptr));
diff --git a/command.y b/command.y
index e36497ad..cb5707c6 100644
--- a/command.y
+++ b/command.y
@@ -1246,8 +1246,17 @@ err:
errno = 0;
#ifdef HAVE_MPFR
if (do_mpfr) {
- r = mpg_node();
- (void) mpfr_strtofr(r->mpg_numbr, tokstart, & lexptr, 0, RND_MODE);
+ int tval;
+ r = mpg_float();
+ tval = mpfr_strtofr(r->mpg_numbr, tokstart, & lexptr, 0, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ if (mpfr_integer_p(r->mpg_numbr)) {
+ /* integral value, convert to a GMP type. */
+ NODE *tmp = r;
+ r = mpg_integer();
+ mpfr_get_z(r->mpg_i, tmp->mpg_numbr, MPFR_RNDZ);
+ unref(tmp);
+ }
} else
#endif
r = make_number(strtod(tokstart, & lexptr));
diff --git a/debug.c b/debug.c
index 331c7d3c..03fbf47d 100644
--- a/debug.c
+++ b/debug.c
@@ -1591,7 +1591,7 @@ condition_triggered(struct condition *cndn)
return FALSE; /* not triggered */
force_number(r);
- di = is_nonzero_num(r);
+ di = ! iszero(r);
DEREF(r);
return di;
}
@@ -3659,6 +3659,8 @@ print_memory(NODE *m, NODE *func, Func_print print_func, FILE *fp)
#ifdef HAVE_MPFR
if (m->flags & MPFN)
print_func(fp, "%s", mpg_fmt("%R*g", RND_MODE, m->mpg_numbr));
+ else if (m->flags & MPZN)
+ print_func(fp, "%s", mpg_fmt("%Zd", m->mpg_i));
else
#endif
print_func(fp, "%g", m->numbr);
@@ -3668,6 +3670,8 @@ print_memory(NODE *m, NODE *func, Func_print print_func, FILE *fp)
#ifdef HAVE_MPFR
if (m->flags & MPFN)
print_func(fp, "%s", mpg_fmt("%R*g", RND_MODE, m->mpg_numbr));
+ else if (m->flags & MPZN)
+ print_func(fp, "%s", mpg_fmt("%Zd", m->mpg_i));
else
#endif
print_func(fp, "%g", m->numbr);
diff --git a/eval.c b/eval.c
index 5757a154..2305bbb3 100644
--- a/eval.c
+++ b/eval.c
@@ -440,6 +440,7 @@ flags2str(int flagval)
{ INTIND, "INTIND" },
{ WSTRCUR, "WSTRCUR" },
{ MPFN, "MPFN" },
+ { MPZN, "MPZN" },
{ ARRAYMAXED, "ARRAYMAXED" },
{ HALFHAT, "HALFHAT" },
{ XARRAY, "XARRAY" },
@@ -566,6 +567,7 @@ posix_compare(NODE *s1, NODE *s2)
return ret;
}
+
/* cmp_nodes --- compare two nodes, returning negative, 0, positive */
int
@@ -587,33 +589,11 @@ cmp_nodes(NODE *t1, NODE *t2)
if (t2->flags & INTIND)
t2 = force_string(t2);
- if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
-#ifdef HAVE_MPFR
- if (t1->flags & MPFN) {
- assert((t2->flags & MPFN) != 0);
-
- /*
- * N.B.: For non-MPFN, gawk returns 1 if either t1 or t2 is NaN.
- * The results of == and < comparisons below are false with NaN(s).
- */
-
- if (mpfr_nan_p(t1->mpg_numbr) || mpfr_nan_p(t2->mpg_numbr))
- return 1;
- return mpfr_cmp(t1->mpg_numbr, t2->mpg_numbr);
- }
-#endif
- if (t1->numbr == t2->numbr)
- ret = 0;
- /* don't subtract, in case one or both are infinite */
- else if (t1->numbr < t2->numbr)
- ret = -1;
- else
- ret = 1;
- return ret;
- }
+ if ((t1->flags & NUMBER) && (t2->flags & NUMBER))
+ return cmp_numbers(t1, t2);
- t1 = force_string(t1);
- t2 = force_string(t2);
+ (void) force_string(t1);
+ (void) force_string(t2);
len1 = t1->stlen;
len2 = t2->stlen;
ldiff = len1 - len2;
@@ -732,10 +712,10 @@ set_IGNORECASE()
IGNORECASE = (n->stlen > 0);
} else {
(void) force_number(n);
- IGNORECASE = is_nonzero_num(n);
+ IGNORECASE = ! iszero(n);
}
} else if ((n->flags & (NUMCUR|NUMBER)) != 0)
- IGNORECASE = is_nonzero_num(n);
+ IGNORECASE = ! iszero(n);
else
IGNORECASE = FALSE; /* shouldn't happen */
@@ -965,7 +945,7 @@ set_LINT()
}
} else {
(void) force_number(n);
- if (is_nonzero_num(n))
+ if (! iszero(n))
do_flags |= DO_LINT_ALL;
else
do_flags &= ~(DO_LINT_ALL|DO_LINT_INVALID);
@@ -973,7 +953,7 @@ set_LINT()
}
} else if ((n->flags & (NUMCUR|NUMBER)) != 0) {
(void) force_number(n);
- if (is_nonzero_num(n))
+ if (! iszero(n))
do_flags |= DO_LINT_ALL;
else
do_flags &= ~(DO_LINT_ALL|DO_LINT_INVALID);
@@ -1038,8 +1018,8 @@ void
update_NR()
{
#ifdef HAVE_MPFR
- if ((NR_node->var_value->flags & MPFN) != 0)
- mpg_update_var(NR_node);
+ if (is_mpg_number(NR_node->var_value))
+ (void) mpg_update_var(NR_node);
else
#endif
if (NR_node->var_value->numbr != NR) {
@@ -1070,8 +1050,8 @@ void
update_FNR()
{
#ifdef HAVE_MPFR
- if ((FNR_node->var_value->flags & MPFN) != 0)
- mpg_update_var(FNR_node);
+ if (is_mpg_number(FNR_node->var_value))
+ (void) mpg_update_var(FNR_node);
else
#endif
if (FNR_node->var_value->numbr != FNR) {
@@ -1508,15 +1488,15 @@ eval_condition(NODE *t)
force_number(t);
if ((t->flags & NUMBER) != 0)
- return is_nonzero_num(t);
+ return ! iszero(t);
return (t->stlen != 0);
}
-/* cmp_scalar -- compare two nodes on the stack */
+/* cmp_scalars -- compare two nodes on the stack */
static inline int
-cmp_scalar()
+cmp_scalars()
{
NODE *t1, *t2;
int di;
@@ -1764,9 +1744,9 @@ init_interpret()
frame_ptr->vname = NULL;
/* initialize TRUE and FALSE nodes */
- node_Boolean[FALSE] = make_number(0);
+ node_Boolean[FALSE] = make_number(0.0);
node_Boolean[TRUE] = make_number(1.0);
- if ((node_Boolean[FALSE]->flags & MPFN) == 0) {
+ if (! is_mpg_number(node_Boolean[FALSE])) {
node_Boolean[FALSE]->flags |= NUMINT;
node_Boolean[TRUE]->flags |= NUMINT;
}
diff --git a/field.c b/field.c
index d496a579..26ece846 100644
--- a/field.c
+++ b/field.c
@@ -203,11 +203,14 @@ rebuild_record()
*n = *Null_field;
n->stlen = r->stlen;
if ((r->flags & (NUMCUR|NUMBER)) != 0) {
- n->flags |= (r->flags & (NUMCUR|NUMBER));
+ n->flags |= (r->flags & (MPFN|MPZN|NUMCUR|NUMBER));
#ifdef HAVE_MPFR
- if (r->flags & MPFN) {
+ if (is_mpg_float(r)) {
mpfr_init(n->mpg_numbr);
mpfr_set(n->mpg_numbr, r->mpg_numbr, RND_MODE);
+ } else if (is_mpg_integer(r)) {
+ mpz_init(n->mpg_i);
+ mpz_set(n->mpg_i, r->mpg_i);
} else
#endif
n->numbr = r->numbr;
diff --git a/interpret.h b/interpret.h
index 2f38fbe3..009e6e10 100644
--- a/interpret.h
+++ b/interpret.h
@@ -346,37 +346,37 @@ top:
break;
case Op_equal:
- r = node_Boolean[cmp_scalar() == 0];
+ r = node_Boolean[cmp_scalars() == 0];
UPREF(r);
REPLACE(r);
break;
case Op_notequal:
- r = node_Boolean[cmp_scalar() != 0];
+ r = node_Boolean[cmp_scalars() != 0];
UPREF(r);
REPLACE(r);
break;
case Op_less:
- r = node_Boolean[cmp_scalar() < 0];
+ r = node_Boolean[cmp_scalars() < 0];
UPREF(r);
REPLACE(r);
break;
case Op_greater:
- r = node_Boolean[cmp_scalar() > 0];
+ r = node_Boolean[cmp_scalars() > 0];
UPREF(r);
REPLACE(r);
break;
case Op_leq:
- r = node_Boolean[cmp_scalar() <= 0];
+ r = node_Boolean[cmp_scalars() <= 0];
UPREF(r);
REPLACE(r);
break;
case Op_geq:
- r = node_Boolean[cmp_scalar() >= 0];
+ r = node_Boolean[cmp_scalars() >= 0];
UPREF(r);
REPLACE(r);
break;
diff --git a/io.c b/io.c
index c7ae06e8..78cf70a2 100644
--- a/io.c
+++ b/io.c
@@ -135,7 +135,7 @@
#ifdef HAVE_MPFR
/* increment NR or FNR */
#define INCREMENT_R(X) (do_mpfr && X == (LONG_MAX - 1)) ? \
- (mpfr_add_ui(M##X, M##X, 1, RND_MODE), X = 0) : X++
+ (mpz_add_ui(M##X, M##X, 1), X = 0) : X++
#else
#define INCREMENT_R(X) X++
#endif
@@ -400,8 +400,8 @@ nextfile(IOBUF **curfile, int skipping)
unref(FILENAME_node->var_value);
FILENAME_node->var_value = dupnode(arg);
#ifdef HAVE_MPFR
- if (FNR_node->var_value->flags & MPFN)
- mpfr_set_d(MFNR, 0.0, RND_MODE);
+ if (is_mpg_number(FNR_node->var_value))
+ mpz_set_ui(MFNR, 0);
#endif
FNR = 0;
iop = *curfile = iop_alloc(fd, fname, &mybuf, FALSE);
@@ -448,13 +448,14 @@ nextfile(IOBUF **curfile, int skipping)
void
set_FNR()
{
- (void) force_number(FNR_node->var_value);
+ NODE *n = FNR_node->var_value;
+ (void) force_number(n);
#ifdef HAVE_MPFR
- if ((FNR_node->var_value->flags & MPFN) != 0)
+ if (is_mpg_number(n))
FNR = mpg_set_var(FNR_node);
else
#endif
- FNR = FNR_node->var_value->numbr;
+ FNR = get_number_si(n);
}
/* set_NR --- update internal NR from awk variable */
@@ -462,13 +463,14 @@ set_FNR()
void
set_NR()
{
- (void) force_number(NR_node->var_value);
+ NODE *n = NR_node->var_value;
+ (void) force_number(n);
#ifdef HAVE_MPFR
- if ((NR_node->var_value->flags & MPFN) != 0)
+ if (is_mpg_number(n))
NR = mpg_set_var(NR_node);
else
#endif
- NR = NR_node->var_value->numbr;
+ NR = get_number_si(n);
}
/* inrec --- This reads in a record from the input file */
@@ -3278,7 +3280,7 @@ pty_vs_pipe(const char *command)
if (val->flags & MAYBE_NUM)
(void) force_number(val);
if (val->flags & NUMBER)
- return is_nonzero_num(val);
+ return ! iszero(val);
else
return (val->stlen != 0);
}
diff --git a/main.c b/main.c
index 558c91f6..3edb0a91 100644
--- a/main.c
+++ b/main.c
@@ -587,9 +587,8 @@ out:
Nnull_string = make_string("", 0);
#ifdef HAVE_MPFR
if (do_mpfr) {
- mpfr_init(Nnull_string->mpg_numbr);
- mpfr_set_d(Nnull_string->mpg_numbr, 0.0, RND_MODE);
- Nnull_string->flags = (MALLOC|STRCUR|STRING|MPFN|NUMCUR|NUMBER);
+ mpz_init(Nnull_string->mpg_i);
+ Nnull_string->flags = (MALLOC|STRCUR|STRING|MPZN|NUMCUR|NUMBER);
} else
#endif
{
@@ -1079,6 +1078,13 @@ load_procinfo()
update_PROCINFO_str("version", VERSION);
update_PROCINFO_str("strftime", def_strftime_format);
+#ifdef HAVE_MPFR
+ sprintf(name, "GNU MPFR %s", mpfr_get_version());
+ update_PROCINFO_str("mpfr_version", name);
+ sprintf(name, "GNU MP %s", gmp_version);
+ update_PROCINFO_str("gmp_version", name);
+#endif
+
#ifdef GETPGRP_VOID
#define getpgrp_arg() /* nothing */
#else
@@ -1355,7 +1361,11 @@ nostalgia()
static void
version()
{
- printf("%s\n", version_string);
+ printf("%s", version_string);
+#ifdef HAVE_MPFR
+ printf(" (GNU MPFR %s, GNU MP %s)", mpfr_get_version(), gmp_version);
+#endif
+ printf("\n");
/*
* Per GNU coding standards, print copyright info,
* then exit successfully, do nothing else.
diff --git a/mpfr.c b/mpfr.c
index f1bf02c2..aaf65c2b 100644
--- a/mpfr.c
+++ b/mpfr.c
@@ -1,5 +1,5 @@
/*
- * mpfr.c - routines for MPFR number support in gawk.
+ * mpfr.c - routines for arbitrary-precision number support in gawk.
*/
/*
@@ -27,30 +27,53 @@
#ifdef HAVE_MPFR
-#if !defined(__GNU_MP_VERSION) || __GNU_MP_VERSION < 5
-typedef unsigned long int mp_bitcnt_t;
-#endif
-
#if !defined(MPFR_VERSION_MAJOR) || MPFR_VERSION_MAJOR < 3
typedef mp_exp_t mpfr_exp_t;
#endif
extern NODE **fmt_list; /* declared in eval.c */
-mpz_t mpzval; /* GMP integer type; used as temporary in many places */
-mpfr_t MNR;
-mpfr_t MFNR;
+mpz_t mpzval; /* GMP integer type, used as temporary in few places */
+mpz_t MNR;
+mpz_t MFNR;
int do_ieee_fmt; /* IEEE-754 floating-point emulation */
static mpfr_rnd_t get_rnd_mode(const char rmode);
-static NODE *get_bit_ops(NODE **p1, NODE **p2, const char *op);
static NODE *mpg_force_number(NODE *n);
static NODE *mpg_make_number(double);
static NODE *mpg_format_val(const char *format, int index, NODE *s);
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;
+
+/*
+ * PRECISION_MIN is the precision used to initialize _mpf_t1 and _mpf_t2.
+ * 64 bits should be enough for exact conversion of most integers to floats.
+ */
+
+#define PRECISION_MIN 64
+
+/* mf = { _mpf_t1, _mpf_t2 } */
+static inline mpfr_ptr mpg_tofloat(mpfr_ptr mf, mpz_ptr mz);
+/* T = {t1, t2} */
+#define MP_FLOAT(T) is_mpg_integer(T) ? mpg_tofloat(_mpf_##T, (T)->mpg_i) : (T)->mpg_numbr
+
/* init_mpfr --- set up MPFR related variables */
@@ -63,29 +86,42 @@ init_mpfr(const char *rmode)
make_number = mpg_make_number;
str2number = mpg_force_number;
format_val = mpg_format_val;
- mpz_init(mpzval);
- mpfr_init(MNR);
- mpfr_set_d(MNR, 0.0, RND_MODE);
- mpfr_init(MFNR);
- mpfr_set_d(MFNR, 0.0, RND_MODE);
+ cmp_numbers = mpg_cmp;
+
+ mpz_init(MNR);
+ 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);
+
register_exec_hook(mpg_interpret, 0);
}
-/* mpg_node --- allocate a node to store a MPFR number */
+/* mpg_node --- allocate a node to store MPFR float or GMP integer */
NODE *
-mpg_node()
+mpg_node(unsigned int tp)
{
NODE *r;
getnode(r);
r->type = Node_val;
- /* Initialize, set precision to the default precision, and value to NaN */
- mpfr_init(r->mpg_numbr);
-
+ if (tp == MPFN) {
+ /* Initialize, set precision to the default precision, and value to NaN */
+ mpfr_init(r->mpg_numbr);
+ r->flags = MPFN;
+ } else {
+ /* Initialize and set value to 0 */
+ mpz_init(r->mpg_i);
+ r->flags = MPZN;
+ }
+
r->valref = 1;
- r->flags = MALLOC|MPFN|NUMBER|NUMCUR;
+ r->flags |= MALLOC|NUMBER|NUMCUR;
r->stptr = NULL;
r->stlen = 0;
#if MBS_SUPPORT
@@ -95,78 +131,238 @@ mpg_node()
return r;
}
-/* mpg_make_number --- make a MPFR number node and initialize with a double */
+/*
+ * mpg_make_number --- make a arbitrary-precision number node
+ * and initialize with a C double
+ */
static NODE *
mpg_make_number(double x)
{
NODE *r;
- int tval;
+ double ival;
- r = mpg_node();
- tval = mpfr_set_d(r->mpg_numbr, x, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
+ if ((ival = double_to_int(x)) != x) {
+ int tval;
+ r = mpg_float();
+ tval = mpfr_set_d(r->mpg_numbr, x, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ } else {
+ r = mpg_integer();
+ mpz_set_d(r->mpg_i, ival);
+ }
return r;
}
-/* mpg_force_number --- force a value to be a MPFR number */
+/* mpg_strtoui --- assign arbitrary-precision integral value from a string */
-static NODE *
-mpg_force_number(NODE *n)
+int
+mpg_strtoui(mpz_ptr zi, char *str, size_t len, char **end, int base)
{
- char *cp, *cpend, *ptr;
- char save;
- int base = 10;
- unsigned int newflags = 0;
- int tval;
+ char *s = str;
+ char *start;
+ int ret = -1;
- if ((n->flags & (MPFN|NUMCUR)) == (MPFN|NUMCUR))
- return n;
+ /*
+ * mpz_set_str does not like leading 0x or 0X for hex (or 0 for octal)
+ * with a non-zero base argument.
+ */
+ if (base == 16 && len >= 2 && *s == '0' && (s[1] == 'x' || s[1] == 'X')) {
+ s += 2; len -= 2;
+ } else if (base == 8 && len >= 1 && *s == '0') {
+ s++; len--;
+ }
+ start = s;
+
+ while (len > 0) {
+ switch (*s) {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ break;
+ case '8':
+ case '9':
+ if (base == 8)
+ goto done;
+ break;
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ if (base == 16)
+ break;
+ default:
+ goto done;
+ }
+ s++; len--;
+ }
+done:
+ if (s > start) {
+ char save = *s;
+ *s = '\0';
+ ret = mpz_set_str(zi, start, base);
+ *s = save;
+ }
+ if (end != NULL)
+ *end = s;
+ return ret;
+}
- if (n->flags & MAYBE_NUM) {
- n->flags &= ~MAYBE_NUM;
- newflags = NUMBER;
+
+/* mpg_maybe_float --- test if a string may contain arbitrary-precision float */
+
+static int
+mpg_maybe_float(const char *str, int use_locale)
+{
+ int dec_point = '.';
+ const char *s = str;
+
+#if defined(HAVE_LOCALE_H)
+ /*
+ * loc.decimal_point may not have been initialized yet,
+ * so double check it before using it.
+ */
+ if (use_locale && loc.decimal_point != NULL && loc.decimal_point[0] != '\0')
+ dec_point = loc.decimal_point[0]; /* XXX --- assumes one char */
+#endif
+
+ if (strlen(s) >= 3
+ && ( ( (s[0] == 'i' || s[0] == 'I')
+ && (s[1] == 'n' || s[1] == 'N')
+ && (s[2] == 'f' || s[2] == 'F'))
+ || ( (s[0] == 'n' || s[0] == 'N')
+ && (s[1] == 'a' || s[1] == 'A')
+ && (s[2] == 'n' || s[2] == 'N'))))
+ return TRUE;
+
+ for (; *s != '\0'; s++) {
+ if (*s == dec_point || *s == 'e' || *s == 'E')
+ return TRUE;
}
- if ((n->flags & MPFN) == 0) {
- n->flags |= MPFN;
- mpfr_init(n->mpg_numbr);
+ return FALSE;
+}
+
+
+/* mpg_zero --- initialize with arbitrary-precision integer(GMP) and set value to zero */
+
+static inline void
+mpg_zero(NODE *n)
+{
+ if (is_mpg_float(n)) {
+ mpfr_clear(n->mpg_numbr);
+ n->flags &= ~MPFN;
}
- mpfr_set_d(n->mpg_numbr, 0.0, RND_MODE);
+ if (! is_mpg_integer(n)) {
+ mpz_init(n->mpg_i); /* this also sets its value to 0 */
+ n->flags |= MPZN;
+ } else
+ mpz_set_si(n->mpg_i, 0);
+}
- if (n->stlen == 0)
- return n;
+
+/* force_mpnum --- force a value to be a GMP integer or MPFR float */
+
+static int
+force_mpnum(NODE *n, int do_nondec, int use_locale)
+{
+ char *cp, *cpend, *ptr, *cp1;
+ char save;
+ int tval, base = 10;
+
+ if (n->stlen == 0) {
+ mpg_zero(n);
+ return FALSE;
+ }
cp = n->stptr;
cpend = n->stptr + n->stlen;
while (cp < cpend && isspace((unsigned char) *cp))
cp++;
- if (cp == cpend) /* only spaces */
- return n;
-
+ if (cp == cpend) { /* only spaces */
+ mpg_zero(n);
+ return FALSE;
+ }
+
save = *cpend;
*cpend = '\0';
- if (do_non_decimal_data && ! do_traditional)
- base = get_numbase(cp, TRUE);
+ if (*cp == '+' || *cp == '-')
+ cp1 = cp + 1;
+ else
+ cp1 = cp;
+
+ if (do_nondec)
+ base = get_numbase(cp1, use_locale);
+
+ if (! mpg_maybe_float(cp1, use_locale)) {
+ mpg_zero(n);
+ errno = 0;
+ mpg_strtoui(n->mpg_i, cp1, cpend - cp1, & ptr, base);
+ if (*cp == '-')
+ mpz_neg(n->mpg_i, n->mpg_i);
+ goto done;
+ }
+
+ if (is_mpg_integer(n)) {
+ mpz_clear(n->mpg_i);
+ n->flags &= ~MPZN;
+ }
+
+ if (! is_mpg_float(n)) {
+ mpfr_init(n->mpg_numbr);
+ n->flags |= MPFN;
+ }
errno = 0;
tval = mpfr_strtofr(n->mpg_numbr, cp, & ptr, base, RND_MODE);
IEEE_FMT(n->mpg_numbr, tval);
-
+done:
/* trailing space is OK for NUMBER */
while (isspace((unsigned char) *ptr))
ptr++;
*cpend = save;
- if (errno == 0 && ptr == cpend) {
+ if (errno == 0 && ptr == cpend)
+ return TRUE;
+ errno = 0;
+ return FALSE;
+}
+
+/* mpg_force_number --- force a value to be a multiple-precision number */
+
+static NODE *
+mpg_force_number(NODE *n)
+{
+ unsigned int newflags = 0;
+
+ if (is_mpg_number(n) && (n->flags & NUMCUR))
+ return n;
+
+ if (n->flags & MAYBE_NUM) {
+ n->flags &= ~MAYBE_NUM;
+ newflags = NUMBER;
+ }
+
+ if (force_mpnum(n, (do_non_decimal_data && ! do_traditional), TRUE)) {
n->flags |= newflags;
n->flags |= NUMCUR;
}
- errno = 0;
return n;
}
-
/* mpg_format_val --- format a numeric value based on format */
static NODE *
@@ -179,7 +375,7 @@ mpg_format_val(const char *format, int index, NODE *s)
dummy[1] = s;
oflags = s->flags;
- if (mpfr_integer_p(s->mpg_numbr)) {
+ if (is_mpg_integer(s) || mpfr_integer_p(s->mpg_numbr)) {
/* integral value, use %d */
r = format_tree("%d", 2, dummy, 2);
s->stfmt = -1;
@@ -200,80 +396,107 @@ mpg_format_val(const char *format, int index, NODE *s)
return s;
}
+/* mpg_cmp --- compare two numbers */
+
+int
+mpg_cmp(const NODE *t1, const NODE *t2)
+{
+ /*
+ * For the purposes of sorting, NaN is considered greater than
+ * any other value, and all NaN values are considered equivalent and equal.
+ */
+
+ if (is_mpg_float(t1)) {
+ if (is_mpg_float(t2)) {
+ if (mpfr_nan_p(t1->mpg_numbr))
+ return ! mpfr_nan_p(t2->mpg_numbr);
+ if (mpfr_nan_p(t2->mpg_numbr))
+ return -1;
+ return mpfr_cmp(t1->mpg_numbr, t2->mpg_numbr);
+ }
+ if (mpfr_nan_p(t1->mpg_numbr))
+ return 1;
+ return mpfr_cmp_z(t1->mpg_numbr, t2->mpg_i);
+ } else if (is_mpg_float(t2)) {
+ int ret;
+ if (mpfr_nan_p(t2->mpg_numbr))
+ return -1;
+ ret = mpfr_cmp_z(t2->mpg_numbr, t1->mpg_i);
+ return ret > 0 ? -1 : (ret < 0);
+ } else if (is_mpg_integer(t1)) {
+ return mpz_cmp(t1->mpg_i, t2->mpg_i);
+ }
+
+ /* t1 and t2 are AWKNUMs */
+ return cmp_awknums(t1, t2);
+}
+
/*
* mpg_update_var --- update NR or FNR.
- * NR_node->var_value(mpfr_t) = MNR(mpfr_t) * LONG_MAX + NR(long)
+ * NR_node->var_value(mpz_t) = MNR(mpz_t) * LONG_MAX + NR(long)
*/
-void
+NODE *
mpg_update_var(NODE *n)
{
NODE *val = n->var_value;
- long nl;
- mpfr_ptr nm;
+ long nr;
+ mpz_ptr nq;
if (n == NR_node) {
- nl = NR;
- nm = MNR;
+ nr = NR;
+ nq = MNR;
} else if (n == FNR_node) {
- nl = FNR;
- nm = MFNR;
+ nr = FNR;
+ nq = MFNR;
} else
cant_happen();
- if (mpfr_zero_p(nm)) {
- double d;
-
- /* Efficiency hack for NR < LONG_MAX */
- d = mpfr_get_d(val->mpg_numbr, RND_MODE);
- if (d != nl) {
+ if (mpz_sgn(nq) == 0) {
+ /* Efficiency hack similar to that for AWKNUM */
+ if (is_mpg_float(val) || mpz_get_si(val->mpg_i) != nr) {
unref(n->var_value);
- n->var_value = make_number(nl);
+ val = n->var_value = mpg_integer();
+ mpz_set_si(val->mpg_i, nr);
}
} else {
unref(n->var_value);
- val = n->var_value = mpg_node();
- mpfr_mul_si(val->mpg_numbr, nm, LONG_MAX, RND_MODE);
- mpfr_add_si(val->mpg_numbr, val->mpg_numbr, nl, RND_MODE);
+ val = n->var_value = mpg_integer();
+ mpz_set_si(val->mpg_i, nr);
+ mpz_addmul_ui(val->mpg_i, nq, LONG_MAX); /* val->mpg_i += nq * LONG_MAX */
}
+ return val;
}
-
/* mpg_set_var --- set NR or FNR */
long
mpg_set_var(NODE *n)
{
- long l;
- mpfr_ptr nm;
- mpfr_ptr p = n->var_value->mpg_numbr;
+ long nr;
+ mpz_ptr nq, r;
+ NODE *val = n->var_value;
int neg = FALSE;
if (n == NR_node)
- nm = MNR;
+ nq = MNR;
else if (n == FNR_node)
- nm = MFNR;
+ nq = MFNR;
else
cant_happen();
- mpfr_get_z(mpzval, p, MPFR_RNDZ);
- if (mpfr_signbit(p)) {
- /* It is a negative number ! */
- neg = TRUE;
- mpz_neg(mpzval, mpzval);
- }
- l = mpz_fdiv_q_ui(mpzval, mpzval, LONG_MAX);
- if (neg) {
- mpz_neg(mpzval, mpzval);
- l = -l;
+ if (is_mpg_integer(val))
+ r = val->mpg_i;
+ else {
+ /* convert float to integer */
+ mpfr_get_z(mpzval, val->mpg_numbr, MPFR_RNDZ);
+ r = mpzval;
}
-
- mpfr_set_z(nm, mpzval, RND_MODE); /* quotient (MNR) */
- return l; /* remainder (NR) */
+ nr = mpz_fdiv_q_ui(nq, r, LONG_MAX); /* nq (MNR or MFNR) is quotient */
+ return nr; /* remainder (NR or FNR) */
}
-
/* set_PREC --- update MPFR PRECISION related variables when PREC assigned to */
void
@@ -358,20 +581,20 @@ get_rnd_mode(const char rmode)
switch (rmode) {
case 'N':
case 'n':
- return MPFR_RNDN; /* round to nearest */
+ return MPFR_RNDN; /* round to nearest (IEEE-754 roundTiesToEven) */
case 'Z':
case 'z':
- return MPFR_RNDZ; /* round toward zero */
+ return MPFR_RNDZ; /* round toward zero (IEEE-754 roundTowardZero) */
case 'U':
case 'u':
- return MPFR_RNDU; /* round toward plus infinity */
+ return MPFR_RNDU; /* round toward plus infinity (IEEE-754 roundTowardPositive) */
case 'D':
case 'd':
- return MPFR_RNDD; /* round toward minus infinity */
+ return MPFR_RNDD; /* round toward minus infinity (IEEE-754 roundTowardNegative) */
#if defined(MPFR_VERSION_MAJOR) && MPFR_VERSION_MAJOR > 2
case 'A':
case 'a':
- return MPFR_RNDA; /* round away from zero */
+ return MPFR_RNDA; /* round away from zero (IEEE-754 roundTiesToAway) */
#endif
default:
break;
@@ -407,12 +630,12 @@ format_ieee(mpfr_ptr x, int tval)
/*
* The MPFR doc says that it's our responsibility to make sure all numbers
* including those previously created are in range after we've changed the
- * exponent range. Most MPFR operations and functions requires
+ * exponent range. Most MPFR operations and functions require
* the input arguments to have exponents within the current exponent range.
* Any argument outside the range results in a MPFR assertion failure
* like this:
*
- * $] gawk -M 'BEGIN { x=1.0e-10000; print x+0; PREC="double"; print x+0}'
+ * $ gawk -M 'BEGIN { x=1.0e-10000; print x+0; PREC="double"; print x+0}'
* 1e-10000
* init2.c:52: MPFR assertion failed ....
*
@@ -423,7 +646,7 @@ format_ieee(mpfr_ptr x, int tval)
*
* When gawk starts, the exponent range is the MPFR default
* [MPFR_EMIN_DEFAULT, MPFR_EMAX_DEFAULT]. Any number that gawk
- * creates must have exponent in this range (excluding infinities, NANs and zeros).
+ * creates must have exponent in this range (excluding infinities, NaNs and zeros).
* Each MPFR operation or function is performed with this default exponent
* range.
*
@@ -444,86 +667,13 @@ format_ieee(mpfr_ptr x, int tval)
}
-/* get_bit_ops --- get the numeric operands of a binary function */
-
-static NODE *
-get_bit_ops(NODE **p1, NODE **p2, const char *op)
-{
- NODE *t1, *t2;
- mpfr_ptr left, right;
-
- *p2 = t2 = POP_SCALAR();
- *p1 = t1 = POP_SCALAR();
-
- if (do_lint) {
- if ((t1->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("%s: received non-numeric first argument"), op);
- if ((t2->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("%s: received non-numeric second argument"), op);
- }
-
- left = force_number(t1)->mpg_numbr;
- right = force_number(t2)->mpg_numbr;
-
- if (! mpfr_number_p(left)) {
- /* [+-]inf or NaN */
- DEREF(t2);
- return t1;
- }
-
- if (! mpfr_number_p(right)) {
- /* [+-]inf or NaN */
- DEREF(t1);
- return t2;
- }
-
- if (do_lint) {
- if (mpfr_signbit(left) || mpfr_signbit(right))
- lintwarn("%s",
- mpg_fmt(_("%s(%Rg, %Rg): negative values will give strange results"),
- op, left, right)
- );
- if (! mpfr_integer_p(left) || ! mpfr_integer_p(right))
- lintwarn("%s",
- mpg_fmt(_("%s(%Rg, %Rg): fractional values will be truncated"),
- op, left, right)
- );
- }
- return NULL;
-}
-
-
-/* do_mpfr_and --- perform an & operation */
-
-NODE *
-do_mpfr_and(int nargs)
-{
- NODE *t1, *t2, *res;
- mpz_t z;
-
- if ((res = get_bit_ops(& t1, & t2, "and")) != NULL)
- return res;
-
- mpz_init(z);
- mpfr_get_z(mpzval, t1->mpg_numbr, MPFR_RNDZ); /* float to integer conversion */
- mpfr_get_z(z, t2->mpg_numbr, MPFR_RNDZ); /* Same */
- mpz_and(z, mpzval, z);
-
- res = mpg_node();
- mpfr_set_z(res->mpg_numbr, z, RND_MODE); /* integer to float conversion */
- mpz_clear(z);
-
- DEREF(t1);
- DEREF(t2);
- return res;
-}
-
/* do_mpfr_atan2 --- do the atan2 function */
NODE *
do_mpfr_atan2(int nargs)
{
NODE *t1, *t2, *res;
+ mpfr_ptr p1, p2;
int tval;
t2 = POP_SCALAR();
@@ -538,9 +688,11 @@ do_mpfr_atan2(int nargs)
force_number(t1);
force_number(t2);
- res = mpg_node();
+ p1 = MP_FLOAT(t1);
+ p2 = MP_FLOAT(t2);
+ res = mpg_float();
/* See MPFR documentation for handling of special values like +inf as an argument */
- tval = mpfr_atan2(res->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
+ tval = mpfr_atan2(res->mpg_numbr, p1, p2, RND_MODE);
IEEE_FMT(res->mpg_numbr, tval);
DEREF(t1);
@@ -549,53 +701,19 @@ do_mpfr_atan2(int nargs)
}
-/* do_mpfr_compl --- perform a ~ operation */
-
-NODE *
-do_mpfr_compl(int nargs)
-{
- NODE *tmp, *r;
- mpfr_ptr p;
-
- tmp = POP_SCALAR();
- if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("compl: received non-numeric argument"));
-
- p = force_number(tmp)->mpg_numbr;
- if (! mpfr_number_p(p)) {
- /* [+-]inf or NaN */
- return tmp;
- }
-
- if (do_lint) {
- if (mpfr_signbit(p))
- lintwarn("%s",
- mpg_fmt(_("compl(%Rg): negative value will give strange results"), p)
- );
- if (! mpfr_integer_p(p))
- lintwarn("%s",
- mpg_fmt(_("comp(%Rg): fractional value will be truncated"), p)
- );
- }
- mpfr_get_z(mpzval, p, MPFR_RNDZ);
- mpz_com(mpzval, mpzval);
- r = mpg_node();
- mpfr_set_z(r->mpg_numbr, mpzval, RND_MODE);
- DEREF(tmp);
- return r;
-}
-
-#define SPEC_MATH(X) \
-NODE *tmp, *res; \
-int tval; \
-tmp = POP_SCALAR(); \
-if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0) \
- lintwarn(_("%s: received non-numeric argument"), #X); \
-force_number(tmp); \
-res = mpg_node(); \
-tval = mpfr_##X(res->mpg_numbr, tmp->mpg_numbr, RND_MODE); \
-IEEE_FMT(res->mpg_numbr, tval); \
-DEREF(tmp); \
+#define SPEC_MATH(X) \
+NODE *t1, *res; \
+mpfr_ptr p1; \
+int tval; \
+t1 = POP_SCALAR(); \
+if (do_lint && (t1->flags & (NUMCUR|NUMBER)) == 0) \
+ lintwarn(_("%s: received non-numeric argument"), #X); \
+force_number(t1); \
+p1 = MP_FLOAT(t1); \
+res = mpg_float(); \
+tval = mpfr_##X(res->mpg_numbr, p1, RND_MODE); \
+IEEE_FMT(res->mpg_numbr, tval); \
+DEREF(t1); \
return res
@@ -650,89 +768,251 @@ do_mpfr_int(int nargs)
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("int: received non-numeric argument"));
force_number(tmp);
- if (! mpfr_number_p(tmp->mpg_numbr)) {
- /* [+-]inf or NaN */
- return tmp;
+
+ if (is_mpg_integer(tmp)) {
+ r = mpg_integer();
+ mpz_set(r->mpg_i, tmp->mpg_i);
+ } else {
+ if (! mpfr_number_p(tmp->mpg_numbr)) {
+ /* [+-]inf or NaN */
+ return tmp;
+ }
+
+ r = mpg_integer();
+ mpfr_get_z(r->mpg_i, tmp->mpg_numbr, MPFR_RNDZ);
}
- mpfr_get_z(mpzval, tmp->mpg_numbr, MPFR_RNDZ);
- r = mpg_node();
- mpfr_set_z(r->mpg_numbr, mpzval, RND_MODE);
+
DEREF(tmp);
return r;
}
-
-/* do_mpfr_lshift --- perform a << operation */
+/* do_mpfr_compl --- perform a ~ operation */
NODE *
-do_mpfr_lshift(int nargs)
+do_mpfr_compl(int nargs)
{
- NODE *t1, *t2, *res;
- mp_bitcnt_t shift;
+ NODE *tmp, *r;
+ mpz_ptr zptr;
- if ((res = get_bit_ops(& t1, & t2, "lshift")) != NULL)
- return res;
+ tmp = POP_SCALAR();
+ if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
+ lintwarn(_("compl: received non-numeric argument"));
- mpfr_get_z(mpzval, t1->mpg_numbr, MPFR_RNDZ); /* mpfr_t (float) => mpz_t (integer) conversion */
- shift = mpfr_get_ui(t2->mpg_numbr, MPFR_RNDZ); /* mpfr_t (float) => unsigned long conversion */
- mpz_mul_2exp(mpzval, mpzval, shift); /* mpzval = mpzval * 2^shift */
+ force_number(tmp);
+ if (is_mpg_float(tmp)) {
+ mpfr_ptr p = tmp->mpg_numbr;
- res = mpg_node();
- mpfr_set_z(res->mpg_numbr, mpzval, RND_MODE); /* integer to float conversion */
- DEREF(t1);
- DEREF(t2);
- return res;
+ if (! mpfr_number_p(p)) {
+ /* [+-]inf or NaN */
+ return tmp;
+ }
+ if (do_lint) {
+ if (mpfr_sgn(p) < 0)
+ lintwarn("%s",
+ mpg_fmt(_("compl(%Rg): negative value will give strange results"), p)
+ );
+ if (! mpfr_integer_p(p))
+ lintwarn("%s",
+ mpg_fmt(_("comp(%Rg): fractional value will be truncated"), p)
+ );
+ }
+
+ mpfr_get_z(mpzval, p, MPFR_RNDZ); /* float to integer conversion */
+ zptr = mpzval;
+ } else {
+ /* (tmp->flags & MPZN) != 0 */
+ zptr = tmp->mpg_i;
+ if (do_lint) {
+ if (mpz_sgn(zptr) < 0)
+ lintwarn("%s",
+ mpg_fmt(_("cmpl(%Zd): negative values will give strange results"), zptr)
+ );
+ }
+ }
+
+ r = mpg_integer();
+ mpz_com(r->mpg_i, zptr);
+ DEREF(tmp);
+ return r;
}
-/* do_mpfr_or --- perform an | operation */
+/*
+ * 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.
+ */
-NODE *
-do_mpfr_or(int nargs)
+static NODE *
+get_bit_ops(const char *op)
{
- NODE *t1, *t2, *res;
- mpz_t z;
+ _tz2 = POP_SCALAR();
+ _tz1 = POP_SCALAR();
- if ((res = get_bit_ops(& t1, & t2, "or")) != NULL)
- return res;
+ 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);
+ }
- mpz_init(z);
- mpfr_get_z(mpzval, t1->mpg_numbr, MPFR_RNDZ);
- mpfr_get_z(z, t2->mpg_numbr, MPFR_RNDZ);
- mpz_ior(z, mpzval, z);
+ force_number(_tz1);
+ force_number(_tz2);
+
+ if (is_mpg_float(_tz1)) {
+ mpfr_ptr left = _tz1->mpg_numbr;
+ if (! mpfr_number_p(left)) {
+ /* inf or NaN */
+ NODE *res;
+ res = mpg_float();
+ mpfr_set(res->mpg_numbr, _tz1->mpg_numbr, RND_MODE);
+ return res;
+ }
- res = mpg_node();
- mpfr_set_z(res->mpg_numbr, z, RND_MODE);
- mpz_clear(z);
+ if (do_lint) {
+ if (mpfr_sgn(left) < 0)
+ lintwarn("%s",
+ mpg_fmt(_("%s(%Rg, ..): negative values will give strange results"),
+ op, left)
+ );
+ if (! mpfr_integer_p(left))
+ lintwarn("%s",
+ mpg_fmt(_("%s(%Rg, ..): fractional values will be truncated"),
+ op, 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)
+ );
+ }
+ }
- DEREF(t1);
- DEREF(t2);
- return res;
+ 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, RND_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)
+ );
+ }
+
+ 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)
+ );
+ }
+ }
+
+ return NULL;
}
+/* do_mpfr_lshift --- perform a << operation */
+
+NODE *
+do_mpfr_lshift(int nargs)
+{
+ NODE *res;
+ unsigned long shift;
+
+ if ((res = get_bit_ops("lshift")) == 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.
+ */
+
+ 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();
+ return res;
+}
/* do_mpfr_rshift --- perform a >> operation */
NODE *
do_mpfr_rhift(int nargs)
{
- NODE *t1, *t2, *res;
- mp_bitcnt_t shift;
+ NODE *res;
+ unsigned long shift;
+
+ 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.
+ */
+
+ 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();
+ return res;
+}
- if ((res = get_bit_ops(& t1, & t2, "rshift")) != NULL)
- return res;
+/* do_mpfr_and --- perform an & operation */
- mpfr_get_z(mpzval, t1->mpg_numbr, MPFR_RNDZ); /* mpfr_t (float) => mpz_t (integer) conversion */
- shift = mpfr_get_ui(t2->mpg_numbr, MPFR_RNDZ); /* mpfr_t (float) => unsigned long conversion */
- mpz_fdiv_q_2exp(mpzval, mpzval, shift); /* mpzval = mpzval / 2^shift, round towards −inf */
+NODE *
+do_mpfr_and(int nargs)
+{
+ NODE *res;
- res = mpg_node();
- mpfr_set_z(res->mpg_numbr, mpzval, RND_MODE); /* integer to float conversion */
- DEREF(t1);
- DEREF(t2);
+ if ((res = get_bit_ops("and")) == NULL) {
+ res = mpg_integer();
+ mpz_and(res->mpg_i, mpz1, mpz2);
+ }
+ free_bit_ops();
return res;
}
+/* do_mpfr_or --- perform an | operation */
+
+NODE *
+do_mpfr_or(int nargs)
+{
+ NODE *res;
+
+ if ((res = get_bit_ops("or")) == NULL) {
+ res = mpg_integer();
+ mpz_ior(res->mpg_i, mpz1, mpz2);
+ }
+ free_bit_ops();
+ return res;
+}
/* do_mpfr_strtonum --- the strtonum function */
@@ -740,48 +1020,44 @@ NODE *
do_mpfr_strtonum(int nargs)
{
NODE *tmp, *r;
- int base, tval;
tmp = POP_SCALAR();
- r = mpg_node();
- if ((tmp->flags & (NUMBER|NUMCUR)) != 0)
- tval = mpfr_set(r->mpg_numbr, tmp->mpg_numbr, RND_MODE);
- else if ((base = get_numbase(tmp->stptr, use_lc_numeric)) != 10) {
- tval = mpfr_strtofr(r->mpg_numbr, tmp->stptr, NULL, base, RND_MODE);
- errno = 0;
+ if ((tmp->flags & (NUMBER|NUMCUR)) == 0) {
+ r = mpg_integer(); /* will be changed to MPFR float if necessary in force_mpnum() */
+ r->stptr = tmp->stptr;
+ r->stlen = tmp->stlen;
+ force_mpnum(r, TRUE, use_lc_numeric);
+ r->stptr = NULL;
+ r->stlen = 0;
} else {
(void) force_number(tmp);
- tval = mpfr_set(r->mpg_numbr, tmp->mpg_numbr, RND_MODE);
+ if (is_mpg_float(tmp)) {
+ int tval;
+ r = mpg_float();
+ tval = mpfr_set(r->mpg_numbr, tmp->mpg_numbr, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ } else {
+ r = mpg_integer();
+ mpz_set(r->mpg_i, tmp->mpg_i);
+ }
}
- IEEE_FMT(r->mpg_numbr, tval);
DEREF(tmp);
return r;
}
-
/* do_mpfr_xor --- perform an ^ operation */
NODE *
do_mpfr_xor(int nargs)
{
- NODE *t1, *t2, *res;
- mpz_t z;
-
- if ((res = get_bit_ops(& t1, & t2, "xor")) != NULL)
- return res;
-
- mpz_init(z);
- mpfr_get_z(mpzval, t1->mpg_numbr, MPFR_RNDZ);
- mpfr_get_z(z, t2->mpg_numbr, MPFR_RNDZ);
- mpz_xor(z, mpzval, z);
-
- res = mpg_node();
- mpfr_set_z(res->mpg_numbr, z, RND_MODE);
- mpz_clear(z);
+ NODE *res;
- DEREF(t1);
- DEREF(t2);
+ if ((res = get_bit_ops("xor")) == NULL) {
+ res = mpg_integer();
+ mpz_xor(res->mpg_i, mpz1, mpz2);
+ }
+ free_bit_ops();
return res;
}
@@ -799,15 +1075,24 @@ do_mpfr_rand(int nargs ATTRIBUTE_UNUSED)
int tval;
if (firstrand) {
+#if 0
/* Choose the default algorithm */
gmp_randinit_default(state);
+#endif
+ /*
+ * Choose a specific (Mersenne Twister) algorithm in case the default
+ * changes in the future.
+ */
+
+ gmp_randinit_mt(state);
+
mpz_init(seed);
- mpz_set_ui(seed, 1L);
+ mpz_set_ui(seed, 1);
/* seed state */
gmp_randseed(state, seed);
firstrand = FALSE;
}
- res = mpg_node();
+ res = mpg_float();
tval = mpfr_urandomb(res->mpg_numbr, state);
IEEE_FMT(res->mpg_numbr, tval);
return res;
@@ -820,20 +1105,27 @@ NODE *
do_mpfr_srand(int nargs)
{
NODE *res;
- int tval;
if (firstrand) {
+#if 0
/* Choose the default algorithm */
gmp_randinit_default(state);
+#endif
+ /*
+ * Choose a specific algorithm (Mersenne Twister) in case default
+ * changes in the future.
+ */
+
+ gmp_randinit_mt(state);
+
mpz_init(seed);
- mpz_set_ui(seed, 1L);
+ mpz_set_ui(seed, 1);
/* No need to seed state, will change it below */
firstrand = FALSE;
}
- res = mpg_node();
- tval = mpfr_set_z(res->mpg_numbr, seed, RND_MODE); /* previous seed */
- IEEE_FMT(res->mpg_numbr, tval);
+ res = mpg_integer();
+ mpz_set(res->mpg_i, seed); /* previous seed */
if (nargs == 0)
mpz_set_ui(seed, (unsigned long) time((time_t *) 0));
@@ -843,7 +1135,10 @@ do_mpfr_srand(int nargs)
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("srand: received non-numeric argument"));
force_number(tmp);
- mpfr_get_z(seed, tmp->mpg_numbr, MPFR_RNDZ);
+ if (is_mpg_float(tmp))
+ mpfr_get_z(seed, tmp->mpg_numbr, MPFR_RNDZ);
+ else /* MP integer */
+ mpz_set(seed, tmp->mpg_i);
DEREF(tmp);
}
@@ -852,8 +1147,209 @@ do_mpfr_srand(int nargs)
}
/*
+ * mpg_tofloat --- convert an arbitrary-precision integer operand to
+ * a float without loss of precision. It is assumed that the
+ * MPFR variable has already been initialized.
+ */
+
+static inline mpfr_ptr
+mpg_tofloat(mpfr_ptr mf, mpz_ptr mz)
+{
+ size_t prec;
+
+ /*
+ * When implicitely converting a GMP integer operand to a MPFR float, use
+ * a precision sufficiently large to hold the converted value exactly.
+ *
+ * $ ./gawk -M 'BEGIN { print 13 % 2 }'
+ * 1
+ * If the user-specified precision is used to convert the integer 13 to a
+ * float, one will get:
+ * $ ./gawk -M 'BEGIN { PREC=2; print 13 % 2.0 }'
+ * 0
+ */
+
+ prec = mpz_sizeinbase(mz, 2); /* most significant 1 bit position starting at 1 */
+ if (prec > PRECISION_MIN) {
+ prec -= (size_t) mpz_scan1(mz, 0); /* least significant 1 bit index starting at 0 */
+ if (prec > MPFR_PREC_MAX)
+ prec = MPFR_PREC_MAX;
+ if (prec > PRECISION_MIN)
+ mpfr_set_prec(mf, prec);
+ }
+
+ mpfr_set_z(mf, mz, RND_MODE);
+ return mf;
+}
+
+
+/* mpg_add --- add arbitrary-precision numbers */
+
+static NODE *
+mpg_add(NODE *t1, NODE *t2)
+{
+ NODE *r;
+ int tval;
+
+ if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
+ r = mpg_integer();
+ mpz_add(r->mpg_i, t1->mpg_i, t2->mpg_i);
+ } else {
+ r = mpg_float();
+ if (is_mpg_integer(t2))
+ tval = mpfr_add_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, RND_MODE);
+ else if (is_mpg_integer(t1))
+ tval = mpfr_add_z(r->mpg_numbr, t2->mpg_numbr, t1->mpg_i, RND_MODE);
+ else
+ tval = mpfr_add(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
+ return r;
+}
+
+/* mpg_sub --- subtract arbitrary-precision numbers */
+
+static NODE *
+mpg_sub(NODE *t1, NODE *t2)
+{
+ NODE *r;
+ int tval;
+
+ if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
+ r = mpg_integer();
+ mpz_sub(r->mpg_i, t1->mpg_i, t2->mpg_i);
+ } else {
+ r = mpg_float();
+ if (is_mpg_integer(t2))
+ tval = mpfr_sub_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, RND_MODE);
+ else if (is_mpg_integer(t1)) {
+#if (!defined(MPFR_VERSION) || (MPFR_VERSION < MPFR_VERSION_NUM(3,1,0)))
+ NODE *tmp = t1;
+ t1 = t2;
+ t2 = tmp;
+ tval = mpfr_sub_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, RND_MODE);
+ tval = mpfr_neg(r->mpg_numbr, r->mpg_numbr, RND_MODE);
+ t2 = t1;
+ t1 = tmp;
+#else
+ tval = mpfr_z_sub(r->mpg_numbr, t1->mpg_i, t2->mpg_numbr, RND_MODE);
+#endif
+ } else
+ tval = mpfr_sub(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
+ return r;
+}
+
+/* mpg_mul --- multiply arbitrary-precision numbers */
+
+static NODE *
+mpg_mul(NODE *t1, NODE *t2)
+{
+ NODE *r;
+ int tval;
+
+ if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
+ r = mpg_integer();
+ mpz_mul(r->mpg_i, t1->mpg_i, t2->mpg_i);
+ } else {
+ r = mpg_float();
+ if (is_mpg_integer(t2))
+ tval = mpfr_mul_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, RND_MODE);
+ else if (is_mpg_integer(t1))
+ tval = mpfr_mul_z(r->mpg_numbr, t2->mpg_numbr, t1->mpg_i, RND_MODE);
+ else
+ tval = mpfr_mul(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
+ return r;
+}
+
+
+/* mpg_pow --- exponentiation involving arbitrary-precision numbers */
+
+static NODE *
+mpg_pow(NODE *t1, NODE *t2)
+{
+ NODE *r;
+ int tval;
+
+ if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
+ if (mpz_sgn(t2->mpg_i) >= 0 && mpz_fits_ulong_p(t2->mpg_i)) {
+ r = mpg_integer();
+ mpz_pow_ui(r->mpg_i, t1->mpg_i, mpz_get_ui(t2->mpg_i));
+ } else {
+ mpfr_ptr p1, p2;
+ p1 = MP_FLOAT(t1);
+ p2 = MP_FLOAT(t2);
+ r = mpg_float();
+ tval = mpfr_pow(r->mpg_numbr, p1, p2, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
+ } else {
+ r = mpg_float();
+ if (is_mpg_integer(t2))
+ tval = mpfr_pow_z(r->mpg_numbr, t1->mpg_numbr, t2->mpg_i, RND_MODE);
+ else {
+ mpfr_ptr p1;
+ p1 = MP_FLOAT(t1);
+ tval = mpfr_pow(r->mpg_numbr, p1, t2->mpg_numbr, RND_MODE);
+ }
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
+ return r;
+}
+
+/* mpg_div --- arbitrary-precision division */
+
+static NODE *
+mpg_div(NODE *t1, NODE *t2)
+{
+ NODE *r;
+ int tval;
+
+ if (is_mpg_integer(t1) && is_mpg_integer(t2)
+ && (mpz_sgn(t2->mpg_i) != 0) /* not dividing by 0 */
+ && mpz_divisible_p(t1->mpg_i, t2->mpg_i)
+ ) {
+ r = mpg_integer();
+ mpz_divexact(r->mpg_i, t1->mpg_i, t2->mpg_i);
+ } else {
+ mpfr_ptr p1, p2;
+ p1 = MP_FLOAT(t1);
+ p2 = MP_FLOAT(t2);
+ r = mpg_float();
+ tval = mpfr_div(r->mpg_numbr, p1, p2, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
+ return r;
+}
+
+/* mpg_mod --- modulus operation with arbitrary-precision numbers */
+
+static NODE *
+mpg_mod(NODE *t1, NODE *t2)
+{
+ NODE *r;
+ int tval;
+
+ if (is_mpg_integer(t1) && is_mpg_integer(t2)) {
+ r = mpg_integer();
+ mpz_mod(r->mpg_i, t1->mpg_i, t2->mpg_i);
+ } else {
+ mpfr_ptr p1, p2;
+ p1 = MP_FLOAT(t1);
+ p2 = MP_FLOAT(t2);
+ r = mpg_float();
+ tval = mpfr_fmod(r->mpg_numbr, p1, p2, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ }
+ return r;
+}
+
+/*
* mpg_interpret --- pre-exec hook in the interpreter. Handles
- * arithmetic operations with MPFR numbers.
+ * arithmetic operations with MPFR/GMP numbers.
*/
static int
@@ -864,9 +1360,7 @@ mpg_interpret(INSTRUCTION **cp)
NODE *r = NULL;
NODE *t1, *t2;
NODE **lhs;
- AWKNUM x;
- mpfr_ptr p1, p2;
- int tval;
+ int tval; /* the ternary value returned by a MPFR function */
switch ((op = pc->opcode)) {
case Op_plus_i:
@@ -876,9 +1370,7 @@ mpg_interpret(INSTRUCTION **cp)
t2 = POP_NUMBER();
plus:
t1 = TOP_NUMBER();
- r = mpg_node();
- tval = mpfr_add(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
+ r = mpg_add(t1, t2);
DEREF(t1);
if (op == Op_plus)
DEREF(t2);
@@ -892,9 +1384,7 @@ plus:
t2 = POP_NUMBER();
minus:
t1 = TOP_NUMBER();
- r = mpg_node();
- tval = mpfr_sub(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
+ r = mpg_sub(t1, t2);
DEREF(t1);
if (op == Op_minus)
DEREF(t2);
@@ -908,9 +1398,7 @@ minus:
t2 = POP_NUMBER();
times:
t1 = TOP_NUMBER();
- r = mpg_node();
- tval = mpfr_mul(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
+ r = mpg_mul(t1, t2);
DEREF(t1);
if (op == Op_times)
DEREF(t2);
@@ -924,9 +1412,7 @@ times:
t2 = POP_NUMBER();
exp:
t1 = TOP_NUMBER();
- r = mpg_node();
- tval = mpfr_pow(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
+ r = mpg_pow(t1, t2);
DEREF(t1);
if (op == Op_exp)
DEREF(t2);
@@ -940,9 +1426,7 @@ exp:
t2 = POP_NUMBER();
quotient:
t1 = TOP_NUMBER();
- r = mpg_node();
- tval = mpfr_div(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
+ r = mpg_div(t1, t2);
DEREF(t1);
if (op == Op_quotient)
DEREF(t2);
@@ -956,9 +1440,7 @@ quotient:
t2 = POP_NUMBER();
mod:
t1 = TOP_NUMBER();
- r = mpg_node();
- tval = mpfr_fmod(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
+ r = mpg_mod(t1, t2);
DEREF(t1);
if (op == Op_mod)
DEREF(t2);
@@ -967,56 +1449,84 @@ mod:
case Op_preincrement:
case Op_predecrement:
- x = op == Op_preincrement ? 1.0 : -1.0;
lhs = TOP_ADDRESS();
t1 = *lhs;
force_number(t1);
-#if 0
- /*
- * The optimizations for fixed precision do not always
- * work the same way in arbitrary precision. With this optimization on,
- * gawk -M 'BEGIN { PREC=53; i=2^53; PREC=113; ++i; print i}'
- * prints 2^53 instead of 2^53+1.
- */
+ if (is_mpg_integer(t1)) {
+ if (t1->valref == 1 && t1->flags == (MALLOC|MPZN|NUMCUR|NUMBER))
+ /* Efficiency hack. Big speed-up (> 30%) in a tight loop */
+ r = t1;
+ else
+ r = *lhs = mpg_integer();
+ if (op == Op_preincrement)
+ mpz_add_ui(r->mpg_i, t1->mpg_i, 1);
+ else
+ mpz_sub_ui(r->mpg_i, t1->mpg_i, 1);
+ } else {
- if (t1->valref == 1 && t1->flags == (MALLOC|MPFN|NUMCUR|NUMBER)) {
- /* optimization */
- tval = mpfr_add_d(t1->mpg_numbr, t1->mpg_numbr, x, RND_MODE);
- IEEE_FMT(t1->mpg_numbr, tval);
- r = t1;
+ /*
+ * An optimization like the one above is not going to work
+ * for a floating-point number. With it,
+ * gawk -M 'BEGIN { PREC=53; i=2^53+0.0; PREC=113; ++i; print i}'
+ * will output 2^53 instead of 2^53+1.
+ */
+
+ r = *lhs = mpg_float();
+ tval = mpfr_add_si(r->mpg_numbr, t1->mpg_numbr,
+ op == Op_preincrement ? 1 : -1,
+ RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
}
-#endif
- r = *lhs = mpg_node();
- tval = mpfr_add_d(r->mpg_numbr, t1->mpg_numbr, x, RND_MODE);
- IEEE_FMT(r->mpg_numbr, tval);
- unref(t1);
+ if (r != t1)
+ unref(t1);
UPREF(r);
REPLACE(r);
break;
case Op_postincrement:
case Op_postdecrement:
- x = op == Op_postincrement ? 1.0 : -1.0;
lhs = TOP_ADDRESS();
t1 = *lhs;
force_number(t1);
- r = mpg_node();
- tval = mpfr_set(r->mpg_numbr, t1->mpg_numbr, RND_MODE); /* r = t1 */
- IEEE_FMT(r->mpg_numbr, tval);
- t2 = *lhs = mpg_node();
- tval = mpfr_add_d(t2->mpg_numbr, t1->mpg_numbr, x, RND_MODE);
- IEEE_FMT(t2->mpg_numbr, tval);
- unref(t1);
+
+ if (is_mpg_integer(t1)) {
+ r = mpg_integer();
+ mpz_set(r->mpg_i, t1->mpg_i);
+ if (t1->valref == 1 && t1->flags == (MALLOC|MPZN|NUMCUR|NUMBER))
+ /* Efficiency hack. Big speed-up (> 30%) in a tight loop */
+ t2 = t1;
+ else
+ t2 = *lhs = mpg_integer();
+ if (op == Op_postincrement)
+ mpz_add_ui(t2->mpg_i, t1->mpg_i, 1);
+ else
+ mpz_sub_ui(t2->mpg_i, t1->mpg_i, 1);
+ } else {
+ r = mpg_float();
+ tval = mpfr_set(r->mpg_numbr, t1->mpg_numbr, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ t2 = *lhs = mpg_float();
+ tval = mpfr_add_si(t2->mpg_numbr, t1->mpg_numbr,
+ op == Op_postincrement ? 1 : -1,
+ RND_MODE);
+ IEEE_FMT(t2->mpg_numbr, tval);
+ }
+ if (t2 != t1)
+ unref(t1);
REPLACE(r);
break;
case Op_unary_minus:
t1 = TOP_NUMBER();
- r = mpg_node();
- mpfr_set(r->mpg_numbr, t1->mpg_numbr, RND_MODE); /* r = t1 */
- tval = mpfr_neg(r->mpg_numbr, r->mpg_numbr, RND_MODE); /* change sign */
- IEEE_FMT(r->mpg_numbr, tval);
+ if (is_mpg_float(t1)) {
+ r = mpg_float();
+ tval = mpfr_neg(r->mpg_numbr, t1->mpg_numbr, RND_MODE);
+ IEEE_FMT(r->mpg_numbr, tval);
+ } else {
+ r = mpg_integer();
+ mpz_neg(r->mpg_i, t1->mpg_i);
+ }
DEREF(t1);
REPLACE(r);
break;
@@ -1029,41 +1539,35 @@ mod:
case Op_assign_exp:
lhs = POP_ADDRESS();
t1 = *lhs;
- p1 = force_number(t1)->mpg_numbr;
-
+ force_number(t1);
t2 = TOP_NUMBER();
- p2 = t2->mpg_numbr;
- r = mpg_node();
switch (op) {
case Op_assign_plus:
- tval = mpfr_add(r->mpg_numbr, p1, p2, RND_MODE);
+ r = mpg_add(t1, t2);
break;
case Op_assign_minus:
- tval = mpfr_sub(r->mpg_numbr, p1, p2, RND_MODE);
+ r = mpg_sub(t1, t2);
break;
case Op_assign_times:
- tval = mpfr_mul(r->mpg_numbr, p1, p2, RND_MODE);
+ r = mpg_mul(t1, t2);
break;
case Op_assign_quotient:
- tval = mpfr_div(r->mpg_numbr, p1, p2, RND_MODE);
+ r = mpg_div(t1, t2);
break;
case Op_assign_mod:
- tval = mpfr_fmod(r->mpg_numbr, p1, p2, RND_MODE);
+ r = mpg_mod(t1, t2);
break;
case Op_assign_exp:
- tval = mpfr_pow(r->mpg_numbr, p1, p2, RND_MODE);
+ r = mpg_pow(t1, t2);
break;
default:
cant_happen();
}
- IEEE_FMT(r->mpg_numbr, tval);
-
DEREF(t2);
unref(*lhs);
*lhs = r;
-
UPREF(r);
REPLACE(r);
break;
diff --git a/msg.c b/msg.c
index e651c8c1..78818187 100644
--- a/msg.c
+++ b/msg.c
@@ -64,15 +64,16 @@ err(const char *s, const char *emsg, va_list argp)
}
#ifdef HAVE_MPFR
- if (FNR_node && (FNR_node->var_value->flags & MPFN) != 0) {
- mpg_update_var(FNR_node);
- mpfr_get_z(mpzval, FNR_node->var_value->mpg_numbr, MPFR_RNDZ);
- if (mpz_sgn(mpzval) > 0) {
+ if (FNR_node && is_mpg_number(FNR_node->var_value)) {
+ NODE *val;
+ val = mpg_update_var(FNR_node);
+ assert((val->flags & MPZN) != 0);
+ if (mpz_sgn(val->mpg_i) > 0) {
file = FILENAME_node->var_value->stptr;
(void) putc('(', stderr);
if (file)
(void) fprintf(stderr, "FILENAME=%s ", file);
- (void) mpfr_fprintf(stderr, "FNR=%Zd) ", mpzval);
+ (void) mpfr_fprintf(stderr, "FNR=%Zd) ", val->mpg_i);
}
} else
#endif
diff --git a/node.c b/node.c
index 27ed791b..8dbe68a9 100644
--- a/node.c
+++ b/node.c
@@ -26,14 +26,17 @@
#include "awk.h"
#include "math.h"
+#include "floatmagic.h" /* definition of isnan */
static int is_ieee_magic_val(const char *val);
+static NODE *r_make_number(double x);
static AWKNUM get_ieee_magic_val(const char *val);
extern NODE **fmt_list; /* declared in eval.c */
NODE *(*make_number)(double) = r_make_number;
NODE *(*str2number)(NODE *) = r_force_number;
NODE *(*format_val)(const char *, int, NODE *) = r_format_val;
+int (*cmp_numbers)(const NODE *, const NODE *) = cmp_awknums;
/* force_number --- force a value to be numeric */
@@ -321,9 +324,9 @@ r_dupnode(NODE *n)
return r;
}
-/* make_number --- allocate a node with defined number */
+/* r_make_number --- allocate a node with defined number */
-NODE *
+static NODE *
r_make_number(double x)
{
NODE *r;
@@ -341,6 +344,32 @@ r_make_number(double x)
return r;
}
+/* cmp_awknums --- compare two AWKNUMs */
+
+int
+cmp_awknums(const NODE *t1, const NODE *t2)
+{
+ /*
+ * This routine is also used to sort numeric array indices or values.
+ * For the purposes of sorting, NaN is considered greater than
+ * any other value, and all NaN values are considered equivalent and equal.
+ * This isn't in compliance with IEEE standard, but compliance w.r.t. NaN
+ * comparison at the awk level is a different issue, and needs to be dealt
+ * with in the interpreter for each opcode seperately.
+ */
+
+ if (isnan(t1->numbr))
+ return ! isnan(t2->numbr);
+ if (isnan(t2->numbr))
+ return -1;
+ /* don't subtract, in case one or both are infinite */
+ if (t1->numbr == t2->numbr)
+ return 0;
+ if (t1->numbr < t2->numbr)
+ return -1;
+ return 1;
+}
+
/* r_make_str_node --- make a string node */
@@ -443,8 +472,10 @@ r_unref(NODE *tmp)
#endif
#ifdef HAVE_MPFR
- if ((tmp->flags & MPFN) != 0)
+ if (is_mpg_float(tmp))
mpfr_clear(tmp->mpg_numbr);
+ else if (is_mpg_integer(tmp))
+ mpz_clear(tmp->mpg_i);
#endif
free_wstr(tmp);
diff --git a/profile.c b/profile.c
index 48f90c63..7d5c07b2 100644
--- a/profile.c
+++ b/profile.c
@@ -1209,8 +1209,10 @@ pp_number(NODE *n)
emalloc(str, char *, PP_PRECISION + 10, "pp_number");
#ifdef HAVE_MPFR
- if (n->flags & MPFN)
+ if (is_mpg_float(n))
mpfr_sprintf(str, "%0.*R*g", PP_PRECISION, RND_MODE, n->mpg_numbr);
+ else if (is_mpg_integer(n))
+ mpfr_sprintf(str, "%Zd", n->mpg_i);
else
#endif
sprintf(str, "%0.*g", PP_PRECISION, n->numbr);
diff --git a/str_array.c b/str_array.c
index 6895f587..1b3a33f1 100644
--- a/str_array.c
+++ b/str_array.c
@@ -150,7 +150,7 @@ str_lookup(NODE *symbol, NODE *subs)
* never be used.
*/
- if ((subs->flags & (MPFN|NUMCUR)) == NUMCUR) {
+ if ((subs->flags & (MPFN|MPZN|NUMCUR)) == NUMCUR) {
tmp->numbr = subs->numbr;
tmp->flags |= NUMCUR;
}
diff --git a/test/Gentests b/test/Gentests
index 640c3a0c..ae56b8cc 100755
--- a/test/Gentests
+++ b/test/Gentests
@@ -100,9 +100,12 @@ function generate(x, s)
printf "\t@echo $@\n"
printf "\t@AWKPATH=$(srcdir) $(AWK) -f $@.awk %s >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@\n", s
+
if (x in mpfr) {
delete mpfr[x]
- printf "\t@-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@\n\n"
+ printf "\t@-if test -z \"$$AWKFLAGS\" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \\\n"
+ printf "\t$(CMP) $(srcdir)/$@-mpfr.ok _$@ && rm -f _$@ ; \\\n"
+ printf "\tfi\n\n"
} else {
printf "\t@-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@\n\n"
}
diff --git a/test/Makefile.am b/test/Makefile.am
index bc174fb8..da3faeaa 100644
--- a/test/Makefile.am
+++ b/test/Makefile.am
@@ -846,7 +846,7 @@ INET_TESTS = inetdayu inetdayt inetechu inetecht
MACHINE_TESTS = double1 double2 fmtspcl intformat
-MPFR_TESTS = mpfrnr mpfrrnd mpfrieee mpfrexprange
+MPFR_TESTS = mpfrnr mpfrrnd mpfrieee mpfrexprange mpfrsort mpfrbigint
LOCALE_CHARSET_TESTS = \
asort asorti fmttest fnarydel fnparydl lc_num1 mbfw1 \
@@ -1112,7 +1112,9 @@ fmtspcl.ok: fmtspcl.tok Makefile
fmtspcl: fmtspcl.ok
@echo $@
@$(AWK) -f $(srcdir)/fmtspcl.awk --lint >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ $(CMP) $(srcdir)/$@-mpfr.ok _$@ && rm -f _$@ ; \
+ fi
reint::
@echo $@
@@ -1455,6 +1457,13 @@ rri1::
AWKPATH=$(srcdir) $(AWK) -f $@.awk < $(srcdir)/$@.in >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
@-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
+rand:
+ @echo $@
+ @AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ ($(CMP) $(srcdir)/$@-mpfr.ok _$@ || $(CMP) $(srcdir)/$@-mpfr1.ok _$@) && rm -f _$@ ; \
+ fi
+
mpfrieee:
@echo $@
@$(AWK) -M -vPREC=double -f $(srcdir)/$@.awk > _$@ 2>&1
@@ -1475,6 +1484,16 @@ mpfrnr:
@$(AWK) -M -vPREC=113 -f $(srcdir)/$@.awk $(srcdir)/$@.in > _$@
@-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
+mpfrsort:
+ @echo $@
+ @$(AWK) -M -vPREC=53 -f $(srcdir)/$@.awk > _$@ 2>&1
+ @-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
+
+mpfrbigint:
+ @echo $@
+ @$(AWK) -M -f $(srcdir)/$@.awk > _$@ 2>&1
+ @-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
+
# Targets generated for other tests:
include Maketests
diff --git a/test/Makefile.in b/test/Makefile.in
index 7a88e836..4eb95900 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -1029,7 +1029,7 @@ GAWK_EXT_TESTS = \
EXTRA_TESTS = inftest regtest
INET_TESTS = inetdayu inetdayt inetechu inetecht
MACHINE_TESTS = double1 double2 fmtspcl intformat
-MPFR_TESTS = mpfrnr mpfrrnd mpfrieee mpfrexprange
+MPFR_TESTS = mpfrnr mpfrrnd mpfrieee mpfrexprange mpfrsort mpfrbigint
LOCALE_CHARSET_TESTS = \
asort asorti fmttest fnarydel fnparydl lc_num1 mbfw1 \
mbprintf1 mbprintf2 mbprintf3 rebt8b2 rtlenmb sort1 sprintfc
@@ -1463,7 +1463,9 @@ fmtspcl.ok: fmtspcl.tok Makefile
fmtspcl: fmtspcl.ok
@echo $@
@$(AWK) -f $(srcdir)/fmtspcl.awk --lint >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ $(CMP) $(srcdir)/$@-mpfr.ok _$@ && rm -f _$@ ; \
+ fi
reint::
@echo $@
@@ -1806,6 +1808,13 @@ rri1::
AWKPATH=$(srcdir) $(AWK) -f $@.awk < $(srcdir)/$@.in >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
@-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
+rand:
+ @echo $@
+ @AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ ($(CMP) $(srcdir)/$@-mpfr.ok _$@ || $(CMP) $(srcdir)/$@-mpfr1.ok _$@) && rm -f _$@ ; \
+ fi
+
mpfrieee:
@echo $@
@$(AWK) -M -vPREC=double -f $(srcdir)/$@.awk > _$@ 2>&1
@@ -1825,6 +1834,16 @@ mpfrnr:
@echo $@
@$(AWK) -M -vPREC=113 -f $(srcdir)/$@.awk $(srcdir)/$@.in > _$@
@-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
+
+mpfrsort:
+ @echo $@
+ @$(AWK) -M -vPREC=53 -f $(srcdir)/$@.awk > _$@ 2>&1
+ @-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
+
+mpfrbigint:
+ @echo $@
+ @$(AWK) -M -f $(srcdir)/$@.awk > _$@ 2>&1
+ @-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
Gt-dummy:
# file Maketests, generated from Makefile.am by the Gentests program
addcomma:
@@ -2467,11 +2486,6 @@ prtoeval:
@AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
@-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
-rand:
- @echo $@
- @AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
-
range1:
@echo $@
@AWKPATH=$(srcdir) $(AWK) -f $@.awk < $(srcdir)/$@.in >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
@@ -2995,12 +3009,16 @@ fmttest:
fnarydel:
@echo $@
@AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ $(CMP) $(srcdir)/$@-mpfr.ok _$@ && rm -f _$@ ; \
+ fi
fnparydl:
@echo $@
@AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ $(CMP) $(srcdir)/$@-mpfr.ok _$@ && rm -f _$@ ; \
+ fi
rebt8b2:
@echo $@
diff --git a/test/Maketests b/test/Maketests
index e7577dea..4bc06e50 100644
--- a/test/Maketests
+++ b/test/Maketests
@@ -640,11 +640,6 @@ prtoeval:
@AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
@-$(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@
-rand:
- @echo $@
- @AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
-
range1:
@echo $@
@AWKPATH=$(srcdir) $(AWK) -f $@.awk < $(srcdir)/$@.in >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
@@ -1168,12 +1163,16 @@ fmttest:
fnarydel:
@echo $@
@AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ $(CMP) $(srcdir)/$@-mpfr.ok _$@ && rm -f _$@ ; \
+ fi
fnparydl:
@echo $@
@AWKPATH=$(srcdir) $(AWK) -f $@.awk >_$@ 2>&1 || echo EXIT CODE: $$? >>_$@
- @-($(CMP) $(srcdir)/$@.ok _$@ || $(CMP) $(srcdir)/$@-mpfr.ok _$@) && rm -f _$@
+ @-if test -z "$$AWKFLAGS" ; then $(CMP) $(srcdir)/$@.ok _$@ && rm -f _$@ ; else \
+ $(CMP) $(srcdir)/$@-mpfr.ok _$@ && rm -f _$@ ; \
+ fi
rebt8b2:
@echo $@
diff --git a/test/mpfrbigint.awk b/test/mpfrbigint.awk
new file mode 100644
index 00000000..bfdd871a
--- /dev/null
+++ b/test/mpfrbigint.awk
@@ -0,0 +1,11 @@
+BEGIN {
+ x = 5^4^3^2
+ print "# of digits =", length(x)
+ print substr(x, 1, 20), "...", substr(x, length(x) - 19, 20)
+
+ PREC = 1 + 3.321928095 * length(x); # 1 + digits * log2(10)
+ print "floating-point computation with precision =", PREC
+ y = 5.0^4.0^3.0^2.0
+ print "# of digits =", length(y)
+ print substr(y, 1, 20), "...", substr(y, length(y) - 19, 20)
+}
diff --git a/test/mpfrbigint.ok b/test/mpfrbigint.ok
new file mode 100644
index 00000000..670d4e07
--- /dev/null
+++ b/test/mpfrbigint.ok
@@ -0,0 +1,5 @@
+# of digits = 183231
+62060698786608744707 ... 92256259918212890625
+floating-point computation with precision = 608681
+# of digits = 183231
+62060698786608744707 ... 92256259918212890625
diff --git a/test/mpfrsort.awk b/test/mpfrsort.awk
new file mode 100644
index 00000000..6f7fa65c
--- /dev/null
+++ b/test/mpfrsort.awk
@@ -0,0 +1,8 @@
+BEGIN {
+# s = "1.0 +nan 0.0 -1 +inf -0.0 1 nan 1.0 -nan -inf 2.0"
+ s = "1.0 +nan 0.0 -1 +inf -0.0 1 1.0 -nan -inf 2.0"
+ split(s, a)
+ PROCINFO["sorted_in"] = "@val_num_asc"
+ for (i in a)
+ print a[i]
+}
diff --git a/test/mpfrsort.ok b/test/mpfrsort.ok
new file mode 100644
index 00000000..77a51ecf
--- /dev/null
+++ b/test/mpfrsort.ok
@@ -0,0 +1,11 @@
+-inf
+-1
+-0.0
+0.0
+1
+1.0
+1.0
+2.0
++inf
++nan
+-nan
diff --git a/test/rand-mpfr1.ok b/test/rand-mpfr1.ok
new file mode 100644
index 00000000..448f4032
--- /dev/null
+++ b/test/rand-mpfr1.ok
@@ -0,0 +1 @@
+ 25 42 47 49 80 5 4 92 59 96 8 63 92 28 41 37 80 51 48
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-05 15:45:56 +0000