"Fossies" - the Fresh Open Source Software Archive

Member "gawk-5.1.0/array.c" (10 Mar 2020, 33740 Bytes) of package /linux/misc/gawk-5.1.0.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "array.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 5.0.1_vs_5.1.0.

    1 /*
    2  * array.c - routines for awk arrays.
    3  */
    4 
    5 /*
    6  * Copyright (C) 1986, 1988, 1989, 1991-2014, 2016, 2018, 2019, 2020,
    7  * the Free Software Foundation, Inc.
    8  *
    9  * This file is part of GAWK, the GNU implementation of the
   10  * AWK Programming Language.
   11  *
   12  * GAWK is free software; you can redistribute it and/or modify
   13  * it under the terms of the GNU General Public License as published by
   14  * the Free Software Foundation; either version 3 of the License, or
   15  * (at your option) any later version.
   16  *
   17  * GAWK is distributed in the hope that it will be useful,
   18  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   19  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   20  * GNU General Public License for more details.
   21  *
   22  * You should have received a copy of the GNU General Public License
   23  * along with this program; if not, write to the Free Software
   24  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
   25  */
   26 
   27 #include "awk.h"
   28 
   29 extern FILE *output_fp;
   30 extern NODE **fmt_list;          /* declared in eval.c */
   31 
   32 NODE *success_node;
   33 
   34 static size_t SUBSEPlen;
   35 static char *SUBSEP;
   36 static char indent_char[] = "    ";
   37 
   38 static int sort_up_value_type(const void *p1, const void *p2);
   39 static NODE **null_lookup(NODE *symbol, NODE *subs);
   40 static NODE **null_dump(NODE *symbol, NODE *subs);
   41 static const array_funcs_t null_array_func = {
   42     "null",
   43     (afunc_t) 0,
   44     (afunc_t) 0,
   45     null_lookup,
   46     null_afunc,
   47     null_afunc,
   48     null_afunc,
   49     null_afunc,
   50     null_afunc,
   51     null_dump,
   52     (afunc_t) 0,
   53 };
   54 
   55 #define MAX_ATYPE 10
   56 
   57 static const array_funcs_t *array_types[MAX_ATYPE];
   58 static int num_array_types = 0;
   59 
   60 /* register_array_func --- add routines to handle arrays */
   61 
   62 static int
   63 register_array_func(const array_funcs_t *afunc)
   64 {
   65     if (afunc && num_array_types < MAX_ATYPE) {
   66         if (afunc != & str_array_func && afunc->type_of == NULL)
   67             return false;
   68         array_types[num_array_types++] = afunc;
   69         if (afunc->init)    /* execute init routine if any */
   70             (void) (*afunc->init)(NULL, NULL);
   71         return true;
   72     }
   73     return false;
   74 }
   75 
   76 
   77 /* array_init --- register all builtin array types */
   78 
   79 void
   80 array_init()
   81 {
   82     (void) register_array_func(& str_array_func);   /* the default */
   83     if (! do_mpfr) {
   84         (void) register_array_func(& int_array_func);
   85         (void) register_array_func(& cint_array_func);
   86     }
   87 }
   88 
   89 
   90 /* make_array --- create an array node */
   91 
   92 NODE *
   93 make_array()
   94 {
   95     NODE *array;
   96     getnode(array);
   97     memset(array, '\0', sizeof(NODE));
   98     array->type = Node_var_array;
   99     array->array_funcs = & null_array_func;
  100     /* vname, flags, and parent_array not set here */
  101 
  102     return array;
  103 }
  104 
  105 
  106 /* null_array --- force symbol to be an empty typeless array */
  107 
  108 void
  109 null_array(NODE *symbol)
  110 {
  111     symbol->type = Node_var_array;
  112     symbol->array_funcs = & null_array_func;
  113     symbol->buckets = NULL;
  114     symbol->table_size = symbol->array_size = 0;
  115     symbol->array_capacity = 0;
  116     symbol->flags = 0;
  117 
  118     assert(symbol->xarray == NULL);
  119 
  120     /* vname, parent_array not (re)initialized */
  121 }
  122 
  123 
  124 /* null_lookup --- assign type to an empty array. */
  125 
  126 static NODE **
  127 null_lookup(NODE *symbol, NODE *subs)
  128 {
  129     int i;
  130     const array_funcs_t *afunc = NULL;
  131 
  132     assert(symbol->table_size == 0);
  133 
  134     /*
  135      * Check which array type wants to accept this sub; traverse
  136      * array type list in reverse order.
  137      */
  138     for (i = num_array_types - 1; i >= 1; i--) {
  139         afunc = array_types[i];
  140         if (afunc->type_of(symbol, subs) != NULL)
  141             break;
  142     }
  143     if (i == 0 || afunc == NULL)
  144         afunc = array_types[0]; /* default is str_array_func */
  145     symbol->array_funcs = afunc;
  146 
  147     /* We have the right type of array; install the subscript */
  148     return symbol->alookup(symbol, subs);
  149 }
  150 
  151 
  152 /* null_afunc --- default function for array interface */
  153 
  154 NODE **
  155 null_afunc(NODE *symbol ATTRIBUTE_UNUSED, NODE *subs ATTRIBUTE_UNUSED)
  156 {
  157     return NULL;
  158 }
  159 
  160 /* null_dump --- dump function for an empty array */
  161 
  162 static NODE **
  163 null_dump(NODE *symbol, NODE *subs ATTRIBUTE_UNUSED)
  164 {
  165     fprintf(output_fp, "array `%s' is empty\n", array_vname(symbol));
  166     return NULL;
  167 }
  168 
  169 
  170 /* assoc_copy --- duplicate input array "symbol" */
  171 
  172 NODE *
  173 assoc_copy(NODE *symbol, NODE *newsymb)
  174 {
  175     assert(newsymb->vname != NULL);
  176 
  177     assoc_clear(newsymb);
  178     (void) symbol->acopy(symbol, newsymb);
  179     newsymb->array_funcs = symbol->array_funcs;
  180     newsymb->flags = symbol->flags;
  181     return newsymb;
  182 }
  183 
  184 
  185 /* assoc_dump --- dump array */
  186 
  187 void
  188 assoc_dump(NODE *symbol, NODE *ndump)
  189 {
  190     if (symbol->adump)
  191         (void) symbol->adump(symbol, ndump);
  192 }
  193 
  194 
  195 /* make_aname --- construct a 'vname' for a (sub)array */
  196 
  197 const char *
  198 make_aname(const NODE *symbol)
  199 {
  200     static char *aname = NULL;
  201     static size_t alen;
  202     static size_t max_alen;
  203 #define SLEN 256
  204 
  205     if (symbol->parent_array != NULL) {
  206         size_t slen;
  207 
  208         (void) make_aname(symbol->parent_array);
  209         slen = strlen(symbol->vname);   /* subscript in parent array */
  210         if (alen + slen + 4 > max_alen) {       /* sizeof("[\"\"]") = 4 */
  211             max_alen = alen + slen + 4 + SLEN;
  212             erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");
  213         }
  214         alen += sprintf(aname + alen, "[\"%s\"]", symbol->vname);
  215     } else {
  216         alen = strlen(symbol->vname);
  217         if (aname == NULL) {
  218             max_alen = alen + SLEN;
  219             emalloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");
  220         } else if (alen > max_alen) {
  221             max_alen = alen + SLEN;
  222             erealloc(aname, char *, (max_alen + 1) * sizeof(char *), "make_aname");
  223         }
  224         memcpy(aname, symbol->vname, alen + 1);
  225     }
  226     return aname;
  227 }
  228 #undef SLEN
  229 
  230 
  231 /*
  232  * array_vname --- print the name of the array
  233  *
  234  * Returns a pointer to a statically maintained dynamically allocated string.
  235  * It's appropriate for printing the name once; if the caller wants
  236  * to save it, they have to make a copy.
  237  */
  238 
  239 const char *
  240 array_vname(const NODE *symbol)
  241 {
  242     static char *message = NULL;
  243     static size_t msglen = 0;
  244     char *s;
  245     size_t len;
  246     int n;
  247     const NODE *save_symbol = symbol;
  248     const char *from = _("from %s");
  249     const char *aname;
  250 
  251     if (symbol->type != Node_array_ref
  252             || symbol->orig_array->type != Node_var_array
  253     ) {
  254         if (symbol->type != Node_var_array || symbol->parent_array == NULL)
  255             return symbol->vname;
  256         return make_aname(symbol);
  257     }
  258 
  259     /* First, we have to compute the length of the string: */
  260 
  261     len = 2; /* " (" */
  262     n = 0;
  263     while (symbol->type == Node_array_ref) {
  264         len += strlen(symbol->vname);
  265         n++;
  266         symbol = symbol->prev_array;
  267     }
  268 
  269     /* Get the (sub)array name */
  270     if (symbol->parent_array == NULL)
  271         aname = symbol->vname;
  272     else
  273         aname = make_aname(symbol);
  274     len += strlen(aname);
  275     /*
  276      * Each node contributes by strlen(from) minus the length
  277      * of "%s" in the translation (which is at least 2)
  278      * plus 2 for ", " or ")\0"; this adds up to strlen(from).
  279      */
  280     len += n * strlen(from);
  281 
  282     /* (Re)allocate memory: */
  283     if (message == NULL) {
  284         emalloc(message, char *, len, "array_vname");
  285         msglen = len;
  286     } else if (len > msglen) {
  287         erealloc(message, char *, len, "array_vname");
  288         msglen = len;
  289     } /* else
  290         current buffer can hold new name */
  291 
  292     /* We're ready to print: */
  293     symbol = save_symbol;
  294     s = message;
  295     /*
  296      * Ancient systems have sprintf() returning char *, not int.
  297      * If you have one of those, use sprintf(..); s += strlen(s) instead.
  298      */
  299 
  300     s += sprintf(s, "%s (", symbol->vname);
  301     for (;;) {
  302         symbol = symbol->prev_array;
  303         if (symbol->type != Node_array_ref)
  304             break;
  305         s += sprintf(s, from, symbol->vname);
  306         s += sprintf(s, ", ");
  307     }
  308     s += sprintf(s, from, aname);
  309     strcpy(s, ")");
  310 
  311     return message;
  312 }
  313 
  314 
  315 /*
  316  *  force_array --- proceed to the actual Node_var_array,
  317  *  change Node_var_new to an array.
  318  *  If canfatal and type isn't good, die fatally,
  319  *  otherwise return the final actual value.
  320  */
  321 
  322 NODE *
  323 force_array(NODE *symbol, bool canfatal)
  324 {
  325     NODE *save_symbol = symbol;
  326     bool isparam = false;
  327 
  328     if (symbol->type == Node_param_list) {
  329         save_symbol = symbol = GET_PARAM(symbol->param_cnt);
  330         isparam = true;
  331         if (symbol->type == Node_array_ref)
  332             symbol = symbol->orig_array;
  333     }
  334 
  335     switch (symbol->type) {
  336     case Node_var_new:
  337         symbol->xarray = NULL;  /* make sure union is as it should be */
  338         null_array(symbol);
  339         symbol->parent_array = NULL;    /* main array has no parent */
  340         /* fall through */
  341     case Node_var_array:
  342         break;
  343 
  344     case Node_array_ref:
  345     default:
  346         /* notably Node_var but catches also e.g. a[1] = "x"; a[1][1] = "y" */
  347         if (canfatal) {
  348             if (symbol->type == Node_val)
  349                 fatal(_("attempt to use a scalar value as array"));
  350             if (isparam)
  351                 fatal(_("attempt to use scalar parameter `%s' as an array"),
  352                     save_symbol->vname);
  353             else
  354                 fatal(_("attempt to use scalar `%s' as an array"),
  355                     save_symbol->vname);
  356         } else
  357             break;
  358     }
  359 
  360     return symbol;
  361 }
  362 
  363 
  364 /* set_SUBSEP --- update SUBSEP related variables when SUBSEP assigned to */
  365 
  366 void
  367 set_SUBSEP()
  368 {
  369     SUBSEP_node->var_value = force_string(SUBSEP_node->var_value);
  370     SUBSEP = SUBSEP_node->var_value->stptr;
  371     SUBSEPlen = SUBSEP_node->var_value->stlen;
  372 }
  373 
  374 
  375 /* concat_exp --- concatenate expression list into a single string */
  376 
  377 NODE *
  378 concat_exp(int nargs, bool do_subsep)
  379 {
  380     /* do_subsep is false for Op_concat */
  381     NODE *r;
  382     char *str;
  383     char *s;
  384     size_t len;
  385     size_t subseplen = 0;
  386     int i;
  387     extern NODE **args_array;
  388 
  389     if (nargs == 1)
  390         return POP_STRING();
  391 
  392     if (do_subsep)
  393         subseplen = SUBSEPlen;
  394 
  395     len = 0;
  396     for (i = 1; i <= nargs; i++) {
  397         r = TOP();
  398         if (r->type == Node_var_array) {
  399             while (--i > 0)
  400                 DEREF(args_array[i]);   /* avoid memory leak */
  401             fatal(_("attempt to use array `%s' in a scalar context"), array_vname(r));
  402         }
  403         r = POP_STRING();
  404         args_array[i] = r;
  405         len += r->stlen;
  406     }
  407     len += (nargs - 1) * subseplen;
  408 
  409     emalloc(str, char *, len + 1, "concat_exp");
  410 
  411     r = args_array[nargs];
  412     memcpy(str, r->stptr, r->stlen);
  413     s = str + r->stlen;
  414     DEREF(r);
  415     for (i = nargs - 1; i > 0; i--) {
  416         if (subseplen == 1)
  417             *s++ = *SUBSEP;
  418         else if (subseplen > 0) {
  419             memcpy(s, SUBSEP, subseplen);
  420             s += subseplen;
  421         }
  422         r = args_array[i];
  423         memcpy(s, r->stptr, r->stlen);
  424         s += r->stlen;
  425         DEREF(r);
  426     }
  427 
  428     return make_str_node(str, len, ALREADY_MALLOCED);
  429 }
  430 
  431 
  432 /*
  433  * adjust_fcall_stack: remove subarray(s) of symbol[] from
  434  *  function call stack.
  435  */
  436 
  437 static void
  438 adjust_fcall_stack(NODE *symbol, int nsubs)
  439 {
  440     NODE *func, *r, *n;
  441     NODE **sp;
  442     int pcount;
  443 
  444     /*
  445      * Solve the nasty problem of disappearing subarray arguments:
  446      *
  447      *  function f(c, d) { delete c; .. use non-existent array d .. }
  448      *  BEGIN { a[0][0] = 1; f(a, a[0]); .. }
  449      *
  450      * The fix is to convert 'd' to a local empty array; This has
  451      * to be done before clearing the parent array to avoid referring to
  452      * already free-ed memory.
  453      *
  454      * Similar situations exist for builtins accepting more than
  455      * one array argument: split, patsplit, asort and asorti. For example:
  456      *
  457      *  BEGIN { a[0][0] = 1; split("abc", a, "", a[0]) }
  458      *
  459      * These cases do not involve the function call stack, and are
  460      * handled individually in their respective routines.
  461      */
  462 
  463     func = frame_ptr->func_node;
  464     if (func == NULL)   /* in main */
  465         return;
  466     pcount = func->param_cnt;
  467     sp = frame_ptr->stack;
  468 
  469     for (; pcount > 0; pcount--) {
  470         r = *sp++;
  471         if (r->type != Node_array_ref
  472                 || r->orig_array->type != Node_var_array)
  473             continue;
  474         n = r->orig_array;
  475 
  476         /* Case 1 */
  477         if (n == symbol
  478             && symbol->parent_array != NULL
  479             && nsubs > 0
  480         ) {
  481             /*
  482              * 'symbol' is a subarray, and 'r' is the same subarray:
  483              *
  484              *   function f(c, d) { delete c[0]; .. }
  485              *   BEGIN { a[0][0] = 1; f(a, a[0]); .. }
  486              *
  487              * But excludes cases like (nsubs = 0):
  488              *
  489              *   function f(c, d) { delete c; ..}
  490              *   BEGIN { a[0][0] = 1; f(a[0], a[0]); ...}
  491              */
  492 
  493             null_array(r);
  494             r->parent_array = NULL;
  495             continue;
  496         }
  497 
  498         /* Case 2 */
  499         for (n = n->parent_array; n != NULL; n = n->parent_array) {
  500             assert(n->type == Node_var_array);
  501             if (n == symbol) {
  502                 /*
  503                  * 'r' is a subarray of 'symbol':
  504                  *
  505                  *    function f(c, d) { delete c; .. use d as array .. }
  506                  *    BEGIN { a[0][0] = 1; f(a, a[0]); .. }
  507                  *  OR
  508                  *    BEGIN { a[0][0][0][0] = 1; f(a[0], a[0][0][0]); .. }
  509                  *
  510                  */
  511                 null_array(r);
  512                 r->parent_array = NULL;
  513                 break;
  514             }
  515         }
  516     }
  517 }
  518 
  519 
  520 /* do_delete --- perform `delete array[s]' */
  521 
  522 /*
  523  * `symbol' is array
  524  * `nsubs' is no of subscripts
  525  */
  526 
  527 void
  528 do_delete(NODE *symbol, int nsubs)
  529 {
  530     NODE *val, *subs;
  531     int i;
  532 
  533     assert(symbol->type == Node_var_array);
  534     subs = val = NULL;  /* silence the compiler */
  535 
  536     /*
  537      * The force_string() call is needed to make sure that
  538      * the string subscript is reasonable.  For example, with it:
  539      *
  540      * $ ./gawk --posix 'BEGIN { CONVFMT="%ld"; delete a[1.233]}'
  541      * gawk: cmd. line:1: fatal: `%l' is not permitted in POSIX awk formats
  542      *
  543      * Without it, the code does not fail.
  544      */
  545 
  546 #define free_subs(n)    do {                                    \
  547     NODE *s = PEEK(n - 1);                                      \
  548     if (s->type == Node_val) {                                  \
  549         (void) force_string(s); /* may have side effects. */    \
  550         DEREF(s);                                               \
  551     }                                                           \
  552 } while (--n > 0)
  553 
  554     if (nsubs == 0) {
  555         /* delete array */
  556 
  557         adjust_fcall_stack(symbol, 0);  /* fix function call stack; See above. */
  558         assoc_clear(symbol);
  559         return;
  560     }
  561 
  562     /* NB: subscripts are in reverse order on stack */
  563 
  564     for (i = nsubs; i > 0; i--) {
  565         subs = PEEK(i - 1);
  566         if (subs->type != Node_val) {
  567             free_subs(i);
  568             fatal(_("attempt to use array `%s' in a scalar context"), array_vname(subs));
  569         }
  570 
  571         val = in_array(symbol, subs);
  572         if (val == NULL) {
  573             if (do_lint) {
  574                 subs = force_string(subs);
  575                 lintwarn(_("delete: index `%.*s' not in array `%s'"),
  576                     (int) subs->stlen, subs->stptr, array_vname(symbol));
  577             }
  578             /* avoid memory leak, free all subs */
  579             free_subs(i);
  580             return;
  581         }
  582 
  583         if (i > 1) {
  584             if (val->type != Node_var_array) {
  585                 /* e.g.: a[1] = 1; delete a[1][1] */
  586 
  587                 free_subs(i);
  588                 subs = force_string(subs);
  589                 fatal(_("attempt to use scalar `%s[\"%.*s\"]' as an array"),
  590                     array_vname(symbol),
  591                     (int) subs->stlen,
  592                     subs->stptr);
  593             }
  594             symbol = val;
  595             DEREF(subs);
  596         }
  597     }
  598 
  599     if (val->type == Node_var_array) {
  600         adjust_fcall_stack(val, nsubs);  /* fix function call stack; See above. */
  601         assoc_clear(val);
  602         /* cleared a sub-array, free Node_var_array */
  603         efree(val->vname);
  604         freenode(val);
  605     } else
  606         unref(val);
  607 
  608     (void) assoc_remove(symbol, subs);
  609     DEREF(subs);
  610     if (assoc_empty(symbol))
  611         /* last element was removed, so reset array type to null */
  612         null_array(symbol);
  613 
  614 #undef free_subs
  615 }
  616 
  617 
  618 /* do_delete_loop --- simulate ``for (iggy in foo) delete foo[iggy]'' */
  619 
  620 /*
  621  * The primary hassle here is that `iggy' needs to have some arbitrary
  622  * array index put in it before we can clear the array, we can't
  623  * just replace the loop with `delete foo'.
  624  */
  625 
  626 void
  627 do_delete_loop(NODE *symbol, NODE **lhs)
  628 {
  629     NODE **list;
  630     NODE akind;
  631 
  632     akind.flags = AINDEX|ADELETE;   /* need a single index */
  633     list = symbol->alist(symbol, & akind);
  634 
  635     if (assoc_empty(symbol))
  636         return;
  637 
  638     unref(*lhs);
  639     *lhs = list[0];
  640     efree(list);
  641 
  642     /* blast the array in one shot */
  643     adjust_fcall_stack(symbol, 0);
  644     assoc_clear(symbol);
  645 }
  646 
  647 
  648 /* value_info --- print scalar node info */
  649 
  650 static void
  651 value_info(NODE *n)
  652 {
  653 
  654 #define PREC_NUM -1
  655 
  656     if (n == Nnull_string || n == Null_field) {
  657         fprintf(output_fp, "<(null)>");
  658         return;
  659     }
  660 
  661     if ((n->flags & (STRING|STRCUR)) != 0) {
  662         fprintf(output_fp, "<");
  663         fprintf(output_fp, "\"%.*s\"", (int) n->stlen, n->stptr);
  664         if ((n->flags & (NUMBER|NUMCUR)) != 0) {
  665 #ifdef HAVE_MPFR
  666             if (is_mpg_float(n))
  667                 fprintf(output_fp, ":%s",
  668                     mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));
  669             else if (is_mpg_integer(n))
  670                 fprintf(output_fp, ":%s", mpg_fmt("%Zd", n->mpg_i));
  671             else
  672 #endif
  673             fprintf(output_fp, ":%.*g", PREC_NUM, n->numbr);
  674         }
  675         fprintf(output_fp, ">");
  676     } else {
  677 #ifdef HAVE_MPFR
  678         if (is_mpg_float(n))
  679             fprintf(output_fp, "<%s>",
  680                 mpg_fmt("%.*R*g", PREC_NUM, ROUND_MODE, n->mpg_numbr));
  681         else if (is_mpg_integer(n))
  682             fprintf(output_fp, "<%s>", mpg_fmt("%Zd", n->mpg_i));
  683         else
  684 #endif
  685         fprintf(output_fp, "<%.*g>", PREC_NUM, n->numbr);
  686     }
  687 
  688     fprintf(output_fp, ":%s", flags2str(n->flags));
  689 
  690     if ((n->flags & MALLOC) != 0)
  691         fprintf(output_fp, ":%ld", n->valref);
  692     else
  693         fprintf(output_fp, ":");
  694 
  695     if ((n->flags & (STRING|STRCUR)) == STRCUR) {
  696         size_t len;
  697 
  698         fprintf(output_fp, "][");
  699         fprintf(output_fp, "stfmt=%d, ", n->stfmt);
  700         /*
  701          * If not STFMT_UNUSED, could be CONVFMT or OFMT if last
  702          * used in a print statement. If immutable, could be that it
  703          * was originally set as a string, or it's a number that has
  704          * an integer value.
  705          */
  706         len = fmt_list[n->stfmt]->stlen;
  707         fmt_list[n->stfmt]->stptr[len] = '\0';
  708         fprintf(output_fp, "FMT=\"%s\"",
  709                     n->stfmt == STFMT_UNUSED ? "<unused>"
  710                     : fmt_list[n->stfmt]->stptr);
  711 #ifdef HAVE_MPFR
  712         fprintf(output_fp, ", RNDMODE=\"%c\"", n->strndmode);
  713 #endif
  714     }
  715 
  716 #undef PREC_NUM
  717 }
  718 
  719 
  720 void
  721 indent(int indent_level)
  722 {
  723     int i;
  724     for (i = 0; i < indent_level; i++)
  725         fprintf(output_fp, "%s", indent_char);
  726 }
  727 
  728 /* assoc_info --- print index, value info */
  729 
  730 void
  731 assoc_info(NODE *subs, NODE *val, NODE *ndump, const char *aname)
  732 {
  733     int indent_level = ndump->alevel;
  734 
  735     indent_level++;
  736     indent(indent_level);
  737     fprintf(output_fp, "I: [%s:", aname);
  738     if ((subs->flags & (MPFN|MPZN|INTIND)) == INTIND)
  739         fprintf(output_fp, "<%ld>", (long) subs->numbr);
  740     else
  741         value_info(subs);
  742     fprintf(output_fp, "]\n");
  743 
  744     indent(indent_level);
  745     if (val->type == Node_val) {
  746         fprintf(output_fp, "V: [scalar: ");
  747         value_info(val);
  748     } else {
  749         fprintf(output_fp, "V: [");
  750         ndump->alevel++;
  751         ndump->adepth--;
  752         assoc_dump(val, ndump);
  753         ndump->adepth++;
  754         ndump->alevel--;
  755         indent(indent_level);
  756     }
  757     fprintf(output_fp, "]\n");
  758 }
  759 
  760 
  761 /* do_adump --- dump an array: interface to assoc_dump */
  762 
  763 NODE *
  764 do_adump(int nargs)
  765 {
  766     NODE *symbol, *tmp;
  767     static NODE ndump;
  768     long depth = 0;
  769 
  770     /*
  771      * depth < 0, no index and value info.
  772      *       = 0, main array index and value info; does not descend into sub-arrays.
  773      *       > 0, descends into 'depth' sub-arrays, and prints index and value info.
  774      */
  775 
  776     if (nargs == 2) {
  777         tmp = POP_NUMBER();
  778         depth = get_number_si(tmp);
  779         DEREF(tmp);
  780     }
  781     symbol = POP_PARAM();
  782     if (symbol->type != Node_var_array)
  783         fatal(_("%s: first argument is not an array"), "adump");
  784 
  785     ndump.type = Node_dump_array;
  786     ndump.adepth = depth;
  787     ndump.alevel = 0;
  788     assoc_dump(symbol, & ndump);
  789     return make_number((AWKNUM) 0);
  790 }
  791 
  792 
  793 /* asort_actual --- do the actual work to sort the input array */
  794 
  795 static NODE *
  796 asort_actual(int nargs, sort_context_t ctxt)
  797 {
  798     NODE *array, *dest = NULL, *result;
  799     NODE *r, *subs, *s;
  800     NODE **list = NULL, **ptr;
  801     unsigned long num_elems, i;
  802     const char *sort_str;
  803     char save;
  804 
  805     if (nargs == 3)  /* 3rd optional arg */
  806         s = POP_STRING();
  807     else
  808         s = dupnode(Nnull_string);  /* "" => default sorting */
  809 
  810     s = force_string(s);
  811     sort_str = s->stptr;
  812     save = s->stptr[s->stlen];
  813     s->stptr[s->stlen] = '\0';
  814     if (s->stlen == 0) {        /* default sorting */
  815         if (ctxt == ASORT)
  816             sort_str = "@val_type_asc";
  817         else
  818             sort_str = "@ind_str_asc";
  819     }
  820 
  821     if (nargs >= 2) {  /* 2nd optional arg */
  822         dest = POP_PARAM();
  823         if (dest->type != Node_var_array) {
  824             fatal(_("%s: second argument is not an array"),
  825                 ctxt == ASORT ? "asort" : "asorti");
  826         }
  827     }
  828 
  829     array = POP_PARAM();
  830     if (array->type != Node_var_array) {
  831         fatal(_("%s: first argument is not an array"),
  832             ctxt == ASORT ? "asort" : "asorti");
  833     }
  834     else if (array == symbol_table)
  835         fatal(_("%s: first argument cannot be SYMTAB"),
  836             ctxt == ASORT ? "asort" : "asorti");
  837     else if (array == func_table)
  838         fatal(_("%s: first argument cannot be FUNCTAB"),
  839             ctxt == ASORT ? "asort" : "asorti");
  840 
  841     if (dest != NULL) {
  842         for (r = dest->parent_array; r != NULL; r = r->parent_array) {
  843             if (r == array)
  844                 fatal(_("%s: cannot use a subarray of first argument for second argument"),
  845                     ctxt == ASORT ? "asort" : "asorti");
  846         }
  847         for (r = array->parent_array; r != NULL; r = r->parent_array) {
  848             if (r == dest)
  849                 fatal(_("%s: cannot use a subarray of second argument for first argument"),
  850                     ctxt == ASORT ? "asort" : "asorti");
  851         }
  852     }
  853 
  854     /* sorting happens inside assoc_list */
  855     list = assoc_list(array, sort_str, ctxt);
  856     s->stptr[s->stlen] = save;
  857     DEREF(s);
  858 
  859     num_elems = assoc_length(array);
  860     if (num_elems == 0 || list == NULL) {
  861         /* source array is empty */
  862         if (dest != NULL && dest != array)
  863             assoc_clear(dest);
  864         if (list != NULL)
  865             efree(list);
  866         return make_number((AWKNUM) 0);
  867     }
  868 
  869     /*
  870      * Must not assoc_clear() the source array before constructing
  871      * the output array. assoc_list() does not duplicate array values
  872      * which are needed for asort().
  873      */
  874 
  875     if (dest != NULL && dest != array) {
  876         assoc_clear(dest);
  877         result = dest;
  878     } else {
  879         /* use 'result' as a temporary destination array */
  880         result = make_array();
  881         result->vname = array->vname;
  882         result->parent_array = array->parent_array;
  883     }
  884 
  885     if (ctxt == ASORTI) {
  886         /* We want the indices of the source array. */
  887 
  888         for (i = 1, ptr = list; i <= num_elems; i++, ptr += 2) {
  889             subs = make_number(i);
  890             assoc_set(result, subs, *ptr);
  891         }
  892     } else {
  893         /* We want the values of the source array. */
  894 
  895         for (i = 1, ptr = list; i <= num_elems; i++) {
  896             subs = make_number(i);
  897 
  898             /* free index node */
  899             r = *ptr++;
  900             unref(r);
  901 
  902             /* value node */
  903             r = *ptr++;
  904 
  905             NODE *value;
  906 
  907             if (r->type == Node_val)
  908                 value = dupnode(r);
  909             else {
  910                 NODE *arr;
  911                 arr = make_array();
  912                 subs = force_string(subs);
  913                 arr->vname = subs->stptr;
  914                 arr->vname[subs->stlen] = '\0';
  915                 subs->stptr = NULL;
  916                 subs->flags &= ~STRCUR;
  917                 arr->parent_array = array; /* actual parent, not the temporary one. */
  918 
  919                 value = assoc_copy(r, arr);
  920             }
  921             assoc_set(result, subs, value);
  922         }
  923     }
  924 
  925     efree(list);
  926 
  927     if (result != dest) {
  928         /* dest == NULL or dest == array */
  929         assoc_clear(array);
  930         *array = *result;   /* copy result into array */
  931         freenode(result);
  932     } /* else
  933         result == dest
  934         dest != NULL and dest != array */
  935 
  936     return make_number((AWKNUM) num_elems);
  937 }
  938 
  939 /* do_asort --- sort array by value */
  940 
  941 NODE *
  942 do_asort(int nargs)
  943 {
  944     return asort_actual(nargs, ASORT);
  945 }
  946 
  947 /* do_asorti --- sort array by index */
  948 
  949 NODE *
  950 do_asorti(int nargs)
  951 {
  952     return asort_actual(nargs, ASORTI);
  953 }
  954 
  955 
  956 /*
  957  * cmp_strings --- compare two strings; logic similar to cmp_nodes() in eval.c
  958  *  except the extra case-sensitive comparison when the case-insensitive
  959  *  result is a match.
  960  */
  961 
  962 static int
  963 cmp_strings(const NODE *n1, const NODE *n2)
  964 {
  965     char *s1, *s2;
  966     size_t len1, len2;
  967     int ret;
  968 
  969     s1 = n1->stptr;
  970     len1 = n1->stlen;
  971     s2 =  n2->stptr;
  972     len2 = n2->stlen;
  973 
  974     if (len1 == 0)
  975         return len2 == 0 ? 0 : -1;
  976     if (len2 == 0)
  977         return 1;
  978 
  979     /* len1 > 0 && len2 > 0 */
  980     // make const to ensure it doesn't change if we
  981     // need to call memcmp(), below
  982     const size_t lmin = len1 < len2 ? len1 : len2;
  983 
  984     if (IGNORECASE) {
  985         const unsigned char *cp1 = (const unsigned char *) s1;
  986         const unsigned char *cp2 = (const unsigned char *) s2;
  987 
  988         if (gawk_mb_cur_max > 1) {
  989             ret = strncasecmpmbs((const unsigned char *) cp1,
  990                          (const unsigned char *) cp2, lmin);
  991         } else {
  992             size_t count = lmin;
  993 
  994             for (ret = 0; count-- > 0 && ret == 0; cp1++, cp2++)
  995                 ret = casetable[*cp1] - casetable[*cp2];
  996         }
  997         if (ret != 0)
  998             return ret;
  999         /*
 1000          * If case insensitive result is "they're the same",
 1001          * use case sensitive comparison to force distinct order.
 1002          */
 1003     }
 1004 
 1005     ret = memcmp(s1, s2, lmin);
 1006     if (ret != 0 || len1 == len2)
 1007         return ret;
 1008     return (len1 < len2) ? -1 : 1;
 1009 }
 1010 
 1011 /* sort_up_index_string --- qsort comparison function; ascending index strings. */
 1012 
 1013 static int
 1014 sort_up_index_string(const void *p1, const void *p2)
 1015 {
 1016     const NODE *t1, *t2;
 1017 
 1018     /* Array indices are strings */
 1019     t1 = *((const NODE *const *) p1);
 1020     t2 = *((const NODE *const *) p2);
 1021     return cmp_strings(t1, t2);
 1022 }
 1023 
 1024 
 1025 /* sort_down_index_str --- qsort comparison function; descending index strings. */
 1026 
 1027 static int
 1028 sort_down_index_string(const void *p1, const void *p2)
 1029 {
 1030     /*
 1031      * Negation versus transposed arguments:  when all keys are
 1032      * distinct, as with array indices here, either method will
 1033      * transform an ascending sort into a descending one.  But if
 1034      * there are equal keys--such as when IGNORECASE is honored--
 1035      * that get disambiguated into a determisitc order, negation
 1036      * will reverse those but transposed arguments would retain
 1037      * their relative order within the rest of the reversed sort.
 1038      */
 1039     return -sort_up_index_string(p1, p2);
 1040 }
 1041 
 1042 
 1043 /* sort_up_index_number --- qsort comparison function; ascending index numbers. */
 1044 
 1045 static int
 1046 sort_up_index_number(const void *p1, const void *p2)
 1047 {
 1048     const NODE *t1, *t2;
 1049     int ret;
 1050 
 1051     t1 = *((const NODE *const *) p1);
 1052     t2 = *((const NODE *const *) p2);
 1053 
 1054     ret = cmp_numbers(t1, t2);
 1055     if (ret != 0)
 1056         return ret;
 1057 
 1058     /* break a tie with the index string itself */
 1059     t1 = force_string((NODE *) t1);
 1060     t2 = force_string((NODE *) t2);
 1061     return cmp_strings(t1, t2);
 1062 }
 1063 
 1064 /* sort_down_index_number --- qsort comparison function; descending index numbers */
 1065 
 1066 static int
 1067 sort_down_index_number(const void *p1, const void *p2)
 1068 {
 1069     return -sort_up_index_number(p1, p2);
 1070 }
 1071 
 1072 
 1073 /* sort_up_value_string --- qsort comparison function; ascending value string */
 1074 
 1075 static int
 1076 sort_up_value_string(const void *p1, const void *p2)
 1077 {
 1078     const NODE *t1, *t2;
 1079     int ret;
 1080 
 1081     t1 = *((const NODE *const *) p1 + 1);
 1082     t2 = *((const NODE *const *) p2 + 1);
 1083 
 1084     if (t1->type != Node_val || t2->type != Node_val)
 1085         return sort_up_value_type(p1, p2);
 1086 
 1087     /* t1 and t2 both have string values */
 1088     ret = cmp_strings(t1, t2);
 1089     if (ret != 0)
 1090         return ret;
 1091     return sort_up_index_string(p1, p2);
 1092 }
 1093 
 1094 
 1095 /* sort_down_value_string --- qsort comparison function; descending value string */
 1096 
 1097 static int
 1098 sort_down_value_string(const void *p1, const void *p2)
 1099 {
 1100     return -sort_up_value_string(p1, p2);
 1101 }
 1102 
 1103 
 1104 /* sort_up_value_number --- qsort comparison function; ascending value number */
 1105 
 1106 static int
 1107 sort_up_value_number(const void *p1, const void *p2)
 1108 {
 1109     NODE *t1, *t2;
 1110     int ret;
 1111 
 1112     t1 = *((NODE *const *) p1 + 1);
 1113     t2 = *((NODE *const *) p2 + 1);
 1114 
 1115     if (t1->type != Node_val || t2->type != Node_val)
 1116         return sort_up_value_type(p1, p2);
 1117 
 1118     ret = cmp_numbers(t1, t2);
 1119     if (ret != 0)
 1120         return ret;
 1121 
 1122     /*
 1123      * Use string value to guarantee same sort order on all
 1124      * versions of qsort().
 1125      */
 1126     ret = cmp_strings(force_string(t1), force_string(t2));
 1127     if (ret != 0)
 1128         return ret;
 1129     return sort_up_index_string(p1, p2);
 1130 }
 1131 
 1132 
 1133 /* sort_down_value_number --- qsort comparison function; descending value number */
 1134 
 1135 static int
 1136 sort_down_value_number(const void *p1, const void *p2)
 1137 {
 1138     return -sort_up_value_number(p1, p2);
 1139 }
 1140 
 1141 
 1142 /* do_sort_up_value_type --- backend comparison on ascending value type */
 1143 
 1144 static int
 1145 do_sort_up_value_type(const void *p1, const void *p2)
 1146 {
 1147     NODE *n1, *n2;
 1148 
 1149     static const NODETYPE element_types[] = {
 1150         Node_builtin_func,
 1151         Node_func,
 1152         Node_ext_func,
 1153         Node_var_new,
 1154         Node_var,
 1155         Node_var_array,
 1156         Node_val,
 1157         Node_illegal
 1158     };
 1159 
 1160     /* we want to compare the element values */
 1161     n1 = *((NODE *const *) p1 + 1);
 1162     n2 = *((NODE *const *) p2 + 1);
 1163 
 1164     if (n1->type == Node_var && n2->type == Node_var) {
 1165         /* compare the values of the variables */
 1166         n1 = n1->var_value;
 1167         n2 = n2->var_value;
 1168     }
 1169 
 1170     /* 1. Arrays vs. everything else, everything else is less than array */
 1171     if (n1->type == Node_var_array) {
 1172         /* return 0 if n2 is a sub-array too, else return 1 */
 1173         return (n2->type != Node_var_array);
 1174     }
 1175     if (n2->type == Node_var_array) {
 1176         return -1;              /* n1 (non-array) < n2 (sub-array) */
 1177     }
 1178 
 1179     /* 2. Non scalars */
 1180     if (n1->type != Node_val || n2->type != Node_val) {
 1181         int n1_pos, n2_pos, i;
 1182 
 1183         n1_pos = n2_pos = -1;
 1184         for (i = 0; element_types[i] != Node_illegal; i++) {
 1185             if (n1->type == element_types[i])
 1186                 n1_pos = i;
 1187 
 1188             if (n2->type == element_types[i])
 1189                 n2_pos = i;
 1190         }
 1191 
 1192         assert(n1_pos != -1 && n2_pos != -1);
 1193         return (n1_pos - n2_pos);
 1194     }
 1195 
 1196     /* two scalars */
 1197     (void) fixtype(n1);
 1198     (void) fixtype(n2);
 1199 
 1200     if ((n1->flags & NUMBER) != 0 && (n2->flags & NUMBER) != 0) {
 1201         return cmp_numbers(n1, n2);
 1202     }
 1203 
 1204     /* 3. All numbers are less than all strings. This is aribitrary. */
 1205     if ((n1->flags & NUMBER) != 0 && (n2->flags & STRING) != 0) {
 1206         return -1;
 1207     } else if ((n1->flags & STRING) != 0 && (n2->flags & NUMBER) != 0) {
 1208         return 1;
 1209     }
 1210 
 1211     /* 4. Two strings */
 1212     return cmp_strings(n1, n2);
 1213 }
 1214 
 1215 /* sort_up_value_type --- qsort comparison function; ascending value type */
 1216 
 1217 static int
 1218 sort_up_value_type(const void *p1, const void *p2)
 1219 {
 1220     int rc = do_sort_up_value_type(p1, p2);
 1221 
 1222     /* use a tie-breaker if do_sort_up_value_type has no opinion */
 1223     return rc ? rc : sort_up_index_string(p1, p2);
 1224 }
 1225 
 1226 /* sort_down_value_type --- qsort comparison function; descending value type */
 1227 
 1228 static int
 1229 sort_down_value_type(const void *p1, const void *p2)
 1230 {
 1231     return -sort_up_value_type(p1, p2);
 1232 }
 1233 
 1234 /* sort_user_func --- user defined qsort comparison function */
 1235 
 1236 static int
 1237 sort_user_func(const void *p1, const void *p2)
 1238 {
 1239     NODE *idx1, *idx2, *val1, *val2, *r;
 1240     int ret;
 1241     INSTRUCTION *code;
 1242 
 1243     idx1 = *((NODE *const *) p1);
 1244     idx2 = *((NODE *const *) p2);
 1245     val1 = *((NODE *const *) p1 + 1);
 1246     val2 = *((NODE *const *) p2 + 1);
 1247 
 1248     code = TOP()->code_ptr; /* comparison function call instructions */
 1249 
 1250     /* setup 4 arguments to comp_func() */
 1251     UPREF(idx1);
 1252     PUSH(idx1);
 1253     if (val1->type == Node_val)
 1254         UPREF(val1);
 1255     PUSH(val1);
 1256 
 1257     UPREF(idx2);
 1258     PUSH(idx2);
 1259     if (val2->type == Node_val)
 1260         UPREF(val2);
 1261     PUSH(val2);
 1262 
 1263     /* execute the comparison function */
 1264     (void) (*interpret)(code);
 1265 
 1266     /* return value of the comparison function */
 1267     r = POP_NUMBER();
 1268 #ifdef HAVE_MPFR
 1269     /*
 1270      * mpfr_sgn(mpz_sgn): Returns a positive value if op > 0,
 1271      * zero if op = 0, and a negative value if op < 0.
 1272      */
 1273     if (is_mpg_float(r))
 1274         ret = mpfr_sgn(r->mpg_numbr);
 1275     else if (is_mpg_integer(r))
 1276         ret = mpz_sgn(r->mpg_i);
 1277     else
 1278 #endif
 1279         ret = (r->numbr < 0.0) ? -1 : (r->numbr > 0.0);
 1280     DEREF(r);
 1281     return ret;
 1282 }
 1283 
 1284 
 1285 /* assoc_list -- construct, and optionally sort, a list of array elements */
 1286 
 1287 NODE **
 1288 assoc_list(NODE *symbol, const char *sort_str, sort_context_t sort_ctxt)
 1289 {
 1290     typedef int (*qsort_compfunc)(const void *, const void *);
 1291 
 1292     static const struct qsort_funcs {
 1293         const char *name;
 1294         qsort_compfunc comp_func;
 1295         assoc_kind_t kind;
 1296     } sort_funcs[] = {
 1297 { "@ind_str_asc",   sort_up_index_string,   AINDEX|AISTR|AASC },
 1298 { "@ind_num_asc",   sort_up_index_number,   AINDEX|AINUM|AASC },
 1299 { "@val_str_asc",   sort_up_value_string,   AVALUE|AVSTR|AASC },
 1300 { "@val_num_asc",   sort_up_value_number,   AVALUE|AVNUM|AASC },
 1301 { "@ind_str_desc",  sort_down_index_string, AINDEX|AISTR|ADESC },
 1302 { "@ind_num_desc",  sort_down_index_number, AINDEX|AINUM|ADESC },
 1303 { "@val_str_desc",  sort_down_value_string, AVALUE|AVSTR|ADESC },
 1304 { "@val_num_desc",  sort_down_value_number, AVALUE|AVNUM|ADESC },
 1305 { "@val_type_asc",  sort_up_value_type, AVALUE|AASC },
 1306 { "@val_type_desc", sort_down_value_type,   AVALUE|ADESC },
 1307 { "@unsorted",      0,          AINDEX },
 1308 };
 1309 
 1310     /*
 1311      * N.B.: AASC and ADESC are hints to the specific array types.
 1312      *  See cint_list() in cint_array.c.
 1313      */
 1314 
 1315     NODE **list;
 1316     NODE akind;
 1317     unsigned long num_elems, j;
 1318     int elem_size, qi;
 1319     qsort_compfunc cmp_func = 0;
 1320     INSTRUCTION *code = NULL;
 1321     extern int currule;
 1322     int save_rule = 0;
 1323     assoc_kind_t assoc_kind = ANONE;
 1324 
 1325     elem_size = 1;
 1326 
 1327     for (qi = 0, j = sizeof(sort_funcs)/sizeof(sort_funcs[0]); qi < j; qi++) {
 1328         if (strcmp(sort_funcs[qi].name, sort_str) == 0)
 1329             break;
 1330     }
 1331 
 1332     if (qi < j) {
 1333         cmp_func = sort_funcs[qi].comp_func;
 1334         assoc_kind = sort_funcs[qi].kind;
 1335 
 1336         if (symbol->array_funcs != & cint_array_func)
 1337             assoc_kind &= ~(AASC|ADESC);
 1338 
 1339         if (sort_ctxt != SORTED_IN || (assoc_kind & AVALUE) != 0) {
 1340             /* need index and value pair in the list */
 1341 
 1342             assoc_kind |= (AINDEX|AVALUE);
 1343             elem_size = 2;
 1344         }
 1345 
 1346     } else {    /* unrecognized */
 1347         NODE *f;
 1348         const char *sp;
 1349 
 1350         for (sp = sort_str; *sp != '\0' && ! isspace((unsigned char) *sp); sp++)
 1351             continue;
 1352 
 1353         /* empty string or string with space(s) not valid as function name */
 1354         if (sp == sort_str || *sp != '\0')
 1355             fatal(_("`%s' is invalid as a function name"), sort_str);
 1356 
 1357         f = lookup(sort_str);
 1358         if (f == NULL || f->type != Node_func)
 1359             fatal(_("sort comparison function `%s' is not defined"), sort_str);
 1360 
 1361         cmp_func = sort_user_func;
 1362 
 1363         /* need index and value pair in the list */
 1364         assoc_kind |= (AVALUE|AINDEX);
 1365         elem_size = 2;
 1366 
 1367         /* make function call instructions */
 1368         code = bcalloc(Op_func_call, 2, 0);
 1369         code->func_body = f;
 1370         code->func_name = NULL;     /* not needed, func_body already assigned */
 1371         (code + 1)->expr_count = 4; /* function takes 4 arguments */
 1372         code->nexti = bcalloc(Op_stop, 1, 0);
 1373 
 1374         /*
 1375          * make non-redirected getline, exit, `next' and `nextfile' fatal in
 1376          * callback function by setting currule in interpret()
 1377          * to undefined (0).
 1378          */
 1379 
 1380         save_rule = currule;    /* save current rule */
 1381         currule = 0;
 1382 
 1383         PUSH_CODE(code);
 1384     }
 1385 
 1386     akind.flags = (unsigned int) assoc_kind;    /* kludge */
 1387     list = symbol->alist(symbol, & akind);
 1388     assoc_kind = (assoc_kind_t) akind.flags;    /* symbol->alist can modify it */
 1389 
 1390     /* check for empty list or unsorted, or list already sorted */
 1391     if (list != NULL && cmp_func != NULL && (assoc_kind & (AASC|ADESC)) == 0) {
 1392         num_elems = assoc_length(symbol);
 1393 
 1394         qsort(list, num_elems, elem_size * sizeof(NODE *), cmp_func); /* shazzam! */
 1395 
 1396         if (sort_ctxt == SORTED_IN && (assoc_kind & (AINDEX|AVALUE)) == (AINDEX|AVALUE)) {
 1397             /* relocate all index nodes to the first half of the list. */
 1398             for (j = 1; j < num_elems; j++)
 1399                 list[j] = list[2 * j];
 1400 
 1401             /* give back extra memory */
 1402 
 1403             erealloc(list, NODE **, num_elems * sizeof(NODE *), "assoc_list");
 1404         }
 1405     }
 1406 
 1407     if (cmp_func == sort_user_func) {
 1408         code = POP_CODE();
 1409         currule = save_rule;            /* restore current rule */
 1410         bcfree(code->nexti);            /* Op_stop */
 1411         bcfree(code);                   /* Op_func_call */
 1412     }
 1413 
 1414     return list;
 1415 }