aboutsummaryrefslogtreecommitdiffstats
path: root/array.c
diff options
context:
space:
mode:
Diffstat (limited to 'array.c')
-rw-r--r--array.c157
1 files changed, 71 insertions, 86 deletions
diff --git a/array.c b/array.c
index e3bdbf54..c8e230f7 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,29 @@ 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 (is_mpg_float(n))
+ fprintf(output_fp, ":%s",
+ mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ fprintf(output_fp, ":%s", mpg_fmt("%Zd", n->mpg_i));
+ else
+#endif
fprintf(output_fp, ":%.*g", PREC_NUM, n->numbr);
+ }
fprintf(output_fp, ">");
- } else
+ } else {
+#ifdef HAVE_MPFR
+ if (is_mpg_float(n))
+ fprintf(output_fp, "<%s>",
+ mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));
+ else if (is_mpg_integer(n))
+ fprintf(output_fp, "<%s>", mpg_fmt("%Zd", n->mpg_i));
+ else
+#endif
fprintf(output_fp, "<%.*g>", PREC_NUM, n->numbr);
+ }
fprintf(output_fp, ":%s", flags2str(n->flags));
@@ -703,32 +719,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 +737,7 @@ assoc_info(NODE *subs, NODE *val, NODE *ndump, const char *aname)
indent_level++;
indent(indent_level);
fprintf(output_fp, "I: [%s:", aname);
- if ((subs->flags & INTIND) != 0)
+ if ((subs->flags & (MPFN|MPZN|INTIND)) == INTIND)
fprintf(output_fp, "<%ld>", (long) subs->numbr);
else
value_info(subs);
@@ -785,8 +775,8 @@ do_adump(int nargs)
*/
if (nargs == 2) {
- tmp = POP_SCALAR();
- depth = (long) force_number(tmp);
+ tmp = POP_NUMBER();
+ depth = get_number_si(tmp);
DEREF(tmp);
}
symbol = POP_PARAM();
@@ -885,21 +875,19 @@ asort_actual(int nargs, SORT_CTXT ctxt)
result->parent_array = array->parent_array;
}
- subs = make_number((AWKNUM) 0.0);
-
if (ctxt == ASORTI) {
/* We want the indices of the source array. */
for (i = 1, ptr = list; i <= num_elems; i++, ptr += 2) {
- subs->numbr = (AWKNUM) i;
- r = *ptr;
- *assoc_lookup(result, subs) = r;
+ subs = make_number(i);
+ *assoc_lookup(result, subs) = *ptr;
+ unref(subs);
}
} else {
/* We want the values of the source array. */
for (i = 1, ptr = list; i <= num_elems; i++) {
- subs->numbr = (AWKNUM) i;
+ subs = make_number(i);
/* free index node */
r = *ptr++;
@@ -908,8 +896,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 {
@@ -922,10 +908,10 @@ asort_actual(int nargs, SORT_CTXT ctxt)
arr->parent_array = array; /* actual parent, not the temporary one. */
*assoc_lookup(result, subs) = assoc_copy(r, arr);
}
+ unref(subs);
}
}
- unref(subs);
efree(list);
if (result != dest) {
@@ -958,13 +944,13 @@ do_asorti(int nargs)
/*
- * cmp_string --- compare two strings; logic similar to cmp_nodes() in eval.c
+ * cmp_strings --- compare two strings; logic similar to cmp_nodes() in eval.c
* except the extra case-sensitive comparison when the case-insensitive
* result is a match.
*/
static int
-cmp_string(const NODE *n1, const NODE *n2)
+cmp_strings(const NODE *n1, const NODE *n2)
{
char *s1, *s2;
size_t len1, len2;
@@ -1010,7 +996,6 @@ cmp_string(const NODE *n1, const NODE *n2)
return (len1 < len2) ? -1 : 1;
}
-
/* sort_up_index_string --- qsort comparison function; ascending index strings. */
static int
@@ -1021,7 +1006,7 @@ sort_up_index_string(const void *p1, const void *p2)
/* Array indices are strings */
t1 = *((const NODE *const *) p1);
t2 = *((const NODE *const *) p2);
- return cmp_string(t1, t2);
+ return cmp_strings(t1, t2);
}
@@ -1054,15 +1039,14 @@ sort_up_index_number(const void *p1, const void *p2)
t1 = *((const NODE *const *) p1);
t2 = *((const NODE *const *) p2);
- if (t1->numbr < t2->numbr)
- ret = -1;
- else
- ret = (t1->numbr > t2->numbr);
+ ret = cmp_numbers(t1, t2);
+ if (ret != 0)
+ return ret;
/* break a tie with the index string itself */
- if (ret == 0)
- return cmp_string(t1, t2);
- return ret;
+ t1 = force_string((NODE *) t1);
+ t2 = force_string((NODE *) t2);
+ return cmp_strings(t1, t2);
}
/* sort_down_index_number --- qsort comparison function; descending index numbers */
@@ -1092,7 +1076,7 @@ sort_up_value_string(const void *p1, const void *p2)
return -1; /* t1 (scalar) < t2 (sub-array) */
/* t1 and t2 both have string values */
- return cmp_string(t1, t2);
+ return cmp_strings(t1, t2);
}
@@ -1123,23 +1107,17 @@ sort_up_value_number(const void *p1, const void *p2)
if (t2->type == Node_var_array)
return -1; /* t1 (scalar) < t2 (sub-array) */
- /* t1 and t2 both Node_val, and force_number'ed */
- if (t1->numbr < t2->numbr)
- ret = -1;
- else
- ret = (t1->numbr > t2->numbr);
-
- if (ret == 0) {
- /*
- * Use string value to guarantee same sort order on all
- * versions of qsort().
- */
- t1 = force_string(t1);
- t2 = force_string(t2);
- ret = cmp_string(t1, t2);
- }
+ ret = cmp_numbers(t1, t2);
+ if (ret != 0)
+ return ret;
- return ret;
+ /*
+ * Use string value to guarantee same sort order on all
+ * versions of qsort().
+ */
+ t1 = force_string(t1);
+ t2 = force_string(t2);
+ return cmp_strings(t1, t2);
}
@@ -1186,12 +1164,7 @@ sort_up_value_type(const void *p1, const void *p2)
(void) force_string(n2);
if ((n1->flags & NUMBER) != 0 && (n2->flags & NUMBER) != 0) {
- if (n1->numbr < n2->numbr)
- return -1;
- else if (n1->numbr > n2->numbr)
- return 1;
- else
- return 0;
+ return cmp_numbers(n1, n2);
}
/* 3. All numbers are less than all strings. This is aribitrary. */
@@ -1202,7 +1175,7 @@ sort_up_value_type(const void *p1, const void *p2)
}
/* 4. Two strings */
- return cmp_string(n1, n2);
+ return cmp_strings(n1, n2);
}
/* sort_down_value_type --- qsort comparison function; descending value type */
@@ -1218,8 +1191,8 @@ sort_down_value_type(const void *p1, const void *p2)
static int
sort_user_func(const void *p1, const void *p2)
{
- NODE *idx1, *idx2, *val1, *val2;
- AWKNUM ret;
+ NODE *idx1, *idx2, *val1, *val2, *r;
+ int ret;
INSTRUCTION *code;
idx1 = *((NODE *const *) p1);
@@ -1246,9 +1219,21 @@ sort_user_func(const void *p1, const void *p2)
(void) (*interpret)(code);
/* return value of the comparison function */
- POP_NUMBER(ret);
-
- return (ret < 0.0) ? -1 : (ret > 0.0);
+ r = POP_NUMBER();
+#ifdef HAVE_MPFR
+ /*
+ * mpfr_sgn(mpz_sgn): Returns a positive value if op > 0,
+ * zero if op = 0, and a negative value if op < 0.
+ */
+ if (is_mpg_float(r))
+ ret = mpfr_sgn(r->mpg_numbr);
+ else if (is_mpg_integer(r))
+ ret = mpz_sgn(r->mpg_i);
+ else
+#endif
+ ret = (r->numbr < 0.0) ? -1 : (r->numbr > 0.0);
+ DEREF(r);
+ return ret;
}
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-05 14:53:56 +0000