eval.c

   1 /*
   2  * eval.c - gawk parse tree interpreter
   3  */
   4
   5 /*
   6  * Copyright (C) 1986, 1988, 1989, 1991-2005 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 2 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 P((double x, double y));
  29 extern double modf P((double x, double *yp));
  30 extern double fmod P((double x, double y));
  31
  32 static inline void make_scalar P((NODE *tree));
  33 static int eval_condition P((NODE *tree));
  34 static NODE *op_assign P((NODE *tree));
  35 static NODE *func_call P((NODE *tree));
  36 static NODE *match_op P((NODE *tree));
  37 static void pop_forloop P((void));
  38 static inline void pop_all_forloops P((void));
  39 static void push_forloop P((const char *varname, NODE **elems, size_t nelems));
  40 static void push_args P((int count, NODE *arglist, NODE **oldstack,
  41                         const char *func_name, char **varnames));
  42 static inline void pop_fcall_stack P((void));
  43 static void pop_fcall P((void));
  44 static int comp_func P((const void *p1, const void *p2));
  45
  46 #if __GNUC__ < 2
  47 NODE *_t;               /* used as a temporary in macros */
  48 #endif
  49 #ifdef MSDOS
  50 double _msc51bug;       /* to get around a bug in MSC 5.1 */
  51 #endif
  52 NODE *ret_node;
  53 int OFSlen;
  54 int ORSlen;
  55 int OFMTidx;
  56 int CONVFMTidx;
  57
  58 /* Profiling stuff */
  59 #ifdef PROFILING
  60 #define INCREMENT(n)    n++
  61 #else
  62 #define INCREMENT(n)    /* nothing */
  63 #endif
  64
  65 /* Macros and variables to save and restore function and loop bindings */
  66 /*
  67  * the val variable allows return/continue/break-out-of-context to be
  68  * caught and diagnosed
  69  */
  70 #define PUSH_BINDING(stack, x, val) (memcpy((char *)(stack), (const char *)(x), sizeof(jmp_buf)), val++)
  71 #define RESTORE_BINDING(stack, x, val) (memcpy((char *)(x), (const char *)(stack), sizeof(jmp_buf)), val--)
  72
  73 static jmp_buf loop_tag;                /* always the current binding */
  74 static int loop_tag_valid = FALSE;      /* nonzero when loop_tag valid */
  75 static int func_tag_valid = FALSE;
  76 static jmp_buf func_tag;
  77 extern int exiting, exit_val;
  78
  79 /* This rather ugly macro is for VMS C */
  80 #ifdef C
  81 #undef C
  82 #endif
  83 #define C(c) ((char)c)
  84 /*
  85  * This table is used by the regexp routines to do case independant
  86  * matching. Basically, every ascii character maps to itself, except
  87  * uppercase letters map to lower case ones. This table has 256
  88  * entries, for ISO 8859-1. Note also that if the system this
  89  * is compiled on doesn't use 7-bit ascii, casetable[] should not be
  90  * defined to the linker, so gawk should not load.
  91  *
  92  * Do NOT make this array static, it is used in several spots, not
  93  * just in this file.
  94  *
  95  * 6/2004:
  96  * This table is also used for IGNORECASE for == and !=, and index().
  97  * Although with GLIBC, we could use tolower() everywhere and RE_ICASE
  98  * for the regex matcher, precomputing this table once gives us a
  99  * performance improvement.  I also think it's better for portability
 100  * to non-GLIBC systems.  All the world is not (yet :-) GNU/Linux.
 101  */
 102 #if 'a' == 97   /* it's ascii */
 103 char casetable[] = {
 104         '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
 105         '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
 106         '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
 107         '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
 108         /* ' '     '!'     '"'     '#'     '$'     '%'     '&'     ''' */
 109         '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
 110         /* '('     ')'     '*'     '+'     ','     '-'     '.'     '/' */
 111         '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
 112         /* '0'     '1'     '2'     '3'     '4'     '5'     '6'     '7' */
 113         '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
 114         /* '8'     '9'     ':'     ';'     '<'     '='     '>'     '?' */
 115         '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
 116         /* '@'     'A'     'B'     'C'     'D'     'E'     'F'     'G' */
 117         '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
 118         /* 'H'     'I'     'J'     'K'     'L'     'M'     'N'     'O' */
 119         '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
 120         /* 'P'     'Q'     'R'     'S'     'T'     'U'     'V'     'W' */
 121         '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
 122         /* 'X'     'Y'     'Z'     '['     '\'     ']'     '^'     '_' */
 123         '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
 124         /* '`'     'a'     'b'     'c'     'd'     'e'     'f'     'g' */
 125         '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
 126         /* 'h'     'i'     'j'     'k'     'l'     'm'     'n'     'o' */
 127         '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
 128         /* 'p'     'q'     'r'     's'     't'     'u'     'v'     'w' */
 129         '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
 130         /* 'x'     'y'     'z'     '{'     '|'     '}'     '~' */
 131         '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
 132
 133         /* Latin 1: */
 134         C('\200'), C('\201'), C('\202'), C('\203'), C('\204'), C('\205'), C('\206'), C('\207'),
 135         C('\210'), C('\211'), C('\212'), C('\213'), C('\214'), C('\215'), C('\216'), C('\217'),
 136         C('\220'), C('\221'), C('\222'), C('\223'), C('\224'), C('\225'), C('\226'), C('\227'),
 137         C('\230'), C('\231'), C('\232'), C('\233'), C('\234'), C('\235'), C('\236'), C('\237'),
 138         C('\240'), C('\241'), C('\242'), C('\243'), C('\244'), C('\245'), C('\246'), C('\247'),
 139         C('\250'), C('\251'), C('\252'), C('\253'), C('\254'), C('\255'), C('\256'), C('\257'),
 140         C('\260'), C('\261'), C('\262'), C('\263'), C('\264'), C('\265'), C('\266'), C('\267'),
 141         C('\270'), C('\271'), C('\272'), C('\273'), C('\274'), C('\275'), C('\276'), C('\277'),
 142         C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
 143         C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
 144         C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\327'),
 145         C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\337'),
 146         C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
 147         C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
 148         C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\367'),
 149         C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\377'),
 150 };
 151 #else
 152 #include "You lose. You will need a translation table for your character set."
 153 #endif
 154
 155 #undef C
 156
 157 /* load_casetable --- for a non-ASCII locale, redo the table */
 158
 159 void
 160 load_casetable(void)
 161 {
 162 #if defined(LC_CTYPE)
 163         int i;
 164         char *cp;
 165         static int loaded = FALSE;
 166
 167         if (loaded || do_traditional)
 168                 return;
 169
 170         loaded = TRUE;
 171         cp = setlocale(LC_CTYPE, NULL);
 172
 173         /* this is not per standard, but it's pretty safe */
 174         if (cp == NULL || strcmp(cp, "C") == 0 || strcmp(cp, "POSIX") == 0)
 175                 return;
 176
 177         for (i = 0200; i <= 0377; i++) {
 178                 if (isalpha(i) && islower(i) && i != toupper(i))
 179                         casetable[i] = toupper(i);
 180         }
 181 #endif
 182 }
 183
 184 /*
 185  * This table maps node types to strings for debugging.
 186  * KEEP IN SYNC WITH awk.h!!!!
 187  */
 188 static const char *const nodetypes[] = {
 189         "Node_illegal",
 190         "Node_times",
 191         "Node_quotient",
 192         "Node_mod",
 193         "Node_plus",
 194         "Node_minus",
 195         "Node_cond_pair",
 196         "Node_subscript",
 197         "Node_concat",
 198         "Node_exp",
 199         "Node_preincrement",
 200         "Node_predecrement",
 201         "Node_postincrement",
 202         "Node_postdecrement",
 203         "Node_unary_minus",
 204         "Node_field_spec",
 205         "Node_assign",
 206         "Node_assign_times",
 207         "Node_assign_quotient",
 208         "Node_assign_mod",
 209         "Node_assign_plus",
 210         "Node_assign_minus",
 211         "Node_assign_exp",
 212         "Node_assign_concat",
 213         "Node_and",
 214         "Node_or",
 215         "Node_equal",
 216         "Node_notequal",
 217         "Node_less",
 218         "Node_greater",
 219         "Node_leq",
 220         "Node_geq",
 221         "Node_match",
 222         "Node_nomatch",
 223         "Node_not",
 224         "Node_rule_list",
 225         "Node_rule_node",
 226         "Node_statement_list",
 227         "Node_switch_body",
 228         "Node_case_list",
 229         "Node_if_branches",
 230         "Node_expression_list",
 231         "Node_param_list",
 232         "Node_K_if",
 233         "Node_K_switch",
 234         "Node_K_case",
 235         "Node_K_default",
 236         "Node_K_while",
 237         "Node_K_for",
 238         "Node_K_arrayfor",
 239         "Node_K_break",
 240         "Node_K_continue",
 241         "Node_K_print",
 242         "Node_K_print_rec",
 243         "Node_K_printf",
 244         "Node_K_next",
 245         "Node_K_exit",
 246         "Node_K_do",
 247         "Node_K_return",
 248         "Node_K_delete",
 249         "Node_K_delete_loop",
 250         "Node_K_getline",
 251         "Node_K_function",
 252         "Node_K_nextfile",
 253         "Node_redirect_output",
 254         "Node_redirect_append",
 255         "Node_redirect_pipe",
 256         "Node_redirect_pipein",
 257         "Node_redirect_input",
 258         "Node_redirect_twoway",
 259         "Node_var_new",
 260         "Node_var",
 261         "Node_var_array",
 262         "Node_val",
 263         "Node_builtin",
 264         "Node_line_range",
 265         "Node_in_array",
 266         "Node_func",
 267         "Node_func_call",
 268         "Node_cond_exp",
 269         "Node_regex",
 270         "Node_dynregex",
 271         "Node_hashnode",
 272         "Node_ahash",
 273         "Node_array_ref",
 274         "Node_BINMODE",
 275         "Node_CONVFMT",
 276         "Node_FIELDWIDTHS",
 277         "Node_FNR",
 278         "Node_FS",
 279         "Node_IGNORECASE",
 280         "Node_LINT",
 281         "Node_NF",
 282         "Node_NR",
 283         "Node_OFMT",
 284         "Node_OFS",
 285         "Node_ORS",
 286         "Node_RS",
 287         "Node_SUBSEP",
 288         "Node_TEXTDOMAIN",
 289         "Node_final --- this should never appear",
 290         NULL
 291 };
 292
 293 /* nodetype2str --- convert a node type into a printable value */
 294
 295 const char *
 296 nodetype2str(NODETYPE type)
 297 {
 298         static char buf[40];
 299
 300         if (type >= Node_illegal && type <= Node_final)
 301                 return nodetypes[(int) type];
 302
 303         sprintf(buf, _("unknown nodetype %d"), (int) type);
 304         return buf;
 305 }
 306
 307 /* flags2str --- make a flags value readable */
 308
 309 const char *
 310 flags2str(int flagval)
 311 {
 312         static const struct flagtab values[] = {
 313                 { MALLOC, "MALLOC" },
 314                 { TEMP, "TEMP" },
 315                 { PERM, "PERM" },
 316                 { STRING, "STRING" },
 317                 { STRCUR, "STRCUR" },
 318                 { NUMCUR, "NUMCUR" },
 319                 { NUMBER, "NUMBER" },
 320                 { MAYBE_NUM, "MAYBE_NUM" },
 321                 { ARRAYMAXED, "ARRAYMAXED" },
 322                 { FUNC, "FUNC" },
 323                 { FIELD, "FIELD" },
 324                 { INTLSTR, "INTLSTR" },
 325 #ifdef WSTRCUR
 326                 { WSTRCUR, "WSTRCUR" },
 327 #endif
 328                 { 0,    NULL },
 329         };
 330
 331         return genflags2str(flagval, values);
 332 }
 333
 334 /* genflags2str --- general routine to convert a flag value to a string */
 335
 336 const char *
 337 genflags2str(int flagval, const struct flagtab *tab)
 338 {
 339         static char buffer[BUFSIZ];
 340         char *sp;
 341         int i, space_left, space_needed;
 342
 343         sp = buffer;
 344         space_left = BUFSIZ;
 345         for (i = 0; tab[i].name != NULL; i++) {
 346                 if ((flagval & tab[i].val) != 0) {
 347                         /*
 348                          * note the trick, we want 1 or 0 for whether we need
 349                          * the '|' character.
 350                          */
 351                         space_needed = (strlen(tab[i].name) + (sp != buffer));
 352                         if (space_left < space_needed)
 353                                 fatal(_("buffer overflow in genflags2str"));
 354
 355                         if (sp != buffer) {
 356                                 *sp++ = '|';
 357                                 space_left--;
 358                         }
 359                         strcpy(sp, tab[i].name);
 360                         /* note ordering! */
 361                         space_left -= strlen(sp);
 362                         sp += strlen(sp);
 363                 }
 364         }
 365
 366         return buffer;
 367 }
 368
 369 /*
 370  * make_scalar --- make sure that tree is a scalar.
 371  *
 372  * tree is in a scalar context.  If it is a variable, accomplish
 373  * what's needed; otherwise, do nothing.
 374  *
 375  * Notice that nodes of type Node_var_new have undefined value in var_value
 376  * (a.k.a. lnode)---even though awkgram.y:variable() initializes it,
 377  * push_args() doesn't.  Thus we have to initialize it.
 378  */
 379
 380 static inline void
 381 make_scalar(NODE *tree)
 382 {
 383         switch (tree->type) {
 384         case Node_var_array:
 385                 fatal(_("attempt to use array `%s' in a scalar context"),
 386                         array_vname(tree));
 387
 388         case Node_array_ref:
 389                 switch (tree->orig_array->type) {
 390                 case Node_var_array:
 391                         fatal(_("attempt to use array `%s' in a scalar context"),
 392                                 array_vname(tree));
 393                 case Node_var_new:
 394                         tree->orig_array->type = Node_var;
 395                         tree->orig_array->var_value = Nnull_string;
 396                         break;
 397                 case Node_var:
 398                         break;
 399                 default:
 400                         cant_happen();
 401                 }
 402                 /* fall through */
 403         case Node_var_new:
 404                 tree->type = Node_var;
 405                 tree->var_value = Nnull_string;
 406         default:
 407                 /* shut up GCC */
 408                 break;
 409         }
 410 }
 411
 412 /*
 413  * interpret:
 414  * Tree is a bunch of rules to run. Returns zero if it hit an exit()
 415  * statement
 416  */
 417 int
 418 interpret(register NODE *volatile tree)
 419 {
 420         jmp_buf volatile loop_tag_stack; /* shallow binding stack for loop_tag */
 421         static jmp_buf rule_tag; /* tag the rule currently being run, for NEXT
 422                                   * and EXIT statements.  It is static because
 423                                   * there are no nested rules */
 424         register NODE *volatile t = NULL;       /* temporary */
 425         NODE **volatile lhs;    /* lhs == Left Hand Side for assigns, etc */
 426         NODE *volatile stable_tree;
 427         int volatile traverse = TRUE;   /* True => loop thru tree (Node_rule_list) */
 428
 429         /* avoid false source indications */
 430         source = NULL;
 431         sourceline = 0;
 432
 433         if (tree == NULL)
 434                 return 1;
 435         sourceline = tree->source_line;
 436         source = tree->source_file;
 437         switch (tree->type) {
 438         case Node_rule_node:
 439                 traverse = FALSE;  /* False => one for-loop iteration only */
 440                 /* FALL THROUGH */
 441         case Node_rule_list:
 442                 for (t = tree; t != NULL; t = t->rnode) {
 443                         if (traverse)
 444                                 tree = t->lnode;
 445                         sourceline = tree->source_line;
 446                         source = tree->source_file;
 447                         INCREMENT(tree->exec_count);
 448                         switch (setjmp(rule_tag)) {
 449                         case 0: /* normal non-jump */
 450                                 /* test pattern, if any */
 451                                 if (tree->lnode == NULL ||
 452                                     eval_condition(tree->lnode)) {
 453                                         /* using the lnode exec_count is kludgey */
 454                                         if (tree->lnode != NULL)
 455                                                 INCREMENT(tree->lnode->exec_count);
 456                                         (void) interpret(tree->rnode);
 457                                 }
 458                                 break;
 459                         case TAG_CONTINUE:      /* NEXT statement */
 460                                 pop_all_forloops();
 461                                 pop_fcall_stack();
 462                                 return 1;
 463                         case TAG_BREAK:         /* EXIT statement */
 464                                 pop_all_forloops();
 465                                 pop_fcall_stack();
 466                                 return 0;
 467                         default:
 468                                 cant_happen();
 469                         }
 470                         if (! traverse)         /* case Node_rule_node */
 471                                 break;          /* don't loop */
 472                 }
 473                 break;
 474
 475         case Node_statement_list:
 476                 for (t = tree; t != NULL; t = t->rnode)
 477                         (void) interpret(t->lnode);
 478                 break;
 479
 480         case Node_K_if:
 481                 INCREMENT(tree->exec_count);
 482                 if (eval_condition(tree->lnode)) {
 483                         INCREMENT(tree->rnode->exec_count);
 484                         (void) interpret(tree->rnode->lnode);
 485                 } else {
 486                         (void) interpret(tree->rnode->rnode);
 487                 }
 488                 break;
 489
 490         case Node_K_switch:
 491                 {
 492                 NODE *switch_value;
 493                 NODE *switch_body;
 494                 NODE *case_list;
 495                 NODE *default_list;
 496                 NODE *case_stmt;
 497
 498                 int match_found = FALSE;
 499
 500                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 501                 INCREMENT(tree->exec_count);
 502                 stable_tree = tree;
 503
 504                 switch_value = tree_eval(stable_tree->lnode);
 505                 switch_body = stable_tree->rnode;
 506                 case_list = switch_body->lnode;
 507                 default_list  = switch_body->rnode;
 508
 509                 for (; case_list != NULL; case_list = case_list->rnode) {
 510                         case_stmt = case_list->lnode;
 511
 512                         /*
 513                          * Once a match is found, all cases will be processed as they fall through,
 514                          * so continue to execute statements until a break is reached.
 515                          */
 516                         if (! match_found) {
 517                                 if (case_stmt->type == Node_K_default)
 518                                         ;       /* do nothing */
 519                                 else if (case_stmt->lnode->type == Node_regex) {
 520                                         NODE *t1;
 521                                         Regexp *rp;
 522                                         /* see comments in match_op() code about this. */
 523                                         int kludge_need_start = 0;
 524
 525                                         t1 = force_string(switch_value);
 526                                         rp = re_update(case_stmt->lnode);
 527
 528                                         if (avoid_dfa(tree, t1->stptr, t1->stlen))
 529                                                 kludge_need_start = RE_NEED_START;
 530                                         match_found = (research(rp, t1->stptr, 0, t1->stlen, kludge_need_start) >= 0);
 531                                         if (t1 != switch_value)
 532                                                 free_temp(t1);
 533                                 } else
 534                                         match_found = (cmp_nodes(switch_value, case_stmt->lnode) == 0);
 535                         }
 536
 537                         /* If a match was found, execute the statements associated with the case. */
 538                         if (match_found) {
 539                                 INCREMENT(case_stmt->exec_count);
 540                                 switch (setjmp(loop_tag)) {
 541                                 case 0:                /* Normal non-jump    */
 542                                         (void) interpret(case_stmt->rnode);
 543                                         break;
 544                                 case TAG_CONTINUE:     /* continue statement */
 545                                         free_temp(switch_value);
 546                                         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 547                                         longjmp(loop_tag, TAG_CONTINUE);
 548                                         break;
 549                                 case TAG_BREAK:        /* break statement    */
 550                                         free_temp(switch_value);
 551                                         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 552                                         return 1;
 553                                 default:
 554                                         cant_happen();
 555                                 }
 556                         }
 557
 558                 }
 559
 560                 free_temp(switch_value);
 561
 562                 /*
 563                  * If a default section was found, execute the statements associated with it
 564                  * and execute any trailing case statements if the default falls through.
 565                  */
 566                 if (! match_found && default_list != NULL) {
 567                         for (case_list = default_list;
 568                                         case_list != NULL; case_list = case_list->rnode) {
 569                                 case_stmt = case_list->lnode;
 570
 571                                 INCREMENT(case_stmt->exec_count);
 572                                 switch (setjmp(loop_tag)) {
 573                                 case 0:                /* Normal non-jump    */
 574                                         (void) interpret(case_stmt->rnode);
 575                                         break;
 576                                 case TAG_CONTINUE:     /* continue statement */
 577                                         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 578                                         longjmp(loop_tag, TAG_CONTINUE);
 579                                         break;
 580                                 case TAG_BREAK:        /* break statement    */
 581                                         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 582                                         return 1;
 583                                 default:
 584                                         cant_happen();
 585                                 }
 586                         }
 587                 }
 588
 589                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 590                 }
 591                 break;
 592
 593         case Node_K_while:
 594                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 595
 596                 stable_tree = tree;
 597                 while (eval_condition(stable_tree->lnode)) {
 598                         INCREMENT(stable_tree->exec_count);
 599                         switch (setjmp(loop_tag)) {
 600                         case 0: /* normal non-jump */
 601                                 (void) interpret(stable_tree->rnode);
 602                                 break;
 603                         case TAG_CONTINUE:      /* continue statement */
 604                                 break;
 605                         case TAG_BREAK: /* break statement */
 606                                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 607                                 return 1;
 608                         default:
 609                                 cant_happen();
 610                         }
 611                 }
 612                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 613                 break;
 614
 615         case Node_K_do:
 616                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 617                 stable_tree = tree;
 618                 do {
 619                         INCREMENT(stable_tree->exec_count);
 620                         switch (setjmp(loop_tag)) {
 621                         case 0: /* normal non-jump */
 622                                 (void) interpret(stable_tree->rnode);
 623                                 break;
 624                         case TAG_CONTINUE:      /* continue statement */
 625                                 break;
 626                         case TAG_BREAK: /* break statement */
 627                                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 628                                 return 1;
 629                         default:
 630                                 cant_happen();
 631                         }
 632                 } while (eval_condition(stable_tree->lnode));
 633                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 634                 break;
 635
 636         case Node_K_for:
 637                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 638                 (void) interpret(tree->forloop->init);
 639                 stable_tree = tree;
 640                 while (eval_condition(stable_tree->forloop->cond)) {
 641                         INCREMENT(stable_tree->exec_count);
 642                         switch (setjmp(loop_tag)) {
 643                         case 0: /* normal non-jump */
 644                                 (void) interpret(stable_tree->lnode);
 645                                 /* fall through */
 646                         case TAG_CONTINUE:      /* continue statement */
 647                                 (void) interpret(stable_tree->forloop->incr);
 648                                 break;
 649                         case TAG_BREAK: /* break statement */
 650                                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 651                                 return 1;
 652                         default:
 653                                 cant_happen();
 654                         }
 655                 }
 656                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 657                 break;
 658
 659         case Node_K_arrayfor:
 660                 {
 661                 Func_ptr after_assign = NULL;
 662                 NODE **list = NULL;
 663                 NODE *volatile array;
 664                 NODE *volatile save_array;
 665                 volatile size_t i, num_elems;
 666                 size_t j;
 667                 volatile int retval = 0;
 668                 int sort_indices = whiny_users;
 669
 670 #define hakvar forloop->init
 671 #define arrvar forloop->incr
 672                 /* get the array */
 673                 save_array = tree->arrvar;
 674                 array = get_array(save_array);
 675
 676                 /* sanity: do nothing if empty */
 677                 if (array->var_array == NULL || array->table_size == 0)
 678                         break;  /* from switch */
 679
 680                 /* allocate space for array */
 681                 num_elems = array->table_size;
 682                 emalloc(list, NODE **, num_elems * sizeof(NODE *), "for_loop");
 683
 684                 /* populate it */
 685                 for (i = j = 0; i < array->array_size; i++) {
 686                         NODE *t = array->var_array[i];
 687
 688                         if (t == NULL)
 689                                 continue;
 690
 691                         for (; t != NULL; t = t->ahnext) {
 692                                 list[j++] = dupnode(t);
 693                                 assert(list[j-1] == t);
 694                         }
 695                 }
 696
 697
 698                 if (sort_indices)
 699                         qsort(list, num_elems, sizeof(NODE *), comp_func); /* shazzam! */
 700
 701                 /* now we can run the loop */
 702                 push_forloop(array->vname, list, num_elems);
 703                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 704
 705                 lhs = get_lhs(tree->hakvar, &after_assign, FALSE);
 706                 stable_tree = tree;
 707                 for (i = 0; i < num_elems; i++) {
 708                         INCREMENT(stable_tree->exec_count);
 709                         unref(*((NODE **) lhs));
 710                         *lhs = make_string(list[i]->ahname_str, list[i]->ahname_len);
 711                         if (after_assign)
 712                                 (*after_assign)();
 713                         switch (setjmp(loop_tag)) {
 714                         case 0:
 715                                 (void) interpret(stable_tree->lnode);
 716                         case TAG_CONTINUE:
 717                                 break;
 718
 719                         case TAG_BREAK:
 720                                 retval = 1;
 721                                 goto done;
 722
 723                         default:
 724                                 cant_happen();
 725                         }
 726                 }
 727
 728         done:
 729                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 730                 pop_forloop();
 731
 732                 if (do_lint && num_elems != array->table_size)
 733                         lintwarn(_("for loop: array `%s' changed size from %ld to %ld during loop execution"),
 734                                 array_vname(save_array), (long) num_elems, (long) array->table_size);
 735
 736                 if (retval == 1)
 737                         return 1;
 738                 break;
 739                 }
 740 #undef hakvar
 741 #undef arrvar
 742
 743         case Node_K_break:
 744                 INCREMENT(tree->exec_count);
 745                 if (! loop_tag_valid) {
 746                         /*
 747                          * Old AT&T nawk treats break outside of loops like
 748                          * next. New ones catch it at parse time. Allow it if
 749                          * do_traditional is on, and complain if lint.
 750                          */
 751                         static int warned = FALSE;
 752
 753                         if (do_lint && ! warned) {
 754                                 lintwarn(_("`break' outside a loop is not portable"));
 755                                 warned = TRUE;
 756                         }
 757                         if (! do_traditional || do_posix)
 758                                 fatal(_("`break' outside a loop is not allowed"));
 759                         longjmp(rule_tag, TAG_CONTINUE);
 760                 } else
 761                         longjmp(loop_tag, TAG_BREAK);
 762                 break;
 763
 764         case Node_K_continue:
 765                 INCREMENT(tree->exec_count);
 766                 if (! loop_tag_valid) {
 767                         /*
 768                          * Old AT&T nawk treats continue outside of loops like
 769                          * next. New ones catch it at parse time. Allow it if
 770                          * do_traditional is on, and complain if lint.
 771                          */
 772                         static int warned = FALSE;
 773
 774                         if (do_lint && ! warned) {
 775                                 lintwarn(_("`continue' outside a loop is not portable"));
 776                                 warned = TRUE;
 777                         }
 778                         if (! do_traditional || do_posix)
 779                                 fatal(_("`continue' outside a loop is not allowed"));
 780                         longjmp(rule_tag, TAG_CONTINUE);
 781                 } else
 782                         longjmp(loop_tag, TAG_CONTINUE);
 783                 break;
 784
 785         case Node_K_print:
 786                 INCREMENT(tree->exec_count);
 787                 do_print(tree);
 788                 break;
 789
 790         case Node_K_print_rec:
 791                 INCREMENT(tree->exec_count);
 792                 do_print_rec(tree);
 793                 break;
 794
 795         case Node_K_printf:
 796                 INCREMENT(tree->exec_count);
 797                 do_printf(tree);
 798                 break;
 799
 800         case Node_K_delete:
 801                 INCREMENT(tree->exec_count);
 802                 do_delete(tree->lnode, tree->rnode);
 803                 break;
 804
 805         case Node_K_delete_loop:
 806                 INCREMENT(tree->exec_count);
 807                 do_delete_loop(tree->lnode, tree->rnode);
 808                 break;
 809
 810         case Node_K_next:
 811                 INCREMENT(tree->exec_count);
 812                 if (in_begin_rule)
 813                         fatal(_("`next' cannot be called from a BEGIN rule"));
 814                 else if (in_end_rule)
 815                         fatal(_("`next' cannot be called from an END rule"));
 816
 817                 /* could add a lint check here for in a loop or function */
 818                 longjmp(rule_tag, TAG_CONTINUE);
 819                 break;
 820
 821         case Node_K_nextfile:
 822                 INCREMENT(tree->exec_count);
 823                 if (in_begin_rule)
 824                         fatal(_("`nextfile' cannot be called from a BEGIN rule"));
 825                 else if (in_end_rule)
 826                         fatal(_("`nextfile' cannot be called from an END rule"));
 827
 828                 /* could add a lint check here for in a loop or function */
 829                 /*
 830                  * Have to do this cleanup here, since we don't longjump
 831                  * back to the main awk rule loop (rule_tag).
 832                  */
 833                 pop_all_forloops();
 834                 pop_fcall_stack();
 835
 836                 do_nextfile();
 837                 break;
 838
 839         case Node_K_exit:
 840                 INCREMENT(tree->exec_count);
 841                 /*
 842                  * In A,K,&W, p. 49, it says that an exit statement "...
 843                  * causes the program to behave as if the end of input had
 844                  * occurred; no more input is read, and the END actions, if
 845                  * any are executed." This implies that the rest of the rules
 846                  * are not done. So we immediately break out of the main loop.
 847                  */
 848                 exiting = TRUE;
 849                 if (tree->lnode != NULL) {
 850                         t = tree_eval(tree->lnode);
 851                         exit_val = (int) force_number(t);
 852                         free_temp(t);
 853                 }
 854                 longjmp(rule_tag, TAG_BREAK);
 855                 break;
 856
 857         case Node_K_return:
 858                 INCREMENT(tree->exec_count);
 859                 t = tree_eval(tree->lnode);
 860                 if ((t->flags & (PERM|TEMP)) != 0)
 861                         ret_node = t;
 862                 else {
 863                         ret_node = copynode(t);  /* don't do a dupnode here */
 864                         ret_node->flags |= TEMP;
 865                 }
 866                 longjmp(func_tag, TAG_RETURN);
 867                 break;
 868
 869         default:
 870                 /*
 871                  * Appears to be an expression statement.  Throw away the
 872                  * value.
 873                  */
 874                 if (do_lint && (tree->type == Node_var || tree->type == Node_var_new))
 875                         lintwarn(_("statement has no effect"));
 876                 INCREMENT(tree->exec_count);
 877                 t = tree_eval(tree);
 878                 if (t)  /* stopme() returns NULL */
 879                         free_temp(t);
 880                 break;
 881         }
 882         return 1;
 883 }
 884
 885 /*
 886  * calc_exp_posint --- calculate x^n for positive integral n,
 887  * using exponentiation by squaring without recursion.
 888  */
 889
 890 static AWKNUM
 891 calc_exp_posint(AWKNUM x, long n)
 892 {
 893         AWKNUM mult = 1;
 894
 895         while (n > 1) {
 896                 if ((n % 2) == 1)
 897                         mult *= x;
 898                 x *= x;
 899                 n /= 2;
 900         }
 901         return mult * x;
 902 }
 903
 904 /* calc_exp --- calculate x1^x2 */
 905
 906 static AWKNUM
 907 calc_exp(AWKNUM x1, AWKNUM x2)
 908 {
 909         long lx;
 910
 911         if ((lx = x2) == x2) {          /* integer exponent */
 912                 if (lx == 0)
 913                         return 1;
 914                 return (lx > 0) ? calc_exp_posint(x1, lx)
 915                                 : 1.0 / calc_exp_posint(x1, -lx);
 916         }
 917         return (AWKNUM) pow((double) x1, (double) x2);
 918 }
 919
 920 /* r_tree_eval --- evaluate a subtree */
 921
 922 NODE *
 923 r_tree_eval(register NODE *tree, int iscond)
 924 {
 925         register NODE *r, *t1, *t2;     /* return value & temporary subtrees */
 926         register NODE **lhs;
 927         register int di;
 928         AWKNUM x, x1, x2;
 929 #ifdef _CRAY
 930         long lx2;
 931 #endif
 932
 933 #ifndef TREE_EVAL_MACRO
 934         if (tree == NULL)
 935                 cant_happen();
 936         if (tree->type == Node_val) {
 937                 if (tree->stref <= 0)
 938                         cant_happen();
 939                 return ((tree->flags & INTLSTR) != 0
 940                         ? r_force_string(tree)
 941                         : tree);
 942         } else if (tree->type == Node_var) {
 943                 if (tree->var_value->stref <= 0)
 944                         cant_happen();
 945                 if (! var_uninitialized(tree))
 946                         return tree->var_value;
 947         }
 948 #endif
 949
 950         if (tree->type == Node_param_list) {
 951                 if ((tree->flags & FUNC) != 0)
 952                         fatal(_("can't use function name `%s' as variable or array"),
 953                                         tree->vname);
 954
 955                 tree = stack_ptr[tree->param_cnt];
 956
 957                 if (tree == NULL) {
 958                         if (do_lint)
 959                                 lintwarn(_("reference to uninitialized argument `%s'"),
 960                                                 tree->vname);
 961                         return Nnull_string;
 962                 }
 963
 964                 if (do_lint && var_uninitialized(tree))
 965                         lintwarn(_("reference to uninitialized argument `%s'"),
 966                               tree->vname);
 967         }
 968
 969         make_scalar(tree);
 970
 971         switch (tree->type) {
 972         case Node_var:
 973                 if (do_lint && var_uninitialized(tree))
 974                         lintwarn(_("reference to uninitialized variable `%s'"),
 975                               tree->vname);
 976                 return tree->var_value;
 977
 978         case Node_and:
 979                 return tmp_number((AWKNUM) (eval_condition(tree->lnode)
 980                                             && eval_condition(tree->rnode)));
 981
 982         case Node_or:
 983                 return tmp_number((AWKNUM) (eval_condition(tree->lnode)
 984                                             || eval_condition(tree->rnode)));
 985
 986         case Node_not:
 987                 return tmp_number((AWKNUM) ! eval_condition(tree->lnode));
 988
 989                 /* Builtins */
 990         case Node_builtin:
 991                 return (*tree->builtin)(tree->subnode);
 992
 993         case Node_K_getline:
 994                 return do_getline(tree);
 995
 996         case Node_in_array:
 997                 return tmp_number((AWKNUM) (in_array(tree->lnode, tree->rnode) != NULL));
 998
 999         case Node_func_call:
1000                 return func_call(tree);
1001
1002                 /* unary operations */
1003         case Node_NR:
1004         case Node_FNR:
1005         case Node_NF:
1006         case Node_FIELDWIDTHS:
1007         case Node_FS:
1008         case Node_RS:
1009         case Node_field_spec:
1010         case Node_subscript:
1011         case Node_IGNORECASE:
1012         case Node_OFS:
1013         case Node_ORS:
1014         case Node_OFMT:
1015         case Node_CONVFMT:
1016         case Node_BINMODE:
1017         case Node_LINT:
1018         case Node_SUBSEP:
1019         case Node_TEXTDOMAIN:
1020                 lhs = get_lhs(tree, (Func_ptr *) NULL, TRUE);
1021                 return *lhs;
1022
1023         case Node_unary_minus:
1024                 t1 = tree_eval(tree->subnode);
1025                 x = -force_number(t1);
1026                 free_temp(t1);
1027                 return tmp_number(x);
1028
1029         case Node_cond_exp:
1030                 if (eval_condition(tree->lnode))
1031                         return tree_eval(tree->rnode->lnode);
1032                 return tree_eval(tree->rnode->rnode);
1033
1034         case Node_match:
1035         case Node_nomatch:
1036         case Node_regex:
1037         case Node_dynregex:
1038                 return match_op(tree);
1039
1040         case Node_concat:
1041                 {
1042                 NODE **treelist;
1043                 NODE **strlist;
1044                 NODE *save_tree;
1045                 register NODE **treep;
1046                 register NODE **strp;
1047                 register size_t len;
1048                 register size_t supposed_len;
1049                 char *str;
1050                 register char *dest;
1051                 int alloc_count, str_count;
1052                 int i;
1053
1054                 /*
1055                  * This is an efficiency hack for multiple adjacent string
1056                  * concatenations, to avoid recursion and string copies.
1057                  *
1058                  * Node_concat trees grow downward to the left, so
1059                  * descend to lowest (first) node, accumulating nodes
1060                  * to evaluate to strings as we go.
1061                  */
1062
1063                 /*
1064                  * But first, no arbitrary limits. Count the number of
1065                  * nodes and malloc the treelist and strlist arrays.
1066                  * There will be alloc_count + 1 items to concatenate. We
1067                  * also leave room for an extra pointer at the end to
1068                  * use as a sentinel.  Thus, start alloc_count at 2.
1069                  */
1070                 save_tree = tree;
1071                 for (alloc_count = 2; tree != NULL && tree->type == Node_concat;
1072                                 tree = tree->lnode)
1073                         alloc_count++;
1074                 tree = save_tree;
1075                 emalloc(treelist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
1076                 emalloc(strlist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
1077
1078                 /* Now, here we go. */
1079                 treep = treelist;
1080                 while (tree != NULL && tree->type == Node_concat) {
1081                         *treep++ = tree->rnode;
1082                         tree = tree->lnode;
1083                 }
1084                 *treep = tree;
1085                 /*
1086                  * Now, evaluate to strings in LIFO order, accumulating
1087                  * the string length, so we can do a single malloc at the
1088                  * end.
1089                  *
1090                  * Evaluate the expressions first, then get their
1091                  * lengthes, in case one of the expressions has a
1092                  * side effect that changes one of the others.
1093                  * See test/nasty.awk.
1094                  *
1095                  * dupnode the results a la do_print, to give us
1096                  * more predicable behavior; compare gawk 3.0.6 to
1097                  * nawk/mawk on test/nasty.awk.
1098                  */
1099                 strp = strlist;
1100                 supposed_len = len = 0;
1101                 while (treep >= treelist) {
1102                         NODE *n;
1103
1104                         /* Here lies the wumpus's brother. R.I.P. */
1105                         n = force_string(tree_eval(*treep--));
1106                         *strp = dupnode(n);
1107                         free_temp(n);
1108                         supposed_len += (*strp)->stlen;
1109                         strp++;
1110                 }
1111                 *strp = NULL;
1112
1113                 str_count = strp - strlist;
1114                 strp = strlist;
1115                 for (i = 0; i < str_count; i++) {
1116                         len += (*strp)->stlen;
1117                         strp++;
1118                 }
1119                 if (do_lint && supposed_len != len)
1120                         lintwarn(_("concatenation: side effects in one expression have changed the length of another!"));
1121                 emalloc(str, char *, len+2, "tree_eval");
1122                 str[len] = str[len+1] = '\0';   /* for good measure */
1123                 dest = str;
1124                 strp = strlist;
1125                 while (*strp != NULL) {
1126                         memcpy(dest, (*strp)->stptr, (*strp)->stlen);
1127                         dest += (*strp)->stlen;
1128                         unref(*strp);
1129                         strp++;
1130                 }
1131                 r = make_str_node(str, len, ALREADY_MALLOCED);
1132                 r->flags |= TEMP;
1133
1134                 free(strlist);
1135                 free(treelist);
1136                 }
1137                 return r;
1138
1139         /* assignments */
1140         case Node_assign_concat:
1141         {
1142                 Func_ptr after_assign = NULL;
1143                 NODE *l, *r;
1144
1145                 /*
1146                  * Note that something lovely like this:
1147                  *
1148                  * BEGIN { a = "a"; a = a (a = "b"); print a }
1149                  *
1150                  * is not defined.  It could print `ab' or `bb'.
1151                  * Gawk 3.1.3 prints `ab', so we do that too, simply
1152                  * by evaluating the LHS first.  Ugh.
1153                  *
1154                  * Thanks to mary1john@earthlink.net for pointing
1155                  * out this issue.
1156                  */
1157                 lhs = get_lhs(tree->lnode, &after_assign, FALSE);
1158                 *lhs = force_string(*lhs);
1159                 l = *lhs;
1160                 r = force_string(tree_eval(tree->rnode));
1161
1162                 /*
1163                  * Don't clobber string constants!
1164                  *
1165                  * Also check stref; see test/strcat1.awk,
1166                  * the test for l->stref == 1 can't be an
1167                  * assertion.
1168                  *
1169                  * Thanks again to mary1john@earthlink.net for pointing
1170                  * out this issue.
1171                  */
1172                 if (l != r && (l->flags & PERM) == 0 && l->stref == 1) {
1173                         size_t nlen = l->stlen + r->stlen + 2;
1174
1175                         erealloc(l->stptr, char *, nlen, "interpret");
1176                         memcpy(l->stptr + l->stlen, r->stptr, r->stlen);
1177                         l->stlen += r->stlen;
1178                         l->stptr[l->stlen] = '\0';
1179                 } else {
1180                         char *nval;
1181                         size_t nlen = l->stlen + r->stlen + 2;
1182
1183                         emalloc(nval, char *, nlen, "interpret");
1184                         memcpy(nval, l->stptr, l->stlen);
1185                         memcpy(nval + l->stlen, r->stptr, r->stlen);
1186                         unref(*lhs);
1187                         *lhs = make_str_node(nval, l->stlen + r->stlen, ALREADY_MALLOCED);
1188                 }
1189                 free_temp(r);
1190
1191                 if (after_assign)
1192                         (*after_assign)();
1193                 return *lhs;
1194         }
1195         case Node_assign:
1196                 {
1197                 Func_ptr after_assign = NULL;
1198
1199                 if (do_lint && iscond)
1200                         lintwarn(_("assignment used in conditional context"));
1201                 r = tree_eval(tree->rnode);
1202                 lhs = get_lhs(tree->lnode, &after_assign, FALSE);
1203
1204                 assign_val(lhs, r);
1205                 if (after_assign)
1206                         (*after_assign)();
1207                 return *lhs;
1208                 }
1209
1210         /* other assignment types are easier because they are numeric */
1211         case Node_preincrement:
1212         case Node_predecrement:
1213         case Node_postincrement:
1214         case Node_postdecrement:
1215         case Node_assign_exp:
1216         case Node_assign_times:
1217         case Node_assign_quotient:
1218         case Node_assign_mod:
1219         case Node_assign_plus:
1220         case Node_assign_minus:
1221                 return op_assign(tree);
1222         default:
1223                 break;  /* handled below */
1224         }
1225
1226         /*
1227          * Evaluate subtrees in order to do binary operation, then keep going.
1228          * Use dupnode to make sure that these values don't disappear out
1229          * from under us during recursive subexpression evaluation.
1230          */
1231         t1 = dupnode(tree_eval(tree->lnode));
1232         t2 = dupnode(tree_eval(tree->rnode));
1233
1234         switch (tree->type) {
1235         case Node_geq:
1236         case Node_leq:
1237         case Node_greater:
1238         case Node_less:
1239         case Node_notequal:
1240         case Node_equal:
1241                 di = cmp_nodes(t1, t2);
1242                 unref(t1);
1243                 unref(t2);
1244                 switch (tree->type) {
1245                 case Node_equal:
1246                         return tmp_number((AWKNUM) (di == 0));
1247                 case Node_notequal:
1248                         return tmp_number((AWKNUM) (di != 0));
1249                 case Node_less:
1250                         return tmp_number((AWKNUM) (di < 0));
1251                 case Node_greater:
1252                         return tmp_number((AWKNUM) (di > 0));
1253                 case Node_leq:
1254                         return tmp_number((AWKNUM) (di <= 0));
1255                 case Node_geq:
1256                         return tmp_number((AWKNUM) (di >= 0));
1257                 default:
1258                         cant_happen();
1259                 }
1260                 break;
1261         default:
1262                 break;  /* handled below */
1263         }
1264
1265         x1 = force_number(t1);
1266         x2 = force_number(t2);
1267         unref(t1);
1268         unref(t2);
1269         switch (tree->type) {
1270         case Node_exp:
1271                 return tmp_number(calc_exp(x1, x2));
1272
1273         case Node_times:
1274                 return tmp_number(x1 * x2);
1275
1276         case Node_quotient:
1277                 if (x2 == 0)
1278                         fatal(_("division by zero attempted"));
1279 #ifdef _CRAY
1280                 /* special case for integer division, put in for Cray */
1281                 lx2 = x2;
1282                 if (lx2 == 0)
1283                         return tmp_number(x1 / x2);
1284                 lx = (long) x1 / lx2;
1285                 if (lx * x2 == x1)
1286                         return tmp_number((AWKNUM) lx);
1287                 else
1288 #endif
1289                         return tmp_number(x1 / x2);
1290
1291         case Node_mod:
1292                 if (x2 == 0)
1293                         fatal(_("division by zero attempted in `%%'"));
1294 #ifdef HAVE_FMOD
1295                 return tmp_number(fmod(x1, x2));
1296 #else   /* ! HAVE_FMOD */
1297                 (void) modf(x1 / x2, &x);
1298                 return tmp_number(x1 - x * x2);
1299 #endif  /* ! HAVE_FMOD */
1300
1301         case Node_plus:
1302                 return tmp_number(x1 + x2);
1303
1304         case Node_minus:
1305                 return tmp_number(x1 - x2);
1306
1307         default:
1308                 fatal(_("illegal type (%s) in tree_eval"), nodetype2str(tree->type));
1309         }
1310         return (NODE *) 0;
1311 }
1312
1313 /* eval_condition --- is TREE true or false? Returns 0==false, non-zero==true */
1314
1315 static int
1316 eval_condition(register NODE *tree)
1317 {
1318         register NODE *t1;
1319         register int ret;
1320
1321         if (tree == NULL)       /* Null trees are the easiest kinds */
1322                 return TRUE;
1323         if (tree->type == Node_line_range) {
1324                 /*
1325                  * Node_line_range is kind of like Node_match, EXCEPT: the
1326                  * lnode field (more properly, the condpair field) is a node
1327                  * of a Node_cond_pair; whether we evaluate the lnode of that
1328                  * node or the rnode depends on the triggered word.  More
1329                  * precisely:  if we are not yet triggered, we tree_eval the
1330                  * lnode; if that returns true, we set the triggered word.
1331                  * If we are triggered (not ELSE IF, note), we tree_eval the
1332                  * rnode, clear triggered if it succeeds, and perform our
1333                  * action (regardless of success or failure).  We want to be
1334                  * able to begin and end on a single input record, so this
1335                  * isn't an ELSE IF, as noted above.
1336                  */
1337                 if (! tree->triggered) {
1338                         if (! eval_condition(tree->condpair->lnode))
1339                                 return FALSE;
1340                         else
1341                                 tree->triggered = TRUE;
1342                 }
1343                 /* Else we are triggered */
1344                 if (eval_condition(tree->condpair->rnode))
1345                         tree->triggered = FALSE;
1346                 return TRUE;
1347         }
1348
1349         /*
1350          * Could just be J.random expression. in which case, null and 0 are
1351          * false, anything else is true
1352          */
1353
1354         t1 = m_tree_eval(tree, TRUE);
1355         if (t1->flags & MAYBE_NUM)
1356                 (void) force_number(t1);
1357         if (t1->flags & NUMBER)
1358                 ret = (t1->numbr != 0.0);
1359         else
1360                 ret = (t1->stlen != 0);
1361         free_temp(t1);
1362         return ret;
1363 }
1364
1365 /* cmp_nodes --- compare two nodes, returning negative, 0, positive */
1366
1367 int
1368 cmp_nodes(register NODE *t1, register NODE *t2)
1369 {
1370         register int ret;
1371         register size_t len1, len2;
1372         register int l;
1373         int ldiff;
1374
1375         if (t1 == t2)
1376                 return 0;
1377         if (t1->flags & MAYBE_NUM)
1378                 (void) force_number(t1);
1379         if (t2->flags & MAYBE_NUM)
1380                 (void) force_number(t2);
1381         if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
1382                 if (t1->numbr == t2->numbr)
1383                         return 0;
1384                 /* don't subtract, in case one or both are infinite */
1385                 else if (t1->numbr < t2->numbr)
1386                         return -1;
1387                 else
1388                         return 1;
1389         }
1390         (void) force_string(t1);
1391         (void) force_string(t2);
1392         len1 = t1->stlen;
1393         len2 = t2->stlen;
1394         ldiff = len1 - len2;
1395         if (len1 == 0 || len2 == 0)
1396                 return ldiff;
1397         l = (ldiff <= 0 ? len1 : len2);
1398         if (IGNORECASE) {
1399                 const unsigned char *cp1 = (const unsigned char *) t1->stptr;
1400                 const unsigned char *cp2 = (const unsigned char *) t2->stptr;
1401
1402 #ifdef MBS_SUPPORT
1403                 if (gawk_mb_cur_max > 1) {
1404                         mbstate_t mbs;
1405                         memset(&mbs, 0, sizeof(mbstate_t));
1406                         ret = strncasecmpmbs((const char *) cp1, mbs,
1407                                              (const char *) cp2, mbs, l);
1408                 } else
1409 #endif
1410                 /* Could use tolower() here; see discussion above. */
1411                 for (ret = 0; l-- > 0 && ret == 0; cp1++, cp2++)
1412                         ret = casetable[*cp1] - casetable[*cp2];
1413         } else
1414                 ret = memcmp(t1->stptr, t2->stptr, l);
1415         return (ret == 0 ? ldiff : ret);
1416 }
1417
1418 /* op_assign --- do +=, -=, etc. */
1419
1420 static NODE *
1421 op_assign(register NODE *tree)
1422 {
1423         AWKNUM rval, lval;
1424         NODE **lhs;
1425         NODE *tmp;
1426         Func_ptr after_assign = NULL;
1427         int post = FALSE;
1428
1429         /*
1430          * For += etc, do the rhs first, since it can rearrange things,
1431          * and *then* get the lhs.
1432          */
1433         if (tree->rnode != NULL) {
1434                 tmp = tree_eval(tree->rnode);
1435                 rval = force_number(tmp);
1436                 free_temp(tmp);
1437         } else
1438                 rval = (AWKNUM) 1.0;
1439
1440         lhs = get_lhs(tree->lnode, &after_assign, TRUE);
1441         lval = force_number(*lhs);
1442         unref(*lhs);
1443
1444         switch(tree->type) {
1445         case Node_postincrement:
1446                 post = TRUE;
1447                 /* fall through */
1448         case Node_preincrement:
1449         case Node_assign_plus:
1450                 *lhs = make_number(lval + rval);
1451                 break;
1452
1453         case Node_postdecrement:
1454                 post = TRUE;
1455                 /* fall through */
1456         case Node_predecrement:
1457         case Node_assign_minus:
1458                 *lhs = make_number(lval - rval);
1459                 break;
1460
1461         case Node_assign_exp:
1462                 *lhs = make_number(calc_exp(lval, rval));
1463                 break;
1464
1465         case Node_assign_times:
1466                 *lhs = make_number(lval * rval);
1467                 break;
1468
1469         case Node_assign_quotient:
1470                 if (rval == (AWKNUM) 0)
1471                         fatal(_("division by zero attempted in `/='"));
1472         {
1473 #ifdef _CRAY
1474                 long ltemp;
1475
1476                 /* special case for integer division, put in for Cray */
1477                 ltemp = rval;
1478                 if (ltemp == 0) {
1479                         *lhs = make_number(lval / rval);
1480                         break;
1481                 }
1482                 ltemp = (long) lval / ltemp;
1483                 if (ltemp * lval == rval)
1484                         *lhs = make_number((AWKNUM) ltemp);
1485                 else
1486 #endif  /* _CRAY */
1487                         *lhs = make_number(lval / rval);
1488         }
1489                 break;
1490
1491         case Node_assign_mod:
1492                 if (rval == (AWKNUM) 0)
1493                         fatal(_("division by zero attempted in `%%='"));
1494 #ifdef HAVE_FMOD
1495                 *lhs = make_number(fmod(lval, rval));
1496 #else   /* ! HAVE_FMOD */
1497         {
1498                 AWKNUM t1, t2;
1499
1500                 (void) modf(lval / rval, &t1);
1501                 t2 = lval - rval * t1;
1502                 *lhs = make_number(t2);
1503         }
1504 #endif  /* ! HAVE_FMOD */
1505                 break;
1506
1507         default:
1508                 cant_happen();
1509         }
1510
1511         if (after_assign)
1512                 (*after_assign)();
1513
1514         /* for postincrement or postdecrement, return the old value */
1515         return (post ? tmp_number(lval) : *lhs);
1516 }
1517
1518 /*
1519  * Avoiding memory leaks is difficult.  In paticular, any of `next',
1520  * `nextfile', `break' or `continue' (when not in a loop), can longjmp
1521  * out to the outermost level.  This leaks memory if it happens in a
1522  * called function. It also leaks memory if it happens in a
1523  * `for (iggy in foo)' loop, since such loops malloc an array of the
1524  * current array indices to loop over, which provides stability.
1525  *
1526  * The following code takes care of these problems.  First comes the
1527  * array-loop management code.  This can be a stack of arrays being looped
1528  * on at any one time.  This stack serves for both mainline code and
1529  * function body code. As each loop starts and finishes, it pushes its
1530  * info onto this stack and off of it; whether the loop is in a function
1531  * body or not isn't relevant.
1532  *
1533  * Since the list of indices is created using dupnode(), when popping
1534  * this stack it should be safe to unref() things, and then memory
1535  * will get finally released when the function call stack is popped.
1536  * This means that the loop_stack should be popped first upon a `next'.
1537  */
1538
1539 static struct loop_info {
1540         const char *varname;    /* variable name, for debugging */
1541         NODE **elems;           /* list of indices */
1542         size_t nelems;          /* how many there are */
1543 } *loop_stack = NULL;
1544 size_t nloops = 0;              /* how many slots there are in the stack */
1545 size_t nloops_active = 0;       /* how many loops are actively stacked */
1546
1547 /* pop_forloop --- pop one for loop off the stack */
1548
1549 static void
1550 pop_forloop()
1551 {
1552         int i, curloop;
1553         struct loop_info *loop;
1554
1555         assert(nloops_active > 0);
1556
1557         curloop = --nloops_active;      /* 0-based indexing */
1558         loop = & loop_stack[curloop];
1559
1560         for (i = 0; i < loop->nelems; i++)
1561                 unref(loop->elems[i]);
1562
1563         free(loop->elems);
1564
1565         loop->elems = NULL;
1566         loop->varname = NULL;
1567         loop->nelems = 0;
1568 }
1569
1570 /* pop_forloops --- pop the for loops stack all the way */
1571
1572 static inline void
1573 pop_all_forloops()
1574 {
1575         while (nloops_active > 0)
1576                 pop_forloop();  /* decrements nloops_active for us */
1577 }
1578
1579 /* push_forloop --- add a single for loop to the stack */
1580
1581 static void
1582 push_forloop(const char *varname, NODE **elems, size_t nelems)
1583 {
1584 #define NLOOPS  4       /* seems like a good guess */
1585         if (loop_stack == NULL) {
1586                 /* allocate stack, set vars */
1587                 nloops = NLOOPS;
1588                 emalloc(loop_stack, struct loop_info *, nloops * sizeof(struct loop_info),
1589                                 "push_forloop");
1590         } else if (nloops_active == nloops) {
1591                 /* grow stack, set vars */
1592                 nloops *= 2;
1593                 erealloc(loop_stack, struct loop_info *, nloops * sizeof(struct loop_info),
1594                                 "push_forloop");
1595         }
1596
1597         loop_stack[nloops_active].varname = varname;
1598         loop_stack[nloops_active].elems = elems;
1599         loop_stack[nloops_active].nelems = nelems;
1600         nloops_active++;
1601 }
1602
1603 /*
1604  * 2/2004:
1605  * N.B. The code that uses fcalls[] *always* uses indexing.
1606  * This avoids severe problems in case fcalls gets realloc()'ed
1607  * during recursive tree_eval()'s or whatever, so that we don't
1608  * have to carefully reassign pointers into the array.  The
1609  * minor speed gain from using a pointer was offset too much
1610  * by the hassles to get the code right and commented.
1611  *
1612  * Thanks and a tip of the hatlo to Brian Kernighan.
1613  */
1614
1615 static struct fcall {
1616         const char *fname;      /* function name */
1617         size_t count;           /* how many args */
1618         NODE *arglist;          /* list thereof */
1619         NODE **prevstack;       /* function stack frame of previous function */
1620         NODE **stack;           /* function stack frame of current function */
1621 } *fcalls = NULL;
1622
1623 static long fcall_list_size = 0;
1624 static long curfcall = -1;
1625
1626 /*
1627  * get_curfunc_arg_count --- return number actual parameters
1628  *
1629  * This is for use by dynamically loaded C extension functions.
1630  */
1631 size_t
1632 get_curfunc_arg_count(void)
1633 {
1634         NODE *argp;
1635         size_t argc;
1636
1637         assert(curfcall >= 0);
1638
1639         /* count the # of expressions in argument expression list */
1640         for (argc = 0, argp = fcalls[curfcall].arglist;
1641              argp != NULL; argp = argp->rnode)
1642                 argc++;
1643
1644         return argc;
1645 }
1646
1647 /* pop_fcall --- pop off a single function call */
1648
1649 static void
1650 pop_fcall()
1651 {
1652         NODE *n, **sp;
1653         int count;
1654
1655         assert(curfcall >= 0);
1656         stack_ptr = fcalls[curfcall].prevstack;
1657
1658         sp = fcalls[curfcall].stack;
1659
1660         for (count = fcalls[curfcall].count; count > 0; count--) {
1661                 n = *sp++;
1662                 if (n->type == Node_var)                /* local variable */
1663                         unref(n->var_value);
1664                 else if (n->type == Node_var_array)     /* local array */
1665                         assoc_clear(n);
1666                 freenode(n);
1667         }
1668         if (fcalls[curfcall].stack) {
1669                 free((char *) fcalls[curfcall].stack);
1670                 fcalls[curfcall].stack = NULL;
1671         }
1672         curfcall--;
1673 }
1674
1675 /* pop_fcall_stack --- pop off all function args, don't leak memory */
1676
1677 static inline void
1678 pop_fcall_stack()
1679 {
1680         while (curfcall >= 0)
1681                 pop_fcall();
1682 }
1683
1684 /* push_args --- push function arguments onto the stack */
1685
1686 static void
1687 push_args(int count,
1688         NODE *argp,
1689         NODE **oldstack,
1690         const char *func_name,
1691         char **varnames)
1692 {
1693         NODE *arg, *r, **sp;
1694         int i;
1695
1696         if (fcall_list_size == 0) {     /* first time */
1697                 emalloc(fcalls, struct fcall *, 10 * sizeof(struct fcall),
1698                         "push_args");
1699                 fcall_list_size = 10;
1700         }
1701
1702         if (++curfcall >= fcall_list_size) {
1703                 fcall_list_size *= 2;
1704                 erealloc(fcalls, struct fcall *,
1705                         fcall_list_size * sizeof(struct fcall), "push_args");
1706         }
1707
1708         if (count > 0)
1709                 emalloc(fcalls[curfcall].stack, NODE **, count*sizeof(NODE *), "push_args");
1710         else
1711                 fcalls[curfcall].stack = NULL;
1712         fcalls[curfcall].count = count;
1713         fcalls[curfcall].fname = func_name;     /* not used, for debugging, just in case */
1714         fcalls[curfcall].arglist = argp;
1715         fcalls[curfcall].prevstack = oldstack;
1716
1717         sp = fcalls[curfcall].stack;
1718
1719         /* for each calling arg. add NODE * on stack */
1720         for (i = 0; i < count; i++) {
1721                 getnode(r);
1722                 *sp++ = r;
1723                 if (argp == NULL) {
1724                         /* local variable */
1725                         r->type = Node_var_new;
1726                         r->var_value = Nnull_string;
1727                         r->vname = varnames[i];
1728                         r->rnode = NULL;
1729                         continue;
1730                 }
1731                 arg = argp->lnode;
1732                 /* call by reference for arrays; see below also */
1733                 if (arg->type == Node_param_list)
1734                         arg = fcalls[curfcall].prevstack[arg->param_cnt];
1735
1736                 if (arg->type == Node_var_array || arg->type == Node_var_new) {
1737                         r->type = Node_array_ref;
1738                         r->orig_array = arg;
1739                         r->prev_array = arg;
1740                 } else if (arg->type == Node_array_ref) {
1741                         *r = *arg;
1742                         r->prev_array = arg;
1743                 } else {
1744                         NODE *n = tree_eval(arg);
1745
1746                         r->type = Node_var;
1747                         r->lnode = dupnode(n);
1748                         r->rnode = (NODE *) NULL;
1749                         free_temp(n);
1750                 }
1751                 r->vname = varnames[i];
1752                 argp = argp->rnode;
1753         }
1754
1755         if (argp != NULL) {
1756                 /* Left over calling args. */
1757                 warning(
1758                     _("function `%s' called with more arguments than declared"),
1759                     func_name);
1760                 /* Evaluate them, they may have side effects: */
1761                 do {
1762                         arg = argp->lnode;
1763                         if (arg->type == Node_param_list)
1764                                 arg = fcalls[curfcall].prevstack[arg->param_cnt];
1765                         if (arg->type != Node_var_array &&
1766                             arg->type != Node_array_ref &&
1767                             arg->type != Node_var_new)
1768                                 free_temp(tree_eval(arg));
1769                 } while ((argp = argp->rnode) != NULL);
1770         }
1771
1772         stack_ptr = fcalls[curfcall].stack;
1773 }
1774
1775 /* func_call --- call a function, call by reference for arrays */
1776
1777 NODE **stack_ptr;
1778
1779 static NODE *
1780 func_call(NODE *tree)
1781 {
1782         register NODE *r;
1783         NODE *name, *arg_list;
1784         NODE *f;
1785         jmp_buf volatile func_tag_stack;
1786         jmp_buf volatile loop_tag_stack;
1787         int volatile save_loop_tag_valid = FALSE;
1788         NODE *save_ret_node;
1789         extern NODE *ret_node;
1790
1791         /* tree->rnode is a Node_val giving function name */
1792         /* tree->lnode is Node_expression_list of calling args. */
1793         name = tree->rnode;
1794         arg_list = tree->lnode;
1795
1796         /* retrieve function definition node */
1797         if (tree->funcbody != NULL)
1798                 f = tree->funcbody;
1799         else {
1800                 f = lookup(name->stptr);
1801                 if (f == NULL || f->type != Node_func)
1802                         fatal(_("function `%s' not defined"), name->stptr);
1803
1804                 tree->funcbody = f;     /* save for next call */
1805         }
1806
1807 #ifdef FUNC_TRACE
1808         fprintf(stderr, "function `%s' called\n", name->stptr);
1809 #endif
1810         push_args(f->lnode->param_cnt, arg_list, stack_ptr, name->stptr,
1811                         f->parmlist);
1812
1813         /*
1814          * Execute function body, saving context, as a return statement
1815          * will longjmp back here.
1816          *
1817          * Have to save and restore the loop_tag stuff so that a return
1818          * inside a loop in a function body doesn't scrog any loops going
1819          * on in the main program.  We save the necessary info in variables
1820          * local to this function so that function nesting works OK.
1821          * We also only bother to save the loop stuff if we're in a loop
1822          * when the function is called.
1823          */
1824         if (loop_tag_valid) {
1825                 int junk = 0;
1826
1827                 save_loop_tag_valid = (volatile int) loop_tag_valid;
1828                 PUSH_BINDING(loop_tag_stack, loop_tag, junk);
1829                 loop_tag_valid = FALSE;
1830         }
1831         PUSH_BINDING(func_tag_stack, func_tag, func_tag_valid);
1832         save_ret_node = ret_node;
1833         ret_node = Nnull_string;        /* default return value */
1834         INCREMENT(f->exec_count);       /* count function calls */
1835         if (setjmp(func_tag) == 0)
1836                 (void) interpret(f->rnode);
1837
1838         r = ret_node;
1839         ret_node = (NODE *) save_ret_node;
1840         RESTORE_BINDING(func_tag_stack, func_tag, func_tag_valid);
1841         pop_fcall();
1842
1843         /* Restore the loop_tag stuff if necessary. */
1844         if (save_loop_tag_valid) {
1845                 int junk = 0;
1846
1847                 loop_tag_valid = (int) save_loop_tag_valid;
1848                 RESTORE_BINDING(loop_tag_stack, loop_tag, junk);
1849         }
1850
1851         return r;
1852 }
1853
1854 #ifdef PROFILING
1855 /* dump_fcall_stack --- print a backtrace of the awk function calls */
1856
1857 void
1858 dump_fcall_stack(FILE *fp)
1859 {
1860         int i;
1861
1862         if (curfcall < 0)
1863                 return;
1864
1865         fprintf(fp, _("\n\t# Function Call Stack:\n\n"));
1866         for (i = curfcall; i >= 0; i--)
1867                 fprintf(fp, "\t# %3d. %s\n", i+1, fcalls[i].fname);
1868         fprintf(fp, _("\t# -- main --\n"));
1869 }
1870 #endif /* PROFILING */
1871
1872 /*
1873  * r_get_lhs:
1874  * This returns a POINTER to a node pointer. get_lhs(ptr) is the current
1875  * value of the var, or where to store the var's new value
1876  *
1877  * For the special variables, don't unref their current value if it's
1878  * the same as the internal copy; perhaps the current one is used in
1879  * a concatenation or some other expression somewhere higher up in the
1880  * call chain.  Ouch.
1881  */
1882
1883 NODE **
1884 r_get_lhs(register NODE *ptr, Func_ptr *assign, int reference)
1885 {
1886         register NODE **aptr = NULL;
1887         register NODE *n;
1888
1889         if (assign)
1890                 *assign = NULL; /* for safety */
1891         if (ptr->type == Node_param_list) {
1892                 if ((ptr->flags & FUNC) != 0)
1893                         fatal(_("can't use function name `%s' as variable or array"), ptr->vname);
1894                 ptr = stack_ptr[ptr->param_cnt];
1895         }
1896
1897         make_scalar(ptr);
1898
1899         switch (ptr->type) {
1900         case Node_var:
1901                 if (do_lint && reference && var_uninitialized(ptr))
1902                         lintwarn(_("reference to uninitialized variable `%s'"),
1903                                               ptr->vname);
1904
1905                 aptr = &(ptr->var_value);
1906 #ifdef GAWKDEBUG
1907                 if (ptr->var_value->stref <= 0)
1908                         cant_happen();
1909 #endif
1910                 break;
1911
1912         case Node_FIELDWIDTHS:
1913                 aptr = &(FIELDWIDTHS_node->var_value);
1914                 if (assign != NULL)
1915                         *assign = set_FIELDWIDTHS;
1916                 break;
1917
1918         case Node_RS:
1919                 aptr = &(RS_node->var_value);
1920                 if (assign != NULL)
1921                         *assign = set_RS;
1922                 break;
1923
1924         case Node_FS:
1925                 aptr = &(FS_node->var_value);
1926                 if (assign != NULL)
1927                         *assign = set_FS;
1928                 break;
1929
1930         case Node_FNR:
1931                 if (FNR_node->var_value->numbr != FNR) {
1932                         unref(FNR_node->var_value);
1933                         FNR_node->var_value = make_number((AWKNUM) FNR);
1934                 }
1935                 aptr = &(FNR_node->var_value);
1936                 if (assign != NULL)
1937                         *assign = set_FNR;
1938                 break;
1939
1940         case Node_NR:
1941                 if (NR_node->var_value->numbr != NR) {
1942                         unref(NR_node->var_value);
1943                         NR_node->var_value = make_number((AWKNUM) NR);
1944                 }
1945                 aptr = &(NR_node->var_value);
1946                 if (assign != NULL)
1947                         *assign = set_NR;
1948                 break;
1949
1950         case Node_NF:
1951                 if (NF == -1 || NF_node->var_value->numbr != NF) {
1952                         if (NF == -1)
1953                                 (void) get_field(UNLIMITED-1, assign); /* parse record */
1954                         unref(NF_node->var_value);
1955                         NF_node->var_value = make_number((AWKNUM) NF);
1956                 }
1957                 aptr = &(NF_node->var_value);
1958                 if (assign != NULL)
1959                         *assign = set_NF;
1960                 break;
1961
1962         case Node_IGNORECASE:
1963                 aptr = &(IGNORECASE_node->var_value);
1964                 if (assign != NULL)
1965                         *assign = set_IGNORECASE;
1966                 break;
1967
1968         case Node_BINMODE:
1969                 aptr = &(BINMODE_node->var_value);
1970                 if (assign != NULL)
1971                         *assign = set_BINMODE;
1972                 break;
1973
1974         case Node_LINT:
1975                 aptr = &(LINT_node->var_value);
1976                 if (assign != NULL)
1977                         *assign = set_LINT;
1978                 break;
1979
1980         case Node_OFMT:
1981                 aptr = &(OFMT_node->var_value);
1982                 if (assign != NULL)
1983                         *assign = set_OFMT;
1984                 break;
1985
1986         case Node_CONVFMT:
1987                 aptr = &(CONVFMT_node->var_value);
1988                 if (assign != NULL)
1989                         *assign = set_CONVFMT;
1990                 break;
1991
1992         case Node_ORS:
1993                 aptr = &(ORS_node->var_value);
1994                 if (assign != NULL)
1995                         *assign = set_ORS;
1996                 break;
1997
1998         case Node_OFS:
1999                 aptr = &(OFS_node->var_value);
2000                 if (assign != NULL)
2001                         *assign = set_OFS;
2002                 break;
2003
2004         case Node_SUBSEP:
2005                 aptr = &(SUBSEP_node->var_value);
2006                 if (assign != NULL)
2007                         *assign = set_SUBSEP;
2008                 break;
2009
2010         case Node_TEXTDOMAIN:
2011                 aptr = &(TEXTDOMAIN_node->var_value);
2012                 if (assign != NULL)
2013                         *assign = set_TEXTDOMAIN;
2014                 break;
2015
2016         case Node_field_spec:
2017                 {
2018                 int field_num;
2019
2020                 n = tree_eval(ptr->lnode);
2021                 if (do_lint) {
2022                         if ((n->flags & NUMBER) == 0) {
2023                                 lintwarn(_("attempt to field reference from non-numeric value"));
2024                                 if (n->stlen == 0)
2025                                         lintwarn(_("attempt to reference from null string"));
2026                         }
2027                 }
2028                 field_num = (int) force_number(n);
2029                 free_temp(n);
2030                 if (field_num < 0)
2031                         fatal(_("attempt to access field %d"), field_num);
2032                 if (field_num == 0 && field0_valid) {   /* short circuit */
2033                         aptr = &fields_arr[0];
2034                         if (assign != NULL)
2035                                 *assign = reset_record;
2036                 } else
2037                         aptr = get_field(field_num, assign);
2038                 if (do_lint && reference && (*aptr == Null_field || *aptr == Nnull_string))
2039                         lintwarn(_("reference to uninitialized field `$%d'"),
2040                                               field_num);
2041                 break;
2042                 }
2043
2044         case Node_subscript:
2045                 n = get_array(ptr->lnode);
2046                 aptr = assoc_lookup(n, concat_exp(ptr->rnode), reference);
2047                 break;
2048
2049         case Node_builtin:
2050 #if 1
2051                 /* in gawk for a while */
2052                 fatal(_("assignment is not allowed to result of builtin function"));
2053 #else
2054                 /*
2055                  * This is how Christos at Deshaw did it.
2056                  * Does this buy us anything?
2057                  */
2058                 if (ptr->builtin == NULL)
2059                         fatal(_("assignment is not allowed to result of builtin function"));
2060                 ptr->callresult = (*ptr->builtin)(ptr->subnode);
2061                 aptr = &ptr->callresult;
2062                 break;
2063 #endif
2064
2065         default:
2066                 fprintf(stderr, "type = %s\n", nodetype2str(ptr->type));
2067                 fflush(stderr);
2068                 cant_happen();
2069         }
2070         return aptr;
2071 }
2072
2073 /* match_op --- do ~ and !~ */
2074
2075 static NODE *
2076 match_op(register NODE *tree)
2077 {
2078         register NODE *t1;
2079         register Regexp *rp;
2080         int i;
2081         int match = TRUE;
2082         int kludge_need_start = 0;      /* FIXME: --- see below */
2083
2084         if (tree->type == Node_nomatch)
2085                 match = FALSE;
2086         if (tree->type == Node_regex)
2087                 t1 = *get_field(0, (Func_ptr *) 0);
2088         else {
2089                 t1 = force_string(tree_eval(tree->lnode));
2090                 tree = tree->rnode;
2091         }
2092         rp = re_update(tree);
2093         /*
2094          * FIXME:
2095          *
2096          * Any place where research() is called with a last parameter of
2097          * zero, we need to use the avoid_dfa test. This appears here and
2098          * in the code for Node_K_switch.
2099          *
2100          * A new or improved dfa that distinguishes beginning/end of
2101          * string from beginning/end of line will allow us to get rid of
2102          * this temporary hack.
2103          *
2104          * The avoid_dfa() function is in re.c; it is not very smart.
2105          */
2106         if (avoid_dfa(tree, t1->stptr, t1->stlen))
2107                 kludge_need_start = RE_NEED_START;
2108         i = research(rp, t1->stptr, 0, t1->stlen, kludge_need_start);
2109         i = (i == -1) ^ (match == TRUE);
2110         free_temp(t1);
2111         return tmp_number((AWKNUM) i);
2112 }
2113
2114 /* set_IGNORECASE --- update IGNORECASE as appropriate */
2115
2116 void
2117 set_IGNORECASE()
2118 {
2119         static int warned = FALSE;
2120
2121         if ((do_lint || do_traditional) && ! warned) {
2122                 warned = TRUE;
2123                 lintwarn(_("`IGNORECASE' is a gawk extension"));
2124         }
2125         load_casetable();
2126         if (do_traditional)
2127                 IGNORECASE = FALSE;
2128         else if ((IGNORECASE_node->var_value->flags & (STRING|STRCUR)) != 0) {
2129                 if ((IGNORECASE_node->var_value->flags & MAYBE_NUM) == 0)
2130                         IGNORECASE = (force_string(IGNORECASE_node->var_value)->stlen > 0);
2131                 else
2132                         IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
2133         } else if ((IGNORECASE_node->var_value->flags & (NUMCUR|NUMBER)) != 0)
2134                 IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
2135         else
2136                 IGNORECASE = FALSE;             /* shouldn't happen */
2137
2138         set_RS();       /* set_RS() calls set_FS() if need be, for us */
2139 }
2140
2141 /* set_BINMODE --- set translation mode (OS/2, DOS, others) */
2142
2143 void
2144 set_BINMODE()
2145 {
2146         static int warned = FALSE;
2147         char *p, *cp, save;
2148         NODE *v;
2149         int digits = FALSE;
2150
2151         if ((do_lint || do_traditional) && ! warned) {
2152                 warned = TRUE;
2153                 lintwarn(_("`BINMODE' is a gawk extension"));
2154         }
2155         if (do_traditional)
2156                 BINMODE = 0;
2157         else if ((BINMODE_node->var_value->flags & STRING) != 0) {
2158                 v = BINMODE_node->var_value;
2159                 p = v->stptr;
2160                 save = p[v->stlen];
2161                 p[v->stlen] = '\0';
2162
2163                 for (cp = p; *cp != '\0'; cp++) {
2164                         if (ISDIGIT(*cp)) {
2165                                 digits = TRUE;
2166                                 break;
2167                         }
2168                 }
2169
2170                 if (! digits || (BINMODE_node->var_value->flags & MAYBE_NUM) == 0) {
2171                         BINMODE = 0;
2172                         if (strcmp(p, "r") == 0)
2173                                 BINMODE = 1;
2174                         else if (strcmp(p, "w") == 0)
2175                                 BINMODE = 2;
2176                         else if (strcmp(p, "rw") == 0 || strcmp(p, "wr") == 0)
2177                                 BINMODE = 3;
2178
2179                         if (BINMODE == 0 && v->stlen != 0) {
2180                                 /* arbitrary string, assume both */
2181                                 BINMODE = 3;
2182                                 warning("BINMODE: arbitrary string value treated as \"rw\"");
2183                         }
2184                 } else
2185                         BINMODE = (int) force_number(BINMODE_node->var_value);
2186
2187                 p[v->stlen] = save;
2188         } else if ((BINMODE_node->var_value->flags & NUMBER) != 0)
2189                 BINMODE = (int) force_number(BINMODE_node->var_value);
2190         else
2191                 BINMODE = 0;            /* shouldn't happen */
2192 }
2193
2194 /* set_OFS --- update OFS related variables when OFS assigned to */
2195
2196 void
2197 set_OFS()
2198 {
2199         OFS = force_string(OFS_node->var_value)->stptr;
2200         OFSlen = OFS_node->var_value->stlen;
2201         OFS[OFSlen] = '\0';
2202 }
2203
2204 /* set_ORS --- update ORS related variables when ORS assigned to */
2205
2206 void
2207 set_ORS()
2208 {
2209         ORS = force_string(ORS_node->var_value)->stptr;
2210         ORSlen = ORS_node->var_value->stlen;
2211         ORS[ORSlen] = '\0';
2212 }
2213
2214 /* fmt_ok --- is the conversion format a valid one? */
2215
2216 NODE **fmt_list = NULL;
2217 static int fmt_ok P((NODE *n));
2218 static int fmt_index P((NODE *n));
2219
2220 static int
2221 fmt_ok(NODE *n)
2222 {
2223         NODE *tmp = force_string(n);
2224         const char *p = tmp->stptr;
2225 #if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1
2226         static const char float_formats[] = "efgEG";
2227 #else
2228         static const char float_formats[] = "efgEFG";
2229 #endif
2230 #if defined(HAVE_LOCALE_H)
2231         static const char flags[] = " +-#'";
2232 #else
2233         static const char flags[] = " +-#";
2234 #endif
2235
2236         if (*p++ != '%')
2237                 return 0;
2238         while (*p && strchr(flags, *p) != NULL) /* flags */
2239                 p++;
2240         while (*p && ISDIGIT(*p))       /* width - %*.*g is NOT allowed */
2241                 p++;
2242         if (*p == '\0' || (*p != '.' && ! ISDIGIT(*p)))
2243                 return 0;
2244         if (*p == '.')
2245                 p++;
2246         while (*p && ISDIGIT(*p))       /* precision */
2247                 p++;
2248         if (*p == '\0' || strchr(float_formats, *p) == NULL)
2249                 return 0;
2250         if (*++p != '\0')
2251                 return 0;
2252         return 1;
2253 }
2254
2255 /* fmt_index --- track values of OFMT and CONVFMT to keep semantics correct */
2256
2257 static int
2258 fmt_index(NODE *n)
2259 {
2260         register int ix = 0;
2261         static int fmt_num = 4;
2262         static int fmt_hiwater = 0;
2263
2264         if (fmt_list == NULL)
2265                 emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
2266         (void) force_string(n);
2267         while (ix < fmt_hiwater) {
2268                 if (cmp_nodes(fmt_list[ix], n) == 0)
2269                         return ix;
2270                 ix++;
2271         }
2272         /* not found */
2273         n->stptr[n->stlen] = '\0';
2274         if (do_lint && ! fmt_ok(n))
2275                 lintwarn(_("bad `%sFMT' specification `%s'"),
2276                             n == CONVFMT_node->var_value ? "CONV"
2277                           : n == OFMT_node->var_value ? "O"
2278                           : "", n->stptr);
2279
2280         if (fmt_hiwater >= fmt_num) {
2281                 fmt_num *= 2;
2282                 erealloc(fmt_list, NODE **, fmt_num * sizeof(*fmt_list), "fmt_index");
2283         }
2284         fmt_list[fmt_hiwater] = dupnode(n);
2285         return fmt_hiwater++;
2286 }
2287
2288 /* set_OFMT --- track OFMT correctly */
2289
2290 void
2291 set_OFMT()
2292 {
2293         OFMTidx = fmt_index(OFMT_node->var_value);
2294         OFMT = fmt_list[OFMTidx]->stptr;
2295 }
2296
2297 /* set_CONVFMT --- track CONVFMT correctly */
2298
2299 void
2300 set_CONVFMT()
2301 {
2302         CONVFMTidx = fmt_index(CONVFMT_node->var_value);
2303         CONVFMT = fmt_list[CONVFMTidx]->stptr;
2304 }
2305
2306 /* set_LINT --- update LINT as appropriate */
2307
2308 void
2309 set_LINT()
2310 {
2311 #ifndef NO_LINT
2312         int old_lint = do_lint;
2313
2314         if ((LINT_node->var_value->flags & (STRING|STRCUR)) != 0) {
2315                 if ((LINT_node->var_value->flags & MAYBE_NUM) == 0) {
2316                         const char *lintval;
2317                         size_t lintlen;
2318
2319                         do_lint = (force_string(LINT_node->var_value)->stlen > 0);
2320                         lintval = LINT_node->var_value->stptr;
2321                         lintlen = LINT_node->var_value->stlen;
2322                         if (do_lint) {
2323                                 do_lint = LINT_ALL;
2324                                 if (lintlen == 5 && strncmp(lintval, "fatal", 5) == 0)
2325                                         lintfunc = r_fatal;
2326                                 else if (lintlen == 7 && strncmp(lintval, "invalid", 7) == 0)
2327                                         do_lint = LINT_INVALID;
2328                                 else
2329                                         lintfunc = warning;
2330                         } else
2331                                 lintfunc = warning;
2332                 } else {
2333                         if (force_number(LINT_node->var_value) != 0.0)
2334                                 do_lint = LINT_ALL;
2335                         else
2336                                 do_lint = FALSE;
2337                         lintfunc = warning;
2338                 }
2339         } else if ((LINT_node->var_value->flags & (NUMCUR|NUMBER)) != 0) {
2340                 if (force_number(LINT_node->var_value) != 0.0)
2341                         do_lint = LINT_ALL;
2342                 else
2343                         do_lint = FALSE;
2344                 lintfunc = warning;
2345         } else
2346                 do_lint = FALSE;                /* shouldn't happen */
2347
2348         if (! do_lint)
2349                 lintfunc = warning;
2350
2351         /* explicitly use warning() here, in case lintfunc == r_fatal */
2352         if (old_lint != do_lint && old_lint && do_lint == FALSE)
2353                 warning(_("turning off `--lint' due to assignment to `LINT'"));
2354 #endif /* ! NO_LINT */
2355 }
2356
2357 /* set_TEXTDOMAIN --- update TEXTDOMAIN variable when TEXTDOMAIN assigned to */
2358
2359 void
2360 set_TEXTDOMAIN()
2361 {
2362         int len;
2363
2364         TEXTDOMAIN = force_string(TEXTDOMAIN_node->var_value)->stptr;
2365         len = TEXTDOMAIN_node->var_value->stlen;
2366         TEXTDOMAIN[len] = '\0';
2367         /*
2368          * Note: don't call textdomain(); this value is for
2369          * the awk program, not for gawk itself.
2370          */
2371 }
2372
2373 /*
2374  * assign_val --- do mechanics of assignment, for calling from multiple
2375  *                places.
2376  */
2377
2378 NODE *
2379 assign_val(NODE **lhs_p, NODE *rhs)
2380 {
2381         if (rhs != *lhs_p) {
2382                 /*
2383                  * Since we know that the nodes are different,
2384                  * we can do the unref() before the dupnode().
2385                  */
2386                 unref(*lhs_p);
2387                 *lhs_p = dupnode(rhs);
2388         }
2389         return *lhs_p;
2390 }
2391
2392 /* update_ERRNO_saved --- update the value of ERRNO based on argument */
2393
2394 void
2395 update_ERRNO_saved(int errcode)
2396 {
2397         char *cp;
2398
2399         cp = strerror(errcode);
2400         cp = gettext(cp);
2401         unref(ERRNO_node->var_value);
2402         ERRNO_node->var_value = make_string(cp, strlen(cp));
2403 }
2404
2405 /* update_ERRNO --- update the value of ERRNO based on errno */
2406
2407 void
2408 update_ERRNO()
2409 {
2410         update_ERRNO_saved(errno);
2411 }
2412
2413 /* comp_func --- array index comparison function for qsort */
2414
2415 static int
2416 comp_func(const void *p1, const void *p2)
2417 {
2418         size_t len1, len2;
2419         const char *str1, *str2;
2420         const NODE *t1, *t2;
2421         int cmp1;
2422
2423         t1 = *((const NODE *const *) p1);
2424         t2 = *((const NODE *const *) p2);
2425
2426 /*
2427         t1 = force_string(t1);
2428         t2 = force_string(t2);
2429 */
2430         len1 = t1->ahname_len;
2431         str1 = t1->ahname_str;
2432
2433         len2 = t2->ahname_len;
2434         str2 = t2->ahname_str;
2435
2436         /* Array indexes are strings, compare as such, always! */
2437         cmp1 = memcmp(str1, str2, len1 < len2 ? len1 : len2);
2438         /* if prefixes are equal, size matters */
2439         return (cmp1 != 0 ? cmp1 :
2440                 len1 < len2 ? -1 : (len1 > len2));
2441 }