Introduced -devel and -extras subpackages for gawk
[platform/upstream/gawk.git] / eval.c
1 /*
2  * eval.c - gawk bytecode interpreter 
3  */
4
5 /* 
6  * Copyright (C) 1986, 1988, 1989, 1991-2011 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 3 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
28 extern void after_beginfile(IOBUF **curfile);
29 extern double pow(double x, double y);
30 extern double modf(double x, double *yp);
31 extern double fmod(double x, double y);
32 NODE **fcall_list;
33 long fcall_count = 0;
34 int currule = 0;
35 IOBUF *curfile = NULL;          /* current data file */
36 int exiting = FALSE;
37
38 #ifdef DEBUGGING
39 extern int pre_execute(INSTRUCTION **);
40 extern void post_execute(INSTRUCTION *);
41 #else
42 #define r_interpret interpret
43 #endif
44
45 /*
46  * Flag which executable this is; done here because eval.c is compiled
47  * differently for each of them.
48  */
49 enum exe_mode which_gawk =
50 #ifdef PROFILING
51                            exe_profiling        /* pgawk */
52 #else
53 # ifdef DEBUGGING
54                            exe_debugging        /* dgawk */     
55 # else
56                            exe_normal           /* normal gawk */   
57 # endif
58 #endif
59                            ;    /* which_gawk */
60
61 #if __GNUC__ < 2
62 NODE *_t;               /* used as a temporary in macros */
63 #endif
64 int OFSlen;
65 int ORSlen;
66 int OFMTidx;
67 int CONVFMTidx;
68
69 /* Profiling stuff */
70 #ifdef PROFILING
71 #define INCREMENT(n)    n++
72 #else
73 #define INCREMENT(n)    /* nothing */
74 #endif
75
76 /* This rather ugly macro is for VMS C */
77 #ifdef C
78 #undef C
79 #endif
80 #define C(c) ((char)c)  
81 /*
82  * This table is used by the regexp routines to do case independent
83  * matching. Basically, every ascii character maps to itself, except
84  * uppercase letters map to lower case ones. This table has 256
85  * entries, for ISO 8859-1. Note also that if the system this
86  * is compiled on doesn't use 7-bit ascii, casetable[] should not be
87  * defined to the linker, so gawk should not load.
88  *
89  * Do NOT make this array static, it is used in several spots, not
90  * just in this file.
91  *
92  * 6/2004:
93  * This table is also used for IGNORECASE for == and !=, and index().
94  * Although with GLIBC, we could use tolower() everywhere and RE_ICASE
95  * for the regex matcher, precomputing this table once gives us a
96  * performance improvement.  I also think it's better for portability
97  * to non-GLIBC systems.  All the world is not (yet :-) GNU/Linux.
98  */
99 #if 'a' == 97   /* it's ascii */
100 char casetable[] = {
101         '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
102         '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
103         '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
104         '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
105         /* ' '     '!'     '"'     '#'     '$'     '%'     '&'     ''' */
106         '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
107         /* '('     ')'     '*'     '+'     ','     '-'     '.'     '/' */
108         '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
109         /* '0'     '1'     '2'     '3'     '4'     '5'     '6'     '7' */
110         '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
111         /* '8'     '9'     ':'     ';'     '<'     '='     '>'     '?' */
112         '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
113         /* '@'     'A'     'B'     'C'     'D'     'E'     'F'     'G' */
114         '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
115         /* 'H'     'I'     'J'     'K'     'L'     'M'     'N'     'O' */
116         '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
117         /* 'P'     'Q'     'R'     'S'     'T'     'U'     'V'     'W' */
118         '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
119         /* 'X'     'Y'     'Z'     '['     '\'     ']'     '^'     '_' */
120         '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
121         /* '`'     'a'     'b'     'c'     'd'     'e'     'f'     'g' */
122         '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
123         /* 'h'     'i'     'j'     'k'     'l'     'm'     'n'     'o' */
124         '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
125         /* 'p'     'q'     'r'     's'     't'     'u'     'v'     'w' */
126         '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
127         /* 'x'     'y'     'z'     '{'     '|'     '}'     '~' */
128         '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
129
130         /* Latin 1: */
131         C('\200'), C('\201'), C('\202'), C('\203'), C('\204'), C('\205'), C('\206'), C('\207'),
132         C('\210'), C('\211'), C('\212'), C('\213'), C('\214'), C('\215'), C('\216'), C('\217'),
133         C('\220'), C('\221'), C('\222'), C('\223'), C('\224'), C('\225'), C('\226'), C('\227'),
134         C('\230'), C('\231'), C('\232'), C('\233'), C('\234'), C('\235'), C('\236'), C('\237'),
135         C('\240'), C('\241'), C('\242'), C('\243'), C('\244'), C('\245'), C('\246'), C('\247'),
136         C('\250'), C('\251'), C('\252'), C('\253'), C('\254'), C('\255'), C('\256'), C('\257'),
137         C('\260'), C('\261'), C('\262'), C('\263'), C('\264'), C('\265'), C('\266'), C('\267'),
138         C('\270'), C('\271'), C('\272'), C('\273'), C('\274'), C('\275'), C('\276'), C('\277'),
139         C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
140         C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
141         C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\327'),
142         C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\337'),
143         C('\340'), C('\341'), C('\342'), C('\343'), C('\344'), C('\345'), C('\346'), C('\347'),
144         C('\350'), C('\351'), C('\352'), C('\353'), C('\354'), C('\355'), C('\356'), C('\357'),
145         C('\360'), C('\361'), C('\362'), C('\363'), C('\364'), C('\365'), C('\366'), C('\367'),
146         C('\370'), C('\371'), C('\372'), C('\373'), C('\374'), C('\375'), C('\376'), C('\377'),
147 };
148 #elif 'a' == 0x81 /* it's EBCDIC */
149 char casetable[] = {
150  /*00  NU    SH    SX    EX    PF    HT    LC    DL */
151       0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
152  /*08              SM    VT    FF    CR    SO    SI */
153       0x08, 0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
154  /*10  DE    D1    D2    TM    RS    NL    BS    IL */
155       0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
156  /*18  CN    EM    CC    C1    FS    GS    RS    US */
157       0x18, 0x19, 0x1A, 0x1B, 0x1C, 0x1D, 0x1E, 0x1F,
158  /*20  DS    SS    FS          BP    LF    EB    EC */
159       0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
160  /*28              SM    C2    EQ    AK    BL       */
161       0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x2D, 0x2E, 0x2F,
162  /*30              SY          PN    RS    UC    ET */
163       0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,
164  /*38                    C3    D4    NK          SU */
165       0x38, 0x39, 0x3A, 0x3B, 0x3C, 0x3D, 0x3E, 0x3F,
166  /*40  SP                                           */
167       0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,
168  /*48             CENT    .     <     (     +     | */
169       0x48, 0x49, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F,
170  /*50   &                                           */
171       0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57,
172  /*58               !     $     *     )     ;     ^ */
173       0x58, 0x59, 0x5A, 0x5B, 0x5C, 0x5D, 0x5E, 0x5F,
174  /*60   -     /                                     */
175       0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
176  /*68               |     ,     %     _     >     ? */
177       0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F,
178  /*70                                               */
179       0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
180  /*78         `     :     #     @     '     =     " */
181       0x78, 0x79, 0x7A, 0x7B, 0x7C, 0x7D, 0x7E, 0x7F,
182  /*80         a     b     c     d     e     f     g */
183       0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
184  /*88   h     i           {                         */
185       0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F,
186  /*90         j     k     l     m     n     o     p */
187       0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
188  /*98   q     r           }                         */
189       0x98, 0x99, 0x9A, 0x9B, 0x9C, 0x9D, 0x9E, 0x9F,
190  /*A0         ~     s     t     u     v     w     x */
191       0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,
192  /*A8   y     z                       [             */
193       0xA8, 0xA9, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF,
194  /*B0                                               */
195       0xB0, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7,
196  /*B8                                 ]             */
197       0xB8, 0xB9, 0xBA, 0xBB, 0xBC, 0xBD, 0xBE, 0xBF,
198  /*C0   {     A     B     C     D     E     F     G */
199       0xC0, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
200  /*C8   H     I                                     */
201       0x88, 0x89, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF,
202  /*D0   }     J     K     L     M     N     O     P */
203       0xD0, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
204  /*D8   Q     R                                     */
205       0x98, 0x99, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF,
206  /*E0   \           S     T     U     V     W     X */
207       0xE0, 0xE1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,
208  /*E8   Y     Z                                     */
209       0xA8, 0xA9, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF,
210  /*F0   0     1     2     3     4     5     6     7 */
211       0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,
212  /*F8   8     9                                     */
213       0xF8, 0xF9, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF
214 };
215 #else
216 #include "You lose. You will need a translation table for your character set."
217 #endif
218
219 #undef C
220
221 /* load_casetable --- for a non-ASCII locale, redo the table */
222
223 void
224 load_casetable(void)
225 {
226 #if defined(LC_CTYPE)
227         int i;
228         char *cp;
229         static int loaded = FALSE;
230
231         if (loaded || do_traditional)
232                 return;
233
234         loaded = TRUE;
235         cp = setlocale(LC_CTYPE, NULL);
236
237         /* this is not per standard, but it's pretty safe */
238         if (cp == NULL || strcmp(cp, "C") == 0 || strcmp(cp, "POSIX") == 0)
239                 return;
240
241 #ifndef ZOS_USS
242         for (i = 0200; i <= 0377; i++) {
243                 if (isalpha(i) && islower(i) && i != toupper(i))
244                         casetable[i] = toupper(i);
245         }
246 #endif
247 #endif
248 }
249
250 /*
251  * This table maps node types to strings for debugging.
252  * KEEP IN SYNC WITH awk.h!!!!
253  */
254
255 static const char *const nodetypes[] = {
256         "Node_illegal",
257         "Node_val",
258         "Node_regex",
259         "Node_dynregex",
260         "Node_var",
261         "Node_var_array",
262         "Node_var_new",
263         "Node_param_list",
264         "Node_func",
265         "Node_hashnode",
266         "Node_ahash",
267         "Node_array_ref",
268         "Node_arrayfor",
269         "Node_frame",
270         "Node_instruction",
271         "Node_final --- this should never appear",
272         NULL
273 };
274
275
276 /*
277  * This table maps Op codes to strings.
278  * KEEP IN SYNC WITH awk.h!!!!
279  */
280
281 static struct optypetab {
282         char *desc;
283         char *operator;
284 } optypes[] = {
285         { "Op_illegal", NULL },
286         { "Op_times", " * " },
287         { "Op_times_i", " * " },
288         { "Op_quotient", " / " },
289         { "Op_quotient_i", " / " },
290         { "Op_mod", " % " },
291         { "Op_mod_i", " % " },
292         { "Op_plus", " + " },
293         { "Op_plus_i", " + " },
294         { "Op_minus", " - " },
295         { "Op_minus_i", " - " },
296         { "Op_exp", " ^ " },
297         { "Op_exp_i", " ^ " },
298         { "Op_concat", " " },
299         { "Op_line_range", NULL },
300         { "Op_cond_pair", ", " },
301         { "Op_subscript", "[]" },
302         { "Op_sub_array", "[]" },
303         { "Op_preincrement", "++" },
304         { "Op_predecrement", "--" },
305         { "Op_postincrement", "++" },
306         { "Op_postdecrement", "--" },
307         { "Op_unary_minus", "-" },
308         { "Op_field_spec", "$" },
309         { "Op_not", "! " },
310         { "Op_assign", " = " },
311         { "Op_store_var", " = " },
312         { "Op_store_sub", " = " },
313         { "Op_store_field", " = " },
314         { "Op_assign_times", " *= " },
315         { "Op_assign_quotient", " /= " },
316         { "Op_assign_mod", " %= " },
317         { "Op_assign_plus", " += " },
318         { "Op_assign_minus", " -= " },
319         { "Op_assign_exp", " ^= " },
320         { "Op_assign_concat", " " },
321         { "Op_and", " && " },
322         { "Op_and_final", NULL },
323         { "Op_or", " || " },
324         { "Op_or_final", NULL },
325         { "Op_equal", " == " },
326         { "Op_notequal", " != " },
327         { "Op_less", " < " },
328         { "Op_greater", " > " },
329         { "Op_leq", " <= " },
330         { "Op_geq", " >= " },
331         { "Op_match", " ~ " },
332         { "Op_match_rec", NULL },
333         { "Op_nomatch", " !~ " },
334         { "Op_rule", NULL }, 
335         { "Op_K_case", "case" },
336         { "Op_K_default", "default" },
337         { "Op_K_break", "break" },
338         { "Op_K_continue", "continue" },
339         { "Op_K_print", "print" },
340         { "Op_K_print_rec", "print" },
341         { "Op_K_printf", "printf" },
342         { "Op_K_next", "next" },
343         { "Op_K_exit", "exit" },
344         { "Op_K_return", "return" },
345         { "Op_K_delete", "delete" },
346         { "Op_K_delete_loop", NULL },
347         { "Op_K_getline_redir", "getline" },
348         { "Op_K_getline", "getline" },
349         { "Op_K_nextfile", "nextfile" },
350         { "Op_builtin", NULL },
351         { "Op_sub_builtin", NULL },
352         { "Op_in_array", " in " },
353         { "Op_func_call", NULL },
354         { "Op_indirect_func_call", NULL },
355         { "Op_push", NULL },
356         { "Op_push_arg", NULL },
357         { "Op_push_i", NULL },
358         { "Op_push_re", NULL },
359         { "Op_push_array", NULL },
360         { "Op_push_param", NULL },
361         { "Op_push_lhs", NULL },
362         { "Op_subscript_lhs", "[]" },
363         { "Op_field_spec_lhs", "$" },
364         { "Op_no_op", NULL },
365         { "Op_pop", NULL },
366         { "Op_jmp", NULL },
367         { "Op_jmp_true", NULL },
368         { "Op_jmp_false", NULL },
369         { "Op_get_record", NULL },
370         { "Op_newfile", NULL },
371         { "Op_arrayfor_init", NULL },
372         { "Op_arrayfor_incr", NULL },
373         { "Op_arrayfor_final", NULL },
374         { "Op_var_update", NULL },
375         { "Op_var_assign", NULL },
376         { "Op_field_assign", NULL },
377         { "Op_after_beginfile", NULL },
378         { "Op_after_endfile", NULL },
379         { "Op_ext_func", NULL },
380         { "Op_func", NULL },
381         { "Op_exec_count", NULL },
382         { "Op_breakpoint", NULL },
383         { "Op_lint", NULL },
384         { "Op_atexit", NULL },
385         { "Op_stop", NULL },
386         { "Op_token", NULL },
387         { "Op_symbol", NULL },
388         { "Op_list", NULL },
389         { "Op_K_do", "do" },
390         { "Op_K_for", "for" },
391         { "Op_K_arrayfor", "for" },
392         { "Op_K_while", "while" },
393         { "Op_K_switch", "switch" },
394         { "Op_K_if", "if" },
395         { "Op_K_else", "else" },
396         { "Op_K_function", "function" },
397         { "Op_cond_exp", NULL },
398         { "Op_final --- this should never appear", NULL },
399         { NULL, NULL },
400 };
401
402 /* nodetype2str --- convert a node type into a printable value */
403
404 const char *
405 nodetype2str(NODETYPE type)
406 {
407         static char buf[40];
408
409         if (type >= Node_illegal && type <= Node_final)
410                 return nodetypes[(int) type];
411
412         sprintf(buf, _("unknown nodetype %d"), (int) type);
413         return buf;
414 }
415
416 /* opcode2str --- convert a opcode type into a printable value */
417
418 const char *
419 opcode2str(OPCODE op)
420 {
421         if (op >= Op_illegal && op < Op_final)
422                 return optypes[(int) op].desc;
423         fatal(_("unknown opcode %d"), (int) op);
424         return NULL;
425 }
426
427 const char *
428 op2str(OPCODE op)
429 {
430         if (op >= Op_illegal && op < Op_final) {
431                 if (optypes[(int) op].operator != NULL)
432                         return optypes[(int) op].operator;
433                 else
434                         fatal(_("opcode %s not an operator or keyword"),
435                                         optypes[(int) op].desc);
436         } else
437                 fatal(_("unknown opcode %d"), (int) op);
438         return NULL;
439 }
440
441
442 /* flags2str --- make a flags value readable */
443
444 const char *
445 flags2str(int flagval)
446 {
447         static const struct flagtab values[] = {
448                 { MALLOC, "MALLOC" },
449                 { PERM, "PERM" },
450                 { STRING, "STRING" },
451                 { STRCUR, "STRCUR" },
452                 { NUMCUR, "NUMCUR" },
453                 { NUMBER, "NUMBER" },
454                 { MAYBE_NUM, "MAYBE_NUM" },
455                 { ARRAYMAXED, "ARRAYMAXED" },
456                 { FUNC, "FUNC" },
457                 { FIELD, "FIELD" },
458                 { INTLSTR, "INTLSTR" },
459                 { NUMIND, "NUMIND" },
460 #ifdef WSTRCUR
461                 { WSTRCUR, "WSTRCUR" },
462 #endif
463                 { 0,    NULL },
464         };
465
466         return genflags2str(flagval, values);
467 }
468
469 /* genflags2str --- general routine to convert a flag value to a string */
470
471 const char *
472 genflags2str(int flagval, const struct flagtab *tab)
473 {
474         static char buffer[BUFSIZ];
475         char *sp;
476         int i, space_left, space_needed;
477
478         sp = buffer;
479         space_left = BUFSIZ;
480         for (i = 0; tab[i].name != NULL; i++) {
481                 if ((flagval & tab[i].val) != 0) {
482                         /*
483                          * note the trick, we want 1 or 0 for whether we need
484                          * the '|' character.
485                          */
486                         space_needed = (strlen(tab[i].name) + (sp != buffer));
487                         if (space_left < space_needed)
488                                 fatal(_("buffer overflow in genflags2str"));
489
490                         if (sp != buffer) {
491                                 *sp++ = '|';
492                                 space_left--;
493                         }
494                         strcpy(sp, tab[i].name);
495                         /* note ordering! */
496                         space_left -= strlen(sp);
497                         sp += strlen(sp);
498                 }
499         }
500
501         return buffer;
502 }
503
504 /* posix_compare --- compare strings using strcoll */
505
506 static int
507 posix_compare(NODE *s1, NODE *s2)
508 {
509         int ret = 0;
510         char save1, save2;
511         size_t l = 0;
512
513         save1 = s1->stptr[s1->stlen];
514         s1->stptr[s1->stlen] = '\0';
515
516         save2 = s2->stptr[s2->stlen];
517         s2->stptr[s2->stlen] = '\0';
518
519         if (gawk_mb_cur_max == 1) {
520                 if (strlen(s1->stptr) == s1->stlen && strlen(s2->stptr) == s2->stlen)
521                         ret = strcoll(s1->stptr, s2->stptr);
522                 else {
523                         char b1[2], b2[2];
524                         char *p1, *p2;
525                         size_t i;
526
527                         if (s1->stlen < s2->stlen)
528                                 l = s1->stlen;
529                         else
530                                 l = s2->stlen;
531
532                         b1[1] = b2[1] = '\0';
533                         for (i = ret = 0, p1 = s1->stptr, p2 = s2->stptr;
534                              ret == 0 && i < l;
535                              p1++, p2++) {
536                                 b1[0] = *p1;
537                                 b2[0] = *p2;
538                                 ret = strcoll(b1, b2);
539                         }
540                 }
541                 /*
542                  * Either worked through the strings or ret != 0.
543                  * In either case, ret will be the right thing to return.
544                  */
545         }
546 #if MBS_SUPPORT
547         else {
548                 /* Similar logic, using wide characters */
549                 (void) force_wstring(s1);
550                 (void) force_wstring(s2);
551
552                 if (wcslen(s1->wstptr) == s1->wstlen && wcslen(s2->wstptr) == s2->wstlen)
553                         ret = wcscoll(s1->wstptr, s2->wstptr);
554                 else {
555                         wchar_t b1[2], b2[2];
556                         wchar_t *p1, *p2;
557                         size_t i;
558
559                         if (s1->wstlen < s2->wstlen)
560                                 l = s1->wstlen;
561                         else
562                                 l = s2->wstlen;
563
564                         b1[1] = b2[1] = L'\0';
565                         for (i = ret = 0, p1 = s1->wstptr, p2 = s2->wstptr;
566                              ret == 0 && i < l;
567                              p1++, p2++) {
568                                 b1[0] = *p1;
569                                 b2[0] = *p2;
570                                 ret = wcscoll(b1, b2);
571                         }
572                 }
573                 /*
574                  * Either worked through the strings or ret != 0.
575                  * In either case, ret will be the right thing to return.
576                  */
577         }
578 #endif
579
580         s1->stptr[s1->stlen] = save1;
581         s2->stptr[s2->stlen] = save2;
582         return ret;
583 }
584
585
586 /* cmp_nodes --- compare two nodes, returning negative, 0, positive */
587
588 int
589 cmp_nodes(NODE *t1, NODE *t2)
590 {
591         int ret = 0;
592         size_t len1, len2;
593         int l, ldiff;
594
595         if (t1 == t2)
596                 return 0;
597
598         if (t1->flags & MAYBE_NUM)
599                 (void) force_number(t1);
600         if (t2->flags & MAYBE_NUM)
601                 (void) force_number(t2);
602         if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
603                 if (t1->numbr == t2->numbr)
604                         ret = 0;
605                 /* don't subtract, in case one or both are infinite */
606                 else if (t1->numbr < t2->numbr)
607                         ret = -1;
608                 else
609                         ret = 1;
610                 return ret;
611         }
612
613         (void) force_string(t1);
614         (void) force_string(t2);
615         len1 = t1->stlen;
616         len2 = t2->stlen;
617         ldiff = len1 - len2;
618         if (len1 == 0 || len2 == 0)
619                 return ldiff;
620
621         if (do_posix)
622                 return posix_compare(t1, t2);
623
624         l = (ldiff <= 0 ? len1 : len2);
625         if (IGNORECASE) {
626                 const unsigned char *cp1 = (const unsigned char *) t1->stptr;
627                 const unsigned char *cp2 = (const unsigned char *) t2->stptr;
628
629 #if MBS_SUPPORT
630                 if (gawk_mb_cur_max > 1) {
631                         ret = strncasecmpmbs((const unsigned char *) cp1,
632                                              (const unsigned char *) cp2, l);
633                 } else
634 #endif
635                 /* Could use tolower() here; see discussion above. */
636                 for (ret = 0; l-- > 0 && ret == 0; cp1++, cp2++)
637                         ret = casetable[*cp1] - casetable[*cp2];
638         } else
639                 ret = memcmp(t1->stptr, t2->stptr, l);
640         return (ret == 0 ? ldiff : ret);
641 }
642
643
644 #if defined(PROFILING) || defined(DEBUGGING)
645 static void
646 push_frame(NODE *f)
647 {
648         static long max_fcall;
649
650         /* NB: frame numbering scheme as in GDB. frame_ptr => frame #0. */
651
652         fcall_count++;
653         if (fcall_list == NULL) {
654                 max_fcall = 10;
655                 emalloc(fcall_list, NODE **, (max_fcall + 1) * sizeof(NODE *), "push_frame");
656         } else if (fcall_count == max_fcall) {
657                 max_fcall *= 2;
658                 erealloc(fcall_list, NODE **, (max_fcall + 1) * sizeof(NODE *), "push_frame");
659         }
660
661         if (fcall_count > 1)
662                 memmove(fcall_list + 2, fcall_list + 1, (fcall_count - 1) * sizeof(NODE *)); 
663         fcall_list[1] = f;
664 }
665
666 static void
667 pop_frame()
668 {
669 #ifdef DEBUGGING
670         extern void frame_popped();
671 #endif
672         if (fcall_count > 1)
673                 memmove(fcall_list + 1, fcall_list + 2, (fcall_count - 1) * sizeof(NODE *)); 
674         fcall_count--;
675         assert(fcall_count >= 0);
676 #ifdef DEBUGGING
677         frame_popped();
678 #endif
679 }
680 #else   /* not PROFILING or DEBUGGING */
681 #define push_frame(p)   /* nothing */
682 #define pop_frame()             /* nothing */
683 #endif
684
685
686 #ifdef PROFILING
687
688 /* dump_fcall_stack --- print a backtrace of the awk function calls */
689
690 void
691 dump_fcall_stack(FILE *fp)
692 {
693         NODE *f, *func;
694         long i = 0;
695
696         if (fcall_count == 0)
697                 return;
698         fprintf(fp, _("\n\t# Function Call Stack:\n\n"));
699
700         /* current frame */
701         func = frame_ptr->func_node;
702         fprintf(fp, "\t# %3ld. %s\n", i, func->lnode->param);
703
704         /* outer frames except main */
705         for (i = 1; i < fcall_count; i++) {
706                 f = fcall_list[i];
707                 func = f->func_node;
708                 fprintf(fp, "\t# %3ld. %s\n", i, func->lnode->param);
709         }
710
711         fprintf(fp, "\t# %3ld. -- main --\n", fcall_count);
712 }
713
714 #endif /* PROFILING */
715
716 /* set_IGNORECASE --- update IGNORECASE as appropriate */
717
718 void
719 set_IGNORECASE()
720 {
721         static short warned = FALSE;
722
723         if ((do_lint || do_traditional) && ! warned) {
724                 warned = TRUE;
725                 lintwarn(_("`IGNORECASE' is a gawk extension"));
726         }
727         load_casetable();
728         if (do_traditional)
729                 IGNORECASE = FALSE;
730         else if ((IGNORECASE_node->var_value->flags & (STRING|STRCUR)) != 0) {
731                 if ((IGNORECASE_node->var_value->flags & MAYBE_NUM) == 0)
732                         IGNORECASE = (force_string(IGNORECASE_node->var_value)->stlen > 0);
733                 else
734                         IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
735         } else if ((IGNORECASE_node->var_value->flags & (NUMCUR|NUMBER)) != 0)
736                 IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
737         else
738                 IGNORECASE = FALSE;             /* shouldn't happen */
739                   
740         set_RS();       /* set_RS() calls set_FS() if need be, for us */
741 }
742
743 /* set_BINMODE --- set translation mode (OS/2, DOS, others) */
744
745 void
746 set_BINMODE()
747 {
748         static short warned = FALSE;
749         char *p;
750         NODE *v;
751
752         if ((do_lint || do_traditional) && ! warned) {
753                 warned = TRUE;
754                 lintwarn(_("`BINMODE' is a gawk extension"));
755         }
756         if (do_traditional)
757                 BINMODE = 0;
758         else if ((BINMODE_node->var_value->flags & NUMBER) != 0) {
759                 BINMODE = (int) force_number(BINMODE_node->var_value);
760                 /* Make sure the value is rational. */
761                 if (BINMODE < 0)
762                         BINMODE = 0;
763                 else if (BINMODE > 3)
764                         BINMODE = 3;
765         }
766         else if ((BINMODE_node->var_value->flags & STRING) != 0) {
767                 v = BINMODE_node->var_value;
768                 p = v->stptr;
769
770                 /*
771                  * Allow only one of the following:
772                  * "0", "1", "2", "3",
773                  * "r", "w", "rw", "wr"
774                  * ANYTHING ELSE goes to 3. So there.
775                  */
776                 switch (v->stlen) {
777                 case 1:
778                         switch (p[0]) {
779                         case '0':
780                         case '1':
781                         case '2':
782                         case '3':
783                                 BINMODE = p[0] - '0';
784                                 break;
785                         case 'r':
786                                 BINMODE = 1;
787                                 break;
788                         case 'w':
789                                 BINMODE = 2;
790                                 break;
791                         default:
792                                 BINMODE = 3;
793                                 goto bad_value;
794                                 break;
795                         }
796                         break;
797                 case 2:
798                         switch (p[0]) {
799                         case 'r':
800                                 BINMODE = 3;
801                                 if (p[1] != 'w')
802                                         goto bad_value;
803                                 break;
804                         case 'w':
805                                 BINMODE = 3;
806                                 if (p[1] != 'r')
807                                         goto bad_value;
808                                 break;
809                         break;
810                 default:
811         bad_value:
812                         lintwarn(_("BINMODE value `%s' is invalid, treated as 3"), p);
813                         break;
814                         }
815                 }
816         }
817         else
818                 BINMODE = 3;            /* shouldn't happen */
819 }
820
821 /* set_OFS --- update OFS related variables when OFS assigned to */
822
823 void
824 set_OFS()
825 {
826         OFS = force_string(OFS_node->var_value)->stptr;
827         OFSlen = OFS_node->var_value->stlen;
828         OFS[OFSlen] = '\0';
829 }
830
831 /* set_ORS --- update ORS related variables when ORS assigned to */
832
833 void
834 set_ORS()
835 {
836         ORS = force_string(ORS_node->var_value)->stptr;
837         ORSlen = ORS_node->var_value->stlen;
838         ORS[ORSlen] = '\0';
839 }
840
841 /* fmt_ok --- is the conversion format a valid one? */
842
843 NODE **fmt_list = NULL;
844 static int fmt_ok(NODE *n);
845 static int fmt_index(NODE *n);
846
847 static int
848 fmt_ok(NODE *n)
849 {
850         NODE *tmp = force_string(n);
851         const char *p = tmp->stptr;
852 #if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1
853         static const char float_formats[] = "efgEG";
854 #else
855         static const char float_formats[] = "efgEFG";
856 #endif
857 #if defined(HAVE_LOCALE_H)
858         static const char flags[] = " +-#'";
859 #else
860         static const char flags[] = " +-#";
861 #endif
862
863         if (*p++ != '%')
864                 return 0;
865         while (*p && strchr(flags, *p) != NULL) /* flags */
866                 p++;
867         while (*p && isdigit((unsigned char) *p))       /* width - %*.*g is NOT allowed */
868                 p++;
869         if (*p == '\0' || (*p != '.' && ! isdigit((unsigned char) *p)))
870                 return 0;
871         if (*p == '.')
872                 p++;
873         while (*p && isdigit((unsigned char) *p))       /* precision */
874                 p++;
875         if (*p == '\0' || strchr(float_formats, *p) == NULL)
876                 return 0;
877         if (*++p != '\0')
878                 return 0;
879         return 1;
880 }
881
882 /* fmt_index --- track values of OFMT and CONVFMT to keep semantics correct */
883
884 static int
885 fmt_index(NODE *n)
886 {
887         int ix = 0;
888         static int fmt_num = 4;
889         static int fmt_hiwater = 0;
890
891         if (fmt_list == NULL)
892                 emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
893         (void) force_string(n);
894         while (ix < fmt_hiwater) {
895                 if (cmp_nodes(fmt_list[ix], n) == 0)
896                         return ix;
897                 ix++;
898         }
899         /* not found */
900         n->stptr[n->stlen] = '\0';
901         if (do_lint && ! fmt_ok(n))
902                 lintwarn(_("bad `%sFMT' specification `%s'"),
903                             n == CONVFMT_node->var_value ? "CONV"
904                           : n == OFMT_node->var_value ? "O"
905                           : "", n->stptr);
906
907         if (fmt_hiwater >= fmt_num) {
908                 fmt_num *= 2;
909                 erealloc(fmt_list, NODE **, fmt_num * sizeof(*fmt_list), "fmt_index");
910         }
911         fmt_list[fmt_hiwater] = dupnode(n);
912         return fmt_hiwater++;
913 }
914
915 /* set_OFMT --- track OFMT correctly */
916
917 void
918 set_OFMT()
919 {
920         OFMTidx = fmt_index(OFMT_node->var_value);
921         OFMT = fmt_list[OFMTidx]->stptr;
922 }
923
924 /* set_CONVFMT --- track CONVFMT correctly */
925
926 void
927 set_CONVFMT()
928 {
929         CONVFMTidx = fmt_index(CONVFMT_node->var_value);
930         CONVFMT = fmt_list[CONVFMTidx]->stptr;
931 }
932
933 /* set_LINT --- update LINT as appropriate */
934
935 void
936 set_LINT()
937 {
938 #ifndef NO_LINT
939         int old_lint = do_lint;
940
941         if ((LINT_node->var_value->flags & (STRING|STRCUR)) != 0) {
942                 if ((LINT_node->var_value->flags & MAYBE_NUM) == 0) {
943                         const char *lintval;
944                         size_t lintlen;
945
946                         do_lint = (force_string(LINT_node->var_value)->stlen > 0);
947                         lintval = LINT_node->var_value->stptr;
948                         lintlen = LINT_node->var_value->stlen;
949                         if (do_lint) {
950                                 do_lint = LINT_ALL;
951                                 if (lintlen == 5 && strncmp(lintval, "fatal", 5) == 0)
952                                         lintfunc = r_fatal;
953                                 else if (lintlen == 7 && strncmp(lintval, "invalid", 7) == 0)
954                                         do_lint = LINT_INVALID;
955                                 else
956                                         lintfunc = warning;
957                         } else
958                                 lintfunc = warning;
959                 } else {
960                         if (force_number(LINT_node->var_value) != 0.0)
961                                 do_lint = LINT_ALL;
962                         else
963                                 do_lint = FALSE;
964                         lintfunc = warning;
965                 }
966         } else if ((LINT_node->var_value->flags & (NUMCUR|NUMBER)) != 0) {
967                 if (force_number(LINT_node->var_value) != 0.0)
968                         do_lint = LINT_ALL;
969                 else
970                         do_lint = FALSE;
971                 lintfunc = warning;
972         } else
973                 do_lint = FALSE;                /* shouldn't happen */
974
975         if (! do_lint)
976                 lintfunc = warning;
977
978         /* explicitly use warning() here, in case lintfunc == r_fatal */
979         if (old_lint != do_lint && old_lint && do_lint == FALSE)
980                 warning(_("turning off `--lint' due to assignment to `LINT'"));
981 #endif /* ! NO_LINT */
982 }
983
984 /* set_TEXTDOMAIN --- update TEXTDOMAIN variable when TEXTDOMAIN assigned to */
985
986 void
987 set_TEXTDOMAIN()
988 {
989         int len;
990
991         TEXTDOMAIN = force_string(TEXTDOMAIN_node->var_value)->stptr;
992         len = TEXTDOMAIN_node->var_value->stlen;
993         TEXTDOMAIN[len] = '\0';
994         /*
995          * Note: don't call textdomain(); this value is for
996          * the awk program, not for gawk itself.
997          */
998 }
999
1000 /* update_ERRNO_saved --- update the value of ERRNO based on argument */
1001
1002 void
1003 update_ERRNO_saved(int errcode)
1004 {
1005         char *cp;
1006
1007         if (errcode) {
1008                 cp = strerror(errcode);
1009                 cp = gettext(cp);
1010         } else
1011                 cp = "";
1012         unref(ERRNO_node->var_value);
1013         ERRNO_node->var_value = make_string(cp, strlen(cp));
1014 }
1015
1016 /* update_ERRNO --- update the value of ERRNO based on errno */
1017
1018 void
1019 update_ERRNO()
1020 {
1021         update_ERRNO_saved(errno);
1022 }
1023
1024 /* update_NR --- update the value of NR */
1025
1026 void
1027 update_NR()
1028 {
1029         if (NR_node->var_value->numbr != NR) {
1030                 unref(NR_node->var_value);
1031                 NR_node->var_value = make_number((AWKNUM) NR);
1032         }
1033 }
1034
1035 /* update_NF --- update the value of NF */
1036
1037 void
1038 update_NF()
1039 {
1040         if (NF == -1 || NF_node->var_value->numbr != NF) {
1041                 if (NF == -1)
1042                         (void) get_field(UNLIMITED - 1, NULL); /* parse record */
1043                 unref(NF_node->var_value);
1044                 NF_node->var_value = make_number((AWKNUM) NF);
1045         }
1046 }
1047
1048 /* update_FNR --- update the value of FNR */
1049
1050 void
1051 update_FNR()
1052 {
1053         if (FNR_node->var_value->numbr != FNR) {
1054                 unref(FNR_node->var_value);
1055                 FNR_node->var_value = make_number((AWKNUM) FNR);
1056         }
1057 }
1058
1059
1060
1061 NODE *frame_ptr;        /* current frame */
1062 STACK_ITEM *stack_ptr = NULL;
1063 STACK_ITEM *stack_bottom;
1064 STACK_ITEM *stack_top;
1065 static unsigned long STACK_SIZE = 256;    /* initial size of stack */
1066 int max_args = 0;       /* maximum # of arguments to printf, print, sprintf,
1067                          * or # of array subscripts, or adjacent strings     
1068                          * to be concatenated.
1069                          */
1070 NODE **args_array = NULL;
1071
1072 /* grow_stack --- grow the size of runtime stack */
1073
1074 /* N.B. stack_ptr points to the topmost occupied location
1075  *      on the stack, not the first free location.
1076  */
1077
1078 STACK_ITEM *
1079 grow_stack()
1080 {
1081         if (stack_ptr == NULL) {
1082                 char *val;
1083
1084                 if ((val = getenv("GAWK_STACKSIZE")) != NULL) {
1085                         if (isdigit((unsigned char) *val)) {
1086                                 unsigned long n = 0;
1087                                 for (; *val && isdigit((unsigned char) *val); val++)
1088                                         n = (n * 10) + *val - '0';
1089                                 if (n >= 1)
1090                                         STACK_SIZE = n;
1091                         }
1092                 }
1093
1094                 emalloc(stack_bottom, STACK_ITEM *, STACK_SIZE * sizeof(STACK_ITEM), "grow_stack");
1095                 stack_ptr = stack_bottom - 1;
1096                 stack_top = stack_bottom + STACK_SIZE - 1;
1097
1098                 /* initialize frame pointer */
1099                 getnode(frame_ptr);
1100                 frame_ptr->type = Node_frame;
1101                 frame_ptr->stack = NULL;
1102                 frame_ptr->func_node = NULL;    /* in main */
1103                 frame_ptr->vname = NULL;
1104                 return stack_ptr;
1105         }
1106
1107         STACK_SIZE *= 2;
1108         erealloc(stack_bottom, STACK_ITEM *, STACK_SIZE * sizeof(STACK_ITEM), "grow_stack");
1109         stack_top = stack_bottom + STACK_SIZE - 1;
1110         stack_ptr = stack_bottom + STACK_SIZE / 2;
1111         return stack_ptr;
1112 }
1113
1114 /*
1115  * r_get_lhs:
1116  * This returns a POINTER to a node pointer (var's value).
1117  * used to store the var's new value.
1118  */
1119
1120 NODE **
1121 r_get_lhs(NODE *n, int reference)
1122 {
1123         int isparam = FALSE;
1124
1125         if (n->type == Node_param_list) {
1126                 if ((n->flags & FUNC) != 0)
1127                         fatal(_("can't use function name `%s' as variable or array"),
1128                                         n->vname);
1129                 isparam = TRUE;
1130                 n = GET_PARAM(n->param_cnt);
1131         }
1132
1133         switch (n->type) {
1134         case Node_var_array:
1135                 fatal(_("attempt to use array `%s' in a scalar context"),
1136                                 array_vname(n));
1137         case Node_array_ref:
1138                 if (n->orig_array->type == Node_var_array)
1139                         fatal(_("attempt to use array `%s' in a scalar context"),
1140                                         array_vname(n));
1141                 n->orig_array->type = Node_var;
1142                 n->orig_array->var_value = Nnull_string;
1143                 /* fall through */
1144         case Node_var_new:
1145                 n->type = Node_var;
1146                 n->var_value = Nnull_string;
1147                 break;
1148
1149         case Node_var:
1150                 break;
1151
1152         default:
1153                 cant_happen();
1154         }
1155
1156         if (do_lint && reference && var_uninitialized(n))
1157                 lintwarn((isparam ?
1158                         _("reference to uninitialized argument `%s'") :
1159                         _("reference to uninitialized variable `%s'")),
1160                                 n->vname);
1161         return &n->var_value;
1162 }
1163
1164
1165 /* r_get_field --- get the address of a field node */
1166  
1167 static inline NODE **
1168 r_get_field(NODE *n, Func_ptr *assign, int reference)
1169 {
1170         long field_num;
1171         NODE **lhs;
1172
1173         if (assign)
1174                 *assign = NULL;
1175         if (do_lint) {
1176                 if ((n->flags & NUMBER) == 0) {
1177                         lintwarn(_("attempt to field reference from non-numeric value"));
1178                         if (n->stlen == 0)
1179                                 lintwarn(_("attempt to field reference from null string"));
1180                 }
1181         }
1182
1183         field_num = (long) force_number(n);
1184         if (field_num < 0)
1185                 fatal(_("attempt to access field %ld"), field_num);
1186
1187         if (field_num == 0 && field0_valid) {           /* short circuit */
1188                 lhs = &fields_arr[0];
1189                 if (assign)
1190                         *assign = reset_record;
1191         } else
1192                 lhs = get_field(field_num, assign);
1193         if (do_lint && reference && (*lhs == Null_field || *lhs == Nnull_string))
1194                 lintwarn(_("reference to uninitialized field `$%ld'"),
1195                               field_num);
1196         return lhs;
1197 }
1198
1199
1200 /*
1201  * calc_exp_posint --- calculate x^n for positive integral n,
1202  * using exponentiation by squaring without recursion.
1203  */
1204
1205 static AWKNUM
1206 calc_exp_posint(AWKNUM x, long n)
1207 {
1208         AWKNUM mult = 1;
1209
1210         while (n > 1) {
1211                 if ((n % 2) == 1)
1212                         mult *= x;
1213                 x *= x;
1214                 n /= 2;
1215         }
1216         return mult * x;
1217 }
1218
1219 /* calc_exp --- calculate x1^x2 */
1220
1221 AWKNUM
1222 calc_exp(AWKNUM x1, AWKNUM x2)
1223 {
1224         long lx;
1225
1226         if ((lx = x2) == x2) {          /* integer exponent */
1227                 if (lx == 0)
1228                         return 1;
1229                 return (lx > 0) ? calc_exp_posint(x1, lx)
1230                                 : 1.0 / calc_exp_posint(x1, -lx);
1231         }
1232         return (AWKNUM) pow((double) x1, (double) x2);
1233 }
1234
1235
1236 /* setup_frame --- setup new frame for function call */ 
1237
1238 static INSTRUCTION *
1239 setup_frame(INSTRUCTION *pc)
1240 {
1241         NODE *r = NULL;
1242         NODE *m;
1243         NODE *f;
1244         NODE **sp = NULL;
1245         char **varnames;
1246         int pcount, arg_count, i;
1247
1248         f = pc->func_body;
1249         pcount = f->lnode->param_cnt;
1250         varnames = f->parmlist;
1251         arg_count = (pc + 1)->expr_count;
1252
1253         /* check for extra args */ 
1254         if (arg_count > pcount) {
1255                 warning(
1256                         _("function `%s' called with more arguments than declared"),
1257                         f->vname);
1258                 do {
1259                         r = POP();
1260                         if (r->type == Node_val)
1261                                 DEREF(r);
1262                 } while (--arg_count > pcount);
1263         }
1264
1265         if (pcount > 0) {
1266                 emalloc(sp, NODE **, pcount * sizeof(NODE *), "setup_frame");
1267                 memset(sp, 0, pcount * sizeof(NODE *));
1268         }
1269
1270         for (i = 0; i < pcount; i++) {
1271                 getnode(r);
1272                 memset(r, 0, sizeof(NODE));
1273                 sp[i] = r;
1274                 if (i >= arg_count) {
1275                         /* local variable */
1276                         r->type = Node_var_new;
1277                         r->vname = varnames[i];
1278                         continue;
1279                 }
1280
1281                 m = PEEK(arg_count - i - 1); /* arguments in reverse order on runtime stack */
1282
1283                 if (m->type == Node_param_list)
1284                         m = GET_PARAM(m->param_cnt);
1285                         
1286                 switch (m->type) {
1287                 case Node_var_new:
1288                 case Node_var_array:
1289                         r->type = Node_array_ref;
1290                         r->orig_array = r->prev_array = m;
1291                         break;
1292
1293                 case Node_array_ref:
1294                         r->type = Node_array_ref;
1295                         r->orig_array = m->orig_array;
1296                         r->prev_array = m;
1297                         break;
1298
1299                 case Node_var:
1300                         /* Untyped (Node_var_new) variable as param became a
1301                          * scalar during evaluation of expression for a
1302                          * subsequent param.
1303                          */
1304                         r->type = Node_var;
1305                         r->var_value = Nnull_string;
1306                         break;
1307
1308                 case Node_val:
1309                         r->type = Node_var;
1310                         r->var_value = m;
1311                         break;
1312
1313                 default:
1314                         cant_happen();
1315                 }
1316                 r->vname = varnames[i];
1317         }
1318         stack_adj(-arg_count);  /* adjust stack pointer */
1319
1320         if (pc->opcode == Op_indirect_func_call) {
1321                 r = POP();      /* indirect var */
1322                 DEREF(r);
1323         }
1324
1325         frame_ptr->vname = source;      /* save current source */
1326
1327         push_frame(frame_ptr);
1328
1329         /* save current frame in stack */
1330         PUSH(frame_ptr);
1331
1332         /* setup new frame */
1333         getnode(frame_ptr);
1334         frame_ptr->type = Node_frame;   
1335         frame_ptr->stack = sp;
1336         frame_ptr->prev_frame_size = (stack_ptr - stack_bottom); /* size of the previous stack frame */
1337         frame_ptr->func_node = f;
1338         frame_ptr->vname = NULL;
1339         frame_ptr->reti = pc; /* on return execute pc->nexti */
1340
1341         return f->code_ptr;
1342 }
1343
1344
1345 /* restore_frame --- clean up the stack and update frame */
1346
1347 static INSTRUCTION *
1348 restore_frame(NODE *fp)
1349 {
1350         NODE *r;
1351         NODE **sp;
1352         int n;
1353         NODE *func;
1354         INSTRUCTION *ri;
1355
1356         func = frame_ptr->func_node;
1357         n = func->lnode->param_cnt;
1358         sp = frame_ptr->stack;
1359
1360         for (; n > 0; n--) {
1361                 r = *sp++;
1362                 if (r->type == Node_var)     /* local variable */
1363                         DEREF(r->var_value);
1364                 else if (r->type == Node_var_array)     /* local array */
1365                         assoc_clear(r);
1366                 freenode(r);
1367         }
1368         if (frame_ptr->stack != NULL)
1369                 efree(frame_ptr->stack);
1370         ri = frame_ptr->reti;     /* execution in calling frame
1371                                    * resumes from ri->nexti.
1372                                    */
1373         freenode(frame_ptr);
1374         pop_frame();
1375
1376         /* restore frame */
1377         frame_ptr = fp;
1378         /* restore source */
1379         source = fp->vname;
1380         fp->vname = NULL;
1381
1382         return ri->nexti;
1383 }
1384
1385
1386 /* free_arrayfor --- free 'for (var in array)' related data */
1387
1388 static inline void
1389 free_arrayfor(NODE *r)
1390 {
1391         if (r->var_array != NULL) {
1392                 size_t num_elems = r->table_size;
1393                 NODE **list = r->var_array;
1394                 while (num_elems > 0)
1395                         unref(list[--num_elems]);
1396                 efree(list);
1397         }
1398         freenode(r);
1399 }
1400
1401
1402 /* unwind_stack --- pop items off the run-time stack;
1403  *      'n' is the # of items left in the stack.
1404  */
1405
1406 INSTRUCTION *
1407 unwind_stack(long n)
1408 {
1409         NODE *r;
1410         INSTRUCTION *cp = NULL;
1411         STACK_ITEM *sp;
1412
1413         if (stack_empty())
1414                 return NULL;
1415
1416         sp = stack_bottom + n;
1417
1418         if (stack_ptr < sp)
1419                 return NULL;
1420
1421         while ((r = POP()) != NULL) {
1422                 switch (r->type) {
1423                 case Node_frame:
1424                         cp = restore_frame(r);
1425                         break;
1426                 case Node_arrayfor:
1427                         free_arrayfor(r);
1428                         break;
1429                 case Node_val:
1430                         DEREF(r);
1431                         break;
1432                 case Node_instruction:
1433                         freenode(r);
1434                         break;
1435                 default:
1436                         if (in_main_context())
1437                                 fatal(_("unwind_stack: unexpected type `%s'"),
1438                                                 nodetype2str(r->type));
1439                         /* else 
1440                                 * Node_var_array,
1441                                 * Node_param_list,
1442                                 * Node_var (e.g: trying to use scalar for array)
1443                                 * Node_regex/Node_dynregex
1444                                 * ?
1445                          */
1446                         break;
1447                 }
1448
1449                 if (stack_ptr < sp)
1450                         break;
1451         }
1452         return cp;
1453
1454
1455
1456 /* pop_fcall --- pop off the innermost frame */
1457 #define pop_fcall()     unwind_stack(frame_ptr->prev_frame_size)
1458
1459 /* pop the run-time stack */
1460 #define pop_stack()     (void) unwind_stack(0)
1461
1462
1463 /*
1464  * This generated compiler warnings from GCC 4.4. Who knows why.
1465  *
1466 #define eval_condition(t)       (((t)->flags & MAYBE_NUM) && force_number(t), \
1467                 ((t)->flags & NUMBER) ? ((t)->numbr != 0.0) : ((t)->stlen != 0))
1468 */
1469
1470
1471 static inline int
1472 eval_condition(NODE *t)
1473 {
1474         if ((t->flags & MAYBE_NUM) != 0)
1475                 force_number(t);
1476
1477         if ((t->flags & NUMBER) != 0)
1478                 return (t->numbr != 0.0);
1479
1480         return (t->stlen != 0);
1481 }
1482
1483 /* cmp_scalar -- compare two nodes on the stack */
1484
1485 static inline int
1486 cmp_scalar()
1487 {
1488         NODE *t1, *t2;
1489         int di;
1490
1491         t2 = POP_SCALAR();
1492         t1 = TOP();
1493         if (t1->type == Node_var_array) {
1494                 DEREF(t2);
1495                 fatal(_("attempt to use array `%s' in a scalar context"), array_vname(t1));
1496         }
1497         di = cmp_nodes(t1, t2);
1498         DEREF(t1);
1499         DEREF(t2);
1500         return di;
1501 }
1502
1503 /* op_assign --- assignment operators excluding = */
1504  
1505 static void
1506 op_assign(OPCODE op)
1507 {
1508         NODE **lhs;
1509         NODE *r = NULL;
1510         AWKNUM x1, x2;
1511 #ifndef HAVE_FMOD
1512         AWKNUM x;
1513 #endif
1514
1515         lhs = POP_ADDRESS();
1516         x1 = force_number(*lhs);
1517         TOP_NUMBER(x2);
1518         unref(*lhs);
1519         switch (op) {
1520         case Op_assign_plus:
1521                 r = *lhs = make_number(x1 + x2);
1522                 break;
1523         case Op_assign_minus:
1524                 r = *lhs = make_number(x1 - x2);
1525                 break;
1526         case Op_assign_times:
1527                 r = *lhs = make_number(x1 * x2);
1528                 break;
1529         case Op_assign_quotient:
1530                 if (x2 == (AWKNUM) 0) {
1531                         decr_sp();
1532                         fatal(_("division by zero attempted in `/='"));
1533                 }
1534                 r = *lhs = make_number(x1 / x2);
1535                 break;
1536         case Op_assign_mod:
1537                 if (x2 == (AWKNUM) 0) {
1538                         decr_sp();
1539                         fatal(_("division by zero attempted in `%%='"));
1540                 }
1541 #ifdef HAVE_FMOD
1542                 r = *lhs = make_number(fmod(x1, x2));
1543 #else   /* ! HAVE_FMOD */
1544                 (void) modf(x1 / x2, &x);
1545                 x = x1 - x2 * x;
1546                 r = *lhs = make_number(x);
1547 #endif  /* ! HAVE_FMOD */
1548                 break;
1549         case Op_assign_exp:
1550                 r = *lhs = make_number((AWKNUM) calc_exp((double) x1, (double) x2));
1551                 break;
1552         default:
1553                 break;
1554         }
1555
1556         UPREF(r);
1557         REPLACE(r);
1558 }
1559
1560
1561 /* PUSH_CODE --- push a code onto the runtime stack */
1562
1563 void
1564 PUSH_CODE(INSTRUCTION *cp)
1565 {
1566         NODE *r;
1567         getnode(r);
1568         r->type = Node_instruction;
1569         r->code_ptr = cp;
1570         PUSH(r);
1571 }
1572
1573 /* POP_CODE --- pop a code off the runtime stack */
1574
1575 INSTRUCTION *
1576 POP_CODE()
1577 {
1578         NODE *r;
1579         INSTRUCTION *cp;
1580         r = POP();
1581         cp = r->code_ptr;
1582         freenode(r);
1583         return cp;
1584 }
1585
1586
1587 /* Implementation of BEGINFILE and ENDFILE requires saving an execution
1588  * state and the ability to return to that state. The state is
1589  * defined by the instruction triggering the BEGINFILE/ENDFILE rule, the
1590  * run-time stack, the rule and the source file. The source line is available in
1591  * the instruction and hence is not considered a part of the execution state.
1592  */
1593
1594
1595 typedef struct exec_state {
1596         struct exec_state *next;
1597
1598         INSTRUCTION *cptr;  /* either getline (Op_K_getline) or the 
1599                              * implicit "open-file, read-record" loop (Op_newfile).
1600                              */ 
1601
1602         int rule;           /* rule for the INSTRUCTION */
1603
1604         long stack_size;    /* For this particular usage, it is sufficient to save
1605                              * only the size of the call stack. We do not
1606                              * store the actual stack pointer to avoid problems
1607                              * in case the stack gets realloc-ed.
1608                              */
1609
1610         const char *source; /* source file for the INSTRUCTION */
1611 } EXEC_STATE;
1612
1613 static EXEC_STATE exec_state_stack;
1614
1615 /* push_exec_state --- save an execution state on stack */
1616
1617 static void
1618 push_exec_state(INSTRUCTION *cp, int rule, char *src, STACK_ITEM *sp)
1619 {
1620         EXEC_STATE *es;
1621
1622         emalloc(es, EXEC_STATE *, sizeof(EXEC_STATE), "push_exec_state");
1623         es->rule = rule;
1624         es->cptr = cp;
1625         es->stack_size = (sp - stack_bottom) + 1;
1626         es->source = src;
1627         es->next = exec_state_stack.next;
1628         exec_state_stack.next = es;
1629 }
1630
1631
1632 /* pop_exec_state --- pop one execution state off the stack */
1633
1634 static INSTRUCTION *
1635 pop_exec_state(int *rule, char **src, long *sz)
1636 {
1637         INSTRUCTION *cp;
1638         EXEC_STATE *es;
1639
1640         es = exec_state_stack.next;
1641         if (es == NULL)
1642                 return NULL;
1643         cp = es->cptr;
1644         if (rule != NULL)
1645                 *rule = es->rule;
1646         if (src != NULL)
1647                 *src = (char *) es->source;
1648         if (sz != NULL)
1649                 *sz = es->stack_size;
1650         exec_state_stack.next = es->next;
1651         efree(es);
1652         return cp;
1653 }
1654
1655
1656 /*
1657  * r_interpret:
1658  *   code is a list of instructions to run. returns the exit value
1659  *       from the awk code.
1660  */
1661  
1662  /* N.B.:
1663  *   1) reference counting done for both number and string values.
1664  *   2) TEMP flag no longer needed (consequence of the above; valref = 0
1665  *      is the replacement).
1666  *   3) Stack operations:
1667  *       Use REPLACE[_XX] if last stack operation was TOP[_XX],
1668  *       PUSH[_XX] if last operation was POP[_XX] instead. 
1669  *   4) UPREF and DREF -- see awk.h 
1670  */
1671
1672
1673 int
1674 r_interpret(INSTRUCTION *code)
1675 {
1676         INSTRUCTION *pc;   /* current instruction */
1677         NODE *r = NULL;
1678         NODE *m;
1679         INSTRUCTION *ni;
1680         NODE *t1, *t2;
1681         NODE *f;        /* function definition */
1682         NODE **lhs;
1683         AWKNUM x, x1, x2;
1684         int di, pre = FALSE;
1685         Regexp *rp;
1686 #if defined(GAWKDEBUG) || defined(ARRAYDEBUG)
1687         int last_was_stopme = FALSE;    /* builtin stopme() called ? */
1688 #endif
1689         int stdio_problem = FALSE;
1690
1691
1692         if (args_array == NULL)
1693                 emalloc(args_array, NODE **, (max_args + 2)*sizeof(NODE *), "r_interpret");
1694         else
1695                 erealloc(args_array, NODE **, (max_args + 2)*sizeof(NODE *), "r_interpret");
1696
1697 /* array subscript */
1698 #define mk_sub(n)       (n == 1 ? POP_STRING() : concat_exp(n, TRUE))
1699
1700 #ifdef DEBUGGING
1701 #define JUMPTO(x)       do { post_execute(pc); pc = (x); goto top; } while(FALSE)
1702 #else
1703 #define JUMPTO(x)       do { pc = (x); goto top; } while(FALSE)
1704 #endif
1705
1706         pc = code;
1707
1708         /* N.B.: always use JUMPTO for next instruction, otherwise bad things
1709          * may happen. DO NOT add a real loop (for/while) below to
1710          * replace ' forever {'; this catches failure to use JUMPTO to execute
1711          * next instruction (e.g. continue statement).
1712          */
1713
1714         /* loop until hit Op_stop instruction */
1715
1716         /* forever {  */
1717 top:
1718                 if (pc->source_line > 0)
1719                         sourceline = pc->source_line;
1720
1721 #ifdef DEBUGGING
1722                 if (! pre_execute(&pc))
1723                         goto top;
1724 #endif
1725
1726                 switch (pc->opcode) {
1727                 case Op_rule:
1728                         currule = pc->in_rule;   /* for sole use in Op_K_next, Op_K_nextfile, Op_K_getline* */
1729                         /* fall through */
1730                 case Op_func:
1731                 case Op_ext_func:
1732                         source = pc->source_file;
1733                         break;
1734
1735                 case Op_atexit:
1736                         /* avoid false source indications */
1737                         source = NULL;
1738                         sourceline = 0;
1739                         (void) nextfile(&curfile, TRUE);        /* close input data file */ 
1740                         /*
1741                          * This used to be:
1742                          *
1743                          * if (close_io() != 0 && ! exiting && exit_val == 0)
1744                          *      exit_val = 1;
1745                          *
1746                          * Other awks don't care about problems closing open files
1747                          * and pipes, in that it doesn't affect their exit status.
1748                          * So we no longer do either.
1749                          */
1750                         (void) close_io(& stdio_problem);
1751                         /*
1752                          * However, we do want to exit non-zero if there was a problem
1753                          * with stdout/stderr, so we reinstate a slightly different
1754                          * version of the above:
1755                          */
1756                         if (stdio_problem && ! exiting && exit_val == 0)
1757                                 exit_val = 1;
1758                         break;
1759
1760                 case Op_stop:
1761                         return 0;
1762
1763                 case Op_push_i:
1764                         m = pc->memory;
1765                         PUSH((m->flags & INTLSTR) != 0 ? format_val(CONVFMT, CONVFMTidx, m): m);
1766                         break;
1767
1768                 case Op_push:
1769                 case Op_push_arg:
1770                 {
1771                         NODE *save_symbol;
1772                         int isparam = FALSE;
1773
1774                         save_symbol = m = pc->memory;
1775                         if (m->type == Node_param_list) {
1776                                 if ((m->flags & FUNC) != 0)
1777                                         fatal(_("can't use function name `%s' as variable or array"),
1778                                                         m->vname);
1779                                 isparam = TRUE;
1780                                 save_symbol = m = GET_PARAM(m->param_cnt);
1781                                 if (m->type == Node_array_ref)
1782                                         m = m->orig_array;
1783                         }
1784                                 
1785                         switch (m->type) {
1786                         case Node_var:
1787                                 if (do_lint && var_uninitialized(m))
1788                                         lintwarn(isparam ?
1789                                                 _("reference to uninitialized argument `%s'") :
1790                                                 _("reference to uninitialized variable `%s'"),
1791                                                                 save_symbol->vname);
1792                                 m = m->var_value;
1793                                 UPREF(m);
1794                                 PUSH(m);
1795                                 break;
1796
1797                         case Node_var_new:
1798                                 m->type = Node_var;
1799                                 m->var_value = Nnull_string;
1800                                 if (do_lint)
1801                                         lintwarn(isparam ?
1802                                                 _("reference to uninitialized argument `%s'") :
1803                                                 _("reference to uninitialized variable `%s'"),
1804                                                                 save_symbol->vname);
1805                                 PUSH(Nnull_string);
1806                                 break;
1807
1808                         case Node_var_array:
1809                                 if (pc->opcode == Op_push_arg)
1810                                         PUSH(m);
1811                                 else
1812                                         fatal(_("attempt to use array `%s' in a scalar context"),
1813                                                         array_vname(save_symbol));
1814                                 break;
1815
1816                         default:
1817                                 cant_happen();
1818                         }
1819                 }
1820                         break;  
1821
1822                 case Op_push_param:             /* function argument */
1823                         m = pc->memory;
1824                         if (m->type == Node_param_list)
1825                                 m = GET_PARAM(m->param_cnt);
1826                         if (m->type == Node_var) {
1827                                 m = m->var_value;
1828                                 UPREF(m);
1829                                 PUSH(m);
1830                                 break;
1831                         }
1832                         /* else
1833                                 fall through */
1834                 case Op_push_array:
1835                         PUSH(pc->memory);
1836                         break;
1837
1838                 case Op_push_lhs:
1839                         lhs = get_lhs(pc->memory, pc->do_reference);
1840                         PUSH_ADDRESS(lhs);
1841                         break;
1842
1843                 case Op_subscript:
1844                         t2 = mk_sub(pc->sub_count);
1845                         t1 = POP_ARRAY();
1846                         r = *assoc_lookup(t1, t2, TRUE);
1847                         DEREF(t2);
1848                         if (r->type == Node_val)
1849                                 UPREF(r);
1850                         PUSH(r);
1851                         break;
1852
1853                 case Op_sub_array:
1854                         t2 = mk_sub(pc->sub_count);
1855                         t1 = POP_ARRAY();
1856                         r = in_array(t1, t2);
1857                         if (r == NULL) {
1858                                 getnode(r);
1859                                 r->type = Node_var_array;
1860                                 r->var_array = NULL;
1861                                 r->vname = estrdup(t2->stptr, t2->stlen);       /* the subscript in parent array */
1862                                 r->parent_array = t1;
1863                                 *assoc_lookup(t1, t2, FALSE) = r;
1864                         } else if (r->type != Node_var_array)
1865                                 fatal(_("attempt to use scalar `%s[\"%.*s\"]' as an array"),
1866                                                 array_vname(t1), (int) t2->stlen, t2->stptr);
1867                         DEREF(t2);
1868                         PUSH(r);
1869                         break;
1870
1871                 case Op_subscript_lhs:
1872                         t2 = mk_sub(pc->sub_count);
1873                         t1 = POP_ARRAY();
1874                         lhs = assoc_lookup(t1, t2, pc->do_reference);
1875                         if ((*lhs)->type == Node_var_array)
1876                                 fatal(_("attempt to use array `%s[\"%.*s\"]' in a scalar context"),
1877                                                 array_vname(t1), (int) t2->stlen, t2->stptr);
1878                         DEREF(t2);
1879                         PUSH_ADDRESS(lhs);
1880                         break;
1881
1882                 case Op_field_spec:
1883                         t1 = TOP_SCALAR();
1884                         lhs = r_get_field(t1, (Func_ptr *) 0, TRUE);
1885                         decr_sp();
1886                         DEREF(t1);
1887                         /* This used to look like this:
1888                             PUSH(dupnode(*lhs));
1889                            but was changed to bypass an apparent bug in the z/OS C compiler.
1890                            Please do not remerge.  */
1891                         r = dupnode(*lhs);     /* can't use UPREF here */
1892                         PUSH(r);
1893                         break;
1894
1895                 case Op_field_spec_lhs:
1896                         t1 = TOP_SCALAR();
1897                         lhs = r_get_field(t1, &pc->target_assign->field_assign, pc->do_reference);
1898                         decr_sp();
1899                         DEREF(t1);
1900                         PUSH_ADDRESS(lhs);
1901                         break;
1902
1903                 case Op_lint:
1904                         if (do_lint) {
1905                                 switch (pc->lint_type) {
1906                                 case LINT_assign_in_cond:
1907                                         lintwarn(_("assignment used in conditional context"));
1908                                         break;
1909
1910                                 case LINT_no_effect:
1911                                         lintwarn(_("statement has no effect"));
1912                                         break;
1913
1914                                 default:
1915                                         cant_happen();
1916                                 }
1917                         }
1918                         break;
1919
1920                 case Op_K_break:
1921                 case Op_K_continue:
1922                 case Op_jmp:
1923                         JUMPTO(pc->target_jmp);
1924
1925                 case Op_jmp_false:
1926                         r = POP_SCALAR();
1927                         di = eval_condition(r);
1928                         DEREF(r);
1929                         if (! di)
1930                                 JUMPTO(pc->target_jmp);
1931                         break;
1932
1933                 case Op_jmp_true:
1934                         r = POP_SCALAR();
1935                         di = eval_condition(r);
1936                         DEREF(r);                       
1937                         if (di)
1938                                 JUMPTO(pc->target_jmp);
1939                         break;
1940
1941                 case Op_and:
1942                 case Op_or:
1943                         t1 = POP_SCALAR();
1944                         di = eval_condition(t1);
1945                         DEREF(t1);
1946                         if ((pc->opcode == Op_and && di)
1947                                         || (pc->opcode == Op_or && ! di))
1948                                 break;
1949                         r = make_number((AWKNUM) di);
1950                         PUSH(r);
1951                         ni = pc->target_jmp;
1952                         JUMPTO(ni->nexti);
1953
1954                 case Op_and_final:
1955                 case Op_or_final:
1956                         t1 = TOP_SCALAR();
1957                         r = make_number((AWKNUM) eval_condition(t1));
1958                         DEREF(t1);
1959                         REPLACE(r);
1960                         break;
1961
1962                 case Op_not:
1963                         t1 = TOP_SCALAR(); 
1964                         r = make_number((AWKNUM) ! eval_condition(t1));
1965                         DEREF(t1);
1966                         REPLACE(r);
1967                         break;
1968
1969                 case Op_equal:
1970                         r = make_number((AWKNUM) (cmp_scalar() == 0));
1971                         REPLACE(r);
1972                         break;
1973
1974                 case Op_notequal:
1975                         r = make_number((AWKNUM) (cmp_scalar() != 0));
1976                         REPLACE(r);
1977                         break;
1978
1979                 case Op_less:
1980                         r = make_number((AWKNUM) (cmp_scalar() < 0));
1981                         REPLACE(r);
1982                         break;
1983
1984                 case Op_greater:
1985                         r = make_number((AWKNUM) (cmp_scalar() > 0));
1986                         REPLACE(r);
1987                         break;
1988
1989                 case Op_leq:
1990                         r = make_number((AWKNUM) (cmp_scalar() <= 0));
1991                         REPLACE(r);
1992                         break;
1993
1994                 case Op_geq:
1995                         r = make_number((AWKNUM) (cmp_scalar() >= 0));
1996                         REPLACE(r);
1997                         break;
1998
1999                 case Op_plus_i:
2000                         x2 = force_number(pc->memory);
2001                         goto plus;
2002
2003                 case Op_plus:
2004                         POP_NUMBER(x2);
2005 plus:
2006                         TOP_NUMBER(x1);
2007                         r = make_number(x1 + x2);
2008                         REPLACE(r);
2009                         break;
2010
2011                 case Op_minus_i:
2012                         x2 = force_number(pc->memory);
2013                         goto minus;
2014
2015                 case Op_minus:
2016                         POP_NUMBER(x2);
2017 minus:
2018                         TOP_NUMBER(x1);
2019                         r = make_number(x1 - x2);
2020                         REPLACE(r);
2021                         break;
2022
2023                 case Op_times_i:
2024                         x2 = force_number(pc->memory);
2025                         goto times;
2026
2027                 case Op_times:
2028                         POP_NUMBER(x2);
2029 times:
2030                         TOP_NUMBER(x1);
2031                         r = make_number(x1 * x2);
2032                         REPLACE(r);
2033                         break;
2034
2035                 case Op_exp_i:
2036                         x2 = force_number(pc->memory);
2037                         goto exponent;
2038
2039                 case Op_exp:
2040                         POP_NUMBER(x2);
2041 exponent:
2042                         TOP_NUMBER(x1);
2043                         x = calc_exp(x1, x2);
2044                         r = make_number(x);
2045                         REPLACE(r);
2046                         break;
2047
2048                 case Op_quotient_i:
2049                         x2 = force_number(pc->memory);
2050                         goto quotient;
2051
2052                 case Op_quotient:
2053                         POP_NUMBER(x2);
2054 quotient:
2055                         if (x2 == 0)
2056                                 fatal(_("division by zero attempted"));
2057
2058                         TOP_NUMBER(x1);
2059                         x = x1 / x2;
2060                         r = make_number(x);
2061                         REPLACE(r);
2062                         break;          
2063
2064                 case Op_mod_i:
2065                         x2 = force_number(pc->memory);
2066                         goto mod;
2067
2068                 case Op_mod:
2069                         POP_NUMBER(x2);
2070 mod:
2071                         if (x2 == 0)
2072                                 fatal(_("division by zero attempted in `%%'"));
2073
2074                         TOP_NUMBER(x1);
2075 #ifdef HAVE_FMOD
2076                         x = fmod(x1, x2);
2077 #else   /* ! HAVE_FMOD */
2078                         (void) modf(x1 / x2, &x);
2079                         x = x1 - x * x2;
2080 #endif  /* ! HAVE_FMOD */
2081                         r = make_number(x);
2082                         REPLACE(r);
2083                         break;          
2084
2085                 case Op_preincrement:
2086                         pre = TRUE;
2087                 case Op_postincrement:
2088                         x2 = 1.0;
2089 post:
2090                         lhs = TOP_ADDRESS();
2091                         x1 = force_number(*lhs);
2092                         unref(*lhs);
2093                         r = *lhs = make_number(x1 + x2);
2094                         if (pre)
2095                                 UPREF(r);
2096                         else
2097                                 r = make_number(x1);
2098                         REPLACE(r);
2099                         pre = FALSE;
2100                         break;                  
2101
2102                 case Op_predecrement:
2103                         pre = TRUE;
2104                 case Op_postdecrement:
2105                         x2 = -1.0;
2106                         goto post;                                      
2107
2108                 case Op_unary_minus:
2109                         TOP_NUMBER(x1);
2110                         r = make_number(-x1);
2111                         REPLACE(r);
2112                         break;
2113
2114                 case Op_store_sub:
2115                         /* array[sub] assignment optimization,
2116                          * see awkgram.y (optimize_assignment)
2117                          */
2118                         t1 = get_array(pc->memory, TRUE);       /* array */
2119                         t2 = mk_sub(pc->expr_count);    /* subscript */
2120                         lhs = assoc_lookup(t1, t2, FALSE);
2121                         if ((*lhs)->type == Node_var_array)
2122                                 fatal(_("attempt to use array `%s[\"%.*s\"]' in a scalar context"),
2123                                                 array_vname(t1), (int) t2->stlen, t2->stptr);
2124                         DEREF(t2);
2125                         unref(*lhs);
2126                         *lhs = POP_SCALAR();
2127                         break;
2128
2129                 case Op_store_var:
2130                         /* simple variable assignment optimization,
2131                          * see awkgram.y (optimize_assignment)
2132                          */
2133         
2134                         lhs = get_lhs(pc->memory, FALSE);
2135                         unref(*lhs);
2136                         *lhs = POP_SCALAR();
2137                         break;
2138
2139                 case Op_store_field:
2140                 {
2141                         /* field assignment optimization,
2142                          * see awkgram.y (optimize_assignment)
2143                          */
2144
2145                         Func_ptr assign;
2146                         t1 = TOP_SCALAR();
2147                         lhs = r_get_field(t1, &assign, FALSE);
2148                         decr_sp();
2149                         DEREF(t1);
2150                         unref(*lhs);
2151                         *lhs = POP_SCALAR();
2152                         assert(assign != NULL);
2153                         assign();
2154                 }
2155                         break;
2156
2157                 case Op_assign_concat:
2158                         /* x = x ... string concatenation optimization */
2159                         lhs = get_lhs(pc->memory, FALSE);
2160                         t1 = force_string(*lhs);
2161                         t2 = POP_STRING();
2162
2163                         free_wstr(*lhs);
2164
2165                         if (t1 != t2 && t1->valref == 1 && (t1->flags & PERM) == 0) {
2166                                 size_t nlen = t1->stlen + t2->stlen;
2167                                 erealloc(t1->stptr, char *, nlen + 2, "r_interpret");
2168                                 memcpy(t1->stptr + t1->stlen, t2->stptr, t2->stlen);
2169                                 t1->stlen = nlen;
2170                                 t1->stptr[nlen] = '\0';
2171                         } else {
2172                                 size_t nlen = t1->stlen + t2->stlen;  
2173                                 char *p;
2174
2175                                 emalloc(p, char *, nlen + 2, "r_interpret");
2176                                 memcpy(p, t1->stptr, t1->stlen);
2177                                 memcpy(p + t1->stlen, t2->stptr, t2->stlen);
2178                                 unref(*lhs);
2179                                 t1 = *lhs = make_str_node(p, nlen,  ALREADY_MALLOCED); 
2180                         }
2181                         t1->flags &= ~(NUMCUR|NUMBER);
2182                         DEREF(t2);
2183                         break;
2184
2185                 case Op_assign:
2186                         lhs = POP_ADDRESS();
2187                         r = TOP_SCALAR();
2188                         unref(*lhs);
2189                         *lhs = r;
2190                         UPREF(r);
2191                         REPLACE(r);
2192                         break;
2193
2194                 /* numeric assignments */
2195                 case Op_assign_plus:
2196                 case Op_assign_minus:
2197                 case Op_assign_times:
2198                 case Op_assign_quotient:
2199                 case Op_assign_mod:
2200                 case Op_assign_exp:
2201                         op_assign(pc->opcode);
2202                         break;
2203
2204                 case Op_var_update:        /* update value of NR, FNR or NF */
2205                         pc->update_var();
2206                         break;
2207
2208                 case Op_var_assign:
2209                 case Op_field_assign:
2210                         if (pc->assign_ctxt == Op_sub_builtin
2211                                 && TOP()->numbr == 0.0  /* top of stack has a number == 0 */
2212                         ) {
2213                                 /* There wasn't any substitutions. If the target is a FIELD,
2214                                  * this means no field re-splitting or $0 reconstruction.
2215                                  * Skip the set_FOO routine if the target is a special variable.
2216                                  */
2217
2218                                 break;
2219                         } else if ((pc->assign_ctxt == Op_K_getline
2220                                         || pc->assign_ctxt == Op_K_getline_redir)
2221                                 && TOP()->numbr <= 0.0  /* top of stack has a number <= 0 */
2222                         ) {
2223                                 /* getline returned EOF or error */
2224
2225                                 break;
2226                         }
2227
2228                         if (pc->opcode == Op_var_assign)
2229                                 pc->assign_var();
2230                         else
2231                                 pc->field_assign();
2232                         break;
2233
2234                 case Op_concat:
2235                         r = concat_exp(pc->expr_count, pc->concat_flag & CSUBSEP);
2236                         PUSH(r);
2237                         break;
2238
2239                 case Op_K_case:
2240                         if ((pc + 1)->match_exp) {
2241                                 /* match a constant regex against switch expression instead of $0. */
2242                                 m = POP();      /* regex */
2243                                 t2 = TOP_SCALAR();      /* switch expression */
2244                                 (void) force_string(t2);
2245                                 rp = re_update(m);
2246                                 di = (research(rp, t2->stptr, 0, t2->stlen,
2247                                                         avoid_dfa(m, t2->stptr, t2->stlen)) >= 0);
2248                         } else {
2249                                 t1 = POP_SCALAR();      /* case value */
2250                                 t2 = TOP_SCALAR();      /* switch expression */
2251                                 di = (cmp_nodes(t2, t1) == 0);
2252                                 DEREF(t1);
2253                         }
2254
2255                         if (di) {       /* match found */
2256                                 decr_sp();
2257                                 DEREF(t2);
2258                                 JUMPTO(pc->target_jmp);
2259                         }
2260                         break;
2261
2262                 case Op_K_delete:
2263                         t1 = POP_ARRAY();
2264                         do_delete(t1, pc->expr_count);
2265                         stack_adj(-pc->expr_count);
2266                         break;
2267
2268                 case Op_K_delete_loop:
2269                         t1 = POP_ARRAY();
2270                         lhs = POP_ADDRESS();    /* item */
2271                         do_delete_loop(t1, lhs);
2272                         break;
2273
2274                 case Op_in_array:
2275                         t1 = POP_ARRAY();
2276                         t2 = mk_sub(pc->expr_count);
2277                         di = (in_array(t1, t2) != NULL);
2278                         DEREF(t2);
2279                         PUSH(make_number((AWKNUM) di));
2280                         break;
2281
2282                 case Op_arrayfor_init:
2283                 {
2284                         NODE **list = NULL;
2285                         NODE *array, *sort_str;
2286                         size_t num_elems = 0;
2287                         static NODE *sorted_in = NULL;
2288                         const char *how_to_sort = "@unsorted";
2289
2290                         /* get the array */
2291                         array = POP_ARRAY();
2292
2293                         /* sanity: check if empty */
2294                         if (array->var_array == NULL || array->table_size == 0)
2295                                 goto arrayfor;
2296
2297                         num_elems = array->table_size;
2298
2299                         if (sorted_in == NULL)          /* do this once */
2300                                 sorted_in = make_string("sorted_in", 9);
2301
2302                         sort_str = NULL;
2303                         /*
2304                          * If posix, or if there's no PROCINFO[],
2305                          * there's no ["sorted_in"], so no sorting
2306                          */
2307                         if (! do_posix && PROCINFO_node != NULL)
2308                                 sort_str = in_array(PROCINFO_node, sorted_in);
2309
2310                         if (sort_str != NULL) {
2311                                 sort_str = force_string(sort_str);
2312                                 if (sort_str->stlen > 0)
2313                                         how_to_sort = sort_str->stptr;
2314                         }
2315
2316                         list = assoc_list(array, how_to_sort, SORTED_IN);
2317
2318                         /*
2319                          * Actual array for use in lint warning
2320                          * in Op_arrayfor_incr
2321                          */
2322                         list[num_elems] = array;
2323
2324 arrayfor:
2325                         getnode(r);
2326                         r->type = Node_arrayfor;
2327                         r->var_array = list;
2328                         r->table_size = num_elems;     /* # of elements in list */
2329                         r->array_size = -1;            /* current index */
2330                         PUSH(r);
2331
2332                         if (num_elems == 0)
2333                                 JUMPTO(pc->target_jmp);   /* Op_arrayfor_final */
2334                 }
2335                         break;
2336
2337                 case Op_arrayfor_incr:
2338                         r = TOP();      /* Node_arrayfor */
2339                         if (++r->array_size == r->table_size) {
2340                                 NODE *array;
2341                                 array = r->var_array[r->table_size];    /* actual array */
2342                                 if (do_lint && array->table_size != r->table_size)
2343                                         lintwarn(_("for loop: array `%s' changed size from %ld to %ld during loop execution"),
2344                                                 array_vname(array), (long) r->table_size, (long) array->table_size);
2345                                 JUMPTO(pc->target_jmp); /* Op_arrayfor_final */
2346                         }
2347
2348                         t1 = r->var_array[r->array_size];
2349                         lhs = get_lhs(pc->array_var, FALSE);
2350                         unref(*lhs);
2351                         *lhs = make_string(t1->ahname_str, t1->ahname_len);
2352                         break;                   
2353
2354                 case Op_arrayfor_final:
2355                         r = POP();
2356                         assert(r->type == Node_arrayfor);
2357                         free_arrayfor(r);
2358                         break;
2359
2360                 case Op_builtin:
2361                         r = pc->builtin(pc->expr_count);
2362 #if defined(GAWKDEBUG) || defined(ARRAYDEBUG)
2363                         if (! r)
2364                                 last_was_stopme = TRUE;
2365                         else
2366 #endif
2367                                 PUSH(r);
2368                         break;
2369
2370                 case Op_sub_builtin:    /* sub, gsub and gensub */
2371                         r = do_sub(pc->expr_count, pc->sub_flags);
2372                         PUSH(r);
2373                         break;
2374
2375                 case Op_K_print:
2376                         do_print(pc->expr_count, pc->redir_type);
2377                         break;
2378
2379                 case Op_K_printf:
2380                         do_printf(pc->expr_count, pc->redir_type);
2381                         break;
2382
2383                 case Op_K_print_rec:
2384                         do_print_rec(pc->expr_count, pc->redir_type);
2385                         break;
2386
2387                 case Op_push_re:
2388                         m = pc->memory;
2389                         if (m->type == Node_dynregex) {
2390                                 r = POP_STRING();
2391                                 unref(m->re_exp);
2392                                 m->re_exp = r;
2393                         }
2394                         PUSH(m);
2395                         break;
2396                         
2397                 case Op_match_rec:
2398                         m = pc->memory;
2399                         t1 = *get_field(0, (Func_ptr *) 0);
2400 match_re:
2401                         rp = re_update(m);
2402                         /*
2403                          * Any place where research() is called with a last parameter of
2404                          * zero, we need to use the avoid_dfa test. This appears here and
2405                          * in the code for Op_K_case.
2406                          *
2407                          * A new or improved dfa that distinguishes beginning/end of
2408                          * string from beginning/end of line will allow us to get rid of
2409                          * this hack.
2410                          *
2411                          * The avoid_dfa() function is in re.c; it is not very smart.
2412                          */
2413
2414                         di = research(rp, t1->stptr, 0, t1->stlen,
2415                                                                 avoid_dfa(m, t1->stptr, t1->stlen));
2416                         di = (di == -1) ^ (pc->opcode != Op_nomatch);
2417                         if(pc->opcode != Op_match_rec) {
2418                                 decr_sp();
2419                                 DEREF(t1);
2420                         }
2421                         r = make_number((AWKNUM) di);
2422                         PUSH(r);
2423                         break;
2424
2425                 case Op_nomatch:
2426                         /* fall through */
2427                 case Op_match:
2428                         m = pc->memory;
2429                         t1 = TOP_STRING();
2430                         if (m->type == Node_dynregex) {
2431                                 unref(m->re_exp);
2432                                 m->re_exp = t1;
2433                                 decr_sp();
2434                                 t1 = TOP_STRING();
2435                         }
2436                         goto match_re;
2437                         break;
2438
2439                 case Op_indirect_func_call:
2440                 {
2441                         int arg_count;
2442
2443                         f = NULL;
2444                         arg_count = (pc + 1)->expr_count;
2445                         t1 = PEEK(arg_count);   /* indirect var */
2446                         assert(t1->type == Node_val);   /* @a[1](p) not allowed in grammar */
2447                         (void) force_string(t1);
2448                         if (t1->stlen > 0) {
2449                                 /* retrieve function definition node */
2450                                 f = pc->func_body;
2451                                 if (f != NULL && strcmp(f->vname, t1->stptr) == 0)
2452                                         /* indirect var hasn't been reassigned */
2453                                         goto func_call;
2454                                 f = lookup(t1->stptr);
2455                         }
2456
2457                         if (f == NULL || f->type != Node_func)
2458                                 fatal(_("function called indirectly through `%s' does not exist"), pc->func_name);      
2459                         pc->func_body = f;     /* save for next call */
2460
2461                         goto func_call;
2462                 }
2463
2464                 case Op_func_call:
2465                         /* retrieve function definition node */
2466                         f = pc->func_body;
2467                         if (f == NULL) {
2468                                 f = lookup(pc->func_name);
2469                                 if (f == NULL || f->type != Node_func)
2470                                         fatal(_("function `%s' not defined"), pc->func_name);
2471                                 pc->func_body = f;     /* save for next call */
2472                         }
2473
2474                         /* save current frame along with source */
2475
2476 func_call:
2477                         ni = setup_frame(pc);
2478                                                 
2479                         if (ni->opcode == Op_ext_func) {
2480                                 /* dynamically set source and line numbers for an extension builtin. */
2481                                 ni->source_file = source;
2482                                 ni->source_line = sourceline;
2483                                 ni->nexti->source_line = sourceline;    /* Op_builtin */
2484                                 ni->nexti->nexti->source_line = sourceline;     /* Op_K_return */
2485                         }
2486
2487                         /* run the function instructions */
2488                         JUMPTO(ni);             /* Op_func or Op_ext_func */
2489
2490                 case Op_K_return:
2491                         m = POP_SCALAR();       /* return value */
2492
2493                         ni = pop_fcall();
2494         
2495                         /* put the return value back on stack */
2496                         PUSH(m);
2497
2498                         JUMPTO(ni);
2499
2500                 case Op_K_getline_redir:
2501                         if ((currule == BEGINFILE || currule == ENDFILE)
2502                                         && pc->into_var == FALSE
2503                                         && pc->redir_type == redirect_input)
2504                                 fatal(_("`getline' invalid inside `%s' rule"), ruletab[currule]);
2505                         r = do_getline_redir(pc->into_var, pc->redir_type);
2506                         PUSH(r);
2507                         break;
2508
2509                 case Op_K_getline:      /* no redirection */
2510                         if (! currule || currule == BEGINFILE || currule == ENDFILE)
2511                                 fatal(_("non-redirected `getline' invalid inside `%s' rule"),
2512                                                 ruletab[currule]);
2513
2514                         do {
2515                                 int ret;
2516                                 ret = nextfile(& curfile, FALSE);
2517                                 if (ret <= 0)
2518                                         r = do_getline(pc->into_var, curfile);
2519                                 else {
2520
2521                                         /* Save execution state so that we can return to it
2522                                          * from Op_after_beginfile or Op_after_endfile.
2523                                          */ 
2524
2525                                         push_exec_state(pc, currule, source, stack_ptr);
2526
2527                                         if (curfile == NULL)
2528                                                 JUMPTO((pc + 1)->target_endfile);
2529                                         else
2530                                                 JUMPTO((pc + 1)->target_beginfile);
2531                                 }
2532                         } while (r == NULL);    /* EOF */
2533
2534                         PUSH(r);
2535                         break;
2536
2537                 case Op_after_endfile:
2538                         /* Find the execution state to return to */
2539                         ni = pop_exec_state(& currule, & source, NULL);
2540
2541                         assert(ni->opcode == Op_newfile || ni->opcode == Op_K_getline);
2542                         JUMPTO(ni);
2543
2544                 case Op_after_beginfile:
2545                         after_beginfile(& curfile);
2546
2547                         /* Find the execution state to return to */
2548                         ni = pop_exec_state(& currule, & source, NULL);
2549
2550                         assert(ni->opcode == Op_newfile || ni->opcode == Op_K_getline);
2551                         if (ni->opcode == Op_K_getline
2552                                         || curfile == NULL      /* skipping directory argument */
2553                         )
2554                                 JUMPTO(ni);
2555
2556                         break;  /* read a record, Op_get_record */
2557
2558                 case Op_newfile:
2559                 {
2560                         int ret;
2561
2562                         ret = nextfile(& curfile, FALSE);
2563
2564                         if (ret < 0)    /* end of input */
2565                                 JUMPTO(pc->target_jmp); /* end block or Op_atexit */
2566
2567                         if (ret == 0) /* read a record */
2568                                 JUMPTO((pc + 1)->target_get_record);
2569
2570                         /* ret > 0 */
2571                         /* Save execution state for use in Op_after_beginfile or Op_after_endfile. */
2572
2573                         push_exec_state(pc, currule, source, stack_ptr);
2574
2575                         if (curfile == NULL)    /* EOF */
2576                                 JUMPTO(pc->target_endfile);
2577                         /* else
2578                                 execute beginfile block */
2579                 }
2580                         break;
2581                         
2582                 case Op_get_record:             
2583                 {
2584                         int errcode = 0;
2585
2586                         ni = pc->target_newfile;
2587                         if (curfile == NULL) {
2588                                 /* from non-redirected getline, e.g.:
2589                                  *  {
2590                                  *              while (getline > 0) ;
2591                                  *  }
2592                                  */
2593
2594                                 ni = ni->target_jmp;    /* end_block or Op_atexit */
2595                                 JUMPTO(ni);
2596                         }
2597
2598                         if (inrec(curfile, & errcode) != 0) {
2599                                 if (errcode > 0 && (do_traditional || ! pc->has_endfile))
2600                                         fatal(_("error reading input file `%s': %s"),
2601                                                 curfile->name, strerror(errcode));
2602
2603                                 JUMPTO(ni);
2604                         } /* else
2605                                 prog (rule) block */
2606                 }
2607                         break;
2608
2609                 case Op_K_nextfile:
2610                 {
2611                         int ret;
2612
2613                         if (currule != Rule && currule != BEGINFILE)
2614                                 fatal(_("`nextfile' cannot be called from a `%s' rule"),
2615                                         ruletab[currule]);
2616
2617                         ret = nextfile(& curfile, TRUE);        /* skip current file */
2618
2619                         if (currule == BEGINFILE) {
2620                                 long stack_size;
2621
2622                                 ni = pop_exec_state(& currule, & source, & stack_size);
2623
2624                                 assert(ni->opcode == Op_K_getline || ni->opcode == Op_newfile);
2625
2626                                 /* pop stack returning to the state of Op_K_getline or Op_newfile. */
2627                                 unwind_stack(stack_size);
2628
2629                                 if (ret == 0) {
2630                                         /* There was an error opening the file;
2631                                          * don't run ENDFILE block(s).
2632                                          */
2633
2634                                         JUMPTO(ni);
2635                                 } else {
2636                                         /* do run ENDFILE block(s) first. */
2637                                         
2638                                         /* Execution state to return to in Op_after_endfile. */
2639                                         push_exec_state(ni, currule, source, stack_ptr);
2640
2641                                         JUMPTO(pc->target_endfile);
2642                                 }                               
2643                         } /* else 
2644                                 Start over with the first rule. */
2645
2646                         /* empty the run-time stack to avoid memory leak */
2647                         pop_stack();
2648
2649                         /* Push an execution state for Op_after_endfile to return to */
2650                         push_exec_state(pc->target_newfile, currule, source, stack_ptr);
2651
2652                         JUMPTO(pc->target_endfile);
2653                 }
2654                         break;
2655
2656                 case Op_K_exit:
2657                         /* exit not allowed in user-defined comparison functions for "sorted_in";
2658                          * This is done so that END blocks aren't executed more than once.
2659                          */
2660                         if (! currule)
2661                                 fatal(_("`exit' cannot be called in the current context"));
2662
2663                         exiting = TRUE;
2664                         POP_NUMBER(x1);
2665                         exit_val = (int) x1;
2666 #ifdef VMS
2667                         if (exit_val == 0)
2668                                 exit_val = EXIT_SUCCESS;
2669                         else if (exit_val == 1)
2670                                 exit_val = EXIT_FAILURE;
2671                         /* else
2672                                 just pass anything else on through */
2673 #endif
2674
2675                         if (currule == BEGINFILE || currule == ENDFILE) {
2676
2677                                 /* Find the rule of the saved execution state (Op_K_getline/Op_newfile).
2678                                  * This is needed to prevent multiple execution of any END rules:
2679                                  *      gawk 'BEGINFILE { exit(1) } \
2680                                  *         END { while (getline > 0); }' in1 in2
2681                                  */
2682
2683                                 (void) pop_exec_state(& currule, & source, NULL);
2684                         }
2685
2686                         pop_stack();    /* empty stack, don't leak memory */
2687
2688                         /* Jump to either the first END block instruction
2689                          * or to Op_atexit.
2690                          */
2691
2692                         if (currule == END)
2693                                 ni = pc->target_atexit;
2694                         else
2695                                 ni = pc->target_end;
2696                         JUMPTO(ni);
2697
2698                 case Op_K_next:
2699                         if (currule != Rule)
2700                                 fatal(_("`next' cannot be called from a `%s' rule"), ruletab[currule]);
2701
2702                         pop_stack();
2703                         JUMPTO(pc->target_jmp); /* Op_get_record, read next record */
2704
2705                 case Op_pop:
2706 #if defined(GAWKDEBUG) || defined(ARRAYDEBUG)
2707                         if (last_was_stopme)
2708                                 last_was_stopme = FALSE;
2709                         else
2710 #endif
2711                         {
2712                                 r = POP_SCALAR();
2713                                 DEREF(r);
2714                         }
2715                         break;
2716
2717                 case Op_line_range:
2718                         if (pc->triggered)              /* evaluate right expression */
2719                                 JUMPTO(pc->target_jmp);
2720                         /* else
2721                                 evaluate left expression */
2722                         break;
2723
2724                 case Op_cond_pair:
2725                 {
2726                         int result;
2727                         INSTRUCTION *ip;
2728
2729                         t1 = TOP_SCALAR();   /* from right hand side expression */
2730                         di = (eval_condition(t1) != 0);
2731                         DEREF(t1);
2732
2733                         ip = pc->line_range;            /* Op_line_range */
2734
2735                         if (! ip->triggered && di) {
2736                                 /* not already triggered and left expression is TRUE */
2737                                 decr_sp();
2738                                 ip->triggered = TRUE;
2739                                 JUMPTO(ip->target_jmp); /* evaluate right expression */ 
2740                         }
2741
2742                         result = ip->triggered || di;
2743                         ip->triggered ^= di;            /* update triggered flag */
2744                         r = make_number((AWKNUM) result);      /* final value of condition pair */
2745                         REPLACE(r);
2746                         JUMPTO(pc->target_jmp);
2747                 }
2748
2749                 case Op_exec_count:
2750                         INCREMENT(pc->exec_count);
2751                         break;
2752
2753                 case Op_no_op:
2754                 case Op_K_do:
2755                 case Op_K_while:
2756                 case Op_K_for:
2757                 case Op_K_arrayfor:
2758                 case Op_K_switch:
2759                 case Op_K_default:
2760                 case Op_K_if:
2761                 case Op_K_else:
2762                 case Op_cond_exp:
2763                         break;
2764
2765                 default:
2766                         fatal(_("Sorry, don't know how to interpret `%s'"), opcode2str(pc->opcode));
2767                 }
2768
2769                 JUMPTO(pc->nexti);
2770
2771 /*      } forever */
2772
2773         /* not reached */
2774         return 0;
2775
2776 #undef mk_sub
2777 #undef JUMPTO
2778 }