"Fossies" - the Fresh Open Source Software Archive

Member "gawk-5.1.0/eval.c" (6 Feb 2020, 43707 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 "eval.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  * eval.c - gawk bytecode interpreter
    3  */
    4 
    5 /*
    6  * Copyright (C) 1986, 1988, 1989, 1991-2019 the Free Software Foundation, Inc.
    7  *
    8  * This file is part of GAWK, the GNU implementation of the
    9  * AWK Programming Language.
   10  *
   11  * GAWK is free software; you can redistribute it and/or modify
   12  * it under the terms of the GNU General Public License as published by
   13  * the Free Software Foundation; either version 3 of the License, or
   14  * (at your option) any later version.
   15  *
   16  * GAWK is distributed in the hope that it will be useful,
   17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19  * GNU General Public License for more details.
   20  *
   21  * You should have received a copy of the GNU General Public License
   22  * along with this program; if not, write to the Free Software
   23  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
   24  */
   25 
   26 #include "awk.h"
   27 
   28 extern double pow(double x, double y);
   29 extern double modf(double x, double *yp);
   30 extern double fmod(double x, double y);
   31 NODE **fcall_list = NULL;
   32 long fcall_count = 0;
   33 int currule = 0;
   34 IOBUF *curfile = NULL;      /* current data file */
   35 bool exiting = false;
   36 
   37 int (*interpret)(INSTRUCTION *);
   38 #define MAX_EXEC_HOOKS  10
   39 static int num_exec_hook = 0;
   40 static Func_pre_exec pre_execute[MAX_EXEC_HOOKS];
   41 static Func_post_exec post_execute = NULL;
   42 
   43 extern void frame_popped();
   44 
   45 int OFSlen;
   46 int ORSlen;
   47 int OFMTidx;
   48 int CONVFMTidx;
   49 
   50 static NODE *node_Boolean[2];
   51 
   52 /* This rather ugly macro is for VMS C */
   53 #ifdef C
   54 #undef C
   55 #endif
   56 #define C(c) ((char)c)
   57 /*
   58  * This table is used by the regexp routines to do case independent
   59  * matching. Basically, every ascii character maps to itself, except
   60  * uppercase letters map to lower case ones. This table has 256
   61  * entries, for ISO 8859-1. Note also that if the system this
   62  * is compiled on doesn't use 7-bit ascii, casetable[] should not be
   63  * defined to the linker, so gawk should not load.
   64  *
   65  * Do NOT make this array static, it is used in several spots, not
   66  * just in this file.
   67  *
   68  * 6/2004:
   69  * This table is also used for IGNORECASE for == and !=, and index().
   70  * Although with GLIBC, we could use tolower() everywhere and RE_ICASE
   71  * for the regex matcher, precomputing this table once gives us a
   72  * performance improvement.  I also think it's better for portability
   73  * to non-GLIBC systems.  All the world is not (yet :-) GNU/Linux.
   74  */
   75 #if 'a' == 97   /* it's ascii */
   76 char casetable[] = {
   77     '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
   78     '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
   79     '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
   80     '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
   81     /* ' '     '!'     '"'     '#'     '$'     '%'     '&'     ''' */
   82     '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
   83     /* '('     ')'     '*'     '+'     ','     '-'     '.'     '/' */
   84     '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
   85     /* '0'     '1'     '2'     '3'     '4'     '5'     '6'     '7' */
   86     '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
   87     /* '8'     '9'     ':'     ';'     '<'     '='     '>'     '?' */
   88     '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
   89     /* '@'     'A'     'B'     'C'     'D'     'E'     'F'     'G' */
   90     '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
   91     /* 'H'     'I'     'J'     'K'     'L'     'M'     'N'     'O' */
   92     '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
   93     /* 'P'     'Q'     'R'     'S'     'T'     'U'     'V'     'W' */
   94     '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
   95     /* 'X'     'Y'     'Z'     '['     '\'     ']'     '^'     '_' */
   96     '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
   97     /* '`'     'a'     'b'     'c'     'd'     'e'     'f'     'g' */
   98     '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
   99     /* 'h'     'i'     'j'     'k'     'l'     'm'     'n'     'o' */
  100     '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
  101     /* 'p'     'q'     'r'     's'     't'     'u'     'v'     'w' */
  102     '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
  103     /* 'x'     'y'     'z'     '{'     '|'     '}'     '~' */
  104     '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
  105 
  106     /* Latin 1: */
  107     /*
  108      * 4/2019: This is now overridden; in single byte locales
  109      * we call load_casetable from main and it fills in the values
  110      * based on the current locale. In particular, we want LC_ALL=C
  111      * to work correctly for values >= 0200.
  112      */
  113     C('\200'), C('\201'), C('\202'), C('\203'), C('\204'), C('\205'), C('\206'), C('\207'),
  114     C('\210'), C('\211'), C('\212'), C('\213'), C('\214'), C('\215'), C('\216'), C('\217'),
  115     C('\220'), C('\221'), C('\222'), C('\223'), C('\224'), C('\225'), C('\226'), C('\227'),
  116     C('\230'), C('\231'), C('\232'), C('\233'), C('\234'), C('\235'), C('\236'), C('\237'),
  117     C('\240'), C('\241'), C('\242'), C('\243'), C('\244'), C('\245'), C('\246'), C('\247'),
  118     C('\250'), C('\251'), C('\252'), C('\253'), C('\254'), C('\255'), C('\256'), C('\257'),
  119     C('\260'), C('\261'), C('\262'), C('\263'), C('\264'), C('\265'), C('\266'), C('\267'),
  120     C('\270'), C('\271'), C('\272'), C('\273'), C('\274'), C('\275'), C('\276'), C('\277'),
  121     C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
  122     C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
  123     C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\327'),
  124     C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\337'),
  125     C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
  126     C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
  127     C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\367'),
  128     C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\377'),
  129 };
  130 #elif defined(USE_EBCDIC)
  131 char casetable[] = {
  132  /*00  NU    SH    SX    EX    PF    HT    LC    DL */
  133       0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
  134  /*08              SM    VT    FF    CR    SO    SI */
  135       0x08, 0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
  136  /*10  DE    D1    D2    TM    RS    NL    BS    IL */
  137       0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
  138  /*18  CN    EM    CC    C1    FS    GS    RS    US */
  139       0x18, 0x19, 0x1A, 0x1B, 0x1C, 0x1D, 0x1E, 0x1F,
  140  /*20  DS    SS    FS          BP    LF    EB    EC */
  141       0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
  142  /*28              SM    C2    EQ    AK    BL       */
  143       0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x2D, 0x2E, 0x2F,
  144  /*30              SY          PN    RS    UC    ET */
  145       0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,
  146  /*38                    C3    D4    NK          SU */
  147       0x38, 0x39, 0x3A, 0x3B, 0x3C, 0x3D, 0x3E, 0x3F,
  148  /*40  SP                                           */
  149       0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,
  150  /*48             CENT    .     <     (     +     | */
  151       0x48, 0x49, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F,
  152  /*50   &                                           */
  153       0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57,
  154  /*58               !     $     *     )     ;     ^ */
  155       0x58, 0x59, 0x5A, 0x5B, 0x5C, 0x5D, 0x5E, 0x5F,
  156  /*60   -     /                                     */
  157       0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
  158  /*68               |     ,     %     _     >     ? */
  159       0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F,
  160  /*70                                               */
  161       0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
  162  /*78         `     :     #     @     '     =     " */
  163       0x78, 0x79, 0x7A, 0x7B, 0x7C, 0x7D, 0x7E, 0x7F,
  164  /*80         a     b     c     d     e     f     g */
  165       0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
  166  /*88   h     i           {                         */
  167       0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F,
  168  /*90         j     k     l     m     n     o     p */
  169       0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
  170  /*98   q     r           }                         */
  171       0x98, 0x99, 0x9A, 0x9B, 0x9C, 0x9D, 0x9E, 0x9F,
  172  /*A0         ~     s     t     u     v     w     x */
  173       0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,
  174  /*A8   y     z                       [             */
  175       0xA8, 0xA9, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF,
  176  /*B0                                               */
  177       0xB0, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7,
  178  /*B8                                 ]             */
  179       0xB8, 0xB9, 0xBA, 0xBB, 0xBC, 0xBD, 0xBE, 0xBF,
  180  /*C0   {     A     B     C     D     E     F     G */
  181       0xC0, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
  182  /*C8   H     I                                     */
  183       0x88, 0x89, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF,
  184  /*D0   }     J     K     L     M     N     O     P */
  185       0xD0, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
  186  /*D8   Q     R                                     */
  187       0x98, 0x99, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF,
  188  /*E0   \           S     T     U     V     W     X */
  189       0xE0, 0xE1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,
  190  /*E8   Y     Z                                     */
  191       0xA8, 0xA9, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF,
  192  /*F0   0     1     2     3     4     5     6     7 */
  193       0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,
  194  /*F8   8     9                                     */
  195       0xF8, 0xF9, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF
  196 };
  197 #else
  198 #include "You lose. You will need a translation table for your character set."
  199 #endif
  200 
  201 #undef C
  202 
  203 /* load_casetable --- for a non-ASCII locale, redo the table */
  204 
  205 void
  206 load_casetable(void)
  207 {
  208 #if defined(LC_CTYPE)
  209     int i;
  210     static bool loaded = false;
  211 
  212     if (loaded || do_traditional)
  213         return;
  214 
  215     loaded = true;
  216 
  217 #ifndef USE_EBCDIC
  218     /* use of isalpha is ok here (see is_alpha in awkgram.y) */
  219     for (i = 0200; i <= 0377; i++) {
  220         if (isalpha(i) && islower(i) && i != toupper(i))
  221             casetable[i] = toupper(i);
  222         else
  223             casetable[i] = i;
  224     }
  225 #endif
  226 #endif
  227 }
  228 
  229 /*
  230  * This table maps node types to strings for debugging.
  231  * KEEP IN SYNC WITH awk.h!!!!
  232  */
  233 
  234 static const char *const nodetypes[] = {
  235     "Node_illegal",
  236     "Node_val",
  237     "Node_regex",
  238     "Node_dynregex",
  239     "Node_var",
  240     "Node_var_array",
  241     "Node_var_new",
  242     "Node_param_list",
  243     "Node_func",
  244     "Node_ext_func",
  245     "Node_builtin_func",
  246     "Node_array_ref",
  247     "Node_array_tree",
  248     "Node_array_leaf",
  249     "Node_dump_array",
  250     "Node_arrayfor",
  251     "Node_frame",
  252     "Node_instruction",
  253     "Node_final --- this should never appear",
  254     NULL
  255 };
  256 
  257 
  258 /*
  259  * This table maps Op codes to strings.
  260  * KEEP IN SYNC WITH awk.h!!!!
  261  */
  262 
  263 static struct optypetab {
  264     char *desc;
  265     char *operator;
  266 } optypes[] = {
  267     { "Op_illegal", NULL },
  268     { "Op_times", " * " },
  269     { "Op_times_i", " * " },
  270     { "Op_quotient", " / " },
  271     { "Op_quotient_i", " / " },
  272     { "Op_mod", " % " },
  273     { "Op_mod_i", " % " },
  274     { "Op_plus", " + " },
  275     { "Op_plus_i", " + " },
  276     { "Op_minus", " - " },
  277     { "Op_minus_i", " - " },
  278     { "Op_exp", " ^ " },
  279     { "Op_exp_i", " ^ " },
  280     { "Op_concat", " " },
  281     { "Op_line_range", NULL },
  282     { "Op_cond_pair", ", " },
  283     { "Op_subscript", "[]" },
  284     { "Op_sub_array", "[]" },
  285     { "Op_preincrement", "++" },
  286     { "Op_predecrement", "--" },
  287     { "Op_postincrement", "++" },
  288     { "Op_postdecrement", "--" },
  289     { "Op_unary_minus", "-" },
  290     { "Op_unary_plus", "+" },
  291     { "Op_field_spec", "$" },
  292     { "Op_not", "! " },
  293     { "Op_assign", " = " },
  294     { "Op_store_var", " = " },
  295     { "Op_store_sub", " = " },
  296     { "Op_store_field", " = " },
  297     { "Op_assign_times", " *= " },
  298     { "Op_assign_quotient", " /= " },
  299     { "Op_assign_mod", " %= " },
  300     { "Op_assign_plus", " += " },
  301     { "Op_assign_minus", " -= " },
  302     { "Op_assign_exp", " ^= " },
  303     { "Op_assign_concat", " " },
  304     { "Op_and", " && " },
  305     { "Op_and_final", NULL },
  306     { "Op_or", " || " },
  307     { "Op_or_final", NULL },
  308     { "Op_equal", " == " },
  309     { "Op_notequal", " != " },
  310     { "Op_less", " < " },
  311     { "Op_greater", " > " },
  312     { "Op_leq", " <= " },
  313     { "Op_geq", " >= " },
  314     { "Op_match", " ~ " },
  315     { "Op_match_rec", NULL },
  316     { "Op_nomatch", " !~ " },
  317     { "Op_rule", NULL },
  318     { "Op_K_case", "case" },
  319     { "Op_K_default", "default" },
  320     { "Op_K_break", "break" },
  321     { "Op_K_continue", "continue" },
  322     { "Op_K_print", "print" },
  323     { "Op_K_print_rec", "print" },
  324     { "Op_K_printf", "printf" },
  325     { "Op_K_next", "next" },
  326     { "Op_K_exit", "exit" },
  327     { "Op_K_return", "return" },
  328     { "Op_K_return_from_eval", "return" },
  329     { "Op_K_delete", "delete" },
  330     { "Op_K_delete_loop", NULL },
  331     { "Op_K_getline_redir", "getline" },
  332     { "Op_K_getline", "getline" },
  333     { "Op_K_nextfile", "nextfile" },
  334     { "Op_K_namespace", "@namespace" },
  335     { "Op_builtin", NULL },
  336     { "Op_sub_builtin", NULL },
  337     { "Op_ext_builtin", NULL },
  338     { "Op_in_array", " in " },
  339     { "Op_func_call", NULL },
  340     { "Op_indirect_func_call", NULL },
  341     { "Op_push", NULL },
  342     { "Op_push_arg", NULL },
  343     { "Op_push_arg_untyped", NULL },
  344     { "Op_push_i", NULL },
  345     { "Op_push_re", NULL },
  346     { "Op_push_array", NULL },
  347     { "Op_push_param", NULL },
  348     { "Op_push_lhs", NULL },
  349     { "Op_subscript_lhs", "[]" },
  350     { "Op_field_spec_lhs", "$" },
  351     { "Op_no_op", NULL },
  352     { "Op_pop", NULL },
  353     { "Op_jmp", NULL },
  354     { "Op_jmp_true", NULL },
  355     { "Op_jmp_false", NULL },
  356     { "Op_get_record", NULL },
  357     { "Op_newfile", NULL },
  358     { "Op_arrayfor_init", NULL },
  359     { "Op_arrayfor_incr", NULL },
  360     { "Op_arrayfor_final", NULL },
  361     { "Op_var_update", NULL },
  362     { "Op_var_assign", NULL },
  363     { "Op_field_assign", NULL },
  364     { "Op_subscript_assign", NULL },
  365     { "Op_after_beginfile", NULL },
  366     { "Op_after_endfile", NULL },
  367     { "Op_func", NULL },
  368     { "Op_comment", NULL },
  369     { "Op_exec_count", NULL },
  370     { "Op_breakpoint", NULL },
  371     { "Op_lint", NULL },
  372     { "Op_atexit", NULL },
  373     { "Op_stop", NULL },
  374     { "Op_token", NULL },
  375     { "Op_symbol", NULL },
  376     { "Op_list", NULL },
  377     { "Op_K_do", "do" },
  378     { "Op_K_for", "for" },
  379     { "Op_K_arrayfor", "for" },
  380     { "Op_K_while", "while" },
  381     { "Op_K_switch", "switch" },
  382     { "Op_K_if", "if" },
  383     { "Op_K_else", "else" },
  384     { "Op_K_function", "function" },
  385     { "Op_cond_exp", NULL },
  386     { "Op_parens", NULL },
  387     { "Op_final --- this should never appear", NULL },
  388     { NULL, NULL },
  389 };
  390 
  391 /* nodetype2str --- convert a node type into a printable value */
  392 
  393 const char *
  394 nodetype2str(NODETYPE type)
  395 {
  396     static char buf[40];
  397 
  398     if (type >= Node_illegal && type <= Node_final)
  399         return nodetypes[(int) type];
  400 
  401     sprintf(buf, _("unknown nodetype %d"), (int) type);
  402     return buf;
  403 }
  404 
  405 /* opcode2str --- convert an opcode type into a printable value */
  406 
  407 const char *
  408 opcode2str(OPCODE op)
  409 {
  410     if (op >= Op_illegal && op < Op_final)
  411         return optypes[(int) op].desc;
  412     fatal(_("unknown opcode %d"), (int) op);
  413     return NULL;
  414 }
  415 
  416 /* op2str --- convert an opcode type to corresponding operator or keyword */
  417 
  418 const char *
  419 op2str(OPCODE op)
  420 {
  421     if (op >= Op_illegal && op < Op_final) {
  422         if (optypes[(int) op].operator != NULL)
  423             return optypes[(int) op].operator;
  424         else
  425             fatal(_("opcode %s not an operator or keyword"),
  426                     optypes[(int) op].desc);
  427     } else
  428         fatal(_("unknown opcode %d"), (int) op);
  429     return NULL;
  430 }
  431 
  432 
  433 /* flags2str --- make a flags value readable */
  434 
  435 const char *
  436 flags2str(int flagval)
  437 {
  438     static const struct flagtab values[] = {
  439         { MALLOC, "MALLOC" },
  440         { STRING, "STRING" },
  441         { STRCUR, "STRCUR" },
  442         { NUMCUR, "NUMCUR" },
  443         { NUMBER, "NUMBER" },
  444         { USER_INPUT, "USER_INPUT" },
  445         { INTLSTR, "INTLSTR" },
  446         { NUMINT, "NUMINT" },
  447         { INTIND, "INTIND" },
  448         { WSTRCUR, "WSTRCUR" },
  449         { MPFN, "MPFN" },
  450         { MPZN, "MPZN" },
  451         { NO_EXT_SET, "NO_EXT_SET" },
  452         { NULL_FIELD, "NULL_FIELD" },
  453         { ARRAYMAXED, "ARRAYMAXED" },
  454         { HALFHAT, "HALFHAT" },
  455         { XARRAY, "XARRAY" },
  456         { NUMCONSTSTR, "NUMCONSTSTR" },
  457         { REGEX, "REGEX" },
  458         { 0,    NULL },
  459     };
  460 
  461     return genflags2str(flagval, values);
  462 }
  463 
  464 /* genflags2str --- general routine to convert a flag value to a string */
  465 
  466 const char *
  467 genflags2str(int flagval, const struct flagtab *tab)
  468 {
  469     static char buffer[BUFSIZ];
  470     char *sp;
  471     int i, space_left, space_needed;
  472 
  473     sp = buffer;
  474     space_left = BUFSIZ;
  475     for (i = 0; tab[i].name != NULL; i++) {
  476         if ((flagval & tab[i].val) != 0) {
  477             /*
  478              * note the trick, we want 1 or 0 for whether we need
  479              * the '|' character.
  480              */
  481             space_needed = (strlen(tab[i].name) + (sp != buffer));
  482             if (space_left <= space_needed)
  483                 fatal(_("buffer overflow in genflags2str"));
  484 
  485             if (sp != buffer) {
  486                 *sp++ = '|';
  487                 space_left--;
  488             }
  489             strcpy(sp, tab[i].name);
  490             /* note ordering! */
  491             space_left -= strlen(sp);
  492             sp += strlen(sp);
  493         }
  494     }
  495 
  496     *sp = '\0';
  497     return buffer;
  498 }
  499 
  500 /* posix_compare --- compare strings using strcoll */
  501 
  502 static int
  503 posix_compare(NODE *s1, NODE *s2)
  504 {
  505     int ret = 0;
  506     char save1, save2;
  507     size_t l = 0;
  508 
  509     save1 = s1->stptr[s1->stlen];
  510     s1->stptr[s1->stlen] = '\0';
  511 
  512     save2 = s2->stptr[s2->stlen];
  513     s2->stptr[s2->stlen] = '\0';
  514 
  515     if (gawk_mb_cur_max == 1) {
  516         if (strlen(s1->stptr) == s1->stlen && strlen(s2->stptr) == s2->stlen)
  517             ret = strcoll(s1->stptr, s2->stptr);
  518         else {
  519             char b1[2], b2[2];
  520             char *p1, *p2;
  521             size_t i;
  522 
  523             if (s1->stlen < s2->stlen)
  524                 l = s1->stlen;
  525             else
  526                 l = s2->stlen;
  527 
  528             b1[1] = b2[1] = '\0';
  529             for (i = ret = 0, p1 = s1->stptr, p2 = s2->stptr;
  530                  ret == 0 && i < l;
  531                  p1++, p2++) {
  532                 b1[0] = *p1;
  533                 b2[0] = *p2;
  534                 ret = strcoll(b1, b2);
  535             }
  536         }
  537         /*
  538          * Either worked through the strings or ret != 0.
  539          * In either case, ret will be the right thing to return.
  540          */
  541     }
  542 #if ! defined(__DJGPP__)
  543     else {
  544         /* Similar logic, using wide characters */
  545         (void) force_wstring(s1);
  546         (void) force_wstring(s2);
  547 
  548         if (wcslen(s1->wstptr) == s1->wstlen && wcslen(s2->wstptr) == s2->wstlen)
  549             ret = wcscoll(s1->wstptr, s2->wstptr);
  550         else {
  551             wchar_t b1[2], b2[2];
  552             wchar_t *p1, *p2;
  553             size_t i;
  554 
  555             if (s1->wstlen < s2->wstlen)
  556                 l = s1->wstlen;
  557             else
  558                 l = s2->wstlen;
  559 
  560             b1[1] = b2[1] = L'\0';
  561             for (i = ret = 0, p1 = s1->wstptr, p2 = s2->wstptr;
  562                  ret == 0 && i < l;
  563                  p1++, p2++) {
  564                 b1[0] = *p1;
  565                 b2[0] = *p2;
  566                 ret = wcscoll(b1, b2);
  567             }
  568         }
  569         /*
  570          * Either worked through the strings or ret != 0.
  571          * In either case, ret will be the right thing to return.
  572          */
  573     }
  574 #endif
  575 
  576     s1->stptr[s1->stlen] = save1;
  577     s2->stptr[s2->stlen] = save2;
  578     return ret;
  579 }
  580 
  581 
  582 /* cmp_nodes --- compare two nodes, returning negative, 0, positive */
  583 
  584 int
  585 cmp_nodes(NODE *t1, NODE *t2, bool use_strcmp)
  586 {
  587     int ret = 0;
  588     size_t len1, len2;
  589     int l, ldiff;
  590 
  591     if (t1 == t2)
  592         return 0;
  593 
  594     (void) fixtype(t1);
  595     (void) fixtype(t2);
  596 
  597     if ((t1->flags & NUMBER) != 0 && (t2->flags & NUMBER) != 0)
  598         return cmp_numbers(t1, t2);
  599 
  600     (void) force_string(t1);
  601     (void) force_string(t2);
  602     len1 = t1->stlen;
  603     len2 = t2->stlen;
  604     ldiff = len1 - len2;
  605     if (len1 == 0 || len2 == 0)
  606         return ldiff;
  607 
  608     if (do_posix && ! use_strcmp)
  609         return posix_compare(t1, t2);
  610 
  611     l = (ldiff <= 0 ? len1 : len2);
  612     if (IGNORECASE) {
  613         const unsigned char *cp1 = (const unsigned char *) t1->stptr;
  614         const unsigned char *cp2 = (const unsigned char *) t2->stptr;
  615         char save1 = t1->stptr[t1->stlen];
  616         char save2 = t2->stptr[t2->stlen];
  617 
  618 
  619         if (gawk_mb_cur_max > 1) {
  620             t1->stptr[t1->stlen] = t2->stptr[t2->stlen] = '\0';
  621             ret = strncasecmpmbs((const unsigned char *) cp1,
  622                          (const unsigned char *) cp2, l);
  623             t1->stptr[t1->stlen] = save1;
  624             t2->stptr[t2->stlen] = save2;
  625         } else {
  626             /* Could use tolower() here; see discussion above. */
  627             for (ret = 0; l-- > 0 && ret == 0; cp1++, cp2++)
  628                 ret = casetable[*cp1] - casetable[*cp2];
  629         }
  630     } else
  631         ret = memcmp(t1->stptr, t2->stptr, l);
  632 
  633     ret = ret == 0 ? ldiff : ret;
  634     return ret;
  635 }
  636 
  637 /* push_frame --- push a frame NODE onto stack */
  638 
  639 static void
  640 push_frame(NODE *f)
  641 {
  642     static long max_fcall;
  643 
  644     /* NB: frame numbering scheme as in GDB. frame_ptr => frame #0. */
  645 
  646     fcall_count++;
  647     if (fcall_list == NULL) {
  648         max_fcall = 10;
  649         emalloc(fcall_list, NODE **, (max_fcall + 1) * sizeof(NODE *), "push_frame");
  650     } else if (fcall_count == max_fcall) {
  651         max_fcall *= 2;
  652         erealloc(fcall_list, NODE **, (max_fcall + 1) * sizeof(NODE *), "push_frame");
  653     }
  654 
  655     if (fcall_count > 1)
  656         memmove(fcall_list + 2, fcall_list + 1, (fcall_count - 1) * sizeof(NODE *));
  657     fcall_list[1] = f;
  658 }
  659 
  660 
  661 /* pop_frame --- pop off a frame NODE*/
  662 
  663 static void
  664 pop_frame()
  665 {
  666     if (fcall_count > 1)
  667         memmove(fcall_list + 1, fcall_list + 2, (fcall_count - 1) * sizeof(NODE *));
  668     fcall_count--;
  669     assert(fcall_count >= 0);
  670     if (do_debug)
  671         frame_popped();
  672 }
  673 
  674 
  675 /* dump_fcall_stack --- print a backtrace of the awk function calls */
  676 
  677 void
  678 dump_fcall_stack(FILE *fp)
  679 {
  680     NODE *f, *func;
  681     long i = 0, k = 0;
  682 
  683     if (fcall_count == 0)
  684         return;
  685     fprintf(fp, _("\n\t# Function Call Stack:\n\n"));
  686 
  687     /* current frame */
  688     func = frame_ptr->func_node;
  689     fprintf(fp, "\t# %3ld. %s\n", k++, func->vname);
  690 
  691     /* outer frames except main */
  692     for (i = 1; i < fcall_count; i++) {
  693         f = fcall_list[i];
  694         func = f->func_node;
  695         fprintf(fp, "\t# %3ld. %s\n", k++, func->vname);
  696     }
  697 
  698     fprintf(fp, "\t# %3ld. -- main --\n", k);
  699 }
  700 
  701 
  702 /* set_IGNORECASE --- update IGNORECASE as appropriate */
  703 
  704 void
  705 set_IGNORECASE()
  706 {
  707     static bool warned = false;
  708 
  709     if ((do_lint_extensions || do_traditional) && ! warned) {
  710         warned = true;
  711         lintwarn(_("`IGNORECASE' is a gawk extension"));
  712     }
  713 
  714     if (do_traditional)
  715         IGNORECASE = false;
  716     else
  717         IGNORECASE = boolval(IGNORECASE_node->var_value);
  718     set_RS();   /* set_RS() calls set_FS() if need be, for us */
  719 }
  720 
  721 /* set_BINMODE --- set translation mode (OS/2, DOS, others) */
  722 
  723 void
  724 set_BINMODE()
  725 {
  726     static bool warned = false;
  727     char *p;
  728     NODE *v = fixtype(BINMODE_node->var_value);
  729 
  730     if ((do_lint_extensions || do_traditional) && ! warned) {
  731         warned = true;
  732         lintwarn(_("`BINMODE' is a gawk extension"));
  733     }
  734     if (do_traditional)
  735         BINMODE = TEXT_TRANSLATE;
  736     else if ((v->flags & NUMBER) != 0) {
  737         BINMODE = get_number_si(v);
  738         /* Make sure the value is rational. */
  739         if (BINMODE < TEXT_TRANSLATE)
  740             BINMODE = TEXT_TRANSLATE;
  741         else if (BINMODE > BINMODE_BOTH)
  742             BINMODE = BINMODE_BOTH;
  743     } else if ((v->flags & STRING) != 0) {
  744         p = v->stptr;
  745 
  746         /*
  747          * Allow only one of the following:
  748          * "0", "1", "2", "3",
  749          * "r", "w", "rw", "wr"
  750          * ANYTHING ELSE goes to 3. So there.
  751          */
  752         switch (v->stlen) {
  753         case 1:
  754             switch (p[0]) {
  755             case '0':
  756             case '1':
  757             case '2':
  758             case '3':
  759                 BINMODE = p[0] - '0';
  760                 break;
  761             case 'r':
  762                 BINMODE = BINMODE_INPUT;
  763                 break;
  764             case 'w':
  765                 BINMODE = BINMODE_OUTPUT;
  766                 break;
  767             default:
  768                 BINMODE = BINMODE_BOTH;
  769                 goto bad_value;
  770                 break;
  771             }
  772             break;
  773         case 2:
  774             switch (p[0]) {
  775             case 'r':
  776                 BINMODE = BINMODE_BOTH;
  777                 if (p[1] != 'w')
  778                     goto bad_value;
  779                 break;
  780             case 'w':
  781                 BINMODE = BINMODE_BOTH;
  782                 if (p[1] != 'r')
  783                     goto bad_value;
  784                 break;
  785             }
  786             break;
  787         default:
  788     bad_value:
  789             lintwarn(_("BINMODE value `%s' is invalid, treated as 3"), p);
  790             break;
  791         }
  792     } else
  793         BINMODE = 3;        /* shouldn't happen */
  794 }
  795 
  796 /* set_OFS --- update OFS related variables when OFS assigned to */
  797 
  798 void
  799 set_OFS()
  800 {
  801     static bool first = true;
  802     size_t new_ofs_len;
  803 
  804     if (first)  /* true when called from init_vars() in main() */
  805         first = false;
  806     else {
  807         /* rebuild $0 using OFS that was current when $0 changed */
  808         if (! field0_valid) {
  809             get_field(UNLIMITED - 1, NULL);
  810             rebuild_record();
  811         }
  812     }
  813 
  814     /*
  815      * Save OFS value for use in building record and in printing.
  816      * Can't just have OFS point into the OFS_node since it's
  817      * already updated when we come into this routine, and we need
  818      * the old value to rebuild the record (see above).
  819      */
  820     OFS_node->var_value = force_string(OFS_node->var_value);
  821     new_ofs_len = OFS_node->var_value->stlen;
  822 
  823     if (OFS == NULL)
  824         emalloc(OFS, char *, new_ofs_len + 1, "set_OFS");
  825     else if (OFSlen < new_ofs_len)
  826         erealloc(OFS, char *, new_ofs_len + 1, "set_OFS");
  827 
  828     memcpy(OFS, OFS_node->var_value->stptr, OFS_node->var_value->stlen);
  829     OFSlen = new_ofs_len;
  830     OFS[OFSlen] = '\0';
  831 }
  832 
  833 /* set_ORS --- update ORS related variables when ORS assigned to */
  834 
  835 void
  836 set_ORS()
  837 {
  838     ORS_node->var_value = force_string(ORS_node->var_value);
  839     ORS = ORS_node->var_value->stptr;
  840     ORSlen = ORS_node->var_value->stlen;
  841 }
  842 
  843 /* fmt_ok --- is the conversion format a valid one? */
  844 
  845 NODE **fmt_list = NULL;
  846 static int fmt_ok(NODE *n);
  847 static int fmt_index(NODE *n);
  848 
  849 static int
  850 fmt_ok(NODE *n)
  851 {
  852     NODE *tmp = force_string(n);
  853     const char *p = tmp->stptr;
  854 
  855 #if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1
  856     static const char float_formats[] = "efgEG";
  857 #else
  858     static const char float_formats[] = "efgEFG";
  859 #endif
  860 #if defined(HAVE_LOCALE_H)
  861     static const char flags[] = " +-#'";
  862 #else
  863     static const char flags[] = " +-#";
  864 #endif
  865 
  866     // We rely on the caller to zero-terminate n->stptr.
  867 
  868     if (*p++ != '%')
  869         return 0;
  870     while (*p && strchr(flags, *p) != NULL) /* flags */
  871         p++;
  872     while (*p && isdigit((unsigned char) *p))   /* width - %*.*g is NOT allowed */
  873         p++;
  874     if (*p == '\0' || (*p != '.' && ! isdigit((unsigned char) *p)))
  875         return 0;
  876     if (*p == '.')
  877         p++;
  878     while (*p && isdigit((unsigned char) *p))   /* precision */
  879         p++;
  880     if (*p == '\0' || strchr(float_formats, *p) == NULL)
  881         return 0;
  882     if (*++p != '\0')
  883         return 0;
  884     return 1;
  885 }
  886 
  887 /* fmt_index --- track values of OFMT and CONVFMT to keep semantics correct */
  888 
  889 static int
  890 fmt_index(NODE *n)
  891 {
  892     int ix = 0;
  893     static int fmt_num = 4;
  894     static int fmt_hiwater = 0;
  895     char save;
  896 
  897     if (fmt_list == NULL)
  898         emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
  899     n = force_string(n);
  900 
  901     save = n->stptr[n->stlen];
  902     n->stptr[n->stlen] = '\0';
  903 
  904     while (ix < fmt_hiwater) {
  905         if (cmp_nodes(fmt_list[ix], n, true) == 0)
  906             return ix;
  907         ix++;
  908     }
  909 
  910     /* not found */
  911     if (do_lint && ! fmt_ok(n))
  912         lintwarn(_("bad `%sFMT' specification `%s'"),
  913                 n == CONVFMT_node->var_value ? "CONV"
  914               : n == OFMT_node->var_value ? "O"
  915               : "", n->stptr);
  916 
  917     n->stptr[n->stlen] = save;
  918 
  919     if (fmt_hiwater >= fmt_num) {
  920         fmt_num *= 2;
  921         erealloc(fmt_list, NODE **, fmt_num * sizeof(*fmt_list), "fmt_index");
  922     }
  923     fmt_list[fmt_hiwater] = dupnode(n);
  924     return fmt_hiwater++;
  925 }
  926 
  927 /* set_OFMT --- track OFMT correctly */
  928 
  929 void
  930 set_OFMT()
  931 {
  932     OFMTidx = fmt_index(OFMT_node->var_value);
  933     OFMT = fmt_list[OFMTidx]->stptr;
  934 }
  935 
  936 /* set_CONVFMT --- track CONVFMT correctly */
  937 
  938 void
  939 set_CONVFMT()
  940 {
  941     CONVFMTidx = fmt_index(CONVFMT_node->var_value);
  942     CONVFMT = fmt_list[CONVFMTidx]->stptr;
  943 }
  944 
  945 /* set_LINT --- update LINT as appropriate */
  946 
  947 void
  948 set_LINT()
  949 {
  950 #ifndef NO_LINT
  951     int old_lint = do_lint;
  952     NODE *n = fixtype(LINT_node->var_value);
  953 
  954     /* start with clean defaults */
  955     lintfunc = r_warning;
  956     do_flags &= ~(DO_LINT_ALL|DO_LINT_INVALID);
  957 
  958     if ((n->flags & STRING) != 0) {
  959         const char *lintval;
  960         size_t lintlen;
  961 
  962         lintval = n->stptr;
  963         lintlen = n->stlen;
  964         if (lintlen > 0) {
  965             if (lintlen == 7 && strncmp(lintval, "invalid", 7) == 0)
  966                 do_flags |= DO_LINT_INVALID;
  967             else if (lintlen == 6 && strncmp(lintval, "no-ext", 6) == 0)
  968                 do_flags &= ~DO_LINT_EXTENSIONS;
  969             else {
  970                 do_flags |= DO_LINT_ALL;
  971                 if (lintlen == 5 && strncmp(lintval, "fatal", 5) == 0)
  972                     lintfunc = r_fatal;
  973             }
  974         }
  975     } else {
  976         if (! iszero(n))
  977             do_flags |= DO_LINT_ALL;
  978     }
  979 
  980     /* explicitly use warning() here, in case lintfunc == r_fatal */
  981     if (old_lint != do_lint && old_lint && ! do_lint)
  982         warning(_("turning off `--lint' due to assignment to `LINT'"));
  983 
  984     /* inform plug-in api of change */
  985     update_ext_api();
  986 #endif /* ! NO_LINT */
  987 }
  988 
  989 /* set_TEXTDOMAIN --- update TEXTDOMAIN variable when TEXTDOMAIN assigned to */
  990 
  991 void
  992 set_TEXTDOMAIN()
  993 {
  994     NODE *tmp;
  995 
  996     tmp = TEXTDOMAIN_node->var_value = force_string(TEXTDOMAIN_node->var_value);
  997     TEXTDOMAIN = tmp->stptr;
  998     /*
  999      * Note: don't call textdomain(); this value is for
 1000      * the awk program, not for gawk itself.
 1001      */
 1002 }
 1003 
 1004 /* update_ERRNO_int --- update the value of ERRNO based on argument */
 1005 
 1006 void
 1007 update_ERRNO_int(int errcode)
 1008 {
 1009     char *cp;
 1010 
 1011     update_PROCINFO_num("errno", errcode);
 1012     if (errcode) {
 1013         cp = strerror(errcode);
 1014         cp = gettext(cp);
 1015     } else
 1016         cp = "";
 1017     unref(ERRNO_node->var_value);
 1018     ERRNO_node->var_value = make_string(cp, strlen(cp));
 1019 }
 1020 
 1021 /* update_ERRNO_string --- update ERRNO */
 1022 
 1023 void
 1024 update_ERRNO_string(const char *string)
 1025 {
 1026     update_PROCINFO_num("errno", 0);
 1027     unref(ERRNO_node->var_value);
 1028     size_t len = strlen(string);
 1029 #if defined(USE_EBCDIC) && defined(ELIDE_IBM_ERROR_CODE)
 1030     // skip over leading IBM error code
 1031     // N.B. This code is untested
 1032     if (isupper(string[0]) && isupper(string[1])) {
 1033         while (*string && *string != ' ')
 1034             string++;
 1035 
 1036         while (*string && *string == ' ')
 1037             string++;
 1038 
 1039         len = strlen(string);
 1040         if (string[len-1] == '.')
 1041             len--;  // remove the final '.'
 1042     }
 1043 #endif
 1044     ERRNO_node->var_value = make_string(string, len);
 1045 }
 1046 
 1047 /* unset_ERRNO --- eliminate the value of ERRNO */
 1048 
 1049 void
 1050 unset_ERRNO(void)
 1051 {
 1052     update_PROCINFO_num("errno", 0);
 1053     unref(ERRNO_node->var_value);
 1054     ERRNO_node->var_value = dupnode(Nnull_string);
 1055 }
 1056 
 1057 /* update_NR --- update the value of NR */
 1058 
 1059 void
 1060 update_NR()
 1061 {
 1062 #ifdef HAVE_MPFR
 1063     if (is_mpg_number(NR_node->var_value))
 1064         (void) mpg_update_var(NR_node);
 1065     else
 1066 #endif
 1067     if (NR_node->var_value->numbr != NR) {
 1068         unref(NR_node->var_value);
 1069         NR_node->var_value = make_number(NR);
 1070     }
 1071 }
 1072 
 1073 /* update_NF --- update the value of NF */
 1074 
 1075 void
 1076 update_NF()
 1077 {
 1078     long l;
 1079 
 1080     l = get_number_si(NF_node->var_value);
 1081     if (NF == -1 || l != NF) {
 1082         if (NF == -1)
 1083             (void) get_field(UNLIMITED - 1, NULL); /* parse record */
 1084         unref(NF_node->var_value);
 1085         NF_node->var_value = make_number(NF);
 1086     }
 1087 }
 1088 
 1089 /* update_FNR --- update the value of FNR */
 1090 
 1091 void
 1092 update_FNR()
 1093 {
 1094 #ifdef HAVE_MPFR
 1095     if (is_mpg_number(FNR_node->var_value))
 1096         (void) mpg_update_var(FNR_node);
 1097     else
 1098 #endif
 1099     if (FNR_node->var_value->numbr != FNR) {
 1100         unref(FNR_node->var_value);
 1101         FNR_node->var_value = make_number(FNR);
 1102     }
 1103 }
 1104 
 1105 
 1106 NODE *frame_ptr;        /* current frame */
 1107 STACK_ITEM *stack_ptr = NULL;
 1108 STACK_ITEM *stack_bottom;
 1109 STACK_ITEM *stack_top;
 1110 static unsigned long STACK_SIZE = 256;    /* initial size of stack */
 1111 int max_args = 0;       /* maximum # of arguments to printf, print, sprintf,
 1112                          * or # of array subscripts, or adjacent strings
 1113                          * to be concatenated.
 1114                          */
 1115 NODE **args_array = NULL;
 1116 
 1117 /* grow_stack --- grow the size of runtime stack */
 1118 
 1119 /* N.B. stack_ptr points to the topmost occupied location
 1120  *      on the stack, not the first free location.
 1121  */
 1122 
 1123 STACK_ITEM *
 1124 grow_stack()
 1125 {
 1126     STACK_SIZE *= 2;
 1127     erealloc(stack_bottom, STACK_ITEM *, STACK_SIZE * sizeof(STACK_ITEM), "grow_stack");
 1128     stack_top = stack_bottom + STACK_SIZE - 1;
 1129     stack_ptr = stack_bottom + STACK_SIZE / 2;
 1130     return stack_ptr;
 1131 }
 1132 
 1133 /*
 1134  * r_get_lhs:
 1135  * This returns a POINTER to a node pointer (var's value).
 1136  * used to store the var's new value.
 1137  */
 1138 
 1139 NODE **
 1140 r_get_lhs(NODE *n, bool reference)
 1141 {
 1142     bool isparam = false;
 1143 
 1144     if (n->type == Node_param_list) {
 1145         isparam = true;
 1146         n = GET_PARAM(n->param_cnt);
 1147     }
 1148 
 1149     switch (n->type) {
 1150     case Node_var_array:
 1151         fatal(_("attempt to use array `%s' in a scalar context"),
 1152                 array_vname(n));
 1153     case Node_array_ref:
 1154         if (n->orig_array->type == Node_var_array)
 1155             fatal(_("attempt to use array `%s' in a scalar context"),
 1156                     array_vname(n));
 1157         if (n->orig_array->type != Node_var) {
 1158             n->orig_array->type = Node_var;
 1159             n->orig_array->var_value = dupnode(Nnull_string);
 1160         }
 1161         /* fall through */
 1162     case Node_var_new:
 1163         n->type = Node_var;
 1164         n->var_value = dupnode(Nnull_string);
 1165         break;
 1166 
 1167     case Node_var:
 1168         break;
 1169 
 1170     default:
 1171         cant_happen();
 1172     }
 1173 
 1174     if (do_lint && reference && var_uninitialized(n))
 1175         lintwarn((isparam ?
 1176             _("reference to uninitialized argument `%s'") :
 1177             _("reference to uninitialized variable `%s'")),
 1178                 n->vname);
 1179     return & n->var_value;
 1180 }
 1181 
 1182 
 1183 /* r_get_field --- get the address of a field node */
 1184 
 1185 NODE **
 1186 r_get_field(NODE *n, Func_ptr *assign, bool reference)
 1187 {
 1188     long field_num;
 1189     NODE **lhs;
 1190 
 1191     if (assign)
 1192         *assign = NULL;
 1193     if (do_lint) {
 1194         if ((fixtype(n)->flags & NUMBER) == 0) {
 1195             lintwarn(_("attempt to field reference from non-numeric value"));
 1196             if (n->stlen == 0)
 1197                 lintwarn(_("attempt to field reference from null string"));
 1198         }
 1199     }
 1200 
 1201     (void) force_number(n);
 1202     field_num = get_number_si(n);
 1203 
 1204     if (field_num < 0)
 1205         fatal(_("attempt to access field %ld"), field_num);
 1206 
 1207     if (field_num == 0 && field0_valid) {       /* short circuit */
 1208         lhs = &fields_arr[0];
 1209         if (assign)
 1210             *assign = reset_record;
 1211     } else
 1212         lhs = get_field(field_num, assign);
 1213     if (do_lint && reference && ((*lhs)->flags & NULL_FIELD) != 0)
 1214         lintwarn(_("reference to uninitialized field `$%ld'"),
 1215                   field_num);
 1216     return lhs;
 1217 }
 1218 
 1219 
 1220 /*
 1221  * calc_exp_posint --- calculate x^n for positive integral n,
 1222  * using exponentiation by squaring without recursion.
 1223  */
 1224 
 1225 static AWKNUM
 1226 calc_exp_posint(AWKNUM x, long n)
 1227 {
 1228     AWKNUM mult = 1;
 1229 
 1230     while (n > 1) {
 1231         if ((n % 2) == 1)
 1232             mult *= x;
 1233         x *= x;
 1234         n /= 2;
 1235     }
 1236     return mult * x;
 1237 }
 1238 
 1239 /* calc_exp --- calculate x1^x2 */
 1240 
 1241 AWKNUM
 1242 calc_exp(AWKNUM x1, AWKNUM x2)
 1243 {
 1244     long lx;
 1245 
 1246     if ((lx = x2) == x2) {      /* integer exponent */
 1247         if (lx == 0)
 1248             return 1;
 1249         return (lx > 0) ? calc_exp_posint(x1, lx)
 1250                 : 1.0 / calc_exp_posint(x1, -lx);
 1251     }
 1252     return (AWKNUM) pow((double) x1, (double) x2);
 1253 }
 1254 
 1255 
 1256 /* setup_frame --- setup new frame for function call */
 1257 
 1258 static INSTRUCTION *
 1259 setup_frame(INSTRUCTION *pc)
 1260 {
 1261     NODE *r = NULL;
 1262     NODE *m, *f, *fp;
 1263     NODE **sp = NULL;
 1264     int pcount, arg_count, i, j;
 1265 
 1266     f = pc->func_body;
 1267     pcount = f->param_cnt;
 1268     fp = f->fparms;
 1269     arg_count = (pc + 1)->expr_count;
 1270 
 1271     if (pcount > 0) {
 1272         ezalloc(sp, NODE **, pcount * sizeof(NODE *), "setup_frame");
 1273     }
 1274 
 1275     /* check for extra args */
 1276     if (arg_count > pcount) {
 1277         warning(
 1278             _("function `%s' called with more arguments than declared"),
 1279                 f->vname);
 1280         do {
 1281             r = POP();
 1282             if (r->type == Node_val)
 1283                 DEREF(r);
 1284         } while (--arg_count > pcount);
 1285     }
 1286 
 1287     for (i = 0, j = arg_count - 1; i < pcount; i++, j--) {
 1288         getnode(r);
 1289         memset(r, 0, sizeof(NODE));
 1290         sp[i] = r;
 1291 
 1292         if (i >= arg_count) {
 1293             /* local variable */
 1294             r->type = Node_var_new;
 1295             r->vname = fp[i].param;
 1296             continue;
 1297         }
 1298 
 1299         m = PEEK(j); /* arguments in reverse order on runtime stack */
 1300 
 1301         if (m->type == Node_param_list)
 1302             m = GET_PARAM(m->param_cnt);
 1303 
 1304         /* $0 needs to be passed by value to a function */
 1305         if (m == fields_arr[0]) {
 1306             DEREF(m);
 1307             m = dupnode(m);
 1308         }
 1309 
 1310         switch (m->type) {
 1311         case Node_var_new:
 1312         case Node_var_array:
 1313             r->type = Node_array_ref;
 1314             r->orig_array = r->prev_array = m;
 1315             break;
 1316 
 1317         case Node_array_ref:
 1318             r->type = Node_array_ref;
 1319             r->orig_array = m->orig_array;
 1320             r->prev_array = m;
 1321             break;
 1322 
 1323         case Node_var:
 1324             /* Untyped (Node_var_new) variable as param became a
 1325              * scalar during evaluation of expression for a
 1326              * subsequent param.
 1327              */
 1328             r->type = Node_var;
 1329             r->var_value = dupnode(Nnull_string);
 1330             break;
 1331 
 1332         case Node_val:
 1333             r->type = Node_var;
 1334             r->var_value = m;
 1335             break;
 1336 
 1337         default:
 1338             cant_happen();
 1339         }
 1340         r->vname = fp[i].param;
 1341     }
 1342 
 1343     stack_adj(-arg_count);  /* adjust stack pointer */
 1344 
 1345     if (pc->opcode == Op_indirect_func_call) {
 1346         r = POP();  /* indirect var */
 1347         DEREF(r);
 1348     }
 1349 
 1350     frame_ptr->vname = source;  /* save current source */
 1351 
 1352     if (do_profile || do_debug)
 1353         push_frame(frame_ptr);
 1354 
 1355     /* save current frame in stack */
 1356     PUSH(frame_ptr);
 1357 
 1358     /* setup new frame */
 1359     getnode(frame_ptr);
 1360     frame_ptr->type = Node_frame;
 1361     frame_ptr->stack = sp;
 1362     frame_ptr->prev_frame_size = (stack_ptr - stack_bottom); /* size of the previous stack frame */
 1363     frame_ptr->func_node = f;
 1364     frame_ptr->vname = NULL;
 1365     frame_ptr->reti = pc; /* on return execute pc->nexti */
 1366 
 1367     return f->code_ptr;
 1368 }
 1369 
 1370 
 1371 /* restore_frame --- clean up the stack and update frame */
 1372 
 1373 static INSTRUCTION *
 1374 restore_frame(NODE *fp)
 1375 {
 1376     NODE *r;
 1377     NODE **sp;
 1378     int n;
 1379     NODE *func;
 1380     INSTRUCTION *ri;
 1381 
 1382     func = frame_ptr->func_node;
 1383     n = func->param_cnt;
 1384     sp = frame_ptr->stack;
 1385 
 1386     for (; n > 0; n--) {
 1387         r = *sp++;
 1388         if (r->type == Node_var)     /* local variable */
 1389             DEREF(r->var_value);
 1390         else if (r->type == Node_var_array)     /* local array */
 1391             assoc_clear(r);
 1392         freenode(r);
 1393     }
 1394 
 1395     if (frame_ptr->stack != NULL)
 1396         efree(frame_ptr->stack);
 1397     ri = frame_ptr->reti;     /* execution in calling frame
 1398                                * resumes from ri->nexti.
 1399                                */
 1400     freenode(frame_ptr);
 1401     if (do_profile || do_debug)
 1402         pop_frame();
 1403 
 1404     /* restore frame */
 1405     frame_ptr = fp;
 1406     /* restore source */
 1407     source = fp->vname;
 1408     fp->vname = NULL;
 1409 
 1410     return ri->nexti;
 1411 }
 1412 
 1413 
 1414 /* free_arrayfor --- free 'for (var in array)' related data */
 1415 
 1416 static inline void
 1417 free_arrayfor(NODE *r)
 1418 {
 1419     if (r->for_list != NULL) {
 1420         NODE *n;
 1421         size_t num_elems = r->for_list_size;
 1422         NODE **list = r->for_list;
 1423         while (num_elems > 0) {
 1424             n = list[--num_elems];
 1425             unref(n);
 1426         }
 1427         efree(list);
 1428     }
 1429     freenode(r);
 1430 }
 1431 
 1432 
 1433 /*
 1434  * unwind_stack --- pop items off the run-time stack;
 1435  *  'n' is the # of items left in the stack.
 1436  */
 1437 
 1438 INSTRUCTION *
 1439 unwind_stack(long n)
 1440 {
 1441     NODE *r;
 1442     INSTRUCTION *cp = NULL;
 1443     STACK_ITEM *sp;
 1444 
 1445     if (stack_empty())
 1446         return NULL;
 1447 
 1448     sp = stack_bottom + n;
 1449 
 1450     if (stack_ptr < sp)
 1451         return NULL;
 1452 
 1453     while ((r = POP()) != NULL) {
 1454         switch (r->type) {
 1455         case Node_frame:
 1456             cp = restore_frame(r);
 1457             break;
 1458         case Node_arrayfor:
 1459             free_arrayfor(r);
 1460             break;
 1461         case Node_val:
 1462             DEREF(r);
 1463             break;
 1464         case Node_instruction:
 1465             freenode(r);
 1466             break;
 1467         default:
 1468             /*
 1469              * Check `exiting' and don't produce an error for
 1470              * cases like:
 1471              *  func     _fn0() { exit }
 1472              *  BEGIN { ARRAY[_fn0()] }
 1473              */
 1474             if (in_main_context() && ! exiting)
 1475                 fatal(_("unwind_stack: unexpected type `%s'"),
 1476                         nodetype2str(r->type));
 1477             /* else
 1478                 * Node_var_array,
 1479                 * Node_param_list,
 1480                 * Node_var (e.g: trying to use scalar for array)
 1481                 * Node_regex/Node_dynregex
 1482                 * ?
 1483              */
 1484             break;
 1485         }
 1486 
 1487         if (stack_ptr < sp)
 1488             break;
 1489     }
 1490     return cp;
 1491 }
 1492 
 1493 
 1494 /* pop_fcall --- pop off the innermost frame */
 1495 #define pop_fcall() unwind_stack(frame_ptr->prev_frame_size)
 1496 
 1497 /* pop the run-time stack */
 1498 #define pop_stack() (void) unwind_stack(0)
 1499 
 1500 
 1501 static inline bool
 1502 eval_condition(NODE *t)
 1503 {
 1504     if (t == node_Boolean[false])
 1505         return false;
 1506 
 1507     if (t == node_Boolean[true])
 1508         return true;
 1509 
 1510     return boolval(t);
 1511 }
 1512 
 1513 typedef enum {
 1514     SCALAR_EQ_NEQ,
 1515     SCALAR_RELATIONAL
 1516 } scalar_cmp_t;
 1517 
 1518 /* cmp_scalars -- compare two nodes on the stack */
 1519 
 1520 static inline int
 1521 cmp_scalars(scalar_cmp_t comparison_type)
 1522 {
 1523     NODE *t1, *t2;
 1524     int di;
 1525 
 1526     t2 = POP_SCALAR();
 1527     t1 = TOP();
 1528     if (t1->type == Node_var_array) {
 1529         DEREF(t2);
 1530         fatal(_("attempt to use array `%s' in a scalar context"), array_vname(t1));
 1531     }
 1532     di = cmp_nodes(t1, t2, comparison_type == SCALAR_EQ_NEQ);
 1533     DEREF(t1);
 1534     DEREF(t2);
 1535     return di;
 1536 }
 1537 
 1538 /* op_assign --- assignment operators excluding = */
 1539 
 1540 static void
 1541 op_assign(OPCODE op)
 1542 {
 1543     NODE **lhs;
 1544     NODE *t1, *t2;
 1545     AWKNUM x = 0.0, x1, x2;
 1546 
 1547     lhs = POP_ADDRESS();
 1548     t1 = *lhs;
 1549     x1 = force_number(t1)->numbr;
 1550 
 1551     t2 = TOP_SCALAR();
 1552     x2 = force_number(t2)->numbr;
 1553     DEREF(t2);
 1554 
 1555     switch (op) {
 1556     case Op_assign_plus:
 1557         x = x1 + x2;
 1558         break;
 1559     case Op_assign_minus:
 1560         x = x1 - x2;
 1561         break;
 1562     case Op_assign_times:
 1563         x = x1 * x2;
 1564         break;
 1565     case Op_assign_quotient:
 1566         if (x2 == (AWKNUM) 0) {
 1567             decr_sp();
 1568             fatal(_("division by zero attempted in `/='"));
 1569         }
 1570         x = x1 / x2;
 1571         break;
 1572     case Op_assign_mod:
 1573         if (x2 == (AWKNUM) 0) {
 1574             decr_sp();
 1575             fatal(_("division by zero attempted in `%%='"));
 1576         }
 1577 #ifdef HAVE_FMOD
 1578         x = fmod(x1, x2);
 1579 #else   /* ! HAVE_FMOD */
 1580         (void) modf(x1 / x2, &x);
 1581         x = x1 - x2 * x;
 1582 #endif  /* ! HAVE_FMOD */
 1583         break;
 1584     case Op_assign_exp:
 1585         x = calc_exp((double) x1, (double) x2);
 1586         break;
 1587     default:
 1588         break;
 1589     }
 1590 
 1591     if (t1->valref == 1 && t1->flags == (MALLOC|NUMCUR|NUMBER)) {
 1592         /* optimization */
 1593         t1->numbr = x;
 1594     } else {
 1595         unref(t1);
 1596         t1 = *lhs = make_number(x);
 1597     }
 1598 
 1599     UPREF(t1);
 1600     REPLACE(t1);
 1601 }
 1602 
 1603 /* PUSH_CODE --- push a code onto the runtime stack */
 1604 
 1605 void
 1606 PUSH_CODE(INSTRUCTION *cp)
 1607 {
 1608     NODE *r;
 1609     getnode(r);
 1610     r->type = Node_instruction;
 1611     r->code_ptr = cp;
 1612     PUSH(r);
 1613 }
 1614 
 1615 /* POP_CODE --- pop a code off the runtime stack */
 1616 
 1617 INSTRUCTION *
 1618 POP_CODE()
 1619 {
 1620     NODE *r;
 1621     INSTRUCTION *cp;
 1622     r = POP();
 1623     cp = r->code_ptr;
 1624     freenode(r);
 1625     return cp;
 1626 }
 1627 
 1628 
 1629 /*
 1630  * Implementation of BEGINFILE and ENDFILE requires saving an execution
 1631  * state and the ability to return to that state. The state is
 1632  * defined by the instruction triggering the BEGINFILE/ENDFILE rule, the
 1633  * run-time stack, the rule and the source file. The source line is available in
 1634  * the instruction and hence is not considered a part of the execution state.
 1635  */
 1636 
 1637 
 1638 typedef struct exec_state {
 1639     struct exec_state *next;
 1640 
 1641     INSTRUCTION *cptr;  /* either getline (Op_K_getline) or the
 1642                          * implicit "open-file, read-record" loop (Op_newfile).
 1643                          */
 1644 
 1645     int rule;           /* rule for the INSTRUCTION */
 1646 
 1647     long stack_size;    /* For this particular usage, it is sufficient to save
 1648                          * only the size of the call stack. We do not
 1649                          * store the actual stack pointer to avoid problems
 1650                          * in case the stack gets realloc-ed.
 1651                          */
 1652 
 1653     const char *source; /* source file for the INSTRUCTION */
 1654 } EXEC_STATE;
 1655 
 1656 static EXEC_STATE exec_state_stack;
 1657 
 1658 /* push_exec_state --- save an execution state on stack */
 1659 
 1660 static void
 1661 push_exec_state(INSTRUCTION *cp, int rule, char *src, STACK_ITEM *sp)
 1662 {
 1663     EXEC_STATE *es;
 1664 
 1665     emalloc(es, EXEC_STATE *, sizeof(EXEC_STATE), "push_exec_state");
 1666     es->rule = rule;
 1667     es->cptr = cp;
 1668     es->stack_size = (sp - stack_bottom) + 1;
 1669     es->source = src;
 1670     es->next = exec_state_stack.next;
 1671     exec_state_stack.next = es;
 1672 }
 1673 
 1674 
 1675 /* pop_exec_state --- pop one execution state off the stack */
 1676 
 1677 static INSTRUCTION *
 1678 pop_exec_state(int *rule, char **src, long *sz)
 1679 {
 1680     INSTRUCTION *cp;
 1681     EXEC_STATE *es;
 1682 
 1683     es = exec_state_stack.next;
 1684     if (es == NULL)
 1685         return NULL;
 1686     cp = es->cptr;
 1687     if (rule != NULL)
 1688         *rule = es->rule;
 1689     if (src != NULL)
 1690         *src = (char *) es->source;
 1691     if (sz != NULL)
 1692         *sz = es->stack_size;
 1693     exec_state_stack.next = es->next;
 1694     efree(es);
 1695     return cp;
 1696 }
 1697 
 1698 
 1699 /* register_exec_hook --- add exec hooks in the interpreter. */
 1700 
 1701 int
 1702 register_exec_hook(Func_pre_exec preh, Func_post_exec posth)
 1703 {
 1704     int pos = 0;
 1705 
 1706     /*
 1707      * multiple post-exec hooks aren't supported. post-exec hook is mainly
 1708      * for use by the debugger.
 1709      */
 1710 
 1711     if (! preh || (post_execute && posth))
 1712         return false;
 1713 
 1714     if (num_exec_hook == MAX_EXEC_HOOKS)
 1715         return false;
 1716 
 1717     /*
 1718      * Add to the beginning of the array but do not displace the
 1719      * debugger hook if it exists.
 1720      */
 1721     if (num_exec_hook > 0) {
 1722         pos = !! do_debug;
 1723         if (num_exec_hook > pos)
 1724             memmove(pre_execute + pos + 1, pre_execute + pos,
 1725                     (num_exec_hook - pos) * sizeof (preh));
 1726     }
 1727     pre_execute[pos] = preh;
 1728     num_exec_hook++;
 1729 
 1730     if (posth)
 1731         post_execute = posth;
 1732 
 1733     return true;
 1734 }
 1735 
 1736 
 1737 /* interpreter routine when not debugging */
 1738 #include "interpret.h"
 1739 
 1740 /* interpreter routine with exec hook(s). Used when debugging and/or with MPFR. */
 1741 #define r_interpret h_interpret
 1742 #define EXEC_HOOK 1
 1743 #include "interpret.h"
 1744 #undef EXEC_HOOK
 1745 #undef r_interpret
 1746 
 1747 
 1748 void
 1749 init_interpret()
 1750 {
 1751     long newval;
 1752 
 1753     if ((newval = getenv_long("GAWK_STACKSIZE")) > 0)
 1754         STACK_SIZE = newval;
 1755 
 1756     emalloc(stack_bottom, STACK_ITEM *, STACK_SIZE * sizeof(STACK_ITEM), "grow_stack");
 1757     stack_ptr = stack_bottom - 1;
 1758     stack_top = stack_bottom + STACK_SIZE - 1;
 1759 
 1760     /* initialize frame pointer */
 1761     getnode(frame_ptr);
 1762     frame_ptr->type = Node_frame;
 1763     frame_ptr->stack = NULL;
 1764     frame_ptr->func_node = NULL;    /* in main */
 1765     frame_ptr->vname = NULL;
 1766 
 1767     /* initialize true and false nodes */
 1768     node_Boolean[false] = make_number(0.0);
 1769     node_Boolean[true] = make_number(1.0);
 1770     if (! is_mpg_number(node_Boolean[false])) {
 1771         node_Boolean[false]->flags |= NUMINT;
 1772         node_Boolean[true]->flags |= NUMINT;
 1773     }
 1774 
 1775     /*
 1776      * Select the interpreter routine. The version without
 1777      * any exec hook support (r_interpret) is faster by about
 1778      * 5%, or more depending on the opcodes.
 1779      */
 1780 
 1781     if (num_exec_hook > 0)
 1782         interpret = h_interpret;
 1783     else
 1784         interpret = r_interpret;
 1785 }
 1786