freebsd-skq/contrib/awk/eval.c

/*
 * 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);
}