contrib/awk/eval.c

   1 /*
   2  * eval.c - gawk parse tree interpreter
   3  */
   4
   5 /*
   6  * Copyright (C) 1986, 1988, 1989, 1991-2000 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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
  24  *
  25  * $FreeBSD: src/contrib/awk/eval.c,v 1.4.2.1 2001/01/23 22:08:31 asmodai Exp $
  26  */
  27
  28 #include "awk.h"
  29
  30 extern double pow P((double x, double y));
  31 extern double modf P((double x, double *yp));
  32 extern double fmod P((double x, double y));
  33
  34 static int eval_condition P((NODE *tree));
  35 static NODE *op_assign P((NODE *tree));
  36 static NODE *func_call P((NODE *name, NODE *arg_list));
  37 static NODE *match_op P((NODE *tree));
  38 static void push_args P((int count, NODE *arglist, NODE **oldstack, char *func_name));
  39 static void pop_fcall_stack P((void));
  40 static void pop_fcall P((void));
  41 static int in_function P((void));
  42 char *nodetype2str P((NODETYPE type));
  43 char *flags2str P((int flagval));
  44
  45 #if __GNUC__ < 2
  46 NODE *_t;               /* used as a temporary in macros */
  47 #endif
  48 #ifdef MSDOS
  49 double _msc51bug;       /* to get around a bug in MSC 5.1 */
  50 #endif
  51 NODE *ret_node;
  52 int OFSlen;
  53 int ORSlen;
  54 int OFMTidx;
  55 int CONVFMTidx;
  56
  57 /* Macros and variables to save and restore function and loop bindings */
  58 /*
  59  * the val variable allows return/continue/break-out-of-context to be
  60  * caught and diagnosed
  61  */
  62 #define PUSH_BINDING(stack, x, val) (memcpy((char *)(stack), (char *)(x), sizeof(jmp_buf)), val++)
  63 #define RESTORE_BINDING(stack, x, val) (memcpy((char *)(x), (char *)(stack), sizeof(jmp_buf)), val--)
  64
  65 static jmp_buf loop_tag;                /* always the current binding */
  66 static int loop_tag_valid = FALSE;      /* nonzero when loop_tag valid */
  67 static int func_tag_valid = FALSE;
  68 static jmp_buf func_tag;
  69 extern int exiting, exit_val;
  70
  71 /* This rather ugly macro is for VMS C */
  72 #ifdef C
  73 #undef C
  74 #endif
  75 #define C(c) ((char)c)
  76 /*
  77  * This table is used by the regexp routines to do case independant
  78  * matching. Basically, every ascii character maps to itself, except
  79  * uppercase letters map to lower case ones. This table has 256
  80  * entries, for ISO 8859-1. Note also that if the system this
  81  * is compiled on doesn't use 7-bit ascii, casetable[] should not be
  82  * defined to the linker, so gawk should not load.
  83  *
  84  * Do NOT make this array static, it is used in several spots, not
  85  * just in this file.
  86  */
  87 #if 'a' == 97   /* it's ascii */
  88 char casetable[] = {
  89         '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
  90         '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
  91         '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
  92         '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
  93         /* ' '     '!'     '"'     '#'     '$'     '%'     '&'     ''' */
  94         '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
  95         /* '('     ')'     '*'     '+'     ','     '-'     '.'     '/' */
  96         '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
  97         /* '0'     '1'     '2'     '3'     '4'     '5'     '6'     '7' */
  98         '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
  99         /* '8'     '9'     ':'     ';'     '<'     '='     '>'     '?' */
 100         '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
 101         /* '@'     'A'     'B'     'C'     'D'     'E'     'F'     'G' */
 102         '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
 103         /* 'H'     'I'     'J'     'K'     'L'     'M'     'N'     'O' */
 104         '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
 105         /* 'P'     'Q'     'R'     'S'     'T'     'U'     'V'     'W' */
 106         '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
 107         /* 'X'     'Y'     'Z'     '['     '\'     ']'     '^'     '_' */
 108         '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
 109         /* '`'     'a'     'b'     'c'     'd'     'e'     'f'     'g' */
 110         '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
 111         /* 'h'     'i'     'j'     'k'     'l'     'm'     'n'     'o' */
 112         '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
 113         /* 'p'     'q'     'r'     's'     't'     'u'     'v'     'w' */
 114         '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
 115         /* 'x'     'y'     'z'     '{'     '|'     '}'     '~' */
 116         '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
 117 #ifndef USE_PURE_ASCII
 118         C('\200'), C('\201'), C('\202'), C('\203'), C('\204'), C('\205'), C('\206'), C('\207'),
 119         C('\210'), C('\211'), C('\212'), C('\213'), C('\214'), C('\215'), C('\216'), C('\217'),
 120         C('\220'), C('\221'), C('\222'), C('\223'), C('\224'), C('\225'), C('\226'), C('\227'),
 121         C('\230'), C('\231'), C('\232'), C('\233'), C('\234'), C('\235'), C('\236'), C('\237'),
 122         C('\240'), C('\241'), C('\242'), C('\243'), C('\244'), C('\245'), C('\246'), C('\247'),
 123         C('\250'), C('\251'), C('\252'), C('\253'), C('\254'), C('\255'), C('\256'), C('\257'),
 124         C('\260'), C('\261'), C('\262'), C('\263'), C('\264'), C('\265'), C('\266'), C('\267'),
 125         C('\270'), C('\271'), C('\272'), C('\273'), C('\274'), C('\275'), C('\276'), C('\277'),
 126         C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
 127         C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
 128         C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\327'),
 129         C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\337'),
 130         C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
 131         C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
 132         C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\367'),
 133         C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\377'),
 134 #else
 135         C('\200'), C('\201'), C('\202'), C('\203'), C('\204'), C('\205'), C('\206'), C('\207'),
 136         C('\210'), C('\211'), C('\212'), C('\213'), C('\214'), C('\215'), C('\216'), C('\217'),
 137         C('\220'), C('\221'), C('\222'), C('\223'), C('\224'), C('\225'), C('\226'), C('\227'),
 138         C('\230'), C('\231'), C('\232'), C('\233'), C('\234'), C('\235'), C('\236'), C('\237'),
 139         C('\240'), C('\241'), C('\242'), C('\243'), C('\244'), C('\245'), C('\246'), C('\247'),
 140         C('\250'), C('\251'), C('\252'), C('\253'), C('\254'), C('\255'), C('\256'), C('\257'),
 141         C('\260'), C('\261'), C('\262'), C('\263'), C('\264'), C('\265'), C('\266'), C('\267'),
 142         C('\270'), C('\271'), C('\272'), C('\273'), C('\274'), C('\275'), C('\276'), C('\277'),
 143         C('\300'), C('\301'), C('\302'), C('\303'), C('\304'), C('\305'), C('\306'), C('\307'),
 144         C('\310'), C('\311'), C('\312'), C('\313'), C('\314'), C('\315'), C('\316'), C('\317'),
 145         C('\320'), C('\321'), C('\322'), C('\323'), C('\324'), C('\325'), C('\326'), C('\327'),
 146         C('\330'), C('\331'), C('\332'), C('\333'), C('\334'), C('\335'), C('\336'), C('\337'),
 147         C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
 148         C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
 149         C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\367'),
 150         C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\377'),
 151 #endif
 152 };
 153 #else
 154 #include "You lose. You will need a translation table for your character set."
 155 #endif
 156
 157 #undef C
 158
 159 /*
 160  * This table maps node types to strings for debugging.
 161  * KEEP IN SYNC WITH awk.h!!!!
 162  */
 163 static char *nodetypes[] = {
 164         "Node_illegal",
 165         "Node_times",
 166         "Node_quotient",
 167         "Node_mod",
 168         "Node_plus",
 169         "Node_minus",
 170         "Node_cond_pair",
 171         "Node_subscript",
 172         "Node_concat",
 173         "Node_exp",
 174         "Node_preincrement",
 175         "Node_predecrement",
 176         "Node_postincrement",
 177         "Node_postdecrement",
 178         "Node_unary_minus",
 179         "Node_field_spec",
 180         "Node_assign",
 181         "Node_assign_times",
 182         "Node_assign_quotient",
 183         "Node_assign_mod",
 184         "Node_assign_plus",
 185         "Node_assign_minus",
 186         "Node_assign_exp",
 187         "Node_and",
 188         "Node_or",
 189         "Node_equal",
 190         "Node_notequal",
 191         "Node_less",
 192         "Node_greater",
 193         "Node_leq",
 194         "Node_geq",
 195         "Node_match",
 196         "Node_nomatch",
 197         "Node_not",
 198         "Node_rule_list",
 199         "Node_rule_node",
 200         "Node_statement_list",
 201         "Node_if_branches",
 202         "Node_expression_list",
 203         "Node_param_list",
 204         "Node_K_if",
 205         "Node_K_while",
 206         "Node_K_for",
 207         "Node_K_arrayfor",
 208         "Node_K_break",
 209         "Node_K_continue",
 210         "Node_K_print",
 211         "Node_K_printf",
 212         "Node_K_next",
 213         "Node_K_exit",
 214         "Node_K_do",
 215         "Node_K_return",
 216         "Node_K_delete",
 217         "Node_K_delete_loop",
 218         "Node_K_getline",
 219         "Node_K_function",
 220         "Node_K_nextfile",
 221         "Node_redirect_output",
 222         "Node_redirect_append",
 223         "Node_redirect_pipe",
 224         "Node_redirect_pipein",
 225         "Node_redirect_input",
 226         "Node_var",
 227         "Node_var_array",
 228         "Node_val",
 229         "Node_builtin",
 230         "Node_line_range",
 231         "Node_in_array",
 232         "Node_func",
 233         "Node_func_call",
 234         "Node_cond_exp",
 235         "Node_regex",
 236         "Node_hashnode",
 237         "Node_ahash",
 238         "Node_array_ref",
 239         "Node_NF",
 240         "Node_NR",
 241         "Node_FNR",
 242         "Node_FS",
 243         "Node_RS",
 244         "Node_FIELDWIDTHS",
 245         "Node_IGNORECASE",
 246         "Node_OFS",
 247         "Node_ORS",
 248         "Node_OFMT",
 249         "Node_CONVFMT",
 250         "Node_final",
 251         NULL
 252 };
 253
 254 char *
 255 nodetype2str(type)
 256 NODETYPE type;
 257 {
 258         static char buf[40];
 259
 260         if (type >= Node_illegal && type <= Node_final)
 261                 return nodetypes[(int) type];
 262
 263         sprintf(buf, "unknown nodetype %d", (int) type);
 264         return buf;
 265 }
 266
 267 /* flags2str --- make a flags value readable */
 268
 269 char *
 270 flags2str(flagval)
 271 int flagval;
 272 {
 273         static char buffer[BUFSIZ];
 274         char *sp;
 275
 276         sp = buffer;
 277
 278         if (flagval & MALLOC) {
 279                 strcpy(sp, "MALLOC");
 280                 sp += strlen(sp);
 281         }
 282         if (flagval & TEMP) {
 283                 if (sp != buffer)
 284                         *sp++ = '|';
 285                 strcpy(sp, "TEMP");
 286                 sp += strlen(sp);
 287         }
 288         if (flagval & PERM) {
 289                 if (sp != buffer)
 290                         *sp++ = '|';
 291                 strcpy(sp, "PERM");
 292                 sp += strlen(sp);
 293         }
 294         if (flagval & STRING) {
 295                 if (sp != buffer)
 296                         *sp++ = '|';
 297                 strcpy(sp, "STRING");
 298                 sp += strlen(sp);
 299         }
 300         if (flagval & STR) {
 301                 if (sp != buffer)
 302                         *sp++ = '|';
 303                 strcpy(sp, "STR");
 304                 sp += strlen(sp);
 305         }
 306         if (flagval & NUM) {
 307                 if (sp != buffer)
 308                         *sp++ = '|';
 309                 strcpy(sp, "NUM");
 310                 sp += strlen(sp);
 311         }
 312         if (flagval & NUMBER) {
 313                 if (sp != buffer)
 314                         *sp++ = '|';
 315                 strcpy(sp, "NUMBER");
 316                 sp += strlen(sp);
 317         }
 318         if (flagval & MAYBE_NUM) {
 319                 if (sp != buffer)
 320                         *sp++ = '|';
 321                 strcpy(sp, "MAYBE_NUM");
 322                 sp += strlen(sp);
 323         }
 324         if (flagval & ARRAYMAXED) {
 325                 if (sp != buffer)
 326                         *sp++ = '|';
 327                 strcpy(sp, "ARRAYMAXED");
 328                 sp += strlen(sp);
 329         }
 330         if (flagval & SCALAR) {
 331                 if (sp != buffer)
 332                         *sp++ = '|';
 333                 strcpy(sp, "SCALAR");
 334                 sp += strlen(sp);
 335         }
 336         if (flagval & FUNC) {
 337                 if (sp != buffer)
 338                         *sp++ = '|';
 339                 strcpy(sp, "FUNC");
 340                 sp += strlen(sp);
 341         }
 342         if (flagval & FIELD) {
 343                 if (sp != buffer)
 344                         *sp++ = '|';
 345                 strcpy(sp, "FIELD");
 346                 sp += strlen(sp);
 347         }
 348
 349         return buffer;
 350 }
 351
 352 /*
 353  * interpret:
 354  * Tree is a bunch of rules to run. Returns zero if it hit an exit()
 355  * statement
 356  */
 357 int
 358 interpret(tree)
 359 register NODE *volatile tree;
 360 {
 361         jmp_buf volatile loop_tag_stack; /* shallow binding stack for loop_tag */
 362         static jmp_buf rule_tag; /* tag the rule currently being run, for NEXT
 363                                   * and EXIT statements.  It is static because
 364                                   * there are no nested rules */
 365         register NODE *volatile t = NULL;       /* temporary */
 366         NODE **volatile lhs;    /* lhs == Left Hand Side for assigns, etc */
 367         NODE *volatile stable_tree;
 368         int volatile traverse = TRUE;   /* True => loop thru tree (Node_rule_list) */
 369
 370         /* avoid false source indications */
 371         source = NULL;
 372         sourceline = 0;
 373
 374         if (tree == NULL)
 375                 return 1;
 376         sourceline = tree->source_line;
 377         source = tree->source_file;
 378         switch (tree->type) {
 379         case Node_rule_node:
 380                 traverse = FALSE;  /* False => one for-loop iteration only */
 381                 /* FALL THROUGH */
 382         case Node_rule_list:
 383                 for (t = tree; t != NULL; t = t->rnode) {
 384                         if (traverse)
 385                                 tree = t->lnode;
 386                         sourceline = tree->source_line;
 387                         source = tree->source_file;
 388                         switch (setjmp(rule_tag)) {
 389                         case 0: /* normal non-jump */
 390                                 /* test pattern, if any */
 391                                 if (tree->lnode == NULL ||
 392                                     eval_condition(tree->lnode))
 393                                         (void) interpret(tree->rnode);
 394                                 break;
 395                         case TAG_CONTINUE:      /* NEXT statement */
 396                                 return 1;
 397                         case TAG_BREAK:
 398                                 return 0;
 399                         default:
 400                                 cant_happen();
 401                         }
 402                         if (! traverse)         /* case Node_rule_node */
 403                                 break;          /* don't loop */
 404                 }
 405                 break;
 406
 407         case Node_statement_list:
 408                 for (t = tree; t != NULL; t = t->rnode)
 409                         (void) interpret(t->lnode);
 410                 break;
 411
 412         case Node_K_if:
 413                 if (eval_condition(tree->lnode))
 414                         (void) interpret(tree->rnode->lnode);
 415                 else
 416                         (void) interpret(tree->rnode->rnode);
 417                 break;
 418
 419         case Node_K_while:
 420                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 421
 422                 stable_tree = tree;
 423                 while (eval_condition(stable_tree->lnode)) {
 424                         switch (setjmp(loop_tag)) {
 425                         case 0: /* normal non-jump */
 426                                 (void) interpret(stable_tree->rnode);
 427                                 break;
 428                         case TAG_CONTINUE:      /* continue statement */
 429                                 break;
 430                         case TAG_BREAK: /* break statement */
 431                                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 432                                 return 1;
 433                         default:
 434                                 cant_happen();
 435                         }
 436                 }
 437                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 438                 break;
 439
 440         case Node_K_do:
 441                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 442                 stable_tree = tree;
 443                 do {
 444                         switch (setjmp(loop_tag)) {
 445                         case 0: /* normal non-jump */
 446                                 (void) interpret(stable_tree->rnode);
 447                                 break;
 448                         case TAG_CONTINUE:      /* continue statement */
 449                                 break;
 450                         case TAG_BREAK: /* break statement */
 451                                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 452                                 return 1;
 453                         default:
 454                                 cant_happen();
 455                         }
 456                 } while (eval_condition(stable_tree->lnode));
 457                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 458                 break;
 459
 460         case Node_K_for:
 461                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 462                 (void) interpret(tree->forloop->init);
 463                 stable_tree = tree;
 464                 while (eval_condition(stable_tree->forloop->cond)) {
 465                         switch (setjmp(loop_tag)) {
 466                         case 0: /* normal non-jump */
 467                                 (void) interpret(stable_tree->lnode);
 468                                 /* fall through */
 469                         case TAG_CONTINUE:      /* continue statement */
 470                                 (void) interpret(stable_tree->forloop->incr);
 471                                 break;
 472                         case TAG_BREAK: /* break statement */
 473                                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 474                                 return 1;
 475                         default:
 476                                 cant_happen();
 477                         }
 478                 }
 479                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 480                 break;
 481
 482         case Node_K_arrayfor:
 483                 {
 484                 volatile struct search l;       /* For array_for */
 485                 Func_ptr after_assign = NULL;
 486
 487 #define hakvar forloop->init
 488 #define arrvar forloop->incr
 489                 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 490                 lhs = get_lhs(tree->hakvar, &after_assign);
 491                 t = tree->arrvar;
 492                 if (t->type == Node_param_list)
 493                         t = stack_ptr[t->param_cnt];
 494                 if (t->type == Node_array_ref)
 495                         t = t->orig_array;
 496                 stable_tree = tree;
 497                 if ((t->flags & SCALAR) != 0)
 498                         fatal("attempt to use scalar as array");
 499                 for (assoc_scan(t, (struct search *)&l);
 500                      l.retval;
 501                      assoc_next((struct search *)&l)) {
 502                         unref(*((NODE **) lhs));
 503                         *lhs = dupnode(l.retval);
 504                         if (after_assign)
 505                                 (*after_assign)();
 506                         switch (setjmp(loop_tag)) {
 507                         case 0:
 508                                 (void) interpret(stable_tree->lnode);
 509                         case TAG_CONTINUE:
 510                                 break;
 511
 512                         case TAG_BREAK:
 513                                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 514                                 return 1;
 515                         default:
 516                                 cant_happen();
 517                         }
 518                 }
 519                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
 520                 break;
 521                 }
 522
 523         case Node_K_break:
 524                 if (! loop_tag_valid) {
 525                         /*
 526                          * Old AT&T nawk treats break outside of loops like
 527                          * next. New ones catch it at parse time. Allow it if
 528                          * do_traditional is on, and complain if lint.
 529                          */
 530                         static int warned = FALSE;
 531
 532                         if (do_lint && ! warned) {
 533                                 warning("use of `break' outside a loop is not portable");
 534                                 warned = TRUE;
 535                         }
 536                         if (! do_traditional || do_posix)
 537                                 fatal("use of `break' outside a loop is not allowed");
 538                         if (in_function())
 539                                 pop_fcall_stack();
 540                         longjmp(rule_tag, TAG_CONTINUE);
 541                 } else
 542                         longjmp(loop_tag, TAG_BREAK);
 543                 break;
 544
 545         case Node_K_continue:
 546                 if (! loop_tag_valid) {
 547                         /*
 548                          * Old AT&T nawk treats continue outside of loops like
 549                          * next. New ones catch it at parse time. Allow it if
 550                          * do_traditional is on, and complain if lint.
 551                          */
 552                         static int warned = FALSE;
 553
 554                         if (do_lint && ! warned) {
 555                                 warning("use of `continue' outside a loop is not portable");
 556                                 warned = TRUE;
 557                         }
 558                         if (! do_traditional || do_posix)
 559                                 fatal("use of `continue' outside a loop is not allowed");
 560                         if (in_function())
 561                                 pop_fcall_stack();
 562                         longjmp(rule_tag, TAG_CONTINUE);
 563                 } else
 564                         longjmp(loop_tag, TAG_CONTINUE);
 565                 break;
 566
 567         case Node_K_print:
 568                 do_print(tree);
 569                 break;
 570
 571         case Node_K_printf:
 572                 do_printf(tree);
 573                 break;
 574
 575         case Node_K_delete:
 576                 do_delete(tree->lnode, tree->rnode);
 577                 break;
 578
 579         case Node_K_delete_loop:
 580                 do_delete_loop(tree->lnode, tree->rnode);
 581                 break;
 582
 583         case Node_K_next:
 584                 if (in_begin_rule)
 585                         fatal("`next' cannot be called from a BEGIN rule");
 586                 else if (in_end_rule)
 587                         fatal("`next' cannot be called from an END rule");
 588
 589                 if (in_function())
 590                         pop_fcall_stack();
 591
 592                 longjmp(rule_tag, TAG_CONTINUE);
 593                 break;
 594
 595         case Node_K_nextfile:
 596                 if (in_begin_rule)
 597                         fatal("`nextfile' cannot be called from a BEGIN rule");
 598                 else if (in_end_rule)
 599                         fatal("`nextfile' cannot be called from an END rule");
 600
 601                 if (in_function())
 602                         pop_fcall_stack();
 603
 604                 do_nextfile();
 605                 break;
 606
 607         case Node_K_exit:
 608                 /*
 609                  * In A,K,&W, p. 49, it says that an exit statement "...
 610                  * causes the program to behave as if the end of input had
 611                  * occurred; no more input is read, and the END actions, if
 612                  * any are executed." This implies that the rest of the rules
 613                  * are not done. So we immediately break out of the main loop.
 614                  */
 615                 exiting = TRUE;
 616                 if (tree->lnode != NULL) {
 617                         t = tree_eval(tree->lnode);
 618                         exit_val = (int) force_number(t);
 619                         free_temp(t);
 620                 }
 621                 longjmp(rule_tag, TAG_BREAK);
 622                 break;
 623
 624         case Node_K_return:
 625                 t = tree_eval(tree->lnode);
 626                 ret_node = dupnode(t);
 627                 free_temp(t);
 628                 longjmp(func_tag, TAG_RETURN);
 629                 break;
 630
 631         default:
 632                 /*
 633                  * Appears to be an expression statement.  Throw away the
 634                  * value.
 635                  */
 636                 if (do_lint && tree->type == Node_var)
 637                         warning("statement has no effect");
 638                 t = tree_eval(tree);
 639                 free_temp(t);
 640                 break;
 641         }
 642         return 1;
 643 }
 644
 645 /* r_tree_eval --- evaluate a subtree */
 646
 647 NODE *
 648 r_tree_eval(tree, iscond)
 649 register NODE *tree;
 650 int iscond;
 651 {
 652         register NODE *r, *t1, *t2;     /* return value & temporary subtrees */
 653         register NODE **lhs;
 654         register int di;
 655         AWKNUM x, x1, x2;
 656         long lx;
 657 #ifdef _CRAY
 658         long lx2;
 659 #endif
 660         char namebuf[100];
 661
 662 #ifdef DEBUG
 663         if (tree == NULL)
 664                 return Nnull_string;
 665         else if (tree->type == Node_val) {
 666                 if (tree->stref <= 0)
 667                         cant_happen();
 668                 return tree;
 669         } else if (tree->type == Node_var) {
 670                 if (tree->var_value->stref <= 0)
 671                         cant_happen();
 672                 return tree->var_value;
 673         }
 674 #endif
 675
 676         if (tree->type == Node_param_list) {
 677                 int paramnum = tree->param_cnt + 1;
 678
 679                 if ((tree->flags & FUNC) != 0)
 680                         fatal("can't use function name `%s' as variable or array",
 681                                         tree->vname);
 682
 683                 tree = stack_ptr[tree->param_cnt];
 684                 if (tree == NULL)
 685                         return Nnull_string;
 686                 sprintf(namebuf, "parameter #%d", paramnum);
 687                 tree->vname = namebuf;
 688         }
 689         if (tree->type == Node_array_ref)
 690                 tree = tree->orig_array;
 691
 692         switch (tree->type) {
 693         case Node_var:
 694                 return tree->var_value;
 695
 696         case Node_and:
 697                 return tmp_number((AWKNUM) (eval_condition(tree->lnode)
 698                                             && eval_condition(tree->rnode)));
 699
 700         case Node_or:
 701                 return tmp_number((AWKNUM) (eval_condition(tree->lnode)
 702                                             || eval_condition(tree->rnode)));
 703
 704         case Node_not:
 705                 return tmp_number((AWKNUM) ! eval_condition(tree->lnode));
 706
 707                 /* Builtins */
 708         case Node_builtin:
 709                 return (*tree->proc)(tree->subnode);
 710
 711         case Node_K_getline:
 712                 return (do_getline(tree));
 713
 714         case Node_in_array:
 715                 return tmp_number((AWKNUM) in_array(tree->lnode, tree->rnode));
 716
 717         case Node_func_call:
 718                 return func_call(tree->rnode, tree->lnode);
 719
 720                 /* unary operations */
 721         case Node_NR:
 722         case Node_FNR:
 723         case Node_NF:
 724         case Node_FIELDWIDTHS:
 725         case Node_FS:
 726         case Node_RS:
 727         case Node_field_spec:
 728         case Node_subscript:
 729         case Node_IGNORECASE:
 730         case Node_OFS:
 731         case Node_ORS:
 732         case Node_OFMT:
 733         case Node_CONVFMT:
 734                 lhs = get_lhs(tree, (Func_ptr *) NULL);
 735                 return *lhs;
 736
 737         case Node_var_array:
 738                 fatal("attempt to use array `%s' in a scalar context",
 739                         tree->vname);
 740
 741         case Node_unary_minus:
 742                 t1 = tree_eval(tree->subnode);
 743                 x = -force_number(t1);
 744                 free_temp(t1);
 745                 return tmp_number(x);
 746
 747         case Node_cond_exp:
 748                 if (eval_condition(tree->lnode))
 749                         return tree_eval(tree->rnode->lnode);
 750                 return tree_eval(tree->rnode->rnode);
 751
 752         case Node_match:
 753         case Node_nomatch:
 754         case Node_regex:
 755                 return match_op(tree);
 756
 757         case Node_func:
 758                 fatal("function `%s' called with space between name and (,\n%s",
 759                         tree->lnode->param,
 760                         "or used in other expression context");
 761
 762                 /* assignments */
 763         case Node_assign:
 764                 {
 765                 Func_ptr after_assign = NULL;
 766
 767                 if (iscond && do_lint)
 768                         warning("assignment used in conditional context");
 769                 r = tree_eval(tree->rnode);
 770                 lhs = get_lhs(tree->lnode, &after_assign);
 771                 if (r != *lhs) {
 772                         NODE *save;
 773
 774                         save = *lhs;
 775                         *lhs = dupnode(r);
 776                         unref(save);
 777                 }
 778                 free_temp(r);
 779                 tree->lnode->flags |= SCALAR;
 780                 if (after_assign)
 781                         (*after_assign)();
 782                 return *lhs;
 783                 }
 784
 785         case Node_concat:
 786                 {
 787                 NODE **treelist;
 788                 NODE **strlist;
 789                 NODE *save_tree;
 790                 register NODE **treep;
 791                 register NODE **strp;
 792                 register size_t len;
 793                 char *str;
 794                 register char *dest;
 795                 int alloc_count, str_count;
 796                 int i;
 797
 798                 /*
 799                  * This is an efficiency hack for multiple adjacent string
 800                  * concatenations, to avoid recursion and string copies.
 801                  *
 802                  * Node_concat trees grow downward to the left, so
 803                  * descend to lowest (first) node, accumulating nodes
 804                  * to evaluate to strings as we go.
 805                  */
 806
 807                 /*
 808                  * But first, no arbitrary limits. Count the number of
 809                  * nodes and malloc the treelist and strlist arrays.
 810                  * There will be alloc_count + 1 items to concatenate. We
 811                  * also leave room for an extra pointer at the end to
 812                  * use as a sentinel.  Thus, start alloc_count at 2.
 813                  */
 814                 save_tree = tree;
 815                 for (alloc_count = 2; tree && tree->type == Node_concat; tree = tree->lnode)
 816                         alloc_count++;
 817                 tree = save_tree;
 818                 emalloc(treelist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
 819                 emalloc(strlist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
 820
 821                 /* Now, here we go. */
 822                 treep = treelist;
 823                 while (tree && tree->type == Node_concat) {
 824                         *treep++ = tree->rnode;
 825                         tree = tree->lnode;
 826                 }
 827                 *treep = tree;
 828                 /*
 829                  * Now, evaluate to strings in LIFO order, accumulating
 830                  * the string length, so we can do a single malloc at the
 831                  * end.
 832                  *
 833                  * Evaluate the expressions first, then get their
 834                  * lengthes, in case one of the expressions has a
 835                  * side effect that changes one of the others.
 836                  * See test/nasty.awk.
 837                  */
 838                 strp = strlist;
 839                 len = 0;
 840                 while (treep >= treelist) {
 841                         *strp = force_string(tree_eval(*treep--));
 842                         strp++;
 843                 }
 844                 *strp = NULL;
 845
 846                 str_count = strp - strlist;
 847                 strp = strlist;
 848                 for (i = 0; i < str_count; i++) {
 849                         len += (*strp)->stlen;
 850                         strp++;
 851                 }
 852                 emalloc(str, char *, len+2, "tree_eval");
 853                 str[len] = str[len+1] = '\0';   /* for good measure */
 854                 dest = str;
 855                 strp = strlist;
 856                 while (*strp) {
 857                         memcpy(dest, (*strp)->stptr, (*strp)->stlen);
 858                         dest += (*strp)->stlen;
 859                         free_temp(*strp);
 860                         strp++;
 861                 }
 862                 r = make_str_node(str, len, ALREADY_MALLOCED);
 863                 r->flags |= TEMP;
 864
 865                 free(strlist);
 866                 free(treelist);
 867                 }
 868                 return r;
 869
 870         /* other assignment types are easier because they are numeric */
 871         case Node_preincrement:
 872         case Node_predecrement:
 873         case Node_postincrement:
 874         case Node_postdecrement:
 875         case Node_assign_exp:
 876         case Node_assign_times:
 877         case Node_assign_quotient:
 878         case Node_assign_mod:
 879         case Node_assign_plus:
 880         case Node_assign_minus:
 881                 return op_assign(tree);
 882         default:
 883                 break;  /* handled below */
 884         }
 885
 886         /* evaluate subtrees in order to do binary operation, then keep going */
 887         t1 = tree_eval(tree->lnode);
 888         t2 = tree_eval(tree->rnode);
 889
 890         switch (tree->type) {
 891         case Node_geq:
 892         case Node_leq:
 893         case Node_greater:
 894         case Node_less:
 895         case Node_notequal:
 896         case Node_equal:
 897                 di = cmp_nodes(t1, t2);
 898                 free_temp(t1);
 899                 free_temp(t2);
 900                 switch (tree->type) {
 901                 case Node_equal:
 902                         return tmp_number((AWKNUM) (di == 0));
 903                 case Node_notequal:
 904                         return tmp_number((AWKNUM) (di != 0));
 905                 case Node_less:
 906                         return tmp_number((AWKNUM) (di < 0));
 907                 case Node_greater:
 908                         return tmp_number((AWKNUM) (di > 0));
 909                 case Node_leq:
 910                         return tmp_number((AWKNUM) (di <= 0));
 911                 case Node_geq:
 912                         return tmp_number((AWKNUM) (di >= 0));
 913                 default:
 914                         cant_happen();
 915                 }
 916                 break;
 917         default:
 918                 break;  /* handled below */
 919         }
 920
 921         x1 = force_number(t1);
 922         free_temp(t1);
 923         x2 = force_number(t2);
 924         free_temp(t2);
 925         switch (tree->type) {
 926         case Node_exp:
 927                 if ((lx = x2) == x2 && lx >= 0) {       /* integer exponent */
 928                         if (lx == 0)
 929                                 x = 1;
 930                         else if (lx == 1)
 931                                 x = x1;
 932                         else {
 933                                 /* doing it this way should be more precise */
 934                                 for (x = x1; --lx; )
 935                                         x *= x1;
 936                         }
 937                 } else
 938                         x = pow((double) x1, (double) x2);
 939                 return tmp_number(x);
 940
 941         case Node_times:
 942                 return tmp_number(x1 * x2);
 943
 944         case Node_quotient:
 945                 if (x2 == 0)
 946                         fatal("division by zero attempted");
 947 #ifdef _CRAY
 948                 /* special case for integer division, put in for Cray */
 949                 lx2 = x2;
 950                 if (lx2 == 0)
 951                         return tmp_number(x1 / x2);
 952                 lx = (long) x1 / lx2;
 953                 if (lx * x2 == x1)
 954                         return tmp_number((AWKNUM) lx);
 955                 else
 956 #endif
 957                         return tmp_number(x1 / x2);
 958
 959         case Node_mod:
 960                 if (x2 == 0)
 961                         fatal("division by zero attempted in mod");
 962 #ifdef HAVE_FMOD
 963                 return tmp_number(fmod(x1, x2));
 964 #else   /* ! HAVE_FMOD */
 965                 (void) modf(x1 / x2, &x);
 966                 return tmp_number(x1 - x * x2);
 967 #endif  /* ! HAVE_FMOD */
 968
 969         case Node_plus:
 970                 return tmp_number(x1 + x2);
 971
 972         case Node_minus:
 973                 return tmp_number(x1 - x2);
 974
 975         case Node_var_array:
 976                 fatal("attempt to use array `%s' in a scalar context",
 977                         tree->vname);
 978
 979         default:
 980                 fatal("illegal type (%s) in tree_eval", nodetype2str(tree->type));
 981         }
 982         return 0;
 983 }
 984
 985 /* eval_condition --- is TREE true or false? Returns 0==false, non-zero==true */
 986
 987 static int
 988 eval_condition(tree)
 989 register NODE *tree;
 990 {
 991         register NODE *t1;
 992         register int ret;
 993
 994         if (tree == NULL)       /* Null trees are the easiest kinds */
 995                 return TRUE;
 996         if (tree->type == Node_line_range) {
 997                 /*
 998                  * Node_line_range is kind of like Node_match, EXCEPT: the
 999                  * lnode field (more properly, the condpair field) is a node
1000                  * of a Node_cond_pair; whether we evaluate the lnode of that
1001                  * node or the rnode depends on the triggered word.  More
1002                  * precisely:  if we are not yet triggered, we tree_eval the
1003                  * lnode; if that returns true, we set the triggered word.
1004                  * If we are triggered (not ELSE IF, note), we tree_eval the
1005                  * rnode, clear triggered if it succeeds, and perform our
1006                  * action (regardless of success or failure).  We want to be
1007                  * able to begin and end on a single input record, so this
1008                  * isn't an ELSE IF, as noted above.
1009                  */
1010                 if (! tree->triggered) {
1011                         if (! eval_condition(tree->condpair->lnode))
1012                                 return FALSE;
1013                         else
1014                                 tree->triggered = TRUE;
1015                 }
1016                 /* Else we are triggered */
1017                 if (eval_condition(tree->condpair->rnode))
1018                         tree->triggered = FALSE;
1019                 return TRUE;
1020         }
1021
1022         /*
1023          * Could just be J.random expression. in which case, null and 0 are
1024          * false, anything else is true
1025          */
1026
1027         t1 = m_tree_eval(tree, TRUE);
1028         if (t1->flags & MAYBE_NUM)
1029                 (void) force_number(t1);
1030         if (t1->flags & NUMBER)
1031                 ret = (t1->numbr != 0.0);
1032         else
1033                 ret = (t1->stlen != 0);
1034         free_temp(t1);
1035         return ret;
1036 }
1037
1038 /* cmp_nodes --- compare two nodes, returning negative, 0, positive */
1039
1040 int
1041 cmp_nodes(t1, t2)
1042 register NODE *t1, *t2;
1043 {
1044         register int ret;
1045         register size_t len1, len2;
1046         register int l;
1047         int ldiff;
1048
1049         if (t1 == t2)
1050                 return 0;
1051         if (t1->flags & MAYBE_NUM)
1052                 (void) force_number(t1);
1053         if (t2->flags & MAYBE_NUM)
1054                 (void) force_number(t2);
1055         if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
1056                 if (t1->numbr == t2->numbr)
1057                         return 0;
1058                 /* don't subtract, in case one or both are infinite */
1059                 else if (t1->numbr < t2->numbr)
1060                         return -1;
1061                 else
1062                         return 1;
1063         }
1064         (void) force_string(t1);
1065         (void) force_string(t2);
1066         len1 = t1->stlen;
1067         len2 = t2->stlen;
1068         ldiff = len1 - len2;
1069         if (len1 == 0 || len2 == 0)
1070                 return ldiff;
1071         l = (ldiff <= 0 ? len1 : len2);
1072         if (IGNORECASE) {
1073                 register unsigned char *cp1 = (unsigned char *) t1->stptr;
1074                 register unsigned char *cp2 = (unsigned char *) t2->stptr;
1075
1076                 for (ret = 0; l-- > 0 && ret == 0; cp1++, cp2++)
1077                         ret = casetable[*cp1] - casetable[*cp2];
1078         } else
1079                 ret = memcmp(t1->stptr, t2->stptr, l);
1080         return (ret == 0 ? ldiff : ret);
1081 }
1082
1083 /* op_assign --- do +=, -=, etc. */
1084
1085 static NODE *
1086 op_assign(tree)
1087 register NODE *tree;
1088 {
1089         AWKNUM rval, lval;
1090         NODE **lhs;
1091         AWKNUM t1, t2;
1092         long ltemp;
1093         NODE *tmp;
1094         Func_ptr after_assign = NULL;
1095
1096         /*
1097          * For ++ and --, get the lhs when doing the op and then
1098          * return.  For += etc, do the rhs first, since it can
1099          * rearrange things, and *then* get the lhs.
1100          */
1101
1102         switch(tree->type) {
1103         case Node_preincrement:
1104         case Node_predecrement:
1105                 lhs = get_lhs(tree->lnode, &after_assign);
1106                 lval = force_number(*lhs);
1107                 unref(*lhs);
1108                 *lhs = make_number(lval +
1109                                (tree->type == Node_preincrement ? 1.0 : -1.0));
1110                 tree->lnode->flags |= SCALAR;
1111                 if (after_assign)
1112                         (*after_assign)();
1113                 return *lhs;
1114
1115         case Node_postincrement:
1116         case Node_postdecrement:
1117                 lhs = get_lhs(tree->lnode, &after_assign);
1118                 lval = force_number(*lhs);
1119                 unref(*lhs);
1120                 *lhs = make_number(lval +
1121                                (tree->type == Node_postincrement ? 1.0 : -1.0));
1122                 tree->lnode->flags |= SCALAR;
1123                 if (after_assign)
1124                         (*after_assign)();
1125                 return tmp_number(lval);
1126         default:
1127                 break;  /* handled below */
1128         }
1129
1130         /*
1131          * It's a += kind of thing.  Do the rhs, then the lhs.
1132          */
1133
1134         tmp = tree_eval(tree->rnode);
1135         rval = force_number(tmp);
1136         free_temp(tmp);
1137
1138         lhs = get_lhs(tree->lnode, &after_assign);
1139         lval = force_number(*lhs);
1140
1141         unref(*lhs);
1142         switch(tree->type) {
1143         case Node_assign_exp:
1144                 if ((ltemp = rval) == rval) {   /* integer exponent */
1145                         if (ltemp == 0)
1146                                 *lhs = make_number((AWKNUM) 1);
1147                         else if (ltemp == 1)
1148                                 *lhs = make_number(lval);
1149                         else {
1150                                 /* doing it this way should be more precise */
1151                                 for (t1 = t2 = lval; --ltemp; )
1152                                         t1 *= t2;
1153                                 *lhs = make_number(t1);
1154                         }
1155                 } else
1156                         *lhs = make_number((AWKNUM) pow((double) lval, (double) rval));
1157                 break;
1158
1159         case Node_assign_times:
1160                 *lhs = make_number(lval * rval);
1161                 break;
1162
1163         case Node_assign_quotient:
1164                 if (rval == (AWKNUM) 0)
1165                         fatal("division by zero attempted in /=");
1166 #ifdef _CRAY
1167                 /* special case for integer division, put in for Cray */
1168                 ltemp = rval;
1169                 if (ltemp == 0) {
1170                         *lhs = make_number(lval / rval);
1171                         break;
1172                 }
1173                 ltemp = (long) lval / ltemp;
1174                 if (ltemp * lval == rval)
1175                         *lhs = make_number((AWKNUM) ltemp);
1176                 else
1177 #endif  /* _CRAY */
1178                         *lhs = make_number(lval / rval);
1179                 break;
1180
1181         case Node_assign_mod:
1182                 if (rval == (AWKNUM) 0)
1183                         fatal("division by zero attempted in %%=");
1184 #ifdef HAVE_FMOD
1185                 *lhs = make_number(fmod(lval, rval));
1186 #else   /* ! HAVE_FMOD */
1187                 (void) modf(lval / rval, &t1);
1188                 t2 = lval - rval * t1;
1189                 *lhs = make_number(t2);
1190 #endif  /* ! HAVE_FMOD */
1191                 break;
1192
1193         case Node_assign_plus:
1194                 *lhs = make_number(lval + rval);
1195                 break;
1196
1197         case Node_assign_minus:
1198                 *lhs = make_number(lval - rval);
1199                 break;
1200         default:
1201                 cant_happen();
1202         }
1203         tree->lnode->flags |= SCALAR;
1204         if (after_assign)
1205                 (*after_assign)();
1206         return *lhs;
1207 }
1208
1209 static struct fcall {
1210         char *fname;
1211         unsigned long count;
1212         NODE *arglist;
1213         NODE **prevstack;
1214         NODE **stack;
1215 } *fcall_list = NULL;
1216
1217 static long fcall_list_size = 0;
1218 static long curfcall = -1;
1219
1220 /* in_function --- return true/false if we need to unwind awk functions */
1221
1222 static int
1223 in_function()
1224 {
1225         return (curfcall >= 0);
1226 }
1227
1228 /* pop_fcall --- pop off a single function call */
1229
1230 static void
1231 pop_fcall()
1232 {
1233         NODE *n, **sp, *arg, *argp;
1234         int count;
1235         struct fcall *f;
1236
1237         assert(curfcall >= 0);
1238         f = & fcall_list[curfcall];
1239         stack_ptr = f->prevstack;
1240
1241         /*
1242          * here, we pop each parameter and check whether
1243          * it was an array.  If so, and if the arg. passed in was
1244          * a simple variable, then the value should be copied back.
1245          * This achieves "call-by-reference" for arrays.
1246          */
1247         sp = f->stack;
1248         count = f->count;
1249
1250         for (argp = f->arglist; count > 0 && argp != NULL; argp = argp->rnode) {
1251                 arg = argp->lnode;
1252                 if (arg->type == Node_param_list)
1253                         arg = stack_ptr[arg->param_cnt];
1254                 n = *sp++;
1255                 if ((arg->type == Node_var /* || arg->type == Node_var_array */)
1256                     && n->type == Node_var_array) {
1257                         /* should we free arg->var_value ? */
1258                         arg->var_array = n->var_array;
1259                         arg->type = Node_var_array;
1260                         arg->array_size = n->array_size;
1261                         arg->table_size = n->table_size;
1262                         arg->flags = n->flags;
1263                 }
1264                 /* n->lnode overlays the array size, don't unref it if array */
1265                 if (n->type != Node_var_array && n->type != Node_array_ref)
1266                         unref(n->lnode);
1267                 freenode(n);
1268                 count--;
1269         }
1270         while (count-- > 0) {
1271                 n = *sp++;
1272                 /* if n is a local array, all the elements should be freed */
1273                 if (n->type == Node_var_array)
1274                         assoc_clear(n);
1275                 /* n->lnode overlays the array size, don't unref it if array */
1276                 if (n->type != Node_var_array && n->type != Node_array_ref)
1277                         unref(n->lnode);
1278                 freenode(n);
1279         }
1280         if (f->stack)
1281                 free((char *) f->stack);
1282         memset(f, '\0', sizeof(struct fcall));
1283         curfcall--;
1284 }
1285
1286 /* pop_fcall_stack --- pop off all function args, don't leak memory */
1287
1288 static void
1289 pop_fcall_stack()
1290 {
1291         while (curfcall >= 0)
1292                 pop_fcall();
1293 }
1294
1295 /* push_args --- push function arguments onto the stack */
1296
1297 static void
1298 push_args(count, arglist, oldstack, func_name)
1299 int count;
1300 NODE *arglist;
1301 NODE **oldstack;
1302 char *func_name;
1303 {
1304         struct fcall *f;
1305         NODE *arg, *argp, *r, **sp, *n;
1306
1307         if (fcall_list_size == 0) {     /* first time */
1308                 emalloc(fcall_list, struct fcall *, 10 * sizeof(struct fcall),
1309                         "push_args");
1310                 fcall_list_size = 10;
1311         }
1312
1313         if (++curfcall >= fcall_list_size) {
1314                 fcall_list_size *= 2;
1315                 erealloc(fcall_list, struct fcall *,
1316                         fcall_list_size * sizeof(struct fcall), "push_args");
1317         }
1318         f = & fcall_list[curfcall];
1319         memset(f, '\0', sizeof(struct fcall));
1320
1321         if (count > 0)
1322                 emalloc(f->stack, NODE **, count*sizeof(NODE *), "func_call");
1323         f->count = count;
1324         f->fname = func_name;   /* not used, for debugging, just in case */
1325         f->arglist = arglist;
1326         f->prevstack = oldstack;
1327
1328         sp = f->stack;
1329
1330         /* for each calling arg. add NODE * on stack */
1331         for (argp = arglist; count > 0 && argp != NULL; argp = argp->rnode) {
1332                 arg = argp->lnode;
1333                 getnode(r);
1334                 r->type = Node_var;
1335
1336                 /* call by reference for arrays; see below also */
1337                 if (arg->type == Node_param_list) {
1338                         /* we must also reassign f here; see below */
1339                         f = & fcall_list[curfcall];
1340                         arg = f->prevstack[arg->param_cnt];
1341                 }
1342                 if (arg->type == Node_var_array) {
1343                         r->type = Node_array_ref;
1344                         r->flags &= ~SCALAR;
1345                         r->orig_array = arg;
1346                         r->vname = arg->vname;
1347                 } else if (arg->type == Node_array_ref) {
1348                         *r = *arg;
1349                 } else {
1350                         n = tree_eval(arg);
1351                         r->lnode = dupnode(n);
1352                         r->rnode = (NODE *) NULL;
1353                         if ((n->flags & SCALAR) != 0)
1354                                 r->flags |= SCALAR;
1355                         free_temp(n);
1356                 }
1357                 *sp++ = r;
1358                 count--;
1359         }
1360         if (argp != NULL)       /* left over calling args. */
1361                 warning(
1362                     "function `%s' called with more arguments than declared",
1363                     func_name);
1364
1365         /* add remaining params. on stack with null value */
1366         while (count-- > 0) {
1367                 getnode(r);
1368                 r->type = Node_var;
1369                 r->lnode = Nnull_string;
1370                 r->flags &= ~SCALAR;
1371                 r->rnode = (NODE *) NULL;
1372                 *sp++ = r;
1373         }
1374
1375         /*
1376          * We have to reassign f. Why, you may ask?  It is possible that
1377          * other functions were called during the course of tree_eval()-ing
1378          * the arguments to this function. As a result of that, fcall_list
1379          * may have been realloc()'ed, with the result that f is now
1380          * pointing into free()'d space.  This was a nasty one to track down.
1381          */
1382         f = & fcall_list[curfcall];
1383
1384         stack_ptr = f->stack;
1385 }
1386
1387 /* func_call --- call a function, call by reference for arrays */
1388
1389 NODE **stack_ptr;
1390
1391 static NODE *
1392 func_call(name, arg_list)
1393 NODE *name;             /* name is a Node_val giving function name */
1394 NODE *arg_list;         /* Node_expression_list of calling args. */
1395 {
1396         register NODE *r;
1397         NODE *f;
1398         jmp_buf volatile func_tag_stack;
1399         jmp_buf volatile loop_tag_stack;
1400         int volatile save_loop_tag_valid = FALSE;
1401         NODE *save_ret_node;
1402         extern NODE *ret_node;
1403
1404         /* retrieve function definition node */
1405         f = lookup(name->stptr);
1406         if (f == NULL || f->type != Node_func)
1407                 fatal("function `%s' not defined", name->stptr);
1408 #ifdef FUNC_TRACE
1409         fprintf(stderr, "function %s called\n", name->stptr);
1410 #endif
1411         push_args(f->lnode->param_cnt, arg_list, stack_ptr, name->stptr);
1412
1413         /*
1414          * Execute function body, saving context, as a return statement
1415          * will longjmp back here.
1416          *
1417          * Have to save and restore the loop_tag stuff so that a return
1418          * inside a loop in a function body doesn't scrog any loops going
1419          * on in the main program.  We save the necessary info in variables
1420          * local to this function so that function nesting works OK.
1421          * We also only bother to save the loop stuff if we're in a loop
1422          * when the function is called.
1423          */
1424         if (loop_tag_valid) {
1425                 int junk = 0;
1426
1427                 save_loop_tag_valid = (volatile int) loop_tag_valid;
1428                 PUSH_BINDING(loop_tag_stack, loop_tag, junk);
1429                 loop_tag_valid = FALSE;
1430         }
1431         PUSH_BINDING(func_tag_stack, func_tag, func_tag_valid);
1432         save_ret_node = ret_node;
1433         ret_node = Nnull_string;        /* default return value */
1434         if (setjmp(func_tag) == 0)
1435                 (void) interpret(f->rnode);
1436
1437         r = ret_node;
1438         ret_node = (NODE *) save_ret_node;
1439         RESTORE_BINDING(func_tag_stack, func_tag, func_tag_valid);
1440         pop_fcall();
1441
1442         /* Restore the loop_tag stuff if necessary. */
1443         if (save_loop_tag_valid) {
1444                 int junk = 0;
1445
1446                 loop_tag_valid = (int) save_loop_tag_valid;
1447                 RESTORE_BINDING(loop_tag_stack, loop_tag, junk);
1448         }
1449
1450         if ((r->flags & PERM) == 0)
1451                 r->flags |= TEMP;
1452         return r;
1453 }
1454
1455 /*
1456  * r_get_lhs:
1457  * This returns a POINTER to a node pointer. get_lhs(ptr) is the current
1458  * value of the var, or where to store the var's new value
1459  *
1460  * For the special variables, don't unref their current value if it's
1461  * the same as the internal copy; perhaps the current one is used in
1462  * a concatenation or some other expression somewhere higher up in the
1463  * call chain.  Ouch.
1464  */
1465
1466 NODE **
1467 r_get_lhs(ptr, assign)
1468 register NODE *ptr;
1469 Func_ptr *assign;
1470 {
1471         register NODE **aptr = NULL;
1472         register NODE *n;
1473
1474         if (assign)
1475                 *assign = NULL; /* for safety */
1476         if (ptr->type == Node_param_list) {
1477                 if ((ptr->flags & FUNC) != 0)
1478                         fatal("can't use function name `%s' as variable or array", ptr->vname);
1479                 ptr = stack_ptr[ptr->param_cnt];
1480         }
1481
1482         switch (ptr->type) {
1483         case Node_array_ref:
1484         case Node_var_array:
1485                 fatal("attempt to use array `%s' in a scalar context",
1486                         ptr->vname);
1487
1488         case Node_var:
1489                 aptr = &(ptr->var_value);
1490 #ifdef DEBUG
1491                 if (ptr->var_value->stref <= 0)
1492                         cant_happen();
1493 #endif
1494                 break;
1495
1496         case Node_FIELDWIDTHS:
1497                 aptr = &(FIELDWIDTHS_node->var_value);
1498                 if (assign != NULL)
1499                         *assign = set_FIELDWIDTHS;
1500                 break;
1501
1502         case Node_RS:
1503                 aptr = &(RS_node->var_value);
1504                 if (assign != NULL)
1505                         *assign = set_RS;
1506                 break;
1507
1508         case Node_FS:
1509                 aptr = &(FS_node->var_value);
1510                 if (assign != NULL)
1511                         *assign = set_FS;
1512                 break;
1513
1514         case Node_FNR:
1515                 if (FNR_node->var_value->numbr != FNR) {
1516                         unref(FNR_node->var_value);
1517                         FNR_node->var_value = make_number((AWKNUM) FNR);
1518                 }
1519                 aptr = &(FNR_node->var_value);
1520                 if (assign != NULL)
1521                         *assign = set_FNR;
1522                 break;
1523
1524         case Node_NR:
1525                 if (NR_node->var_value->numbr != NR) {
1526                         unref(NR_node->var_value);
1527                         NR_node->var_value = make_number((AWKNUM) NR);
1528                 }
1529                 aptr = &(NR_node->var_value);
1530                 if (assign != NULL)
1531                         *assign = set_NR;
1532                 break;
1533
1534         case Node_NF:
1535                 if (NF == -1 || NF_node->var_value->numbr != NF) {
1536                         if (NF == -1)
1537                                 (void) get_field(HUGE-1, assign); /* parse record */
1538                         unref(NF_node->var_value);
1539                         NF_node->var_value = make_number((AWKNUM) NF);
1540                 }
1541                 aptr = &(NF_node->var_value);
1542                 if (assign != NULL)
1543                         *assign = set_NF;
1544                 break;
1545
1546         case Node_IGNORECASE:
1547                 aptr = &(IGNORECASE_node->var_value);
1548                 if (assign != NULL)
1549                         *assign = set_IGNORECASE;
1550                 break;
1551
1552         case Node_OFMT:
1553                 aptr = &(OFMT_node->var_value);
1554                 if (assign != NULL)
1555                         *assign = set_OFMT;
1556                 break;
1557
1558         case Node_CONVFMT:
1559                 aptr = &(CONVFMT_node->var_value);
1560                 if (assign != NULL)
1561                         *assign = set_CONVFMT;
1562                 break;
1563
1564         case Node_ORS:
1565                 aptr = &(ORS_node->var_value);
1566                 if (assign != NULL)
1567                         *assign = set_ORS;
1568                 break;
1569
1570         case Node_OFS:
1571                 aptr = &(OFS_node->var_value);
1572                 if (assign != NULL)
1573                         *assign = set_OFS;
1574                 break;
1575
1576         case Node_param_list:
1577                 aptr = &(stack_ptr[ptr->param_cnt]->var_value);
1578                 break;
1579
1580         case Node_field_spec:
1581                 {
1582                 int field_num;
1583
1584                 n = tree_eval(ptr->lnode);
1585                 field_num = (int) force_number(n);
1586                 free_temp(n);
1587                 if (field_num < 0)
1588                         fatal("attempt to access field %d", field_num);
1589                 if (field_num == 0 && field0_valid) {   /* short circuit */
1590                         aptr = &fields_arr[0];
1591                         if (assign != NULL)
1592                                 *assign = reset_record;
1593                         break;
1594                 }
1595                 aptr = get_field(field_num, assign);
1596                 break;
1597                 }
1598         case Node_subscript:
1599                 n = ptr->lnode;
1600                 if (n->type == Node_param_list) {
1601                         int i = n->param_cnt + 1;
1602
1603                         n = stack_ptr[n->param_cnt];
1604                         if ((n->flags & SCALAR) != 0)
1605                                 fatal("attempt to use scalar parameter %d as an array", i);
1606                 }
1607                 if (n->type == Node_array_ref) {
1608                         n = n->orig_array;
1609                         assert(n->type == Node_var_array || n->type == Node_var);
1610                 }
1611                 if (n->type == Node_func) {
1612                         fatal("attempt to use function `%s' as array",
1613                                 n->lnode->param);
1614                 }
1615                 aptr = assoc_lookup(n, concat_exp(ptr->rnode));
1616                 break;
1617
1618         case Node_func:
1619                 fatal("`%s' is a function, assignment is not allowed",
1620                         ptr->lnode->param);
1621
1622         case Node_builtin:
1623                 fatal("assignment is not allowed to result of builtin function");
1624         default:
1625                 fprintf(stderr, "type = %s\n", nodetype2str(ptr->type));
1626                 fflush(stderr);
1627                 cant_happen();
1628         }
1629         return aptr;
1630 }
1631
1632 /* match_op --- do ~ and !~ */
1633
1634 static NODE *
1635 match_op(tree)
1636 register NODE *tree;
1637 {
1638         register NODE *t1;
1639         register Regexp *rp;
1640         int i;
1641         int match = TRUE;
1642         int kludge_need_start = FALSE;  /* FIXME: --- see below */
1643
1644         if (tree->type == Node_nomatch)
1645                 match = FALSE;
1646         if (tree->type == Node_regex)
1647                 t1 = *get_field(0, (Func_ptr *) 0);
1648         else {
1649                 t1 = force_string(tree_eval(tree->lnode));
1650                 tree = tree->rnode;
1651         }
1652         rp = re_update(tree);
1653         /*
1654          * FIXME:
1655          *
1656          * Any place where research() is called with a last parameter of
1657          * FALSE, we need to use the avoid_dfa test. This is the only place
1658          * at the moment.
1659          *
1660          * A new or improved dfa that distinguishes beginning/end of
1661          * string from beginning/end of line will allow us to get rid of
1662          * this temporary hack.
1663          *
1664          * The avoid_dfa() function is in re.c; it is not very smart.
1665          */
1666         if (avoid_dfa(tree, t1->stptr, t1->stlen))
1667                 kludge_need_start = TRUE;
1668         i = research(rp, t1->stptr, 0, t1->stlen, kludge_need_start);
1669         i = (i == -1) ^ (match == TRUE);
1670         free_temp(t1);
1671         return tmp_number((AWKNUM) i);
1672 }
1673
1674 /* set_IGNORECASE --- update IGNORECASE as appropriate */
1675
1676 void
1677 set_IGNORECASE()
1678 {
1679         static int warned = FALSE;
1680
1681         if ((do_lint || do_traditional) && ! warned) {
1682                 warned = TRUE;
1683                 warning("IGNORECASE not supported in compatibility mode");
1684         }
1685         if (do_traditional)
1686                 IGNORECASE = FALSE;
1687         else if ((IGNORECASE_node->var_value->flags & (STRING|STR)) != 0) {
1688                 if ((IGNORECASE_node->var_value->flags & MAYBE_NUM) == 0)
1689                         IGNORECASE = (force_string(IGNORECASE_node->var_value)->stlen > 0);
1690                 else
1691                         IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
1692         } else if ((IGNORECASE_node->var_value->flags & (NUM|NUMBER)) != 0)
1693                 IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
1694         else
1695                 IGNORECASE = FALSE;             /* shouldn't happen */
1696         set_FS_if_not_FIELDWIDTHS();
1697 }
1698
1699 /* set_OFS --- update OFS related variables when OFS assigned to */
1700
1701 void
1702 set_OFS()
1703 {
1704         OFS = force_string(OFS_node->var_value)->stptr;
1705         OFSlen = OFS_node->var_value->stlen;
1706         OFS[OFSlen] = '\0';
1707 }
1708
1709 /* set_ORS --- update ORS related variables when ORS assigned to */
1710
1711 void
1712 set_ORS()
1713 {
1714         ORS = force_string(ORS_node->var_value)->stptr;
1715         ORSlen = ORS_node->var_value->stlen;
1716         ORS[ORSlen] = '\0';
1717 }
1718
1719 /* fmt_ok --- is the conversion format a valid one? */
1720
1721 NODE **fmt_list = NULL;
1722 static int fmt_ok P((NODE *n));
1723 static int fmt_index P((NODE *n));
1724
1725 static int
1726 fmt_ok(n)
1727 NODE *n;
1728 {
1729         NODE *tmp = force_string(n);
1730         char *p = tmp->stptr;
1731
1732         if (*p++ != '%')
1733                 return 0;
1734         while (*p && strchr(" +-#", *p) != NULL)        /* flags */
1735                 p++;
1736         while (*p && isdigit(*p))       /* width - %*.*g is NOT allowed */
1737                 p++;
1738         if (*p == '\0' || (*p != '.' && ! isdigit(*p)))
1739                 return 0;
1740         if (*p == '.')
1741                 p++;
1742         while (*p && isdigit(*p))       /* precision */
1743                 p++;
1744         if (*p == '\0' || strchr("efgEG", *p) == NULL)
1745                 return 0;
1746         if (*++p != '\0')
1747                 return 0;
1748         return 1;
1749 }
1750
1751 /* fmt_index --- track values of OFMT and CONVFMT to keep semantics correct */
1752
1753 static int
1754 fmt_index(n)
1755 NODE *n;
1756 {
1757         register int ix = 0;
1758         static int fmt_num = 4;
1759         static int fmt_hiwater = 0;
1760
1761         if (fmt_list == NULL)
1762                 emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
1763         (void) force_string(n);
1764         while (ix < fmt_hiwater) {
1765                 if (cmp_nodes(fmt_list[ix], n) == 0)
1766                         return ix;
1767                 ix++;
1768         }
1769         /* not found */
1770         n->stptr[n->stlen] = '\0';
1771         if (do_lint && ! fmt_ok(n))
1772                 warning("bad %sFMT specification",
1773                             n == CONVFMT_node->var_value ? "CONV"
1774                           : n == OFMT_node->var_value ? "O"
1775                           : "");
1776
1777         if (fmt_hiwater >= fmt_num) {
1778                 fmt_num *= 2;
1779                 emalloc(fmt_list, NODE **, fmt_num, "fmt_index");
1780         }
1781         fmt_list[fmt_hiwater] = dupnode(n);
1782         return fmt_hiwater++;
1783 }
1784
1785 /* set_OFMT --- track OFMT correctly */
1786
1787 void
1788 set_OFMT()
1789 {
1790         OFMTidx = fmt_index(OFMT_node->var_value);
1791         OFMT = fmt_list[OFMTidx]->stptr;
1792 }
1793
1794 /* set_CONVFMT --- track CONVFMT correctly */
1795
1796 void
1797 set_CONVFMT()
1798 {
1799         CONVFMTidx = fmt_index(CONVFMT_node->var_value);
1800         CONVFMT = fmt_list[CONVFMTidx]->stptr;
1801 }