/*
* eval.c - gawk parse tree interpreter
*/
/*
* Copyright (C) 1986, 1988, 1989, 1991-2001 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
*
* $FreeBSD$
*/
#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 int eval_condition P((NODE *tree));
static NODE *op_assign P((NODE *tree));
static NODE *func_call P((NODE *name, NODE *arg_list));
static NODE *match_op P((NODE *tree));
static void push_args P((int count, NODE *arglist, NODE **oldstack,
char *func_name, char **varnames));
static void pop_fcall_stack P((void));
static void pop_fcall P((void));
static int in_function P((void));
char *nodetype2str P((NODETYPE type));
char *flags2str P((int flagval));
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), (char *)(x), sizeof(jmp_buf)), val++)
#define RESTORE_BINDING(stack, x, val) (memcpy((char *)(x), (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.
*/
#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
/*
* This table maps node types to strings for debugging.
* KEEP IN SYNC WITH awk.h!!!!
*/
static char *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_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_if_branches",
"Node_expression_list",
"Node_param_list",
"Node_K_if",
"Node_K_while",
"Node_K_for",
"Node_K_arrayfor",
"Node_K_break",
"Node_K_continue",
"Node_K_print",
"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",
"Node_var_array",
"Node_val",
"Node_builtin",
"Node_line_range",
"Node_in_array",
"Node_func",
"Node_func_call",
"Node_cond_exp",
"Node_regex",
"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_TEXTDOMAIN",
"Node_final --- this should never appear",
NULL
};
/* nodetype2str --- convert a node type into a printable value */
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 */
char *
flags2str(int flagval)
{
static struct flagtab values[] = {
{ MALLOC, "MALLOC" },
{ TEMP, "TEMP" },
{ PERM, "PERM" },
{ STRING, "STRING" },
{ STR, "STR" },
{ NUM, "NUM" },
{ NUMBER, "NUMBER" },
{ MAYBE_NUM, "MAYBE_NUM" },
{ ARRAYMAXED, "ARRAYMAXED" },
{ SCALAR, "SCALAR" },
{ FUNC, "FUNC" },
{ FIELD, "FIELD" },
{ INTLSTR, "INTLSTR" },
{ UNINITIALIZED, "UNINITIALIZED" },
{ 0, NULL },
};
return genflags2str(flagval, values);
}
/* genflags2str --- general routine to convert a flag value to a string */
char *
genflags2str(int flagval, 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++) {
/*
* 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 ((flagval & tab[i].val) != 0) {
if (sp != buffer) {
*sp++ = '|';
space_left--;
}
strcpy(sp, tab[i].name);
/* note ordering! */
space_left -= strlen(sp);
sp += strlen(sp);
}
}
return buffer;
}
/*
* 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 */
return 1;
case TAG_BREAK:
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_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 = 0;
NODE *volatile array;
volatile size_t i;
size_t j, num_elems;
volatile int retval = 0;
static int first = TRUE;
static int sort_indices = FALSE;
#define hakvar forloop->init
#define arrvar forloop->incr
/* get the array */
array = tree->arrvar;
if (array->type == Node_param_list)
array = stack_ptr[array->param_cnt];
if (array->type == Node_array_ref)
array = array->orig_array;
if ((array->flags & SCALAR) != 0)
fatal(_("attempt to use scalar `%s' as array"), array->vname);
/* sanity: do nothing if empty */
if (array->type == Node_var || 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->ahname);
}
}
if (first) {
first = FALSE;
sort_indices = (getenv("WHINY_USERS") != 0);
}
if (sort_indices)
qsort(list, num_elems, sizeof(NODE *), comp_func); /* shazzam! */
/* now we can run the loop */
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 = dupnode(list[i]);
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);
if (do_lint && num_elems != array->table_size)
lintwarn(_("for loop: array `%s' changed size from %d to %d during loop execution"),
array->vname, num_elems, array->table_size);
for (i = 0; i < num_elems; i++)
unref(list[i]);
free(list);
if (retval == 1)
return 1;
break;
}
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"));
if (in_function())
pop_fcall_stack();
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"));
if (in_function())
pop_fcall_stack();
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_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:
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 */
if (in_function())
pop_fcall_stack();
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 */
if (in_function())
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);
ret_node = dupnode(t);
free_temp(t);
longjmp(func_tag, TAG_RETURN);
break;
default:
/*
* Appears to be an expression statement. Throw away the
* value.
*/
if (do_lint && tree->type == Node_var)
lintwarn(_("statement has no effect"));
INCREMENT(tree->exec_count);
t = tree_eval(tree);
free_temp(t);
break;
}
return 1;
}
/* 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;
long lx;
#ifdef _CRAY
long lx2;
#endif
#ifdef GAWKDEBUG
if (tree == NULL)
return Nnull_string;
else if (tree->type == Node_val) {
if (tree->stref <= 0)
cant_happen();
return tree;
} else if (tree->type == Node_var) {
if (tree->var_value->stref <= 0)
cant_happen();
if ((tree->flags & UNINITIALIZED) != 0)
warning(_("reference to uninitialized variable `%s'"),
tree->vname);
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 && (tree->flags & UNINITIALIZED) != 0)
lintwarn(_("reference to uninitialized argument `%s'"),
tree->vname);
}
if (tree->type == Node_array_ref)
tree = tree->orig_array;
switch (tree->type) {
case Node_var:
if (do_lint && (tree->flags & UNINITIALIZED) != 0)
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->proc)(tree->subnode);
case Node_K_getline:
return (do_getline(tree));
case Node_in_array:
return tmp_number((AWKNUM) in_array(tree->lnode, tree->rnode));
case Node_func_call:
return func_call(tree->rnode, tree->lnode);
/* 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_TEXTDOMAIN:
lhs = get_lhs(tree, (Func_ptr *) NULL, TRUE);
return *lhs;
case Node_var_array:
fatal(_("attempt to use array `%s' in a scalar context"),
tree->vname);
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:
return match_op(tree);
case Node_func:
fatal(_("function `%s' called with space between name and `(',\n%s"),
tree->lnode->param,
_("or used in other expression context"));
/* assignments */
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);
free_temp(r);
tree->lnode->flags |= SCALAR;
if (after_assign)
(*after_assign)();
return *lhs;
}
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;
/* 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 */
t1 = tree_eval(tree->lnode);
t2 = 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);
free_temp(t1);
free_temp(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);
free_temp(t1);
x2 = force_number(t2);
free_temp(t2);
switch (tree->type) {
case Node_exp:
if ((lx = x2) == x2 && lx >= 0) { /* integer exponent */
if (lx == 0)
x = 1;
else if (lx == 1)
x = x1;
else {
/* doing it this way should be more precise */
for (x = x1; --lx; )
x *= x1;
}
} else
x = pow((double) x1, (double) x2);
return tmp_number(x);
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);
case Node_var_array:
fatal(_("attempt to use array `%s' in a scalar context"),
tree->vname);
default:
fatal(_("illegal type (%s) in tree_eval"), nodetype2str(tree->type));
}
return 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) {
register unsigned char *cp1 = (unsigned char *) t1->stptr;
register unsigned char *cp2 = (unsigned char *) t2->stptr;
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;
AWKNUM t1, t2;
long ltemp;
NODE *tmp;
Func_ptr after_assign = NULL;
/*
* For ++ and --, get the lhs when doing the op and then
* return. For += etc, do the rhs first, since it can
* rearrange things, and *then* get the lhs.
*/
switch(tree->type) {
case Node_preincrement:
case Node_predecrement:
lhs = get_lhs(tree->lnode, &after_assign, TRUE);
lval = force_number(*lhs);
unref(*lhs);
*lhs = make_number(lval +
(tree->type == Node_preincrement ? 1.0 : -1.0));
tree->lnode->flags |= SCALAR;
if (after_assign)
(*after_assign)();
return *lhs;
case Node_postincrement:
case Node_postdecrement:
lhs = get_lhs(tree->lnode, &after_assign, TRUE);
lval = force_number(*lhs);
unref(*lhs);
*lhs = make_number(lval +
(tree->type == Node_postincrement ? 1.0 : -1.0));
tree->lnode->flags |= SCALAR;
if (after_assign)
(*after_assign)();
return tmp_number(lval);
default:
break; /* handled below */
}
/*
* It's a += kind of thing. Do the rhs, then the lhs.
*/
tmp = tree_eval(tree->rnode);
rval = force_number(tmp);
free_temp(tmp);
lhs = get_lhs(tree->lnode, &after_assign, FALSE);
lval = force_number(*lhs);
unref(*lhs);
switch(tree->type) {
case Node_assign_exp:
if ((ltemp = rval) == rval) { /* integer exponent */
if (ltemp == 0)
*lhs = make_number((AWKNUM) 1);
else if (ltemp == 1)
*lhs = make_number(lval);
else {
/* doing it this way should be more precise */
for (t1 = t2 = lval; --ltemp; )
t1 *= t2;
*lhs = make_number(t1);
}
} else
*lhs = make_number((AWKNUM) pow((double) lval, (double) 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
/* 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 */
(void) modf(lval / rval, &t1);
t2 = lval - rval * t1;
*lhs = make_number(t2);
#endif /* ! HAVE_FMOD */
break;
case Node_assign_plus:
*lhs = make_number(lval + rval);
break;
case Node_assign_minus:
*lhs = make_number(lval - rval);
break;
default:
cant_happen();
}
tree->lnode->flags |= SCALAR;
if (after_assign)
(*after_assign)();
return *lhs;
}
static struct fcall {
char *fname;
unsigned long count;
NODE *arglist;
NODE **prevstack;
NODE **stack;
} *fcall_list = NULL;
static long fcall_list_size = 0;
static long curfcall = -1;
/* in_function --- return true/false if we need to unwind awk functions */
static int
in_function()
{
return (curfcall >= 0);
}
/* pop_fcall --- pop off a single function call */
static void
pop_fcall()
{
NODE *n, **sp, *arg, *argp;
int count;
struct fcall *f;
assert(curfcall >= 0);
f = & fcall_list[curfcall];
stack_ptr = f->prevstack;
/*
* here, we pop each parameter and check whether
* it was an array. If so, and if the arg. passed in was
* a simple variable, then the value should be copied back.
* This achieves "call-by-reference" for arrays.
*/
sp = f->stack;
count = f->count;
for (argp = f->arglist; count > 0 && argp != NULL; argp = argp->rnode) {
arg = argp->lnode;
if (arg->type == Node_param_list)
arg = stack_ptr[arg->param_cnt];
n = *sp++;
if (n->type == Node_var_array || n->type == Node_array_ref) {
NODETYPE old_type; /* for check, below */
old_type = arg->type;
/*
* subtlety: if arg->type is Node_var but n->type
* is Node_var_array, then the array routines noticed
* that a variable name was really an array and
* changed the type. But when v->name was pushed
* on the stack, it came out of the varnames array,
* and was not malloc'ed, so we shouldn't free it.
* See the corresponding code in push_args().
* Thanks to Juergen Kahrs for finding a test case
* that shows this.
*/
if (old_type == Node_var_array || old_type == Node_array_ref)
free(n->vname);
if (arg->type == Node_var) {
/* type changed, copy array back for call by reference */
/* should we free arg->var_value ? */
arg->var_array = n->var_array;
arg->type = Node_var_array;
arg->array_size = n->array_size;
arg->table_size = n->table_size;
arg->flags = n->flags;
}
}
/* n->lnode overlays the array size, don't unref it if array */
if (n->type != Node_var_array && n->type != Node_array_ref)
unref(n->lnode);
freenode(n);
count--;
}
while (count-- > 0) {
n = *sp++;
/* if n is a local array, all the elements should be freed */
if (n->type == Node_var_array)
assoc_clear(n);
/* n->lnode overlays the array size, don't unref it if array */
if (n->type != Node_var_array && n->type != Node_array_ref)
unref(n->lnode);
freenode(n);
}
if (f->stack)
free((char *) f->stack);
memset(f, '\0', sizeof(struct fcall));
curfcall--;
}
/* pop_fcall_stack --- pop off all function args, don't leak memory */
static void
pop_fcall_stack()
{
while (curfcall >= 0)
pop_fcall();
}
/* push_args --- push function arguments onto the stack */
static void
push_args(int count,
NODE *arglist,
NODE **oldstack,
char *func_name,
char **varnames)
{
struct fcall *f;
NODE *arg, *argp, *r, **sp, *n;
int i;
int num_args;
num_args = count; /* save for later use */
if (fcall_list_size == 0) { /* first time */
emalloc(fcall_list, struct fcall *, 10 * sizeof(struct fcall),
"push_args");
fcall_list_size = 10;
}
if (++curfcall >= fcall_list_size) {
fcall_list_size *= 2;
erealloc(fcall_list, struct fcall *,
fcall_list_size * sizeof(struct fcall), "push_args");
}
f = & fcall_list[curfcall];
memset(f, '\0', sizeof(struct fcall));
if (count > 0)
emalloc(f->stack, NODE **, count*sizeof(NODE *), "push_args");
f->count = count;
f->fname = func_name; /* not used, for debugging, just in case */
f->arglist = arglist;
f->prevstack = oldstack;
sp = f->stack;
/* for each calling arg. add NODE * on stack */
for (argp = arglist, i = 0; count > 0 && argp != NULL; argp = argp->rnode) {
static char from[] = N_("%s (from %s)");
arg = argp->lnode;
getnode(r);
r->type = Node_var;
r->flags = 0;
/* call by reference for arrays; see below also */
if (arg->type == Node_param_list) {
/* we must also reassign f here; see below */
f = & fcall_list[curfcall];
arg = f->prevstack[arg->param_cnt];
}
if (arg->type == Node_var_array) {
char *p;
size_t len;
r->type = Node_array_ref;
r->flags &= ~SCALAR;
r->orig_array = arg;
len = strlen(varnames[i]) + strlen(arg->vname)
+ strlen(gettext(from)) - 4 + 1;
emalloc(p, char *, len, "push_args");
sprintf(p, _(from), varnames[i], arg->vname);
r->vname = p;
} else if (arg->type == Node_array_ref) {
char *p;
size_t len;
*r = *arg;
len = strlen(varnames[i]) + strlen(arg->vname)
+ strlen(gettext(from)) - 4 + 1;
emalloc(p, char *, len, "push_args");
sprintf(p, _(from), varnames[i], arg->vname);
r->vname = p;
} else {
n = tree_eval(arg);
r->lnode = dupnode(n);
r->rnode = (NODE *) NULL;
if ((n->flags & SCALAR) != 0)
r->flags |= SCALAR;
r->vname = varnames[i];
free_temp(n);
}
*sp++ = r;
i++;
count--;
}
if (argp != NULL) /* left over calling args. */
warning(
_("function `%s' called with more arguments than declared"),
func_name);
/* add remaining params. on stack with null value */
while (count-- > 0) {
getnode(r);
r->type = Node_var;
r->lnode = Nnull_string;
r->flags &= ~SCALAR;
r->rnode = (NODE *) NULL;
r->vname = varnames[i++];
r->flags = UNINITIALIZED;
r->param_cnt = num_args - count;
*sp++ = r;
}
/*
* We have to reassign f. Why, you may ask? It is possible that
* other functions were called during the course of tree_eval()-ing
* the arguments to this function. As a result of that, fcall_list
* may have been realloc()'ed, with the result that f is now
* pointing into free()'d space. This was a nasty one to track down.
*/
f = & fcall_list[curfcall];
stack_ptr = f->stack;
}
/* func_call --- call a function, call by reference for arrays */
NODE **stack_ptr;
static NODE *
func_call(NODE *name, /* name is a Node_val giving function name */
NODE *arg_list) /* Node_expression_list of calling args. */
{
register NODE *r;
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;
/* retrieve function definition node */
f = lookup(name->stptr);
if (f == NULL || f->type != Node_func)
fatal(_("function `%s' not defined"), name->stptr);
#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);
}
if ((r->flags & PERM) == 0)
r->flags |= TEMP;
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, fcall_list[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];
}
switch (ptr->type) {
case Node_array_ref:
case Node_var_array:
fatal(_("attempt to use array `%s' in a scalar context"),
ptr->vname);
case Node_var:
if (! reference)
ptr->flags &= ~UNINITIALIZED;
else if (do_lint && (ptr->flags & UNINITIALIZED) != 0)
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(HUGE-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_TEXTDOMAIN:
aptr = &(TEXTDOMAIN_node->var_value);
if (assign != NULL)
*assign = set_TEXTDOMAIN;
break;
case Node_param_list:
{
NODE *n = stack_ptr[ptr->param_cnt];
/*
* This test should always be true, due to the code
* above, before the switch, that handles parameters.
*/
if (n->type != Node_var_array)
aptr = &n->var_value;
else
fatal(_("attempt to use array `%s' in a scalar context"),
n->vname);
if (! reference)
n->flags &= ~UNINITIALIZED;
else if (do_lint && (n->flags & UNINITIALIZED) != 0)
lintwarn(_("reference to uninitialized argument `%s'"),
n->vname);
}
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;
break;
}
aptr = get_field(field_num, assign);
break;
}
case Node_subscript:
n = ptr->lnode;
if (n->type == Node_param_list) {
n = stack_ptr[n->param_cnt];
if ((n->flags & SCALAR) != 0)
fatal(_("attempt to use scalar parameter `%s' as an array"), n->vname);
}
if (n->type == Node_array_ref) {
n = n->orig_array;
assert(n->type == Node_var_array || n->type == Node_var);
}
if (n->type == Node_func) {
fatal(_("attempt to use function `%s' as array"),
n->lnode->param);
}
aptr = assoc_lookup(n, concat_exp(ptr->rnode), reference);
break;
case Node_func:
fatal(_("`%s' is a function, assignment is not allowed"),
ptr->lnode->param);
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->proc == NULL)
fatal(_("assignment is not allowed to result of builtin function"));
ptr->callresult = (*ptr->proc)(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 = FALSE; /* 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
* FALSE, we need to use the avoid_dfa test. This is the only place
* at the moment.
*
* 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 = TRUE;
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"));
}
if (do_traditional)
IGNORECASE = FALSE;
else if ((IGNORECASE_node->var_value->flags & (STRING|STR)) != 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 & (NUM|NUMBER)) != 0)
IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
else
IGNORECASE = FALSE; /* shouldn't happen */
set_FS_if_not_FIELDWIDTHS();
}
/* 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: arbitary 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);
char *p = tmp->stptr;
if (*p++ != '%')
return 0;
while (*p && strchr(" +-#", *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("efgEG", *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;
emalloc(fmt_list, NODE **, fmt_num, "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()
{
int old_lint = do_lint;
if ((LINT_node->var_value->flags & (STRING|STR)) != 0) {
if ((LINT_node->var_value->flags & MAYBE_NUM) == 0) {
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) {
if (lintlen == 5 && strncmp(lintval, "fatal", 5) == 0)
lintfunc = r_fatal;
else
lintfunc = warning;
} else
lintfunc = warning;
} else
do_lint = (force_number(LINT_node->var_value) != 0.0);
} else if ((LINT_node->var_value->flags & (NUM|NUMBER)) != 0) {
do_lint = (force_number(LINT_node->var_value) != 0.0);
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)
warning(_("turning off `--lint' due to assignment to `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)
{
NODE *save;
if (rhs != *lhs_p) {
save = *lhs_p;
*lhs_p = dupnode(rhs);
unref(save);
}
return *lhs_p;
}
/* update_ERRNO --- update the value of ERRNO */
void
update_ERRNO()
{
char *cp;
cp = strerror(errno);
cp = gettext(cp);
unref(ERRNO_node->var_value);
ERRNO_node->var_value = make_string(cp, strlen(cp));
}
/* comp_func --- array index comparison function for qsort */
static int
comp_func(const void *p1, const void *p2)
{
size_t len1, len2;
char *str1, *str2;
NODE *t1, *t2;
t1 = *((NODE **) p1);
t2 = *((NODE **) p2);
/*
t1 = force_string(t1);
t2 = force_string(t2);
*/
len1 = t1->stlen;
str1 = t1->stptr;
len2 = t2->stlen;
str2 = t2->stptr;
/* Array indexes are strings, compare as such, always! */
if (len1 == len2 || len1 < len2)
return strncmp(str1, str2, len1);
else
return strncmp(str1, str2, len2);
}