aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjohn haque <j.eh@mchsi.com>2012-02-16 15:44:26 -0600
committerjohn haque <j.eh@mchsi.com>2012-02-16 15:44:26 -0600
commit0221eb79f43f4ef5c8d74759679a501607936d19 (patch)
tree05bad5469dfeba414838280cb86332b8fa853be7
parent06a6f16495e2a3d0cb664fc473107d3cdbe6f11e (diff)
downloadegawk-0221eb79f43f4ef5c8d74759679a501607936d19.tar.gz
egawk-0221eb79f43f4ef5c8d74759679a501607936d19.tar.bz2
egawk-0221eb79f43f4ef5c8d74759679a501607936d19.zip
New interpreter routine for MPFR.
Diffstat
-rw-r--r--array.c21
-rw-r--r--awk.h73
-rw-r--r--awkgram.c308
-rw-r--r--awkgram.y44
-rw-r--r--builtin.c125
-rw-r--r--eval.c65
-rw-r--r--int_array.c2
-rw-r--r--interpret.h273
-rw-r--r--io.c35
-rw-r--r--main.c6
-rw-r--r--mpfr.c482
-rw-r--r--msg.c15
-rw-r--r--node.c38
-rw-r--r--str_array.c6
-rw-r--r--test/Makefile.am4
-rw-r--r--test/Makefile.in4
16 files changed, 944 insertions, 557 deletions
diff --git a/array.c b/array.c
index e3bdbf54..7220d7ea 100644
--- a/array.c
+++ b/array.c
@@ -785,8 +785,8 @@ do_adump(int nargs)
*/
if (nargs == 2) {
- tmp = POP_SCALAR();
- depth = (long) force_number(tmp);
+ tmp = POP_NUMBER();
+ depth = get_number_si(tmp);
DEREF(tmp);
}
symbol = POP_PARAM();
@@ -1218,8 +1218,8 @@ sort_down_value_type(const void *p1, const void *p2)
static int
sort_user_func(const void *p1, const void *p2)
{
- NODE *idx1, *idx2, *val1, *val2;
- AWKNUM ret;
+ NODE *idx1, *idx2, *val1, *val2, *r;
+ int ret;
INSTRUCTION *code;
idx1 = *((NODE *const *) p1);
@@ -1246,9 +1246,16 @@ sort_user_func(const void *p1, const void *p2)
(void) (*interpret)(code);
/* return value of the comparison function */
- POP_NUMBER(ret);
-
- return (ret < 0.0) ? -1 : (ret > 0.0);
+ 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)
+ ret = mpfr_sgn(r->mpfr_numbr);
+ else
+#endif
+ ret = (r->numbr < 0.0) ? -1 : (r->numbr > 0.0);
+ DEREF(r);
+ return ret;
}
diff --git a/awk.h b/awk.h
index f08c10bf..9f2e904b 100644
--- a/awk.h
+++ b/awk.h
@@ -201,6 +201,7 @@ typedef void *stackoverflow_context_t;
#include <gmp.h>
#include <mpfr.h>
#ifndef MPFR_RNDN
+/* for compatibility with MPFR 2.X */
#define MPFR_RNDN GMP_RNDN
#define MPFR_RNDZ GMP_RNDZ
#define MPFR_RNDU GMP_RNDU
@@ -1020,7 +1021,8 @@ extern int sourceline;
extern char *source;
extern int (*interpret)(INSTRUCTION *); /* interpreter routine */
extern NODE *(*make_number)(AWKNUM );
-extern AWKNUM (*m_force_number)(NODE *);
+extern NODE *(*m_force_number)(NODE *);
+extern NODE *(*format_val)(const char *, int, NODE *);
#if __GNUC__ < 2
extern NODE *_t; /* used as temporary in macros */
@@ -1105,6 +1107,9 @@ 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 mpzval;
#endif
@@ -1165,9 +1170,6 @@ extern STACK_ITEM *stack_top;
#define POP_PARAM() ({ NODE *_t = POP(); \
_t->type == Node_var_array ? _t : get_array(_t, FALSE); })
-#define POP_NUMBER(x) ({ NODE *_t = POP_SCALAR(); x = force_number(_t); DEREF(_t); })
-#define TOP_NUMBER(x) ({ NODE *_t = TOP_SCALAR(); x = force_number(_t); DEREF(_t); })
-
#define POP_SCALAR() ({ NODE *_t = POP(); _t->type != Node_var_array ? _t \
: (fatal(_("attempt to use array `%s' in a scalar context"), array_vname(_t)), _t);})
#define TOP_SCALAR() ({ NODE *_t = TOP(); _t->type != Node_var_array ? _t \
@@ -1184,9 +1186,6 @@ extern STACK_ITEM *stack_top;
#define POP_PARAM() (_t = POP(), \
_t->type == Node_var_array ? _t : get_array(_t, FALSE))
-#define POP_NUMBER(x) (_t = POP_SCALAR(), x = force_number(_t), DEREF(_t))
-#define TOP_NUMBER(x) (_t = TOP_SCALAR(), x = force_number(_t), DEREF(_t))
-
#define POP_SCALAR() (_t = POP(), _t->type != Node_var_array ? _t \
: (fatal(_("attempt to use array `%s' in a scalar context"), array_vname(_t)), _t))
#define TOP_SCALAR() (_t = TOP(), _t->type != Node_var_array ? _t \
@@ -1197,6 +1196,9 @@ extern STACK_ITEM *stack_top;
#endif /* __GNUC__ */
+#define POP_NUMBER() force_number(POP_SCALAR())
+#define TOP_NUMBER() force_number(TOP_SCALAR())
+
/* ------------------------- Pseudo-functions ------------------------- */
#ifdef HAVE_MPFR
/* conversion to C types */
@@ -1211,6 +1213,10 @@ extern STACK_ITEM *stack_top;
#define is_nonzero_num(n) (((n)->flags & MPFN) ? (! mpfr_zero_p((n)->mpfr_numbr)) \
: ((n)->numbr != 0.0))
+
+/* increment NR or FNR */
+#define INCREMNT(X) (do_mpfr && X == (LONG_MAX - 1)) ? \
+ (mpfr_add_ui(M##X, M##X, 1, RND_MODE), X = 0) : X++
#else
#define get_number_ui(n) (unsigned long) (n)->numbr
#define get_number_si(n) (long) (n)->numbr
@@ -1218,6 +1224,8 @@ extern STACK_ITEM *stack_top;
#define get_number_uj(n) (uintmax_t) (n)->numbr
#define is_nonzero_num(n) ((n)->numbr != 0.0)
+
+#define INCREMNT(X) X++
#endif
#define is_identchar(c) (isalnum(c) || (c) == '_')
@@ -1277,8 +1285,8 @@ extern NODE *r_force_string(NODE *s);
#define dupnode(n) __extension__ ({ NODE *_tn = (n); \
(_tn->flags & MALLOC) ? (_tn->valref++, _tn) : r_dupnode(_tn); })
-#define force_number(n) __extension__ ({ NODE *_tn = (n);\
- (_tn->flags & NUMCUR) ? _tn->numbr : m_force_number(_tn); })
+#define force_number(n) __extension__ ({ NODE *_tn = (n); \
+ (_tn->flags & NUMCUR) ? _tn : m_force_number(_tn); })
#define force_string(s) __extension__ ({ NODE *_ts = (s); m_force_string(_ts); })
@@ -1419,6 +1427,9 @@ extern INSTRUCTION *POP_CODE(void);
extern void init_interpret(void);
extern int r_interpret(INSTRUCTION *);
extern int debug_interpret(INSTRUCTION *);
+#ifdef HAVE_MPFR
+extern int mpfr_interpret(INSTRUCTION *);
+#endif
extern int cmp_nodes(NODE *p1, NODE *p2);
extern void set_IGNORECASE(void);
extern void set_OFS(void);
@@ -1517,29 +1528,31 @@ extern void update_global_values();
extern long getenv_long(const char *name);
/* mpfr.c */
-#ifdef HAVE_MPFR
extern void set_PREC(void);
extern void set_RNDMODE(void);
-extern NODE *do_and_mpfr(int);
-extern NODE *do_atan2_mpfr(int);
-extern NODE *do_compl_mpfr(int);
-extern NODE *do_cos_mpfr(int);
-extern NODE *do_exp_mpfr(int);
-extern NODE *do_int_mpfr(int);
-extern NODE *do_log_mpfr(int);
-extern NODE *do_lshift_mpfr(int);
-extern NODE *do_or_mpfr(int);
-extern NODE *do_rand_mpfr(int);
-extern NODE *do_rhift_mpfr(int);
-extern NODE *do_sin_mpfr(int);
-extern NODE *do_sqrt_mpfr(int);
-extern NODE *do_srand_mpfr(int);
-extern NODE *do_strtonum_mpfr(int);
-extern NODE *do_xor_mpfr(int);
+#ifdef HAVE_MPFR
+extern void mpfr_update_var(NODE *);
+extern long mpfr_set_var(NODE *);
+extern NODE *do_mpfr_and(int);
+extern NODE *do_mpfr_atan2(int);
+extern NODE *do_mpfr_compl(int);
+extern NODE *do_mpfr_cos(int);
+extern NODE *do_mpfr_exp(int);
+extern NODE *do_mpfr_int(int);
+extern NODE *do_mpfr_log(int);
+extern NODE *do_mpfr_lshift(int);
+extern NODE *do_mpfr_or(int);
+extern NODE *do_mpfr_rand(int);
+extern NODE *do_mpfr_rhift(int);
+extern NODE *do_mpfr_sin(int);
+extern NODE *do_mpfr_sqrt(int);
+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 AWKNUM force_mpfr_number(NODE *n);
extern NODE *mpfr_node();
-extern NODE *make_mpfr_number(double x);
+extern void op_assign_mpfr(OPCODE op);
+const char *mpfr_fmt(const char *mesg, ...);
#endif
/* msg.c */
extern void gawk_exit(int status);
@@ -1566,8 +1579,8 @@ extern int pp_func(INSTRUCTION *pc, void *);
extern void pp_string_fp(Func_print print_func, FILE *fp, const char *str,
size_t namelen, int delim, int breaklines);
/* node.c */
-extern AWKNUM r_force_number(NODE *n);
-extern NODE *format_val(const char *format, int index, NODE *s);
+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);
diff --git a/awkgram.c b/awkgram.c
index f7c74f38..edf99320 100644
--- a/awkgram.c
+++ b/awkgram.c
@@ -712,20 +712,20 @@ static const yytype_uint16 yyrline[] =
322, 331, 341, 343, 345, 351, 356, 357, 361, 380,
379, 413, 415, 420, 421, 434, 439, 440, 444, 446,
448, 455, 545, 587, 629, 742, 749, 756, 766, 775,
- 784, 793, 808, 824, 823, 847, 859, 859, 953, 953,
- 978, 1001, 1007, 1008, 1014, 1015, 1022, 1027, 1039, 1053,
- 1055, 1066, 1071, 1073, 1081, 1083, 1092, 1093, 1101, 1106,
- 1106, 1117, 1121, 1129, 1130, 1133, 1135, 1140, 1141, 1150,
- 1151, 1156, 1161, 1167, 1169, 1171, 1178, 1179, 1185, 1186,
- 1191, 1193, 1198, 1200, 1202, 1204, 1210, 1217, 1219, 1221,
- 1237, 1247, 1254, 1256, 1261, 1263, 1265, 1273, 1275, 1280,
- 1282, 1287, 1289, 1291, 1341, 1343, 1345, 1347, 1349, 1351,
- 1353, 1355, 1378, 1383, 1388, 1413, 1419, 1421, 1423, 1425,
- 1427, 1429, 1434, 1438, 1469, 1471, 1477, 1483, 1496, 1497,
- 1498, 1503, 1508, 1512, 1516, 1534, 1547, 1552, 1588, 1606,
- 1607, 1613, 1614, 1619, 1621, 1628, 1645, 1662, 1664, 1671,
- 1676, 1684, 1694, 1706, 1715, 1719, 1723, 1727, 1731, 1735,
- 1738, 1740, 1744, 1748, 1752
+ 784, 793, 808, 824, 823, 847, 859, 859, 954, 954,
+ 979, 1002, 1008, 1009, 1015, 1016, 1023, 1028, 1040, 1054,
+ 1056, 1067, 1072, 1074, 1082, 1084, 1093, 1094, 1102, 1107,
+ 1107, 1118, 1122, 1130, 1131, 1134, 1136, 1141, 1142, 1151,
+ 1152, 1157, 1162, 1168, 1170, 1172, 1179, 1180, 1186, 1187,
+ 1192, 1194, 1199, 1201, 1203, 1205, 1211, 1218, 1220, 1222,
+ 1238, 1248, 1255, 1257, 1262, 1264, 1266, 1274, 1276, 1281,
+ 1283, 1288, 1290, 1292, 1342, 1344, 1346, 1348, 1350, 1352,
+ 1354, 1356, 1379, 1384, 1389, 1414, 1420, 1422, 1424, 1426,
+ 1428, 1430, 1435, 1439, 1471, 1473, 1479, 1485, 1498, 1499,
+ 1500, 1505, 1510, 1514, 1518, 1536, 1549, 1554, 1590, 1608,
+ 1609, 1615, 1616, 1621, 1623, 1630, 1647, 1664, 1666, 1673,
+ 1678, 1686, 1696, 1708, 1717, 1721, 1725, 1729, 1733, 1737,
+ 1740, 1742, 1746, 1750, 1754
};
#endif
@@ -2897,6 +2897,7 @@ regular_loop:
&& (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)
)
) {
@@ -2981,14 +2982,14 @@ regular_loop:
case 58:
/* Line 1821 of yacc.c */
-#line 953 "awkgram.y"
+#line 954 "awkgram.y"
{ sub_counter = 0; }
break;
case 59:
/* Line 1821 of yacc.c */
-#line 954 "awkgram.y"
+#line 955 "awkgram.y"
{
char *arr = (yyvsp[(2) - (4)])->lextok;
@@ -3018,7 +3019,7 @@ regular_loop:
case 60:
/* Line 1821 of yacc.c */
-#line 983 "awkgram.y"
+#line 984 "awkgram.y"
{
static short warned = FALSE;
char *arr = (yyvsp[(3) - (4)])->lextok;
@@ -3042,35 +3043,35 @@ regular_loop:
case 61:
/* Line 1821 of yacc.c */
-#line 1002 "awkgram.y"
+#line 1003 "awkgram.y"
{ (yyval) = optimize_assignment((yyvsp[(1) - (1)])); }
break;
case 62:
/* Line 1821 of yacc.c */
-#line 1007 "awkgram.y"
+#line 1008 "awkgram.y"
{ (yyval) = NULL; }
break;
case 63:
/* Line 1821 of yacc.c */
-#line 1009 "awkgram.y"
+#line 1010 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 64:
/* Line 1821 of yacc.c */
-#line 1014 "awkgram.y"
+#line 1015 "awkgram.y"
{ (yyval) = NULL; }
break;
case 65:
/* Line 1821 of yacc.c */
-#line 1016 "awkgram.y"
+#line 1017 "awkgram.y"
{
if ((yyvsp[(1) - (2)]) == NULL)
(yyval) = list_create((yyvsp[(2) - (2)]));
@@ -3082,14 +3083,14 @@ regular_loop:
case 66:
/* Line 1821 of yacc.c */
-#line 1023 "awkgram.y"
+#line 1024 "awkgram.y"
{ (yyval) = NULL; }
break;
case 67:
/* Line 1821 of yacc.c */
-#line 1028 "awkgram.y"
+#line 1029 "awkgram.y"
{
INSTRUCTION *casestmt = (yyvsp[(5) - (5)]);
if ((yyvsp[(5) - (5)]) == NULL)
@@ -3106,7 +3107,7 @@ regular_loop:
case 68:
/* Line 1821 of yacc.c */
-#line 1040 "awkgram.y"
+#line 1041 "awkgram.y"
{
INSTRUCTION *casestmt = (yyvsp[(4) - (4)]);
if ((yyvsp[(4) - (4)]) == NULL)
@@ -3122,14 +3123,14 @@ regular_loop:
case 69:
/* Line 1821 of yacc.c */
-#line 1054 "awkgram.y"
+#line 1055 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 70:
/* Line 1821 of yacc.c */
-#line 1056 "awkgram.y"
+#line 1057 "awkgram.y"
{
NODE *n = (yyvsp[(2) - (2)])->memory;
(void) force_number(n);
@@ -3145,7 +3146,7 @@ regular_loop:
case 71:
/* Line 1821 of yacc.c */
-#line 1067 "awkgram.y"
+#line 1068 "awkgram.y"
{
bcfree((yyvsp[(1) - (2)]));
(yyval) = (yyvsp[(2) - (2)]);
@@ -3155,14 +3156,14 @@ regular_loop:
case 72:
/* Line 1821 of yacc.c */
-#line 1072 "awkgram.y"
+#line 1073 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 73:
/* Line 1821 of yacc.c */
-#line 1074 "awkgram.y"
+#line 1075 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_push_re;
(yyval) = (yyvsp[(1) - (1)]);
@@ -3172,21 +3173,21 @@ regular_loop:
case 74:
/* Line 1821 of yacc.c */
-#line 1082 "awkgram.y"
+#line 1083 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 75:
/* Line 1821 of yacc.c */
-#line 1084 "awkgram.y"
+#line 1085 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 77:
/* Line 1821 of yacc.c */
-#line 1094 "awkgram.y"
+#line 1095 "awkgram.y"
{
(yyval) = (yyvsp[(2) - (3)]);
}
@@ -3195,7 +3196,7 @@ regular_loop:
case 78:
/* Line 1821 of yacc.c */
-#line 1101 "awkgram.y"
+#line 1102 "awkgram.y"
{
in_print = FALSE;
in_parens = 0;
@@ -3206,14 +3207,14 @@ regular_loop:
case 79:
/* Line 1821 of yacc.c */
-#line 1106 "awkgram.y"
+#line 1107 "awkgram.y"
{ in_print = FALSE; in_parens = 0; }
break;
case 80:
/* Line 1821 of yacc.c */
-#line 1107 "awkgram.y"
+#line 1108 "awkgram.y"
{
if ((yyvsp[(1) - (3)])->redir_type == redirect_twoway
&& (yyvsp[(3) - (3)])->lasti->opcode == Op_K_getline_redir
@@ -3226,7 +3227,7 @@ regular_loop:
case 81:
/* Line 1821 of yacc.c */
-#line 1118 "awkgram.y"
+#line 1119 "awkgram.y"
{
(yyval) = mk_condition((yyvsp[(3) - (6)]), (yyvsp[(1) - (6)]), (yyvsp[(6) - (6)]), NULL, NULL);
}
@@ -3235,7 +3236,7 @@ regular_loop:
case 82:
/* Line 1821 of yacc.c */
-#line 1123 "awkgram.y"
+#line 1124 "awkgram.y"
{
(yyval) = mk_condition((yyvsp[(3) - (9)]), (yyvsp[(1) - (9)]), (yyvsp[(6) - (9)]), (yyvsp[(7) - (9)]), (yyvsp[(9) - (9)]));
}
@@ -3244,14 +3245,14 @@ regular_loop:
case 87:
/* Line 1821 of yacc.c */
-#line 1140 "awkgram.y"
+#line 1141 "awkgram.y"
{ (yyval) = NULL; }
break;
case 88:
/* Line 1821 of yacc.c */
-#line 1142 "awkgram.y"
+#line 1143 "awkgram.y"
{
bcfree((yyvsp[(1) - (2)]));
(yyval) = (yyvsp[(2) - (2)]);
@@ -3261,21 +3262,21 @@ regular_loop:
case 89:
/* Line 1821 of yacc.c */
-#line 1150 "awkgram.y"
+#line 1151 "awkgram.y"
{ (yyval) = NULL; }
break;
case 90:
/* Line 1821 of yacc.c */
-#line 1152 "awkgram.y"
+#line 1153 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]) ; }
break;
case 91:
/* Line 1821 of yacc.c */
-#line 1157 "awkgram.y"
+#line 1158 "awkgram.y"
{
(yyvsp[(1) - (1)])->param_count = 0;
(yyval) = list_create((yyvsp[(1) - (1)]));
@@ -3285,7 +3286,7 @@ regular_loop:
case 92:
/* Line 1821 of yacc.c */
-#line 1162 "awkgram.y"
+#line 1163 "awkgram.y"
{
(yyvsp[(3) - (3)])->param_count = (yyvsp[(1) - (3)])->lasti->param_count + 1;
(yyval) = list_append((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]));
@@ -3296,63 +3297,63 @@ regular_loop:
case 93:
/* Line 1821 of yacc.c */
-#line 1168 "awkgram.y"
+#line 1169 "awkgram.y"
{ (yyval) = NULL; }
break;
case 94:
/* Line 1821 of yacc.c */
-#line 1170 "awkgram.y"
+#line 1171 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 95:
/* Line 1821 of yacc.c */
-#line 1172 "awkgram.y"
+#line 1173 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (3)]); }
break;
case 96:
/* Line 1821 of yacc.c */
-#line 1178 "awkgram.y"
+#line 1179 "awkgram.y"
{ (yyval) = NULL; }
break;
case 97:
/* Line 1821 of yacc.c */
-#line 1180 "awkgram.y"
+#line 1181 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 98:
/* Line 1821 of yacc.c */
-#line 1185 "awkgram.y"
+#line 1186 "awkgram.y"
{ (yyval) = NULL; }
break;
case 99:
/* Line 1821 of yacc.c */
-#line 1187 "awkgram.y"
+#line 1188 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 100:
/* Line 1821 of yacc.c */
-#line 1192 "awkgram.y"
+#line 1193 "awkgram.y"
{ (yyval) = mk_expression_list(NULL, (yyvsp[(1) - (1)])); }
break;
case 101:
/* Line 1821 of yacc.c */
-#line 1194 "awkgram.y"
+#line 1195 "awkgram.y"
{
(yyval) = mk_expression_list((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]));
yyerrok;
@@ -3362,35 +3363,35 @@ regular_loop:
case 102:
/* Line 1821 of yacc.c */
-#line 1199 "awkgram.y"
+#line 1200 "awkgram.y"
{ (yyval) = NULL; }
break;
case 103:
/* Line 1821 of yacc.c */
-#line 1201 "awkgram.y"
+#line 1202 "awkgram.y"
{ (yyval) = NULL; }
break;
case 104:
/* Line 1821 of yacc.c */
-#line 1203 "awkgram.y"
+#line 1204 "awkgram.y"
{ (yyval) = NULL; }
break;
case 105:
/* Line 1821 of yacc.c */
-#line 1205 "awkgram.y"
+#line 1206 "awkgram.y"
{ (yyval) = NULL; }
break;
case 106:
/* Line 1821 of yacc.c */
-#line 1211 "awkgram.y"
+#line 1212 "awkgram.y"
{
if (do_lint && (yyvsp[(3) - (3)])->lasti->opcode == Op_match_rec)
lintwarn_ln((yyvsp[(2) - (3)])->source_line,
@@ -3402,21 +3403,21 @@ regular_loop:
case 107:
/* Line 1821 of yacc.c */
-#line 1218 "awkgram.y"
+#line 1219 "awkgram.y"
{ (yyval) = mk_boolean((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 108:
/* Line 1821 of yacc.c */
-#line 1220 "awkgram.y"
+#line 1221 "awkgram.y"
{ (yyval) = mk_boolean((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 109:
/* Line 1821 of yacc.c */
-#line 1222 "awkgram.y"
+#line 1223 "awkgram.y"
{
if ((yyvsp[(1) - (3)])->lasti->opcode == Op_match_rec)
warning_ln((yyvsp[(2) - (3)])->source_line,
@@ -3437,7 +3438,7 @@ regular_loop:
case 110:
/* Line 1821 of yacc.c */
-#line 1238 "awkgram.y"
+#line 1239 "awkgram.y"
{
if (do_lint_old)
warning_ln((yyvsp[(2) - (3)])->source_line,
@@ -3452,7 +3453,7 @@ regular_loop:
case 111:
/* Line 1821 of yacc.c */
-#line 1248 "awkgram.y"
+#line 1249 "awkgram.y"
{
if (do_lint && (yyvsp[(3) - (3)])->lasti->opcode == Op_match_rec)
lintwarn_ln((yyvsp[(2) - (3)])->source_line,
@@ -3464,35 +3465,35 @@ regular_loop:
case 112:
/* Line 1821 of yacc.c */
-#line 1255 "awkgram.y"
+#line 1256 "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 1257 "awkgram.y"
+#line 1258 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 114:
/* Line 1821 of yacc.c */
-#line 1262 "awkgram.y"
+#line 1263 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 115:
/* Line 1821 of yacc.c */
-#line 1264 "awkgram.y"
+#line 1265 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 116:
/* Line 1821 of yacc.c */
-#line 1266 "awkgram.y"
+#line 1267 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_assign_quotient;
(yyval) = (yyvsp[(2) - (2)]);
@@ -3502,49 +3503,49 @@ regular_loop:
case 117:
/* Line 1821 of yacc.c */
-#line 1274 "awkgram.y"
+#line 1275 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 118:
/* Line 1821 of yacc.c */
-#line 1276 "awkgram.y"
+#line 1277 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 119:
/* Line 1821 of yacc.c */
-#line 1281 "awkgram.y"
+#line 1282 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 120:
/* Line 1821 of yacc.c */
-#line 1283 "awkgram.y"
+#line 1284 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 121:
/* Line 1821 of yacc.c */
-#line 1288 "awkgram.y"
+#line 1289 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 122:
/* Line 1821 of yacc.c */
-#line 1290 "awkgram.y"
+#line 1291 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 123:
/* Line 1821 of yacc.c */
-#line 1292 "awkgram.y"
+#line 1293 "awkgram.y"
{
int count = 2;
int is_simple_var = FALSE;
@@ -3596,49 +3597,49 @@ regular_loop:
case 125:
/* Line 1821 of yacc.c */
-#line 1344 "awkgram.y"
+#line 1345 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 126:
/* Line 1821 of yacc.c */
-#line 1346 "awkgram.y"
+#line 1347 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 127:
/* Line 1821 of yacc.c */
-#line 1348 "awkgram.y"
+#line 1349 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 128:
/* Line 1821 of yacc.c */
-#line 1350 "awkgram.y"
+#line 1351 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 129:
/* Line 1821 of yacc.c */
-#line 1352 "awkgram.y"
+#line 1353 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 130:
/* Line 1821 of yacc.c */
-#line 1354 "awkgram.y"
+#line 1355 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 131:
/* Line 1821 of yacc.c */
-#line 1356 "awkgram.y"
+#line 1357 "awkgram.y"
{
/*
* In BEGINFILE/ENDFILE, allow `getline var < file'
@@ -3666,7 +3667,7 @@ regular_loop:
case 132:
/* Line 1821 of yacc.c */
-#line 1379 "awkgram.y"
+#line 1380 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_postincrement;
(yyval) = mk_assignment((yyvsp[(1) - (2)]), NULL, (yyvsp[(2) - (2)]));
@@ -3676,7 +3677,7 @@ regular_loop:
case 133:
/* Line 1821 of yacc.c */
-#line 1384 "awkgram.y"
+#line 1385 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_postdecrement;
(yyval) = mk_assignment((yyvsp[(1) - (2)]), NULL, (yyvsp[(2) - (2)]));
@@ -3686,7 +3687,7 @@ regular_loop:
case 134:
/* Line 1821 of yacc.c */
-#line 1389 "awkgram.y"
+#line 1390 "awkgram.y"
{
if (do_lint_old) {
warning_ln((yyvsp[(4) - (5)])->source_line,
@@ -3711,7 +3712,7 @@ regular_loop:
case 135:
/* Line 1821 of yacc.c */
-#line 1414 "awkgram.y"
+#line 1415 "awkgram.y"
{
(yyval) = mk_getline((yyvsp[(3) - (4)]), (yyvsp[(4) - (4)]), (yyvsp[(1) - (4)]), (yyvsp[(2) - (4)])->redir_type);
bcfree((yyvsp[(2) - (4)]));
@@ -3721,49 +3722,49 @@ regular_loop:
case 136:
/* Line 1821 of yacc.c */
-#line 1420 "awkgram.y"
+#line 1421 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 137:
/* Line 1821 of yacc.c */
-#line 1422 "awkgram.y"
+#line 1423 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 138:
/* Line 1821 of yacc.c */
-#line 1424 "awkgram.y"
+#line 1425 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 139:
/* Line 1821 of yacc.c */
-#line 1426 "awkgram.y"
+#line 1427 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 140:
/* Line 1821 of yacc.c */
-#line 1428 "awkgram.y"
+#line 1429 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 141:
/* Line 1821 of yacc.c */
-#line 1430 "awkgram.y"
+#line 1431 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) - (3)])); }
break;
case 142:
/* Line 1821 of yacc.c */
-#line 1435 "awkgram.y"
+#line 1436 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3772,7 +3773,7 @@ regular_loop:
case 143:
/* Line 1821 of yacc.c */
-#line 1439 "awkgram.y"
+#line 1440 "awkgram.y"
{
if ((yyvsp[(2) - (2)])->opcode == Op_match_rec) {
(yyvsp[(2) - (2)])->opcode = Op_nomatch;
@@ -3783,6 +3784,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
) {
NODE *n = (yyvsp[(2) - (2)])->nexti->memory;
if ((n->flags & (STRCUR|STRING)) != 0) {
@@ -3808,14 +3810,14 @@ regular_loop:
case 144:
/* Line 1821 of yacc.c */
-#line 1470 "awkgram.y"
+#line 1472 "awkgram.y"
{ (yyval) = (yyvsp[(2) - (3)]); }
break;
case 145:
/* Line 1821 of yacc.c */
-#line 1472 "awkgram.y"
+#line 1474 "awkgram.y"
{
(yyval) = snode((yyvsp[(3) - (4)]), (yyvsp[(1) - (4)]));
if ((yyval) == NULL)
@@ -3826,7 +3828,7 @@ regular_loop:
case 146:
/* Line 1821 of yacc.c */
-#line 1478 "awkgram.y"
+#line 1480 "awkgram.y"
{
(yyval) = snode((yyvsp[(3) - (4)]), (yyvsp[(1) - (4)]));
if ((yyval) == NULL)
@@ -3837,7 +3839,7 @@ regular_loop:
case 147:
/* Line 1821 of yacc.c */
-#line 1484 "awkgram.y"
+#line 1486 "awkgram.y"
{
static short warned1 = FALSE;
@@ -3855,7 +3857,7 @@ regular_loop:
case 150:
/* Line 1821 of yacc.c */
-#line 1499 "awkgram.y"
+#line 1501 "awkgram.y"
{
(yyvsp[(1) - (2)])->opcode = Op_preincrement;
(yyval) = mk_assignment((yyvsp[(2) - (2)]), NULL, (yyvsp[(1) - (2)]));
@@ -3865,7 +3867,7 @@ regular_loop:
case 151:
/* Line 1821 of yacc.c */
-#line 1504 "awkgram.y"
+#line 1506 "awkgram.y"
{
(yyvsp[(1) - (2)])->opcode = Op_predecrement;
(yyval) = mk_assignment((yyvsp[(2) - (2)]), NULL, (yyvsp[(1) - (2)]));
@@ -3875,7 +3877,7 @@ regular_loop:
case 152:
/* Line 1821 of yacc.c */
-#line 1509 "awkgram.y"
+#line 1511 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3884,7 +3886,7 @@ regular_loop:
case 153:
/* Line 1821 of yacc.c */
-#line 1513 "awkgram.y"
+#line 1515 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3893,7 +3895,7 @@ regular_loop:
case 154:
/* Line 1821 of yacc.c */
-#line 1517 "awkgram.y"
+#line 1519 "awkgram.y"
{
if ((yyvsp[(2) - (2)])->lasti->opcode == Op_push_i
&& ((yyvsp[(2) - (2)])->lasti->memory->flags & (STRCUR|STRING)) == 0
@@ -3916,7 +3918,7 @@ regular_loop:
case 155:
/* Line 1821 of yacc.c */
-#line 1535 "awkgram.y"
+#line 1537 "awkgram.y"
{
/*
* was: $$ = $2
@@ -3931,7 +3933,7 @@ regular_loop:
case 156:
/* Line 1821 of yacc.c */
-#line 1548 "awkgram.y"
+#line 1550 "awkgram.y"
{
func_use((yyvsp[(1) - (1)])->lasti->func_name, FUNC_USE);
(yyval) = (yyvsp[(1) - (1)]);
@@ -3941,7 +3943,7 @@ regular_loop:
case 157:
/* Line 1821 of yacc.c */
-#line 1553 "awkgram.y"
+#line 1555 "awkgram.y"
{
/* indirect function call */
INSTRUCTION *f, *t;
@@ -3979,7 +3981,7 @@ regular_loop:
case 158:
/* Line 1821 of yacc.c */
-#line 1589 "awkgram.y"
+#line 1591 "awkgram.y"
{
param_sanity((yyvsp[(3) - (4)]));
(yyvsp[(1) - (4)])->opcode = Op_func_call;
@@ -3998,42 +4000,42 @@ regular_loop:
case 159:
/* Line 1821 of yacc.c */
-#line 1606 "awkgram.y"
+#line 1608 "awkgram.y"
{ (yyval) = NULL; }
break;
case 160:
/* Line 1821 of yacc.c */
-#line 1608 "awkgram.y"
+#line 1610 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 161:
/* Line 1821 of yacc.c */
-#line 1613 "awkgram.y"
+#line 1615 "awkgram.y"
{ (yyval) = NULL; }
break;
case 162:
/* Line 1821 of yacc.c */
-#line 1615 "awkgram.y"
+#line 1617 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 163:
/* Line 1821 of yacc.c */
-#line 1620 "awkgram.y"
+#line 1622 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 164:
/* Line 1821 of yacc.c */
-#line 1622 "awkgram.y"
+#line 1624 "awkgram.y"
{
(yyval) = list_merge((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
}
@@ -4042,7 +4044,7 @@ regular_loop:
case 165:
/* Line 1821 of yacc.c */
-#line 1629 "awkgram.y"
+#line 1631 "awkgram.y"
{
INSTRUCTION *ip = (yyvsp[(1) - (1)])->lasti;
int count = ip->sub_count; /* # of SUBSEP-seperated expressions */
@@ -4061,7 +4063,7 @@ regular_loop:
case 166:
/* Line 1821 of yacc.c */
-#line 1646 "awkgram.y"
+#line 1648 "awkgram.y"
{
INSTRUCTION *t = (yyvsp[(2) - (3)]);
if ((yyvsp[(2) - (3)]) == NULL) {
@@ -4080,14 +4082,14 @@ regular_loop:
case 167:
/* Line 1821 of yacc.c */
-#line 1663 "awkgram.y"
+#line 1665 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 168:
/* Line 1821 of yacc.c */
-#line 1665 "awkgram.y"
+#line 1667 "awkgram.y"
{
(yyval) = list_merge((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
}
@@ -4096,14 +4098,14 @@ regular_loop:
case 169:
/* Line 1821 of yacc.c */
-#line 1672 "awkgram.y"
+#line 1674 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 170:
/* Line 1821 of yacc.c */
-#line 1677 "awkgram.y"
+#line 1679 "awkgram.y"
{
char *var_name = (yyvsp[(1) - (1)])->lextok;
@@ -4116,7 +4118,7 @@ regular_loop:
case 171:
/* Line 1821 of yacc.c */
-#line 1685 "awkgram.y"
+#line 1687 "awkgram.y"
{
char *arr = (yyvsp[(1) - (2)])->lextok;
(yyvsp[(1) - (2)])->memory = variable((yyvsp[(1) - (2)])->source_line, arr, Node_var_new);
@@ -4128,7 +4130,7 @@ regular_loop:
case 172:
/* Line 1821 of yacc.c */
-#line 1695 "awkgram.y"
+#line 1697 "awkgram.y"
{
INSTRUCTION *ip = (yyvsp[(1) - (1)])->nexti;
if (ip->opcode == Op_push
@@ -4145,7 +4147,7 @@ regular_loop:
case 173:
/* Line 1821 of yacc.c */
-#line 1707 "awkgram.y"
+#line 1709 "awkgram.y"
{
(yyval) = list_append((yyvsp[(2) - (3)]), (yyvsp[(1) - (3)]));
if ((yyvsp[(3) - (3)]) != NULL)
@@ -4156,7 +4158,7 @@ regular_loop:
case 174:
/* Line 1821 of yacc.c */
-#line 1716 "awkgram.y"
+#line 1718 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_postincrement;
}
@@ -4165,7 +4167,7 @@ regular_loop:
case 175:
/* Line 1821 of yacc.c */
-#line 1720 "awkgram.y"
+#line 1722 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_postdecrement;
}
@@ -4174,49 +4176,49 @@ regular_loop:
case 176:
/* Line 1821 of yacc.c */
-#line 1723 "awkgram.y"
+#line 1725 "awkgram.y"
{ (yyval) = NULL; }
break;
case 178:
/* Line 1821 of yacc.c */
-#line 1731 "awkgram.y"
+#line 1733 "awkgram.y"
{ yyerrok; }
break;
case 179:
/* Line 1821 of yacc.c */
-#line 1735 "awkgram.y"
+#line 1737 "awkgram.y"
{ yyerrok; }
break;
case 182:
/* Line 1821 of yacc.c */
-#line 1744 "awkgram.y"
+#line 1746 "awkgram.y"
{ yyerrok; }
break;
case 183:
/* Line 1821 of yacc.c */
-#line 1748 "awkgram.y"
+#line 1750 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); yyerrok; }
break;
case 184:
/* Line 1821 of yacc.c */
-#line 1752 "awkgram.y"
+#line 1754 "awkgram.y"
{ yyerrok; }
break;
/* Line 1821 of yacc.c */
-#line 4232 "awkgram.c"
+#line 4234 "awkgram.c"
default: break;
}
/* User semantic actions sometimes alter yychar, and that requires
@@ -4447,7 +4449,7 @@ yyreturn:
/* Line 2067 of yacc.c */
-#line 1754 "awkgram.y"
+#line 1756 "awkgram.y"
struct token {
@@ -4491,7 +4493,7 @@ tokcompare(const void *l, const void *r)
*/
#ifdef HAVE_MPFR
-#define MPF(F) F##_mpfr
+#define MPF(F) do_mpfr_##F
#else
#define MPF(F) 0
#endif
@@ -4504,20 +4506,20 @@ static const struct token tokentab[] = {
#ifdef ARRAYDEBUG
{"adump", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2), do_adump, 0},
#endif
-{"and", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_and, MPF(do_and)},
+{"and", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_and, MPF(and)},
#ifdef ARRAYDEBUG
{"aoption", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_aoption, 0},
#endif
{"asort", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3), do_asort, 0},
{"asorti", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3), do_asorti, 0},
-{"atan2", Op_builtin, LEX_BUILTIN, NOT_OLD|A(2), do_atan2, MPF(do_atan2)},
+{"atan2", Op_builtin, LEX_BUILTIN, NOT_OLD|A(2), do_atan2, MPF(atan2)},
{"bindtextdomain", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2), do_bindtextdomain, 0},
{"break", Op_K_break, LEX_BREAK, 0, 0, 0},
{"case", Op_K_case, LEX_CASE, GAWKX, 0, 0},
{"close", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1)|A(2), do_close, 0},
-{"compl", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_compl, MPF(do_compl)},
+{"compl", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_compl, MPF(compl)},
{"continue", Op_K_continue, LEX_CONTINUE, 0, 0, 0},
-{"cos", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_cos, MPF(do_cos)},
+{"cos", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_cos, MPF(cos)},
{"dcgettext", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3), do_dcgettext, 0},
{"dcngettext", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3)|A(4)|A(5), do_dcngettext, 0},
{"default", Op_K_default, LEX_DEFAULT, GAWKX, 0, 0},
@@ -4526,7 +4528,7 @@ static const struct token tokentab[] = {
{"else", Op_K_else, LEX_ELSE, 0, 0, 0},
{"eval", Op_symbol, LEX_EVAL, 0, 0, 0},
{"exit", Op_K_exit, LEX_EXIT, 0, 0, 0},
-{"exp", Op_builtin, LEX_BUILTIN, A(1), do_exp, MPF(do_exp)},
+{"exp", Op_builtin, LEX_BUILTIN, A(1), do_exp, MPF(exp)},
{"extension", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_ext, 0},
{"fflush", Op_builtin, LEX_BUILTIN, RESX|A(0)|A(1), do_fflush, 0},
{"for", Op_K_for, LEX_FOR, BREAK|CONTINUE, 0, 0},
@@ -4539,29 +4541,29 @@ static const struct token tokentab[] = {
{"in", Op_symbol, LEX_IN, 0, 0, 0},
{"include", Op_symbol, LEX_INCLUDE, GAWKX, 0, 0},
{"index", Op_builtin, LEX_BUILTIN, A(2), do_index, 0},
-{"int", Op_builtin, LEX_BUILTIN, A(1), do_int, MPF(do_int)},
+{"int", Op_builtin, LEX_BUILTIN, A(1), do_int, MPF(int)},
{"isarray", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_isarray, 0},
{"length", Op_builtin, LEX_LENGTH, A(0)|A(1), do_length, 0},
-{"log", Op_builtin, LEX_BUILTIN, A(1), do_log, MPF(do_log)},
-{"lshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_lshift, MPF(do_lshift)},
+{"log", Op_builtin, LEX_BUILTIN, A(1), do_log, MPF(log)},
+{"lshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_lshift, MPF(lshift)},
{"match", Op_builtin, LEX_BUILTIN, NOT_OLD|A(2)|A(3), do_match, 0},
{"mktime", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_mktime, 0},
{"next", Op_K_next, LEX_NEXT, 0, 0, 0},
{"nextfile", Op_K_nextfile, LEX_NEXTFILE, GAWKX, 0, 0},
-{"or", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_or, MPF(do_or)},
+{"or", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_or, MPF(or)},
{"patsplit", Op_builtin, LEX_BUILTIN, GAWKX|A(2)|A(3)|A(4), do_patsplit, 0},
{"print", Op_K_print, LEX_PRINT, 0, 0, 0},
{"printf", Op_K_printf, LEX_PRINTF, 0, 0, 0},
-{"rand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0), do_rand, MPF(do_rand)},
+{"rand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0), do_rand, MPF(rand)},
{"return", Op_K_return, LEX_RETURN, NOT_OLD, 0, 0},
-{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(do_rhift)},
-{"sin", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_sin, MPF(do_sin)},
+{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(rhift)},
+{"sin", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_sin, MPF(sin)},
{"split", Op_builtin, LEX_BUILTIN, A(2)|A(3)|A(4), do_split, 0},
{"sprintf", Op_builtin, LEX_BUILTIN, 0, do_sprintf, 0},
-{"sqrt", Op_builtin, LEX_BUILTIN, A(1), do_sqrt, MPF(do_sqrt)},
-{"srand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0)|A(1), do_srand, MPF(do_srand)},
+{"sqrt", Op_builtin, LEX_BUILTIN, A(1), do_sqrt, MPF(sqrt)},
+{"srand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0)|A(1), do_srand, MPF(srand)},
{"strftime", Op_builtin, LEX_BUILTIN, GAWKX|A(0)|A(1)|A(2)|A(3), do_strftime, 0},
-{"strtonum", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_strtonum, MPF(do_strtonum)},
+{"strtonum", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_strtonum, MPF(strtonum)},
{"sub", Op_sub_builtin, LEX_BUILTIN, NOT_OLD|A(2)|A(3), 0, 0},
{"substr", Op_builtin, LEX_BUILTIN, A(2)|A(3), do_substr, 0},
{"switch", Op_K_switch, LEX_SWITCH, GAWKX|BREAK, 0, 0},
@@ -4570,7 +4572,7 @@ static const struct token tokentab[] = {
{"tolower", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_tolower, 0},
{"toupper", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_toupper, 0},
{"while", Op_K_while, LEX_WHILE, BREAK|CONTINUE, 0, 0},
-{"xor", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_xor, MPF(do_xor)},
+{"xor", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_xor, MPF(xor)},
};
#if MBS_SUPPORT
@@ -6576,6 +6578,8 @@ parms_shadow(INSTRUCTION *pc, int *shadow)
void
valinfo(NODE *n, Func_print print_func, FILE *fp)
{
+ /* FIXME -- MPFR */
+
if (n == Nnull_string)
print_func(fp, "uninitialized scalar\n");
else if (n->flags & STRING) {
@@ -7135,11 +7139,11 @@ 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 & (STRCUR|STRING)) == 0
- && (ip2->memory->flags & (STRCUR|STRING)) == 0
+ && (ip1->memory->flags & (MPFN|STRCUR|STRING)) == 0
+ && (ip2->memory->flags & (MPFN|STRCUR|STRING)) == 0
) {
NODE *n1 = ip1->memory, *n2 = ip2->memory;
- res = force_number(n1);
+ res = force_number(n1)->numbr;
(void) force_number(n2);
switch (op->opcode) {
case Op_times:
diff --git a/awkgram.y b/awkgram.y
index 74a5611a..b6fd00c0 100644
--- a/awkgram.y
+++ b/awkgram.y
@@ -870,6 +870,7 @@ simple_stmt
&& $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)
)
) {
@@ -1446,6 +1447,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
) {
NODE *n = $2->nexti->memory;
if ((n->flags & (STRCUR|STRING)) != 0) {
@@ -1794,7 +1796,7 @@ tokcompare(const void *l, const void *r)
*/
#ifdef HAVE_MPFR
-#define MPF(F) F##_mpfr
+#define MPF(F) do_mpfr_##F
#else
#define MPF(F) 0
#endif
@@ -1807,20 +1809,20 @@ static const struct token tokentab[] = {
#ifdef ARRAYDEBUG
{"adump", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2), do_adump, 0},
#endif
-{"and", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_and, MPF(do_and)},
+{"and", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_and, MPF(and)},
#ifdef ARRAYDEBUG
{"aoption", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_aoption, 0},
#endif
{"asort", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3), do_asort, 0},
{"asorti", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3), do_asorti, 0},
-{"atan2", Op_builtin, LEX_BUILTIN, NOT_OLD|A(2), do_atan2, MPF(do_atan2)},
+{"atan2", Op_builtin, LEX_BUILTIN, NOT_OLD|A(2), do_atan2, MPF(atan2)},
{"bindtextdomain", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2), do_bindtextdomain, 0},
{"break", Op_K_break, LEX_BREAK, 0, 0, 0},
{"case", Op_K_case, LEX_CASE, GAWKX, 0, 0},
{"close", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1)|A(2), do_close, 0},
-{"compl", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_compl, MPF(do_compl)},
+{"compl", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_compl, MPF(compl)},
{"continue", Op_K_continue, LEX_CONTINUE, 0, 0, 0},
-{"cos", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_cos, MPF(do_cos)},
+{"cos", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_cos, MPF(cos)},
{"dcgettext", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3), do_dcgettext, 0},
{"dcngettext", Op_builtin, LEX_BUILTIN, GAWKX|A(1)|A(2)|A(3)|A(4)|A(5), do_dcngettext, 0},
{"default", Op_K_default, LEX_DEFAULT, GAWKX, 0, 0},
@@ -1829,7 +1831,7 @@ static const struct token tokentab[] = {
{"else", Op_K_else, LEX_ELSE, 0, 0, 0},
{"eval", Op_symbol, LEX_EVAL, 0, 0, 0},
{"exit", Op_K_exit, LEX_EXIT, 0, 0, 0},
-{"exp", Op_builtin, LEX_BUILTIN, A(1), do_exp, MPF(do_exp)},
+{"exp", Op_builtin, LEX_BUILTIN, A(1), do_exp, MPF(exp)},
{"extension", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_ext, 0},
{"fflush", Op_builtin, LEX_BUILTIN, RESX|A(0)|A(1), do_fflush, 0},
{"for", Op_K_for, LEX_FOR, BREAK|CONTINUE, 0, 0},
@@ -1842,29 +1844,29 @@ static const struct token tokentab[] = {
{"in", Op_symbol, LEX_IN, 0, 0, 0},
{"include", Op_symbol, LEX_INCLUDE, GAWKX, 0, 0},
{"index", Op_builtin, LEX_BUILTIN, A(2), do_index, 0},
-{"int", Op_builtin, LEX_BUILTIN, A(1), do_int, MPF(do_int)},
+{"int", Op_builtin, LEX_BUILTIN, A(1), do_int, MPF(int)},
{"isarray", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_isarray, 0},
{"length", Op_builtin, LEX_LENGTH, A(0)|A(1), do_length, 0},
-{"log", Op_builtin, LEX_BUILTIN, A(1), do_log, MPF(do_log)},
-{"lshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_lshift, MPF(do_lshift)},
+{"log", Op_builtin, LEX_BUILTIN, A(1), do_log, MPF(log)},
+{"lshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_lshift, MPF(lshift)},
{"match", Op_builtin, LEX_BUILTIN, NOT_OLD|A(2)|A(3), do_match, 0},
{"mktime", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_mktime, 0},
{"next", Op_K_next, LEX_NEXT, 0, 0, 0},
{"nextfile", Op_K_nextfile, LEX_NEXTFILE, GAWKX, 0, 0},
-{"or", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_or, MPF(do_or)},
+{"or", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_or, MPF(or)},
{"patsplit", Op_builtin, LEX_BUILTIN, GAWKX|A(2)|A(3)|A(4), do_patsplit, 0},
{"print", Op_K_print, LEX_PRINT, 0, 0, 0},
{"printf", Op_K_printf, LEX_PRINTF, 0, 0, 0},
-{"rand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0), do_rand, MPF(do_rand)},
+{"rand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0), do_rand, MPF(rand)},
{"return", Op_K_return, LEX_RETURN, NOT_OLD, 0, 0},
-{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(do_rhift)},
-{"sin", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_sin, MPF(do_sin)},
+{"rshift", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_rshift, MPF(rhift)},
+{"sin", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_sin, MPF(sin)},
{"split", Op_builtin, LEX_BUILTIN, A(2)|A(3)|A(4), do_split, 0},
{"sprintf", Op_builtin, LEX_BUILTIN, 0, do_sprintf, 0},
-{"sqrt", Op_builtin, LEX_BUILTIN, A(1), do_sqrt, MPF(do_sqrt)},
-{"srand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0)|A(1), do_srand, MPF(do_srand)},
+{"sqrt", Op_builtin, LEX_BUILTIN, A(1), do_sqrt, MPF(sqrt)},
+{"srand", Op_builtin, LEX_BUILTIN, NOT_OLD|A(0)|A(1), do_srand, MPF(srand)},
{"strftime", Op_builtin, LEX_BUILTIN, GAWKX|A(0)|A(1)|A(2)|A(3), do_strftime, 0},
-{"strtonum", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_strtonum, MPF(do_strtonum)},
+{"strtonum", Op_builtin, LEX_BUILTIN, GAWKX|A(1), do_strtonum, MPF(strtonum)},
{"sub", Op_sub_builtin, LEX_BUILTIN, NOT_OLD|A(2)|A(3), 0, 0},
{"substr", Op_builtin, LEX_BUILTIN, A(2)|A(3), do_substr, 0},
{"switch", Op_K_switch, LEX_SWITCH, GAWKX|BREAK, 0, 0},
@@ -1873,7 +1875,7 @@ static const struct token tokentab[] = {
{"tolower", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_tolower, 0},
{"toupper", Op_builtin, LEX_BUILTIN, NOT_OLD|A(1), do_toupper, 0},
{"while", Op_K_while, LEX_WHILE, BREAK|CONTINUE, 0, 0},
-{"xor", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_xor, MPF(do_xor)},
+{"xor", Op_builtin, LEX_BUILTIN, GAWKX|A(2), do_xor, MPF(xor)},
};
#if MBS_SUPPORT
@@ -3879,6 +3881,8 @@ parms_shadow(INSTRUCTION *pc, int *shadow)
void
valinfo(NODE *n, Func_print print_func, FILE *fp)
{
+ /* FIXME -- MPFR */
+
if (n == Nnull_string)
print_func(fp, "uninitialized scalar\n");
else if (n->flags & STRING) {
@@ -4438,11 +4442,11 @@ 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 & (STRCUR|STRING)) == 0
- && (ip2->memory->flags & (STRCUR|STRING)) == 0
+ && (ip1->memory->flags & (MPFN|STRCUR|STRING)) == 0
+ && (ip2->memory->flags & (MPFN|STRCUR|STRING)) == 0
) {
NODE *n1 = ip1->memory, *n2 = ip2->memory;
- res = force_number(n1);
+ res = force_number(n1)->numbr;
(void) force_number(n2);
switch (op->opcode) {
case Op_times:
diff --git a/builtin.c b/builtin.c
index 0c9553ab..d403b7a2 100644
--- a/builtin.c
+++ b/builtin.c
@@ -135,7 +135,7 @@ do_exp(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("exp: received non-numeric argument"));
- d = force_number(tmp);
+ d = force_number(tmp)->numbr;
DEREF(tmp);
errno = 0;
res = exp(d);
@@ -459,7 +459,7 @@ do_int(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("int: received non-numeric argument"));
- d = force_number(tmp);
+ d = force_number(tmp)->numbr;
d = double_to_int(d);
DEREF(tmp);
return make_number((AWKNUM) d);
@@ -537,7 +537,7 @@ do_log(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("log: received non-numeric argument"));
- arg = (double) force_number(tmp);
+ arg = force_number(tmp)->numbr;
if (arg < 0.0)
warning(_("log: received negative argument %g"), arg);
d = log(arg);
@@ -644,7 +644,6 @@ format_tree(
char *chp;
size_t copy_count, char_count;
#ifdef HAVE_MPFR
- extern mpz_t mpzval; /* initialized in mpfr.c */
enum { MPFR_INT_WITH_PREC = 1, MPFR_INT_WITHOUT_PREC, MPFR_FLOAT } mpfr_fmt_type;
#endif
static const char sp[] = " ";
@@ -869,7 +868,8 @@ check_pos:
} else {
parse_next_arg();
}
- *cur = force_number(arg);
+ (void) force_number(arg);
+ *cur = get_number_si(arg);
if (*cur < 0 && cur == &fw) {
*cur = -*cur;
lj++;
@@ -977,7 +977,7 @@ check_pos:
if ((arg->flags & (MAYBE_NUM|NUMBER)) == MAYBE_NUM)
(void) force_number(arg);
if (arg->flags & NUMBER) {
- uval = (uintmax_t) arg->numbr;
+ uval = get_number_uj(arg);
#if MBS_SUPPORT
if (gawk_mb_cur_max > 1) {
char buf[100];
@@ -1183,17 +1183,40 @@ out2:
#ifdef HAVE_MPFR
if (arg->flags & MPFN) {
+ mpfr_ptr mt;
mpfr_int:
- if (have_prec && prec == 0)
- zero_flag = FALSE;
+ mt = arg->mpfr_numbr;
+ if (! mpfr_number_p(mt)) {
+ /* inf or NaN */
+ cs1 = 'g';
+ goto format_float;
+ }
+
+ if (cs1 != 'd' && cs1 != 'i') {
+ if (mpfr_sgn(mt) < 0) {
+ if (! mpfr_fits_intmax_p(mt, RND_MODE)) {
+ /* -ve number is too large */
+ cs1 = 'g';
+ goto format_float;
+ }
+ uval = (uintmax_t) mpfr_get_sj(mt, RND_MODE);
+ goto format_fixed_int;
+ }
+ 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)));
- (void) mpfr_get_z(mpzval, arg->mpfr_numbr, MPFR_RNDZ);
- mpfr_fmt_type = have_prec ? MPFR_INT_WITH_PREC : MPFR_INT_WITHOUT_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;
} else
#endif
- tmpval = arg->numbr;
-
+ tmpval = arg->numbr;
+
/*
* ``The result of converting a zero value with a
* precision of zero is no characters.''
@@ -1211,14 +1234,14 @@ mpfr_int:
if (tmpval < 0) {
uval = (uintmax_t) (intmax_t) tmpval;
- if ((AWKNUM)(intmax_t)uval !=
- double_to_int(tmpval))
+ if ((AWKNUM)(intmax_t)uval != double_to_int(tmpval))
goto out_of_range;
} else {
uval = (uintmax_t) tmpval;
if ((AWKNUM)uval != double_to_int(tmpval))
goto out_of_range;
}
+ format_fixed_int:
/*
* When to fill with zeroes is of course not simple.
* First: No zero fill if left-justifying.
@@ -1319,8 +1342,10 @@ mpfr_int:
format_float:
if ((arg->flags & MPFN) == 0)
tmpval = arg->numbr;
+#ifdef HAVE_MPFR
else
mpfr_fmt_type = MPFR_FLOAT;
+#endif
if (! have_prec)
prec = DEFAULT_G_PRECISION;
format_int:
@@ -1339,7 +1364,7 @@ mpfr_int:
*cp++ = '\'';
#ifdef HAVE_MPFR
- if (do_mpfr) {
+ if (arg->flags & MPFN) {
if (mpfr_fmt_type == MPFR_INT_WITH_PREC) {
strcpy(cp, "*.*Z");
cp += 4;
@@ -1375,7 +1400,7 @@ mpfr_int:
while ((n = mpfr_snprintf(obufout, ofre, cpbuf,
(int) fw, mpzval)) >= ofre)
chksize(n)
- } else {
+ } else {
while ((n = mpfr_snprintf(obufout, ofre, cpbuf,
(int) fw, (int) prec, RND_MODE,
arg->mpfr_numbr)) >= ofre)
@@ -1546,7 +1571,7 @@ do_sqrt(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("sqrt: received non-numeric argument"));
- arg = (double) force_number(tmp);
+ arg = (double) force_number(tmp)->numbr;
DEREF(tmp);
if (arg < 0.0)
warning(_("sqrt: called with negative argument %g"), arg);
@@ -1565,9 +1590,16 @@ do_substr(int nargs)
double d_index = 0, d_length = 0;
size_t src_len;
- if (nargs == 3)
- POP_NUMBER(d_length);
- POP_NUMBER(d_index);
+ if (nargs == 3) {
+ t1 = POP_NUMBER();
+ d_length = get_number_d(t1);
+ DEREF(t1);
+ }
+
+ t1 = POP_NUMBER();
+ d_index = get_number_d(t1);
+ DEREF(t1);
+
t1 = POP_STRING();
if (nargs == 3) {
@@ -1751,7 +1783,8 @@ do_strftime(int nargs)
t2 = POP_SCALAR();
if (do_lint && (t2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("strftime: received non-numeric second argument"));
- clock_val = (long) force_number(t2);
+ (void) force_number(t2);
+ clock_val = get_number_si(t2);
if (clock_val < 0)
fatal(_("strftime: second argument less than 0 or too big for time_t"));
fclock = (time_t) clock_val;
@@ -2169,8 +2202,8 @@ do_atan2(int nargs)
if ((t2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("atan2: received non-numeric second argument"));
}
- d1 = force_number(t1);
- d2 = force_number(t2);
+ d1 = force_number(t1)->numbr;
+ d2 = force_number(t2)->numbr;
DEREF(t1);
DEREF(t2);
return make_number((AWKNUM) atan2(d1, d2));
@@ -2187,7 +2220,7 @@ do_sin(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("sin: received non-numeric argument"));
- d = sin((double) force_number(tmp));
+ d = sin((double) force_number(tmp)->numbr);
DEREF(tmp);
return make_number((AWKNUM) d);
}
@@ -2203,7 +2236,7 @@ do_cos(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("cos: received non-numeric argument"));
- d = cos((double) force_number(tmp));
+ d = cos((double) force_number(tmp)->numbr);
DEREF(tmp);
return make_number((AWKNUM) d);
}
@@ -2256,7 +2289,7 @@ do_srand(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("srand: received non-numeric argument"));
- srandom((unsigned int) (save_seed = (long) force_number(tmp)));
+ srandom((unsigned int) (save_seed = (long) force_number(tmp)->numbr));
DEREF(tmp);
}
return make_number((AWKNUM) ret);
@@ -2533,15 +2566,16 @@ do_sub(int nargs, unsigned int flags)
if (t1->stlen > 0 && (t1->stptr[0] == 'g' || t1->stptr[0] == 'G'))
how_many = -1;
else {
- d = force_number(t1);
-
+ (void) force_number(t1);
+ d = get_number_d(t1);
if ((t1->flags & NUMCUR) != 0)
goto set_how_many;
how_many = 1;
}
} else {
- d = force_number(t1);
+ (void) force_number(t1);
+ d = get_number_d(t1);
set_how_many:
if (d < 1)
how_many = 1;
@@ -2847,8 +2881,8 @@ do_lshift(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("lshift: received non-numeric second argument"));
}
- val = force_number(s1);
- shift = force_number(s2);
+ val = force_number(s1)->numbr;
+ shift = force_number(s2)->numbr;
if (do_lint) {
if (val < 0 || shift < 0)
lintwarn(_("lshift(%lf, %lf): negative values will give strange results"), val, shift);
@@ -2884,8 +2918,8 @@ do_rshift(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("rshift: received non-numeric second argument"));
}
- val = force_number(s1);
- shift = force_number(s2);
+ val = force_number(s1)->numbr;
+ shift = force_number(s2)->numbr;
if (do_lint) {
if (val < 0 || shift < 0)
lintwarn(_("rshift(%lf, %lf): negative values will give strange results"), val, shift);
@@ -2921,8 +2955,8 @@ do_and(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("and: received non-numeric second argument"));
}
- left = force_number(s1);
- right = force_number(s2);
+ left = force_number(s1)->numbr;
+ right = force_number(s2)->numbr;
if (do_lint) {
if (left < 0 || right < 0)
lintwarn(_("and(%lf, %lf): negative values will give strange results"), left, right);
@@ -2956,8 +2990,8 @@ do_or(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("or: received non-numeric second argument"));
}
- left = force_number(s1);
- right = force_number(s2);
+ left = force_number(s1)->numbr;
+ right = force_number(s2)->numbr;
if (do_lint) {
if (left < 0 || right < 0)
lintwarn(_("or(%lf, %lf): negative values will give strange results"), left, right);
@@ -2985,8 +3019,6 @@ do_xor(int nargs)
AWKNUM left, right;
POP_TWO_SCALARS(s1, s2);
- left = force_number(s1);
- right = force_number(s2);
if (do_lint) {
if ((s1->flags & (NUMCUR|NUMBER)) == 0)
@@ -2994,8 +3026,8 @@ do_xor(int nargs)
if ((s2->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("xor: received non-numeric second argument"));
}
- left = force_number(s1);
- right = force_number(s2);
+ left = force_number(s1)->numbr;
+ right = force_number(s2)->numbr;
if (do_lint) {
if (left < 0 || right < 0)
lintwarn(_("xor(%lf, %lf): negative values will give strange results"), left, right);
@@ -3025,7 +3057,7 @@ do_compl(int nargs)
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("compl: received non-numeric argument"));
- d = force_number(tmp);
+ d = force_number(tmp)->numbr;
DEREF(tmp);
if (do_lint) {
@@ -3052,11 +3084,11 @@ do_strtonum(int nargs)
tmp = POP_SCALAR();
if ((tmp->flags & (NUMBER|NUMCUR)) != 0)
- d = (AWKNUM) force_number(tmp);
+ d = (AWKNUM) force_number(tmp)->numbr;
else if (get_numbase(tmp->stptr, use_lc_numeric) != 10)
d = nondec2awknum(tmp->stptr, tmp->stlen);
else
- d = (AWKNUM) force_number(tmp);
+ d = (AWKNUM) force_number(tmp)->numbr;
DEREF(tmp);
return make_number((AWKNUM) d);
@@ -3306,7 +3338,10 @@ do_dcngettext(int nargs)
}
#endif
- POP_NUMBER(d); /* third argument */
+ t2 = POP_NUMBER(); /* third argument */
+ d = get_number_d(t2);
+ DEREF(t2);
+
number = (unsigned long) double_to_int(d);
t2 = POP_STRING(); /* second argument */
string2 = t2->stptr;
diff --git a/eval.c b/eval.c
index ffe7bdd1..920855a8 100644
--- a/eval.c
+++ b/eval.c
@@ -583,9 +583,19 @@ cmp_nodes(NODE *t1, NODE *t2)
if (t1->flags & INTIND)
t1 = force_string(t1);
if (t2->flags & INTIND)
- t2 = force_string(t2);
+ t2 = force_string(t2);
if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
+#ifdef HAVE_MPFR
+ if (t1->flags & MPFN) {
+ assert((t2->flags & MPFN) != 0);
+
+ /* Note: returns zero if either t1 or t2 is NaN */
+ return mpfr_cmp(t1->mpfr_numbr, t2->mpfr_numbr);
+ }
+ assert((t2->flags & MPFN) == 0);
+#endif
+
if (t1->numbr == t2->numbr)
ret = 0;
/* don't subtract, in case one or both are infinite */
@@ -1023,10 +1033,12 @@ update_ERRNO()
void
update_NR()
{
- double d;
-
- d = get_number_d(NR_node->var_value);
- if (d != NR) {
+#ifdef HAVE_MPFR
+ if ((NR_node->var_value->flags & MPFN) != 0)
+ mpfr_update_var(NR_node);
+ else
+#endif
+ if (NR_node->var_value->numbr != NR) {
unref(NR_node->var_value);
NR_node->var_value = make_number((AWKNUM) NR);
}
@@ -1053,10 +1065,12 @@ update_NF()
void
update_FNR()
{
- double d;
-
- d = get_number_d(FNR_node->var_value);
- if (d != FNR) {
+#ifdef HAVE_MPFR
+ if ((FNR_node->var_value->flags & MPFN) != 0)
+ mpfr_update_var(FNR_node);
+ else
+#endif
+ if (FNR_node->var_value->numbr != FNR) {
unref(FNR_node->var_value);
FNR_node->var_value = make_number((AWKNUM) FNR);
}
@@ -1156,7 +1170,9 @@ r_get_field(NODE *n, Func_ptr *assign, int reference)
}
}
- field_num = (long) force_number(n);
+ (void) force_number(n);
+ field_num = get_number_si(n);
+
if (field_num < 0)
fatal(_("attempt to access field %ld"), field_num);
@@ -1495,7 +1511,7 @@ eval_condition(NODE *t)
force_number(t);
if ((t->flags & NUMBER) != 0)
- return (t->numbr != 0.0);
+ return is_nonzero_num(t);
return (t->stlen != 0);
}
@@ -1527,13 +1543,16 @@ static void
op_assign(OPCODE op)
{
NODE **lhs;
- NODE *t1;
+ NODE *t1, *t2;
AWKNUM x = 0.0, x1, x2;
lhs = POP_ADDRESS();
t1 = *lhs;
- x1 = force_number(t1);
- TOP_NUMBER(x2);
+ x1 = force_number(t1)->numbr;
+
+ t2 = TOP_SCALAR();
+ x2 = force_number(t2)->numbr;
+ DEREF(t2);
switch (op) {
case Op_assign_plus:
@@ -1583,7 +1602,6 @@ op_assign(OPCODE op)
REPLACE(t1);
}
-
/* PUSH_CODE --- push a code onto the runtime stack */
void
@@ -1700,13 +1718,19 @@ init_interpret()
/* initialize TRUE and FALSE nodes */
node_Boolean[FALSE] = make_number(0);
- node_Boolean[FALSE]->flags |= NUMINT;
node_Boolean[TRUE] = make_number(1.0);
- node_Boolean[TRUE]->flags |= NUMINT;
+ if ((node_Boolean[FALSE]->flags & MPFN) == 0) {
+ node_Boolean[FALSE]->flags |= NUMINT;
+ node_Boolean[TRUE]->flags |= NUMINT;
+ }
/* select the interpreter routine */
if (do_debug)
interpret = debug_interpret;
+#ifdef HAVE_MPFR
+ else if (do_mpfr)
+ interpret = mpfr_interpret;
+#endif
else
interpret = r_interpret;
}
@@ -1722,3 +1746,10 @@ init_interpret()
#undef DEBUGGING
#undef r_interpret
+#ifdef HAVE_MPFR
+#define r_interpret mpfr_interpret
+#define EXE_MPFR 1
+#include "interpret.h"
+#undef EXE_MPFR
+#undef r_interpret
+#endif
diff --git a/int_array.c b/int_array.c
index 9dd20bea..d9983109 100644
--- a/int_array.c
+++ b/int_array.c
@@ -86,7 +86,7 @@ is_integer(NODE *symbol, NODE *subs)
long l;
AWKNUM d;
- if (subs == Nnull_string)
+ if (subs == Nnull_string || do_mpfr)
return NULL;
if ((subs->flags & NUMINT) != 0)
diff --git a/interpret.h b/interpret.h
index 67a702e3..83e78056 100644
--- a/interpret.h
+++ b/interpret.h
@@ -1,31 +1,27 @@
/*
- * interpret:
- * code is a list of instructions to run. returns the exit value
- * from the awk code.
- */
-
- /* N.B.:
- * 1) reference counting done for both number and string values.
- * 2) Stack operations:
- * Use REPLACE[_XX] if last stack operation was TOP[_XX],
- * PUSH[_XX] if last operation was POP[_XX] instead.
- * 3) UPREF and DREF -- see awk.h
+ * interpret --- code is a list of instructions to run.
*/
+#ifdef EXE_MPFR
+#define NV(r) r->mpfr_numbr
+#else
+#define NV(r) r->numbr
+#endif
+
+
int
r_interpret(INSTRUCTION *code)
{
INSTRUCTION *pc; /* current instruction */
+ OPCODE op; /* current opcode */
NODE *r = NULL;
NODE *m;
INSTRUCTION *ni;
NODE *t1, *t2;
- NODE *f; /* function definition */
NODE **lhs;
- AWKNUM x, x1, x2;
+ AWKNUM x;
int di;
Regexp *rp;
- int stdio_problem = FALSE;
/* array subscript */
#define mk_sub(n) (n == 1 ? POP_SCALAR() : concat_exp(n, TRUE))
@@ -52,11 +48,11 @@ top:
sourceline = pc->source_line;
#ifdef DEBUGGING
- if (! pre_execute(&pc))
+ if (! pre_execute(& pc))
goto top;
#endif
- switch (pc->opcode) {
+ switch ((op = pc->opcode)) {
case Op_rule:
currule = pc->in_rule; /* for sole use in Op_K_next, Op_K_nextfile, Op_K_getline */
/* fall through */
@@ -65,6 +61,9 @@ top:
break;
case Op_atexit:
+ {
+ int stdio_problem = FALSE;
+
/* avoid false source indications */
source = NULL;
sourceline = 0;
@@ -87,6 +86,7 @@ top:
*/
if (stdio_problem && ! exiting && exit_val == 0)
exit_val = 1;
+ }
break;
case Op_stop:
@@ -147,7 +147,7 @@ top:
break;
case Node_var_array:
- if (pc->opcode == Op_push_arg)
+ if (op == Op_push_arg)
PUSH(m);
else
fatal(_("attempt to use array `%s' in a scalar context"),
@@ -303,8 +303,7 @@ top:
t1 = POP_SCALAR();
di = eval_condition(t1);
DEREF(t1);
- if ((pc->opcode == Op_and && di)
- || (pc->opcode == Op_or && ! di))
+ if ((op == Op_and && di) || (op == Op_or && ! di))
break;
r = node_Boolean[di];
UPREF(r);
@@ -366,128 +365,198 @@ top:
break;
case Op_plus_i:
- x2 = force_number(pc->memory);
+ t2 = force_number(pc->memory);
goto plus;
-
case Op_plus:
- POP_NUMBER(x2);
+ t2 = POP_NUMBER();
plus:
- TOP_NUMBER(x1);
- r = make_number(x1 + x2);
+ t1 = TOP_NUMBER();
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_add(NV(r), NV(t1), NV(t2), RND_MODE);
+#else
+ r = make_number(NV(t1) + NV(t2));
+#endif
+ DEREF(t1);
+ if (op == Op_plus)
+ DEREF(t2);
REPLACE(r);
break;
case Op_minus_i:
- x2 = force_number(pc->memory);
+ t2 = force_number(pc->memory);
goto minus;
-
case Op_minus:
- POP_NUMBER(x2);
+ t2 = POP_NUMBER();
minus:
- TOP_NUMBER(x1);
- r = make_number(x1 - x2);
+ t1 = TOP_NUMBER();
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_sub(NV(r), NV(t1), NV(t2), RND_MODE);
+#else
+ r = make_number(NV(t1) - NV(t2));
+#endif
+ DEREF(t1);
+ if (op == Op_minus)
+ DEREF(t2);
REPLACE(r);
break;
case Op_times_i:
- x2 = force_number(pc->memory);
+ t2 = force_number(pc->memory);
goto times;
-
case Op_times:
- POP_NUMBER(x2);
+ t2 = POP_NUMBER();
times:
- TOP_NUMBER(x1);
- r = make_number(x1 * x2);
+ t1 = TOP_NUMBER();
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_mul(NV(r), NV(t1), NV(t2), RND_MODE);
+#else
+ r = make_number(NV(t1) * NV(t2));
+#endif
+ DEREF(t1);
+ if (op == Op_times)
+ DEREF(t2);
REPLACE(r);
break;
case Op_exp_i:
- x2 = force_number(pc->memory);
- goto exponent;
-
+ t2 = force_number(pc->memory);
+ goto exp;
case Op_exp:
- POP_NUMBER(x2);
-exponent:
- TOP_NUMBER(x1);
- x = calc_exp(x1, x2);
+ t2 = POP_NUMBER();
+exp:
+ t1 = TOP_NUMBER();
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_pow(NV(r), NV(t1), NV(t2), RND_MODE);
+#else
+ x = calc_exp(NV(t1), NV(t2));
r = make_number(x);
+#endif
+ DEREF(t1);
+ if (op == Op_exp)
+ DEREF(t2);
REPLACE(r);
break;
case Op_quotient_i:
- x2 = force_number(pc->memory);
+ t2 = force_number(pc->memory);
goto quotient;
-
case Op_quotient:
- POP_NUMBER(x2);
+ t2 = POP_NUMBER();
quotient:
- if (x2 == 0)
+ t1 = TOP_NUMBER();
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_div(NV(r), NV(t1), NV(t2), RND_MODE);
+#else
+ if (NV(t2) == 0)
fatal(_("division by zero attempted"));
-
- TOP_NUMBER(x1);
- x = x1 / x2;
+ x = NV(t1) / NV(t2);
r = make_number(x);
+#endif
+ DEREF(t1);
+ if (op == Op_quotient)
+ DEREF(t2);
REPLACE(r);
break;
case Op_mod_i:
- x2 = force_number(pc->memory);
+ t2 = force_number(pc->memory);
goto mod;
-
case Op_mod:
- POP_NUMBER(x2);
+ t2 = POP_NUMBER();
mod:
- if (x2 == 0)
+ t1 = TOP_NUMBER();
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_fmod(NV(r), NV(t1), NV(t2), RND_MODE);
+#else
+ if (NV(t2) == 0)
fatal(_("division by zero attempted in `%%'"));
-
- TOP_NUMBER(x1);
#ifdef HAVE_FMOD
- x = fmod(x1, x2);
+ x = fmod(NV(t1), NV(t2));
#else /* ! HAVE_FMOD */
- (void) modf(x1 / x2, &x);
- x = x1 - x * x2;
+ (void) modf(NV(t1) / NV(t2), &x);
+ x = NV(t1) - x * NV(t2);
#endif /* ! HAVE_FMOD */
r = make_number(x);
+#endif
+ DEREF(t1);
+ if (op == Op_mod)
+ DEREF(t2);
REPLACE(r);
- break;
+ break;
case Op_preincrement:
case Op_predecrement:
- x2 = pc->opcode == Op_preincrement ? 1.0 : -1.0;
+ x = op == Op_preincrement ? 1.0 : -1.0;
lhs = TOP_ADDRESS();
t1 = *lhs;
- x1 = force_number(t1);
+ force_number(t1);
if (t1->valref == 1 && t1->flags == (MALLOC|NUMCUR|NUMBER)) {
/* optimization */
- t1->numbr = x1 + x2;
+#ifdef EXE_MPFR
+ mpfr_add_d(NV(t1), NV(t1), x, RND_MODE);
+#else
+ NV(t1) += x;
+#endif
+ r = t1;
} else {
+#ifdef EXE_MPFR
+ r = *lhs = mpfr_node();
+ mpfr_add_d(NV(r), NV(t1), x, RND_MODE);
+#else
+ r = *lhs = make_number(NV(t1) + x);
+#endif
unref(t1);
- t1 = *lhs = make_number(x1 + x2);
}
- UPREF(t1);
- REPLACE(t1);
+ UPREF(r);
+ REPLACE(r);
break;
case Op_postincrement:
case Op_postdecrement:
- x2 = pc->opcode == Op_postincrement ? 1.0 : -1.0;
+ x = op == Op_postincrement ? 1.0 : -1.0;
lhs = TOP_ADDRESS();
t1 = *lhs;
- x1 = force_number(t1);
+ force_number(t1);
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_set(NV(r), NV(t1), RND_MODE); /* r = t1 */
if (t1->valref == 1 && t1->flags == (MALLOC|NUMCUR|NUMBER)) {
/* optimization */
- t1->numbr = x1 + x2;
+ mpfr_add_d(NV(t1), NV(t1), x, RND_MODE);
} else {
+ t2 = *lhs = mpfr_node();
+ mpfr_add_d(NV(t2), NV(t1), x, RND_MODE);
unref(t1);
- *lhs = make_number(x1 + x2);
}
- r = make_number(x1);
+#else
+ r = make_number(NV(t1));
+ if (t1->valref == 1 && t1->flags == (MALLOC|NUMCUR|NUMBER)) {
+ /* optimization */
+ NV(t1) += x;
+ } else {
+ *lhs = make_number(NV(t1) + x);
+ unref(t1);
+ }
+#endif
REPLACE(r);
break;
case Op_unary_minus:
- TOP_NUMBER(x1);
- r = make_number(-x1);
+ t1 = TOP_NUMBER();
+#ifdef EXE_MPFR
+ r = mpfr_node();
+ mpfr_set(NV(r), NV(t1), RND_MODE); /* r = t1 */
+ mpfr_neg(NV(r), NV(r), RND_MODE); /* change sign */
+#else
+ r = make_number(-NV(t1));
+#endif
+ DEREF(t1);
REPLACE(r);
break;
@@ -532,7 +601,7 @@ mod:
Func_ptr assign;
t1 = TOP_SCALAR();
- lhs = r_get_field(t1, &assign, FALSE);
+ lhs = r_get_field(t1, & assign, FALSE);
decr_sp();
DEREF(t1);
unref(*lhs);
@@ -555,7 +624,7 @@ mod:
*lhs = dupnode(t1);
}
- if (t1 != t2 && t1->valref == 1) {
+ if (t1 != t2 && t1->valref == 1 && (t1->flags & MPFN) == 0) {
size_t nlen = t1->stlen + t2->stlen;
erealloc(t1->stptr, char *, nlen + 2, "r_interpret");
@@ -592,7 +661,11 @@ mod:
case Op_assign_quotient:
case Op_assign_mod:
case Op_assign_exp:
- op_assign(pc->opcode);
+#ifdef EXE_MPFR
+ op_mpfr_assign(op);
+#else
+ op_assign(op);
+#endif
break;
case Op_var_update: /* update value of NR, FNR or NF */
@@ -601,8 +674,18 @@ mod:
case Op_var_assign:
case Op_field_assign:
+ r = TOP();
+#ifdef EXE_MPFR
+ di = mpfr_sgn(NV(r));
+#else
+ if (NV(r) < 0.0)
+ di = -1;
+ else
+ di = (NV(r) > 0.0);
+#endif
+
if (pc->assign_ctxt == Op_sub_builtin
- && TOP()->numbr == 0.0 /* top of stack has a number == 0 */
+ && di == 0 /* top of stack has a number == 0 */
) {
/* There wasn't any substitutions. If the target is a FIELD,
* this means no field re-splitting or $0 reconstruction.
@@ -612,14 +695,14 @@ mod:
break;
} else if ((pc->assign_ctxt == Op_K_getline
|| pc->assign_ctxt == Op_K_getline_redir)
- && TOP()->numbr <= 0.0 /* top of stack has a number <= 0 */
+ && di <= 0 /* top of stack has a number <= 0 */
) {
/* getline returned EOF or error */
break;
}
- if (pc->opcode == Op_var_assign)
+ if (op == Op_var_assign)
pc->assign_var();
else
pc->field_assign();
@@ -649,7 +732,6 @@ mod:
if (di) {
/* match found */
-
t2 = POP_SCALAR();
DEREF(t2);
JUMPTO(pc->target_jmp);
@@ -671,9 +753,10 @@ mod:
case Op_in_array:
t1 = POP_ARRAY();
t2 = mk_sub(pc->expr_count);
- di = (in_array(t1, t2) != NULL);
+ r = node_Boolean[(in_array(t1, t2) != NULL)];
DEREF(t2);
- PUSH(make_number((AWKNUM) di));
+ UPREF(r);
+ PUSH(r);
break;
case Op_arrayfor_init:
@@ -816,8 +899,8 @@ match_re:
di = research(rp, t1->stptr, 0, t1->stlen,
avoid_dfa(m, t1->stptr, t1->stlen));
- di = (di == -1) ^ (pc->opcode != Op_nomatch);
- if(pc->opcode != Op_match_rec) {
+ di = (di == -1) ^ (op != Op_nomatch);
+ if (op != Op_match_rec) {
decr_sp();
DEREF(t1);
}
@@ -842,9 +925,9 @@ match_re:
case Op_indirect_func_call:
{
+ NODE *f = NULL;
int arg_count;
- f = NULL;
arg_count = (pc + 1)->expr_count;
t1 = PEEK(arg_count); /* indirect var */
assert(t1->type == Node_val); /* @a[1](p) not allowed in grammar */
@@ -855,7 +938,8 @@ match_re:
if (f != NULL && strcmp(f->vname, t1->stptr) == 0) {
/* indirect var hasn't been reassigned */
- goto func_call;
+ ni = setup_frame(pc);
+ JUMPTO(ni); /* Op_func */
}
f = lookup(t1->stptr);
}
@@ -865,10 +949,14 @@ match_re:
pc->func_name);
pc->func_body = f; /* save for next call */
- goto func_call;
+ ni = setup_frame(pc);
+ JUMPTO(ni); /* Op_func */
}
case Op_func_call:
+ {
+ NODE *f;
+
/* retrieve function definition node */
f = pc->func_body;
if (f == NULL) {
@@ -894,11 +982,9 @@ match_re:
JUMPTO(ni);
}
-func_call:
ni = setup_frame(pc);
-
- /* run the function instructions */
- JUMPTO(ni); /* Op_func */
+ JUMPTO(ni); /* Op_func */
+ }
case Op_K_return:
m = POP_SCALAR(); /* return value */
@@ -1074,8 +1160,10 @@ func_call:
fatal(_("`exit' cannot be called in the current context"));
exiting = TRUE;
- POP_NUMBER(x1);
- exit_val = (int) x1;
+ t1 = POP_SCALAR();
+ (void) force_number(t1);
+ exit_val = (int) get_number_si(t1);
+ DEREF(t1);
#ifdef VMS
if (exit_val == 0)
exit_val = EXIT_SUCCESS;
@@ -1171,7 +1259,7 @@ func_call:
break;
default:
- fatal(_("Sorry, don't know how to interpret `%s'"), opcode2str(pc->opcode));
+ fatal(_("Sorry, don't know how to interpret `%s'"), opcode2str(op));
}
JUMPTO(pc->nexti);
@@ -1185,3 +1273,4 @@ func_call:
#undef JUMPTO
}
+#undef NV
diff --git a/io.c b/io.c
index 3eaceb88..66847e5c 100644
--- a/io.c
+++ b/io.c
@@ -233,7 +233,6 @@ extern NODE *ARGIND_node;
extern NODE *ERRNO_node;
extern NODE **fields_arr;
-/* init_io --- set up timeout related variables */
void
init_io()
@@ -391,6 +390,10 @@ nextfile(IOBUF **curfile, int skipping)
/* This is a kludge. */
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);
+#endif
FNR = 0;
iop = *curfile = iop_alloc(fd, fname, &mybuf, FALSE);
if (fd == INVALID_HANDLE)
@@ -437,7 +440,12 @@ void
set_FNR()
{
(void) force_number(FNR_node->var_value);
- FNR = get_number_si(FNR_node->var_value);
+#ifdef HAVE_MPFR
+ if ((FNR_node->var_value->flags & MPFN) != 0)
+ FNR = mpfr_set_var(FNR_node);
+ else
+#endif
+ FNR = FNR_node->var_value->numbr;
}
/* set_NR --- update internal NR from awk variable */
@@ -446,7 +454,12 @@ void
set_NR()
{
(void) force_number(NR_node->var_value);
- NR = get_number_si(NR_node->var_value);
+#ifdef HAVE_MPFR
+ if ((NR_node->var_value->flags & MPFN) != 0)
+ NR = mpfr_set_var(NR_node);
+ else
+#endif
+ NR = NR_node->var_value->numbr;
}
/* inrec --- This reads in a record from the input file */
@@ -470,8 +483,8 @@ inrec(IOBUF *iop, int *errcode)
if (*errcode > 0)
update_ERRNO_saved(*errcode);
} else {
- NR += 1;
- FNR += 1;
+ INCREMNT(NR);
+ INCREMNT(FNR);
set_record(begin, cnt);
}
@@ -2302,8 +2315,8 @@ do_getline(int intovar, IOBUF *iop)
if (cnt == EOF)
return NULL; /* try next file */
- NR++;
- FNR++;
+ INCREMNT(NR);
+ INCREMNT(FNR);
if (! intovar) /* no optional var. */
set_record(s, cnt);
@@ -3256,7 +3269,7 @@ pty_vs_pipe(const char *command)
if (val->flags & MAYBE_NUM)
(void) force_number(val);
if (val->flags & NUMBER)
- return (val->numbr != 0.0);
+ return is_nonzero_num(val);
else
return (val->stlen != 0);
}
@@ -3389,8 +3402,10 @@ get_read_timeout(IOBUF *iop)
} else /* use cached full index */
val = in_array(PROCINFO_node, full_idx);
- if (val != NULL)
- tmout = (long) force_number(val);
+ if (val != NULL) {
+ (void) force_number(val);
+ tmout = get_number_si(val);
+ }
} else
tmout = read_default_timeout; /* initialized from env. variable in init_io() */
diff --git a/main.c b/main.c
index a7ebb296..00a63d5a 100644
--- a/main.c
+++ b/main.c
@@ -450,7 +450,9 @@ main(int argc, char **argv)
break;
case 'M':
+#ifdef HAVE_MPFR
do_flags |= DO_MPFR;
+#endif
break;
case 'P':
@@ -956,9 +958,7 @@ static const struct varinit varinit[] = {
{&FPAT_node, "FPAT", "[^[:space:]]+", 0, NULL, set_FPAT, FALSE, NON_STANDARD },
{&IGNORECASE_node, "IGNORECASE", NULL, 0, NULL, set_IGNORECASE, FALSE, NON_STANDARD },
{&LINT_node, "LINT", NULL, 0, NULL, set_LINT, FALSE, NON_STANDARD },
-#ifdef HAVE_MPFR
{&PREC_node, "PREC", NULL, DEFAULT_PREC, NULL, set_PREC, FALSE, NON_STANDARD},
-#endif
{&NF_node, "NF", NULL, -1, update_NF, set_NF, FALSE, 0 },
{&NR_node, "NR", NULL, 0, update_NR, set_NR, TRUE, 0 },
{&OFMT_node, "OFMT", "%.6g", 0, NULL, set_OFMT, TRUE, 0 },
@@ -966,9 +966,7 @@ static const struct varinit varinit[] = {
{&ORS_node, "ORS", "\n", 0, NULL, set_ORS, TRUE, 0 },
{NULL, "PROCINFO", NULL, 0, NULL, NULL, FALSE, NO_INSTALL | NON_STANDARD },
{&RLENGTH_node, "RLENGTH", NULL, 0, NULL, NULL, FALSE, 0 },
-#ifdef HAVE_MPFR
{&RNDMODE_node, "RNDMODE", DEFAULT_RNDMODE, 0, NULL, set_RNDMODE, FALSE, NON_STANDARD },
-#endif
{&RS_node, "RS", "\n", 0, NULL, set_RS, TRUE, 0 },
{&RSTART_node, "RSTART", NULL, 0, NULL, NULL, FALSE, 0 },
{&RT_node, "RT", "", 0, NULL, NULL, FALSE, NON_STANDARD },
diff --git a/mpfr.c b/mpfr.c
index 677bdcd7..0875bc60 100644
--- a/mpfr.c
+++ b/mpfr.c
@@ -25,12 +25,28 @@
#include "awk.h"
-#ifdef HAVE_MPFR
+#ifndef HAVE_MPFR
+
+void
+set_PREC()
+{
+ /* dummy function */
+}
+
+void
+set_RNDMODE()
+{
+ /* dummy function */
+}
+
+#else
#ifndef mp_bitcnt_t
#define mp_bitcnt_t unsigned long
#endif
+extern NODE **fmt_list; /* declared in eval.c */
+
#define POP_TWO_SCALARS(s1, s2) \
s2 = POP_SCALAR(); \
s1 = POP(); \
@@ -40,8 +56,14 @@ fatal(_("attempt to use array `%s' in a scalar context"), array_vname(s1)); \
}} while (FALSE)
mpz_t mpzval; /* GMP integer type; used as temporary in many places */
+mpfr_t MNR;
+mpfr_t MFNR;
static mpfr_rnd_t mpfr_rnd_mode(const char *mode, size_t mode_len);
+static NODE *get_bit_ops(NODE **p1, NODE **p2, const char *op);
+static NODE *mpfr_force_number(NODE *n);
+static NODE *mpfr_make_number(double);
+static NODE *mpfr_format_val(const char *format, int index, NODE *s);
/* init_mpfr --- set up MPFR related variables */
@@ -52,9 +74,14 @@ init_mpfr(const char *rnd_mode)
mpfr_set_default_prec(PRECISION);
RND_MODE = mpfr_rnd_mode(rnd_mode, strlen(rnd_mode));
mpfr_set_default_rounding_mode(RND_MODE);
- make_number = make_mpfr_number;
- m_force_number = force_mpfr_number;
+ make_number = mpfr_make_number;
+ m_force_number = mpfr_force_number;
+ format_val = mpfr_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);
}
/* mpfr_node --- allocate a node to store a MPFR number */
@@ -79,8 +106,8 @@ mpfr_node()
/* mpfr_make_number --- make a MPFR number node and initialize with a double */
-NODE *
-make_mpfr_number(double x)
+static NODE *
+mpfr_make_number(double x)
{
NODE *r;
r = mpfr_node();
@@ -90,8 +117,8 @@ make_mpfr_number(double x)
/* mpfr_force_number --- force a value to be a MPFR number */
-AWKNUM
-force_mpfr_number(NODE *n)
+static NODE *
+mpfr_force_number(NODE *n)
{
char *cp, *cpend, *ptr;
char save;
@@ -99,7 +126,7 @@ force_mpfr_number(NODE *n)
unsigned int newflags = 0;
if ((n->flags & (MPFN|NUMCUR)) == (MPFN|NUMCUR))
- return 0;
+ return n;
if (n->flags & MAYBE_NUM) {
n->flags &= ~MAYBE_NUM;
@@ -110,18 +137,17 @@ force_mpfr_number(NODE *n)
n->flags |= MPFN;
mpfr_init(n->mpfr_numbr);
}
-
- mpfr_set_d(n->mpfr_numbr, 0.0, RND_MODE); /* initialize to 0.0 */
+ mpfr_set_d(n->mpfr_numbr, 0.0, RND_MODE);
if (n->stlen == 0)
- return 0;
+ return n;
cp = n->stptr;
cpend = n->stptr + n->stlen;
while (cp < cpend && isspace((unsigned char) *cp))
cp++;
if (cp == cpend) /* only spaces */
- return 0;
+ return n;
save = *cpend;
*cpend = '\0';
@@ -141,27 +167,139 @@ force_mpfr_number(NODE *n)
n->flags |= NUMCUR;
}
errno = 0;
- return 0;
+ return n;
+}
+
+/* mpfr_format_val --- format a numeric value based on format */
+
+static NODE *
+mpfr_format_val(const char *format, int index, NODE *s)
+{
+ NODE *dummy[2], *r;
+ unsigned int oflags;
+
+ /* create dummy node for a sole use of format_tree */
+ dummy[1] = s;
+ oflags = s->flags;
+
+ if (mpfr_integer_p(s->mpfr_numbr)) {
+ /* integral value, use %d */
+ r = format_tree("%d", 2, dummy, 2);
+ s->stfmt = -1;
+ } else {
+ r = format_tree(format, fmt_list[index]->stlen, dummy, 2);
+ assert(r != NULL);
+ s->stfmt = (char) index;
+ }
+ s->flags = oflags;
+ s->stlen = r->stlen;
+ if ((s->flags & STRCUR) != 0)
+ efree(s->stptr);
+ s->stptr = r->stptr;
+ freenode(r); /* Do not unref(r)! We want to keep s->stptr == r->stpr. */
+
+ s->flags |= STRCUR;
+ free_wstr(s);
+ return s;
+}
+
+
+/*
+ * mpfr_update_var --- update NR or FNR.
+ * NR_node(mpfr_t) = MNR(mpfr_t) * LONG_MAX + NR(long)
+ */
+
+/*
+ * Test:
+ * $ ./gawk -M 'BEGIN{NR=0x7FFFFFFFL; print NR} END{ print NR, NR-0x7FFFFFFFL, FNR}' awk.h
+ */
+
+void
+mpfr_update_var(NODE *n)
+{
+ NODE *val = n->var_value;
+ long nl;
+ mpfr_ptr nm;
+
+ if (n == NR_node) {
+ nl = NR;
+ nm = MNR;
+ } else if (n == FNR_node) {
+ nl = FNR;
+ nm = MFNR;
+ } else
+ cant_happen();
+
+ if (mpfr_zero_p(nm)) {
+ double d;
+
+ /* Efficiency hack for NR < LONG_MAX */
+ d = mpfr_get_d(val->mpfr_numbr, RND_MODE);
+ if (d != nl) {
+ unref(n->var_value);
+ n->var_value = make_number((AWKNUM) nl);
+ }
+ } else {
+ unref(n->var_value);
+ val = n->var_value = mpfr_node();
+ mpfr_mul_si(val->mpfr_numbr, nm, LONG_MAX, RND_MODE);
+ mpfr_add_si(val->mpfr_numbr, val->mpfr_numbr, nl, RND_MODE);
+ }
+}
+
+
+/* mpfr_set_var --- set NR or FNR */
+
+long
+mpfr_set_var(NODE *n)
+{
+ long l;
+ mpfr_ptr nm;
+ mpfr_ptr p = n->var_value->mpfr_numbr;
+ int neg = FALSE;
+
+ if (n == NR_node)
+ nm = MNR;
+ else if (n == FNR_node)
+ nm = MFNR;
+ else
+ cant_happen();
+
+ mpfr_get_z(mpzval, p, MPFR_RNDZ);
+ if (mpfr_signbit(p)) {
+ neg = TRUE;
+ mpz_neg(mpzval, mpzval);
+ }
+ l = mpz_fdiv_q_ui(mpzval, mpzval, LONG_MAX);
+ if (neg) {
+ mpz_neg(mpzval, mpzval);
+ l = -l;
+ }
+
+ mpfr_set_z(nm, mpzval, RND_MODE); /* quotient (MNR) */
+ return l; /* remainder (NR) */
}
+
/* set_PREC --- update MPFR PRECISION related variables when PREC assigned to */
void
set_PREC()
{
+ /* TODO: "DOUBLE", "QUAD", "OCT", .. */
+
if (do_mpfr) {
long l;
NODE *val = PREC_node->var_value;
- l = (long) force_number(val);
- if ((val->flags & MPFN) != 0)
- l = mpfr_get_si(val->mpfr_numbr, RND_MODE);
+ (void) force_number(val);
+ l = get_number_si(val);
if (l >= MPFR_PREC_MIN && l <= MPFR_PREC_MAX) {
mpfr_set_default_prec(l);
PRECISION = mpfr_get_default_prec();
} else
- warning(_("Invalid PREC value: %ld"), l);
+ warning(_("Invalid PREC value: %ld"), l);
}
}
@@ -210,40 +348,113 @@ set_RNDMODE()
}
}
+/* 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)->mpfr_numbr;
+ right = force_number(t2)->mpfr_numbr;
-/* do_and_mpfr --- perform an & operation */
+ 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",
+ mpfr_fmt(_("%s(%Rg, %Rg): negative values will give strange results"),
+ op, left, right)
+ );
+ if (! mpfr_integer_p(left) || ! mpfr_integer_p(right))
+ lintwarn("%s",
+ mpfr_fmt(_("%s(%Rg, %Rg): fractional values will be truncated"),
+ op, left, right)
+ );
+ }
+ return NULL;
+}
+
+
+/* do_and --- perform an & operation */
NODE *
-do_and_mpfr(int nargs)
+do_mpfr_and(int nargs)
{
- NODE *t1, *t2;
+ NODE *t1, *t2, *res;
+ mpz_t z;
+
+ if ((res = get_bit_ops(& t1, & t2, "and")) != NULL)
+ return res;
- POP_TWO_SCALARS(t1, t2);
+ mpz_init(z);
+ mpfr_get_z(mpzval, t1->mpfr_numbr, MPFR_RNDZ); /* float to integer conversion */
+ mpfr_get_z(z, t2->mpfr_numbr, MPFR_RNDZ); /* Same */
+ mpz_and(z, mpzval, z);
+
+ res = mpfr_node();
+ mpfr_set_z(res->mpfr_numbr, z, RND_MODE); /* integer to float conversion */
+ mpz_clear(z);
DEREF(t1);
DEREF(t2);
- return dupnode(Nnull_string);
+ return res;
}
/* do_atan2 --- do the atan2 function */
NODE *
-do_atan2_mpfr(int nargs)
+do_mpfr_atan2(int nargs)
{
- NODE *t1, *t2;
+ NODE *t1, *t2, *res;
+
+ t2 = POP_SCALAR();
+ t1 = POP_SCALAR();
+
+ if (do_lint) {
+ if ((t1->flags & (NUMCUR|NUMBER)) == 0)
+ lintwarn(_("atan2: received non-numeric first argument"));
+ if ((t2->flags & (NUMCUR|NUMBER)) == 0)
+ lintwarn(_("atan2: received non-numeric second argument"));
+ }
+ force_number(t1);
+ force_number(t2);
- POP_TWO_SCALARS(t1, t2);
+ res = mpfr_node();
+ /* See MPFR documentation for handling of special values like +inf as an argument */
+ mpfr_atan2(res->mpfr_numbr, t1->mpfr_numbr, t2->mpfr_numbr, RND_MODE);
DEREF(t1);
DEREF(t2);
- return dupnode(Nnull_string);
+ return res;
}
/* do_compl --- perform a ~ operation */
NODE *
-do_compl_mpfr(int nargs)
+do_mpfr_compl(int nargs)
{
NODE *tmp;
@@ -256,7 +467,7 @@ do_compl_mpfr(int nargs)
/* do_cos --- do the cos function */
NODE *
-do_cos_mpfr(int nargs)
+do_mpfr_cos(int nargs)
{
NODE *tmp;
@@ -269,7 +480,7 @@ do_cos_mpfr(int nargs)
/* do_exp --- exponential function */
NODE *
-do_exp_mpfr(int nargs)
+do_mpfr_exp(int nargs)
{
NODE *tmp;
@@ -282,7 +493,7 @@ do_exp_mpfr(int nargs)
/* do_int --- convert double to int for awk */
NODE *
-do_int_mpfr(int nargs)
+do_mpfr_int(int nargs)
{
NODE *tmp;
@@ -295,7 +506,7 @@ do_int_mpfr(int nargs)
/* do_log --- the log function */
NODE *
-do_log_mpfr(int nargs)
+do_mpfr_log(int nargs)
{
NODE *tmp;
@@ -307,7 +518,6 @@ do_log_mpfr(int nargs)
/* do_lshift --- perform a << operation */
-
/*
* Test:
* $ ./gawk 'BEGIN { print lshift(1, 52) }'
@@ -319,70 +529,20 @@ do_log_mpfr(int nargs)
*/
NODE *
-do_lshift_mpfr(int nargs)
+do_mpfr_lshift(int nargs)
{
NODE *t1, *t2, *res;
- mpfr_ptr left, right;
mp_bitcnt_t shift;
- POP_TWO_SCALARS(t1, t2);
- if (do_lint) {
- if ((t1->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("lshift: received non-numeric first argument"));
- if ((t2->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("lshift: received non-numeric second argument"));
- }
-
- (void) force_number(t1);
- (void) force_number(t2);
-
- assert((t1->flags & MPFN) != 0);
- assert((t2->flags & MPFN) != 0);
-
- left = t1->mpfr_numbr;
- right = t2->mpfr_numbr; /* shift */
+ if ((res = get_bit_ops(& t1, & t2, "lshift")) != NULL)
+ return res;
- if (! mpfr_number_p(left)) {
- /* [+-]inf or NaN */
- res = dupnode(t1);
- goto finish;
- }
-
- if (! mpfr_number_p(right)) {
- /* [+-]inf or NaN */
- res = dupnode(t2);
- goto finish;
- }
-
- if (do_lint) {
- char *tmp = NULL;
- if (mpfr_signbit(left) || mpfr_signbit(right)) {
- (void) mpfr_asprintf(& tmp,
- _("lshift(%Rg, %Rg): negative values will give strange results"), left, right);
- if (tmp != NULL) {
- lintwarn("%s", tmp);
- mpfr_free_str(tmp);
- tmp = NULL;
- }
- }
- if (! mpfr_integer_p(left) || ! mpfr_integer_p(right)) {
- (void) mpfr_asprintf(& tmp,
- _("lshift(%Rg, %Rg): fractional values will be truncated"), left, right);
- if (tmp != NULL) {
- lintwarn("%s", tmp);
- mpfr_free_str(tmp);
- }
- }
- }
-
- (void) mpfr_get_z(mpzval, left, MPFR_RNDZ); /* mpfr_t (float) => mpz_t (integer) conversion */
- shift = mpfr_get_ui(right, MPFR_RNDZ); /* mpfr_t (float) => unsigned long conversion */
+ mpfr_get_z(mpzval, t1->mpfr_numbr, MPFR_RNDZ); /* mpfr_t (float) => mpz_t (integer) conversion */
+ shift = mpfr_get_ui(t2->mpfr_numbr, MPFR_RNDZ); /* mpfr_t (float) => unsigned long conversion */
mpz_mul_2exp(mpzval, mpzval, shift); /* mpzval = mpzval * 2^shift */
res = mpfr_node();
- (void) mpfr_set_z(res->mpfr_numbr, mpzval, RND_MODE); /* mpz_t => mpfr_t conversion */
-
-finish:
+ mpfr_set_z(res->mpfr_numbr, mpzval, RND_MODE); /* integer to float conversion */
DEREF(t1);
DEREF(t2);
return res;
@@ -392,7 +552,7 @@ finish:
/* do_or --- perform an | operation */
NODE *
-do_or_mpfr(int nargs)
+do_mpfr_or(int nargs)
{
NODE *s1, *s2;
@@ -406,7 +566,7 @@ do_or_mpfr(int nargs)
/* do_rand --- do the rand function */
NODE *
-do_rand_mpfr(int nargs ATTRIBUTE_UNUSED)
+do_mpfr_rand(int nargs ATTRIBUTE_UNUSED)
{
return dupnode(Nnull_string);
}
@@ -439,71 +599,21 @@ do_rand_mpfr(int nargs ATTRIBUTE_UNUSED)
*/
NODE *
-do_rhift_mpfr(int nargs)
+do_mpfr_rhift(int nargs)
{
NODE *t1, *t2, *res;
- mpfr_ptr left, right;
mp_bitcnt_t shift;
- POP_TWO_SCALARS(t1, t2);
- if (do_lint) {
- if ((t1->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("rshift: received non-numeric first argument"));
- if ((t2->flags & (NUMCUR|NUMBER)) == 0)
- lintwarn(_("rshift: received non-numeric second argument"));
- }
-
- (void) force_number(t1);
- (void) force_number(t2);
-
- assert((t1->flags & MPFN) != 0);
- assert((t2->flags & MPFN) != 0);
-
- left = t1->mpfr_numbr;
- right = t2->mpfr_numbr; /* shift */
-
- if (! mpfr_number_p(left)) {
- /* [+-]inf or NaN */
- res = dupnode(t1);
- goto finish;
- }
-
- if (! mpfr_number_p(right)) {
- /* [+-]inf or NaN */
- res = dupnode(t2);
- goto finish;
- }
-
- if (do_lint) {
- char *tmp = NULL;
- if (mpfr_signbit(left) || mpfr_signbit(right)) {
- (void) mpfr_asprintf(& tmp,
- _("rshift(%Rg, %Rg): negative values will give strange results"), left, right);
- if (tmp != NULL) {
- lintwarn("%s", tmp);
- mpfr_free_str(tmp);
- tmp = NULL;
- }
- }
-
- if (! mpfr_integer_p(left) || ! mpfr_integer_p(right)) {
- (void) mpfr_asprintf(& tmp,
- _("rshift(%Rg, %Rg): fractional values will be truncated"), left, right);
- if (tmp != NULL) {
- lintwarn("%s", tmp);
- mpfr_free_str(tmp);
- }
- }
- }
+ if ((res = get_bit_ops(& t1, & t2, "rshift")) != NULL)
+ return res;
- (void) mpfr_get_z(mpzval, left, MPFR_RNDZ); /* mpfr_t (float) => mpz_t (integer) conversion */
- shift = mpfr_get_ui(right, MPFR_RNDZ); /* mpfr_t (float) => unsigned long conversion */
+ mpfr_get_z(mpzval, t1->mpfr_numbr, MPFR_RNDZ); /* mpfr_t (float) => mpz_t (integer) conversion */
+ shift = mpfr_get_ui(t2->mpfr_numbr, MPFR_RNDZ); /* mpfr_t (float) => unsigned long conversion */
mpz_fdiv_q_2exp(mpzval, mpzval, shift); /* mpzval = mpzval / 2^shift, round towards −inf */
res = mpfr_node();
- (void) mpfr_set_z(res->mpfr_numbr, mpzval, RND_MODE); /* mpz_t => mpfr_t conversion */
+ mpfr_set_z(res->mpfr_numbr, mpzval, RND_MODE); /* integer to float conversion */
-finish:
DEREF(t1);
DEREF(t2);
return res;
@@ -513,7 +623,7 @@ finish:
/* do_sin --- do the sin function */
NODE *
-do_sin_mpfr(int nargs)
+do_mpfr_sin(int nargs)
{
NODE *tmp;
@@ -526,7 +636,7 @@ do_sin_mpfr(int nargs)
/* do_sqrt --- do the sqrt function */
NODE *
-do_sqrt_mpfr(int nargs)
+do_mpfr_sqrt(int nargs)
{
NODE *tmp;
@@ -539,7 +649,7 @@ do_sqrt_mpfr(int nargs)
/* do_srand --- seed the random number generator */
NODE *
-do_srand_mpfr(int nargs)
+do_mpfr_srand(int nargs)
{
NODE *tmp;
@@ -556,7 +666,7 @@ do_srand_mpfr(int nargs)
/* do_strtonum --- the strtonum function */
NODE *
-do_strtonum_mpfr(int nargs)
+do_mpfr_strtonum(int nargs)
{
NODE *tmp;
@@ -570,7 +680,7 @@ do_strtonum_mpfr(int nargs)
/* do_xor --- perform an ^ operation */
NODE *
-do_xor_mpfr(int nargs)
+do_mpfr_xor(int nargs)
{
NODE *s1, *s2;
@@ -581,5 +691,73 @@ do_xor_mpfr(int nargs)
return dupnode(Nnull_string);
}
-#endif
+/* op_mpfr_assign --- assignment operators excluding = */
+
+void
+op_mpfr_assign(OPCODE op)
+{
+ NODE **lhs;
+ NODE *t1, *t2, *r;
+ mpfr_ptr p1, p2;
+
+ lhs = POP_ADDRESS();
+ t1 = *lhs;
+ p1 = force_number(t1)->mpfr_numbr;
+
+ t2 = TOP_SCALAR();
+ p2 = force_number(t2)->mpfr_numbr;
+
+ r = mpfr_node();
+ switch (op) {
+ case Op_assign_plus:
+ mpfr_add(r->mpfr_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_minus:
+ mpfr_sub(r->mpfr_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_times:
+ mpfr_mul(r->mpfr_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_quotient:
+ mpfr_div(r->mpfr_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_mod:
+ mpfr_fmod(r->mpfr_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_exp:
+ mpfr_pow(r->mpfr_numbr, p1, p2, RND_MODE);
+ break;
+ default:
+ break;
+ }
+
+ DEREF(t2);
+ unref(*lhs);
+ *lhs = r;
+
+ UPREF(r);
+ REPLACE(r);
+}
+
+
+/* mpfr_fmt --- output formatted string with special MPFR/GMP conversion specifiers */
+
+const char *
+mpfr_fmt(const char *mesg, ...)
+{
+ static char *tmp = NULL;
+ int ret;
+ va_list args;
+
+ if (tmp != NULL)
+ mpfr_free_str(tmp);
+ va_start(args, mesg);
+ ret = mpfr_vasprintf(& tmp, mesg, args);
+ va_end(args);
+ if (ret >= 0 && tmp != NULL)
+ return tmp;
+ return mesg;
+}
+
+#endif
diff --git a/msg.c b/msg.c
index 10f3837a..6f662959 100644
--- a/msg.c
+++ b/msg.c
@@ -62,6 +62,20 @@ err(const char *s, const char *emsg, va_list argp)
(void) fprintf(stderr, "%d: ", sourceline);
}
+
+#ifdef HAVE_MPFR
+ if (FNR_node && (FNR_node->var_value->flags & MPFN) != 0) {
+ mpfr_update_var(FNR_node);
+ mpfr_get_z(mpzval, FNR_node->var_value->mpfr_numbr, MPFR_RNDZ);
+ if (mpz_sgn(mpzval) > 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);
+ }
+ } else
+#endif
if (FNR > 0) {
file = FILENAME_node->var_value->stptr;
(void) putc('(', stderr);
@@ -69,6 +83,7 @@ err(const char *s, const char *emsg, va_list argp)
(void) fprintf(stderr, "FILENAME=%s ", file);
(void) fprintf(stderr, "FNR=%ld) ", FNR);
}
+
(void) fprintf(stderr, "%s", s);
vfprintf(stderr, emsg, argp);
(void) fprintf(stderr, "\n");
diff --git a/node.c b/node.c
index e917da0c..2166f6eb 100644
--- a/node.c
+++ b/node.c
@@ -32,11 +32,12 @@ static AWKNUM get_ieee_magic_val(const char *val);
extern NODE **fmt_list; /* declared in eval.c */
NODE *(*make_number)(AWKNUM ) = r_make_number;
-AWKNUM (*m_force_number)(NODE *) = r_force_number;
+NODE *(*m_force_number)(NODE *) = r_force_number;
+NODE *(*format_val)(const char *, int, NODE *) = r_format_val;
/* force_number --- force a value to be numeric */
-AWKNUM
+NODE *
r_force_number(NODE *n)
{
char *cp;
@@ -47,7 +48,7 @@ r_force_number(NODE *n)
extern double strtod();
if (n->flags & NUMCUR)
- return n->numbr;
+ return n;
/* all the conditionals are an attempt to avoid the expensive strtod */
@@ -56,7 +57,7 @@ r_force_number(NODE *n)
n->numbr = 0.0;
if (n->stlen == 0) {
- return 0.0;
+ return n;
}
cp = n->stptr;
@@ -69,14 +70,14 @@ r_force_number(NODE *n)
*/
if (! do_posix) {
if (isalpha((unsigned char) *cp)) {
- return 0.0;
+ return n;
} else if (n->stlen == 4 && is_ieee_magic_val(n->stptr)) {
if (n->flags & MAYBE_NUM)
n->flags &= ~MAYBE_NUM;
n->flags |= NUMBER|NUMCUR;
n->numbr = get_ieee_magic_val(n->stptr);
- return n->numbr;
+ return n;
}
/* else
fall through */
@@ -94,7 +95,7 @@ r_force_number(NODE *n)
/* CANNOT do non-decimal and saw 0x */
|| (! do_non_decimal_data && cp[0] == '0'
&& (cp[1] == 'x' || cp[1] == 'X'))))) {
- return 0.0;
+ return n;
}
if (n->flags & MAYBE_NUM) {
@@ -111,7 +112,7 @@ r_force_number(NODE *n)
if (cp == n->stptr) /* no leading spaces */
n->flags |= NUMINT;
}
- return n->numbr;
+ return n;
}
if (do_non_decimal_data) { /* main.c assures false if do_posix */
@@ -141,7 +142,7 @@ finish:
errno = 0;
}
- return n->numbr;
+ return n;
}
@@ -164,10 +165,10 @@ static const char *values[] = {
};
#define NVAL (sizeof(values)/sizeof(values[0]))
-/* format_val --- format a numeric value based on format */
+/* r_format_val --- format a numeric value based on format */
NODE *
-format_val(const char *format, int index, NODE *s)
+r_format_val(const char *format, int index, NODE *s)
{
char buf[BUFSIZ];
char *sp = buf;
@@ -191,11 +192,7 @@ format_val(const char *format, int index, NODE *s)
*/
/* not an integral value, or out of range */
- if (
-#ifdef HAVE_MPFR
- (s->flags & MPFN) != 0 ||
-#endif
- (val = double_to_int(s->numbr)) != s->numbr
+ if ((val = double_to_int(s->numbr)) != s->numbr
|| val <= LONG_MIN || val >= LONG_MAX
) {
/*
@@ -214,12 +211,7 @@ format_val(const char *format, int index, NODE *s)
dummy[1] = s;
oflags = s->flags;
- if (
-#ifdef HAVE_MPFR
- ((s->flags & MPFN) != 0 && mpfr_integer_p(s->mpfr_numbr)) ||
-#endif
- ((s->flags & MPFN) == 0 && val == s->numbr)
- ) {
+ if (val == s->numbr) {
/* integral value, but outside range of %ld, use %.0f */
r = format_tree("%.0f", 4, dummy, 2);
s->stfmt = -1;
@@ -633,7 +625,7 @@ get_numbase(const char *s, int use_locale)
}
if (! isdigit((unsigned char) s[1])
- || s[1] == '8' || s[1] == '9'
+ || s[1] == '8' || s[1] == '9'
)
return 10;
return 8;
diff --git a/str_array.c b/str_array.c
index 7ce617ed..4bd993e6 100644
--- a/str_array.c
+++ b/str_array.c
@@ -158,7 +158,7 @@ str_lookup(NODE *symbol, NODE *subs)
* never be used.
*/
- if (subs->flags & NUMCUR) {
+ if ((subs->flags & (MPFN|NUMCUR)) == NUMCUR) {
tmp->numbr = subs->numbr;
tmp->flags |= NUMCUR;
}
@@ -187,7 +187,6 @@ str_lookup(NODE *symbol, NODE *subs)
static NODE **
str_exists(NODE *symbol, NODE *subs)
{
- NODE **lhs;
unsigned long hash1;
size_t code1;
@@ -196,8 +195,7 @@ str_exists(NODE *symbol, NODE *subs)
subs = force_string(subs);
hash1 = hash(subs->stptr, subs->stlen, (unsigned long) symbol->array_size, & code1);
- lhs = str_find(symbol, subs, code1, hash1);
- return lhs;
+ return str_find(symbol, subs, code1, hash1);
}
/* str_clear --- flush all the values in symbol[] */
diff --git a/test/Makefile.am b/test/Makefile.am
index 943dbd9f..2bbc5539 100644
--- a/test/Makefile.am
+++ b/test/Makefile.am
@@ -873,6 +873,10 @@ PGAWKPROG = ../pgawk$(EXEEXT)
AWK = LC_ALL=$${GAWKLOCALE:-C} LANG=$${GAWKLOCALE:-C} $(AWKPROG)
PGAWK = LC_ALL=$${GAWKLOCALE:-C} LANG=$${GAWKLOCALE:-C} $(PGAWKPROG)
+check-mpfr: AWK+=-M
+
+check-mpfr: check
+
# Message stuff is to make it a little easier to follow.
# Make the pass-fail last and dependent on others to avoid
# spurious errors if `make -j' in effect.
diff --git a/test/Makefile.in b/test/Makefile.in
index a389929a..f56ee6ca 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -1225,6 +1225,10 @@ uninstall-am:
mostlyclean-generic pdf pdf-am ps ps-am uninstall uninstall-am
+check-mpfr: AWK+=-M
+
+check-mpfr: check
+
# Message stuff is to make it a little easier to follow.
# Make the pass-fail last and dependent on others to avoid
# spurious errors if `make -j' in effect.
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-04 12:10:19 +0000