source: vendor/gawk/3.1.5/eval.c

Last change on this file was 3076, checked in by bird, 18 years ago

gawk 3.1.5
File size: 60.7 KB
RevLine 
[3076]1/*
2 * eval.c - gawk parse tree interpreter
3 */
4
5/*
6 * Copyright (C) 1986, 1988, 1989, 1991-2005 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
24 */
25
26#include "awk.h"
27
28extern double pow P((double x, double y));
29extern double modf P((double x, double *yp));
30extern double fmod P((double x, double y));
31
32static inline void make_scalar P((NODE *tree));
33static int eval_condition P((NODE *tree));
34static NODE *op_assign P((NODE *tree));
35static NODE *func_call P((NODE *tree));
36static NODE *match_op P((NODE *tree));
37static void pop_forloop P((void));
38static inline void pop_all_forloops P((void));
39static void push_forloop P((const char *varname, NODE **elems, size_t nelems));
40static void push_args P((int count, NODE *arglist, NODE **oldstack,
41 const char *func_name, char **varnames));
42static inline void pop_fcall_stack P((void));
43static void pop_fcall P((void));
44static int comp_func P((const void *p1, const void *p2));
45
46#if __GNUC__ < 2
47NODE *_t; /* used as a temporary in macros */
48#endif
49#ifdef MSDOS
50double _msc51bug; /* to get around a bug in MSC 5.1 */
51#endif
52NODE *ret_node;
53int OFSlen;
54int ORSlen;
55int OFMTidx;
56int CONVFMTidx;
57
58/* Profiling stuff */
59#ifdef PROFILING
60#define INCREMENT(n) n++
61#else
62#define INCREMENT(n) /* nothing */
63#endif
64
65/* Macros and variables to save and restore function and loop bindings */
66/*
67 * the val variable allows return/continue/break-out-of-context to be
68 * caught and diagnosed
69 */
70#define PUSH_BINDING(stack, x, val) (memcpy((char *)(stack), (const char *)(x), sizeof(jmp_buf)), val++)
71#define RESTORE_BINDING(stack, x, val) (memcpy((char *)(x), (const char *)(stack), sizeof(jmp_buf)), val--)
72
73static jmp_buf loop_tag; /* always the current binding */
74static int loop_tag_valid = FALSE; /* nonzero when loop_tag valid */
75static int func_tag_valid = FALSE;
76static jmp_buf func_tag;
77extern int exiting, exit_val;
78
79/* This rather ugly macro is for VMS C */
80#ifdef C
81#undef C
82#endif
83#define C(c) ((char)c)
84/*
85 * This table is used by the regexp routines to do case independant
86 * matching. Basically, every ascii character maps to itself, except
87 * uppercase letters map to lower case ones. This table has 256
88 * entries, for ISO 8859-1. Note also that if the system this
89 * is compiled on doesn't use 7-bit ascii, casetable[] should not be
90 * defined to the linker, so gawk should not load.
91 *
92 * Do NOT make this array static, it is used in several spots, not
93 * just in this file.
94 *
95 * 6/2004:
96 * This table is also used for IGNORECASE for == and !=, and index().
97 * Although with GLIBC, we could use tolower() everywhere and RE_ICASE
98 * for the regex matcher, precomputing this table once gives us a
99 * performance improvement. I also think it's better for portability
100 * to non-GLIBC systems. All the world is not (yet :-) GNU/Linux.
101 */
102#if 'a' == 97 /* it's ascii */
103char casetable[] = {
104 '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
105 '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
106 '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
107 '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
108 /* ' ' '!' '"' '#' '$' '%' '&' ''' */
109 '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
110 /* '(' ')' '*' '+' ',' '-' '.' '/' */
111 '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
112 /* '0' '1' '2' '3' '4' '5' '6' '7' */
113 '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
114 /* '8' '9' ':' ';' '<' '=' '>' '?' */
115 '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
116 /* '@' 'A' 'B' 'C' 'D' 'E' 'F' 'G' */
117 '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
118 /* 'H' 'I' 'J' 'K' 'L' 'M' 'N' 'O' */
119 '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
120 /* 'P' 'Q' 'R' 'S' 'T' 'U' 'V' 'W' */
121 '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
122 /* 'X' 'Y' 'Z' '[' '\' ']' '^' '_' */
123 '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
124 /* '`' 'a' 'b' 'c' 'd' 'e' 'f' 'g' */
125 '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
126 /* 'h' 'i' 'j' 'k' 'l' 'm' 'n' 'o' */
127 '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
128 /* 'p' 'q' 'r' 's' 't' 'u' 'v' 'w' */
129 '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
130 /* 'x' 'y' 'z' '{' '|' '}' '~' */
131 '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
132
133 /* Latin 1: */
134 C('\200'), C('\201'), C('\202'), C('\203'), C('\204'), C('\205'), C('\206'), C('\207'),
135 C('\210'), C('\211'), C('\212'), C('\213'), C('\214'), C('\215'), C('\216'), C('\217'),
136 C('\220'), C('\221'), C('\222'), C('\223'), C('\224'), C('\225'), C('\226'), C('\227'),
137 C('\230'), C('\231'), C('\232'), C('\233'), C('\234'), C('\235'), C('\236'), C('\237'),
138 C('\240'), C('\241'), C('\242'), C('\243'), C('\244'), C('\245'), C('\246'), C('\247'),
139 C('\250'), C('\251'), C('\252'), C('\253'), C('\254'), C('\255'), C('\256'), C('\257'),
140 C('\260'), C('\261'), C('\262'), C('\263'), C('\264'), C('\265'), C('\266'), C('\267'),
141 C('\270'), C('\271'), C('\272'), C('\273'), C('\274'), C('\275'), C('\276'), C('\277'),
142 C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
143 C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
144 C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\327'),
145 C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\337'),
146 C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
147 C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
148 C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\367'),
149 C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\377'),
150};
151#else
152#include "You lose. You will need a translation table for your character set."
153#endif
154
155#undef C
156
157/* load_casetable --- for a non-ASCII locale, redo the table */
158
159void
160load_casetable(void)
161{
162#if defined(LC_CTYPE)
163 int i;
164 char *cp;
165 static int loaded = FALSE;
166
167 if (loaded || do_traditional)
168 return;
169
170 loaded = TRUE;
171 cp = setlocale(LC_CTYPE, NULL);
172
173 /* this is not per standard, but it's pretty safe */
174 if (cp == NULL || strcmp(cp, "C") == 0 || strcmp(cp, "POSIX") == 0)
175 return;
176
177 for (i = 0200; i <= 0377; i++) {
178 if (isalpha(i) && islower(i) && i != toupper(i))
179 casetable[i] = toupper(i);
180 }
181#endif
182}
183
184/*
185 * This table maps node types to strings for debugging.
186 * KEEP IN SYNC WITH awk.h!!!!
187 */
188static const char *const nodetypes[] = {
189 "Node_illegal",
190 "Node_times",
191 "Node_quotient",
192 "Node_mod",
193 "Node_plus",
194 "Node_minus",
195 "Node_cond_pair",
196 "Node_subscript",
197 "Node_concat",
198 "Node_exp",
199 "Node_preincrement",
200 "Node_predecrement",
201 "Node_postincrement",
202 "Node_postdecrement",
203 "Node_unary_minus",
204 "Node_field_spec",
205 "Node_assign",
206 "Node_assign_times",
207 "Node_assign_quotient",
208 "Node_assign_mod",
209 "Node_assign_plus",
210 "Node_assign_minus",
211 "Node_assign_exp",
212 "Node_assign_concat",
213 "Node_and",
214 "Node_or",
215 "Node_equal",
216 "Node_notequal",
217 "Node_less",
218 "Node_greater",
219 "Node_leq",
220 "Node_geq",
221 "Node_match",
222 "Node_nomatch",
223 "Node_not",
224 "Node_rule_list",
225 "Node_rule_node",
226 "Node_statement_list",
227 "Node_switch_body",
228 "Node_case_list",
229 "Node_if_branches",
230 "Node_expression_list",
231 "Node_param_list",
232 "Node_K_if",
233 "Node_K_switch",
234 "Node_K_case",
235 "Node_K_default",
236 "Node_K_while",
237 "Node_K_for",
238 "Node_K_arrayfor",
239 "Node_K_break",
240 "Node_K_continue",
241 "Node_K_print",
242 "Node_K_print_rec",
243 "Node_K_printf",
244 "Node_K_next",
245 "Node_K_exit",
246 "Node_K_do",
247 "Node_K_return",
248 "Node_K_delete",
249 "Node_K_delete_loop",
250 "Node_K_getline",
251 "Node_K_function",
252 "Node_K_nextfile",
253 "Node_redirect_output",
254 "Node_redirect_append",
255 "Node_redirect_pipe",
256 "Node_redirect_pipein",
257 "Node_redirect_input",
258 "Node_redirect_twoway",
259 "Node_var_new",
260 "Node_var",
261 "Node_var_array",
262 "Node_val",
263 "Node_builtin",
264 "Node_line_range",
265 "Node_in_array",
266 "Node_func",
267 "Node_func_call",
268 "Node_cond_exp",
269 "Node_regex",
270 "Node_dynregex",
271 "Node_hashnode",
272 "Node_ahash",
273 "Node_array_ref",
274 "Node_BINMODE",
275 "Node_CONVFMT",
276 "Node_FIELDWIDTHS",
277 "Node_FNR",
278 "Node_FS",
279 "Node_IGNORECASE",
280 "Node_LINT",
281 "Node_NF",
282 "Node_NR",
283 "Node_OFMT",
284 "Node_OFS",
285 "Node_ORS",
286 "Node_RS",
287 "Node_SUBSEP",
288 "Node_TEXTDOMAIN",
289 "Node_final --- this should never appear",
290 NULL
291};
292
293/* nodetype2str --- convert a node type into a printable value */
294
295const char *
296nodetype2str(NODETYPE type)
297{
298 static char buf[40];
299
300 if (type >= Node_illegal && type <= Node_final)
301 return nodetypes[(int) type];
302
303 sprintf(buf, _("unknown nodetype %d"), (int) type);
304 return buf;
305}
306
307/* flags2str --- make a flags value readable */
308
309const char *
310flags2str(int flagval)
311{
312 static const struct flagtab values[] = {
313 { MALLOC, "MALLOC" },
314 { TEMP, "TEMP" },
315 { PERM, "PERM" },
316 { STRING, "STRING" },
317 { STRCUR, "STRCUR" },
318 { NUMCUR, "NUMCUR" },
319 { NUMBER, "NUMBER" },
320 { MAYBE_NUM, "MAYBE_NUM" },
321 { ARRAYMAXED, "ARRAYMAXED" },
322 { FUNC, "FUNC" },
323 { FIELD, "FIELD" },
324 { INTLSTR, "INTLSTR" },
325#ifdef WSTRCUR
326 { WSTRCUR, "WSTRCUR" },
327#endif
328 { 0, NULL },
329 };
330
331 return genflags2str(flagval, values);
332}
333
334/* genflags2str --- general routine to convert a flag value to a string */
335
336const char *
337genflags2str(int flagval, const struct flagtab *tab)
338{
339 static char buffer[BUFSIZ];
340 char *sp;
341 int i, space_left, space_needed;
342
343 sp = buffer;
344 space_left = BUFSIZ;
345 for (i = 0; tab[i].name != NULL; i++) {
346 if ((flagval & tab[i].val) != 0) {
347 /*
348 * note the trick, we want 1 or 0 for whether we need
349 * the '|' character.
350 */
351 space_needed = (strlen(tab[i].name) + (sp != buffer));
352 if (space_left < space_needed)
353 fatal(_("buffer overflow in genflags2str"));
354
355 if (sp != buffer) {
356 *sp++ = '|';
357 space_left--;
358 }
359 strcpy(sp, tab[i].name);
360 /* note ordering! */
361 space_left -= strlen(sp);
362 sp += strlen(sp);
363 }
364 }
365
366 return buffer;
367}
368
369/*
370 * make_scalar --- make sure that tree is a scalar.
371 *
372 * tree is in a scalar context. If it is a variable, accomplish
373 * what's needed; otherwise, do nothing.
374 *
375 * Notice that nodes of type Node_var_new have undefined value in var_value
376 * (a.k.a. lnode)---even though awkgram.y:variable() initializes it,
377 * push_args() doesn't. Thus we have to initialize it.
378 */
379
380static inline void
381make_scalar(NODE *tree)
382{
383 switch (tree->type) {
384 case Node_var_array:
385 fatal(_("attempt to use array `%s' in a scalar context"),
386 array_vname(tree));
387
388 case Node_array_ref:
389 switch (tree->orig_array->type) {
390 case Node_var_array:
391 fatal(_("attempt to use array `%s' in a scalar context"),
392 array_vname(tree));
393 case Node_var_new:
394 tree->orig_array->type = Node_var;
395 tree->orig_array->var_value = Nnull_string;
396 break;
397 case Node_var:
398 break;
399 default:
400 cant_happen();
401 }
402 /* fall through */
403 case Node_var_new:
404 tree->type = Node_var;
405 tree->var_value = Nnull_string;
406 default:
407 /* shut up GCC */
408 break;
409 }
410}
411
412/*
413 * interpret:
414 * Tree is a bunch of rules to run. Returns zero if it hit an exit()
415 * statement
416 */
417int
418interpret(register NODE *volatile tree)
419{
420 jmp_buf volatile loop_tag_stack; /* shallow binding stack for loop_tag */
421 static jmp_buf rule_tag; /* tag the rule currently being run, for NEXT
422 * and EXIT statements. It is static because
423 * there are no nested rules */
424 register NODE *volatile t = NULL; /* temporary */
425 NODE **volatile lhs; /* lhs == Left Hand Side for assigns, etc */
426 NODE *volatile stable_tree;
427 int volatile traverse = TRUE; /* True => loop thru tree (Node_rule_list) */
428
429 /* avoid false source indications */
430 source = NULL;
431 sourceline = 0;
432
433 if (tree == NULL)
434 return 1;
435 sourceline = tree->source_line;
436 source = tree->source_file;
437 switch (tree->type) {
438 case Node_rule_node:
439 traverse = FALSE; /* False => one for-loop iteration only */
440 /* FALL THROUGH */
441 case Node_rule_list:
442 for (t = tree; t != NULL; t = t->rnode) {
443 if (traverse)
444 tree = t->lnode;
445 sourceline = tree->source_line;
446 source = tree->source_file;
447 INCREMENT(tree->exec_count);
448 switch (setjmp(rule_tag)) {
449 case 0: /* normal non-jump */
450 /* test pattern, if any */
451 if (tree->lnode == NULL ||
452 eval_condition(tree->lnode)) {
453 /* using the lnode exec_count is kludgey */
454 if (tree->lnode != NULL)
455 INCREMENT(tree->lnode->exec_count);
456 (void) interpret(tree->rnode);
457 }
458 break;
459 case TAG_CONTINUE: /* NEXT statement */
460 pop_all_forloops();
461 pop_fcall_stack();
462 return 1;
463 case TAG_BREAK: /* EXIT statement */
464 pop_all_forloops();
465 pop_fcall_stack();
466 return 0;
467 default:
468 cant_happen();
469 }
470 if (! traverse) /* case Node_rule_node */
471 break; /* don't loop */
472 }
473 break;
474
475 case Node_statement_list:
476 for (t = tree; t != NULL; t = t->rnode)
477 (void) interpret(t->lnode);
478 break;
479
480 case Node_K_if:
481 INCREMENT(tree->exec_count);
482 if (eval_condition(tree->lnode)) {
483 INCREMENT(tree->rnode->exec_count);
484 (void) interpret(tree->rnode->lnode);
485 } else {
486 (void) interpret(tree->rnode->rnode);
487 }
488 break;
489
490 case Node_K_switch:
491 {
492 NODE *switch_value;
493 NODE *switch_body;
494 NODE *case_list;
495 NODE *default_list;
496 NODE *case_stmt;
497
498 int match_found = FALSE;
499
500 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
501 INCREMENT(tree->exec_count);
502 stable_tree = tree;
503
504 switch_value = tree_eval(stable_tree->lnode);
505 switch_body = stable_tree->rnode;
506 case_list = switch_body->lnode;
507 default_list = switch_body->rnode;
508
509 for (; case_list != NULL; case_list = case_list->rnode) {
510 case_stmt = case_list->lnode;
511
512 /*
513 * Once a match is found, all cases will be processed as they fall through,
514 * so continue to execute statements until a break is reached.
515 */
516 if (! match_found) {
517 if (case_stmt->type == Node_K_default)
518 ; /* do nothing */
519 else if (case_stmt->lnode->type == Node_regex) {
520 NODE *t1;
521 Regexp *rp;
522 /* see comments in match_op() code about this. */
523 int kludge_need_start = 0;
524
525 t1 = force_string(switch_value);
526 rp = re_update(case_stmt->lnode);
527
528 if (avoid_dfa(tree, t1->stptr, t1->stlen))
529 kludge_need_start = RE_NEED_START;
530 match_found = (research(rp, t1->stptr, 0, t1->stlen, kludge_need_start) >= 0);
531 if (t1 != switch_value)
532 free_temp(t1);
533 } else
534 match_found = (cmp_nodes(switch_value, case_stmt->lnode) == 0);
535 }
536
537 /* If a match was found, execute the statements associated with the case. */
538 if (match_found) {
539 INCREMENT(case_stmt->exec_count);
540 switch (setjmp(loop_tag)) {
541 case 0: /* Normal non-jump */
542 (void) interpret(case_stmt->rnode);
543 break;
544 case TAG_CONTINUE: /* continue statement */
545 free_temp(switch_value);
546 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
547 longjmp(loop_tag, TAG_CONTINUE);
548 break;
549 case TAG_BREAK: /* break statement */
550 free_temp(switch_value);
551 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
552 return 1;
553 default:
554 cant_happen();
555 }
556 }
557
558 }
559
560 free_temp(switch_value);
561
562 /*
563 * If a default section was found, execute the statements associated with it
564 * and execute any trailing case statements if the default falls through.
565 */
566 if (! match_found && default_list != NULL) {
567 for (case_list = default_list;
568 case_list != NULL; case_list = case_list->rnode) {
569 case_stmt = case_list->lnode;
570
571 INCREMENT(case_stmt->exec_count);
572 switch (setjmp(loop_tag)) {
573 case 0: /* Normal non-jump */
574 (void) interpret(case_stmt->rnode);
575 break;
576 case TAG_CONTINUE: /* continue statement */
577 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
578 longjmp(loop_tag, TAG_CONTINUE);
579 break;
580 case TAG_BREAK: /* break statement */
581 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
582 return 1;
583 default:
584 cant_happen();
585 }
586 }
587 }
588
589 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
590 }
591 break;
592
593 case Node_K_while:
594 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
595
596 stable_tree = tree;
597 while (eval_condition(stable_tree->lnode)) {
598 INCREMENT(stable_tree->exec_count);
599 switch (setjmp(loop_tag)) {
600 case 0: /* normal non-jump */
601 (void) interpret(stable_tree->rnode);
602 break;
603 case TAG_CONTINUE: /* continue statement */
604 break;
605 case TAG_BREAK: /* break statement */
606 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
607 return 1;
608 default:
609 cant_happen();
610 }
611 }
612 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
613 break;
614
615 case Node_K_do:
616 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
617 stable_tree = tree;
618 do {
619 INCREMENT(stable_tree->exec_count);
620 switch (setjmp(loop_tag)) {
621 case 0: /* normal non-jump */
622 (void) interpret(stable_tree->rnode);
623 break;
624 case TAG_CONTINUE: /* continue statement */
625 break;
626 case TAG_BREAK: /* break statement */
627 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
628 return 1;
629 default:
630 cant_happen();
631 }
632 } while (eval_condition(stable_tree->lnode));
633 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
634 break;
635
636 case Node_K_for:
637 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
638 (void) interpret(tree->forloop->init);
639 stable_tree = tree;
640 while (eval_condition(stable_tree->forloop->cond)) {
641 INCREMENT(stable_tree->exec_count);
642 switch (setjmp(loop_tag)) {
643 case 0: /* normal non-jump */
644 (void) interpret(stable_tree->lnode);
645 /* fall through */
646 case TAG_CONTINUE: /* continue statement */
647 (void) interpret(stable_tree->forloop->incr);
648 break;
649 case TAG_BREAK: /* break statement */
650 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
651 return 1;
652 default:
653 cant_happen();
654 }
655 }
656 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
657 break;
658
659 case Node_K_arrayfor:
660 {
661 Func_ptr after_assign = NULL;
662 NODE **list = NULL;
663 NODE *volatile array;
664 NODE *volatile save_array;
665 volatile size_t i, num_elems;
666 size_t j;
667 volatile int retval = 0;
668 int sort_indices = whiny_users;
669
670#define hakvar forloop->init
671#define arrvar forloop->incr
672 /* get the array */
673 save_array = tree->arrvar;
674 array = get_array(save_array);
675
676 /* sanity: do nothing if empty */
677 if (array->var_array == NULL || array->table_size == 0)
678 break; /* from switch */
679
680 /* allocate space for array */
681 num_elems = array->table_size;
682 emalloc(list, NODE **, num_elems * sizeof(NODE *), "for_loop");
683
684 /* populate it */
685 for (i = j = 0; i < array->array_size; i++) {
686 NODE *t = array->var_array[i];
687
688 if (t == NULL)
689 continue;
690
691 for (; t != NULL; t = t->ahnext) {
692 list[j++] = dupnode(t);
693 assert(list[j-1] == t);
694 }
695 }
696
697
698 if (sort_indices)
699 qsort(list, num_elems, sizeof(NODE *), comp_func); /* shazzam! */
700
701 /* now we can run the loop */
702 push_forloop(array->vname, list, num_elems);
703 PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
704
705 lhs = get_lhs(tree->hakvar, &after_assign, FALSE);
706 stable_tree = tree;
707 for (i = 0; i < num_elems; i++) {
708 INCREMENT(stable_tree->exec_count);
709 unref(*((NODE **) lhs));
710 *lhs = make_string(list[i]->ahname_str, list[i]->ahname_len);
711 if (after_assign)
712 (*after_assign)();
713 switch (setjmp(loop_tag)) {
714 case 0:
715 (void) interpret(stable_tree->lnode);
716 case TAG_CONTINUE:
717 break;
718
719 case TAG_BREAK:
720 retval = 1;
721 goto done;
722
723 default:
724 cant_happen();
725 }
726 }
727
728 done:
729 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
730 pop_forloop();
731
732 if (do_lint && num_elems != array->table_size)
733 lintwarn(_("for loop: array `%s' changed size from %ld to %ld during loop execution"),
734 array_vname(save_array), (long) num_elems, (long) array->table_size);
735
736 if (retval == 1)
737 return 1;
738 break;
739 }
740#undef hakvar
741#undef arrvar
742
743 case Node_K_break:
744 INCREMENT(tree->exec_count);
745 if (! loop_tag_valid) {
746 /*
747 * Old AT&T nawk treats break outside of loops like
748 * next. New ones catch it at parse time. Allow it if
749 * do_traditional is on, and complain if lint.
750 */
751 static int warned = FALSE;
752
753 if (do_lint && ! warned) {
754 lintwarn(_("`break' outside a loop is not portable"));
755 warned = TRUE;
756 }
757 if (! do_traditional || do_posix)
758 fatal(_("`break' outside a loop is not allowed"));
759 longjmp(rule_tag, TAG_CONTINUE);
760 } else
761 longjmp(loop_tag, TAG_BREAK);
762 break;
763
764 case Node_K_continue:
765 INCREMENT(tree->exec_count);
766 if (! loop_tag_valid) {
767 /*
768 * Old AT&T nawk treats continue outside of loops like
769 * next. New ones catch it at parse time. Allow it if
770 * do_traditional is on, and complain if lint.
771 */
772 static int warned = FALSE;
773
774 if (do_lint && ! warned) {
775 lintwarn(_("`continue' outside a loop is not portable"));
776 warned = TRUE;
777 }
778 if (! do_traditional || do_posix)
779 fatal(_("`continue' outside a loop is not allowed"));
780 longjmp(rule_tag, TAG_CONTINUE);
781 } else
782 longjmp(loop_tag, TAG_CONTINUE);
783 break;
784
785 case Node_K_print:
786 INCREMENT(tree->exec_count);
787 do_print(tree);
788 break;
789
790 case Node_K_print_rec:
791 INCREMENT(tree->exec_count);
792 do_print_rec(tree);
793 break;
794
795 case Node_K_printf:
796 INCREMENT(tree->exec_count);
797 do_printf(tree);
798 break;
799
800 case Node_K_delete:
801 INCREMENT(tree->exec_count);
802 do_delete(tree->lnode, tree->rnode);
803 break;
804
805 case Node_K_delete_loop:
806 INCREMENT(tree->exec_count);
807 do_delete_loop(tree->lnode, tree->rnode);
808 break;
809
810 case Node_K_next:
811 INCREMENT(tree->exec_count);
812 if (in_begin_rule)
813 fatal(_("`next' cannot be called from a BEGIN rule"));
814 else if (in_end_rule)
815 fatal(_("`next' cannot be called from an END rule"));
816
817 /* could add a lint check here for in a loop or function */
818 longjmp(rule_tag, TAG_CONTINUE);
819 break;
820
821 case Node_K_nextfile:
822 INCREMENT(tree->exec_count);
823 if (in_begin_rule)
824 fatal(_("`nextfile' cannot be called from a BEGIN rule"));
825 else if (in_end_rule)
826 fatal(_("`nextfile' cannot be called from an END rule"));
827
828 /* could add a lint check here for in a loop or function */
829 /*
830 * Have to do this cleanup here, since we don't longjump
831 * back to the main awk rule loop (rule_tag).
832 */
833 pop_all_forloops();
834 pop_fcall_stack();
835
836 do_nextfile();
837 break;
838
839 case Node_K_exit:
840 INCREMENT(tree->exec_count);
841 /*
842 * In A,K,&W, p. 49, it says that an exit statement "...
843 * causes the program to behave as if the end of input had
844 * occurred; no more input is read, and the END actions, if
845 * any are executed." This implies that the rest of the rules
846 * are not done. So we immediately break out of the main loop.
847 */
848 exiting = TRUE;
849 if (tree->lnode != NULL) {
850 t = tree_eval(tree->lnode);
851 exit_val = (int) force_number(t);
852 free_temp(t);
853 }
854 longjmp(rule_tag, TAG_BREAK);
855 break;
856
857 case Node_K_return:
858 INCREMENT(tree->exec_count);
859 t = tree_eval(tree->lnode);
860 if ((t->flags & (PERM|TEMP)) != 0)
861 ret_node = t;
862 else {
863 ret_node = copynode(t); /* don't do a dupnode here */
864 ret_node->flags |= TEMP;
865 }
866 longjmp(func_tag, TAG_RETURN);
867 break;
868
869 default:
870 /*
871 * Appears to be an expression statement. Throw away the
872 * value.
873 */
874 if (do_lint && (tree->type == Node_var || tree->type == Node_var_new))
875 lintwarn(_("statement has no effect"));
876 INCREMENT(tree->exec_count);
877 t = tree_eval(tree);
878 if (t) /* stopme() returns NULL */
879 free_temp(t);
880 break;
881 }
882 return 1;
883}
884
885/*
886 * calc_exp_posint --- calculate x^n for positive integral n,
887 * using exponentiation by squaring without recursion.
888 */
889
890static AWKNUM
891calc_exp_posint(AWKNUM x, long n)
892{
893 AWKNUM mult = 1;
894
895 while (n > 1) {
896 if ((n % 2) == 1)
897 mult *= x;
898 x *= x;
899 n /= 2;
900 }
901 return mult * x;
902}
903
904/* calc_exp --- calculate x1^x2 */
905
906static AWKNUM
907calc_exp(AWKNUM x1, AWKNUM x2)
908{
909 long lx;
910
911 if ((lx = x2) == x2) { /* integer exponent */
912 if (lx == 0)
913 return 1;
914 return (lx > 0) ? calc_exp_posint(x1, lx)
915 : 1.0 / calc_exp_posint(x1, -lx);
916 }
917 return (AWKNUM) pow((double) x1, (double) x2);
918}
919
920/* r_tree_eval --- evaluate a subtree */
921
922NODE *
923r_tree_eval(register NODE *tree, int iscond)
924{
925 register NODE *r, *t1, *t2; /* return value & temporary subtrees */
926 register NODE **lhs;
927 register int di;
928 AWKNUM x, x1, x2;
929#ifdef _CRAY
930 long lx2;
931#endif
932
933#ifndef TREE_EVAL_MACRO
934 if (tree == NULL)
935 cant_happen();
936 if (tree->type == Node_val) {
937 if (tree->stref <= 0)
938 cant_happen();
939 return ((tree->flags & INTLSTR) != 0
940 ? r_force_string(tree)
941 : tree);
942 } else if (tree->type == Node_var) {
943 if (tree->var_value->stref <= 0)
944 cant_happen();
945 if (! var_uninitialized(tree))
946 return tree->var_value;
947 }
948#endif
949
950 if (tree->type == Node_param_list) {
951 if ((tree->flags & FUNC) != 0)
952 fatal(_("can't use function name `%s' as variable or array"),
953 tree->vname);
954
955 tree = stack_ptr[tree->param_cnt];
956
957 if (tree == NULL) {
958 if (do_lint)
959 lintwarn(_("reference to uninitialized argument `%s'"),
960 tree->vname);
961 return Nnull_string;
962 }
963
964 if (do_lint && var_uninitialized(tree))
965 lintwarn(_("reference to uninitialized argument `%s'"),
966 tree->vname);
967 }
968
969 make_scalar(tree);
970
971 switch (tree->type) {
972 case Node_var:
973 if (do_lint && var_uninitialized(tree))
974 lintwarn(_("reference to uninitialized variable `%s'"),
975 tree->vname);
976 return tree->var_value;
977
978 case Node_and:
979 return tmp_number((AWKNUM) (eval_condition(tree->lnode)
980 && eval_condition(tree->rnode)));
981
982 case Node_or:
983 return tmp_number((AWKNUM) (eval_condition(tree->lnode)
984 || eval_condition(tree->rnode)));
985
986 case Node_not:
987 return tmp_number((AWKNUM) ! eval_condition(tree->lnode));
988
989 /* Builtins */
990 case Node_builtin:
991 return (*tree->builtin)(tree->subnode);
992
993 case Node_K_getline:
994 return do_getline(tree);
995
996 case Node_in_array:
997 return tmp_number((AWKNUM) (in_array(tree->lnode, tree->rnode) != NULL));
998
999 case Node_func_call:
1000 return func_call(tree);
1001
1002 /* unary operations */
1003 case Node_NR:
1004 case Node_FNR:
1005 case Node_NF:
1006 case Node_FIELDWIDTHS:
1007 case Node_FS:
1008 case Node_RS:
1009 case Node_field_spec:
1010 case Node_subscript:
1011 case Node_IGNORECASE:
1012 case Node_OFS:
1013 case Node_ORS:
1014 case Node_OFMT:
1015 case Node_CONVFMT:
1016 case Node_BINMODE:
1017 case Node_LINT:
1018 case Node_SUBSEP:
1019 case Node_TEXTDOMAIN:
1020 lhs = get_lhs(tree, (Func_ptr *) NULL, TRUE);
1021 return *lhs;
1022
1023 case Node_unary_minus:
1024 t1 = tree_eval(tree->subnode);
1025 x = -force_number(t1);
1026 free_temp(t1);
1027 return tmp_number(x);
1028
1029 case Node_cond_exp:
1030 if (eval_condition(tree->lnode))
1031 return tree_eval(tree->rnode->lnode);
1032 return tree_eval(tree->rnode->rnode);
1033
1034 case Node_match:
1035 case Node_nomatch:
1036 case Node_regex:
1037 case Node_dynregex:
1038 return match_op(tree);
1039
1040 case Node_concat:
1041 {
1042 NODE **treelist;
1043 NODE **strlist;
1044 NODE *save_tree;
1045 register NODE **treep;
1046 register NODE **strp;
1047 register size_t len;
1048 register size_t supposed_len;
1049 char *str;
1050 register char *dest;
1051 int alloc_count, str_count;
1052 int i;
1053
1054 /*
1055 * This is an efficiency hack for multiple adjacent string
1056 * concatenations, to avoid recursion and string copies.
1057 *
1058 * Node_concat trees grow downward to the left, so
1059 * descend to lowest (first) node, accumulating nodes
1060 * to evaluate to strings as we go.
1061 */
1062
1063 /*
1064 * But first, no arbitrary limits. Count the number of
1065 * nodes and malloc the treelist and strlist arrays.
1066 * There will be alloc_count + 1 items to concatenate. We
1067 * also leave room for an extra pointer at the end to
1068 * use as a sentinel. Thus, start alloc_count at 2.
1069 */
1070 save_tree = tree;
1071 for (alloc_count = 2; tree != NULL && tree->type == Node_concat;
1072 tree = tree->lnode)
1073 alloc_count++;
1074 tree = save_tree;
1075 emalloc(treelist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
1076 emalloc(strlist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
1077
1078 /* Now, here we go. */
1079 treep = treelist;
1080 while (tree != NULL && tree->type == Node_concat) {
1081 *treep++ = tree->rnode;
1082 tree = tree->lnode;
1083 }
1084 *treep = tree;
1085 /*
1086 * Now, evaluate to strings in LIFO order, accumulating
1087 * the string length, so we can do a single malloc at the
1088 * end.
1089 *
1090 * Evaluate the expressions first, then get their
1091 * lengthes, in case one of the expressions has a
1092 * side effect that changes one of the others.
1093 * See test/nasty.awk.
1094 *
1095 * dupnode the results a la do_print, to give us
1096 * more predicable behavior; compare gawk 3.0.6 to
1097 * nawk/mawk on test/nasty.awk.
1098 */
1099 strp = strlist;
1100 supposed_len = len = 0;
1101 while (treep >= treelist) {
1102 NODE *n;
1103
1104 /* Here lies the wumpus's brother. R.I.P. */
1105 n = force_string(tree_eval(*treep--));
1106 *strp = dupnode(n);
1107 free_temp(n);
1108 supposed_len += (*strp)->stlen;
1109 strp++;
1110 }
1111 *strp = NULL;
1112
1113 str_count = strp - strlist;
1114 strp = strlist;
1115 for (i = 0; i < str_count; i++) {
1116 len += (*strp)->stlen;
1117 strp++;
1118 }
1119 if (do_lint && supposed_len != len)
1120 lintwarn(_("concatenation: side effects in one expression have changed the length of another!"));
1121 emalloc(str, char *, len+2, "tree_eval");
1122 str[len] = str[len+1] = '\0'; /* for good measure */
1123 dest = str;
1124 strp = strlist;
1125 while (*strp != NULL) {
1126 memcpy(dest, (*strp)->stptr, (*strp)->stlen);
1127 dest += (*strp)->stlen;
1128 unref(*strp);
1129 strp++;
1130 }
1131 r = make_str_node(str, len, ALREADY_MALLOCED);
1132 r->flags |= TEMP;
1133
1134 free(strlist);
1135 free(treelist);
1136 }
1137 return r;
1138
1139 /* assignments */
1140 case Node_assign_concat:
1141 {
1142 Func_ptr after_assign = NULL;
1143 NODE *l, *r;
1144
1145 /*
1146 * Note that something lovely like this:
1147 *
1148 * BEGIN { a = "a"; a = a (a = "b"); print a }
1149 *
1150 * is not defined. It could print `ab' or `bb'.
1151 * Gawk 3.1.3 prints `ab', so we do that too, simply
1152 * by evaluating the LHS first. Ugh.
1153 *
1154 * Thanks to mary1john@earthlink.net for pointing
1155 * out this issue.
1156 */
1157 lhs = get_lhs(tree->lnode, &after_assign, FALSE);
1158 *lhs = force_string(*lhs);
1159 l = *lhs;
1160 r = force_string(tree_eval(tree->rnode));
1161
1162 /*
1163 * Don't clobber string constants!
1164 *
1165 * Also check stref; see test/strcat1.awk,
1166 * the test for l->stref == 1 can't be an
1167 * assertion.
1168 *
1169 * Thanks again to mary1john@earthlink.net for pointing
1170 * out this issue.
1171 */
1172 if (l != r && (l->flags & PERM) == 0 && l->stref == 1) {
1173 size_t nlen = l->stlen + r->stlen + 2;
1174
1175 erealloc(l->stptr, char *, nlen, "interpret");
1176 memcpy(l->stptr + l->stlen, r->stptr, r->stlen);
1177 l->stlen += r->stlen;
1178 l->stptr[l->stlen] = '\0';
1179 } else {
1180 char *nval;
1181 size_t nlen = l->stlen + r->stlen + 2;
1182
1183 emalloc(nval, char *, nlen, "interpret");
1184 memcpy(nval, l->stptr, l->stlen);
1185 memcpy(nval + l->stlen, r->stptr, r->stlen);
1186 unref(*lhs);
1187 *lhs = make_str_node(nval, l->stlen + r->stlen, ALREADY_MALLOCED);
1188 }
1189 free_temp(r);
1190
1191 if (after_assign)
1192 (*after_assign)();
1193 return *lhs;
1194 }
1195 case Node_assign:
1196 {
1197 Func_ptr after_assign = NULL;
1198
1199 if (do_lint && iscond)
1200 lintwarn(_("assignment used in conditional context"));
1201 r = tree_eval(tree->rnode);
1202 lhs = get_lhs(tree->lnode, &after_assign, FALSE);
1203
1204 assign_val(lhs, r);
1205 if (after_assign)
1206 (*after_assign)();
1207 return *lhs;
1208 }
1209
1210 /* other assignment types are easier because they are numeric */
1211 case Node_preincrement:
1212 case Node_predecrement:
1213 case Node_postincrement:
1214 case Node_postdecrement:
1215 case Node_assign_exp:
1216 case Node_assign_times:
1217 case Node_assign_quotient:
1218 case Node_assign_mod:
1219 case Node_assign_plus:
1220 case Node_assign_minus:
1221 return op_assign(tree);
1222 default:
1223 break; /* handled below */
1224 }
1225
1226 /*
1227 * Evaluate subtrees in order to do binary operation, then keep going.
1228 * Use dupnode to make sure that these values don't disappear out
1229 * from under us during recursive subexpression evaluation.
1230 */
1231 t1 = dupnode(tree_eval(tree->lnode));
1232 t2 = dupnode(tree_eval(tree->rnode));
1233
1234 switch (tree->type) {
1235 case Node_geq:
1236 case Node_leq:
1237 case Node_greater:
1238 case Node_less:
1239 case Node_notequal:
1240 case Node_equal:
1241 di = cmp_nodes(t1, t2);
1242 unref(t1);
1243 unref(t2);
1244 switch (tree->type) {
1245 case Node_equal:
1246 return tmp_number((AWKNUM) (di == 0));
1247 case Node_notequal:
1248 return tmp_number((AWKNUM) (di != 0));
1249 case Node_less:
1250 return tmp_number((AWKNUM) (di < 0));
1251 case Node_greater:
1252 return tmp_number((AWKNUM) (di > 0));
1253 case Node_leq:
1254 return tmp_number((AWKNUM) (di <= 0));
1255 case Node_geq:
1256 return tmp_number((AWKNUM) (di >= 0));
1257 default:
1258 cant_happen();
1259 }
1260 break;
1261 default:
1262 break; /* handled below */
1263 }
1264
1265 x1 = force_number(t1);
1266 x2 = force_number(t2);
1267 unref(t1);
1268 unref(t2);
1269 switch (tree->type) {
1270 case Node_exp:
1271 return tmp_number(calc_exp(x1, x2));
1272
1273 case Node_times:
1274 return tmp_number(x1 * x2);
1275
1276 case Node_quotient:
1277 if (x2 == 0)
1278 fatal(_("division by zero attempted"));
1279#ifdef _CRAY
1280 /* special case for integer division, put in for Cray */
1281 lx2 = x2;
1282 if (lx2 == 0)
1283 return tmp_number(x1 / x2);
1284 lx = (long) x1 / lx2;
1285 if (lx * x2 == x1)
1286 return tmp_number((AWKNUM) lx);
1287 else
1288#endif
1289 return tmp_number(x1 / x2);
1290
1291 case Node_mod:
1292 if (x2 == 0)
1293 fatal(_("division by zero attempted in `%%'"));
1294#ifdef HAVE_FMOD
1295 return tmp_number(fmod(x1, x2));
1296#else /* ! HAVE_FMOD */
1297 (void) modf(x1 / x2, &x);
1298 return tmp_number(x1 - x * x2);
1299#endif /* ! HAVE_FMOD */
1300
1301 case Node_plus:
1302 return tmp_number(x1 + x2);
1303
1304 case Node_minus:
1305 return tmp_number(x1 - x2);
1306
1307 default:
1308 fatal(_("illegal type (%s) in tree_eval"), nodetype2str(tree->type));
1309 }
1310 return (NODE *) 0;
1311}
1312
1313/* eval_condition --- is TREE true or false? Returns 0==false, non-zero==true */
1314
1315static int
1316eval_condition(register NODE *tree)
1317{
1318 register NODE *t1;
1319 register int ret;
1320
1321 if (tree == NULL) /* Null trees are the easiest kinds */
1322 return TRUE;
1323 if (tree->type == Node_line_range) {
1324 /*
1325 * Node_line_range is kind of like Node_match, EXCEPT: the
1326 * lnode field (more properly, the condpair field) is a node
1327 * of a Node_cond_pair; whether we evaluate the lnode of that
1328 * node or the rnode depends on the triggered word. More
1329 * precisely: if we are not yet triggered, we tree_eval the
1330 * lnode; if that returns true, we set the triggered word.
1331 * If we are triggered (not ELSE IF, note), we tree_eval the
1332 * rnode, clear triggered if it succeeds, and perform our
1333 * action (regardless of success or failure). We want to be
1334 * able to begin and end on a single input record, so this
1335 * isn't an ELSE IF, as noted above.
1336 */
1337 if (! tree->triggered) {
1338 if (! eval_condition(tree->condpair->lnode))
1339 return FALSE;
1340 else
1341 tree->triggered = TRUE;
1342 }
1343 /* Else we are triggered */
1344 if (eval_condition(tree->condpair->rnode))
1345 tree->triggered = FALSE;
1346 return TRUE;
1347 }
1348
1349 /*
1350 * Could just be J.random expression. in which case, null and 0 are
1351 * false, anything else is true
1352 */
1353
1354 t1 = m_tree_eval(tree, TRUE);
1355 if (t1->flags & MAYBE_NUM)
1356 (void) force_number(t1);
1357 if (t1->flags & NUMBER)
1358 ret = (t1->numbr != 0.0);
1359 else
1360 ret = (t1->stlen != 0);
1361 free_temp(t1);
1362 return ret;
1363}
1364
1365/* cmp_nodes --- compare two nodes, returning negative, 0, positive */
1366
1367int
1368cmp_nodes(register NODE *t1, register NODE *t2)
1369{
1370 register int ret;
1371 register size_t len1, len2;
1372 register int l;
1373 int ldiff;
1374
1375 if (t1 == t2)
1376 return 0;
1377 if (t1->flags & MAYBE_NUM)
1378 (void) force_number(t1);
1379 if (t2->flags & MAYBE_NUM)
1380 (void) force_number(t2);
1381 if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
1382 if (t1->numbr == t2->numbr)
1383 return 0;
1384 /* don't subtract, in case one or both are infinite */
1385 else if (t1->numbr < t2->numbr)
1386 return -1;
1387 else
1388 return 1;
1389 }
1390 (void) force_string(t1);
1391 (void) force_string(t2);
1392 len1 = t1->stlen;
1393 len2 = t2->stlen;
1394 ldiff = len1 - len2;
1395 if (len1 == 0 || len2 == 0)
1396 return ldiff;
1397 l = (ldiff <= 0 ? len1 : len2);
1398 if (IGNORECASE) {
1399 const unsigned char *cp1 = (const unsigned char *) t1->stptr;
1400 const unsigned char *cp2 = (const unsigned char *) t2->stptr;
1401
1402#ifdef MBS_SUPPORT
1403 if (gawk_mb_cur_max > 1) {
1404 mbstate_t mbs;
1405 memset(&mbs, 0, sizeof(mbstate_t));
1406 ret = strncasecmpmbs((const char *) cp1, mbs,
1407 (const char *) cp2, mbs, l);
1408 } else
1409#endif
1410 /* Could use tolower() here; see discussion above. */
1411 for (ret = 0; l-- > 0 && ret == 0; cp1++, cp2++)
1412 ret = casetable[*cp1] - casetable[*cp2];
1413 } else
1414 ret = memcmp(t1->stptr, t2->stptr, l);
1415 return (ret == 0 ? ldiff : ret);
1416}
1417
1418/* op_assign --- do +=, -=, etc. */
1419
1420static NODE *
1421op_assign(register NODE *tree)
1422{
1423 AWKNUM rval, lval;
1424 NODE **lhs;
1425 NODE *tmp;
1426 Func_ptr after_assign = NULL;
1427 int post = FALSE;
1428
1429 /*
1430 * For += etc, do the rhs first, since it can rearrange things,
1431 * and *then* get the lhs.
1432 */
1433 if (tree->rnode != NULL) {
1434 tmp = tree_eval(tree->rnode);
1435 rval = force_number(tmp);
1436 free_temp(tmp);
1437 } else
1438 rval = (AWKNUM) 1.0;
1439
1440 lhs = get_lhs(tree->lnode, &after_assign, TRUE);
1441 lval = force_number(*lhs);
1442 unref(*lhs);
1443
1444 switch(tree->type) {
1445 case Node_postincrement:
1446 post = TRUE;
1447 /* fall through */
1448 case Node_preincrement:
1449 case Node_assign_plus:
1450 *lhs = make_number(lval + rval);
1451 break;
1452
1453 case Node_postdecrement:
1454 post = TRUE;
1455 /* fall through */
1456 case Node_predecrement:
1457 case Node_assign_minus:
1458 *lhs = make_number(lval - rval);
1459 break;
1460
1461 case Node_assign_exp:
1462 *lhs = make_number(calc_exp(lval, rval));
1463 break;
1464
1465 case Node_assign_times:
1466 *lhs = make_number(lval * rval);
1467 break;
1468
1469 case Node_assign_quotient:
1470 if (rval == (AWKNUM) 0)
1471 fatal(_("division by zero attempted in `/='"));
1472 {
1473#ifdef _CRAY
1474 long ltemp;
1475
1476 /* special case for integer division, put in for Cray */
1477 ltemp = rval;
1478 if (ltemp == 0) {
1479 *lhs = make_number(lval / rval);
1480 break;
1481 }
1482 ltemp = (long) lval / ltemp;
1483 if (ltemp * lval == rval)
1484 *lhs = make_number((AWKNUM) ltemp);
1485 else
1486#endif /* _CRAY */
1487 *lhs = make_number(lval / rval);
1488 }
1489 break;
1490
1491 case Node_assign_mod:
1492 if (rval == (AWKNUM) 0)
1493 fatal(_("division by zero attempted in `%%='"));
1494#ifdef HAVE_FMOD
1495 *lhs = make_number(fmod(lval, rval));
1496#else /* ! HAVE_FMOD */
1497 {
1498 AWKNUM t1, t2;
1499
1500 (void) modf(lval / rval, &t1);
1501 t2 = lval - rval * t1;
1502 *lhs = make_number(t2);
1503 }
1504#endif /* ! HAVE_FMOD */
1505 break;
1506
1507 default:
1508 cant_happen();
1509 }
1510
1511 if (after_assign)
1512 (*after_assign)();
1513
1514 /* for postincrement or postdecrement, return the old value */
1515 return (post ? tmp_number(lval) : *lhs);
1516}
1517
1518/*
1519 * Avoiding memory leaks is difficult. In paticular, any of `next',
1520 * `nextfile', `break' or `continue' (when not in a loop), can longjmp
1521 * out to the outermost level. This leaks memory if it happens in a
1522 * called function. It also leaks memory if it happens in a
1523 * `for (iggy in foo)' loop, since such loops malloc an array of the
1524 * current array indices to loop over, which provides stability.
1525 *
1526 * The following code takes care of these problems. First comes the
1527 * array-loop management code. This can be a stack of arrays being looped
1528 * on at any one time. This stack serves for both mainline code and
1529 * function body code. As each loop starts and finishes, it pushes its
1530 * info onto this stack and off of it; whether the loop is in a function
1531 * body or not isn't relevant.
1532 *
1533 * Since the list of indices is created using dupnode(), when popping
1534 * this stack it should be safe to unref() things, and then memory
1535 * will get finally released when the function call stack is popped.
1536 * This means that the loop_stack should be popped first upon a `next'.
1537 */
1538
1539static struct loop_info {
1540 const char *varname; /* variable name, for debugging */
1541 NODE **elems; /* list of indices */
1542 size_t nelems; /* how many there are */
1543} *loop_stack = NULL;
1544size_t nloops = 0; /* how many slots there are in the stack */
1545size_t nloops_active = 0; /* how many loops are actively stacked */
1546
1547/* pop_forloop --- pop one for loop off the stack */
1548
1549static void
1550pop_forloop()
1551{
1552 int i, curloop;
1553 struct loop_info *loop;
1554
1555 assert(nloops_active > 0);
1556
1557 curloop = --nloops_active; /* 0-based indexing */
1558 loop = & loop_stack[curloop];
1559
1560 for (i = 0; i < loop->nelems; i++)
1561 unref(loop->elems[i]);
1562
1563 free(loop->elems);
1564
1565 loop->elems = NULL;
1566 loop->varname = NULL;
1567 loop->nelems = 0;
1568}
1569
1570/* pop_forloops --- pop the for loops stack all the way */
1571
1572static inline void
1573pop_all_forloops()
1574{
1575 while (nloops_active > 0)
1576 pop_forloop(); /* decrements nloops_active for us */
1577}
1578
1579/* push_forloop --- add a single for loop to the stack */
1580
1581static void
1582push_forloop(const char *varname, NODE **elems, size_t nelems)
1583{
1584#define NLOOPS 4 /* seems like a good guess */
1585 if (loop_stack == NULL) {
1586 /* allocate stack, set vars */
1587 nloops = NLOOPS;
1588 emalloc(loop_stack, struct loop_info *, nloops * sizeof(struct loop_info),
1589 "push_forloop");
1590 } else if (nloops_active == nloops) {
1591 /* grow stack, set vars */
1592 nloops *= 2;
1593 erealloc(loop_stack, struct loop_info *, nloops * sizeof(struct loop_info),
1594 "push_forloop");
1595 }
1596
1597 loop_stack[nloops_active].varname = varname;
1598 loop_stack[nloops_active].elems = elems;
1599 loop_stack[nloops_active].nelems = nelems;
1600 nloops_active++;
1601}
1602
1603/*
1604 * 2/2004:
1605 * N.B. The code that uses fcalls[] *always* uses indexing.
1606 * This avoids severe problems in case fcalls gets realloc()'ed
1607 * during recursive tree_eval()'s or whatever, so that we don't
1608 * have to carefully reassign pointers into the array. The
1609 * minor speed gain from using a pointer was offset too much
1610 * by the hassles to get the code right and commented.
1611 *
1612 * Thanks and a tip of the hatlo to Brian Kernighan.
1613 */
1614
1615static struct fcall {
1616 const char *fname; /* function name */
1617 size_t count; /* how many args */
1618 NODE *arglist; /* list thereof */
1619 NODE **prevstack; /* function stack frame of previous function */
1620 NODE **stack; /* function stack frame of current function */
1621} *fcalls = NULL;
1622
1623static long fcall_list_size = 0;
1624static long curfcall = -1;
1625
1626/*
1627 * get_curfunc_arg_count --- return number actual parameters
1628 *
1629 * This is for use by dynamically loaded C extension functions.
1630 */
1631size_t
1632get_curfunc_arg_count(void)
1633{
1634 NODE *argp;
1635 size_t argc;
1636
1637 assert(curfcall >= 0);
1638
1639 /* count the # of expressions in argument expression list */
1640 for (argc = 0, argp = fcalls[curfcall].arglist;
1641 argp != NULL; argp = argp->rnode)
1642 argc++;
1643
1644 return argc;
1645}
1646
1647/* pop_fcall --- pop off a single function call */
1648
1649static void
1650pop_fcall()
1651{
1652 NODE *n, **sp;
1653 int count;
1654
1655 assert(curfcall >= 0);
1656 stack_ptr = fcalls[curfcall].prevstack;
1657
1658 sp = fcalls[curfcall].stack;
1659
1660 for (count = fcalls[curfcall].count; count > 0; count--) {
1661 n = *sp++;
1662 if (n->type == Node_var) /* local variable */
1663 unref(n->var_value);
1664 else if (n->type == Node_var_array) /* local array */
1665 assoc_clear(n);
1666 freenode(n);
1667 }
1668 if (fcalls[curfcall].stack) {
1669 free((char *) fcalls[curfcall].stack);
1670 fcalls[curfcall].stack = NULL;
1671 }
1672 curfcall--;
1673}
1674
1675/* pop_fcall_stack --- pop off all function args, don't leak memory */
1676
1677static inline void
1678pop_fcall_stack()
1679{
1680 while (curfcall >= 0)
1681 pop_fcall();
1682}
1683
1684/* push_args --- push function arguments onto the stack */
1685
1686static void
1687push_args(int count,
1688 NODE *argp,
1689 NODE **oldstack,
1690 const char *func_name,
1691 char **varnames)
1692{
1693 NODE *arg, *r, **sp;
1694 int i;
1695
1696 if (fcall_list_size == 0) { /* first time */
1697 emalloc(fcalls, struct fcall *, 10 * sizeof(struct fcall),
1698 "push_args");
1699 fcall_list_size = 10;
1700 }
1701
1702 if (++curfcall >= fcall_list_size) {
1703 fcall_list_size *= 2;
1704 erealloc(fcalls, struct fcall *,
1705 fcall_list_size * sizeof(struct fcall), "push_args");
1706 }
1707
1708 if (count > 0)
1709 emalloc(fcalls[curfcall].stack, NODE **, count*sizeof(NODE *), "push_args");
1710 else
1711 fcalls[curfcall].stack = NULL;
1712 fcalls[curfcall].count = count;
1713 fcalls[curfcall].fname = func_name; /* not used, for debugging, just in case */
1714 fcalls[curfcall].arglist = argp;
1715 fcalls[curfcall].prevstack = oldstack;
1716
1717 sp = fcalls[curfcall].stack;
1718
1719 /* for each calling arg. add NODE * on stack */
1720 for (i = 0; i < count; i++) {
1721 getnode(r);
1722 *sp++ = r;
1723 if (argp == NULL) {
1724 /* local variable */
1725 r->type = Node_var_new;
1726 r->var_value = Nnull_string;
1727 r->vname = varnames[i];
1728 r->rnode = NULL;
1729 continue;
1730 }
1731 arg = argp->lnode;
1732 /* call by reference for arrays; see below also */
1733 if (arg->type == Node_param_list)
1734 arg = fcalls[curfcall].prevstack[arg->param_cnt];
1735
1736 if (arg->type == Node_var_array || arg->type == Node_var_new) {
1737 r->type = Node_array_ref;
1738 r->orig_array = arg;
1739 r->prev_array = arg;
1740 } else if (arg->type == Node_array_ref) {
1741 *r = *arg;
1742 r->prev_array = arg;
1743 } else {
1744 NODE *n = tree_eval(arg);
1745
1746 r->type = Node_var;
1747 r->lnode = dupnode(n);
1748 r->rnode = (NODE *) NULL;
1749 free_temp(n);
1750 }
1751 r->vname = varnames[i];
1752 argp = argp->rnode;
1753 }
1754
1755 if (argp != NULL) {
1756 /* Left over calling args. */
1757 warning(
1758 _("function `%s' called with more arguments than declared"),
1759 func_name);
1760 /* Evaluate them, they may have side effects: */
1761 do {
1762 arg = argp->lnode;
1763 if (arg->type == Node_param_list)
1764 arg = fcalls[curfcall].prevstack[arg->param_cnt];
1765 if (arg->type != Node_var_array &&
1766 arg->type != Node_array_ref &&
1767 arg->type != Node_var_new)
1768 free_temp(tree_eval(arg));
1769 } while ((argp = argp->rnode) != NULL);
1770 }
1771
1772 stack_ptr = fcalls[curfcall].stack;
1773}
1774
1775/* func_call --- call a function, call by reference for arrays */
1776
1777NODE **stack_ptr;
1778
1779static NODE *
1780func_call(NODE *tree)
1781{
1782 register NODE *r;
1783 NODE *name, *arg_list;
1784 NODE *f;
1785 jmp_buf volatile func_tag_stack;
1786 jmp_buf volatile loop_tag_stack;
1787 int volatile save_loop_tag_valid = FALSE;
1788 NODE *save_ret_node;
1789 extern NODE *ret_node;
1790
1791 /* tree->rnode is a Node_val giving function name */
1792 /* tree->lnode is Node_expression_list of calling args. */
1793 name = tree->rnode;
1794 arg_list = tree->lnode;
1795
1796 /* retrieve function definition node */
1797 if (tree->funcbody != NULL)
1798 f = tree->funcbody;
1799 else {
1800 f = lookup(name->stptr);
1801 if (f == NULL || f->type != Node_func)
1802 fatal(_("function `%s' not defined"), name->stptr);
1803
1804 tree->funcbody = f; /* save for next call */
1805 }
1806
1807#ifdef FUNC_TRACE
1808 fprintf(stderr, "function `%s' called\n", name->stptr);
1809#endif
1810 push_args(f->lnode->param_cnt, arg_list, stack_ptr, name->stptr,
1811 f->parmlist);
1812
1813 /*
1814 * Execute function body, saving context, as a return statement
1815 * will longjmp back here.
1816 *
1817 * Have to save and restore the loop_tag stuff so that a return
1818 * inside a loop in a function body doesn't scrog any loops going
1819 * on in the main program. We save the necessary info in variables
1820 * local to this function so that function nesting works OK.
1821 * We also only bother to save the loop stuff if we're in a loop
1822 * when the function is called.
1823 */
1824 if (loop_tag_valid) {
1825 int junk = 0;
1826
1827 save_loop_tag_valid = (volatile int) loop_tag_valid;
1828 PUSH_BINDING(loop_tag_stack, loop_tag, junk);
1829 loop_tag_valid = FALSE;
1830 }
1831 PUSH_BINDING(func_tag_stack, func_tag, func_tag_valid);
1832 save_ret_node = ret_node;
1833 ret_node = Nnull_string; /* default return value */
1834 INCREMENT(f->exec_count); /* count function calls */
1835 if (setjmp(func_tag) == 0)
1836 (void) interpret(f->rnode);
1837
1838 r = ret_node;
1839 ret_node = (NODE *) save_ret_node;
1840 RESTORE_BINDING(func_tag_stack, func_tag, func_tag_valid);
1841 pop_fcall();
1842
1843 /* Restore the loop_tag stuff if necessary. */
1844 if (save_loop_tag_valid) {
1845 int junk = 0;
1846
1847 loop_tag_valid = (int) save_loop_tag_valid;
1848 RESTORE_BINDING(loop_tag_stack, loop_tag, junk);
1849 }
1850
1851 return r;
1852}
1853
1854#ifdef PROFILING
1855/* dump_fcall_stack --- print a backtrace of the awk function calls */
1856
1857void
1858dump_fcall_stack(FILE *fp)
1859{
1860 int i;
1861
1862 if (curfcall < 0)
1863 return;
1864
1865 fprintf(fp, _("\n\t# Function Call Stack:\n\n"));
1866 for (i = curfcall; i >= 0; i--)
1867 fprintf(fp, "\t# %3d. %s\n", i+1, fcalls[i].fname);
1868 fprintf(fp, _("\t# -- main --\n"));
1869}
1870#endif /* PROFILING */
1871
1872/*
1873 * r_get_lhs:
1874 * This returns a POINTER to a node pointer. get_lhs(ptr) is the current
1875 * value of the var, or where to store the var's new value
1876 *
1877 * For the special variables, don't unref their current value if it's
1878 * the same as the internal copy; perhaps the current one is used in
1879 * a concatenation or some other expression somewhere higher up in the
1880 * call chain. Ouch.
1881 */
1882
1883NODE **
1884r_get_lhs(register NODE *ptr, Func_ptr *assign, int reference)
1885{
1886 register NODE **aptr = NULL;
1887 register NODE *n;
1888
1889 if (assign)
1890 *assign = NULL; /* for safety */
1891 if (ptr->type == Node_param_list) {
1892 if ((ptr->flags & FUNC) != 0)
1893 fatal(_("can't use function name `%s' as variable or array"), ptr->vname);
1894 ptr = stack_ptr[ptr->param_cnt];
1895 }
1896
1897 make_scalar(ptr);
1898
1899 switch (ptr->type) {
1900 case Node_var:
1901 if (do_lint && reference && var_uninitialized(ptr))
1902 lintwarn(_("reference to uninitialized variable `%s'"),
1903 ptr->vname);
1904
1905 aptr = &(ptr->var_value);
1906#ifdef GAWKDEBUG
1907 if (ptr->var_value->stref <= 0)
1908 cant_happen();
1909#endif
1910 break;
1911
1912 case Node_FIELDWIDTHS:
1913 aptr = &(FIELDWIDTHS_node->var_value);
1914 if (assign != NULL)
1915 *assign = set_FIELDWIDTHS;
1916 break;
1917
1918 case Node_RS:
1919 aptr = &(RS_node->var_value);
1920 if (assign != NULL)
1921 *assign = set_RS;
1922 break;
1923
1924 case Node_FS:
1925 aptr = &(FS_node->var_value);
1926 if (assign != NULL)
1927 *assign = set_FS;
1928 break;
1929
1930 case Node_FNR:
1931 if (FNR_node->var_value->numbr != FNR) {
1932 unref(FNR_node->var_value);
1933 FNR_node->var_value = make_number((AWKNUM) FNR);
1934 }
1935 aptr = &(FNR_node->var_value);
1936 if (assign != NULL)
1937 *assign = set_FNR;
1938 break;
1939
1940 case Node_NR:
1941 if (NR_node->var_value->numbr != NR) {
1942 unref(NR_node->var_value);
1943 NR_node->var_value = make_number((AWKNUM) NR);
1944 }
1945 aptr = &(NR_node->var_value);
1946 if (assign != NULL)
1947 *assign = set_NR;
1948 break;
1949
1950 case Node_NF:
1951 if (NF == -1 || NF_node->var_value->numbr != NF) {
1952 if (NF == -1)
1953 (void) get_field(UNLIMITED-1, assign); /* parse record */
1954 unref(NF_node->var_value);
1955 NF_node->var_value = make_number((AWKNUM) NF);
1956 }
1957 aptr = &(NF_node->var_value);
1958 if (assign != NULL)
1959 *assign = set_NF;
1960 break;
1961
1962 case Node_IGNORECASE:
1963 aptr = &(IGNORECASE_node->var_value);
1964 if (assign != NULL)
1965 *assign = set_IGNORECASE;
1966 break;
1967
1968 case Node_BINMODE:
1969 aptr = &(BINMODE_node->var_value);
1970 if (assign != NULL)
1971 *assign = set_BINMODE;
1972 break;
1973
1974 case Node_LINT:
1975 aptr = &(LINT_node->var_value);
1976 if (assign != NULL)
1977 *assign = set_LINT;
1978 break;
1979
1980 case Node_OFMT:
1981 aptr = &(OFMT_node->var_value);
1982 if (assign != NULL)
1983 *assign = set_OFMT;
1984 break;
1985
1986 case Node_CONVFMT:
1987 aptr = &(CONVFMT_node->var_value);
1988 if (assign != NULL)
1989 *assign = set_CONVFMT;
1990 break;
1991
1992 case Node_ORS:
1993 aptr = &(ORS_node->var_value);
1994 if (assign != NULL)
1995 *assign = set_ORS;
1996 break;
1997
1998 case Node_OFS:
1999 aptr = &(OFS_node->var_value);
2000 if (assign != NULL)
2001 *assign = set_OFS;
2002 break;
2003
2004 case Node_SUBSEP:
2005 aptr = &(SUBSEP_node->var_value);
2006 if (assign != NULL)
2007 *assign = set_SUBSEP;
2008 break;
2009
2010 case Node_TEXTDOMAIN:
2011 aptr = &(TEXTDOMAIN_node->var_value);
2012 if (assign != NULL)
2013 *assign = set_TEXTDOMAIN;
2014 break;
2015
2016 case Node_field_spec:
2017 {
2018 int field_num;
2019
2020 n = tree_eval(ptr->lnode);
2021 if (do_lint) {
2022 if ((n->flags & NUMBER) == 0) {
2023 lintwarn(_("attempt to field reference from non-numeric value"));
2024 if (n->stlen == 0)
2025 lintwarn(_("attempt to reference from null string"));
2026 }
2027 }
2028 field_num = (int) force_number(n);
2029 free_temp(n);
2030 if (field_num < 0)
2031 fatal(_("attempt to access field %d"), field_num);
2032 if (field_num == 0 && field0_valid) { /* short circuit */
2033 aptr = &fields_arr[0];
2034 if (assign != NULL)
2035 *assign = reset_record;
2036 } else
2037 aptr = get_field(field_num, assign);
2038 if (do_lint && reference && (*aptr == Null_field || *aptr == Nnull_string))
2039 lintwarn(_("reference to uninitialized field `$%d'"),
2040 field_num);
2041 break;
2042 }
2043
2044 case Node_subscript:
2045 n = get_array(ptr->lnode);
2046 aptr = assoc_lookup(n, concat_exp(ptr->rnode), reference);
2047 break;
2048
2049 case Node_builtin:
2050#if 1
2051 /* in gawk for a while */
2052 fatal(_("assignment is not allowed to result of builtin function"));
2053#else
2054 /*
2055 * This is how Christos at Deshaw did it.
2056 * Does this buy us anything?
2057 */
2058 if (ptr->builtin == NULL)
2059 fatal(_("assignment is not allowed to result of builtin function"));
2060 ptr->callresult = (*ptr->builtin)(ptr->subnode);
2061 aptr = &ptr->callresult;
2062 break;
2063#endif
2064
2065 default:
2066 fprintf(stderr, "type = %s\n", nodetype2str(ptr->type));
2067 fflush(stderr);
2068 cant_happen();
2069 }
2070 return aptr;
2071}
2072
2073/* match_op --- do ~ and !~ */
2074
2075static NODE *
2076match_op(register NODE *tree)
2077{
2078 register NODE *t1;
2079 register Regexp *rp;
2080 int i;
2081 int match = TRUE;
2082 int kludge_need_start = 0; /* FIXME: --- see below */
2083
2084 if (tree->type == Node_nomatch)
2085 match = FALSE;
2086 if (tree->type == Node_regex)
2087 t1 = *get_field(0, (Func_ptr *) 0);
2088 else {
2089 t1 = force_string(tree_eval(tree->lnode));
2090 tree = tree->rnode;
2091 }
2092 rp = re_update(tree);
2093 /*
2094 * FIXME:
2095 *
2096 * Any place where research() is called with a last parameter of
2097 * zero, we need to use the avoid_dfa test. This appears here and
2098 * in the code for Node_K_switch.
2099 *
2100 * A new or improved dfa that distinguishes beginning/end of
2101 * string from beginning/end of line will allow us to get rid of
2102 * this temporary hack.
2103 *
2104 * The avoid_dfa() function is in re.c; it is not very smart.
2105 */
2106 if (avoid_dfa(tree, t1->stptr, t1->stlen))
2107 kludge_need_start = RE_NEED_START;
2108 i = research(rp, t1->stptr, 0, t1->stlen, kludge_need_start);
2109 i = (i == -1) ^ (match == TRUE);
2110 free_temp(t1);
2111 return tmp_number((AWKNUM) i);
2112}
2113
2114/* set_IGNORECASE --- update IGNORECASE as appropriate */
2115
2116void
2117set_IGNORECASE()
2118{
2119 static int warned = FALSE;
2120
2121 if ((do_lint || do_traditional) && ! warned) {
2122 warned = TRUE;
2123 lintwarn(_("`IGNORECASE' is a gawk extension"));
2124 }
2125 load_casetable();
2126 if (do_traditional)
2127 IGNORECASE = FALSE;
2128 else if ((IGNORECASE_node->var_value->flags & (STRING|STRCUR)) != 0) {
2129 if ((IGNORECASE_node->var_value->flags & MAYBE_NUM) == 0)
2130 IGNORECASE = (force_string(IGNORECASE_node->var_value)->stlen > 0);
2131 else
2132 IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
2133 } else if ((IGNORECASE_node->var_value->flags & (NUMCUR|NUMBER)) != 0)
2134 IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
2135 else
2136 IGNORECASE = FALSE; /* shouldn't happen */
2137
2138 set_RS(); /* set_RS() calls set_FS() if need be, for us */
2139}
2140
2141/* set_BINMODE --- set translation mode (OS/2, DOS, others) */
2142
2143void
2144set_BINMODE()
2145{
2146 static int warned = FALSE;
2147 char *p, *cp, save;
2148 NODE *v;
2149 int digits = FALSE;
2150
2151 if ((do_lint || do_traditional) && ! warned) {
2152 warned = TRUE;
2153 lintwarn(_("`BINMODE' is a gawk extension"));
2154 }
2155 if (do_traditional)
2156 BINMODE = 0;
2157 else if ((BINMODE_node->var_value->flags & STRING) != 0) {
2158 v = BINMODE_node->var_value;
2159 p = v->stptr;
2160 save = p[v->stlen];
2161 p[v->stlen] = '\0';
2162
2163 for (cp = p; *cp != '\0'; cp++) {
2164 if (ISDIGIT(*cp)) {
2165 digits = TRUE;
2166 break;
2167 }
2168 }
2169
2170 if (! digits || (BINMODE_node->var_value->flags & MAYBE_NUM) == 0) {
2171 BINMODE = 0;
2172 if (strcmp(p, "r") == 0)
2173 BINMODE = 1;
2174 else if (strcmp(p, "w") == 0)
2175 BINMODE = 2;
2176 else if (strcmp(p, "rw") == 0 || strcmp(p, "wr") == 0)
2177 BINMODE = 3;
2178
2179 if (BINMODE == 0 && v->stlen != 0) {
2180 /* arbitrary string, assume both */
2181 BINMODE = 3;
2182 warning("BINMODE: arbitrary string value treated as \"rw\"");
2183 }
2184 } else
2185 BINMODE = (int) force_number(BINMODE_node->var_value);
2186
2187 p[v->stlen] = save;
2188 } else if ((BINMODE_node->var_value->flags & NUMBER) != 0)
2189 BINMODE = (int) force_number(BINMODE_node->var_value);
2190 else
2191 BINMODE = 0; /* shouldn't happen */
2192}
2193
2194/* set_OFS --- update OFS related variables when OFS assigned to */
2195
2196void
2197set_OFS()
2198{
2199 OFS = force_string(OFS_node->var_value)->stptr;
2200 OFSlen = OFS_node->var_value->stlen;
2201 OFS[OFSlen] = '\0';
2202}
2203
2204/* set_ORS --- update ORS related variables when ORS assigned to */
2205
2206void
2207set_ORS()
2208{
2209 ORS = force_string(ORS_node->var_value)->stptr;
2210 ORSlen = ORS_node->var_value->stlen;
2211 ORS[ORSlen] = '\0';
2212}
2213
2214/* fmt_ok --- is the conversion format a valid one? */
2215
2216NODE **fmt_list = NULL;
2217static int fmt_ok P((NODE *n));
2218static int fmt_index P((NODE *n));
2219
2220static int
2221fmt_ok(NODE *n)
2222{
2223 NODE *tmp = force_string(n);
2224 const char *p = tmp->stptr;
2225#if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1
2226 static const char float_formats[] = "efgEG";
2227#else
2228 static const char float_formats[] = "efgEFG";
2229#endif
2230#if defined(HAVE_LOCALE_H)
2231 static const char flags[] = " +-#'";
2232#else
2233 static const char flags[] = " +-#";
2234#endif
2235
2236 if (*p++ != '%')
2237 return 0;
2238 while (*p && strchr(flags, *p) != NULL) /* flags */
2239 p++;
2240 while (*p && ISDIGIT(*p)) /* width - %*.*g is NOT allowed */
2241 p++;
2242 if (*p == '\0' || (*p != '.' && ! ISDIGIT(*p)))
2243 return 0;
2244 if (*p == '.')
2245 p++;
2246 while (*p && ISDIGIT(*p)) /* precision */
2247 p++;
2248 if (*p == '\0' || strchr(float_formats, *p) == NULL)
2249 return 0;
2250 if (*++p != '\0')
2251 return 0;
2252 return 1;
2253}
2254
2255/* fmt_index --- track values of OFMT and CONVFMT to keep semantics correct */
2256
2257static int
2258fmt_index(NODE *n)
2259{
2260 register int ix = 0;
2261 static int fmt_num = 4;
2262 static int fmt_hiwater = 0;
2263
2264 if (fmt_list == NULL)
2265 emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
2266 (void) force_string(n);
2267 while (ix < fmt_hiwater) {
2268 if (cmp_nodes(fmt_list[ix], n) == 0)
2269 return ix;
2270 ix++;
2271 }
2272 /* not found */
2273 n->stptr[n->stlen] = '\0';
2274 if (do_lint && ! fmt_ok(n))
2275 lintwarn(_("bad `%sFMT' specification `%s'"),
2276 n == CONVFMT_node->var_value ? "CONV"
2277 : n == OFMT_node->var_value ? "O"
2278 : "", n->stptr);
2279
2280 if (fmt_hiwater >= fmt_num) {
2281 fmt_num *= 2;
2282 erealloc(fmt_list, NODE **, fmt_num * sizeof(*fmt_list), "fmt_index");
2283 }
2284 fmt_list[fmt_hiwater] = dupnode(n);
2285 return fmt_hiwater++;
2286}
2287
2288/* set_OFMT --- track OFMT correctly */
2289
2290void
2291set_OFMT()
2292{
2293 OFMTidx = fmt_index(OFMT_node->var_value);
2294 OFMT = fmt_list[OFMTidx]->stptr;
2295}
2296
2297/* set_CONVFMT --- track CONVFMT correctly */
2298
2299void
2300set_CONVFMT()
2301{
2302 CONVFMTidx = fmt_index(CONVFMT_node->var_value);
2303 CONVFMT = fmt_list[CONVFMTidx]->stptr;
2304}
2305
2306/* set_LINT --- update LINT as appropriate */
2307
2308void
2309set_LINT()
2310{
2311#ifndef NO_LINT
2312 int old_lint = do_lint;
2313
2314 if ((LINT_node->var_value->flags & (STRING|STRCUR)) != 0) {
2315 if ((LINT_node->var_value->flags & MAYBE_NUM) == 0) {
2316 const char *lintval;
2317 size_t lintlen;
2318
2319 do_lint = (force_string(LINT_node->var_value)->stlen > 0);
2320 lintval = LINT_node->var_value->stptr;
2321 lintlen = LINT_node->var_value->stlen;
2322 if (do_lint) {
2323 do_lint = LINT_ALL;
2324 if (lintlen == 5 && strncmp(lintval, "fatal", 5) == 0)
2325 lintfunc = r_fatal;
2326 else if (lintlen == 7 && strncmp(lintval, "invalid", 7) == 0)
2327 do_lint = LINT_INVALID;
2328 else
2329 lintfunc = warning;
2330 } else
2331 lintfunc = warning;
2332 } else {
2333 if (force_number(LINT_node->var_value) != 0.0)
2334 do_lint = LINT_ALL;
2335 else
2336 do_lint = FALSE;
2337 lintfunc = warning;
2338 }
2339 } else if ((LINT_node->var_value->flags & (NUMCUR|NUMBER)) != 0) {
2340 if (force_number(LINT_node->var_value) != 0.0)
2341 do_lint = LINT_ALL;
2342 else
2343 do_lint = FALSE;
2344 lintfunc = warning;
2345 } else
2346 do_lint = FALSE; /* shouldn't happen */
2347
2348 if (! do_lint)
2349 lintfunc = warning;
2350
2351 /* explicitly use warning() here, in case lintfunc == r_fatal */
2352 if (old_lint != do_lint && old_lint && do_lint == FALSE)
2353 warning(_("turning off `--lint' due to assignment to `LINT'"));
2354#endif /* ! NO_LINT */
2355}
2356
2357/* set_TEXTDOMAIN --- update TEXTDOMAIN variable when TEXTDOMAIN assigned to */
2358
2359void
2360set_TEXTDOMAIN()
2361{
2362 int len;
2363
2364 TEXTDOMAIN = force_string(TEXTDOMAIN_node->var_value)->stptr;
2365 len = TEXTDOMAIN_node->var_value->stlen;
2366 TEXTDOMAIN[len] = '\0';
2367 /*
2368 * Note: don't call textdomain(); this value is for
2369 * the awk program, not for gawk itself.
2370 */
2371}
2372
2373/*
2374 * assign_val --- do mechanics of assignment, for calling from multiple
2375 * places.
2376 */
2377
2378NODE *
2379assign_val(NODE **lhs_p, NODE *rhs)
2380{
2381 if (rhs != *lhs_p) {
2382 /*
2383 * Since we know that the nodes are different,
2384 * we can do the unref() before the dupnode().
2385 */
2386 unref(*lhs_p);
2387 *lhs_p = dupnode(rhs);
2388 }
2389 return *lhs_p;
2390}
2391
2392/* update_ERRNO_saved --- update the value of ERRNO based on argument */
2393
2394void
2395update_ERRNO_saved(int errcode)
2396{
2397 char *cp;
2398
2399 cp = strerror(errcode);
2400 cp = gettext(cp);
2401 unref(ERRNO_node->var_value);
2402 ERRNO_node->var_value = make_string(cp, strlen(cp));
2403}
2404
2405/* update_ERRNO --- update the value of ERRNO based on errno */
2406
2407void
2408update_ERRNO()
2409{
2410 update_ERRNO_saved(errno);
2411}
2412
2413/* comp_func --- array index comparison function for qsort */
2414
2415static int
2416comp_func(const void *p1, const void *p2)
2417{
2418 size_t len1, len2;
2419 const char *str1, *str2;
2420 const NODE *t1, *t2;
2421 int cmp1;
2422
2423 t1 = *((const NODE *const *) p1);
2424 t2 = *((const NODE *const *) p2);
2425
2426/*
2427 t1 = force_string(t1);
2428 t2 = force_string(t2);
2429*/
2430 len1 = t1->ahname_len;
2431 str1 = t1->ahname_str;
2432
2433 len2 = t2->ahname_len;
2434 str2 = t2->ahname_str;
2435
2436 /* Array indexes are strings, compare as such, always! */
2437 cmp1 = memcmp(str1, str2, len1 < len2 ? len1 : len2);
2438 /* if prefixes are equal, size matters */
2439 return (cmp1 != 0 ? cmp1 :
2440 len1 < len2 ? -1 : (len1 > len2));
2441}
Note: See TracBrowser for help on using the repository browser.