/* * array.c - routines for awk arrays. */ /* * Copyright (C) 1986, 1988, 1989, 1991-2014, 2016, 2018-2021, * the Free Software Foundation, Inc. * * This file is part of GAWK, the GNU implementation of the * AWK Programming Language. * * GAWK is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 3 of the License, or * (at your option) any later version. * * GAWK is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA */ #include "awk.h" extern FILE *output_fp; extern NODE **fmt_list; /* declared in eval.c */ NODE *success_node; static size_t SUBSEPlen; static char *SUBSEP; static char indent_char[] = " "; static int sort_up_value_type(const void *p1, const void *p2); static NODE **null_lookup(NODE *symbol, NODE *subs); static NODE **null_dump(NODE *symbol, NODE *subs); static const array_funcs_t null_array_func = { "null", (afunc_t) 0, (afunc_t) 0, null_lookup, null_afunc, null_afunc, null_afunc, null_afunc, null_afunc, null_dump, (afunc_t) 0, }; #define MAX_ATYPE 10 static const array_funcs_t *array_types[MAX_ATYPE]; static int num_array_types = 0; /* register_array_func --- add routines to handle arrays */ static int register_array_func(const array_funcs_t *afunc) { if (afunc && num_array_types < MAX_ATYPE) { if (afunc != & str_array_func && afunc->type_of == NULL) return false; array_types[num_array_types++] = afunc; if (afunc->init) /* execute init routine if any */ (void) (*afunc->init)(NULL, NULL); return true; } return false; } /* array_init --- register all builtin array types */ void array_init() { (void) register_array_func(& str_array_func); /* the default */ if (! do_mpfr) { (void) register_array_func(& int_array_func); (void) register_array_func(& cint_array_func); } } /* make_array --- create an array node */ NODE * make_array() { NODE *array; getnode(array); memset(array, '\0', sizeof(NODE)); array->type = Node_var_array; array->array_funcs = & null_array_func; /* vname, flags, and parent_array not set here */ return array; } /* null_array --- force symbol to be an empty typeless array */ void null_array(NODE *symbol) { symbol->type = Node_var_array; symbol->array_funcs = & null_array_func; symbol->buckets = NULL; symbol->table_size = 0; symbol->array_size = 0; symbol->array_capacity = 0; symbol->flags = 0; assert(symbol->xarray == NULL); /* vname, parent_array not (re)initialized */ } /* null_lookup --- assign type to an empty array. */ static NODE ** null_lookup(NODE *symbol, NODE *subs) { int i; const array_funcs_t *afunc = NULL; assert(symbol->table_size == 0); /* * Check which array type wants to accept this sub; traverse * array type list in reverse order. */ for (i = num_array_types - 1; i >= 1; i--) { afunc = array_types[i]; if (afunc->type_of(symbol, subs) != NULL) break; } if (i == 0 || afunc == NULL) afunc = array_types[0]; /* default is str_array_func */ symbol->array_funcs = afunc; /* We have the right type of array; install the subscript */ return symbol->alookup(symbol, subs); } /* null_afunc --- default function for array interface */ NODE ** null_afunc(NODE *symbol ATTRIBUTE_UNUSED, NODE *subs ATTRIBUTE_UNUSED) { return NULL; } /* null_dump --- dump function for an empty array */ static NODE ** null_dump(NODE *symbol, NODE *subs ATTRIBUTE_UNUSED) { fprintf(output_fp, "array `%s' is empty\n", array_vname(symbol)); return NULL; } /* assoc_copy --- duplicate input array "symbol" */ NODE * assoc_copy(NODE *symbol, NODE *newsymb) { assert(newsymb->vname != NULL); assoc_clear(newsymb); (void) symbol->acopy(symbol, newsymb); newsymb->array_funcs = symbol->array_funcs; newsymb->flags = symbol->flags; return newsymb; } /* assoc_dump --- dump array */ void assoc_dump(NODE *symbol, NODE *ndump) { if (symbol->adump) (void) symbol->adump(symbol, ndump); } /* make_aname --- construct a 'vname' for a (sub)array */ const char * make_aname(const NODE *symbol) { static char *aname = NULL; static size_t alen; static size_t max_alen; #define SLEN 256 if (symbol->parent_array != NULL) { size_t slen; (void) make_aname(symbol->parent_array); slen = strlen(symbol->vname); /* subscript in parent array */ if (alen + slen + 4 > max_alen) { /* sizeof("[\"\"]") = 4 */ max_alen = alen + slen + 4 + SLEN; erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname"); } alen += sprintf(aname + alen, "[\"%s\"]", symbol->vname); } else { alen = strlen(symbol->vname); if (aname == NULL) { max_alen = alen + SLEN; emalloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname"); } else if (alen > max_alen) { max_alen = alen + SLEN; erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname"); } memcpy(aname, symbol->vname, alen + 1); } return aname; } #undef SLEN /* * array_vname --- print the name of the array * * Returns a pointer to a statically maintained dynamically allocated string. * It's appropriate for printing the name once; if the caller wants * to save it, they have to make a copy. */ const char * array_vname(const NODE *symbol) { static char *message = NULL; static size_t msglen = 0; char *s; size_t len; int n; const NODE *save_symbol = symbol; const char *from = _("from %s"); const char *aname; if (symbol->type != Node_array_ref || symbol->orig_array->type != Node_var_array ) { if (symbol->type != Node_var_array || symbol->parent_array == NULL) return symbol->vname; return make_aname(symbol); } /* First, we have to compute the length of the string: */ len = 2; /* " (" */ n = 0; while (symbol->type == Node_array_ref) { len += strlen(symbol->vname); n++; symbol = symbol->prev_array; } /* Get the (sub)array name */ if (symbol->parent_array == NULL) aname = symbol->vname; else aname = make_aname(symbol); len += strlen(aname); /* * Each node contributes by strlen(from) minus the length * of "%s" in the translation (which is at least 2) * plus 2 for ", " or ")\0"; this adds up to strlen(from). */ len += n * strlen(from); /* (Re)allocate memory: */ if (message == NULL) { emalloc(message, char *, len, "array_vname"); msglen = len; } else if (len > msglen) { erealloc(message, char *, len, "array_vname"); msglen = len; } /* else current buffer can hold new name */ /* We're ready to print: */ symbol = save_symbol; s = message; /* * Ancient systems have sprintf() returning char *, not int. * If you have one of those, use sprintf(..); s += strlen(s) instead. */ s += sprintf(s, "%s (", symbol->vname); for (;;) { symbol = symbol->prev_array; if (symbol->type != Node_array_ref) break; s += sprintf(s, from, symbol->vname); s += sprintf(s, ", "); } s += sprintf(s, from, aname); strcpy(s, ")"); return message; } /* * force_array --- proceed to the actual Node_var_array, * change Node_var_new to an array. * If canfatal and type isn't good, die fatally, * otherwise return the final actual value. */ NODE * force_array(NODE *symbol, bool canfatal) { NODE *save_symbol = symbol; bool isparam = false; if (symbol->type == Node_param_list) { save_symbol = symbol = GET_PARAM(symbol->param_cnt); isparam = true; if (symbol->type == Node_array_ref) symbol = symbol->orig_array; } switch (symbol->type) { case Node_var_new: symbol->xarray = NULL; /* make sure union is as it should be */ null_array(symbol); symbol->parent_array = NULL; /* main array has no parent */ /* fall through */ case Node_var_array: break; case Node_array_ref: default: /* notably Node_var but catches also e.g. a[1] = "x"; a[1][1] = "y" */ if (canfatal) { if (symbol->type == Node_val) fatal(_("attempt to use a scalar value as array")); if (isparam) fatal(_("attempt to use scalar parameter `%s' as an array"), save_symbol->vname); else fatal(_("attempt to use scalar `%s' as an array"), save_symbol->vname); } else break; } return symbol; } /* set_SUBSEP --- update SUBSEP related variables when SUBSEP assigned to */ void set_SUBSEP() { SUBSEP_node->var_value = force_string(SUBSEP_node->var_value); SUBSEP = SUBSEP_node->var_value->stptr; SUBSEPlen = SUBSEP_node->var_value->stlen; } /* concat_exp --- concatenate expression list into a single string */ NODE * concat_exp(int nargs, bool do_subsep) { /* do_subsep is false for Op_concat */ NODE *r; char *str; char *s; size_t len; size_t subseplen = 0; int i; extern NODE **args_array; if (nargs == 1) return POP_STRING(); if (do_subsep) subseplen = SUBSEPlen; len = 0; for (i = 1; i <= nargs; i++) { r = TOP(); if (r->type == Node_var_array) { while (--i > 0) DEREF(args_array[i]); /* avoid memory leak */ fatal(_("attempt to use array `%s' in a scalar context"), array_vname(r)); } r = POP_STRING(); args_array[i] = r; len += r->stlen; } len += (nargs - 1) * subseplen; emalloc(str, char *, len + 1, "concat_exp"); r = args_array[nargs]; memcpy(str, r->stptr, r->stlen); s = str + r->stlen; DEREF(r); for (i = nargs - 1; i > 0; i--) { if (subseplen == 1) *s++ = *SUBSEP; else if (subseplen > 0) { memcpy(s, SUBSEP, subseplen); s += subseplen; } r = args_array[i]; memcpy(s, r->stptr, r->stlen); s += r->stlen; DEREF(r); } return make_str_node(str, len, ALREADY_MALLOCED); } /* * adjust_fcall_stack: remove subarray(s) of symbol[] from * function call stack. */ static void adjust_fcall_stack(NODE *symbol, int nsubs) { NODE *func, *r, *n; NODE **sp; int pcount; /* * Solve the nasty problem of disappearing subarray arguments: * * function f(c, d) { delete c; .. use non-existent array d .. } * BEGIN { a[0][0] = 1; f(a, a[0]); .. } * * The fix is to convert 'd' to a local empty array; This has * to be done before clearing the parent array to avoid referring to * already free-ed memory. * * Similar situations exist for builtins accepting more than * one array argument: split, patsplit, asort and asorti. For example: * * BEGIN { a[0][0] = 1; split("abc", a, "", a[0]) } * * These cases do not involve the function call stack, and are * handled individually in their respective routines. */ func = frame_ptr->func_node; if (func == NULL) /* in main */ return; pcount = func->param_cnt; sp = frame_ptr->stack; for (; pcount > 0; pcount--) { r = *sp++; if (r->type != Node_array_ref || r->orig_array->type != Node_var_array) continue; n = r->orig_array; /* Case 1 */ if (n == symbol && symbol->parent_array != NULL && nsubs > 0 ) { /* * 'symbol' is a subarray, and 'r' is the same subarray: * * function f(c, d) { delete c[0]; .. } * BEGIN { a[0][0] = 1; f(a, a[0]); .. } * * But excludes cases like (nsubs = 0): * * function f(c, d) { delete c; ..} * BEGIN { a[0][0] = 1; f(a[0], a[0]); ...} */ null_array(r); r->parent_array = NULL; continue; } /* Case 2 */ for (n = n->parent_array; n != NULL; n = n->parent_array) { assert(n->type == Node_var_array); if (n == symbol) { /* * 'r' is a subarray of 'symbol': * * function f(c, d) { delete c; .. use d as array .. } * BEGIN { a[0][0] = 1; f(a, a[0]); .. } * OR * BEGIN { a[0][0][0][0] = 1; f(a[0], a[0][0][0]); .. } * */ null_array(r); r->parent_array = NULL; break; } } } } /* do_delete --- perform `delete array[s]' */ /* * `symbol' is array * `nsubs' is no of subscripts */ void do_delete(NODE *symbol, int nsubs) { NODE *val, *subs; int i; assert(symbol->type == Node_var_array); subs = val = NULL; /* silence the compiler */ /* * The force_string() call is needed to make sure that * the string subscript is reasonable. For example, with it: * * $ ./gawk --posix 'BEGIN { CONVFMT="%ld"; delete a[1.233]}' * gawk: cmd. line:1: fatal: `%l' is not permitted in POSIX awk formats * * Without it, the code does not fail. */ #define free_subs(n) do { \ NODE *s = PEEK(n - 1); \ if (s->type == Node_val) { \ (void) force_string(s); /* may have side effects. */ \ DEREF(s); \ } \ } while (--n > 0) if (nsubs == 0) { /* delete array */ adjust_fcall_stack(symbol, 0); /* fix function call stack; See above. */ assoc_clear(symbol); return; } /* NB: subscripts are in reverse order on stack */ for (i = nsubs; i > 0; i--) { subs = PEEK(i - 1); if (subs->type != Node_val) { free_subs(i); fatal(_("attempt to use array `%s' in a scalar context"), array_vname(subs)); } val = in_array(symbol, subs); if (val == NULL) { if (do_lint) { subs = force_string(subs); lintwarn(_("delete: index `%.*s' not in array `%s'"), (int) subs->stlen, subs->stptr, array_vname(symbol)); } /* avoid memory leak, free all subs */ free_subs(i); return; } if (i > 1) { if (val->type != Node_var_array) { /* e.g.: a[1] = 1; delete a[1][1] */ free_subs(i); subs = force_string(subs); fatal(_("attempt to use scalar `%s[\"%.*s\"]' as an array"), array_vname(symbol), (int) subs->stlen, subs->stptr); } symbol = val; DEREF(subs); } } if (val->type == Node_var_array) { adjust_fcall_stack(val, nsubs); /* fix function call stack; See above. */ assoc_clear(val); /* cleared a sub-array, free Node_var_array */ efree(val->vname); freenode(val); } else unref(val); (void) assoc_remove(symbol, subs); DEREF(subs); if (assoc_empty(symbol)) /* last element was removed, so reset array type to null */ null_array(symbol); #undef free_subs } /* do_delete_loop --- simulate ``for (iggy in foo) delete foo[iggy]'' */ /* * The primary hassle here is that `iggy' needs to have some arbitrary * array index put in it before we can clear the array, we can't * just replace the loop with `delete foo'. */ void do_delete_loop(NODE *symbol, NODE **lhs) { NODE **list; NODE akind; akind.flags = AINDEX|ADELETE; /* need a single index */ list = symbol->alist(symbol, & akind); if (assoc_empty(symbol)) return; unref(*lhs); *lhs = list[0]; efree(list); /* blast the array in one shot */ adjust_fcall_stack(symbol, 0); assoc_clear(symbol); } /* value_info --- print scalar node info */ static void value_info(NODE *n) { #define PREC_NUM -1 if (n == Nnull_string || n == Null_field) { fprintf(output_fp, "<(null)>"); return; } if ((n->flags & (STRING|STRCUR)) != 0) { fprintf(output_fp, "<"); fprintf(output_fp, "\"%.*s\"", (int) n->stlen, n->stptr); 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 { #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)); if ((n->flags & MALLOC) != 0) fprintf(output_fp, ":%ld", n->valref); else fprintf(output_fp, ":"); if ((n->flags & (STRING|STRCUR)) == STRCUR) { size_t len; fprintf(output_fp, "]["); fprintf(output_fp, "stfmt=%d, ", n->stfmt); /* * If not STFMT_UNUSED, could be CONVFMT or OFMT if last * used in a print statement. If immutable, could be that it * was originally set as a string, or it's a number that has * an integer value. */ len = fmt_list[n->stfmt]->stlen; fmt_list[n->stfmt]->stptr[len] = '\0'; fprintf(output_fp, "FMT=\"%s\"", n->stfmt == STFMT_UNUSED ? "" : fmt_list[n->stfmt]->stptr); #ifdef HAVE_MPFR fprintf(output_fp, ", ROUNDMODE=\"%c\"", n->strndmode); #endif } #undef PREC_NUM } void indent(int indent_level) { int i; for (i = 0; i < indent_level; i++) fprintf(output_fp, "%s", indent_char); } /* assoc_info --- print index, value info */ void assoc_info(NODE *subs, NODE *val, NODE *ndump, const char *aname) { int indent_level = ndump->alevel; indent_level++; indent(indent_level); fprintf(output_fp, "I: [%s:", aname); if ((subs->flags & (MPFN|MPZN|INTIND)) == INTIND) fprintf(output_fp, "<%ld>", (long) subs->numbr); else value_info(subs); fprintf(output_fp, "]\n"); indent(indent_level); if (val->type == Node_val) { fprintf(output_fp, "V: [scalar: "); value_info(val); } else { fprintf(output_fp, "V: ["); ndump->alevel++; ndump->adepth--; assoc_dump(val, ndump); ndump->adepth++; ndump->alevel--; indent(indent_level); } fprintf(output_fp, "]\n"); } /* do_adump --- dump an array: interface to assoc_dump */ NODE * do_adump(int nargs) { NODE *symbol, *tmp; static NODE ndump; long depth = 0; /* * depth < 0, no index and value info. * = 0, main array index and value info; does not descend into sub-arrays. * > 0, descends into 'depth' sub-arrays, and prints index and value info. */ if (nargs == 2) { tmp = POP_NUMBER(); depth = get_number_si(tmp); DEREF(tmp); } symbol = POP_PARAM(); if (symbol->type != Node_var_array) fatal(_("%s: first argument is not an array"), "adump"); ndump.type = Node_dump_array; ndump.adepth = depth; ndump.alevel = 0; assoc_dump(symbol, & ndump); return make_number((AWKNUM) 0); } /* asort_actual --- do the actual work to sort the input array */ static NODE * asort_actual(int nargs, sort_context_t ctxt) { NODE *array, *dest = NULL, *result; NODE *r, *subs, *s; NODE **list = NULL, **ptr; unsigned long num_elems, i; const char *sort_str; char save; const char *name = (ctxt == ASORT ? "asort" : "asorti"); // D.R.Y. if (nargs == 3) /* 3rd optional arg */ s = POP_STRING(); else s = dupnode(Nnull_string); /* "" => default sorting */ s = force_string(s); sort_str = s->stptr; save = s->stptr[s->stlen]; s->stptr[s->stlen] = '\0'; if (s->stlen == 0) { /* default sorting */ if (ctxt == ASORT) sort_str = "@val_type_asc"; else sort_str = "@ind_str_asc"; } if (nargs >= 2) { /* 2nd optional arg */ dest = POP_PARAM(); if (dest->type != Node_var_array) { fatal(_("%s: second argument is not an array"), name); } check_symtab_functab(dest, name, _("%s: cannot use %s as second argument")); } array = POP_PARAM(); if (array->type != Node_var_array) { fatal(_("%s: first argument is not an array"), name); } else if (array == symbol_table && dest == NULL) fatal(_("%s: first argument cannot be SYMTAB without a second argument"), name); else if (array == func_table && dest == NULL) fatal(_("%s: first argument cannot be FUNCTAB without a second argument"), name); if (dest != NULL) { static bool warned = false; if (nargs == 2 && array == dest && ! warned) { warned = true; lintwarn(_("asort/asorti: using the same array as source and destination without " "a third argument is silly.")); } for (r = dest->parent_array; r != NULL; r = r->parent_array) { if (r == array) fatal(_("%s: cannot use a subarray of first argument for second argument"), name); } for (r = array->parent_array; r != NULL; r = r->parent_array) { if (r == dest) fatal(_("%s: cannot use a subarray of second argument for first argument"), name); } } /* sorting happens inside assoc_list */ list = assoc_list(array, sort_str, ctxt); s->stptr[s->stlen] = save; DEREF(s); num_elems = assoc_length(array); if (num_elems == 0 || list == NULL) { /* source array is empty */ if (dest != NULL && dest != array) assoc_clear(dest); if (list != NULL) efree(list); return make_number((AWKNUM) 0); } /* * Must not assoc_clear() the source array before constructing * the output array. assoc_list() does not duplicate array values * which are needed for asort(). */ if (dest != NULL && dest != array) { assoc_clear(dest); result = dest; } else { /* use 'result' as a temporary destination array */ result = make_array(); result->vname = array->vname; result->parent_array = array->parent_array; } if (ctxt == ASORTI) { /* We want the indices of the source array. */ for (i = 1, ptr = list; i <= num_elems; i++, ptr += 2) { subs = make_number(i); assoc_set(result, subs, *ptr); } } else { /* We want the values of the source array. */ for (i = 1, ptr = list; i <= num_elems; i++) { subs = make_number(i); /* free index node */ r = *ptr++; unref(r); /* value node */ r = *ptr++; NODE *value; if (r->type == Node_val) value = dupnode(r); else if (r->type == Node_var) /* SYMTAB ... */ value = dupnode(r->var_value); else if (r->type == Node_builtin_func || r->type == Node_func || r->type == Node_ext_func) { /* FUNCTAB ... */ value = make_string(r->vname, strlen(r->vname)); } else { NODE *arr; arr = make_array(); subs = force_string(subs); arr->vname = subs->stptr; arr->vname[subs->stlen] = '\0'; subs->stptr = NULL; subs->flags &= ~STRCUR; arr->parent_array = array; /* actual parent, not the temporary one. */ value = assoc_copy(r, arr); } assoc_set(result, subs, value); } } efree(list); if (result != dest) { /* dest == NULL or dest == array */ assoc_clear(array); *array = *result; /* copy result into array */ freenode(result); } /* else result == dest dest != NULL and dest != array */ return make_number((AWKNUM) num_elems); } /* do_asort --- sort array by value */ NODE * do_asort(int nargs) { return asort_actual(nargs, ASORT); } /* do_asorti --- sort array by index */ NODE * do_asorti(int nargs) { return asort_actual(nargs, ASORTI); } /* * 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_strings(const NODE *n1, const NODE *n2) { char *s1, *s2; size_t len1, len2; int ret; s1 = n1->stptr; len1 = n1->stlen; s2 = n2->stptr; len2 = n2->stlen; if (len1 == 0) return len2 == 0 ? 0 : -1; if (len2 == 0) return 1; /* len1 > 0 && len2 > 0 */ // make const to ensure it doesn't change if we // need to call memcmp(), below const size_t lmin = len1 < len2 ? len1 : len2; if (IGNORECASE) { const unsigned char *cp1 = (const unsigned char *) s1; const unsigned char *cp2 = (const unsigned char *) s2; if (gawk_mb_cur_max > 1) { ret = strncasecmpmbs((const unsigned char *) cp1, (const unsigned char *) cp2, lmin); } else { size_t count = lmin; for (ret = 0; count-- > 0 && ret == 0; cp1++, cp2++) ret = casetable[*cp1] - casetable[*cp2]; } if (ret != 0) return ret; /* * If case insensitive result is "they're the same", * use case sensitive comparison to force distinct order. */ } ret = memcmp(s1, s2, lmin); if (ret != 0 || len1 == len2) return ret; return (len1 < len2) ? -1 : 1; } /* sort_up_index_string --- qsort comparison function; ascending index strings. */ static int sort_up_index_string(const void *p1, const void *p2) { const NODE *t1, *t2; /* Array indices are strings */ t1 = *((const NODE *const *) p1); t2 = *((const NODE *const *) p2); return cmp_strings(t1, t2); } /* sort_down_index_str --- qsort comparison function; descending index strings. */ static int sort_down_index_string(const void *p1, const void *p2) { /* * Negation versus transposed arguments: when all keys are * distinct, as with array indices here, either method will * transform an ascending sort into a descending one. But if * there are equal keys--such as when IGNORECASE is honored-- * that get disambiguated into a determisitc order, negation * will reverse those but transposed arguments would retain * their relative order within the rest of the reversed sort. */ return -sort_up_index_string(p1, p2); } /* sort_up_index_number --- qsort comparison function; ascending index numbers. */ static int sort_up_index_number(const void *p1, const void *p2) { const NODE *t1, *t2; int ret; t1 = *((const NODE *const *) p1); t2 = *((const NODE *const *) p2); ret = cmp_numbers(t1, t2); if (ret != 0) return ret; /* break a tie with the index string itself */ t1 = force_string((NODE *) t1); t2 = force_string((NODE *) t2); return cmp_strings(t1, t2); } /* sort_down_index_number --- qsort comparison function; descending index numbers */ static int sort_down_index_number(const void *p1, const void *p2) { return -sort_up_index_number(p1, p2); } /* sort_up_value_string --- qsort comparison function; ascending value string */ static int sort_up_value_string(const void *p1, const void *p2) { const NODE *t1, *t2; int ret; t1 = *((const NODE *const *) p1 + 1); t2 = *((const NODE *const *) p2 + 1); if (t1->type != Node_val || t2->type != Node_val) return sort_up_value_type(p1, p2); /* t1 and t2 both have string values */ ret = cmp_strings(t1, t2); if (ret != 0) return ret; return sort_up_index_string(p1, p2); } /* sort_down_value_string --- qsort comparison function; descending value string */ static int sort_down_value_string(const void *p1, const void *p2) { return -sort_up_value_string(p1, p2); } /* sort_up_value_number --- qsort comparison function; ascending value number */ static int sort_up_value_number(const void *p1, const void *p2) { NODE *t1, *t2; int ret; t1 = *((NODE *const *) p1 + 1); t2 = *((NODE *const *) p2 + 1); if (t1->type != Node_val || t2->type != Node_val) return sort_up_value_type(p1, p2); ret = cmp_numbers(t1, t2); if (ret != 0) return ret; /* * Use string value to guarantee same sort order on all * versions of qsort(). */ ret = cmp_strings(force_string(t1), force_string(t2)); if (ret != 0) return ret; return sort_up_index_string(p1, p2); } /* sort_down_value_number --- qsort comparison function; descending value number */ static int sort_down_value_number(const void *p1, const void *p2) { return -sort_up_value_number(p1, p2); } /* do_sort_up_value_type --- backend comparison on ascending value type */ static int do_sort_up_value_type(const void *p1, const void *p2) { NODE *n1, *n2; static const NODETYPE element_types[] = { Node_builtin_func, Node_func, Node_ext_func, Node_var_new, Node_var, Node_var_array, Node_val, Node_illegal }; /* we want to compare the element values */ n1 = *((NODE *const *) p1 + 1); n2 = *((NODE *const *) p2 + 1); if (n1->type == Node_var && n2->type == Node_var) { /* compare the values of the variables */ n1 = n1->var_value; n2 = n2->var_value; } /* 1. Arrays vs. everything else, everything else is less than array */ if (n1->type == Node_var_array) { /* return 0 if n2 is a sub-array too, else return 1 */ return (n2->type != Node_var_array); } if (n2->type == Node_var_array) { return -1; /* n1 (non-array) < n2 (sub-array) */ } /* 2. Non scalars */ if (n1->type != Node_val || n2->type != Node_val) { int n1_pos, n2_pos, i; n1_pos = n2_pos = -1; for (i = 0; element_types[i] != Node_illegal; i++) { if (n1->type == element_types[i]) n1_pos = i; if (n2->type == element_types[i]) n2_pos = i; } assert(n1_pos != -1 && n2_pos != -1); return (n1_pos - n2_pos); } /* two scalars */ (void) fixtype(n1); (void) fixtype(n2); if ((n1->flags & NUMBER) != 0 && (n2->flags & NUMBER) != 0) { return cmp_numbers(n1, n2); } /* 3. All numbers are less than all strings. This is aribitrary. */ if ((n1->flags & NUMBER) != 0 && (n2->flags & STRING) != 0) { return -1; } else if ((n1->flags & STRING) != 0 && (n2->flags & NUMBER) != 0) { return 1; } /* 4. Two strings */ return cmp_strings(n1, n2); } /* sort_up_value_type --- qsort comparison function; ascending value type */ static int sort_up_value_type(const void *p1, const void *p2) { int rc = do_sort_up_value_type(p1, p2); /* use a tie-breaker if do_sort_up_value_type has no opinion */ return rc ? rc : sort_up_index_string(p1, p2); } /* sort_down_value_type --- qsort comparison function; descending value type */ static int sort_down_value_type(const void *p1, const void *p2) { return -sort_up_value_type(p1, p2); } /* sort_user_func --- user defined qsort comparison function */ static int sort_user_func(const void *p1, const void *p2) { NODE *idx1, *idx2, *val1, *val2, *r; int ret; INSTRUCTION *code; idx1 = *((NODE *const *) p1); idx2 = *((NODE *const *) p2); val1 = *((NODE *const *) p1 + 1); val2 = *((NODE *const *) p2 + 1); code = TOP()->code_ptr; /* comparison function call instructions */ /* setup 4 arguments to comp_func() */ UPREF(idx1); PUSH(idx1); if (val1->type == Node_val) UPREF(val1); PUSH(val1); UPREF(idx2); PUSH(idx2); if (val2->type == Node_val) UPREF(val2); PUSH(val2); /* execute the comparison function */ (void) (*interpret)(code); /* return value of the comparison function */ 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; } /* assoc_list -- construct, and optionally sort, a list of array elements */ NODE ** assoc_list(NODE *symbol, const char *sort_str, sort_context_t sort_ctxt) { typedef int (*qsort_compfunc)(const void *, const void *); static const struct qsort_funcs { const char *name; qsort_compfunc comp_func; assoc_kind_t kind; } sort_funcs[] = { { "@ind_str_asc", sort_up_index_string, AINDEX|AISTR|AASC }, { "@ind_num_asc", sort_up_index_number, AINDEX|AINUM|AASC }, { "@val_str_asc", sort_up_value_string, AVALUE|AVSTR|AASC }, { "@val_num_asc", sort_up_value_number, AVALUE|AVNUM|AASC }, { "@ind_str_desc", sort_down_index_string, AINDEX|AISTR|ADESC }, { "@ind_num_desc", sort_down_index_number, AINDEX|AINUM|ADESC }, { "@val_str_desc", sort_down_value_string, AVALUE|AVSTR|ADESC }, { "@val_num_desc", sort_down_value_number, AVALUE|AVNUM|ADESC }, { "@val_type_asc", sort_up_value_type, AVALUE|AASC }, { "@val_type_desc", sort_down_value_type, AVALUE|ADESC }, { "@unsorted", 0, AINDEX }, }; /* * N.B.: AASC and ADESC are hints to the specific array types. * See cint_list() in cint_array.c. */ NODE **list; NODE akind; unsigned long num_elems, j; int elem_size, qi; qsort_compfunc cmp_func = 0; INSTRUCTION *code = NULL; extern int currule; int save_rule = 0; assoc_kind_t assoc_kind = ANONE; elem_size = 1; for (qi = 0, j = sizeof(sort_funcs)/sizeof(sort_funcs[0]); qi < j; qi++) { if (strcmp(sort_funcs[qi].name, sort_str) == 0) break; } if (qi < j) { cmp_func = sort_funcs[qi].comp_func; assoc_kind = sort_funcs[qi].kind; if (symbol->array_funcs != & cint_array_func) assoc_kind &= ~(AASC|ADESC); if (sort_ctxt != SORTED_IN || (assoc_kind & AVALUE) != 0) { /* need index and value pair in the list */ assoc_kind |= (AINDEX|AVALUE); elem_size = 2; } } else { /* unrecognized */ NODE *f; const char *sp; for (sp = sort_str; *sp != '\0' && ! isspace((unsigned char) *sp); sp++) continue; /* empty string or string with space(s) not valid as function name */ if (sp == sort_str || *sp != '\0') fatal(_("`%s' is invalid as a function name"), sort_str); f = lookup(sort_str); if (f == NULL || f->type != Node_func) fatal(_("sort comparison function `%s' is not defined"), sort_str); cmp_func = sort_user_func; /* need index and value pair in the list */ assoc_kind |= (AVALUE|AINDEX); elem_size = 2; /* make function call instructions */ code = bcalloc(Op_func_call, 2, 0); code->func_body = f; code->func_name = NULL; /* not needed, func_body already assigned */ (code + 1)->expr_count = 4; /* function takes 4 arguments */ code->nexti = bcalloc(Op_stop, 1, 0); /* * make non-redirected getline, exit, `next' and `nextfile' fatal in * callback function by setting currule in interpret() * to undefined (0). */ save_rule = currule; /* save current rule */ currule = 0; PUSH_CODE(code); } akind.flags = (unsigned int) assoc_kind; /* kludge */ list = symbol->alist(symbol, & akind); assoc_kind = (assoc_kind_t) akind.flags; /* symbol->alist can modify it */ /* check for empty list or unsorted, or list already sorted */ if (list != NULL && cmp_func != NULL && (assoc_kind & (AASC|ADESC)) == 0) { num_elems = assoc_length(symbol); qsort(list, num_elems, elem_size * sizeof(NODE *), cmp_func); /* shazzam! */ if (sort_ctxt == SORTED_IN && (assoc_kind & (AINDEX|AVALUE)) == (AINDEX|AVALUE)) { /* relocate all index nodes to the first half of the list. */ for (j = 1; j < num_elems; j++) list[j] = list[2 * j]; /* give back extra memory */ erealloc(list, NODE **, num_elems * sizeof(NODE *), "assoc_list"); } } if (cmp_func == sort_user_func) { code = POP_CODE(); currule = save_rule; /* restore current rule */ bcfree(code->nexti); /* Op_stop */ bcfree(code); /* Op_func_call */ } return list; }