/* * eval.c - gawk parse tree interpreter */ /* * Copyright (C) 1986, 1988, 1989, 1991-2005 the Free Software Foundation, Inc. * * This file is part of GAWK, the GNU implementation of the * AWK Programming Language. * * GAWK is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * GAWK is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA */ #include "awk.h" extern double pow P((double x, double y)); extern double modf P((double x, double *yp)); extern double fmod P((double x, double y)); static inline void make_scalar P((NODE *tree)); static int eval_condition P((NODE *tree)); static NODE *op_assign P((NODE *tree)); static NODE *func_call P((NODE *tree)); static NODE *match_op P((NODE *tree)); static void pop_forloop P((void)); static inline void pop_all_forloops P((void)); static void push_forloop P((const char *varname, NODE **elems, size_t nelems)); static void push_args P((int count, NODE *arglist, NODE **oldstack, const char *func_name, char **varnames)); static inline void pop_fcall_stack P((void)); static void pop_fcall P((void)); static int comp_func P((const void *p1, const void *p2)); #if __GNUC__ < 2 NODE *_t; /* used as a temporary in macros */ #endif #ifdef MSDOS double _msc51bug; /* to get around a bug in MSC 5.1 */ #endif NODE *ret_node; int OFSlen; int ORSlen; int OFMTidx; int CONVFMTidx; /* Profiling stuff */ #ifdef PROFILING #define INCREMENT(n) n++ #else #define INCREMENT(n) /* nothing */ #endif /* Macros and variables to save and restore function and loop bindings */ /* * the val variable allows return/continue/break-out-of-context to be * caught and diagnosed */ #define PUSH_BINDING(stack, x, val) (memcpy((char *)(stack), (const char *)(x), sizeof(jmp_buf)), val++) #define RESTORE_BINDING(stack, x, val) (memcpy((char *)(x), (const char *)(stack), sizeof(jmp_buf)), val--) static jmp_buf loop_tag; /* always the current binding */ static int loop_tag_valid = FALSE; /* nonzero when loop_tag valid */ static int func_tag_valid = FALSE; static jmp_buf func_tag; extern int exiting, exit_val; /* This rather ugly macro is for VMS C */ #ifdef C #undef C #endif #define C(c) ((char)c) /* * This table is used by the regexp routines to do case independant * matching. Basically, every ascii character maps to itself, except * uppercase letters map to lower case ones. This table has 256 * entries, for ISO 8859-1. Note also that if the system this * is compiled on doesn't use 7-bit ascii, casetable[] should not be * defined to the linker, so gawk should not load. * * Do NOT make this array static, it is used in several spots, not * just in this file. * * 6/2004: * This table is also used for IGNORECASE for == and !=, and index(). * Although with GLIBC, we could use tolower() everywhere and RE_ICASE * for the regex matcher, precomputing this table once gives us a * performance improvement. I also think it's better for portability * to non-GLIBC systems. All the world is not (yet :-) GNU/Linux. */ #if 'a' == 97 /* it's ascii */ char casetable[] = { '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007', '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017', '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027', '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037', /* ' ' '!' '"' '#' '$' '%' '&' ''' */ '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047', /* '(' ')' '*' '+' ',' '-' '.' '/' */ '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057', /* '0' '1' '2' '3' '4' '5' '6' '7' */ '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067', /* '8' '9' ':' ';' '<' '=' '>' '?' */ '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077', /* '@' 'A' 'B' 'C' 'D' 'E' 'F' 'G' */ '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147', /* 'H' 'I' 'J' 'K' 'L' 'M' 'N' 'O' */ '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157', /* 'P' 'Q' 'R' 'S' 'T' 'U' 'V' 'W' */ '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167', /* 'X' 'Y' 'Z' '[' '\' ']' '^' '_' */ '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137', /* '`' 'a' 'b' 'c' 'd' 'e' 'f' 'g' */ '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147', /* 'h' 'i' 'j' 'k' 'l' 'm' 'n' 'o' */ '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157', /* 'p' 'q' 'r' 's' 't' 'u' 'v' 'w' */ '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167', /* 'x' 'y' 'z' '{' '|' '}' '~' */ '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177', /* Latin 1: */ C('\200'), C('\201'), C('\202'), C('\203'), C('\204'), C('\205'), C('\206'), C('\207'), C('\210'), C('\211'), C('\212'), C('\213'), C('\214'), C('\215'), C('\216'), C('\217'), C('\220'), C('\221'), C('\222'), C('\223'), C('\224'), C('\225'), C('\226'), C('\227'), C('\230'), C('\231'), C('\232'), C('\233'), C('\234'), C('\235'), C('\236'), C('\237'), C('\240'), C('\241'), C('\242'), C('\243'), C('\244'), C('\245'), C('\246'), C('\247'), C('\250'), C('\251'), C('\252'), C('\253'), C('\254'), C('\255'), C('\256'), C('\257'), C('\260'), C('\261'), C('\262'), C('\263'), C('\264'), C('\265'), C('\266'), C('\267'), C('\270'), C('\271'), C('\272'), C('\273'), C('\274'), C('\275'), C('\276'), C('\277'), C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'), C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'), C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\327'), C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\337'), C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'), C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'), C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\367'), C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\377'), }; #else #include "You lose. You will need a translation table for your character set." #endif #undef C /* load_casetable --- for a non-ASCII locale, redo the table */ void load_casetable(void) { #if defined(LC_CTYPE) int i; char *cp; static int loaded = FALSE; if (loaded || do_traditional) return; loaded = TRUE; cp = setlocale(LC_CTYPE, NULL); /* this is not per standard, but it's pretty safe */ if (cp == NULL || strcmp(cp, "C") == 0 || strcmp(cp, "POSIX") == 0) return; for (i = 0200; i <= 0377; i++) { if (isalpha(i) && islower(i) && i != toupper(i)) casetable[i] = toupper(i); } #endif } /* * This table maps node types to strings for debugging. * KEEP IN SYNC WITH awk.h!!!! */ static const char *const nodetypes[] = { "Node_illegal", "Node_times", "Node_quotient", "Node_mod", "Node_plus", "Node_minus", "Node_cond_pair", "Node_subscript", "Node_concat", "Node_exp", "Node_preincrement", "Node_predecrement", "Node_postincrement", "Node_postdecrement", "Node_unary_minus", "Node_field_spec", "Node_assign", "Node_assign_times", "Node_assign_quotient", "Node_assign_mod", "Node_assign_plus", "Node_assign_minus", "Node_assign_exp", "Node_assign_concat", "Node_and", "Node_or", "Node_equal", "Node_notequal", "Node_less", "Node_greater", "Node_leq", "Node_geq", "Node_match", "Node_nomatch", "Node_not", "Node_rule_list", "Node_rule_node", "Node_statement_list", "Node_switch_body", "Node_case_list", "Node_if_branches", "Node_expression_list", "Node_param_list", "Node_K_if", "Node_K_switch", "Node_K_case", "Node_K_default", "Node_K_while", "Node_K_for", "Node_K_arrayfor", "Node_K_break", "Node_K_continue", "Node_K_print", "Node_K_print_rec", "Node_K_printf", "Node_K_next", "Node_K_exit", "Node_K_do", "Node_K_return", "Node_K_delete", "Node_K_delete_loop", "Node_K_getline", "Node_K_function", "Node_K_nextfile", "Node_redirect_output", "Node_redirect_append", "Node_redirect_pipe", "Node_redirect_pipein", "Node_redirect_input", "Node_redirect_twoway", "Node_var_new", "Node_var", "Node_var_array", "Node_val", "Node_builtin", "Node_line_range", "Node_in_array", "Node_func", "Node_func_call", "Node_cond_exp", "Node_regex", "Node_dynregex", "Node_hashnode", "Node_ahash", "Node_array_ref", "Node_BINMODE", "Node_CONVFMT", "Node_FIELDWIDTHS", "Node_FNR", "Node_FS", "Node_IGNORECASE", "Node_LINT", "Node_NF", "Node_NR", "Node_OFMT", "Node_OFS", "Node_ORS", "Node_RS", "Node_SUBSEP", "Node_TEXTDOMAIN", "Node_final --- this should never appear", NULL }; /* nodetype2str --- convert a node type into a printable value */ const char * nodetype2str(NODETYPE type) { static char buf[40]; if (type >= Node_illegal && type <= Node_final) return nodetypes[(int) type]; sprintf(buf, _("unknown nodetype %d"), (int) type); return buf; } /* flags2str --- make a flags value readable */ const char * flags2str(int flagval) { static const struct flagtab values[] = { { MALLOC, "MALLOC" }, { TEMP, "TEMP" }, { PERM, "PERM" }, { STRING, "STRING" }, { STRCUR, "STRCUR" }, { NUMCUR, "NUMCUR" }, { NUMBER, "NUMBER" }, { MAYBE_NUM, "MAYBE_NUM" }, { ARRAYMAXED, "ARRAYMAXED" }, { FUNC, "FUNC" }, { FIELD, "FIELD" }, { INTLSTR, "INTLSTR" }, #ifdef WSTRCUR { WSTRCUR, "WSTRCUR" }, #endif { 0, NULL }, }; return genflags2str(flagval, values); } /* genflags2str --- general routine to convert a flag value to a string */ const char * genflags2str(int flagval, const struct flagtab *tab) { static char buffer[BUFSIZ]; char *sp; int i, space_left, space_needed; sp = buffer; space_left = BUFSIZ; for (i = 0; tab[i].name != NULL; i++) { if ((flagval & tab[i].val) != 0) { /* * note the trick, we want 1 or 0 for whether we need * the '|' character. */ space_needed = (strlen(tab[i].name) + (sp != buffer)); if (space_left < space_needed) fatal(_("buffer overflow in genflags2str")); if (sp != buffer) { *sp++ = '|'; space_left--; } strcpy(sp, tab[i].name); /* note ordering! */ space_left -= strlen(sp); sp += strlen(sp); } } return buffer; } /* * make_scalar --- make sure that tree is a scalar. * * tree is in a scalar context. If it is a variable, accomplish * what's needed; otherwise, do nothing. * * Notice that nodes of type Node_var_new have undefined value in var_value * (a.k.a. lnode)---even though awkgram.y:variable() initializes it, * push_args() doesn't. Thus we have to initialize it. */ static inline void make_scalar(NODE *tree) { switch (tree->type) { case Node_var_array: fatal(_("attempt to use array `%s' in a scalar context"), array_vname(tree)); case Node_array_ref: switch (tree->orig_array->type) { case Node_var_array: fatal(_("attempt to use array `%s' in a scalar context"), array_vname(tree)); case Node_var_new: tree->orig_array->type = Node_var; tree->orig_array->var_value = Nnull_string; break; case Node_var: break; default: cant_happen(); } /* fall through */ case Node_var_new: tree->type = Node_var; tree->var_value = Nnull_string; default: /* shut up GCC */ break; } } /* * interpret: * Tree is a bunch of rules to run. Returns zero if it hit an exit() * statement */ int interpret(register NODE *volatile tree) { jmp_buf volatile loop_tag_stack; /* shallow binding stack for loop_tag */ static jmp_buf rule_tag; /* tag the rule currently being run, for NEXT * and EXIT statements. It is static because * there are no nested rules */ register NODE *volatile t = NULL; /* temporary */ NODE **volatile lhs; /* lhs == Left Hand Side for assigns, etc */ NODE *volatile stable_tree; int volatile traverse = TRUE; /* True => loop thru tree (Node_rule_list) */ /* avoid false source indications */ source = NULL; sourceline = 0; if (tree == NULL) return 1; sourceline = tree->source_line; source = tree->source_file; switch (tree->type) { case Node_rule_node: traverse = FALSE; /* False => one for-loop iteration only */ /* FALL THROUGH */ case Node_rule_list: for (t = tree; t != NULL; t = t->rnode) { if (traverse) tree = t->lnode; sourceline = tree->source_line; source = tree->source_file; INCREMENT(tree->exec_count); switch (setjmp(rule_tag)) { case 0: /* normal non-jump */ /* test pattern, if any */ if (tree->lnode == NULL || eval_condition(tree->lnode)) { /* using the lnode exec_count is kludgey */ if (tree->lnode != NULL) INCREMENT(tree->lnode->exec_count); (void) interpret(tree->rnode); } break; case TAG_CONTINUE: /* NEXT statement */ pop_all_forloops(); pop_fcall_stack(); return 1; case TAG_BREAK: /* EXIT statement */ pop_all_forloops(); pop_fcall_stack(); return 0; default: cant_happen(); } if (! traverse) /* case Node_rule_node */ break; /* don't loop */ } break; case Node_statement_list: for (t = tree; t != NULL; t = t->rnode) (void) interpret(t->lnode); break; case Node_K_if: INCREMENT(tree->exec_count); if (eval_condition(tree->lnode)) { INCREMENT(tree->rnode->exec_count); (void) interpret(tree->rnode->lnode); } else { (void) interpret(tree->rnode->rnode); } break; case Node_K_switch: { NODE *switch_value; NODE *switch_body; NODE *case_list; NODE *default_list; NODE *case_stmt; int match_found = FALSE; PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); INCREMENT(tree->exec_count); stable_tree = tree; switch_value = tree_eval(stable_tree->lnode); switch_body = stable_tree->rnode; case_list = switch_body->lnode; default_list = switch_body->rnode; for (; case_list != NULL; case_list = case_list->rnode) { case_stmt = case_list->lnode; /* * Once a match is found, all cases will be processed as they fall through, * so continue to execute statements until a break is reached. */ if (! match_found) { if (case_stmt->type == Node_K_default) ; /* do nothing */ else if (case_stmt->lnode->type == Node_regex) { NODE *t1; Regexp *rp; /* see comments in match_op() code about this. */ int kludge_need_start = 0; t1 = force_string(switch_value); rp = re_update(case_stmt->lnode); if (avoid_dfa(tree, t1->stptr, t1->stlen)) kludge_need_start = RE_NEED_START; match_found = (research(rp, t1->stptr, 0, t1->stlen, kludge_need_start) >= 0); if (t1 != switch_value) free_temp(t1); } else match_found = (cmp_nodes(switch_value, case_stmt->lnode) == 0); } /* If a match was found, execute the statements associated with the case. */ if (match_found) { INCREMENT(case_stmt->exec_count); switch (setjmp(loop_tag)) { case 0: /* Normal non-jump */ (void) interpret(case_stmt->rnode); break; case TAG_CONTINUE: /* continue statement */ free_temp(switch_value); RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); longjmp(loop_tag, TAG_CONTINUE); break; case TAG_BREAK: /* break statement */ free_temp(switch_value); RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); return 1; default: cant_happen(); } } } free_temp(switch_value); /* * If a default section was found, execute the statements associated with it * and execute any trailing case statements if the default falls through. */ if (! match_found && default_list != NULL) { for (case_list = default_list; case_list != NULL; case_list = case_list->rnode) { case_stmt = case_list->lnode; INCREMENT(case_stmt->exec_count); switch (setjmp(loop_tag)) { case 0: /* Normal non-jump */ (void) interpret(case_stmt->rnode); break; case TAG_CONTINUE: /* continue statement */ RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); longjmp(loop_tag, TAG_CONTINUE); break; case TAG_BREAK: /* break statement */ RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); return 1; default: cant_happen(); } } } RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); } break; case Node_K_while: PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); stable_tree = tree; while (eval_condition(stable_tree->lnode)) { INCREMENT(stable_tree->exec_count); switch (setjmp(loop_tag)) { case 0: /* normal non-jump */ (void) interpret(stable_tree->rnode); break; case TAG_CONTINUE: /* continue statement */ break; case TAG_BREAK: /* break statement */ RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); return 1; default: cant_happen(); } } RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); break; case Node_K_do: PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); stable_tree = tree; do { INCREMENT(stable_tree->exec_count); switch (setjmp(loop_tag)) { case 0: /* normal non-jump */ (void) interpret(stable_tree->rnode); break; case TAG_CONTINUE: /* continue statement */ break; case TAG_BREAK: /* break statement */ RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); return 1; default: cant_happen(); } } while (eval_condition(stable_tree->lnode)); RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); break; case Node_K_for: PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); (void) interpret(tree->forloop->init); stable_tree = tree; while (eval_condition(stable_tree->forloop->cond)) { INCREMENT(stable_tree->exec_count); switch (setjmp(loop_tag)) { case 0: /* normal non-jump */ (void) interpret(stable_tree->lnode); /* fall through */ case TAG_CONTINUE: /* continue statement */ (void) interpret(stable_tree->forloop->incr); break; case TAG_BREAK: /* break statement */ RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); return 1; default: cant_happen(); } } RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); break; case Node_K_arrayfor: { Func_ptr after_assign = NULL; NODE **list = NULL; NODE *volatile array; NODE *volatile save_array; volatile size_t i, num_elems; size_t j; volatile int retval = 0; int sort_indices = whiny_users; #define hakvar forloop->init #define arrvar forloop->incr /* get the array */ save_array = tree->arrvar; array = get_array(save_array); /* sanity: do nothing if empty */ if (array->var_array == NULL || array->table_size == 0) break; /* from switch */ /* allocate space for array */ num_elems = array->table_size; emalloc(list, NODE **, num_elems * sizeof(NODE *), "for_loop"); /* populate it */ for (i = j = 0; i < array->array_size; i++) { NODE *t = array->var_array[i]; if (t == NULL) continue; for (; t != NULL; t = t->ahnext) { list[j++] = dupnode(t); assert(list[j-1] == t); } } if (sort_indices) qsort(list, num_elems, sizeof(NODE *), comp_func); /* shazzam! */ /* now we can run the loop */ push_forloop(array->vname, list, num_elems); PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); lhs = get_lhs(tree->hakvar, &after_assign, FALSE); stable_tree = tree; for (i = 0; i < num_elems; i++) { INCREMENT(stable_tree->exec_count); unref(*((NODE **) lhs)); *lhs = make_string(list[i]->ahname_str, list[i]->ahname_len); if (after_assign) (*after_assign)(); switch (setjmp(loop_tag)) { case 0: (void) interpret(stable_tree->lnode); case TAG_CONTINUE: break; case TAG_BREAK: retval = 1; goto done; default: cant_happen(); } } done: RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid); pop_forloop(); if (do_lint && num_elems != array->table_size) lintwarn(_("for loop: array `%s' changed size from %ld to %ld during loop execution"), array_vname(save_array), (long) num_elems, (long) array->table_size); if (retval == 1) return 1; break; } #undef hakvar #undef arrvar case Node_K_break: INCREMENT(tree->exec_count); if (! loop_tag_valid) { /* * Old AT&T nawk treats break outside of loops like * next. New ones catch it at parse time. Allow it if * do_traditional is on, and complain if lint. */ static int warned = FALSE; if (do_lint && ! warned) { lintwarn(_("`break' outside a loop is not portable")); warned = TRUE; } if (! do_traditional || do_posix) fatal(_("`break' outside a loop is not allowed")); longjmp(rule_tag, TAG_CONTINUE); } else longjmp(loop_tag, TAG_BREAK); break; case Node_K_continue: INCREMENT(tree->exec_count); if (! loop_tag_valid) { /* * Old AT&T nawk treats continue outside of loops like * next. New ones catch it at parse time. Allow it if * do_traditional is on, and complain if lint. */ static int warned = FALSE; if (do_lint && ! warned) { lintwarn(_("`continue' outside a loop is not portable")); warned = TRUE; } if (! do_traditional || do_posix) fatal(_("`continue' outside a loop is not allowed")); longjmp(rule_tag, TAG_CONTINUE); } else longjmp(loop_tag, TAG_CONTINUE); break; case Node_K_print: INCREMENT(tree->exec_count); do_print(tree); break; case Node_K_print_rec: INCREMENT(tree->exec_count); do_print_rec(tree); break; case Node_K_printf: INCREMENT(tree->exec_count); do_printf(tree); break; case Node_K_delete: INCREMENT(tree->exec_count); do_delete(tree->lnode, tree->rnode); break; case Node_K_delete_loop: INCREMENT(tree->exec_count); do_delete_loop(tree->lnode, tree->rnode); break; case Node_K_next: INCREMENT(tree->exec_count); if (in_begin_rule) fatal(_("`next' cannot be called from a BEGIN rule")); else if (in_end_rule) fatal(_("`next' cannot be called from an END rule")); /* could add a lint check here for in a loop or function */ longjmp(rule_tag, TAG_CONTINUE); break; case Node_K_nextfile: INCREMENT(tree->exec_count); if (in_begin_rule) fatal(_("`nextfile' cannot be called from a BEGIN rule")); else if (in_end_rule) fatal(_("`nextfile' cannot be called from an END rule")); /* could add a lint check here for in a loop or function */ /* * Have to do this cleanup here, since we don't longjump * back to the main awk rule loop (rule_tag). */ pop_all_forloops(); pop_fcall_stack(); do_nextfile(); break; case Node_K_exit: INCREMENT(tree->exec_count); /* * In A,K,&W, p. 49, it says that an exit statement "... * causes the program to behave as if the end of input had * occurred; no more input is read, and the END actions, if * any are executed." This implies that the rest of the rules * are not done. So we immediately break out of the main loop. */ exiting = TRUE; if (tree->lnode != NULL) { t = tree_eval(tree->lnode); exit_val = (int) force_number(t); free_temp(t); } longjmp(rule_tag, TAG_BREAK); break; case Node_K_return: INCREMENT(tree->exec_count); t = tree_eval(tree->lnode); if ((t->flags & (PERM|TEMP)) != 0) ret_node = t; else { ret_node = copynode(t); /* don't do a dupnode here */ ret_node->flags |= TEMP; } longjmp(func_tag, TAG_RETURN); break; default: /* * Appears to be an expression statement. Throw away the * value. */ if (do_lint && (tree->type == Node_var || tree->type == Node_var_new)) lintwarn(_("statement has no effect")); INCREMENT(tree->exec_count); t = tree_eval(tree); if (t) /* stopme() returns NULL */ free_temp(t); break; } return 1; } /* * calc_exp_posint --- calculate x^n for positive integral n, * using exponentiation by squaring without recursion. */ static AWKNUM calc_exp_posint(AWKNUM x, long n) { AWKNUM mult = 1; while (n > 1) { if ((n % 2) == 1) mult *= x; x *= x; n /= 2; } return mult * x; } /* calc_exp --- calculate x1^x2 */ static AWKNUM calc_exp(AWKNUM x1, AWKNUM x2) { long lx; if ((lx = x2) == x2) { /* integer exponent */ if (lx == 0) return 1; return (lx > 0) ? calc_exp_posint(x1, lx) : 1.0 / calc_exp_posint(x1, -lx); } return (AWKNUM) pow((double) x1, (double) x2); } /* r_tree_eval --- evaluate a subtree */ NODE * r_tree_eval(register NODE *tree, int iscond) { register NODE *r, *t1, *t2; /* return value & temporary subtrees */ register NODE **lhs; register int di; AWKNUM x, x1, x2; #ifdef _CRAY long lx2; #endif #ifndef TREE_EVAL_MACRO if (tree == NULL) cant_happen(); if (tree->type == Node_val) { if (tree->stref <= 0) cant_happen(); return ((tree->flags & INTLSTR) != 0 ? r_force_string(tree) : tree); } else if (tree->type == Node_var) { if (tree->var_value->stref <= 0) cant_happen(); if (! var_uninitialized(tree)) return tree->var_value; } #endif if (tree->type == Node_param_list) { if ((tree->flags & FUNC) != 0) fatal(_("can't use function name `%s' as variable or array"), tree->vname); tree = stack_ptr[tree->param_cnt]; if (tree == NULL) { if (do_lint) lintwarn(_("reference to uninitialized argument `%s'"), tree->vname); return Nnull_string; } if (do_lint && var_uninitialized(tree)) lintwarn(_("reference to uninitialized argument `%s'"), tree->vname); } make_scalar(tree); switch (tree->type) { case Node_var: if (do_lint && var_uninitialized(tree)) lintwarn(_("reference to uninitialized variable `%s'"), tree->vname); return tree->var_value; case Node_and: return tmp_number((AWKNUM) (eval_condition(tree->lnode) && eval_condition(tree->rnode))); case Node_or: return tmp_number((AWKNUM) (eval_condition(tree->lnode) || eval_condition(tree->rnode))); case Node_not: return tmp_number((AWKNUM) ! eval_condition(tree->lnode)); /* Builtins */ case Node_builtin: return (*tree->builtin)(tree->subnode); case Node_K_getline: return do_getline(tree); case Node_in_array: return tmp_number((AWKNUM) (in_array(tree->lnode, tree->rnode) != NULL)); case Node_func_call: return func_call(tree); /* unary operations */ case Node_NR: case Node_FNR: case Node_NF: case Node_FIELDWIDTHS: case Node_FS: case Node_RS: case Node_field_spec: case Node_subscript: case Node_IGNORECASE: case Node_OFS: case Node_ORS: case Node_OFMT: case Node_CONVFMT: case Node_BINMODE: case Node_LINT: case Node_SUBSEP: case Node_TEXTDOMAIN: lhs = get_lhs(tree, (Func_ptr *) NULL, TRUE); return *lhs; case Node_unary_minus: t1 = tree_eval(tree->subnode); x = -force_number(t1); free_temp(t1); return tmp_number(x); case Node_cond_exp: if (eval_condition(tree->lnode)) return tree_eval(tree->rnode->lnode); return tree_eval(tree->rnode->rnode); case Node_match: case Node_nomatch: case Node_regex: case Node_dynregex: return match_op(tree); case Node_concat: { NODE **treelist; NODE **strlist; NODE *save_tree; register NODE **treep; register NODE **strp; register size_t len; register size_t supposed_len; char *str; register char *dest; int alloc_count, str_count; int i; /* * This is an efficiency hack for multiple adjacent string * concatenations, to avoid recursion and string copies. * * Node_concat trees grow downward to the left, so * descend to lowest (first) node, accumulating nodes * to evaluate to strings as we go. */ /* * But first, no arbitrary limits. Count the number of * nodes and malloc the treelist and strlist arrays. * There will be alloc_count + 1 items to concatenate. We * also leave room for an extra pointer at the end to * use as a sentinel. Thus, start alloc_count at 2. */ save_tree = tree; for (alloc_count = 2; tree != NULL && tree->type == Node_concat; tree = tree->lnode) alloc_count++; tree = save_tree; emalloc(treelist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval"); emalloc(strlist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval"); /* Now, here we go. */ treep = treelist; while (tree != NULL && tree->type == Node_concat) { *treep++ = tree->rnode; tree = tree->lnode; } *treep = tree; /* * Now, evaluate to strings in LIFO order, accumulating * the string length, so we can do a single malloc at the * end. * * Evaluate the expressions first, then get their * lengthes, in case one of the expressions has a * side effect that changes one of the others. * See test/nasty.awk. * * dupnode the results a la do_print, to give us * more predicable behavior; compare gawk 3.0.6 to * nawk/mawk on test/nasty.awk. */ strp = strlist; supposed_len = len = 0; while (treep >= treelist) { NODE *n; /* Here lies the wumpus's brother. R.I.P. */ n = force_string(tree_eval(*treep--)); *strp = dupnode(n); free_temp(n); supposed_len += (*strp)->stlen; strp++; } *strp = NULL; str_count = strp - strlist; strp = strlist; for (i = 0; i < str_count; i++) { len += (*strp)->stlen; strp++; } if (do_lint && supposed_len != len) lintwarn(_("concatenation: side effects in one expression have changed the length of another!")); emalloc(str, char *, len+2, "tree_eval"); str[len] = str[len+1] = '\0'; /* for good measure */ dest = str; strp = strlist; while (*strp != NULL) { memcpy(dest, (*strp)->stptr, (*strp)->stlen); dest += (*strp)->stlen; unref(*strp); strp++; } r = make_str_node(str, len, ALREADY_MALLOCED); r->flags |= TEMP; free(strlist); free(treelist); } return r; /* assignments */ case Node_assign_concat: { Func_ptr after_assign = NULL; NODE *l, *r; /* * Note that something lovely like this: * * BEGIN { a = "a"; a = a (a = "b"); print a } * * is not defined. It could print `ab' or `bb'. * Gawk 3.1.3 prints `ab', so we do that too, simply * by evaluating the LHS first. Ugh. * * Thanks to mary1john@earthlink.net for pointing * out this issue. */ lhs = get_lhs(tree->lnode, &after_assign, FALSE); *lhs = force_string(*lhs); l = *lhs; r = force_string(tree_eval(tree->rnode)); /* * Don't clobber string constants! * * Also check stref; see test/strcat1.awk, * the test for l->stref == 1 can't be an * assertion. * * Thanks again to mary1john@earthlink.net for pointing * out this issue. */ if (l != r && (l->flags & PERM) == 0 && l->stref == 1) { size_t nlen = l->stlen + r->stlen + 2; erealloc(l->stptr, char *, nlen, "interpret"); memcpy(l->stptr + l->stlen, r->stptr, r->stlen); l->stlen += r->stlen; l->stptr[l->stlen] = '\0'; } else { char *nval; size_t nlen = l->stlen + r->stlen + 2; emalloc(nval, char *, nlen, "interpret"); memcpy(nval, l->stptr, l->stlen); memcpy(nval + l->stlen, r->stptr, r->stlen); unref(*lhs); *lhs = make_str_node(nval, l->stlen + r->stlen, ALREADY_MALLOCED); } free_temp(r); if (after_assign) (*after_assign)(); return *lhs; } case Node_assign: { Func_ptr after_assign = NULL; if (do_lint && iscond) lintwarn(_("assignment used in conditional context")); r = tree_eval(tree->rnode); lhs = get_lhs(tree->lnode, &after_assign, FALSE); assign_val(lhs, r); if (after_assign) (*after_assign)(); return *lhs; } /* other assignment types are easier because they are numeric */ case Node_preincrement: case Node_predecrement: case Node_postincrement: case Node_postdecrement: case Node_assign_exp: case Node_assign_times: case Node_assign_quotient: case Node_assign_mod: case Node_assign_plus: case Node_assign_minus: return op_assign(tree); default: break; /* handled below */ } /* * Evaluate subtrees in order to do binary operation, then keep going. * Use dupnode to make sure that these values don't disappear out * from under us during recursive subexpression evaluation. */ t1 = dupnode(tree_eval(tree->lnode)); t2 = dupnode(tree_eval(tree->rnode)); switch (tree->type) { case Node_geq: case Node_leq: case Node_greater: case Node_less: case Node_notequal: case Node_equal: di = cmp_nodes(t1, t2); unref(t1); unref(t2); switch (tree->type) { case Node_equal: return tmp_number((AWKNUM) (di == 0)); case Node_notequal: return tmp_number((AWKNUM) (di != 0)); case Node_less: return tmp_number((AWKNUM) (di < 0)); case Node_greater: return tmp_number((AWKNUM) (di > 0)); case Node_leq: return tmp_number((AWKNUM) (di <= 0)); case Node_geq: return tmp_number((AWKNUM) (di >= 0)); default: cant_happen(); } break; default: break; /* handled below */ } x1 = force_number(t1); x2 = force_number(t2); unref(t1); unref(t2); switch (tree->type) { case Node_exp: return tmp_number(calc_exp(x1, x2)); case Node_times: return tmp_number(x1 * x2); case Node_quotient: if (x2 == 0) fatal(_("division by zero attempted")); #ifdef _CRAY /* special case for integer division, put in for Cray */ lx2 = x2; if (lx2 == 0) return tmp_number(x1 / x2); lx = (long) x1 / lx2; if (lx * x2 == x1) return tmp_number((AWKNUM) lx); else #endif return tmp_number(x1 / x2); case Node_mod: if (x2 == 0) fatal(_("division by zero attempted in `%%'")); #ifdef HAVE_FMOD return tmp_number(fmod(x1, x2)); #else /* ! HAVE_FMOD */ (void) modf(x1 / x2, &x); return tmp_number(x1 - x * x2); #endif /* ! HAVE_FMOD */ case Node_plus: return tmp_number(x1 + x2); case Node_minus: return tmp_number(x1 - x2); default: fatal(_("illegal type (%s) in tree_eval"), nodetype2str(tree->type)); } return (NODE *) 0; } /* eval_condition --- is TREE true or false? Returns 0==false, non-zero==true */ static int eval_condition(register NODE *tree) { register NODE *t1; register int ret; if (tree == NULL) /* Null trees are the easiest kinds */ return TRUE; if (tree->type == Node_line_range) { /* * Node_line_range is kind of like Node_match, EXCEPT: the * lnode field (more properly, the condpair field) is a node * of a Node_cond_pair; whether we evaluate the lnode of that * node or the rnode depends on the triggered word. More * precisely: if we are not yet triggered, we tree_eval the * lnode; if that returns true, we set the triggered word. * If we are triggered (not ELSE IF, note), we tree_eval the * rnode, clear triggered if it succeeds, and perform our * action (regardless of success or failure). We want to be * able to begin and end on a single input record, so this * isn't an ELSE IF, as noted above. */ if (! tree->triggered) { if (! eval_condition(tree->condpair->lnode)) return FALSE; else tree->triggered = TRUE; } /* Else we are triggered */ if (eval_condition(tree->condpair->rnode)) tree->triggered = FALSE; return TRUE; } /* * Could just be J.random expression. in which case, null and 0 are * false, anything else is true */ t1 = m_tree_eval(tree, TRUE); if (t1->flags & MAYBE_NUM) (void) force_number(t1); if (t1->flags & NUMBER) ret = (t1->numbr != 0.0); else ret = (t1->stlen != 0); free_temp(t1); return ret; } /* cmp_nodes --- compare two nodes, returning negative, 0, positive */ int cmp_nodes(register NODE *t1, register NODE *t2) { register int ret; register size_t len1, len2; register int l; int ldiff; if (t1 == t2) return 0; if (t1->flags & MAYBE_NUM) (void) force_number(t1); if (t2->flags & MAYBE_NUM) (void) force_number(t2); if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) { if (t1->numbr == t2->numbr) return 0; /* don't subtract, in case one or both are infinite */ else if (t1->numbr < t2->numbr) return -1; else return 1; } (void) force_string(t1); (void) force_string(t2); len1 = t1->stlen; len2 = t2->stlen; ldiff = len1 - len2; if (len1 == 0 || len2 == 0) return ldiff; l = (ldiff <= 0 ? len1 : len2); if (IGNORECASE) { const unsigned char *cp1 = (const unsigned char *) t1->stptr; const unsigned char *cp2 = (const unsigned char *) t2->stptr; #ifdef MBS_SUPPORT if (gawk_mb_cur_max > 1) { mbstate_t mbs; memset(&mbs, 0, sizeof(mbstate_t)); ret = strncasecmpmbs((const char *) cp1, mbs, (const char *) cp2, mbs, l); } else #endif /* Could use tolower() here; see discussion above. */ for (ret = 0; l-- > 0 && ret == 0; cp1++, cp2++) ret = casetable[*cp1] - casetable[*cp2]; } else ret = memcmp(t1->stptr, t2->stptr, l); return (ret == 0 ? ldiff : ret); } /* op_assign --- do +=, -=, etc. */ static NODE * op_assign(register NODE *tree) { AWKNUM rval, lval; NODE **lhs; NODE *tmp; Func_ptr after_assign = NULL; int post = FALSE; /* * For += etc, do the rhs first, since it can rearrange things, * and *then* get the lhs. */ if (tree->rnode != NULL) { tmp = tree_eval(tree->rnode); rval = force_number(tmp); free_temp(tmp); } else rval = (AWKNUM) 1.0; lhs = get_lhs(tree->lnode, &after_assign, TRUE); lval = force_number(*lhs); unref(*lhs); switch(tree->type) { case Node_postincrement: post = TRUE; /* fall through */ case Node_preincrement: case Node_assign_plus: *lhs = make_number(lval + rval); break; case Node_postdecrement: post = TRUE; /* fall through */ case Node_predecrement: case Node_assign_minus: *lhs = make_number(lval - rval); break; case Node_assign_exp: *lhs = make_number(calc_exp(lval, rval)); break; case Node_assign_times: *lhs = make_number(lval * rval); break; case Node_assign_quotient: if (rval == (AWKNUM) 0) fatal(_("division by zero attempted in `/='")); { #ifdef _CRAY long ltemp; /* special case for integer division, put in for Cray */ ltemp = rval; if (ltemp == 0) { *lhs = make_number(lval / rval); break; } ltemp = (long) lval / ltemp; if (ltemp * lval == rval) *lhs = make_number((AWKNUM) ltemp); else #endif /* _CRAY */ *lhs = make_number(lval / rval); } break; case Node_assign_mod: if (rval == (AWKNUM) 0) fatal(_("division by zero attempted in `%%='")); #ifdef HAVE_FMOD *lhs = make_number(fmod(lval, rval)); #else /* ! HAVE_FMOD */ { AWKNUM t1, t2; (void) modf(lval / rval, &t1); t2 = lval - rval * t1; *lhs = make_number(t2); } #endif /* ! HAVE_FMOD */ break; default: cant_happen(); } if (after_assign) (*after_assign)(); /* for postincrement or postdecrement, return the old value */ return (post ? tmp_number(lval) : *lhs); } /* * Avoiding memory leaks is difficult. In paticular, any of `next', * `nextfile', `break' or `continue' (when not in a loop), can longjmp * out to the outermost level. This leaks memory if it happens in a * called function. It also leaks memory if it happens in a * `for (iggy in foo)' loop, since such loops malloc an array of the * current array indices to loop over, which provides stability. * * The following code takes care of these problems. First comes the * array-loop management code. This can be a stack of arrays being looped * on at any one time. This stack serves for both mainline code and * function body code. As each loop starts and finishes, it pushes its * info onto this stack and off of it; whether the loop is in a function * body or not isn't relevant. * * Since the list of indices is created using dupnode(), when popping * this stack it should be safe to unref() things, and then memory * will get finally released when the function call stack is popped. * This means that the loop_stack should be popped first upon a `next'. */ static struct loop_info { const char *varname; /* variable name, for debugging */ NODE **elems; /* list of indices */ size_t nelems; /* how many there are */ } *loop_stack = NULL; size_t nloops = 0; /* how many slots there are in the stack */ size_t nloops_active = 0; /* how many loops are actively stacked */ /* pop_forloop --- pop one for loop off the stack */ static void pop_forloop() { int i, curloop; struct loop_info *loop; assert(nloops_active > 0); curloop = --nloops_active; /* 0-based indexing */ loop = & loop_stack[curloop]; for (i = 0; i < loop->nelems; i++) unref(loop->elems[i]); free(loop->elems); loop->elems = NULL; loop->varname = NULL; loop->nelems = 0; } /* pop_forloops --- pop the for loops stack all the way */ static inline void pop_all_forloops() { while (nloops_active > 0) pop_forloop(); /* decrements nloops_active for us */ } /* push_forloop --- add a single for loop to the stack */ static void push_forloop(const char *varname, NODE **elems, size_t nelems) { #define NLOOPS 4 /* seems like a good guess */ if (loop_stack == NULL) { /* allocate stack, set vars */ nloops = NLOOPS; emalloc(loop_stack, struct loop_info *, nloops * sizeof(struct loop_info), "push_forloop"); } else if (nloops_active == nloops) { /* grow stack, set vars */ nloops *= 2; erealloc(loop_stack, struct loop_info *, nloops * sizeof(struct loop_info), "push_forloop"); } loop_stack[nloops_active].varname = varname; loop_stack[nloops_active].elems = elems; loop_stack[nloops_active].nelems = nelems; nloops_active++; } /* * 2/2004: * N.B. The code that uses fcalls[] *always* uses indexing. * This avoids severe problems in case fcalls gets realloc()'ed * during recursive tree_eval()'s or whatever, so that we don't * have to carefully reassign pointers into the array. The * minor speed gain from using a pointer was offset too much * by the hassles to get the code right and commented. * * Thanks and a tip of the hatlo to Brian Kernighan. */ static struct fcall { const char *fname; /* function name */ size_t count; /* how many args */ NODE *arglist; /* list thereof */ NODE **prevstack; /* function stack frame of previous function */ NODE **stack; /* function stack frame of current function */ } *fcalls = NULL; static long fcall_list_size = 0; static long curfcall = -1; /* * get_curfunc_arg_count --- return number actual parameters * * This is for use by dynamically loaded C extension functions. */ size_t get_curfunc_arg_count(void) { NODE *argp; size_t argc; assert(curfcall >= 0); /* count the # of expressions in argument expression list */ for (argc = 0, argp = fcalls[curfcall].arglist; argp != NULL; argp = argp->rnode) argc++; return argc; } /* pop_fcall --- pop off a single function call */ static void pop_fcall() { NODE *n, **sp; int count; assert(curfcall >= 0); stack_ptr = fcalls[curfcall].prevstack; sp = fcalls[curfcall].stack; for (count = fcalls[curfcall].count; count > 0; count--) { n = *sp++; if (n->type == Node_var) /* local variable */ unref(n->var_value); else if (n->type == Node_var_array) /* local array */ assoc_clear(n); freenode(n); } if (fcalls[curfcall].stack) { free((char *) fcalls[curfcall].stack); fcalls[curfcall].stack = NULL; } curfcall--; } /* pop_fcall_stack --- pop off all function args, don't leak memory */ static inline void pop_fcall_stack() { while (curfcall >= 0) pop_fcall(); } /* push_args --- push function arguments onto the stack */ static void push_args(int count, NODE *argp, NODE **oldstack, const char *func_name, char **varnames) { NODE *arg, *r, **sp; int i; if (fcall_list_size == 0) { /* first time */ emalloc(fcalls, struct fcall *, 10 * sizeof(struct fcall), "push_args"); fcall_list_size = 10; } if (++curfcall >= fcall_list_size) { fcall_list_size *= 2; erealloc(fcalls, struct fcall *, fcall_list_size * sizeof(struct fcall), "push_args"); } if (count > 0) emalloc(fcalls[curfcall].stack, NODE **, count*sizeof(NODE *), "push_args"); else fcalls[curfcall].stack = NULL; fcalls[curfcall].count = count; fcalls[curfcall].fname = func_name; /* not used, for debugging, just in case */ fcalls[curfcall].arglist = argp; fcalls[curfcall].prevstack = oldstack; sp = fcalls[curfcall].stack; /* for each calling arg. add NODE * on stack */ for (i = 0; i < count; i++) { getnode(r); *sp++ = r; if (argp == NULL) { /* local variable */ r->type = Node_var_new; r->var_value = Nnull_string; r->vname = varnames[i]; r->rnode = NULL; continue; } arg = argp->lnode; /* call by reference for arrays; see below also */ if (arg->type == Node_param_list) arg = fcalls[curfcall].prevstack[arg->param_cnt]; if (arg->type == Node_var_array || arg->type == Node_var_new) { r->type = Node_array_ref; r->orig_array = arg; r->prev_array = arg; } else if (arg->type == Node_array_ref) { *r = *arg; r->prev_array = arg; } else { NODE *n = tree_eval(arg); r->type = Node_var; r->lnode = dupnode(n); r->rnode = (NODE *) NULL; free_temp(n); } r->vname = varnames[i]; argp = argp->rnode; } if (argp != NULL) { /* Left over calling args. */ warning( _("function `%s' called with more arguments than declared"), func_name); /* Evaluate them, they may have side effects: */ do { arg = argp->lnode; if (arg->type == Node_param_list) arg = fcalls[curfcall].prevstack[arg->param_cnt]; if (arg->type != Node_var_array && arg->type != Node_array_ref && arg->type != Node_var_new) free_temp(tree_eval(arg)); } while ((argp = argp->rnode) != NULL); } stack_ptr = fcalls[curfcall].stack; } /* func_call --- call a function, call by reference for arrays */ NODE **stack_ptr; static NODE * func_call(NODE *tree) { register NODE *r; NODE *name, *arg_list; NODE *f; jmp_buf volatile func_tag_stack; jmp_buf volatile loop_tag_stack; int volatile save_loop_tag_valid = FALSE; NODE *save_ret_node; extern NODE *ret_node; /* tree->rnode is a Node_val giving function name */ /* tree->lnode is Node_expression_list of calling args. */ name = tree->rnode; arg_list = tree->lnode; /* retrieve function definition node */ if (tree->funcbody != NULL) f = tree->funcbody; else { f = lookup(name->stptr); if (f == NULL || f->type != Node_func) fatal(_("function `%s' not defined"), name->stptr); tree->funcbody = f; /* save for next call */ } #ifdef FUNC_TRACE fprintf(stderr, "function `%s' called\n", name->stptr); #endif push_args(f->lnode->param_cnt, arg_list, stack_ptr, name->stptr, f->parmlist); /* * Execute function body, saving context, as a return statement * will longjmp back here. * * Have to save and restore the loop_tag stuff so that a return * inside a loop in a function body doesn't scrog any loops going * on in the main program. We save the necessary info in variables * local to this function so that function nesting works OK. * We also only bother to save the loop stuff if we're in a loop * when the function is called. */ if (loop_tag_valid) { int junk = 0; save_loop_tag_valid = (volatile int) loop_tag_valid; PUSH_BINDING(loop_tag_stack, loop_tag, junk); loop_tag_valid = FALSE; } PUSH_BINDING(func_tag_stack, func_tag, func_tag_valid); save_ret_node = ret_node; ret_node = Nnull_string; /* default return value */ INCREMENT(f->exec_count); /* count function calls */ if (setjmp(func_tag) == 0) (void) interpret(f->rnode); r = ret_node; ret_node = (NODE *) save_ret_node; RESTORE_BINDING(func_tag_stack, func_tag, func_tag_valid); pop_fcall(); /* Restore the loop_tag stuff if necessary. */ if (save_loop_tag_valid) { int junk = 0; loop_tag_valid = (int) save_loop_tag_valid; RESTORE_BINDING(loop_tag_stack, loop_tag, junk); } return r; } #ifdef PROFILING /* dump_fcall_stack --- print a backtrace of the awk function calls */ void dump_fcall_stack(FILE *fp) { int i; if (curfcall < 0) return; fprintf(fp, _("\n\t# Function Call Stack:\n\n")); for (i = curfcall; i >= 0; i--) fprintf(fp, "\t# %3d. %s\n", i+1, fcalls[i].fname); fprintf(fp, _("\t# -- main --\n")); } #endif /* PROFILING */ /* * r_get_lhs: * This returns a POINTER to a node pointer. get_lhs(ptr) is the current * value of the var, or where to store the var's new value * * For the special variables, don't unref their current value if it's * the same as the internal copy; perhaps the current one is used in * a concatenation or some other expression somewhere higher up in the * call chain. Ouch. */ NODE ** r_get_lhs(register NODE *ptr, Func_ptr *assign, int reference) { register NODE **aptr = NULL; register NODE *n; if (assign) *assign = NULL; /* for safety */ if (ptr->type == Node_param_list) { if ((ptr->flags & FUNC) != 0) fatal(_("can't use function name `%s' as variable or array"), ptr->vname); ptr = stack_ptr[ptr->param_cnt]; } make_scalar(ptr); switch (ptr->type) { case Node_var: if (do_lint && reference && var_uninitialized(ptr)) lintwarn(_("reference to uninitialized variable `%s'"), ptr->vname); aptr = &(ptr->var_value); #ifdef GAWKDEBUG if (ptr->var_value->stref <= 0) cant_happen(); #endif break; case Node_FIELDWIDTHS: aptr = &(FIELDWIDTHS_node->var_value); if (assign != NULL) *assign = set_FIELDWIDTHS; break; case Node_RS: aptr = &(RS_node->var_value); if (assign != NULL) *assign = set_RS; break; case Node_FS: aptr = &(FS_node->var_value); if (assign != NULL) *assign = set_FS; break; case Node_FNR: if (FNR_node->var_value->numbr != FNR) { unref(FNR_node->var_value); FNR_node->var_value = make_number((AWKNUM) FNR); } aptr = &(FNR_node->var_value); if (assign != NULL) *assign = set_FNR; break; case Node_NR: if (NR_node->var_value->numbr != NR) { unref(NR_node->var_value); NR_node->var_value = make_number((AWKNUM) NR); } aptr = &(NR_node->var_value); if (assign != NULL) *assign = set_NR; break; case Node_NF: if (NF == -1 || NF_node->var_value->numbr != NF) { if (NF == -1) (void) get_field(UNLIMITED-1, assign); /* parse record */ unref(NF_node->var_value); NF_node->var_value = make_number((AWKNUM) NF); } aptr = &(NF_node->var_value); if (assign != NULL) *assign = set_NF; break; case Node_IGNORECASE: aptr = &(IGNORECASE_node->var_value); if (assign != NULL) *assign = set_IGNORECASE; break; case Node_BINMODE: aptr = &(BINMODE_node->var_value); if (assign != NULL) *assign = set_BINMODE; break; case Node_LINT: aptr = &(LINT_node->var_value); if (assign != NULL) *assign = set_LINT; break; case Node_OFMT: aptr = &(OFMT_node->var_value); if (assign != NULL) *assign = set_OFMT; break; case Node_CONVFMT: aptr = &(CONVFMT_node->var_value); if (assign != NULL) *assign = set_CONVFMT; break; case Node_ORS: aptr = &(ORS_node->var_value); if (assign != NULL) *assign = set_ORS; break; case Node_OFS: aptr = &(OFS_node->var_value); if (assign != NULL) *assign = set_OFS; break; case Node_SUBSEP: aptr = &(SUBSEP_node->var_value); if (assign != NULL) *assign = set_SUBSEP; break; case Node_TEXTDOMAIN: aptr = &(TEXTDOMAIN_node->var_value); if (assign != NULL) *assign = set_TEXTDOMAIN; break; case Node_field_spec: { int field_num; n = tree_eval(ptr->lnode); if (do_lint) { if ((n->flags & NUMBER) == 0) { lintwarn(_("attempt to field reference from non-numeric value")); if (n->stlen == 0) lintwarn(_("attempt to reference from null string")); } } field_num = (int) force_number(n); free_temp(n); if (field_num < 0) fatal(_("attempt to access field %d"), field_num); if (field_num == 0 && field0_valid) { /* short circuit */ aptr = &fields_arr[0]; if (assign != NULL) *assign = reset_record; } else aptr = get_field(field_num, assign); if (do_lint && reference && (*aptr == Null_field || *aptr == Nnull_string)) lintwarn(_("reference to uninitialized field `$%d'"), field_num); break; } case Node_subscript: n = get_array(ptr->lnode); aptr = assoc_lookup(n, concat_exp(ptr->rnode), reference); break; case Node_builtin: #if 1 /* in gawk for a while */ fatal(_("assignment is not allowed to result of builtin function")); #else /* * This is how Christos at Deshaw did it. * Does this buy us anything? */ if (ptr->builtin == NULL) fatal(_("assignment is not allowed to result of builtin function")); ptr->callresult = (*ptr->builtin)(ptr->subnode); aptr = &ptr->callresult; break; #endif default: fprintf(stderr, "type = %s\n", nodetype2str(ptr->type)); fflush(stderr); cant_happen(); } return aptr; } /* match_op --- do ~ and !~ */ static NODE * match_op(register NODE *tree) { register NODE *t1; register Regexp *rp; int i; int match = TRUE; int kludge_need_start = 0; /* FIXME: --- see below */ if (tree->type == Node_nomatch) match = FALSE; if (tree->type == Node_regex) t1 = *get_field(0, (Func_ptr *) 0); else { t1 = force_string(tree_eval(tree->lnode)); tree = tree->rnode; } rp = re_update(tree); /* * FIXME: * * Any place where research() is called with a last parameter of * zero, we need to use the avoid_dfa test. This appears here and * in the code for Node_K_switch. * * A new or improved dfa that distinguishes beginning/end of * string from beginning/end of line will allow us to get rid of * this temporary hack. * * The avoid_dfa() function is in re.c; it is not very smart. */ if (avoid_dfa(tree, t1->stptr, t1->stlen)) kludge_need_start = RE_NEED_START; i = research(rp, t1->stptr, 0, t1->stlen, kludge_need_start); i = (i == -1) ^ (match == TRUE); free_temp(t1); return tmp_number((AWKNUM) i); } /* set_IGNORECASE --- update IGNORECASE as appropriate */ void set_IGNORECASE() { static int warned = FALSE; if ((do_lint || do_traditional) && ! warned) { warned = TRUE; lintwarn(_("`IGNORECASE' is a gawk extension")); } load_casetable(); if (do_traditional) IGNORECASE = FALSE; else if ((IGNORECASE_node->var_value->flags & (STRING|STRCUR)) != 0) { if ((IGNORECASE_node->var_value->flags & MAYBE_NUM) == 0) IGNORECASE = (force_string(IGNORECASE_node->var_value)->stlen > 0); else IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0); } else if ((IGNORECASE_node->var_value->flags & (NUMCUR|NUMBER)) != 0) IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0); else IGNORECASE = FALSE; /* shouldn't happen */ set_RS(); /* set_RS() calls set_FS() if need be, for us */ } /* set_BINMODE --- set translation mode (OS/2, DOS, others) */ void set_BINMODE() { static int warned = FALSE; char *p, *cp, save; NODE *v; int digits = FALSE; if ((do_lint || do_traditional) && ! warned) { warned = TRUE; lintwarn(_("`BINMODE' is a gawk extension")); } if (do_traditional) BINMODE = 0; else if ((BINMODE_node->var_value->flags & STRING) != 0) { v = BINMODE_node->var_value; p = v->stptr; save = p[v->stlen]; p[v->stlen] = '\0'; for (cp = p; *cp != '\0'; cp++) { if (ISDIGIT(*cp)) { digits = TRUE; break; } } if (! digits || (BINMODE_node->var_value->flags & MAYBE_NUM) == 0) { BINMODE = 0; if (strcmp(p, "r") == 0) BINMODE = 1; else if (strcmp(p, "w") == 0) BINMODE = 2; else if (strcmp(p, "rw") == 0 || strcmp(p, "wr") == 0) BINMODE = 3; if (BINMODE == 0 && v->stlen != 0) { /* arbitrary string, assume both */ BINMODE = 3; warning("BINMODE: arbitrary string value treated as \"rw\""); } } else BINMODE = (int) force_number(BINMODE_node->var_value); p[v->stlen] = save; } else if ((BINMODE_node->var_value->flags & NUMBER) != 0) BINMODE = (int) force_number(BINMODE_node->var_value); else BINMODE = 0; /* shouldn't happen */ } /* set_OFS --- update OFS related variables when OFS assigned to */ void set_OFS() { OFS = force_string(OFS_node->var_value)->stptr; OFSlen = OFS_node->var_value->stlen; OFS[OFSlen] = '\0'; } /* set_ORS --- update ORS related variables when ORS assigned to */ void set_ORS() { ORS = force_string(ORS_node->var_value)->stptr; ORSlen = ORS_node->var_value->stlen; ORS[ORSlen] = '\0'; } /* fmt_ok --- is the conversion format a valid one? */ NODE **fmt_list = NULL; static int fmt_ok P((NODE *n)); static int fmt_index P((NODE *n)); static int fmt_ok(NODE *n) { NODE *tmp = force_string(n); const char *p = tmp->stptr; #if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1 static const char float_formats[] = "efgEG"; #else static const char float_formats[] = "efgEFG"; #endif #if defined(HAVE_LOCALE_H) static const char flags[] = " +-#'"; #else static const char flags[] = " +-#"; #endif if (*p++ != '%') return 0; while (*p && strchr(flags, *p) != NULL) /* flags */ p++; while (*p && ISDIGIT(*p)) /* width - %*.*g is NOT allowed */ p++; if (*p == '\0' || (*p != '.' && ! ISDIGIT(*p))) return 0; if (*p == '.') p++; while (*p && ISDIGIT(*p)) /* precision */ p++; if (*p == '\0' || strchr(float_formats, *p) == NULL) return 0; if (*++p != '\0') return 0; return 1; } /* fmt_index --- track values of OFMT and CONVFMT to keep semantics correct */ static int fmt_index(NODE *n) { register int ix = 0; static int fmt_num = 4; static int fmt_hiwater = 0; if (fmt_list == NULL) emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index"); (void) force_string(n); while (ix < fmt_hiwater) { if (cmp_nodes(fmt_list[ix], n) == 0) return ix; ix++; } /* not found */ n->stptr[n->stlen] = '\0'; if (do_lint && ! fmt_ok(n)) lintwarn(_("bad `%sFMT' specification `%s'"), n == CONVFMT_node->var_value ? "CONV" : n == OFMT_node->var_value ? "O" : "", n->stptr); if (fmt_hiwater >= fmt_num) { fmt_num *= 2; erealloc(fmt_list, NODE **, fmt_num * sizeof(*fmt_list), "fmt_index"); } fmt_list[fmt_hiwater] = dupnode(n); return fmt_hiwater++; } /* set_OFMT --- track OFMT correctly */ void set_OFMT() { OFMTidx = fmt_index(OFMT_node->var_value); OFMT = fmt_list[OFMTidx]->stptr; } /* set_CONVFMT --- track CONVFMT correctly */ void set_CONVFMT() { CONVFMTidx = fmt_index(CONVFMT_node->var_value); CONVFMT = fmt_list[CONVFMTidx]->stptr; } /* set_LINT --- update LINT as appropriate */ void set_LINT() { #ifndef NO_LINT int old_lint = do_lint; if ((LINT_node->var_value->flags & (STRING|STRCUR)) != 0) { if ((LINT_node->var_value->flags & MAYBE_NUM) == 0) { const char *lintval; size_t lintlen; do_lint = (force_string(LINT_node->var_value)->stlen > 0); lintval = LINT_node->var_value->stptr; lintlen = LINT_node->var_value->stlen; if (do_lint) { do_lint = LINT_ALL; if (lintlen == 5 && strncmp(lintval, "fatal", 5) == 0) lintfunc = r_fatal; else if (lintlen == 7 && strncmp(lintval, "invalid", 7) == 0) do_lint = LINT_INVALID; else lintfunc = warning; } else lintfunc = warning; } else { if (force_number(LINT_node->var_value) != 0.0) do_lint = LINT_ALL; else do_lint = FALSE; lintfunc = warning; } } else if ((LINT_node->var_value->flags & (NUMCUR|NUMBER)) != 0) { if (force_number(LINT_node->var_value) != 0.0) do_lint = LINT_ALL; else do_lint = FALSE; lintfunc = warning; } else do_lint = FALSE; /* shouldn't happen */ if (! do_lint) lintfunc = warning; /* explicitly use warning() here, in case lintfunc == r_fatal */ if (old_lint != do_lint && old_lint && do_lint == FALSE) warning(_("turning off `--lint' due to assignment to `LINT'")); #endif /* ! NO_LINT */ } /* set_TEXTDOMAIN --- update TEXTDOMAIN variable when TEXTDOMAIN assigned to */ void set_TEXTDOMAIN() { int len; TEXTDOMAIN = force_string(TEXTDOMAIN_node->var_value)->stptr; len = TEXTDOMAIN_node->var_value->stlen; TEXTDOMAIN[len] = '\0'; /* * Note: don't call textdomain(); this value is for * the awk program, not for gawk itself. */ } /* * assign_val --- do mechanics of assignment, for calling from multiple * places. */ NODE * assign_val(NODE **lhs_p, NODE *rhs) { if (rhs != *lhs_p) { /* * Since we know that the nodes are different, * we can do the unref() before the dupnode(). */ unref(*lhs_p); *lhs_p = dupnode(rhs); } return *lhs_p; } /* update_ERRNO_saved --- update the value of ERRNO based on argument */ void update_ERRNO_saved(int errcode) { char *cp; cp = strerror(errcode); cp = gettext(cp); unref(ERRNO_node->var_value); ERRNO_node->var_value = make_string(cp, strlen(cp)); } /* update_ERRNO --- update the value of ERRNO based on errno */ void update_ERRNO() { update_ERRNO_saved(errno); } /* comp_func --- array index comparison function for qsort */ static int comp_func(const void *p1, const void *p2) { size_t len1, len2; const char *str1, *str2; const NODE *t1, *t2; int cmp1; t1 = *((const NODE *const *) p1); t2 = *((const NODE *const *) p2); /* t1 = force_string(t1); t2 = force_string(t2); */ len1 = t1->ahname_len; str1 = t1->ahname_str; len2 = t2->ahname_len; str2 = t2->ahname_str; /* Array indexes are strings, compare as such, always! */ cmp1 = memcmp(str1, str2, len1 < len2 ? len1 : len2); /* if prefixes are equal, size matters */ return (cmp1 != 0 ? cmp1 : len1 < len2 ? -1 : (len1 > len2)); }