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