[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gawk-diffs] [SCM] gawk branch, gawk_mpfr, updated. 1c06c5c6f0f6d46f6397
|
From: |
John Haque |
|
Subject: |
[gawk-diffs] [SCM] gawk branch, gawk_mpfr, updated. 1c06c5c6f0f6d46f63977dd7407d86ccc2614226 |
|
Date: |
Sun, 26 Feb 2012 13:11:38 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "gawk".
The branch, gawk_mpfr has been updated
via 1c06c5c6f0f6d46f63977dd7407d86ccc2614226 (commit)
from cb17a712ea65f6510e0000374cce4efbf4ffb902 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
http://git.sv.gnu.org/cgit/gawk.git/commit/?id=1c06c5c6f0f6d46f63977dd7407d86ccc2614226
commit 1c06c5c6f0f6d46f63977dd7407d86ccc2614226
Author: john haque <address@hidden>
Date: Sun Feb 26 06:57:48 2012 -0600
Finish MPFR changes and clean up code.
diff --git a/array.c b/array.c
index 4f8fd5c..9d2f56f 100644
--- a/array.c
+++ b/array.c
@@ -48,9 +48,6 @@ static array_ptr null_array_func[] = {
null_afunc,
null_afunc,
null_dump,
-#ifdef ARRAYDEBUG
- null_afunc
-#endif
};
#define MAX_ATYPE 10
@@ -88,8 +85,10 @@ void
array_init()
{
(void) register_array_func(str_array_func); /* the default */
- (void) register_array_func(int_array_func);
- (void) register_array_func(cint_array_func);
+ if (! do_mpfr) {
+ (void) register_array_func(int_array_func);
+ (void) register_array_func(cint_array_func);
+ }
}
@@ -662,7 +661,6 @@ do_delete_loop(NODE *symbol, NODE **lhs)
/* value_info --- print scalar node info */
-
static void
value_info(NODE *n)
{
@@ -678,11 +676,25 @@ value_info(NODE *n)
if ((n->flags & (STRING|STRCUR)) != 0) {
fprintf(output_fp, "<");
fprintf(output_fp, "\"%.*s\"", PREC_STR, n->stptr);
- if ((n->flags & (NUMBER|NUMCUR)) != 0)
+ 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));
+ else
+#endif
fprintf(output_fp, ":%.*g", PREC_NUM, n->numbr);
+ }
fprintf(output_fp, ">");
- } else
+ } else {
+#ifdef HAVE_MPFR
+ if (n->flags & MPFN)
+ fprintf(output_fp, "%s",
+ mpg_fmt("<%.*R*g>", PREC_NUM, RND_MODE,
n->mpg_numbr));
+ else
+#endif
fprintf(output_fp, "<%.*g>", PREC_NUM, n->numbr);
+ }
fprintf(output_fp, ":%s", flags2str(n->flags));
@@ -703,32 +715,6 @@ value_info(NODE *n)
}
-#ifdef ARRAYDEBUG
-
-NODE *
-do_aoption(int nargs)
-{
- int ret = -1;
- NODE *opt, *val;
- int i;
- array_ptr *afunc;
-
- val = POP_SCALAR();
- opt = POP_SCALAR();
- for (i = 0; i < num_atypes; i++) {
- afunc = atypes[i];
- if (afunc[NUM_AFUNCS] && (*afunc[NUM_AFUNCS])(opt, val) !=
NULL) {
- ret = 0;
- break;
- }
- }
- DEREF(opt);
- DEREF(val);
- return make_number((AWKNUM) ret);
-}
-
-#endif
-
void
indent(int indent_level)
{
@@ -747,7 +733,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 & INTIND) != 0)
+ if ((subs->flags & (MPFN|INTIND)) == INTIND)
fprintf(output_fp, "<%ld>", (long) subs->numbr);
else
value_info(subs);
@@ -906,8 +892,6 @@ asort_actual(int nargs, SORT_CTXT ctxt)
/* value node */
r = *ptr++;
- /* FIXME: asort(a) optimization */
-
if (r->type == Node_val)
*assoc_lookup(result, subs) = dupnode(r);
else {
@@ -1008,6 +992,32 @@ 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. */
@@ -1052,25 +1062,10 @@ sort_up_index_number(const void *p1, const void *p2)
t1 = *((const NODE *const *) p1);
t2 = *((const NODE *const *) p2);
-#ifdef HAVE_MPFR
- if (t1->flags & MPFN) {
- assert((t2->flags & MPFN) != 0);
-
- ret = mpfr_cmp(t1->mpfr_numbr, t2->mpfr_numbr);
- if (ret == 0)
- goto break_tie;
- return ret;
- }
-#endif
-
- if (t1->numbr < t2->numbr)
- ret = -1;
- else
- ret = (t1->numbr > t2->numbr);
-
+ ret = cmp_number(t1, t2);
if (ret != 0)
- return ret;
-break_tie:
+ return ret;
+
/* break a tie with the index string itself */
t1 = force_string((NODE *) t1);
t2 = force_string((NODE *) t2);
@@ -1135,26 +1130,10 @@ sort_up_value_number(const void *p1, const void *p2)
if (t2->type == Node_var_array)
return -1; /* t1 (scalar) < t2 (sub-array) */
-#ifdef HAVE_MPFR
- if (t1->flags & MPFN) {
- assert((t2->flags & MPFN) != 0);
-
- ret = mpfr_cmp(t1->mpfr_numbr, t2->mpfr_numbr);
- if (ret == 0)
- goto break_tie;
- return ret;
- }
-#endif
-
- /* t1 and t2 both Node_val, and force_number'ed */
- if (t1->numbr < t2->numbr)
- ret = -1;
- else
- ret = (t1->numbr > t2->numbr);
-
+ ret = cmp_number(t1, t2);
if (ret != 0)
return ret;
-break_tie:
+
/*
* Use string value to guarantee same sort order on all
* versions of qsort().
@@ -1208,19 +1187,7 @@ sort_up_value_type(const void *p1, const void *p2)
(void) force_string(n2);
if ((n1->flags & NUMBER) != 0 && (n2->flags & NUMBER) != 0) {
-#ifdef HAVE_MPFR
- if (n1->flags & MPFN) {
- assert((n2->flags & MPFN) != 0);
- return mpfr_cmp(n1->mpfr_numbr, n2->mpfr_numbr);
- }
-#endif
-
- if (n1->numbr < n2->numbr)
- return -1;
- else if (n1->numbr > n2->numbr)
- return 1;
- else
- return 0;
+ return cmp_number(n1, n2);
}
/* 3. All numbers are less than all strings. This is aribitrary. */
@@ -1279,7 +1246,7 @@ sort_user_func(const void *p1, const void *p2)
#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);
+ ret = mpfr_sgn(r->mpg_numbr);
else
#endif
ret = (r->numbr < 0.0) ? -1 : (r->numbr > 0.0);
diff --git a/awk.h b/awk.h
index 02fb3e0..9944ea9 100644
--- a/awk.h
+++ b/awk.h
@@ -466,7 +466,7 @@ typedef struct exp_node {
#define wstlen sub.val.wslen
#define numbr sub.val.nm.fltnum
#ifdef HAVE_MPFR
-#define mpfr_numbr sub.val.nm.mpnum
+#define mpg_numbr sub.val.nm.mpnum
#endif
/* Node_arrayfor */
@@ -1018,10 +1018,13 @@ extern NODE **fields_arr;
extern int sourceline;
extern char *source;
extern int (*interpret)(INSTRUCTION *); /* interpreter routine */
-extern NODE *(*make_number)(AWKNUM );
-extern NODE *(*m_force_number)(NODE *);
+extern NODE *(*make_number)(double); /* double instead of AWKNUM on purpose
*/
+extern NODE *(*str2number)(NODE *);
extern NODE *(*format_val)(const char *, int, NODE *);
+typedef int (*Func_pre_exec)(INSTRUCTION **);
+typedef void (*Func_post_exec)(INSTRUCTION *);
+
#if __GNUC__ < 2
extern NODE *_t; /* used as temporary in macros */
#endif
@@ -1060,7 +1063,7 @@ extern int do_flags;
#define DO_PROFILE 0x1000
/* debug the program */
#define DO_DEBUG 0x2000
-/* mpfr */
+/* arbitrary-precision floating-point math */
#define DO_MPFR 0x4000
#define do_traditional (do_flags & DO_TRADITIONAL)
@@ -1103,11 +1106,12 @@ extern struct lconv loc;
#endif /* HAVE_LOCALE_H */
#ifdef HAVE_MPFR
-extern mpfr_prec_t PRECISION;
-extern mpfr_rnd_t RND_MODE;
+extern mpfr_prec_t PRECISION;
+extern mpfr_rnd_t RND_MODE;
extern mpfr_t MNR;
extern mpfr_t MFNR;
extern mpz_t mpzval;
+extern int do_subnormalize; /* IEEE 754 binary format emulation */
#endif
@@ -1200,21 +1204,18 @@ extern STACK_ITEM *stack_top;
/* ------------------------- Pseudo-functions ------------------------- */
#ifdef HAVE_MPFR
/* conversion to C types */
-#define get_number_ui(n) (((n)->flags & MPFN) ?
mpfr_get_ui((n)->mpfr_numbr, RND_MODE) \
+#define get_number_ui(n) (((n)->flags & MPFN) ?
mpfr_get_ui((n)->mpg_numbr, RND_MODE) \
: (unsigned long) (n)->numbr)
-#define get_number_si(n) (((n)->flags & MPFN) ?
mpfr_get_si((n)->mpfr_numbr, RND_MODE) \
+#define get_number_si(n) (((n)->flags & MPFN) ?
mpfr_get_si((n)->mpg_numbr, RND_MODE) \
: (long) (n)->numbr)
-#define get_number_d(n) (((n)->flags & MPFN) ?
mpfr_get_d((n)->mpfr_numbr, RND_MODE) \
+#define get_number_d(n) (((n)->flags & MPFN) ?
mpfr_get_d((n)->mpg_numbr, RND_MODE) \
: (double) (n)->numbr)
-#define get_number_uj(n) (((n)->flags & MPFN) ?
mpfr_get_uj((n)->mpfr_numbr, RND_MODE) \
+#define get_number_uj(n) (((n)->flags & MPFN) ?
mpfr_get_uj((n)->mpg_numbr, RND_MODE) \
: (uintmax_t) (n)->numbr)
-#define is_nonzero_num(n) (((n)->flags & MPFN) ? (!
mpfr_zero_p((n)->mpfr_numbr)) \
+#define is_nonzero_num(n) (((n)->flags & MPFN) ? (!
mpfr_zero_p((n)->mpg_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++
+#define SUBNORMALIZE(r, t) do_subnormalize ? mpfr_subnormalize(r, t,
RND_MODE) : (void)0
#else
#define get_number_ui(n) (unsigned long) (n)->numbr
#define get_number_si(n) (long) (n)->numbr
@@ -1222,8 +1223,6 @@ 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) == '_')
@@ -1265,7 +1264,7 @@ extern STACK_ITEM *stack_top;
#define efree(p) free(p)
#ifdef GAWKDEBUG
-#define force_number m_force_number
+#define force_number str2number
#define dupnode r_dupnode
#define unref r_unref
#define m_force_string r_force_string
@@ -1284,7 +1283,7 @@ extern NODE *r_force_string(NODE *s);
(_tn->flags & MALLOC) ? (_tn->valref++, _tn) : r_dupnode(_tn); })
#define force_number(n) __extension__ ({ NODE *_tn = (n); \
- (_tn->flags & NUMCUR) ? _tn : m_force_number(_tn); })
+ (_tn->flags & NUMCUR) ? _tn : str2number(_tn); })
#define force_string(s) __extension__ ({ NODE *_ts = (s);
m_force_string(_ts); })
@@ -1292,7 +1291,7 @@ extern NODE *r_force_string(NODE *s);
#define dupnode(n) (_t = (n), \
(_t->flags & MALLOC) ? (_t->valref++, _t) : r_dupnode(_t))
-#define force_number m_force_number
+#define force_number str2number
#define force_string(s) (_t = (s), m_force_string(_t))
#endif /* __GNUC__ */
#endif /* GAWKDEBUG */
@@ -1374,6 +1373,7 @@ extern SRCFILE *add_srcfile(int stype, char *src, SRCFILE
*curr, int *already_in
extern void register_deferred_variable(const char *name, NODE
*(*load_func)(void));
extern int files_are_same(char *path, SRCFILE *src);
extern void valinfo(NODE *n, Func_print print_func, FILE *fp);
+extern void negate_num(NODE *n);
/* builtin.c */
extern double double_to_int(double d);
extern NODE *do_exp(int nargs);
@@ -1444,13 +1444,13 @@ extern const char *flags2str(int);
extern const char *genflags2str(int flagval, const struct flagtab *tab);
extern const char *nodetype2str(NODETYPE type);
extern void load_casetable(void);
-
extern AWKNUM calc_exp(AWKNUM x1, AWKNUM x2);
extern const char *opcode2str(OPCODE type);
extern const char *op2str(OPCODE type);
extern NODE **r_get_lhs(NODE *n, int reference);
extern STACK_ITEM *grow_stack(void);
extern void dump_fcall_stack(FILE *fp);
+extern int register_exec_hook(Func_pre_exec preh, Func_post_exec posth);
/* ext.c */
NODE *do_ext(int nargs);
NODE *load_ext(const char *lib_name, const char *init_func, NODE *obj);
@@ -1526,8 +1526,8 @@ extern long getenv_long(const char *name);
extern void set_PREC(void);
extern void set_RNDMODE(void);
#ifdef HAVE_MPFR
-extern void mpfr_update_var(NODE *);
-extern long mpfr_set_var(NODE *);
+extern void mpg_update_var(NODE *);
+extern long mpg_set_var(NODE *);
extern NODE *do_mpfr_and(int);
extern NODE *do_mpfr_atan2(int);
extern NODE *do_mpfr_compl(int);
@@ -1545,9 +1545,8 @@ 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 *mpfr_node();
-extern void op_mpfr_assign(OPCODE op);
-const char *mpfr_fmt(const char *mesg, ...);
+extern NODE *mpg_node();
+const char *mpg_fmt(const char *mesg, ...);
#endif
/* msg.c */
extern void gawk_exit(int status);
diff --git a/awkgram.c b/awkgram.c
index d9f97bc..f4cc6e0 100644
--- a/awkgram.c
+++ b/awkgram.c
@@ -78,10 +78,6 @@
#define signed /**/
#endif
-#ifndef HAVE_MPFR
-#define mpfr_setsign(u,v,w,x) /* nothing */
-#endif
-
static void yyerror(const char *m, ...) ATTRIBUTE_PRINTF_1;
static void error_ln(int line, const char *m, ...) ATTRIBUTE_PRINTF_2;
static void lintwarn_ln(int line, const char *m, ...) ATTRIBUTE_PRINTF_2;
@@ -199,7 +195,7 @@ extern double fmod(double x, double y);
/* Line 268 of yacc.c */
-#line 203 "awkgram.c"
+#line 199 "awkgram.c"
/* Enabling traces. */
#ifndef YYDEBUG
@@ -345,7 +341,7 @@ typedef int YYSTYPE;
/* Line 343 of yacc.c */
-#line 349 "awkgram.c"
+#line 345 "awkgram.c"
#ifdef short
# undef short
@@ -707,25 +703,25 @@ static const yytype_int16 yyrhs[] =
/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
static const yytype_uint16 yyrline[] =
{
- 0, 196, 196, 198, 203, 204, 208, 220, 224, 235,
- 241, 249, 257, 259, 265, 266, 268, 294, 305, 316,
- 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, 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
+ 0, 192, 192, 194, 199, 200, 204, 216, 220, 231,
+ 237, 245, 253, 255, 261, 262, 264, 290, 301, 312,
+ 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
};
#endif
@@ -2044,7 +2040,7 @@ yyreduce:
case 3:
/* Line 1821 of yacc.c */
-#line 199 "awkgram.y"
+#line 195 "awkgram.y"
{
rule = 0;
yyerrok;
@@ -2054,7 +2050,7 @@ yyreduce:
case 5:
/* Line 1821 of yacc.c */
-#line 205 "awkgram.y"
+#line 201 "awkgram.y"
{
next_sourcefile();
}
@@ -2063,7 +2059,7 @@ yyreduce:
case 6:
/* Line 1821 of yacc.c */
-#line 209 "awkgram.y"
+#line 205 "awkgram.y"
{
rule = 0;
/*
@@ -2077,7 +2073,7 @@ yyreduce:
case 7:
/* Line 1821 of yacc.c */
-#line 221 "awkgram.y"
+#line 217 "awkgram.y"
{
(void) append_rule((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
}
@@ -2086,7 +2082,7 @@ yyreduce:
case 8:
/* Line 1821 of yacc.c */
-#line 225 "awkgram.y"
+#line 221 "awkgram.y"
{
if (rule != Rule) {
msg(_("%s blocks must have an action part"),
ruletab[rule]);
@@ -2102,7 +2098,7 @@ yyreduce:
case 9:
/* Line 1821 of yacc.c */
-#line 236 "awkgram.y"
+#line 232 "awkgram.y"
{
in_function = NULL;
(void) mk_function((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
@@ -2113,7 +2109,7 @@ yyreduce:
case 10:
/* Line 1821 of yacc.c */
-#line 242 "awkgram.y"
+#line 238 "awkgram.y"
{
want_source = FALSE;
yyerrok;
@@ -2123,7 +2119,7 @@ yyreduce:
case 11:
/* Line 1821 of yacc.c */
-#line 250 "awkgram.y"
+#line 246 "awkgram.y"
{
if (include_source((yyvsp[(1) - (1)])) < 0)
YYABORT;
@@ -2136,35 +2132,35 @@ yyreduce:
case 12:
/* Line 1821 of yacc.c */
-#line 258 "awkgram.y"
+#line 254 "awkgram.y"
{ (yyval) = NULL; }
break;
case 13:
/* Line 1821 of yacc.c */
-#line 260 "awkgram.y"
+#line 256 "awkgram.y"
{ (yyval) = NULL; }
break;
case 14:
/* Line 1821 of yacc.c */
-#line 265 "awkgram.y"
+#line 261 "awkgram.y"
{ (yyval) = NULL; rule = Rule; }
break;
case 15:
/* Line 1821 of yacc.c */
-#line 267 "awkgram.y"
+#line 263 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); rule = Rule; }
break;
case 16:
/* Line 1821 of yacc.c */
-#line 269 "awkgram.y"
+#line 265 "awkgram.y"
{
INSTRUCTION *tp;
@@ -2195,7 +2191,7 @@ yyreduce:
case 17:
/* Line 1821 of yacc.c */
-#line 295 "awkgram.y"
+#line 291 "awkgram.y"
{
static int begin_seen = 0;
if (do_lint_old && ++begin_seen == 2)
@@ -2211,7 +2207,7 @@ yyreduce:
case 18:
/* Line 1821 of yacc.c */
-#line 306 "awkgram.y"
+#line 302 "awkgram.y"
{
static int end_seen = 0;
if (do_lint_old && ++end_seen == 2)
@@ -2227,7 +2223,7 @@ yyreduce:
case 19:
/* Line 1821 of yacc.c */
-#line 317 "awkgram.y"
+#line 313 "awkgram.y"
{
(yyvsp[(1) - (1)])->in_rule = rule = BEGINFILE;
(yyvsp[(1) - (1)])->source_file = source;
@@ -2238,7 +2234,7 @@ yyreduce:
case 20:
/* Line 1821 of yacc.c */
-#line 323 "awkgram.y"
+#line 319 "awkgram.y"
{
(yyvsp[(1) - (1)])->in_rule = rule = ENDFILE;
(yyvsp[(1) - (1)])->source_file = source;
@@ -2249,7 +2245,7 @@ yyreduce:
case 21:
/* Line 1821 of yacc.c */
-#line 332 "awkgram.y"
+#line 328 "awkgram.y"
{
if ((yyvsp[(2) - (5)]) == NULL)
(yyval) = list_create(instruction(Op_no_op));
@@ -2261,21 +2257,21 @@ yyreduce:
case 22:
/* Line 1821 of yacc.c */
-#line 342 "awkgram.y"
+#line 338 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 23:
/* Line 1821 of yacc.c */
-#line 344 "awkgram.y"
+#line 340 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 24:
/* Line 1821 of yacc.c */
-#line 346 "awkgram.y"
+#line 342 "awkgram.y"
{
yyerror(_("`%s' is a built-in function, it cannot be
redefined"),
tokstart);
@@ -2286,14 +2282,14 @@ yyreduce:
case 25:
/* Line 1821 of yacc.c */
-#line 352 "awkgram.y"
+#line 348 "awkgram.y"
{ (yyval) = (yyvsp[(2) - (2)]); }
break;
case 28:
/* Line 1821 of yacc.c */
-#line 362 "awkgram.y"
+#line 358 "awkgram.y"
{
(yyvsp[(1) - (6)])->source_file = source;
if (install_function((yyvsp[(2) - (6)])->lextok, (yyvsp[(1) -
(6)]), (yyvsp[(4) - (6)])) < 0)
@@ -2309,14 +2305,14 @@ yyreduce:
case 29:
/* Line 1821 of yacc.c */
-#line 380 "awkgram.y"
+#line 376 "awkgram.y"
{ ++want_regexp; }
break;
case 30:
/* Line 1821 of yacc.c */
-#line 382 "awkgram.y"
+#line 378 "awkgram.y"
{
NODE *n, *exp;
char *re;
@@ -2350,21 +2346,21 @@ yyreduce:
case 31:
/* Line 1821 of yacc.c */
-#line 414 "awkgram.y"
+#line 410 "awkgram.y"
{ bcfree((yyvsp[(1) - (1)])); }
break;
case 33:
/* Line 1821 of yacc.c */
-#line 420 "awkgram.y"
+#line 416 "awkgram.y"
{ (yyval) = NULL; }
break;
case 34:
/* Line 1821 of yacc.c */
-#line 422 "awkgram.y"
+#line 418 "awkgram.y"
{
if ((yyvsp[(2) - (2)]) == NULL)
(yyval) = (yyvsp[(1) - (2)]);
@@ -2382,28 +2378,28 @@ yyreduce:
case 35:
/* Line 1821 of yacc.c */
-#line 435 "awkgram.y"
+#line 431 "awkgram.y"
{ (yyval) = NULL; }
break;
case 38:
/* Line 1821 of yacc.c */
-#line 445 "awkgram.y"
+#line 441 "awkgram.y"
{ (yyval) = NULL; }
break;
case 39:
/* Line 1821 of yacc.c */
-#line 447 "awkgram.y"
+#line 443 "awkgram.y"
{ (yyval) = (yyvsp[(2) - (3)]); }
break;
case 40:
/* Line 1821 of yacc.c */
-#line 449 "awkgram.y"
+#line 445 "awkgram.y"
{
if (do_pretty_print)
(yyval) = list_prepend((yyvsp[(1) - (1)]),
instruction(Op_exec_count));
@@ -2415,7 +2411,7 @@ yyreduce:
case 41:
/* Line 1821 of yacc.c */
-#line 456 "awkgram.y"
+#line 452 "awkgram.y"
{
INSTRUCTION *dflt, *curr = NULL, *cexp, *cstmt;
INSTRUCTION *ip, *nextc, *tbreak;
@@ -2510,7 +2506,7 @@ yyreduce:
case 42:
/* Line 1821 of yacc.c */
-#line 546 "awkgram.y"
+#line 542 "awkgram.y"
{
/*
* -----------------
@@ -2557,7 +2553,7 @@ yyreduce:
case 43:
/* Line 1821 of yacc.c */
-#line 588 "awkgram.y"
+#line 584 "awkgram.y"
{
/*
* -----------------
@@ -2604,7 +2600,7 @@ yyreduce:
case 44:
/* Line 1821 of yacc.c */
-#line 630 "awkgram.y"
+#line 626 "awkgram.y"
{
INSTRUCTION *ip;
char *var_name = (yyvsp[(3) - (8)])->lextok;
@@ -2722,7 +2718,7 @@ regular_loop:
case 45:
/* Line 1821 of yacc.c */
-#line 743 "awkgram.y"
+#line 739 "awkgram.y"
{
(yyval) = mk_for_loop((yyvsp[(1) - (12)]), (yyvsp[(3) - (12)]),
(yyvsp[(6) - (12)]), (yyvsp[(9) - (12)]), (yyvsp[(12) - (12)]));
@@ -2734,7 +2730,7 @@ regular_loop:
case 46:
/* Line 1821 of yacc.c */
-#line 750 "awkgram.y"
+#line 746 "awkgram.y"
{
(yyval) = mk_for_loop((yyvsp[(1) - (11)]), (yyvsp[(3) - (11)]),
(INSTRUCTION *) NULL, (yyvsp[(8) - (11)]), (yyvsp[(11) - (11)]));
@@ -2746,7 +2742,7 @@ regular_loop:
case 47:
/* Line 1821 of yacc.c */
-#line 757 "awkgram.y"
+#line 753 "awkgram.y"
{
if (do_pretty_print)
(yyval) = list_prepend((yyvsp[(1) - (1)]),
instruction(Op_exec_count));
@@ -2758,7 +2754,7 @@ regular_loop:
case 48:
/* Line 1821 of yacc.c */
-#line 767 "awkgram.y"
+#line 763 "awkgram.y"
{
if (! break_allowed)
error_ln((yyvsp[(1) - (2)])->source_line,
@@ -2772,7 +2768,7 @@ regular_loop:
case 49:
/* Line 1821 of yacc.c */
-#line 776 "awkgram.y"
+#line 772 "awkgram.y"
{
if (! continue_allowed)
error_ln((yyvsp[(1) - (2)])->source_line,
@@ -2786,7 +2782,7 @@ regular_loop:
case 50:
/* Line 1821 of yacc.c */
-#line 785 "awkgram.y"
+#line 781 "awkgram.y"
{
/* if inside function (rule = 0), resolve context at run-time */
if (rule && rule != Rule)
@@ -2800,7 +2796,7 @@ regular_loop:
case 51:
/* Line 1821 of yacc.c */
-#line 794 "awkgram.y"
+#line 790 "awkgram.y"
{
if (do_traditional)
error_ln((yyvsp[(1) - (2)])->source_line,
@@ -2820,7 +2816,7 @@ regular_loop:
case 52:
/* Line 1821 of yacc.c */
-#line 809 "awkgram.y"
+#line 805 "awkgram.y"
{
/* Initialize the two possible jump targets, the actual target
* is resolved at run-time.
@@ -2840,7 +2836,7 @@ regular_loop:
case 53:
/* Line 1821 of yacc.c */
-#line 824 "awkgram.y"
+#line 820 "awkgram.y"
{
if (! in_function)
yyerror(_("`return' used outside function context"));
@@ -2850,7 +2846,7 @@ regular_loop:
case 54:
/* Line 1821 of yacc.c */
-#line 827 "awkgram.y"
+#line 823 "awkgram.y"
{
if ((yyvsp[(3) - (4)]) == NULL) {
(yyval) = list_create((yyvsp[(1) - (4)]));
@@ -2876,14 +2872,14 @@ regular_loop:
case 56:
/* Line 1821 of yacc.c */
-#line 859 "awkgram.y"
+#line 855 "awkgram.y"
{ in_print = TRUE; in_parens = 0; }
break;
case 57:
/* Line 1821 of yacc.c */
-#line 860 "awkgram.y"
+#line 856 "awkgram.y"
{
/*
* Optimization: plain `print' has no expression list, so $3 is
null.
@@ -2982,14 +2978,14 @@ regular_loop:
case 58:
/* Line 1821 of yacc.c */
-#line 954 "awkgram.y"
+#line 950 "awkgram.y"
{ sub_counter = 0; }
break;
case 59:
/* Line 1821 of yacc.c */
-#line 955 "awkgram.y"
+#line 951 "awkgram.y"
{
char *arr = (yyvsp[(2) - (4)])->lextok;
@@ -3019,7 +3015,7 @@ regular_loop:
case 60:
/* Line 1821 of yacc.c */
-#line 984 "awkgram.y"
+#line 980 "awkgram.y"
{
static short warned = FALSE;
char *arr = (yyvsp[(3) - (4)])->lextok;
@@ -3043,35 +3039,35 @@ regular_loop:
case 61:
/* Line 1821 of yacc.c */
-#line 1003 "awkgram.y"
+#line 999 "awkgram.y"
{ (yyval) = optimize_assignment((yyvsp[(1) - (1)])); }
break;
case 62:
/* Line 1821 of yacc.c */
-#line 1008 "awkgram.y"
+#line 1004 "awkgram.y"
{ (yyval) = NULL; }
break;
case 63:
/* Line 1821 of yacc.c */
-#line 1010 "awkgram.y"
+#line 1006 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 64:
/* Line 1821 of yacc.c */
-#line 1015 "awkgram.y"
+#line 1011 "awkgram.y"
{ (yyval) = NULL; }
break;
case 65:
/* Line 1821 of yacc.c */
-#line 1017 "awkgram.y"
+#line 1013 "awkgram.y"
{
if ((yyvsp[(1) - (2)]) == NULL)
(yyval) = list_create((yyvsp[(2) - (2)]));
@@ -3083,14 +3079,14 @@ regular_loop:
case 66:
/* Line 1821 of yacc.c */
-#line 1024 "awkgram.y"
+#line 1020 "awkgram.y"
{ (yyval) = NULL; }
break;
case 67:
/* Line 1821 of yacc.c */
-#line 1029 "awkgram.y"
+#line 1025 "awkgram.y"
{
INSTRUCTION *casestmt = (yyvsp[(5) - (5)]);
if ((yyvsp[(5) - (5)]) == NULL)
@@ -3107,7 +3103,7 @@ regular_loop:
case 68:
/* Line 1821 of yacc.c */
-#line 1041 "awkgram.y"
+#line 1037 "awkgram.y"
{
INSTRUCTION *casestmt = (yyvsp[(4) - (4)]);
if ((yyvsp[(4) - (4)]) == NULL)
@@ -3123,21 +3119,18 @@ regular_loop:
case 69:
/* Line 1821 of yacc.c */
-#line 1055 "awkgram.y"
+#line 1051 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 70:
/* Line 1821 of yacc.c */
-#line 1057 "awkgram.y"
+#line 1053 "awkgram.y"
{
NODE *n = (yyvsp[(2) - (2)])->memory;
(void) force_number(n);
- if (n->flags & MPFN)
- mpfr_setsign(n->mpfr_numbr, n->mpfr_numbr, TRUE,
RND_MODE);
- else
- n->numbr = -n->numbr;
+ negate_num(n);
bcfree((yyvsp[(1) - (2)]));
(yyval) = (yyvsp[(2) - (2)]);
}
@@ -3146,7 +3139,7 @@ regular_loop:
case 71:
/* Line 1821 of yacc.c */
-#line 1068 "awkgram.y"
+#line 1061 "awkgram.y"
{
bcfree((yyvsp[(1) - (2)]));
(yyval) = (yyvsp[(2) - (2)]);
@@ -3156,14 +3149,14 @@ regular_loop:
case 72:
/* Line 1821 of yacc.c */
-#line 1073 "awkgram.y"
+#line 1066 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 73:
/* Line 1821 of yacc.c */
-#line 1075 "awkgram.y"
+#line 1068 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_push_re;
(yyval) = (yyvsp[(1) - (1)]);
@@ -3173,21 +3166,21 @@ regular_loop:
case 74:
/* Line 1821 of yacc.c */
-#line 1083 "awkgram.y"
+#line 1076 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 75:
/* Line 1821 of yacc.c */
-#line 1085 "awkgram.y"
+#line 1078 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 77:
/* Line 1821 of yacc.c */
-#line 1095 "awkgram.y"
+#line 1088 "awkgram.y"
{
(yyval) = (yyvsp[(2) - (3)]);
}
@@ -3196,7 +3189,7 @@ regular_loop:
case 78:
/* Line 1821 of yacc.c */
-#line 1102 "awkgram.y"
+#line 1095 "awkgram.y"
{
in_print = FALSE;
in_parens = 0;
@@ -3207,14 +3200,14 @@ regular_loop:
case 79:
/* Line 1821 of yacc.c */
-#line 1107 "awkgram.y"
+#line 1100 "awkgram.y"
{ in_print = FALSE; in_parens = 0; }
break;
case 80:
/* Line 1821 of yacc.c */
-#line 1108 "awkgram.y"
+#line 1101 "awkgram.y"
{
if ((yyvsp[(1) - (3)])->redir_type == redirect_twoway
&& (yyvsp[(3) - (3)])->lasti->opcode ==
Op_K_getline_redir
@@ -3227,7 +3220,7 @@ regular_loop:
case 81:
/* Line 1821 of yacc.c */
-#line 1119 "awkgram.y"
+#line 1112 "awkgram.y"
{
(yyval) = mk_condition((yyvsp[(3) - (6)]), (yyvsp[(1) - (6)]),
(yyvsp[(6) - (6)]), NULL, NULL);
}
@@ -3236,7 +3229,7 @@ regular_loop:
case 82:
/* Line 1821 of yacc.c */
-#line 1124 "awkgram.y"
+#line 1117 "awkgram.y"
{
(yyval) = mk_condition((yyvsp[(3) - (9)]), (yyvsp[(1) - (9)]),
(yyvsp[(6) - (9)]), (yyvsp[(7) - (9)]), (yyvsp[(9) - (9)]));
}
@@ -3245,14 +3238,14 @@ regular_loop:
case 87:
/* Line 1821 of yacc.c */
-#line 1141 "awkgram.y"
+#line 1134 "awkgram.y"
{ (yyval) = NULL; }
break;
case 88:
/* Line 1821 of yacc.c */
-#line 1143 "awkgram.y"
+#line 1136 "awkgram.y"
{
bcfree((yyvsp[(1) - (2)]));
(yyval) = (yyvsp[(2) - (2)]);
@@ -3262,21 +3255,21 @@ regular_loop:
case 89:
/* Line 1821 of yacc.c */
-#line 1151 "awkgram.y"
+#line 1144 "awkgram.y"
{ (yyval) = NULL; }
break;
case 90:
/* Line 1821 of yacc.c */
-#line 1153 "awkgram.y"
+#line 1146 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]) ; }
break;
case 91:
/* Line 1821 of yacc.c */
-#line 1158 "awkgram.y"
+#line 1151 "awkgram.y"
{
(yyvsp[(1) - (1)])->param_count = 0;
(yyval) = list_create((yyvsp[(1) - (1)]));
@@ -3286,7 +3279,7 @@ regular_loop:
case 92:
/* Line 1821 of yacc.c */
-#line 1163 "awkgram.y"
+#line 1156 "awkgram.y"
{
(yyvsp[(3) - (3)])->param_count = (yyvsp[(1) -
(3)])->lasti->param_count + 1;
(yyval) = list_append((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]));
@@ -3297,63 +3290,63 @@ regular_loop:
case 93:
/* Line 1821 of yacc.c */
-#line 1169 "awkgram.y"
+#line 1162 "awkgram.y"
{ (yyval) = NULL; }
break;
case 94:
/* Line 1821 of yacc.c */
-#line 1171 "awkgram.y"
+#line 1164 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 95:
/* Line 1821 of yacc.c */
-#line 1173 "awkgram.y"
+#line 1166 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (3)]); }
break;
case 96:
/* Line 1821 of yacc.c */
-#line 1179 "awkgram.y"
+#line 1172 "awkgram.y"
{ (yyval) = NULL; }
break;
case 97:
/* Line 1821 of yacc.c */
-#line 1181 "awkgram.y"
+#line 1174 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 98:
/* Line 1821 of yacc.c */
-#line 1186 "awkgram.y"
+#line 1179 "awkgram.y"
{ (yyval) = NULL; }
break;
case 99:
/* Line 1821 of yacc.c */
-#line 1188 "awkgram.y"
+#line 1181 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 100:
/* Line 1821 of yacc.c */
-#line 1193 "awkgram.y"
+#line 1186 "awkgram.y"
{ (yyval) = mk_expression_list(NULL, (yyvsp[(1) - (1)])); }
break;
case 101:
/* Line 1821 of yacc.c */
-#line 1195 "awkgram.y"
+#line 1188 "awkgram.y"
{
(yyval) = mk_expression_list((yyvsp[(1) - (3)]), (yyvsp[(3) -
(3)]));
yyerrok;
@@ -3363,35 +3356,35 @@ regular_loop:
case 102:
/* Line 1821 of yacc.c */
-#line 1200 "awkgram.y"
+#line 1193 "awkgram.y"
{ (yyval) = NULL; }
break;
case 103:
/* Line 1821 of yacc.c */
-#line 1202 "awkgram.y"
+#line 1195 "awkgram.y"
{ (yyval) = NULL; }
break;
case 104:
/* Line 1821 of yacc.c */
-#line 1204 "awkgram.y"
+#line 1197 "awkgram.y"
{ (yyval) = NULL; }
break;
case 105:
/* Line 1821 of yacc.c */
-#line 1206 "awkgram.y"
+#line 1199 "awkgram.y"
{ (yyval) = NULL; }
break;
case 106:
/* Line 1821 of yacc.c */
-#line 1212 "awkgram.y"
+#line 1205 "awkgram.y"
{
if (do_lint && (yyvsp[(3) - (3)])->lasti->opcode ==
Op_match_rec)
lintwarn_ln((yyvsp[(2) - (3)])->source_line,
@@ -3403,21 +3396,21 @@ regular_loop:
case 107:
/* Line 1821 of yacc.c */
-#line 1219 "awkgram.y"
+#line 1212 "awkgram.y"
{ (yyval) = mk_boolean((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2)
- (3)])); }
break;
case 108:
/* Line 1821 of yacc.c */
-#line 1221 "awkgram.y"
+#line 1214 "awkgram.y"
{ (yyval) = mk_boolean((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2)
- (3)])); }
break;
case 109:
/* Line 1821 of yacc.c */
-#line 1223 "awkgram.y"
+#line 1216 "awkgram.y"
{
if ((yyvsp[(1) - (3)])->lasti->opcode == Op_match_rec)
warning_ln((yyvsp[(2) - (3)])->source_line,
@@ -3438,7 +3431,7 @@ regular_loop:
case 110:
/* Line 1821 of yacc.c */
-#line 1239 "awkgram.y"
+#line 1232 "awkgram.y"
{
if (do_lint_old)
warning_ln((yyvsp[(2) - (3)])->source_line,
@@ -3453,7 +3446,7 @@ regular_loop:
case 111:
/* Line 1821 of yacc.c */
-#line 1249 "awkgram.y"
+#line 1242 "awkgram.y"
{
if (do_lint && (yyvsp[(3) - (3)])->lasti->opcode ==
Op_match_rec)
lintwarn_ln((yyvsp[(2) - (3)])->source_line,
@@ -3465,35 +3458,35 @@ regular_loop:
case 112:
/* Line 1821 of yacc.c */
-#line 1256 "awkgram.y"
+#line 1249 "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 1258 "awkgram.y"
+#line 1251 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 114:
/* Line 1821 of yacc.c */
-#line 1263 "awkgram.y"
+#line 1256 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 115:
/* Line 1821 of yacc.c */
-#line 1265 "awkgram.y"
+#line 1258 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 116:
/* Line 1821 of yacc.c */
-#line 1267 "awkgram.y"
+#line 1260 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_assign_quotient;
(yyval) = (yyvsp[(2) - (2)]);
@@ -3503,49 +3496,49 @@ regular_loop:
case 117:
/* Line 1821 of yacc.c */
-#line 1275 "awkgram.y"
+#line 1268 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 118:
/* Line 1821 of yacc.c */
-#line 1277 "awkgram.y"
+#line 1270 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 119:
/* Line 1821 of yacc.c */
-#line 1282 "awkgram.y"
+#line 1275 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 120:
/* Line 1821 of yacc.c */
-#line 1284 "awkgram.y"
+#line 1277 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 121:
/* Line 1821 of yacc.c */
-#line 1289 "awkgram.y"
+#line 1282 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 122:
/* Line 1821 of yacc.c */
-#line 1291 "awkgram.y"
+#line 1284 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 123:
/* Line 1821 of yacc.c */
-#line 1293 "awkgram.y"
+#line 1286 "awkgram.y"
{
int count = 2;
int is_simple_var = FALSE;
@@ -3597,49 +3590,49 @@ regular_loop:
case 125:
/* Line 1821 of yacc.c */
-#line 1345 "awkgram.y"
+#line 1338 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 126:
/* Line 1821 of yacc.c */
-#line 1347 "awkgram.y"
+#line 1340 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 127:
/* Line 1821 of yacc.c */
-#line 1349 "awkgram.y"
+#line 1342 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 128:
/* Line 1821 of yacc.c */
-#line 1351 "awkgram.y"
+#line 1344 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 129:
/* Line 1821 of yacc.c */
-#line 1353 "awkgram.y"
+#line 1346 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 130:
/* Line 1821 of yacc.c */
-#line 1355 "awkgram.y"
+#line 1348 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 131:
/* Line 1821 of yacc.c */
-#line 1357 "awkgram.y"
+#line 1350 "awkgram.y"
{
/*
* In BEGINFILE/ENDFILE, allow `getline var < file'
@@ -3667,7 +3660,7 @@ regular_loop:
case 132:
/* Line 1821 of yacc.c */
-#line 1380 "awkgram.y"
+#line 1373 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_postincrement;
(yyval) = mk_assignment((yyvsp[(1) - (2)]), NULL, (yyvsp[(2) -
(2)]));
@@ -3677,7 +3670,7 @@ regular_loop:
case 133:
/* Line 1821 of yacc.c */
-#line 1385 "awkgram.y"
+#line 1378 "awkgram.y"
{
(yyvsp[(2) - (2)])->opcode = Op_postdecrement;
(yyval) = mk_assignment((yyvsp[(1) - (2)]), NULL, (yyvsp[(2) -
(2)]));
@@ -3687,7 +3680,7 @@ regular_loop:
case 134:
/* Line 1821 of yacc.c */
-#line 1390 "awkgram.y"
+#line 1383 "awkgram.y"
{
if (do_lint_old) {
warning_ln((yyvsp[(4) - (5)])->source_line,
@@ -3712,7 +3705,7 @@ regular_loop:
case 135:
/* Line 1821 of yacc.c */
-#line 1415 "awkgram.y"
+#line 1408 "awkgram.y"
{
(yyval) = mk_getline((yyvsp[(3) - (4)]), (yyvsp[(4) - (4)]),
(yyvsp[(1) - (4)]), (yyvsp[(2) - (4)])->redir_type);
bcfree((yyvsp[(2) - (4)]));
@@ -3722,49 +3715,49 @@ regular_loop:
case 136:
/* Line 1821 of yacc.c */
-#line 1421 "awkgram.y"
+#line 1414 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 137:
/* Line 1821 of yacc.c */
-#line 1423 "awkgram.y"
+#line 1416 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 138:
/* Line 1821 of yacc.c */
-#line 1425 "awkgram.y"
+#line 1418 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 139:
/* Line 1821 of yacc.c */
-#line 1427 "awkgram.y"
+#line 1420 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 140:
/* Line 1821 of yacc.c */
-#line 1429 "awkgram.y"
+#line 1422 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 141:
/* Line 1821 of yacc.c */
-#line 1431 "awkgram.y"
+#line 1424 "awkgram.y"
{ (yyval) = mk_binary((yyvsp[(1) - (3)]), (yyvsp[(3) - (3)]), (yyvsp[(2) -
(3)])); }
break;
case 142:
/* Line 1821 of yacc.c */
-#line 1436 "awkgram.y"
+#line 1429 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3773,7 +3766,7 @@ regular_loop:
case 143:
/* Line 1821 of yacc.c */
-#line 1440 "awkgram.y"
+#line 1433 "awkgram.y"
{
if ((yyvsp[(2) - (2)])->opcode == Op_match_rec) {
(yyvsp[(2) - (2)])->opcode = Op_nomatch;
@@ -3810,14 +3803,14 @@ regular_loop:
case 144:
/* Line 1821 of yacc.c */
-#line 1472 "awkgram.y"
+#line 1465 "awkgram.y"
{ (yyval) = (yyvsp[(2) - (3)]); }
break;
case 145:
/* Line 1821 of yacc.c */
-#line 1474 "awkgram.y"
+#line 1467 "awkgram.y"
{
(yyval) = snode((yyvsp[(3) - (4)]), (yyvsp[(1) - (4)]));
if ((yyval) == NULL)
@@ -3828,7 +3821,7 @@ regular_loop:
case 146:
/* Line 1821 of yacc.c */
-#line 1480 "awkgram.y"
+#line 1473 "awkgram.y"
{
(yyval) = snode((yyvsp[(3) - (4)]), (yyvsp[(1) - (4)]));
if ((yyval) == NULL)
@@ -3839,7 +3832,7 @@ regular_loop:
case 147:
/* Line 1821 of yacc.c */
-#line 1486 "awkgram.y"
+#line 1479 "awkgram.y"
{
static short warned1 = FALSE;
@@ -3857,7 +3850,7 @@ regular_loop:
case 150:
/* Line 1821 of yacc.c */
-#line 1501 "awkgram.y"
+#line 1494 "awkgram.y"
{
(yyvsp[(1) - (2)])->opcode = Op_preincrement;
(yyval) = mk_assignment((yyvsp[(2) - (2)]), NULL, (yyvsp[(1) -
(2)]));
@@ -3867,7 +3860,7 @@ regular_loop:
case 151:
/* Line 1821 of yacc.c */
-#line 1506 "awkgram.y"
+#line 1499 "awkgram.y"
{
(yyvsp[(1) - (2)])->opcode = Op_predecrement;
(yyval) = mk_assignment((yyvsp[(2) - (2)]), NULL, (yyvsp[(1) -
(2)]));
@@ -3877,7 +3870,7 @@ regular_loop:
case 152:
/* Line 1821 of yacc.c */
-#line 1511 "awkgram.y"
+#line 1504 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3886,7 +3879,7 @@ regular_loop:
case 153:
/* Line 1821 of yacc.c */
-#line 1515 "awkgram.y"
+#line 1508 "awkgram.y"
{
(yyval) = list_create((yyvsp[(1) - (1)]));
}
@@ -3895,17 +3888,16 @@ regular_loop:
case 154:
/* Line 1821 of yacc.c */
-#line 1519 "awkgram.y"
+#line 1512 "awkgram.y"
{
if ((yyvsp[(2) - (2)])->lasti->opcode == Op_push_i
&& ((yyvsp[(2) - (2)])->lasti->memory->flags &
(STRCUR|STRING)) == 0
) {
NODE *n = (yyvsp[(2) - (2)])->lasti->memory;
+ int tval;
+
(void) force_number(n);
- if (n->flags & MPFN)
- mpfr_setsign(n->mpfr_numbr, n->mpfr_numbr,
TRUE, RND_MODE);
- else
- n->numbr = -n->numbr;
+ negate_num(n);
(yyval) = (yyvsp[(2) - (2)]);
bcfree((yyvsp[(1) - (2)]));
} else {
@@ -3918,7 +3910,7 @@ regular_loop:
case 155:
/* Line 1821 of yacc.c */
-#line 1537 "awkgram.y"
+#line 1529 "awkgram.y"
{
/*
* was: $$ = $2
@@ -3933,7 +3925,7 @@ regular_loop:
case 156:
/* Line 1821 of yacc.c */
-#line 1550 "awkgram.y"
+#line 1542 "awkgram.y"
{
func_use((yyvsp[(1) - (1)])->lasti->func_name, FUNC_USE);
(yyval) = (yyvsp[(1) - (1)]);
@@ -3943,7 +3935,7 @@ regular_loop:
case 157:
/* Line 1821 of yacc.c */
-#line 1555 "awkgram.y"
+#line 1547 "awkgram.y"
{
/* indirect function call */
INSTRUCTION *f, *t;
@@ -3981,7 +3973,7 @@ regular_loop:
case 158:
/* Line 1821 of yacc.c */
-#line 1591 "awkgram.y"
+#line 1583 "awkgram.y"
{
param_sanity((yyvsp[(3) - (4)]));
(yyvsp[(1) - (4)])->opcode = Op_func_call;
@@ -4000,42 +3992,42 @@ regular_loop:
case 159:
/* Line 1821 of yacc.c */
-#line 1608 "awkgram.y"
+#line 1600 "awkgram.y"
{ (yyval) = NULL; }
break;
case 160:
/* Line 1821 of yacc.c */
-#line 1610 "awkgram.y"
+#line 1602 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 161:
/* Line 1821 of yacc.c */
-#line 1615 "awkgram.y"
+#line 1607 "awkgram.y"
{ (yyval) = NULL; }
break;
case 162:
/* Line 1821 of yacc.c */
-#line 1617 "awkgram.y"
+#line 1609 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 163:
/* Line 1821 of yacc.c */
-#line 1622 "awkgram.y"
+#line 1614 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 164:
/* Line 1821 of yacc.c */
-#line 1624 "awkgram.y"
+#line 1616 "awkgram.y"
{
(yyval) = list_merge((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
}
@@ -4044,7 +4036,7 @@ regular_loop:
case 165:
/* Line 1821 of yacc.c */
-#line 1631 "awkgram.y"
+#line 1623 "awkgram.y"
{
INSTRUCTION *ip = (yyvsp[(1) - (1)])->lasti;
int count = ip->sub_count; /* # of SUBSEP-seperated
expressions */
@@ -4063,7 +4055,7 @@ regular_loop:
case 166:
/* Line 1821 of yacc.c */
-#line 1648 "awkgram.y"
+#line 1640 "awkgram.y"
{
INSTRUCTION *t = (yyvsp[(2) - (3)]);
if ((yyvsp[(2) - (3)]) == NULL) {
@@ -4082,14 +4074,14 @@ regular_loop:
case 167:
/* Line 1821 of yacc.c */
-#line 1665 "awkgram.y"
+#line 1657 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 168:
/* Line 1821 of yacc.c */
-#line 1667 "awkgram.y"
+#line 1659 "awkgram.y"
{
(yyval) = list_merge((yyvsp[(1) - (2)]), (yyvsp[(2) - (2)]));
}
@@ -4098,14 +4090,14 @@ regular_loop:
case 169:
/* Line 1821 of yacc.c */
-#line 1674 "awkgram.y"
+#line 1666 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (2)]); }
break;
case 170:
/* Line 1821 of yacc.c */
-#line 1679 "awkgram.y"
+#line 1671 "awkgram.y"
{
char *var_name = (yyvsp[(1) - (1)])->lextok;
@@ -4118,7 +4110,7 @@ regular_loop:
case 171:
/* Line 1821 of yacc.c */
-#line 1687 "awkgram.y"
+#line 1679 "awkgram.y"
{
char *arr = (yyvsp[(1) - (2)])->lextok;
(yyvsp[(1) - (2)])->memory = variable((yyvsp[(1) -
(2)])->source_line, arr, Node_var_new);
@@ -4130,7 +4122,7 @@ regular_loop:
case 172:
/* Line 1821 of yacc.c */
-#line 1697 "awkgram.y"
+#line 1689 "awkgram.y"
{
INSTRUCTION *ip = (yyvsp[(1) - (1)])->nexti;
if (ip->opcode == Op_push
@@ -4147,7 +4139,7 @@ regular_loop:
case 173:
/* Line 1821 of yacc.c */
-#line 1709 "awkgram.y"
+#line 1701 "awkgram.y"
{
(yyval) = list_append((yyvsp[(2) - (3)]), (yyvsp[(1) - (3)]));
if ((yyvsp[(3) - (3)]) != NULL)
@@ -4158,7 +4150,7 @@ regular_loop:
case 174:
/* Line 1821 of yacc.c */
-#line 1718 "awkgram.y"
+#line 1710 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_postincrement;
}
@@ -4167,7 +4159,7 @@ regular_loop:
case 175:
/* Line 1821 of yacc.c */
-#line 1722 "awkgram.y"
+#line 1714 "awkgram.y"
{
(yyvsp[(1) - (1)])->opcode = Op_postdecrement;
}
@@ -4176,49 +4168,49 @@ regular_loop:
case 176:
/* Line 1821 of yacc.c */
-#line 1725 "awkgram.y"
+#line 1717 "awkgram.y"
{ (yyval) = NULL; }
break;
case 178:
/* Line 1821 of yacc.c */
-#line 1733 "awkgram.y"
+#line 1725 "awkgram.y"
{ yyerrok; }
break;
case 179:
/* Line 1821 of yacc.c */
-#line 1737 "awkgram.y"
+#line 1729 "awkgram.y"
{ yyerrok; }
break;
case 182:
/* Line 1821 of yacc.c */
-#line 1746 "awkgram.y"
+#line 1738 "awkgram.y"
{ yyerrok; }
break;
case 183:
/* Line 1821 of yacc.c */
-#line 1750 "awkgram.y"
+#line 1742 "awkgram.y"
{ (yyval) = (yyvsp[(1) - (1)]); yyerrok; }
break;
case 184:
/* Line 1821 of yacc.c */
-#line 1754 "awkgram.y"
+#line 1746 "awkgram.y"
{ yyerrok; }
break;
/* Line 1821 of yacc.c */
-#line 4234 "awkgram.c"
+#line 4226 "awkgram.c"
default: break;
}
/* User semantic actions sometimes alter yychar, and that requires
@@ -4449,7 +4441,7 @@ yyreturn:
/* Line 2067 of yacc.c */
-#line 1756 "awkgram.y"
+#line 1748 "awkgram.y"
struct token {
@@ -4507,9 +4499,6 @@ static const struct token tokentab[] = {
{"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(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(atan2)},
@@ -4608,6 +4597,21 @@ getfname(NODE *(*fptr)(int))
return NULL;
}
+/* negate_num --- negate a number in NODE */
+
+void
+negate_num(NODE *n)
+{
+#ifdef HAVE_MPFR
+ if (n->flags & MPFN) {
+ int tval;
+ tval = mpfr_setsign(n->mpg_numbr, n->mpg_numbr, TRUE, RND_MODE);
+ SUBNORMALIZE(n->mpg_numbr, tval);
+ } else
+#endif
+ n->numbr = -n->numbr;
+}
+
/* print_included_from --- print `Included from ..' file names and locations */
static void
@@ -6077,8 +6081,12 @@ retry:
#ifdef HAVE_MPFR
if (do_mpfr) {
NODE *r;
- r = mpfr_node();
- (void) mpfr_set_str(r->mpfr_numbr, tokstart, base,
RND_MODE);
+ int tval;
+
+ r = mpg_node();
+ tval = mpfr_strtofr(r->mpg_numbr, tokstart, NULL, base,
RND_MODE);
+ errno = 0;
+ SUBNORMALIZE(r->mpg_numbr, tval);
yylval->memory = r;
return lasttok = YNUMBER;
}
@@ -6586,7 +6594,7 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
} else if (n->flags & NUMBER) {
#ifdef HAVE_MPFR
if (n->flags & MPFN)
- print_func(fp, "%s\n", mpfr_fmt("%.17R*g", RND_MODE,
n->mpfr_numbr));
+ print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE,
n->mpg_numbr));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
@@ -6596,7 +6604,7 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
} else if (n->flags & NUMCUR) {
#ifdef HAVE_MPFR
if (n->flags & MPFN)
- print_func(fp, "%s\n", mpfr_fmt("%.17R*g", RND_MODE,
n->mpfr_numbr));
+ print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE,
n->mpg_numbr));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
diff --git a/awkgram.y b/awkgram.y
index feb288b..40a5f43 100644
--- a/awkgram.y
+++ b/awkgram.y
@@ -34,10 +34,6 @@
#define signed /**/
#endif
-#ifndef HAVE_MPFR
-#define mpfr_setsign(u,v,w,x) /* nothing */
-#endif
-
static void yyerror(const char *m, ...) ATTRIBUTE_PRINTF_1;
static void error_ln(int line, const char *m, ...) ATTRIBUTE_PRINTF_2;
static void lintwarn_ln(int line, const char *m, ...) ATTRIBUTE_PRINTF_2;
@@ -1057,10 +1053,7 @@ case_value
{
NODE *n = $2->memory;
(void) force_number(n);
- if (n->flags & MPFN)
- mpfr_setsign(n->mpfr_numbr, n->mpfr_numbr, TRUE,
RND_MODE);
- else
- n->numbr = -n->numbr;
+ negate_num(n);
bcfree($1);
$$ = $2;
}
@@ -1521,11 +1514,10 @@ non_post_simp_exp
&& ($2->lasti->memory->flags & (STRCUR|STRING)) == 0
) {
NODE *n = $2->lasti->memory;
+ int tval;
+
(void) force_number(n);
- if (n->flags & MPFN)
- mpfr_setsign(n->mpfr_numbr, n->mpfr_numbr,
TRUE, RND_MODE);
- else
- n->numbr = -n->numbr;
+ negate_num(n);
$$ = $2;
bcfree($1);
} else {
@@ -1810,9 +1802,6 @@ static const struct token tokentab[] = {
{"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(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(atan2)},
@@ -1911,6 +1900,21 @@ getfname(NODE *(*fptr)(int))
return NULL;
}
+/* negate_num --- negate a number in NODE */
+
+void
+negate_num(NODE *n)
+{
+#ifdef HAVE_MPFR
+ if (n->flags & MPFN) {
+ int tval;
+ tval = mpfr_setsign(n->mpg_numbr, n->mpg_numbr, TRUE, RND_MODE);
+ SUBNORMALIZE(n->mpg_numbr, tval);
+ } else
+#endif
+ n->numbr = -n->numbr;
+}
+
/* print_included_from --- print `Included from ..' file names and locations */
static void
@@ -3380,8 +3384,12 @@ retry:
#ifdef HAVE_MPFR
if (do_mpfr) {
NODE *r;
- r = mpfr_node();
- (void) mpfr_set_str(r->mpfr_numbr, tokstart, base,
RND_MODE);
+ int tval;
+
+ r = mpg_node();
+ tval = mpfr_strtofr(r->mpg_numbr, tokstart, NULL, base,
RND_MODE);
+ errno = 0;
+ SUBNORMALIZE(r->mpg_numbr, tval);
yylval->memory = r;
return lasttok = YNUMBER;
}
@@ -3889,7 +3897,7 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
} else if (n->flags & NUMBER) {
#ifdef HAVE_MPFR
if (n->flags & MPFN)
- print_func(fp, "%s\n", mpfr_fmt("%.17R*g", RND_MODE,
n->mpfr_numbr));
+ print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE,
n->mpg_numbr));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
@@ -3899,7 +3907,7 @@ valinfo(NODE *n, Func_print print_func, FILE *fp)
} else if (n->flags & NUMCUR) {
#ifdef HAVE_MPFR
if (n->flags & MPFN)
- print_func(fp, "%s\n", mpfr_fmt("%.17R*g", RND_MODE,
n->mpfr_numbr));
+ print_func(fp, "%s\n", mpg_fmt("%.17R*g", RND_MODE,
n->mpg_numbr));
else
#endif
print_func(fp, "%.17g\n", n->numbr);
diff --git a/builtin.c b/builtin.c
index 1a3a399..f91a2f9 100644
--- a/builtin.c
+++ b/builtin.c
@@ -1183,7 +1183,7 @@ out2:
if (arg->flags & MPFN) {
mpfr_ptr mt;
mpfr_int:
- mt = arg->mpfr_numbr;
+ mt = arg->mpg_numbr;
if (! mpfr_number_p(mt)) {
/* inf or NaN */
cs1 = 'g';
@@ -1401,7 +1401,7 @@ mpfr_int:
} else {
while ((n =
mpfr_snprintf(obufout, ofre, cpbuf,
(int) fw, (int)
prec, RND_MODE,
- arg->mpfr_numbr))
>= ofre)
+ arg->mpg_numbr))
>= ofre)
chksize(n)
}
} else
diff --git a/cint_array.c b/cint_array.c
index 8ec0923..f82eb4b 100644
--- a/cint_array.c
+++ b/cint_array.c
@@ -52,7 +52,6 @@ static NODE **cint_list(NODE *symbol, NODE *t);
static NODE **cint_copy(NODE *symbol, NODE *newsymb);
static NODE **cint_dump(NODE *symbol, NODE *ndump);
#ifdef ARRAYDEBUG
-static NODE **cint_option(NODE *opt, NODE *val);
static void cint_print(NODE *symbol);
#endif
@@ -66,9 +65,6 @@ array_ptr cint_array_func[] = {
cint_list,
cint_copy,
cint_dump,
-#ifdef ARRAYDEBUG
- cint_option,
-#endif
};
static inline int cint_hash(long k);
@@ -624,22 +620,6 @@ cint_find(NODE *symbol, long k, int h1)
#ifdef ARRAYDEBUG
-static NODE **
-cint_option(NODE *opt, NODE *val)
-{
- NODE *tmp;
- NODE **ret = (NODE **) ! NULL;
-
- tmp = force_string(opt);
- (void) force_number(val);
- if (strcmp(tmp->stptr, "NHAT") == 0)
- NHAT = (int) val->numbr;
- else
- ret = NULL;
- return ret;
-}
-
-
/* cint_print --- print structural info */
static void
diff --git a/command.c b/command.c
index 17ba047..81c601d 100644
--- a/command.c
+++ b/command.c
@@ -1713,7 +1713,7 @@ yyreduce:
{
case 3:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 109 "command.y"
{
cmd_idx = -1;
@@ -1733,7 +1733,7 @@ yyreduce:
case 5:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 128 "command.y"
{
if (errcount == 0 && cmd_idx >= 0) {
@@ -1788,7 +1788,7 @@ yyreduce:
case 6:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 178 "command.y"
{
yyerrok;
@@ -1797,14 +1797,14 @@ yyreduce:
case 22:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 212 "command.y"
{ want_nodeval = TRUE; }
break;
case 23:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 217 "command.y"
{
if (errcount == 0) {
@@ -1824,7 +1824,7 @@ yyreduce:
case 24:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 235 "command.y"
{
(yyval) = append_statement(arg_list, (char *) start_EVAL);
@@ -1837,14 +1837,14 @@ yyreduce:
case 25:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 242 "command.y"
{ (yyval) = append_statement((yyvsp[(1) - (2)]), lexptr_begin); }
break;
case 26:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 243 "command.y"
{
(yyval) = (yyvsp[(3) - (4)]);
@@ -1853,7 +1853,7 @@ yyreduce:
case 27:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 250 "command.y"
{
arg_list = append_statement((yyvsp[(2) - (3)]), (char *)
end_EVAL);
@@ -1874,7 +1874,7 @@ yyreduce:
case 28:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 266 "command.y"
{
NODE *n;
@@ -1890,7 +1890,7 @@ yyreduce:
case 34:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 285 "command.y"
{
if (cmdtab[cmd_idx].class == D_FRAME
@@ -1901,7 +1901,7 @@ yyreduce:
case 35:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 291 "command.y"
{
int idx = find_argument((yyvsp[(2) - (2)]));
@@ -1918,49 +1918,49 @@ yyreduce:
case 38:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 304 "command.y"
{ want_nodeval = TRUE; }
break;
case 40:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 305 "command.y"
{ want_nodeval = TRUE; }
break;
case 46:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 310 "command.y"
{ want_nodeval = TRUE; }
break;
case 49:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 312 "command.y"
{ want_nodeval = TRUE; }
break;
case 51:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 313 "command.y"
{ want_nodeval = TRUE; }
break;
case 53:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 314 "command.y"
{ want_nodeval = TRUE; }
break;
case 57:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 318 "command.y"
{
if (in_cmd_src((yyvsp[(2) - (2)])->a_string))
@@ -1970,7 +1970,7 @@ yyreduce:
case 58:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 323 "command.y"
{
if (! input_from_tty)
@@ -1980,7 +1980,7 @@ yyreduce:
case 59:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 328 "command.y"
{
int type = 0;
@@ -2011,7 +2011,7 @@ yyreduce:
case 60:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 354 "command.y"
{
if (! in_commands)
@@ -2026,7 +2026,7 @@ yyreduce:
case 61:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 364 "command.y"
{
if (! in_commands)
@@ -2036,7 +2036,7 @@ yyreduce:
case 62:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 369 "command.y"
{
int idx = find_argument((yyvsp[(2) - (2)]));
@@ -2053,14 +2053,14 @@ yyreduce:
case 63:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 380 "command.y"
{ want_nodeval = TRUE; }
break;
case 64:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 381 "command.y"
{
int type;
@@ -2073,7 +2073,7 @@ yyreduce:
case 65:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 389 "command.y"
{
if (in_commands) {
@@ -2089,7 +2089,7 @@ yyreduce:
case 66:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 403 "command.y"
{
if ((yyvsp[(1) - (1)]) != NULL) {
@@ -2104,42 +2104,42 @@ yyreduce:
case 68:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 417 "command.y"
{ (yyval) = NULL; }
break;
case 69:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 422 "command.y"
{ (yyval) = NULL; }
break;
case 74:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 431 "command.y"
{ (yyval) = NULL; }
break;
case 75:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 436 "command.y"
{ (yyval) = NULL; }
break;
case 77:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 439 "command.y"
{ (yyval) = NULL; }
break;
case 78:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 444 "command.y"
{
NODE *n;
@@ -2151,14 +2151,14 @@ yyreduce:
case 79:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 454 "command.y"
{ (yyval) = NULL; }
break;
case 80:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 456 "command.y"
{
if (find_option((yyvsp[(1) - (1)])->a_string) < 0)
@@ -2168,7 +2168,7 @@ yyreduce:
case 81:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 461 "command.y"
{
if (find_option((yyvsp[(1) - (3)])->a_string) < 0)
@@ -2178,7 +2178,7 @@ yyreduce:
case 82:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 469 "command.y"
{
NODE *n;
@@ -2196,56 +2196,56 @@ yyreduce:
case 83:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 485 "command.y"
{ (yyval) = NULL; }
break;
case 88:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 494 "command.y"
{ (yyval) = NULL; }
break;
case 89:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 495 "command.y"
{ want_nodeval = TRUE; }
break;
case 92:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 497 "command.y"
{ want_nodeval = TRUE; }
break;
case 95:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 503 "command.y"
{ (yyval) = NULL; }
break;
case 97:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 509 "command.y"
{ (yyval) = NULL; }
break;
case 99:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 515 "command.y"
{ (yyval) = NULL; }
break;
case 104:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 527 "command.y"
{
int idx = find_argument((yyvsp[(1) - (2)]));
@@ -2262,7 +2262,7 @@ yyreduce:
case 106:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 543 "command.y"
{
(yyvsp[(2) - (2)])->type = D_array; /* dump all items */
@@ -2272,7 +2272,7 @@ yyreduce:
case 107:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 548 "command.y"
{
(yyvsp[(2) - (3)])->type = D_array;
@@ -2282,21 +2282,21 @@ yyreduce:
case 117:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 574 "command.y"
{ (yyval) = NULL; }
break;
case 118:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 576 "command.y"
{ (yyval) = NULL; }
break;
case 119:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 578 "command.y"
{
CMDARG *a;
@@ -2308,7 +2308,7 @@ yyreduce:
case 126:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 594 "command.y"
{
if ((yyvsp[(1) - (3)])->a_int > (yyvsp[(3) - (3)])->a_int)
@@ -2322,28 +2322,28 @@ yyreduce:
case 127:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 606 "command.y"
{ (yyval) = NULL; }
break;
case 134:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 620 "command.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 135:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 622 "command.y"
{ (yyval) = (yyvsp[(1) - (3)]); }
break;
case 137:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 628 "command.y"
{
CMDARG *a;
@@ -2363,21 +2363,21 @@ yyreduce:
case 139:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 647 "command.y"
{ (yyval) = (yyvsp[(1) - (1)]); num_dim = 1; }
break;
case 140:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 649 "command.y"
{ (yyval) = (yyvsp[(1) - (2)]); num_dim++; }
break;
case 142:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 655 "command.y"
{
NODE *n = (yyvsp[(2) - (2)])->a_node;
@@ -2391,7 +2391,7 @@ yyreduce:
case 143:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 664 "command.y"
{
/* a_string is array name, a_count is dimension count */
@@ -2403,14 +2403,14 @@ yyreduce:
case 144:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 674 "command.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 145:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 676 "command.y"
{
NODE *n = (yyvsp[(2) - (2)])->a_node;
@@ -2422,49 +2422,49 @@ yyreduce:
case 146:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 683 "command.y"
{
NODE *n = (yyvsp[(2) - (2)])->a_node;
if ((n->flags & NUMBER) == 0)
yyerror(_("non-numeric value found, numeric expected"));
else
- (yyvsp[(2) - (2)])->a_node->numbr = - n->numbr;
+ negate_num(n);
(yyval) = (yyvsp[(2) - (2)]);
}
break;
case 147:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 695 "command.y"
{ (yyval) = NULL; }
break;
case 148:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 697 "command.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 149:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 702 "command.y"
{ (yyval) = NULL; }
break;
case 150:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 704 "command.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 151:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 709 "command.y"
{
if ((yyvsp[(1) - (1)])->a_int == 0)
@@ -2475,7 +2475,7 @@ yyreduce:
case 152:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 715 "command.y"
{
if ((yyvsp[(2) - (2)])->a_int == 0)
@@ -2486,21 +2486,21 @@ yyreduce:
case 153:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 724 "command.y"
{ (yyval) = (yyvsp[(1) - (1)]); }
break;
case 154:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 726 "command.y"
{ (yyval) = (yyvsp[(2) - (2)]); }
break;
case 155:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 728 "command.y"
{
(yyvsp[(2) - (2)])->a_int = - (yyvsp[(2) - (2)])->a_int;
@@ -2510,7 +2510,7 @@ yyreduce:
case 156:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 736 "command.y"
{
if (lexptr_begin != NULL) {
@@ -2524,7 +2524,7 @@ yyreduce:
-/* Line 1806 of yacc.c */
+/* Line 1821 of yacc.c */
#line 2541 "command.c"
default: break;
}
@@ -3252,22 +3252,28 @@ err:
return D_STRING;
}
- /* assert(want_nodval == TRUE); */
-
/* look for awk number */
if (isdigit((unsigned char) tokstart[0])) {
- double d;
+ NODE *r = NULL;
errno = 0;
- d = strtod(tokstart, &lexptr);
+#ifdef HAVE_MPFR
+ if (do_mpfr) {
+ r = mpg_node();
+ (void) mpfr_strtofr(r->mpg_numbr, tokstart, & lexptr,
0, RND_MODE);
+ } else
+#endif
+ r = make_number(strtod(tokstart, & lexptr));
+
if (errno != 0) {
yyerror(strerror(errno));
+ unref(r);
errno = 0;
return '\n';
}
yylval = mk_cmdarg(D_node);
- yylval->a_node = make_number(d);
+ yylval->a_node = r;
append_cmdarg(yylval);
return D_NODE;
}
diff --git a/command.y b/command.y
index 64066a0..e36497a 100644
--- a/command.y
+++ b/command.y
@@ -685,7 +685,7 @@ node
if ((n->flags & NUMBER) == 0)
yyerror(_("non-numeric value found, numeric expected"));
else
- $2->a_node->numbr = - n->numbr;
+ negate_num(n);
$$ = $2;
}
;
@@ -1238,22 +1238,28 @@ err:
return D_STRING;
}
- /* assert(want_nodval == TRUE); */
-
/* look for awk number */
if (isdigit((unsigned char) tokstart[0])) {
- double d;
+ NODE *r = NULL;
errno = 0;
- d = strtod(tokstart, &lexptr);
+#ifdef HAVE_MPFR
+ if (do_mpfr) {
+ r = mpg_node();
+ (void) mpfr_strtofr(r->mpg_numbr, tokstart, & lexptr,
0, RND_MODE);
+ } else
+#endif
+ r = make_number(strtod(tokstart, & lexptr));
+
if (errno != 0) {
yyerror(strerror(errno));
+ unref(r);
errno = 0;
return '\n';
}
yylval = mk_cmdarg(D_node);
- yylval->a_node = make_number(d);
+ yylval->a_node = r;
append_cmdarg(yylval);
return D_NODE;
}
diff --git a/configh.in b/configh.in
index cd57c4d..c8960d6 100644
--- a/configh.in
+++ b/configh.in
@@ -157,7 +157,7 @@
/* we have the mktime function */
#undef HAVE_MKTIME
-/* Define to 1 if you have a fully functional mpfr and gmp library. */
+/* Define to 1 if you have fully functional mpfr and gmp libraries. */
#undef HAVE_MPFR
/* Define to 1 if you have the <netdb.h> header file. */
diff --git a/debug.c b/debug.c
index 5fb8d9e..331c7d3 100644
--- a/debug.c
+++ b/debug.c
@@ -51,7 +51,7 @@ static size_t linebuf_len;
FILE *out_fp;
char *dPrompt;
char *commands_Prompt = "> "; /* breakpoint or watchpoint commands list */
-char *eval_Prompt = "@> "; /* awk statement(s) */
+char *eval_Prompt = "@> "; /* awk statement(s) */
int input_from_tty = FALSE;
int input_fd;
@@ -173,7 +173,7 @@ static struct {
int break_point; /* non-zero (breakpoint number) if stopped at
break point */
int watch_point; /* non-zero (watchpoint number) if stopped at
watch point */
- int (*check_func)(INSTRUCTION **); /* function to decide when to
suspend
+ int (*check_func)(INSTRUCTION **); /* function to decide when to
suspend
* awk interpreter and return
control
* to debugger command
interpreter.
*/
@@ -231,10 +231,10 @@ static const char *options_file = DEFAULT_OPTFILE;
static const char *history_file = DEFAULT_HISTFILE;
#endif
-/* keep all option variables in one place */
+/* debugger option related variables */
static char *output_file = "/dev/stdout"; /* gawk output redirection */
-char *dgawk_Prompt = NULL; /* initialized in do_debug */
+char *dgawk_Prompt = NULL; /* initialized in do_debug */
static int list_size = DEFAULT_LISTSIZE; /* # of lines that 'list' prints */
static int do_trace = FALSE;
static int do_save_history = TRUE;
@@ -307,9 +307,10 @@ static int watchpoint_triggered(struct list_item *w);
static void print_instruction(INSTRUCTION *pc, Func_print print_func, FILE
*fp, int in_dump);
static int print_code(INSTRUCTION *pc, void *x);
static void next_command();
+static void debug_post_execute(INSTRUCTION *pc);
+static int debug_pre_execute(INSTRUCTION **pi);
static char *g_readline(const char *prompt);
static int prompt_yes_no(const char *, char , int , FILE *);
-
static struct pf_data {
Func_print print_func;
int defn;
@@ -325,8 +326,8 @@ struct command_source
char * (*read_func)(const char *);
int (*close_func)(int);
int eof_status; /* see push_cmd_src */
- int cmd; /* D_source or 0 */
- char *str; /* sourced file */
+ int cmd; /* D_source or 0 */
+ char *str; /* sourced file */
struct command_source *next;
};
@@ -893,7 +894,7 @@ do_info(CMDARG *arg, int cmd ATTRIBUTE_UNUSED)
}
gprintf(out_fp, "\n");
} else if (IS_FIELD(d))
- gprintf(out_fp, "%d:\t$%ld\n",
d->number, (long) symbol->numbr);
+ gprintf(out_fp, "%d:\t$%ld\n",
d->number, get_number_si(symbol));
else
gprintf(out_fp, "%d:\t%s\n", d->number,
d->sname);
if (d->cndn.code != NULL)
@@ -1179,7 +1180,7 @@ do_print_var(CMDARG *arg, int cmd ATTRIBUTE_UNUSED)
break;
case D_field:
- print_field(a->a_node->numbr);
+ print_field(get_number_si(a->a_node));
break;
default:
@@ -1283,7 +1284,7 @@ do_set_var(CMDARG *arg, int cmd ATTRIBUTE_UNUSED)
long field_num;
Func_ptr assign = NULL;
- field_num = (long) arg->a_node->numbr;
+ field_num = get_number_si(arg->a_node);
assert(field_num >= 0);
arg = arg->next;
val = arg->a_node;
@@ -1533,7 +1534,7 @@ display(struct list_item *d)
} else if (IS_FIELD(d)) {
NODE *r = d->symbol;
fprintf(out_fp, "%d: ", d->number);
- print_field(r->numbr);
+ print_field(get_number_si(r));
} else {
print_sym:
fprintf(out_fp, "%d: %s = ", d->number, d->sname);
@@ -1590,7 +1591,7 @@ condition_triggered(struct condition *cndn)
return FALSE; /* not triggered */
force_number(r);
- di = (r->numbr != 0.0);
+ di = is_nonzero_num(r);
DEREF(r);
return di;
}
@@ -1684,7 +1685,7 @@ watchpoint_triggered(struct list_item *w)
(void) find_subscript(w, &t2);
else if (IS_FIELD(w)) {
long field_num;
- field_num = (long) w->symbol->numbr;
+ field_num = get_number_si(w->symbol);
t2 = *get_field(field_num, NULL);
} else {
switch (symbol->type) {
@@ -1767,7 +1768,7 @@ initialize_watch_item(struct list_item *w)
} else if (IS_FIELD(w)) {
long field_num;
t = w->symbol;
- field_num = (long) t->numbr;
+ field_num = get_number_si(t);
r = *get_field(field_num, NULL);
w->cur_value = dupnode(r);
} else {
@@ -1806,7 +1807,7 @@ do_watch(CMDARG *arg, int cmd ATTRIBUTE_UNUSED)
fprintf(out_fp, "Watchpoint %d: ", w->number);
symbol = w->symbol;
-/* FIXME: common code also in print_watch_item */
+ /* FIXME: common code also in print_watch_item */
if (IS_SUBSCRIPT(w)) {
fprintf(out_fp, "%s", w->sname);
for (i = 0; i < w->num_subs; i++) {
@@ -1815,7 +1816,7 @@ do_watch(CMDARG *arg, int cmd ATTRIBUTE_UNUSED)
}
fprintf(out_fp, "\n");
} else if (IS_FIELD(w))
- fprintf(out_fp, "$%ld\n", (long) symbol->numbr);
+ fprintf(out_fp, "$%ld\n", get_number_si(symbol));
else
fprintf(out_fp, "%s\n", w->sname);
@@ -2721,6 +2722,15 @@ initialize_readline()
#endif
+/* init_debug --- register debugger exec hooks */
+
+void
+init_debug()
+{
+ register_exec_hook(debug_pre_execute, debug_post_execute);
+}
+
+
/* debug_prog --- debugger entry point */
int
@@ -3380,7 +3390,7 @@ print_watch_item(struct list_item *w)
}
fprintf(out_fp, "\n");
} else if (IS_FIELD(w))
- fprintf(out_fp, "$%ld\n", (long) symbol->numbr);
+ fprintf(out_fp, "$%ld\n", get_number_si(symbol));
else
fprintf(out_fp, "%s\n", w->sname);
@@ -3491,10 +3501,10 @@ no_output:
read_command(); /* zzparse */
}
-/* post_execute --- post_hook in the interpreter */
+/* debug_post_execute --- post_hook in the interpreter */
-void
-post_execute(INSTRUCTION *pc)
+static void
+debug_post_execute(INSTRUCTION *pc)
{
if (! in_main_context())
return;
@@ -3544,13 +3554,13 @@ post_execute(INSTRUCTION *pc)
}
}
-/* pre_execute --- pre_hook, called by the interpreter before execution;
+/* debug_pre_execute --- pre_hook, called by the interpreter before execution;
* checks if execution needs to be suspended and control
* transferred to the debugger.
*/
-int
-pre_execute(INSTRUCTION **pi)
+static int
+debug_pre_execute(INSTRUCTION **pi)
{
static int cant_stop = FALSE;
NODE *m;
@@ -3645,13 +3655,23 @@ print_memory(NODE *m, NODE *func, Func_print
print_func, FILE *fp)
case Node_val:
if (m == Nnull_string)
print_func(fp, "Nnull_string");
- else if ((m->flags & NUMBER) != 0)
- print_func(fp, "%g", m->numbr);
- else if ((m->flags & STRING) != 0)
+ else if ((m->flags & NUMBER) != 0) {
+#ifdef HAVE_MPFR
+ if (m->flags & MPFN)
+ print_func(fp, "%s", mpg_fmt("%R*g",
RND_MODE, m->mpg_numbr));
+ else
+#endif
+ print_func(fp, "%g", m->numbr);
+ } else if ((m->flags & STRING) != 0)
pp_string_fp(print_func, fp, m->stptr,
m->stlen, '"', FALSE);
- else if ((m->flags & NUMCUR) != 0)
- print_func(fp, "%g", m->numbr);
- else if ((m->flags & STRCUR) != 0)
+ else if ((m->flags & NUMCUR) != 0) {
+#ifdef HAVE_MPFR
+ if (m->flags & MPFN)
+ print_func(fp, "%s", mpg_fmt("%R*g",
RND_MODE, m->mpg_numbr));
+ else
+#endif
+ print_func(fp, "%g", m->numbr);
+ } else if ((m->flags & STRCUR) != 0)
pp_string_fp(print_func, fp, m->stptr,
m->stlen, '"', FALSE);
else
print_func(fp, "-?-");
@@ -4362,7 +4382,7 @@ enlarge_buffer:
nchar = serialize_subscript(buf + bl, buflen -
bl, wd);
else if (IS_FIELD(wd))
nchar = snprintf(buf + bl, buflen - bl,
"%d%c%d%c%d%c",
- wd->number, FSEP, D_field, FSEP,
(int) wd->symbol->numbr, FSEP);
+ wd->number, FSEP, D_field, FSEP,
(int) get_number_si(wd->symbol), FSEP);
else
nchar = snprintf(buf + bl, buflen - bl,
"%d%c%d%c%s%c",
wd->number, FSEP, D_variable, FSEP,
wd->sname, FSEP);
@@ -4929,7 +4949,7 @@ do_print_f(CMDARG *arg, int cmd ATTRIBUTE_UNUSED)
{
long field_num;
r = a->a_node;
- field_num = (long) r->numbr;
+ field_num = get_number_si(r);
tmp[i] = *get_field(field_num, NULL);
}
break;
diff --git a/eval.c b/eval.c
index 7d00771..c812b7b 100644
--- a/eval.c
+++ b/eval.c
@@ -36,9 +36,11 @@ IOBUF *curfile = NULL; /* current data file */
int exiting = FALSE;
int (*interpret)(INSTRUCTION *);
+#define MAX_EXEC_HOOKS 10
+static int num_exec_hook = 0;
+static Func_pre_exec pre_execute[MAX_EXEC_HOOKS];
+static Func_post_exec post_execute = NULL;
-extern int pre_execute(INSTRUCTION **);
-extern void post_execute(INSTRUCTION *);
extern void frame_popped();
#if __GNUC__ < 2
@@ -591,16 +593,15 @@ cmp_nodes(NODE *t1, NODE *t2)
assert((t2->flags & MPFN) != 0);
/*
- * N.B.: Gawk returns 1 if either t1 or t2 is NaN.
+ * 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->mpfr_numbr) ||
mpfr_nan_p(t2->mpfr_numbr))
+ if (mpfr_nan_p(t1->mpg_numbr) ||
mpfr_nan_p(t2->mpg_numbr))
return 1;
- return mpfr_cmp(t1->mpfr_numbr, t2->mpfr_numbr);
+ 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 */
@@ -764,8 +765,7 @@ set_BINMODE()
BINMODE = 0;
else if (BINMODE > 3)
BINMODE = 3;
- }
- else if ((BINMODE_node->var_value->flags & STRING) != 0) {
+ } else if ((v->flags & STRING) != 0) {
p = v->stptr;
/*
@@ -814,8 +814,7 @@ set_BINMODE()
break;
}
}
- }
- else
+ } else
BINMODE = 3; /* shouldn't happen */
}
@@ -1040,12 +1039,12 @@ update_NR()
{
#ifdef HAVE_MPFR
if ((NR_node->var_value->flags & MPFN) != 0)
- mpfr_update_var(NR_node);
+ mpg_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);
+ NR_node->var_value = make_number(NR);
}
}
@@ -1054,14 +1053,14 @@ update_NR()
void
update_NF()
{
- double d;
+ long l;
- d = get_number_d(NF_node->var_value);
- if (NF == -1 || d != NF) {
+ l = get_number_si(NF_node->var_value);
+ if (NF == -1 || l != NF) {
if (NF == -1)
(void) get_field(UNLIMITED - 1, NULL); /* parse record
*/
unref(NF_node->var_value);
- NF_node->var_value = make_number((AWKNUM) NF);
+ NF_node->var_value = make_number(NF);
}
}
@@ -1072,12 +1071,12 @@ update_FNR()
{
#ifdef HAVE_MPFR
if ((FNR_node->var_value->flags & MPFN) != 0)
- mpfr_update_var(FNR_node);
+ mpg_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);
+ FNR_node->var_value = make_number(FNR);
}
}
@@ -1693,32 +1692,60 @@ pop_exec_state(int *rule, char **src, long *sz)
}
-/* interpreter routine when not debugging */
-#include "interpret.h"
+/* register_exec_hook --- add exec hooks in the interpreter. */
+
+int
+register_exec_hook(Func_pre_exec preh, Func_post_exec posth)
+{
+ int pos = 0;
+
+ /*
+ * multiple post-exec hooks aren't supported. post-exec hook is mainly
+ * for use by the debugger.
+ */
+
+ if (! preh || (post_execute && posth))
+ return FALSE;
+
+ if (num_exec_hook == MAX_EXEC_HOOKS)
+ return FALSE;
+
+ /*
+ * Add to the beginning of the array but do not displace the
+ * debugger hook if it exists.
+ */
+ if (num_exec_hook > 0) {
+ pos = !! do_debug;
+ if (num_exec_hook > pos)
+ memmove(pre_execute + pos + 1, pre_execute + pos,
+ (num_exec_hook - pos) * sizeof (preh));
+ }
+ pre_execute[pos] = preh;
+ num_exec_hook++;
+
+ if (posth)
+ post_execute = posth;
+
+ return TRUE;
+}
-/* interpreter routine when deubugging with gawk --debug */
-#define r_interpret debug_interpret
-#define DEBUGGING 1
+
+/* interpreter routine when not debugging */
#include "interpret.h"
-#undef DEBUGGING
-#undef r_interpret
-/* interpreter routine for gawk --mpfr */
-#ifdef HAVE_MPFR
-#define r_interpret mpfr_interpret
-#define EXE_MPFR 1
+/* interpreter routine with exec hook(s). Used when debugging and/or with
MPFR. */
+#define r_interpret h_interpret
+#define EXEC_HOOK 1
#include "interpret.h"
-#undef EXE_MPFR
+#undef EXEC_HOOK
#undef r_interpret
-#endif
-
-/* FIXME interpreter routine for gawk --mpfr --debug */
void
init_interpret()
{
long newval;
+ int i = 0;
if ((newval = getenv_long("GAWK_STACKSIZE")) > 0)
STACK_SIZE = newval;
@@ -1743,16 +1770,15 @@ init_interpret()
node_Boolean[TRUE]->flags |= NUMINT;
}
- /* select the interpreter routine */
-#ifdef HAVE_MPFR
- if (do_mpfr && do_debug)
- interpret = mpfr_interpret; /* FIXME mpfr_debug_interpret;
*/
- else if (do_mpfr)
- interpret = mpfr_interpret;
- else
-#endif
- if (do_debug)
- interpret = debug_interpret;
+ /*
+ * Select the interpreter routine. The version without
+ * any exec hook support (r_interpret) is faster by about
+ * 5%, or more depending on the opcodes.
+ */
+
+ if (num_exec_hook > 0)
+ interpret = h_interpret;
else
- interpret = r_interpret;
+ interpret = r_interpret;
}
+
diff --git a/ext.c b/ext.c
index 39e512f..6a87632 100644
--- a/ext.c
+++ b/ext.c
@@ -95,7 +95,6 @@ load_ext(const char *lib_name, const char *init_func, NODE
*obj)
if (gpl_compat == NULL)
fatal(_("extension: library `%s': does not define
`plugin_is_GPL_compatible' (%s)\n"),
lib_name, dlerror());
-
func = (NODE *(*)(NODE *, void *)) dlsym(dl, init_func);
if (func == NULL)
fatal(_("extension: library `%s': cannot call function `%s'
(%s)\n"),
diff --git a/field.c b/field.c
index ecee5d5..d496a57 100644
--- a/field.c
+++ b/field.c
@@ -206,8 +206,8 @@ rebuild_record()
n->flags |= (r->flags &
(NUMCUR|NUMBER));
#ifdef HAVE_MPFR
if (r->flags & MPFN) {
- mpfr_init(n->mpfr_numbr);
- mpfr_set(n->mpfr_numbr,
r->mpfr_numbr, RND_MODE);
+ mpfr_init(n->mpg_numbr);
+ mpfr_set(n->mpg_numbr,
r->mpg_numbr, RND_MODE);
} else
#endif
n->numbr = r->numbr;
diff --git a/int_array.c b/int_array.c
index d998310..0fa3764 100644
--- a/int_array.c
+++ b/int_array.c
@@ -40,10 +40,6 @@ static NODE **int_list(NODE *symbol, NODE *t);
static NODE **int_copy(NODE *symbol, NODE *newsymb);
static NODE **int_dump(NODE *symbol, NODE *ndump);
-#ifdef ARRAYDEBUG
-static NODE **int_option(NODE *opt, NODE *val);
-#endif
-
static uint32_t int_hash(uint32_t k, uint32_t hsize);
static inline NODE **int_find(NODE *symbol, long k, uint32_t hash1);
static NODE **int_insert(NODE *symbol, long k, uint32_t hash1);
@@ -59,9 +55,6 @@ array_ptr int_array_func[] = {
int_list,
int_copy,
int_dump,
-#ifdef ARRAYDEBUG
- int_option,
-#endif
};
@@ -804,25 +797,3 @@ grow_int_table(NODE *symbol)
}
efree(old);
}
-
-
-#ifdef ARRAYDEBUG
-
-static NODE **
-int_option(NODE *opt, NODE *val)
-{
- int newval;
- NODE *tmp;
- NODE **ret = (NODE **) ! NULL;
-
- tmp = force_string(opt);
- (void) force_number(val);
- if (strcmp(tmp->stptr, "INT_CHAIN_MAX") == 0) {
- newval = (int) val->numbr;
- if (newval > 0)
- INT_CHAIN_MAX = newval;
- } else
- ret = NULL;
- return ret;
-}
-#endif
diff --git a/interpret.h b/interpret.h
index fc521dd..2f38fbe 100644
--- a/interpret.h
+++ b/interpret.h
@@ -24,13 +24,6 @@
*/
-#ifdef EXE_MPFR
-#define NV(r) (r)->mpfr_numbr
-#else
-#define NV(r) (r)->numbr
-#endif
-
-
int
r_interpret(INSTRUCTION *code)
{
@@ -41,15 +34,15 @@ r_interpret(INSTRUCTION *code)
INSTRUCTION *ni;
NODE *t1, *t2;
NODE **lhs;
- AWKNUM x;
+ AWKNUM x, x2;
int di;
Regexp *rp;
/* array subscript */
#define mk_sub(n) (n == 1 ? POP_SCALAR() : concat_exp(n, TRUE))
-#ifdef DEBUGGING
-#define JUMPTO(x) do { post_execute(pc); pc = (x); goto top; } while
(FALSE)
+#ifdef EXEC_HOOK
+#define JUMPTO(x) do { if (post_execute) post_execute(pc); pc = (x); goto
top; } while (FALSE)
#else
#define JUMPTO(x) do { pc = (x); goto top; } while (FALSE)
#endif
@@ -69,9 +62,11 @@ top:
if (pc->source_line > 0)
sourceline = pc->source_line;
-#ifdef DEBUGGING
- if (! pre_execute(& pc))
- goto top;
+#ifdef EXEC_HOOK
+ for (di = 0; di < num_exec_hook; di++) {
+ if (! pre_execute[di](& pc))
+ goto top;
+ }
#endif
switch ((op = pc->opcode)) {
@@ -387,128 +382,97 @@ top:
break;
case Op_plus_i:
- t2 = force_number(pc->memory);
+ x2 = force_number(pc->memory)->numbr;
goto plus;
case Op_plus:
t2 = POP_NUMBER();
+ x2 = t2->numbr;
+ DEREF(t2);
plus:
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
+ r = make_number(t1->numbr + x2);
DEREF(t1);
- if (op == Op_plus)
- DEREF(t2);
REPLACE(r);
break;
case Op_minus_i:
- t2 = force_number(pc->memory);
+ x2 = force_number(pc->memory)->numbr;
goto minus;
case Op_minus:
t2 = POP_NUMBER();
+ x2 = t2->numbr;
+ DEREF(t2);
minus:
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
+ r = make_number(t1->numbr - x2);
DEREF(t1);
- if (op == Op_minus)
- DEREF(t2);
REPLACE(r);
break;
case Op_times_i:
- t2 = force_number(pc->memory);
+ x2 = force_number(pc->memory)->numbr;
goto times;
case Op_times:
t2 = POP_NUMBER();
+ x2 = t2->numbr;
+ DEREF(t2);
times:
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
+ r = make_number(t1->numbr * x2);
DEREF(t1);
- if (op == Op_times)
- DEREF(t2);
REPLACE(r);
break;
case Op_exp_i:
- t2 = force_number(pc->memory);
+ x2 = force_number(pc->memory)->numbr;
goto exp;
case Op_exp:
t2 = POP_NUMBER();
+ x2 = t2->numbr;
+ DEREF(t2);
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
+ r = make_number(calc_exp(t1->numbr, x2));
DEREF(t1);
- if (op == Op_exp)
- DEREF(t2);
REPLACE(r);
break;
case Op_quotient_i:
- t2 = force_number(pc->memory);
+ x2 = force_number(pc->memory)->numbr;
goto quotient;
case Op_quotient:
t2 = POP_NUMBER();
+ x2 = t2->numbr;
+ DEREF(t2);
quotient:
t1 = TOP_NUMBER();
-#ifdef EXE_MPFR
- r = mpfr_node();
- mpfr_div(NV(r), NV(t1), NV(t2), RND_MODE);
-#else
- if (NV(t2) == 0)
+ if (x2 == 0)
fatal(_("division by zero attempted"));
- x = NV(t1) / NV(t2);
- r = make_number(x);
-#endif
+ r = make_number(t1->numbr / x2);
DEREF(t1);
- if (op == Op_quotient)
- DEREF(t2);
REPLACE(r);
break;
case Op_mod_i:
- t2 = force_number(pc->memory);
+ x2 = force_number(pc->memory)->numbr;
goto mod;
case Op_mod:
t2 = POP_NUMBER();
+ x2 = t2->numbr;
+ DEREF(t2);
mod:
t1 = TOP_NUMBER();
-#ifdef EXE_MPFR
- r = mpfr_node();
- mpfr_fmod(NV(r), NV(t1), NV(t2), RND_MODE);
-#else
- if (NV(t2) == 0)
+ if (x2 == 0)
fatal(_("division by zero attempted in `%%'"));
#ifdef HAVE_FMOD
- x = fmod(NV(t1), NV(t2));
+ x = fmod(t1->numbr, x2);
#else /* ! HAVE_FMOD */
- (void) modf(NV(t1) / NV(t2), &x);
- x = NV(t1) - x * NV(t2);
+ (void) modf(t1->numbr / x2, &x);
+ x = t1->numbr - x * x2;
#endif /* ! HAVE_FMOD */
r = make_number(x);
-#endif
+
DEREF(t1);
- if (op == Op_mod)
- DEREF(t2);
REPLACE(r);
break;
@@ -520,19 +484,10 @@ mod:
force_number(t1);
if (t1->valref == 1 && t1->flags ==
(MALLOC|NUMCUR|NUMBER)) {
/* optimization */
-#ifdef EXE_MPFR
- mpfr_add_d(NV(t1), NV(t1), x, RND_MODE);
-#else
- NV(t1) += x;
-#endif
+ t1->numbr += x;
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
+ r = *lhs = make_number(t1->numbr + x);
unref(t1);
}
UPREF(r);
@@ -545,39 +500,20 @@ mod:
lhs = TOP_ADDRESS();
t1 = *lhs;
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 */
- 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);
- }
-#else
- r = make_number(NV(t1));
+ r = make_number(t1->numbr);
if (t1->valref == 1 && t1->flags ==
(MALLOC|NUMCUR|NUMBER)) {
/* optimization */
- NV(t1) += x;
+ t1->numbr += x;
} else {
- *lhs = make_number(NV(t1) + x);
+ *lhs = make_number(t1->numbr + x);
unref(t1);
}
-#endif
REPLACE(r);
break;
case Op_unary_minus:
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
+ r = make_number(-t1->numbr);
DEREF(t1);
REPLACE(r);
break;
@@ -683,11 +619,7 @@ mod:
case Op_assign_quotient:
case Op_assign_mod:
case Op_assign_exp:
-#ifdef EXE_MPFR
- op_mpfr_assign(op);
-#else
op_assign(op);
-#endif
break;
case Op_var_update: /* update value of NR, FNR or NF */
@@ -696,18 +628,9 @@ 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
-
+ r = TOP();
if (pc->assign_ctxt == Op_sub_builtin
- && di == 0 /* top of stack has a number ==
0 */
+ && get_number_si(r) == 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.
@@ -717,7 +640,7 @@ mod:
break;
} else if ((pc->assign_ctxt == Op_K_getline
|| pc->assign_ctxt ==
Op_K_getline_redir)
- && di <= 0 /* top of stack has a number <=
0 */
+ && get_number_si(r) <= 0 /* top of stack
has a number <= 0 */
) {
/* getline returned EOF or error */
@@ -1182,8 +1105,7 @@ match_re:
fatal(_("`exit' cannot be called in the current
context"));
exiting = TRUE;
- t1 = POP_SCALAR();
- (void) force_number(t1);
+ t1 = POP_NUMBER();
exit_val = (int) get_number_si(t1);
DEREF(t1);
#ifdef VMS
@@ -1294,5 +1216,3 @@ match_re:
#undef mk_sub
#undef JUMPTO
}
-
-#undef NV
diff --git a/io.c b/io.c
index 43600eb..c7ae06e 100644
--- a/io.c
+++ b/io.c
@@ -132,6 +132,14 @@
#define PIPES_SIMULATED
#endif
+#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++
+#else
+#define INCREMENT_R(X) X++
+#endif
+
typedef enum { CLOSE_ALL, CLOSE_TO, CLOSE_FROM } two_way_close_type;
/* Several macros make the code a bit clearer: */
@@ -443,7 +451,7 @@ set_FNR()
(void) force_number(FNR_node->var_value);
#ifdef HAVE_MPFR
if ((FNR_node->var_value->flags & MPFN) != 0)
- FNR = mpfr_set_var(FNR_node);
+ FNR = mpg_set_var(FNR_node);
else
#endif
FNR = FNR_node->var_value->numbr;
@@ -457,7 +465,7 @@ set_NR()
(void) force_number(NR_node->var_value);
#ifdef HAVE_MPFR
if ((NR_node->var_value->flags & MPFN) != 0)
- NR = mpfr_set_var(NR_node);
+ NR = mpg_set_var(NR_node);
else
#endif
NR = NR_node->var_value->numbr;
@@ -484,8 +492,8 @@ inrec(IOBUF *iop, int *errcode)
if (*errcode > 0)
update_ERRNO_saved(*errcode);
} else {
- INCREMNT(NR);
- INCREMNT(FNR);
+ INCREMENT_R(NR);
+ INCREMENT_R(FNR);
set_record(begin, cnt);
}
@@ -2316,8 +2324,8 @@ do_getline(int intovar, IOBUF *iop)
if (cnt == EOF)
return NULL; /* try next file */
- INCREMNT(NR);
- INCREMNT(FNR);
+ INCREMENT_R(NR);
+ INCREMENT_R(FNR);
if (! intovar) /* no optional var. */
set_record(s, cnt);
diff --git a/m4/mpfr.m4 b/m4/mpfr.m4
index 11cfe10..7d9e678 100644
--- a/m4/mpfr.m4
+++ b/m4/mpfr.m4
@@ -50,7 +50,7 @@ mpz_clear(z);
if test $_found_mpfr = yes ; then
AC_DEFINE(HAVE_MPFR,1,
- [Define to 1 if you have a fully functional mpfr and gmp
library.])
+ [Define to 1 if you have fully functional mpfr and gmp
libraries.])
AC_SUBST(LIBMPFR,$_combo)
break
fi
diff --git a/main.c b/main.c
index 00a63d5..558c91f 100644
--- a/main.c
+++ b/main.c
@@ -36,7 +36,7 @@
#define DEFAULT_PROFILE "awkprof.out" /* where to put profile
*/
#define DEFAULT_VARFILE "awkvars.out" /* where to put vars */
#define DEFAULT_PREC 53
-#define DEFAULT_RNDMODE "RNDN"
+#define DEFAULT_RNDMODE "N" /* round to nearest */
static const char *varfile = DEFAULT_VARFILE;
const char *command_file = NULL; /* debugger commands */
@@ -60,7 +60,7 @@ static void init_groupset(void);
static void save_argv(int, char **);
extern int debug_prog(INSTRUCTION *pc); /* debug.c */
-
+extern int init_debug(); /* debug.c */
/* These nodes store all the special variables AWK uses */
NODE *ARGC_node, *ARGIND_node, *ARGV_node, *BINMODE_node, *CONVFMT_node;
@@ -571,7 +571,11 @@ out:
}
#endif
+ if (do_debug) /* Need to register the debugger pre-exec hook before
any other */
+ init_debug();
+
#ifdef HAVE_MPFR
+ /* Set up MPFR defaults, and register pre-exec hook to process
arithmetic opcodes */
if (do_mpfr)
init_mpfr(DEFAULT_RNDMODE);
#endif
@@ -583,8 +587,8 @@ out:
Nnull_string = make_string("", 0);
#ifdef HAVE_MPFR
if (do_mpfr) {
- mpfr_init(Nnull_string->mpfr_numbr);
- mpfr_set_d(Nnull_string->mpfr_numbr, 0.0, RND_MODE);
+ 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);
} else
#endif
@@ -600,8 +604,6 @@ out:
*/
resetup();
- init_interpret();
-
/* Set up the special variables */
init_vars();
@@ -652,6 +654,9 @@ out:
optind++;
}
+ /* Select the interpreter routine */
+ init_interpret();
+
init_args(optind, argc,
do_posix ? argv[0] : myname,
argv);
diff --git a/mpfr.c b/mpfr.c
index 18fe744..5e93ea5 100644
--- a/mpfr.c
+++ b/mpfr.c
@@ -25,24 +25,14 @@
#include "awk.h"
-#ifndef HAVE_MPFR
+#ifdef HAVE_MPFR
-void
-set_PREC()
-{
- /* dummy function */
-}
-
-void
-set_RNDMODE()
-{
- /* dummy function */
-}
-
-#else
+#if __GNU_MP_VERSION < 5
+typedef unsigned long int mp_bitcnt_t;
+#endif
-#ifndef mp_bitcnt_t
-#define mp_bitcnt_t unsigned long
+#if MPFR_VERSION_MAJOR < 3
+typedef mp_exp_t mpfr_exp_t;
#endif
extern NODE **fmt_list; /* declared in eval.c */
@@ -50,43 +40,47 @@ 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;
+int do_subnormalize; /* emulate subnormal number arithmetic */
-static mpfr_rnd_t mpfr_rnd_mode(const char *mode, size_t mode_len);
+static mpfr_rnd_t get_rnd_mode(const char rmode);
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);
+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);
/* init_mpfr --- set up MPFR related variables */
void
-init_mpfr(const char *rnd_mode)
+init_mpfr(const char *rmode)
{
mpfr_set_default_prec(PRECISION);
- RND_MODE = mpfr_rnd_mode(rnd_mode, strlen(rnd_mode));
+ RND_MODE = get_rnd_mode(rmode[0]);
mpfr_set_default_rounding_mode(RND_MODE);
- make_number = mpfr_make_number;
- m_force_number = mpfr_force_number;
- format_val = mpfr_format_val;
+ 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);
+ do_subnormalize = FALSE;
+ register_exec_hook(mpg_interpret, 0);
}
-/* mpfr_node --- allocate a node to store a MPFR number */
+/* mpg_node --- allocate a node to store a MPFR number */
NODE *
-mpfr_node()
+mpg_node()
{
NODE *r;
getnode(r);
r->type = Node_val;
/* Initialize, set precision to the default precision, and value to NaN
*/
- mpfr_init(r->mpfr_numbr);
+ mpfr_init(r->mpg_numbr);
r->valref = 1;
r->flags = MALLOC|MPFN|NUMBER|NUMCUR;
@@ -99,26 +93,30 @@ mpfr_node()
return r;
}
-/* mpfr_make_number --- make a MPFR number node and initialize with a double */
+/* mpg_make_number --- make a MPFR number node and initialize with a double */
static NODE *
-mpfr_make_number(double x)
+mpg_make_number(double x)
{
NODE *r;
- r = mpfr_node();
- mpfr_set_d(r->mpfr_numbr, x, RND_MODE);
+ int tval;
+
+ r = mpg_node();
+ tval = mpfr_set_d(r->mpg_numbr, x, RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
return r;
}
-/* mpfr_force_number --- force a value to be a MPFR number */
+/* mpg_force_number --- force a value to be a MPFR number */
static NODE *
-mpfr_force_number(NODE *n)
+mpg_force_number(NODE *n)
{
char *cp, *cpend, *ptr;
char save;
int base = 10;
unsigned int newflags = 0;
+ int tval;
if ((n->flags & (MPFN|NUMCUR)) == (MPFN|NUMCUR))
return n;
@@ -130,9 +128,9 @@ mpfr_force_number(NODE *n)
if ((n->flags & MPFN) == 0) {
n->flags |= MPFN;
- mpfr_init(n->mpfr_numbr);
+ mpfr_init(n->mpg_numbr);
}
- mpfr_set_d(n->mpfr_numbr, 0.0, RND_MODE);
+ mpfr_set_d(n->mpg_numbr, 0.0, RND_MODE);
if (n->stlen == 0)
return n;
@@ -151,7 +149,8 @@ mpfr_force_number(NODE *n)
base = get_numbase(cp, TRUE);
errno = 0;
- (void) mpfr_strtofr(n->mpfr_numbr, cp, & ptr, base, RND_MODE);
+ tval = mpfr_strtofr(n->mpg_numbr, cp, & ptr, base, RND_MODE);
+ SUBNORMALIZE(n->mpg_numbr, tval);
/* trailing space is OK for NUMBER */
while (isspace((unsigned char) *ptr))
@@ -166,10 +165,10 @@ mpfr_force_number(NODE *n)
}
-/* mpfr_format_val --- format a numeric value based on format */
+/* mpg_format_val --- format a numeric value based on format */
static NODE *
-mpfr_format_val(const char *format, int index, NODE *s)
+mpg_format_val(const char *format, int index, NODE *s)
{
NODE *dummy[2], *r;
unsigned int oflags;
@@ -178,7 +177,7 @@ mpfr_format_val(const char *format, int index, NODE *s)
dummy[1] = s;
oflags = s->flags;
- if (mpfr_integer_p(s->mpfr_numbr)) {
+ if (mpfr_integer_p(s->mpg_numbr)) {
/* integral value, use %d */
r = format_tree("%d", 2, dummy, 2);
s->stfmt = -1;
@@ -201,17 +200,12 @@ mpfr_format_val(const char *format, int index, NODE *s)
/*
- * mpfr_update_var --- update NR or FNR.
+ * mpg_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)
+mpg_update_var(NODE *n)
{
NODE *val = n->var_value;
long nl;
@@ -230,28 +224,28 @@ mpfr_update_var(NODE *n)
double d;
/* Efficiency hack for NR < LONG_MAX */
- d = mpfr_get_d(val->mpfr_numbr, RND_MODE);
+ d = mpfr_get_d(val->mpg_numbr, RND_MODE);
if (d != nl) {
unref(n->var_value);
- n->var_value = make_number((AWKNUM) nl);
+ n->var_value = make_number(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);
+ 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);
}
}
-/* mpfr_set_var --- set NR or FNR */
+/* mpg_set_var --- set NR or FNR */
long
-mpfr_set_var(NODE *n)
+mpg_set_var(NODE *n)
{
long l;
mpfr_ptr nm;
- mpfr_ptr p = n->var_value->mpfr_numbr;
+ mpfr_ptr p = n->var_value->mpg_numbr;
int neg = FALSE;
if (n == NR_node)
@@ -283,43 +277,92 @@ mpfr_set_var(NODE *n)
void
set_PREC()
{
- /* TODO: "DOUBLE", "QUAD", "OCT", .. */
+ long prec = 0;
+ NODE *val;
+ static const struct ieee_fmt {
+ const char *name;
+ mpfr_prec_t precision;
+ mpfr_exp_t emax;
+ mpfr_exp_t emin;
+ } ieee_fmts[] = {
+{ "half", 11, 16, -23 }, /* binary16 */
+{ "single", 24, 128, -148 }, /* binary32 */
+{ "double", 53, 1024, -1073 }, /* binary64 */
+{ "quad", 113, 16384, -16493 }, /* binary128 */
+{ "oct", 237, 262144, -262377 }, /* binary256, not in the IEEE
754-2008 standard */
+
+ /*
+ * For any bitwidth = 32 * k ( k >= 4),
+ * precision = 13 + bitwidth - int(4 * log2(bitwidth))
+ * emax = 1 << bitwidth - precision - 1
+ * emin = 4 - emax - precision
+ */
+ };
+
+ if (! do_mpfr)
+ return;
+
+ val = PREC_node->var_value;
+ if (val->flags & MAYBE_NUM)
+ force_number(val);
+
+ if ((val->flags & (STRING|NUMBER)) == STRING) {
+ int i, j;
+
+ /* emulate binary IEEE 754 arithmetic */
+
+ for (i = 0, j = sizeof(ieee_fmts)/sizeof(ieee_fmts[0]); i < j;
i++) {
+ if (strcmp(ieee_fmts[i].name, val->stptr) == 0)
+ break;
+ }
- if (do_mpfr) {
- long l;
- NODE *val = PREC_node->var_value;
+ if (i < j) {
+ prec = ieee_fmts[i].precision;
+ mpfr_set_emax(ieee_fmts[i].emax);
+ mpfr_set_emin(ieee_fmts[i].emin);
+ do_subnormalize = TRUE;
+ }
+ }
- (void) force_number(val);
- l = get_number_si(val);
+ if (prec <= 0) {
+ force_number(val);
+ prec = get_number_si(val);
+ if (prec < MPFR_PREC_MIN || prec > MPFR_PREC_MAX) {
+ force_string(val);
+ warning(_("PREC value `%.*s' is invalid"),
(int)val->stlen, val->stptr);
+ prec = 0;
+ }
+ }
- 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);
+ if (prec > 0) {
+ mpfr_set_default_prec(prec);
+ PRECISION = mpfr_get_default_prec();
}
}
-/* mpfr_rnd_mode --- convert string to MPFR rounding mode */
+
+/* get_rnd_mode --- convert string to MPFR rounding mode */
static mpfr_rnd_t
-mpfr_rnd_mode(const char *mode, size_t mode_len)
+get_rnd_mode(const char rmode)
{
- if (mode_len != 4 || strncmp(mode, "RND", 3) != 0)
- return -1;
-
- switch (mode[3]) {
+ switch (rmode) {
case 'N':
- return MPFR_RNDN;
+ case 'n':
+ return MPFR_RNDN; /* round to nearest */
case 'Z':
- return MPFR_RNDZ;
+ case 'z':
+ return MPFR_RNDZ; /* round toward zero */
case 'U':
- return MPFR_RNDU;
+ case 'u':
+ return MPFR_RNDU; /* round toward plus infinity */
case 'D':
- return MPFR_RNDD;
+ case 'd':
+ return MPFR_RNDD; /* round toward minus infinity */
#ifdef MPFR_RNDA
case 'A':
- return MPFR_RNDA;
+ case 'a':
+ return MPFR_RNDA; /* round away from zero */
#endif
default:
break;
@@ -333,15 +376,16 @@ void
set_RNDMODE()
{
if (do_mpfr) {
- mpfr_rnd_t rnd;
+ mpfr_rnd_t rnd = -1;
NODE *n;
- n = force_string( RNDMODE_node->var_value);
- rnd = mpfr_rnd_mode(n->stptr, n->stlen);
+ n = force_string(RNDMODE_node->var_value);
+ if (n->stlen == 1)
+ rnd = get_rnd_mode(n->stptr[0]);
if (rnd != -1) {
mpfr_set_default_rounding_mode(rnd);
RND_MODE = rnd;
} else
- warning(_("Invalid value for RNDMODE: `%s'"), n->stptr);
+ warning(_("RNDMODE value `%.*s' is invalid"),
(int)n->stlen, n->stptr);
}
}
@@ -363,8 +407,8 @@ get_bit_ops(NODE **p1, NODE **p2, const char *op)
lintwarn(_("%s: received non-numeric second argument"),
op);
}
- left = force_number(t1)->mpfr_numbr;
- right = force_number(t2)->mpfr_numbr;
+ left = force_number(t1)->mpg_numbr;
+ right = force_number(t2)->mpg_numbr;
if (! mpfr_number_p(left)) {
/* [+-]inf or NaN */
@@ -381,12 +425,12 @@ get_bit_ops(NODE **p1, NODE **p2, const char *op)
if (do_lint) {
if (mpfr_signbit(left) || mpfr_signbit(right))
lintwarn("%s",
- mpfr_fmt(_("%s(%Rg, %Rg): negative values will give strange
results"),
+ 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",
- mpfr_fmt(_("%s(%Rg, %Rg): fractional values will be truncated"),
+ mpg_fmt(_("%s(%Rg, %Rg): fractional values will be truncated"),
op, left, right)
);
}
@@ -394,7 +438,7 @@ get_bit_ops(NODE **p1, NODE **p2, const char *op)
}
-/* do_and --- perform an & operation */
+/* do_mpfr_and --- perform an & operation */
NODE *
do_mpfr_and(int nargs)
@@ -406,12 +450,12 @@ do_mpfr_and(int nargs)
return res;
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 */
+ 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 = mpfr_node();
- mpfr_set_z(res->mpfr_numbr, z, RND_MODE); /* integer to float
conversion */
+ res = mpg_node();
+ mpfr_set_z(res->mpg_numbr, z, RND_MODE); /* integer to float
conversion */
mpz_clear(z);
DEREF(t1);
@@ -419,12 +463,13 @@ do_mpfr_and(int nargs)
return res;
}
-/* do_atan2 --- do the atan2 function */
+/* do_mpfr_atan2 --- do the atan2 function */
NODE *
do_mpfr_atan2(int nargs)
{
NODE *t1, *t2, *res;
+ int tval;
t2 = POP_SCALAR();
t1 = POP_SCALAR();
@@ -438,9 +483,10 @@ do_mpfr_atan2(int nargs)
force_number(t1);
force_number(t2);
- res = mpfr_node();
+ res = mpg_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);
+ tval = mpfr_atan2(res->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr,
RND_MODE);
+ SUBNORMALIZE(res->mpg_numbr, tval);
DEREF(t1);
DEREF(t2);
@@ -448,7 +494,7 @@ do_mpfr_atan2(int nargs)
}
-/* do_compl --- perform a ~ operation */
+/* do_mpfr_compl --- perform a ~ operation */
NODE *
do_mpfr_compl(int nargs)
@@ -460,7 +506,7 @@ do_mpfr_compl(int nargs)
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("compl: received non-numeric argument"));
- p = force_number(tmp)->mpfr_numbr;
+ p = force_number(tmp)->mpg_numbr;
if (! mpfr_number_p(p)) {
/* [+-]inf or NaN */
return tmp;
@@ -469,34 +515,36 @@ do_mpfr_compl(int nargs)
if (do_lint) {
if (mpfr_signbit(p))
lintwarn("%s",
- mpfr_fmt(_("compl(%Rg): negative value will give strange
results"), p)
+ mpg_fmt(_("compl(%Rg): negative value will give strange
results"), p)
);
if (! mpfr_integer_p(p))
lintwarn("%s",
- mpfr_fmt(_("comp(%Rg): fractional value will be truncated"), p)
+ mpg_fmt(_("comp(%Rg): fractional value will be truncated"), p)
);
}
mpfr_get_z(mpzval, p, MPFR_RNDZ);
mpz_com(mpzval, mpzval);
- r = mpfr_node();
- mpfr_set_z(r->mpfr_numbr, mpzval, RND_MODE);
+ 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 = mpfr_node(); \
-mpfr_##X(res->mpfr_numbr, tmp->mpfr_numbr, RND_MODE); \
+res = mpg_node(); \
+tval = mpfr_##X(res->mpg_numbr, tmp->mpg_numbr, RND_MODE); \
+SUBNORMALIZE(res->mpg_numbr, tval); \
DEREF(tmp); \
return res
-/* do_sin --- do the sin function */
+/* do_mpfr_sin --- do the sin function */
NODE *
do_mpfr_sin(int nargs)
@@ -504,7 +552,7 @@ do_mpfr_sin(int nargs)
SPEC_MATH(sin);
}
-/* do_cos --- do the cos function */
+/* do_mpfr_cos --- do the cos function */
NODE *
do_mpfr_cos(int nargs)
@@ -512,7 +560,7 @@ do_mpfr_cos(int nargs)
SPEC_MATH(cos);
}
-/* do_exp --- exponential function */
+/* do_mpfr_exp --- exponential function */
NODE *
do_mpfr_exp(int nargs)
@@ -520,7 +568,7 @@ do_mpfr_exp(int nargs)
SPEC_MATH(exp);
}
-/* do_log --- the log function */
+/* do_mpfr_log --- the log function */
NODE *
do_mpfr_log(int nargs)
@@ -528,7 +576,7 @@ do_mpfr_log(int nargs)
SPEC_MATH(log);
}
-/* do_sqrt --- do the sqrt function */
+/* do_mpfr_sqrt --- do the sqrt function */
NODE *
do_mpfr_sqrt(int nargs)
@@ -536,8 +584,7 @@ do_mpfr_sqrt(int nargs)
SPEC_MATH(sqrt);
}
-
-/* do_int --- convert double to int for awk */
+/* do_mpfr_int --- convert double to int for awk */
NODE *
do_mpfr_int(int nargs)
@@ -548,28 +595,19 @@ 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->mpfr_numbr)) {
+ if (! mpfr_number_p(tmp->mpg_numbr)) {
/* [+-]inf or NaN */
return tmp;
}
- mpfr_get_z(mpzval, tmp->mpfr_numbr, MPFR_RNDZ);
- r = mpfr_node();
- mpfr_set_z(r->mpfr_numbr, mpzval, RND_MODE);
+ 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_lshift --- perform a << operation */
-/*
- * Test:
- * $ ./gawk 'BEGIN { print lshift(1, 52) }'
- * 4503599627370496
- * $ ./gawk 'BEGIN { print lshift(1, 53) }'
- * 0
- * $ ./gawk -M 'BEGIN { print lshift(1, 53) }'
- * 9007199254740992
- */
+/* do_mpfr_lshift --- perform a << operation */
NODE *
do_mpfr_lshift(int nargs)
@@ -580,19 +618,19 @@ do_mpfr_lshift(int nargs)
if ((res = get_bit_ops(& t1, & t2, "lshift")) != NULL)
return res;
- 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 */
+ 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 */
- res = mpfr_node();
- mpfr_set_z(res->mpfr_numbr, mpzval, RND_MODE); /* integer to float
conversion */
+ res = mpg_node();
+ mpfr_set_z(res->mpg_numbr, mpzval, RND_MODE); /* integer to float
conversion */
DEREF(t1);
DEREF(t2);
return res;
}
-/* do_or --- perform an | operation */
+/* do_mpfr_or --- perform an | operation */
NODE *
do_mpfr_or(int nargs)
@@ -604,12 +642,12 @@ do_mpfr_or(int nargs)
return res;
mpz_init(z);
- mpfr_get_z(mpzval, t1->mpfr_numbr, MPFR_RNDZ);
- mpfr_get_z(z, t2->mpfr_numbr, MPFR_RNDZ);
+ mpfr_get_z(mpzval, t1->mpg_numbr, MPFR_RNDZ);
+ mpfr_get_z(z, t2->mpg_numbr, MPFR_RNDZ);
mpz_ior(z, mpzval, z);
- res = mpfr_node();
- mpfr_set_z(res->mpfr_numbr, z, RND_MODE);
+ res = mpg_node();
+ mpfr_set_z(res->mpg_numbr, z, RND_MODE);
mpz_clear(z);
DEREF(t1);
@@ -618,31 +656,7 @@ do_mpfr_or(int nargs)
}
-/* do_rshift --- perform a >> operation */
-
-/*
- * $ ./gawk 'BEGIN { print rshift(0xFFFF, 1)}'
- * 32767
- * $ ./gawk -M 'BEGIN { print rshift(0xFFFF, 1)}'
- * 32767
- * $ ./gawk 'BEGIN { print rshift(-0xFFFF, 1)}'
- * 9007199254708224
- * $ ./gawk -M 'BEGIN { print rshift(-0xFFFF, 1) }'
- * -32768
- *
- * $ ./gawk 'BEGIN { print rshift(lshift(123456789012345678, 45), 45)}'
- * 80
- * $ ./gawk -M 'BEGIN { print rshift(lshift(123456789012345678, 45), 45)}'
- * 123456789012345680
- * $ ./gawk -M -vPREC=80 'BEGIN { print rshift(lshift(123456789012345678, 45),
45)}'
- * 123456789012345678
- *
- * $ ./gawk -M 'BEGIN { print rshift(lshift(1, 999999999), 999999999)}'
- * 1
- * $ ./gawk -M 'BEGIN { print rshift(lshift(1, 9999999999), 9999999999)}'
- * gmp: overflow in mpz type
- * Aborted
- */
+/* do_mpfr_rshift --- perform a >> operation */
NODE *
do_mpfr_rhift(int nargs)
@@ -653,44 +667,45 @@ do_mpfr_rhift(int nargs)
if ((res = get_bit_ops(& t1, & t2, "rshift")) != NULL)
return res;
- 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 */
+ 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 */
- res = mpfr_node();
- mpfr_set_z(res->mpfr_numbr, mpzval, RND_MODE); /* integer to float
conversion */
+ res = mpg_node();
+ mpfr_set_z(res->mpg_numbr, mpzval, RND_MODE); /* integer to float
conversion */
DEREF(t1);
DEREF(t2);
return res;
}
-/* do_strtonum --- the strtonum function */
+/* do_mpfr_strtonum --- the strtonum function */
NODE *
do_mpfr_strtonum(int nargs)
{
NODE *tmp, *r;
- int base;
+ int base, tval;
tmp = POP_SCALAR();
- r = mpfr_node();
+ r = mpg_node();
if ((tmp->flags & (NUMBER|NUMCUR)) != 0)
- mpfr_set(r->mpfr_numbr, tmp->mpfr_numbr, RND_MODE);
+ tval = mpfr_set(r->mpg_numbr, tmp->mpg_numbr, RND_MODE);
else if ((base = get_numbase(tmp->stptr, use_lc_numeric)) != 10) {
- mpfr_strtofr(r->mpfr_numbr, tmp->stptr, NULL, base, RND_MODE);
+ tval = mpfr_strtofr(r->mpg_numbr, tmp->stptr, NULL, base,
RND_MODE);
errno = 0;
} else {
(void) force_number(tmp);
- mpfr_set(r->mpfr_numbr, tmp->mpfr_numbr, RND_MODE);
+ tval = mpfr_set(r->mpg_numbr, tmp->mpg_numbr, RND_MODE);
}
+ SUBNORMALIZE(r->mpg_numbr, tval);
DEREF(tmp);
return r;
}
-/* do_xor --- perform an ^ operation */
+/* do_mpfr_xor --- perform an ^ operation */
NODE *
do_mpfr_xor(int nargs)
@@ -702,12 +717,12 @@ do_mpfr_xor(int nargs)
return res;
mpz_init(z);
- mpfr_get_z(mpzval, t1->mpfr_numbr, MPFR_RNDZ);
- mpfr_get_z(z, t2->mpfr_numbr, MPFR_RNDZ);
+ mpfr_get_z(mpzval, t1->mpg_numbr, MPFR_RNDZ);
+ mpfr_get_z(z, t2->mpg_numbr, MPFR_RNDZ);
mpz_xor(z, mpzval, z);
- res = mpfr_node();
- mpfr_set_z(res->mpfr_numbr, z, RND_MODE);
+ res = mpg_node();
+ mpfr_set_z(res->mpg_numbr, z, RND_MODE);
mpz_clear(z);
DEREF(t1);
@@ -715,16 +730,18 @@ do_mpfr_xor(int nargs)
return res;
}
+
static int firstrand = TRUE;
static gmp_randstate_t state;
static mpz_t seed; /* current seed */
-/* do_rand --- do the rand function */
+/* do_mpfr_rand --- do the rand function */
NODE *
do_mpfr_rand(int nargs ATTRIBUTE_UNUSED)
{
NODE *res;
+ int tval;
if (firstrand) {
/* Choose the default algorithm */
@@ -735,18 +752,20 @@ do_mpfr_rand(int nargs ATTRIBUTE_UNUSED)
gmp_randseed(state, seed);
firstrand = FALSE;
}
- res = mpfr_node();
- mpfr_urandomb(res->mpfr_numbr, state);
+ res = mpg_node();
+ tval = mpfr_urandomb(res->mpg_numbr, state);
+ SUBNORMALIZE(res->mpg_numbr, tval);
return res;
}
-/* do_srand --- seed the random number generator */
+/* do_mpfr_srand --- seed the random number generator */
NODE *
do_mpfr_srand(int nargs)
{
- NODE *tmp, *res;
+ NODE *res;
+ int tval;
if (firstrand) {
/* Choose the default algorithm */
@@ -757,17 +776,19 @@ do_mpfr_srand(int nargs)
firstrand = FALSE;
}
- res = mpfr_node();
- mpfr_set_z(res->mpfr_numbr, seed, RND_MODE); /* previous seed */
+ res = mpg_node();
+ tval = mpfr_set_z(res->mpg_numbr, seed, RND_MODE); /* previous
seed */
+ SUBNORMALIZE(res->mpg_numbr, tval);
if (nargs == 0)
mpz_set_ui(seed, (unsigned long) time((time_t *) 0));
else {
+ NODE *tmp;
tmp = POP_SCALAR();
if (do_lint && (tmp->flags & (NUMCUR|NUMBER)) == 0)
lintwarn(_("srand: received non-numeric argument"));
force_number(tmp);
- mpfr_get_z(seed, tmp->mpfr_numbr, MPFR_RNDZ);
+ mpfr_get_z(seed, tmp->mpg_numbr, MPFR_RNDZ);
DEREF(tmp);
}
@@ -775,67 +796,241 @@ do_mpfr_srand(int nargs)
return res;
}
+/*
+ * mpg_interpret --- pre-exec hook in the interpreter. Handles
+ * arithmetic operations with MPFR numbers.
+ */
-/* op_mpfr_assign --- assignment operators excluding = */
-
-void
-op_mpfr_assign(OPCODE op)
+static int
+mpg_interpret(INSTRUCTION **cp)
{
+ INSTRUCTION *pc = *cp; /* current instruction */
+ OPCODE op; /* current opcode */
+ NODE *r = NULL;
+ NODE *t1, *t2;
NODE **lhs;
- NODE *t1, *t2, *r;
+ AWKNUM x;
mpfr_ptr p1, p2;
+ int tval;
+
+ switch ((op = pc->opcode)) {
+ case Op_plus_i:
+ t2 = force_number(pc->memory);
+ goto plus;
+ case Op_plus:
+ t2 = POP_NUMBER();
+plus:
+ t1 = TOP_NUMBER();
+ r = mpg_node();
+ tval = mpfr_add(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr,
RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ DEREF(t1);
+ if (op == Op_plus)
+ DEREF(t2);
+ REPLACE(r);
+ break;
- lhs = POP_ADDRESS();
- t1 = *lhs;
- p1 = force_number(t1)->mpfr_numbr;
+ case Op_minus_i:
+ t2 = force_number(pc->memory);
+ goto minus;
+ case Op_minus:
+ t2 = POP_NUMBER();
+minus:
+ t1 = TOP_NUMBER();
+ r = mpg_node();
+ tval = mpfr_sub(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr,
RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ DEREF(t1);
+ if (op == Op_minus)
+ DEREF(t2);
+ REPLACE(r);
+ break;
- t2 = TOP_SCALAR();
- p2 = force_number(t2)->mpfr_numbr;
+ case Op_times_i:
+ t2 = force_number(pc->memory);
+ goto times;
+ case Op_times:
+ t2 = POP_NUMBER();
+times:
+ t1 = TOP_NUMBER();
+ r = mpg_node();
+ tval = mpfr_mul(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr,
RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ DEREF(t1);
+ if (op == Op_times)
+ DEREF(t2);
+ REPLACE(r);
+ break;
- r = mpfr_node();
- switch (op) {
- case Op_assign_plus:
- mpfr_add(r->mpfr_numbr, p1, p2, RND_MODE);
+ case Op_exp_i:
+ t2 = force_number(pc->memory);
+ goto exp;
+ case Op_exp:
+ t2 = POP_NUMBER();
+exp:
+ t1 = TOP_NUMBER();
+ r = mpg_node();
+ tval = mpfr_pow(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr,
RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ DEREF(t1);
+ if (op == Op_exp)
+ DEREF(t2);
+ REPLACE(r);
break;
- case Op_assign_minus:
- mpfr_sub(r->mpfr_numbr, p1, p2, RND_MODE);
+
+ case Op_quotient_i:
+ t2 = force_number(pc->memory);
+ goto quotient;
+ case Op_quotient:
+ t2 = POP_NUMBER();
+quotient:
+ t1 = TOP_NUMBER();
+ r = mpg_node();
+ tval = mpfr_div(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr,
RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ DEREF(t1);
+ if (op == Op_quotient)
+ DEREF(t2);
+ REPLACE(r);
+ break;
+
+ case Op_mod_i:
+ t2 = force_number(pc->memory);
+ goto mod;
+ case Op_mod:
+ t2 = POP_NUMBER();
+mod:
+ t1 = TOP_NUMBER();
+ r = mpg_node();
+ tval = mpfr_fmod(r->mpg_numbr, t1->mpg_numbr, t2->mpg_numbr,
RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ DEREF(t1);
+ if (op == Op_mod)
+ DEREF(t2);
+ REPLACE(r);
break;
- case Op_assign_times:
- mpfr_mul(r->mpfr_numbr, p1, p2, RND_MODE);
+
+ case Op_preincrement:
+ case Op_predecrement:
+ x = op == Op_preincrement ? 1.0 : -1.0;
+ lhs = TOP_ADDRESS();
+ t1 = *lhs;
+ force_number(t1);
+ if (t1->valref == 1 && t1->flags == (MALLOC|NUMCUR|NUMBER)) {
+ /* optimization */
+ tval = mpfr_add_d(t1->mpg_numbr, t1->mpg_numbr, x,
RND_MODE);
+ SUBNORMALIZE(t1->mpg_numbr, tval);
+ r = t1;
+ } else {
+ r = *lhs = mpg_node();
+ tval = mpfr_add_d(r->mpg_numbr, t1->mpg_numbr, x,
RND_MODE);
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ unref(t1);
+ }
+ UPREF(r);
+ REPLACE(r);
break;
- case Op_assign_quotient:
- mpfr_div(r->mpfr_numbr, p1, p2, RND_MODE);
+
+ 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 */
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ if (t1->valref == 1 && t1->flags == (MALLOC|NUMCUR|NUMBER)) {
+ /* optimization */
+ tval = mpfr_add_d(t1->mpg_numbr, t1->mpg_numbr, x,
RND_MODE);
+ SUBNORMALIZE(t1->mpg_numbr, tval);
+ } else {
+ t2 = *lhs = mpg_node();
+ tval = mpfr_add_d(t2->mpg_numbr, t1->mpg_numbr, x,
RND_MODE);
+ SUBNORMALIZE(t2->mpg_numbr, tval);
+ unref(t1);
+ }
+ REPLACE(r);
break;
- case Op_assign_mod:
- mpfr_fmod(r->mpfr_numbr, p1, p2, RND_MODE);
+
+ 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 */
+ SUBNORMALIZE(r->mpg_numbr, tval);
+ DEREF(t1);
+ REPLACE(r);
break;
+
+ case Op_assign_plus:
+ case Op_assign_minus:
+ case Op_assign_times:
+ case Op_assign_quotient:
+ case Op_assign_mod:
case Op_assign_exp:
- mpfr_pow(r->mpfr_numbr, p1, p2, RND_MODE);
+ lhs = POP_ADDRESS();
+ t1 = *lhs;
+ p1 = force_number(t1)->mpg_numbr;
+
+ 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);
+ break;
+ case Op_assign_minus:
+ tval = mpfr_sub(r->mpg_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_times:
+ tval = mpfr_mul(r->mpg_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_quotient:
+ tval = mpfr_div(r->mpg_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_mod:
+ tval = mpfr_fmod(r->mpg_numbr, p1, p2, RND_MODE);
+ break;
+ case Op_assign_exp:
+ tval = mpfr_pow(r->mpg_numbr, p1, p2, RND_MODE);
+ break;
+ default:
+ cant_happen();
+ }
+ SUBNORMALIZE(r->mpg_numbr, tval);
+
+ DEREF(t2);
+ unref(*lhs);
+ *lhs = r;
+
+ UPREF(r);
+ REPLACE(r);
break;
+
default:
- break;
+ return TRUE; /* unhandled */
}
- DEREF(t2);
- unref(*lhs);
- *lhs = r;
-
- UPREF(r);
- REPLACE(r);
+ *cp = pc->nexti; /* next instruction to execute */
+ return FALSE;
}
-/* mpfr_fmt --- output formatted string with special MPFR/GMP conversion
specifiers */
+/* mpg_fmt --- output formatted string with special MPFR/GMP conversion
specifiers */
const char *
-mpfr_fmt(const char *mesg, ...)
+mpg_fmt(const char *mesg, ...)
{
static char *tmp = NULL;
int ret;
va_list args;
- if (tmp != NULL)
+ if (tmp != NULL) {
mpfr_free_str(tmp);
+ tmp = NULL;
+ }
va_start(args, mesg);
ret = mpfr_vasprintf(& tmp, mesg, args);
va_end(args);
@@ -844,4 +1039,18 @@ mpfr_fmt(const char *mesg, ...)
return mesg;
}
+#else
+
+void
+set_PREC()
+{
+ /* dummy function */
+}
+
+void
+set_RNDMODE()
+{
+ /* dummy function */
+}
+
#endif
diff --git a/msg.c b/msg.c
index 6f66295..e651c8c 100644
--- a/msg.c
+++ b/msg.c
@@ -65,8 +65,8 @@ err(const char *s, const char *emsg, va_list argp)
#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);
+ mpg_update_var(FNR_node);
+ mpfr_get_z(mpzval, FNR_node->var_value->mpg_numbr, MPFR_RNDZ);
if (mpz_sgn(mpzval) > 0) {
file = FILENAME_node->var_value->stptr;
(void) putc('(', stderr);
diff --git a/node.c b/node.c
index a971098..27ed791 100644
--- a/node.c
+++ b/node.c
@@ -31,8 +31,8 @@ static int is_ieee_magic_val(const char *val);
static AWKNUM get_ieee_magic_val(const char *val);
extern NODE **fmt_list; /* declared in eval.c */
-NODE *(*make_number)(AWKNUM ) = r_make_number;
-NODE *(*m_force_number)(NODE *) = r_force_number;
+NODE *(*make_number)(double) = r_make_number;
+NODE *(*str2number)(NODE *) = r_force_number;
NODE *(*format_val)(const char *, int, NODE *) = r_format_val;
/* force_number --- force a value to be numeric */
@@ -324,7 +324,7 @@ r_dupnode(NODE *n)
/* make_number --- allocate a node with defined number */
NODE *
-r_make_number(AWKNUM x)
+r_make_number(double x)
{
NODE *r;
getnode(r);
@@ -444,7 +444,7 @@ r_unref(NODE *tmp)
#ifdef HAVE_MPFR
if ((tmp->flags & MPFN) != 0)
- mpfr_clear(tmp->mpfr_numbr);
+ mpfr_clear(tmp->mpg_numbr);
#endif
free_wstr(tmp);
diff --git a/profile.c b/profile.c
index bc93d2c..48f90c6 100644
--- a/profile.c
+++ b/profile.c
@@ -1210,7 +1210,7 @@ pp_number(NODE *n)
emalloc(str, char *, PP_PRECISION + 10, "pp_number");
#ifdef HAVE_MPFR
if (n->flags & MPFN)
- mpfr_sprintf(str, "%0.*R*g", PP_PRECISION, RND_MODE,
n->mpfr_numbr);
+ mpfr_sprintf(str, "%0.*R*g", PP_PRECISION, RND_MODE,
n->mpg_numbr);
else
#endif
sprintf(str, "%0.*g", PP_PRECISION, n->numbr);
diff --git a/str_array.c b/str_array.c
index 4bd993e..6895f58 100644
--- a/str_array.c
+++ b/str_array.c
@@ -55,11 +55,6 @@ static NODE **str_list(NODE *symbol, NODE *subs);
static NODE **str_copy(NODE *symbol, NODE *newsymb);
static NODE **str_dump(NODE *symbol, NODE *ndump);
-#ifdef ARRAYDEBUG
-static NODE **str_option(NODE *opt, NODE *val);
-#endif
-
-
array_ptr str_array_func[] = {
str_array_init,
(array_ptr) 0,
@@ -70,9 +65,6 @@ array_ptr str_array_func[] = {
str_list,
str_copy,
str_dump,
-#ifdef ARRAYDEBUG
- str_option
-#endif
};
static inline NODE **str_find(NODE *symbol, NODE *s1, size_t code1, unsigned
long hash1);
@@ -671,27 +663,6 @@ grow_table(NODE *symbol)
}
-#ifdef ARRAYDEBUG
-
-static NODE **
-str_option(NODE *opt, NODE *val)
-{
- int newval;
- NODE *tmp;
- NODE **ret = (NODE **) ! NULL;
-
- tmp = force_string(opt);
- (void) force_number(val);
- if (strcmp(tmp->stptr, "STR_CHAIN_MAX") == 0) {
- newval = (int) val->numbr;
- if (newval > 0)
- STR_CHAIN_MAX = newval;
- } else
- ret = NULL;
- return ret;
-}
-#endif
-
/*
From address@hidden Mon Oct 28 16:05:26 2002
diff --git a/test/dumpvars.ok b/test/dumpvars.ok
index aa49388..68c6a7b 100644
--- a/test/dumpvars.ok
+++ b/test/dumpvars.ok
@@ -18,7 +18,7 @@ OFS: " "
ORS: "\n"
PREC: 53
RLENGTH: 0
-RNDMODE: "RNDN"
+RNDMODE: "N"
RS: "\n"
RSTART: 0
RT: "\n"
-----------------------------------------------------------------------
Summary of changes:
array.c | 141 +++++--------
awk.h | 51 +++---
awkgram.c | 420 ++++++++++++++++++------------------
awkgram.y | 46 +++--
builtin.c | 4 +-
cint_array.c | 20 --
command.c | 166 ++++++++-------
command.y | 18 +-
configh.in | 2 +-
debug.c | 82 +++++---
eval.c | 114 ++++++----
ext.c | 1 -
field.c | 4 +-
int_array.c | 29 ---
interpret.h | 174 ++++-----------
io.c | 20 ++-
m4/mpfr.m4 | 2 +-
main.c | 17 +-
mpfr.c | 633 ++++++++++++++++++++++++++++++++++++------------------
msg.c | 4 +-
node.c | 8 +-
profile.c | 2 +-
str_array.c | 29 ---
test/dumpvars.ok | 2 +-
24 files changed, 1046 insertions(+), 943 deletions(-)
hooks/post-receive
--
gawk
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [gawk-diffs] [SCM] gawk branch, gawk_mpfr, updated. 1c06c5c6f0f6d46f63977dd7407d86ccc2614226,
John Haque <=