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