perl 3.0 patch #30 patch #29, continued
[perl.git] / cmd.c
1 /* $Header: cmd.c,v 3.0.1.9 90/10/15 15:32:39 lwall Locked $
2  *
3  *    Copyright (c) 1989, Larry Wall
4  *
5  *    You may distribute under the terms of the GNU General Public License
6  *    as specified in the README file that comes with the perl 3.0 kit.
7  *
8  * $Log:        cmd.c,v $
9  * Revision 3.0.1.9  90/10/15  15:32:39  lwall
10  * patch29: non-existent array values no longer cause core dumps
11  * patch29: scripts now run at almost full speed under the debugger
12  * patch29: @ENV = () now works
13  * patch29: added caller
14  * 
15  * Revision 3.0.1.8  90/08/09  02:28:49  lwall
16  * patch19: did preliminary work toward debugging packages and evals
17  * patch19: conditionals now always supply a scalar context to expression
18  * patch19: switch optimizer was confused by negative fractional values
19  * 
20  * Revision 3.0.1.7  90/03/27  15:32:37  lwall
21  * patch16: non-terminal blocks should never have arrays requested of them
22  * 
23  * Revision 3.0.1.6  90/03/12  16:21:09  lwall
24  * patch13: fixed some backwards VOLATILE declarations
25  * patch13: while (s/x//) {} still caused some anomolies
26  * patch13: greater-than test of numeric switch structures did less-than action
27  * 
28  * Revision 3.0.1.5  90/02/28  16:38:31  lwall
29  * patch9: volatilized some more variables for super-optimizing compilers
30  * patch9: nested foreach loops didn't reset inner loop on next to outer loop
31  * patch9: returned values were read from obsolete stack
32  * patch9: added sanity check on longjmp() return value
33  * patch9: substitutions that almost always succeed can corrupt label stack
34  * patch9: subs which return by both mechanisms can clobber local return data
35  * 
36  * Revision 3.0.1.4  89/12/21  19:17:41  lwall
37  * patch7: arranged for certain registers to be restored after longjmp()
38  * patch7: made nested or recursive foreach work right
39  * 
40  * Revision 3.0.1.3  89/11/17  15:04:36  lwall
41  * patch5: nested foreach on same array didn't work
42  * 
43  * Revision 3.0.1.2  89/11/11  04:08:56  lwall
44  * patch2: non-BSD machines required two ^D's for <>
45  * patch2: grow_dlevel() not inside #ifdef DEBUGGING
46  * 
47  * Revision 3.0.1.1  89/10/26  23:04:21  lwall
48  * patch1: heuristically disabled optimization could cause core dump
49  * 
50  * Revision 3.0  89/10/18  15:09:02  lwall
51  * 3.0 baseline
52  * 
53  */
54
55 #include "EXTERN.h"
56 #include "perl.h"
57
58 #ifdef I_VARARGS
59 #  include <varargs.h>
60 #endif
61
62 static STR str_chop;
63
64 void grow_dlevel();
65
66 /* do longjmps() clobber register variables? */
67
68 #if defined(cray) || defined(__STDC__)
69 #define JMPCLOBBER
70 #endif
71
72 /* This is the main command loop.  We try to spend as much time in this loop
73  * as possible, so lots of optimizations do their activities in here.  This
74  * means things get a little sloppy.
75  */
76
77 int
78 cmd_exec(cmdparm,gimme,sp)
79 CMD *VOLATILE cmdparm;
80 VOLATILE int gimme;
81 VOLATILE int sp;
82 {
83     register CMD *cmd = cmdparm;
84     SPAT *VOLATILE oldspat;
85     VOLATILE int firstsave = savestack->ary_fill;
86     VOLATILE int oldsave;
87     VOLATILE int aryoptsave;
88 #ifdef DEBUGGING
89     VOLATILE int olddlevel;
90     VOLATILE int entdlevel;
91 #endif
92     register STR *retstr = &str_undef;
93     register char *tmps;
94     register int cmdflags;
95     register int match;
96     register char *go_to = goto_targ;
97     register int newsp = -2;
98     register STR **st = stack->ary_array;
99     FILE *VOLATILE fp;
100     ARRAY *VOLATILE ar;
101
102     lastsize = 0;
103 #ifdef DEBUGGING
104     entdlevel = dlevel;
105 #endif
106 tail_recursion_entry:
107 #ifdef DEBUGGING
108     dlevel = entdlevel;
109 #endif
110 #ifdef TAINT
111     tainted = 0;        /* Each statement is presumed innocent */
112 #endif
113     if (cmd == Nullcmd) {
114         if (gimme == G_ARRAY && newsp > -2)
115             return newsp;
116         else {
117             st[++sp] = retstr;
118             return sp;
119         }
120     }
121     cmdflags = cmd->c_flags;    /* hopefully load register */
122     if (go_to) {
123         if (cmd->c_label && strEQ(go_to,cmd->c_label))
124             goto_targ = go_to = Nullch;         /* here at last */
125         else {
126             switch (cmd->c_type) {
127             case C_IF:
128                 oldspat = curspat;
129                 oldsave = savestack->ary_fill;
130 #ifdef DEBUGGING
131                 olddlevel = dlevel;
132 #endif
133                 retstr = &str_yes;
134                 newsp = -2;
135                 if (cmd->ucmd.ccmd.cc_true) {
136 #ifdef DEBUGGING
137                     if (debug) {
138                         debname[dlevel] = 't';
139                         debdelim[dlevel] = '_';
140                         if (++dlevel >= dlmax)
141                             grow_dlevel();
142                     }
143 #endif
144                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
145                     st = stack->ary_array;      /* possibly reallocated */
146                     retstr = st[newsp];
147                 }
148                 if (!goto_targ)
149                     go_to = Nullch;
150                 curspat = oldspat;
151                 if (savestack->ary_fill > oldsave)
152                     restorelist(oldsave);
153 #ifdef DEBUGGING
154                 dlevel = olddlevel;
155 #endif
156                 cmd = cmd->ucmd.ccmd.cc_alt;
157                 goto tail_recursion_entry;
158             case C_ELSE:
159                 oldspat = curspat;
160                 oldsave = savestack->ary_fill;
161 #ifdef DEBUGGING
162                 olddlevel = dlevel;
163 #endif
164                 retstr = &str_undef;
165                 newsp = -2;
166                 if (cmd->ucmd.ccmd.cc_true) {
167 #ifdef DEBUGGING
168                     if (debug) {
169                         debname[dlevel] = 'e';
170                         debdelim[dlevel] = '_';
171                         if (++dlevel >= dlmax)
172                             grow_dlevel();
173                     }
174 #endif
175                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
176                     st = stack->ary_array;      /* possibly reallocated */
177                     retstr = st[newsp];
178                 }
179                 if (!goto_targ)
180                     go_to = Nullch;
181                 curspat = oldspat;
182                 if (savestack->ary_fill > oldsave)
183                     restorelist(oldsave);
184 #ifdef DEBUGGING
185                 dlevel = olddlevel;
186 #endif
187                 break;
188             case C_BLOCK:
189             case C_WHILE:
190                 if (!(cmdflags & CF_ONCE)) {
191                     cmdflags |= CF_ONCE;
192                     if (++loop_ptr >= loop_max) {
193                         loop_max += 128;
194                         Renew(loop_stack, loop_max, struct loop);
195                     }
196                     loop_stack[loop_ptr].loop_label = cmd->c_label;
197                     loop_stack[loop_ptr].loop_sp = sp;
198 #ifdef DEBUGGING
199                     if (debug & 4) {
200                         deb("(Pushing label #%d %s)\n",
201                           loop_ptr, cmd->c_label ? cmd->c_label : "");
202                     }
203 #endif
204                 }
205 #ifdef JMPCLOBBER
206                 cmdparm = cmd;
207 #endif
208                 if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
209                     st = stack->ary_array;      /* possibly reallocated */
210 #ifdef JMPCLOBBER
211                     cmd = cmdparm;
212                     cmdflags = cmd->c_flags|CF_ONCE;
213 #endif
214                     if (savestack->ary_fill > oldsave)
215                         restorelist(oldsave);
216                     switch (match) {
217                     default:
218                         fatal("longjmp returned bad value (%d)",match);
219                     case O_LAST:        /* not done unless go_to found */
220                         go_to = Nullch;
221                         if (lastretstr) {
222                             retstr = lastretstr;
223                             newsp = -2;
224                         }
225                         else {
226                             newsp = sp + lastsize;
227                             retstr = st[newsp];
228                         }
229 #ifdef DEBUGGING
230                         olddlevel = dlevel;
231 #endif
232                         curspat = oldspat;
233                         goto next_cmd;
234                     case O_NEXT:        /* not done unless go_to found */
235                         go_to = Nullch;
236 #ifdef JMPCLOBBER
237                         newsp = -2;
238                         retstr = &str_undef;
239 #endif
240                         goto next_iter;
241                     case O_REDO:        /* not done unless go_to found */
242                         go_to = Nullch;
243 #ifdef JMPCLOBBER
244                         newsp = -2;
245                         retstr = &str_undef;
246 #endif
247                         goto doit;
248                     }
249                 }
250                 oldspat = curspat;
251                 oldsave = savestack->ary_fill;
252 #ifdef DEBUGGING
253                 olddlevel = dlevel;
254 #endif
255                 if (cmd->ucmd.ccmd.cc_true) {
256 #ifdef DEBUGGING
257                     if (debug) {
258                         debname[dlevel] = 't';
259                         debdelim[dlevel] = '_';
260                         if (++dlevel >= dlmax)
261                             grow_dlevel();
262                     }
263 #endif
264                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
265                     st = stack->ary_array;      /* possibly reallocated */
266                     retstr = st[newsp];
267                 }
268                 if (!goto_targ) {
269                     go_to = Nullch;
270                     goto next_iter;
271                 }
272 #ifdef DEBUGGING
273                 dlevel = olddlevel;
274 #endif
275                 if (cmd->ucmd.ccmd.cc_alt) {
276 #ifdef DEBUGGING
277                     if (debug) {
278                         debname[dlevel] = 'a';
279                         debdelim[dlevel] = '_';
280                         if (++dlevel >= dlmax)
281                             grow_dlevel();
282                     }
283 #endif
284                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
285                     st = stack->ary_array;      /* possibly reallocated */
286                     retstr = st[newsp];
287                 }
288                 if (goto_targ)
289                     break;
290                 go_to = Nullch;
291                 goto finish_while;
292             }
293             cmd = cmd->c_next;
294             if (cmd && cmd->c_head == cmd)
295                                         /* reached end of while loop */
296                 return sp;              /* targ isn't in this block */
297             if (cmdflags & CF_ONCE) {
298 #ifdef DEBUGGING
299                 if (debug & 4) {
300                     tmps = loop_stack[loop_ptr].loop_label;
301                     deb("(Popping label #%d %s)\n",loop_ptr,
302                         tmps ? tmps : "" );
303                 }
304 #endif
305                 loop_ptr--;
306             }
307             goto tail_recursion_entry;
308         }
309     }
310
311 until_loop:
312
313     /* Set line number so run-time errors can be located */
314
315     curcmd = cmd;
316
317 #ifdef DEBUGGING
318     if (debug) {
319         if (debug & 2) {
320             deb("%s     (%lx)   r%lx    t%lx    a%lx    n%lx    cs%lx\n",
321                 cmdname[cmd->c_type],cmd,cmd->c_expr,
322                 cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
323                 curspat);
324         }
325         debname[dlevel] = cmdname[cmd->c_type][0];
326         debdelim[dlevel] = '!';
327         if (++dlevel >= dlmax)
328             grow_dlevel();
329     }
330 #endif
331
332     /* Here is some common optimization */
333
334     if (cmdflags & CF_COND) {
335         switch (cmdflags & CF_OPTIMIZE) {
336
337         case CFT_FALSE:
338             retstr = cmd->c_short;
339             newsp = -2;
340             match = FALSE;
341             if (cmdflags & CF_NESURE)
342                 goto maybe;
343             break;
344         case CFT_TRUE:
345             retstr = cmd->c_short;
346             newsp = -2;
347             match = TRUE;
348             if (cmdflags & CF_EQSURE)
349                 goto flipmaybe;
350             break;
351
352         case CFT_REG:
353             retstr = STAB_STR(cmd->c_stab);
354             newsp = -2;
355             match = str_true(retstr);   /* => retstr = retstr, c2 should fix */
356             if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
357                 goto flipmaybe;
358             break;
359
360         case CFT_ANCHOR:        /* /^pat/ optimization */
361             if (multiline) {
362                 if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
363                     goto scanner;       /* just unanchor it */
364                 else
365                     break;              /* must evaluate */
366             }
367             /* FALL THROUGH */
368         case CFT_STROP:         /* string op optimization */
369             retstr = STAB_STR(cmd->c_stab);
370             newsp = -2;
371 #ifndef I286
372             if (*cmd->c_short->str_ptr == *str_get(retstr) &&
373                     bcmp(cmd->c_short->str_ptr, str_get(retstr),
374                       cmd->c_slen) == 0 ) {
375                 if (cmdflags & CF_EQSURE) {
376                     if (sawampersand && (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
377                         curspat = Nullspat;
378                         if (leftstab)
379                             str_nset(stab_val(leftstab),"",0);
380                         if (amperstab)
381                             str_sset(stab_val(amperstab),cmd->c_short);
382                         if (rightstab)
383                             str_nset(stab_val(rightstab),
384                               retstr->str_ptr + cmd->c_slen,
385                               retstr->str_cur - cmd->c_slen);
386                     }
387                     match = !(cmdflags & CF_FIRSTNEG);
388                     retstr = &str_yes;
389                     goto flipmaybe;
390                 }
391             }
392             else if (cmdflags & CF_NESURE) {
393                 match = cmdflags & CF_FIRSTNEG;
394                 retstr = &str_no;
395                 goto flipmaybe;
396             }
397 #else
398             {
399                 char *zap1, *zap2, zap1c, zap2c;
400                 int  zaplen;
401
402                 zap1 = cmd->c_short->str_ptr;
403                 zap2 = str_get(retstr);
404                 zap1c = *zap1;
405                 zap2c = *zap2;
406                 zaplen = cmd->c_slen;
407                 if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
408                     if (cmdflags & CF_EQSURE) {
409                         if (sawampersand &&
410                           (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
411                             curspat = Nullspat;
412                             if (leftstab)
413                                 str_nset(stab_val(leftstab),"",0);
414                             if (amperstab)
415                                 str_sset(stab_val(amperstab),cmd->c_short);
416                             if (rightstab)
417                                 str_nset(stab_val(rightstab),
418                                          retstr->str_ptr + cmd->c_slen,
419                                          retstr->str_cur - cmd->c_slen);
420                         }
421                         match = !(cmdflags & CF_FIRSTNEG);
422                         retstr = &str_yes;
423                         goto flipmaybe;
424                     }
425                 }
426                 else if (cmdflags & CF_NESURE) {
427                     match = cmdflags & CF_FIRSTNEG;
428                     retstr = &str_no;
429                     goto flipmaybe;
430                 }
431             }
432 #endif
433             break;                      /* must evaluate */
434
435         case CFT_SCAN:                  /* non-anchored search */
436           scanner:
437             retstr = STAB_STR(cmd->c_stab);
438             newsp = -2;
439             if (retstr->str_pok & SP_STUDIED)
440                 if (screamfirst[cmd->c_short->str_rare] >= 0)
441                     tmps = screaminstr(retstr, cmd->c_short);
442                 else
443                     tmps = Nullch;
444             else {
445                 tmps = str_get(retstr);         /* make sure it's pok */
446 #ifndef lint
447                 tmps = fbminstr((unsigned char*)tmps,
448                     (unsigned char*)tmps + retstr->str_cur, cmd->c_short);
449 #endif
450             }
451             if (tmps) {
452                 if (cmdflags & CF_EQSURE) {
453                     ++cmd->c_short->str_u.str_useful;
454                     if (sawampersand) {
455                         curspat = Nullspat;
456                         if (leftstab)
457                             str_nset(stab_val(leftstab),retstr->str_ptr,
458                               tmps - retstr->str_ptr);
459                         if (amperstab)
460                             str_sset(stab_val(amperstab),cmd->c_short);
461                         if (rightstab)
462                             str_nset(stab_val(rightstab),
463                               tmps + cmd->c_short->str_cur,
464                               retstr->str_cur - (tmps - retstr->str_ptr) -
465                                 cmd->c_short->str_cur);
466                     }
467                     match = !(cmdflags & CF_FIRSTNEG);
468                     retstr = &str_yes;
469                     goto flipmaybe;
470                 }
471                 else
472                     hint = tmps;
473             }
474             else {
475                 if (cmdflags & CF_NESURE) {
476                     ++cmd->c_short->str_u.str_useful;
477                     match = cmdflags & CF_FIRSTNEG;
478                     retstr = &str_no;
479                     goto flipmaybe;
480                 }
481             }
482             if (--cmd->c_short->str_u.str_useful < 0) {
483                 cmdflags &= ~CF_OPTIMIZE;
484                 cmdflags |= CFT_EVAL;   /* never try this optimization again */
485                 cmd->c_flags = (cmdflags & ~CF_ONCE);
486             }
487             break;                      /* must evaluate */
488
489         case CFT_NUMOP:         /* numeric op optimization */
490             retstr = STAB_STR(cmd->c_stab);
491             newsp = -2;
492             switch (cmd->c_slen) {
493             case O_EQ:
494                 if (dowarn) {
495                     if ((!retstr->str_nok && !looks_like_number(retstr)))
496                         warn("Possible use of == on string value");
497                 }
498                 match = (str_gnum(retstr) == cmd->c_short->str_u.str_nval);
499                 break;
500             case O_NE:
501                 match = (str_gnum(retstr) != cmd->c_short->str_u.str_nval);
502                 break;
503             case O_LT:
504                 match = (str_gnum(retstr) <  cmd->c_short->str_u.str_nval);
505                 break;
506             case O_LE:
507                 match = (str_gnum(retstr) <= cmd->c_short->str_u.str_nval);
508                 break;
509             case O_GT:
510                 match = (str_gnum(retstr) >  cmd->c_short->str_u.str_nval);
511                 break;
512             case O_GE:
513                 match = (str_gnum(retstr) >= cmd->c_short->str_u.str_nval);
514                 break;
515             }
516             if (match) {
517                 if (cmdflags & CF_EQSURE) {
518                     retstr = &str_yes;
519                     goto flipmaybe;
520                 }
521             }
522             else if (cmdflags & CF_NESURE) {
523                 retstr = &str_no;
524                 goto flipmaybe;
525             }
526             break;                      /* must evaluate */
527
528         case CFT_INDGETS:               /* while (<$foo>) */
529             last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
530             if (!stab_io(last_in_stab))
531                 stab_io(last_in_stab) = stio_new();
532             goto dogets;
533         case CFT_GETS:                  /* really a while (<file>) */
534             last_in_stab = cmd->c_stab;
535           dogets:
536             fp = stab_io(last_in_stab)->ifp;
537             retstr = stab_val(defstab);
538             newsp = -2;
539           keepgoing:
540             if (fp && str_gets(retstr, fp, 0)) {
541                 if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
542                     match = FALSE;
543                 else
544                     match = TRUE;
545                 stab_io(last_in_stab)->lines++;
546             }
547             else if (stab_io(last_in_stab)->flags & IOF_ARGV) {
548                 if (!fp)
549                     goto doeval;        /* first time through */
550                 fp = nextargv(last_in_stab);
551                 if (fp)
552                     goto keepgoing;
553                 (void)do_close(last_in_stab,FALSE);
554                 stab_io(last_in_stab)->flags |= IOF_START;
555                 retstr = &str_undef;
556                 match = FALSE;
557             }
558             else {
559                 retstr = &str_undef;
560                 match = FALSE;
561             }
562             goto flipmaybe;
563         case CFT_EVAL:
564             break;
565         case CFT_UNFLIP:
566             while (tmps_max > tmps_base)        /* clean up after last eval */
567                 str_free(tmps_list[tmps_max--]);
568             newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
569             st = stack->ary_array;      /* possibly reallocated */
570             retstr = st[newsp];
571             match = str_true(retstr);
572             if (cmd->c_expr->arg_type == O_FLIP)        /* undid itself? */
573                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
574             goto maybe;
575         case CFT_CHOP:
576             retstr = stab_val(cmd->c_stab);
577             newsp = -2;
578             match = (retstr->str_cur != 0);
579             tmps = str_get(retstr);
580             tmps += retstr->str_cur - match;
581             str_nset(&str_chop,tmps,match);
582             *tmps = '\0';
583             retstr->str_nok = 0;
584             retstr->str_cur = tmps - retstr->str_ptr;
585             retstr = &str_chop;
586             goto flipmaybe;
587         case CFT_ARRAY:
588             match = cmd->c_short->str_u.str_useful; /* just to get register */
589
590             if (match < 0) {            /* first time through here? */
591                 ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
592                 aryoptsave = savestack->ary_fill;
593                 savesptr(&stab_val(cmd->c_stab));
594                 savelong(&cmd->c_short->str_u.str_useful);
595             }
596             else {
597                 ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
598                 if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave)
599                     restorelist(firstsave);
600             }
601
602             if (match >= ar->ary_fill) {        /* we're in LAST, probably */
603                 retstr = &str_undef;
604                 cmd->c_short->str_u.str_useful = -1;    /* actually redundant */
605                 match = FALSE;
606             }
607             else {
608                 match++;
609                 if (!(retstr = ar->ary_array[match]))
610                     retstr = afetch(ar,match,TRUE);
611                 stab_val(cmd->c_stab) = retstr;
612                 cmd->c_short->str_u.str_useful = match;
613                 match = TRUE;
614             }
615             newsp = -2;
616             goto maybe;
617         case CFT_D1:
618             break;
619         case CFT_D0:
620             if (DBsingle->str_u.str_nval != 0)
621                 break;
622             if (DBsignal->str_u.str_nval != 0)
623                 break;
624             if (DBtrace->str_u.str_nval != 0)
625                 break;
626             goto next_cmd;
627         }
628
629     /* we have tried to make this normal case as abnormal as possible */
630
631     doeval:
632         if (gimme == G_ARRAY) {
633             lastretstr = Nullstr;
634             lastspbase = sp;
635             lastsize = newsp - sp;
636         }
637         else
638             lastretstr = retstr;
639         while (tmps_max > tmps_base)    /* clean up after last eval */
640             str_free(tmps_list[tmps_max--]);
641         newsp = eval(cmd->c_expr,
642           gimme && (cmdflags & CF_TERM) && cmd->c_type == C_EXPR &&
643                 !cmd->ucmd.acmd.ac_expr,
644           sp);
645         st = stack->ary_array;  /* possibly reallocated */
646         retstr = st[newsp];
647         if (newsp > sp && retstr)
648             match = str_true(retstr);
649         else
650             match = FALSE;
651         goto maybe;
652
653     /* if flipflop was true, flop it */
654
655     flipmaybe:
656         if (match && cmdflags & CF_FLIP) {
657             while (tmps_max > tmps_base)        /* clean up after last eval */
658                 str_free(tmps_list[tmps_max--]);
659             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
660                 newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
661                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
662             }
663             else {
664                 newsp = eval(cmd->c_expr,G_SCALAR,sp);/* let eval do it */
665                 if (cmd->c_expr->arg_type == O_FLOP)    /* still toggled? */
666                     cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
667             }
668         }
669         else if (cmdflags & CF_FLIP) {
670             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
671                 match = TRUE;                           /* force on */
672             }
673         }
674
675     /* at this point, match says whether our expression was true */
676
677     maybe:
678         if (cmdflags & CF_INVERT)
679             match = !match;
680         if (!match)
681             goto next_cmd;
682     }
683 #ifdef TAINT
684     tainted = 0;        /* modifier doesn't affect regular expression */
685 #endif
686
687     /* now to do the actual command, if any */
688
689     switch (cmd->c_type) {
690     case C_NULL:
691         fatal("panic: cmd_exec");
692     case C_EXPR:                        /* evaluated for side effects */
693         if (cmd->ucmd.acmd.ac_expr) {   /* more to do? */
694             if (gimme == G_ARRAY) {
695                 lastretstr = Nullstr;
696                 lastspbase = sp;
697                 lastsize = newsp - sp;
698             }
699             else
700                 lastretstr = retstr;
701             while (tmps_max > tmps_base)        /* clean up after last eval */
702                 str_free(tmps_list[tmps_max--]);
703             newsp = eval(cmd->ucmd.acmd.ac_expr,gimme && (cmdflags&CF_TERM),sp);
704             st = stack->ary_array;      /* possibly reallocated */
705             retstr = st[newsp];
706         }
707         break;
708     case C_NSWITCH:
709         {
710             double value = str_gnum(STAB_STR(cmd->c_stab));
711
712             match = (int)value;
713             if (value < 0.0) {
714                 if (((double)match) > value)
715                     --match;            /* was fractional--truncate other way */
716             }
717         }
718         goto doswitch;
719     case C_CSWITCH:
720         match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
721       doswitch:
722         match -= cmd->ucmd.scmd.sc_offset;
723         if (match < 0)
724             match = 0;
725         else if (match > cmd->ucmd.scmd.sc_max)
726             match = cmd->ucmd.scmd.sc_max;
727         cmd = cmd->ucmd.scmd.sc_next[match];
728         goto tail_recursion_entry;
729     case C_NEXT:
730         cmd = cmd->ucmd.ccmd.cc_alt;
731         goto tail_recursion_entry;
732     case C_ELSIF:
733         fatal("panic: ELSIF");
734     case C_IF:
735         oldspat = curspat;
736         oldsave = savestack->ary_fill;
737 #ifdef DEBUGGING
738         olddlevel = dlevel;
739 #endif
740         retstr = &str_yes;
741         newsp = -2;
742         if (cmd->ucmd.ccmd.cc_true) {
743 #ifdef DEBUGGING
744             if (debug) {
745                 debname[dlevel] = 't';
746                 debdelim[dlevel] = '_';
747                 if (++dlevel >= dlmax)
748                     grow_dlevel();
749             }
750 #endif
751             newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
752             st = stack->ary_array;      /* possibly reallocated */
753             retstr = st[newsp];
754         }
755         curspat = oldspat;
756         if (savestack->ary_fill > oldsave)
757             restorelist(oldsave);
758 #ifdef DEBUGGING
759         dlevel = olddlevel;
760 #endif
761         cmd = cmd->ucmd.ccmd.cc_alt;
762         goto tail_recursion_entry;
763     case C_ELSE:
764         oldspat = curspat;
765         oldsave = savestack->ary_fill;
766 #ifdef DEBUGGING
767         olddlevel = dlevel;
768 #endif
769         retstr = &str_undef;
770         newsp = -2;
771         if (cmd->ucmd.ccmd.cc_true) {
772 #ifdef DEBUGGING
773             if (debug) {
774                 debname[dlevel] = 'e';
775                 debdelim[dlevel] = '_';
776                 if (++dlevel >= dlmax)
777                     grow_dlevel();
778             }
779 #endif
780             newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
781             st = stack->ary_array;      /* possibly reallocated */
782             retstr = st[newsp];
783         }
784         curspat = oldspat;
785         if (savestack->ary_fill > oldsave)
786             restorelist(oldsave);
787 #ifdef DEBUGGING
788         dlevel = olddlevel;
789 #endif
790         break;
791     case C_BLOCK:
792     case C_WHILE:
793         if (!(cmdflags & CF_ONCE)) {    /* first time through here? */
794             cmdflags |= CF_ONCE;
795             if (++loop_ptr >= loop_max) {
796                 loop_max += 128;
797                 Renew(loop_stack, loop_max, struct loop);
798             }
799             loop_stack[loop_ptr].loop_label = cmd->c_label;
800             loop_stack[loop_ptr].loop_sp = sp;
801 #ifdef DEBUGGING
802             if (debug & 4) {
803                 deb("(Pushing label #%d %s)\n",
804                   loop_ptr, cmd->c_label ? cmd->c_label : "");
805             }
806 #endif
807         }
808 #ifdef JMPCLOBBER
809         cmdparm = cmd;
810 #endif
811         if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
812             st = stack->ary_array;      /* possibly reallocated */
813 #ifdef JMPCLOBBER
814             cmd = cmdparm;
815             cmdflags = cmd->c_flags|CF_ONCE;
816             go_to = goto_targ;
817 #endif
818             if (savestack->ary_fill > oldsave)
819                 restorelist(oldsave);
820             switch (match) {
821             default:
822                 fatal("longjmp returned bad value (%d)",match);
823             case O_LAST:
824                 if (lastretstr) {
825                     retstr = lastretstr;
826                     newsp = -2;
827                 }
828                 else {
829                     newsp = sp + lastsize;
830                     retstr = st[newsp];
831                 }
832                 curspat = oldspat;
833                 goto next_cmd;
834             case O_NEXT:
835 #ifdef JMPCLOBBER
836                 newsp = -2;
837                 retstr = &str_undef;
838 #endif
839                 goto next_iter;
840             case O_REDO:
841 #ifdef DEBUGGING
842                 dlevel = olddlevel;
843 #endif
844 #ifdef JMPCLOBBER
845                 newsp = -2;
846                 retstr = &str_undef;
847 #endif
848                 goto doit;
849             }
850         }
851         oldspat = curspat;
852         oldsave = savestack->ary_fill;
853 #ifdef DEBUGGING
854         olddlevel = dlevel;
855 #endif
856     doit:
857         if (cmd->ucmd.ccmd.cc_true) {
858 #ifdef DEBUGGING
859             if (debug) {
860                 debname[dlevel] = 't';
861                 debdelim[dlevel] = '_';
862                 if (++dlevel >= dlmax)
863                     grow_dlevel();
864             }
865 #endif
866             newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
867             st = stack->ary_array;      /* possibly reallocated */
868             retstr = st[newsp];
869         }
870         /* actually, this spot is rarely reached anymore since the above
871          * cmd_exec() returns through longjmp().  Hooray for structure.
872          */
873       next_iter:
874 #ifdef DEBUGGING
875         dlevel = olddlevel;
876 #endif
877         if (cmd->ucmd.ccmd.cc_alt) {
878 #ifdef DEBUGGING
879             if (debug) {
880                 debname[dlevel] = 'a';
881                 debdelim[dlevel] = '_';
882                 if (++dlevel >= dlmax)
883                     grow_dlevel();
884             }
885 #endif
886             newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
887             st = stack->ary_array;      /* possibly reallocated */
888             retstr = st[newsp];
889         }
890       finish_while:
891         curspat = oldspat;
892         if (savestack->ary_fill > oldsave) {
893             if (cmdflags & CF_TERM) {
894                 for (match = sp + 1; match <= newsp; match++)
895                     st[match] = str_static(st[match]);
896                 retstr = st[newsp];
897             }
898             restorelist(oldsave);
899         }
900 #ifdef DEBUGGING
901         dlevel = olddlevel - 1;
902 #endif
903         if (cmd->c_type != C_BLOCK)
904             goto until_loop;    /* go back and evaluate conditional again */
905     }
906     if (cmdflags & CF_LOOP) {
907         cmdflags |= CF_COND;            /* now test the condition */
908 #ifdef DEBUGGING
909         dlevel = entdlevel;
910 #endif
911         goto until_loop;
912     }
913   next_cmd:
914     if (cmdflags & CF_ONCE) {
915 #ifdef DEBUGGING
916         if (debug & 4) {
917             tmps = loop_stack[loop_ptr].loop_label;
918             deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
919         }
920 #endif
921         loop_ptr--;
922         if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY &&
923           savestack->ary_fill > aryoptsave)
924             restorelist(aryoptsave);
925     }
926     cmd = cmd->c_next;
927     goto tail_recursion_entry;
928 }
929
930 #ifdef DEBUGGING
931 #  ifndef VARARGS
932 /*VARARGS1*/
933 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
934 char *pat;
935 {
936     register int i;
937
938     fprintf(stderr,"%-4ld",(long)curcmd->c_line);
939     for (i=0; i<dlevel; i++)
940         fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
941     fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
942 }
943 #  else
944 /*VARARGS1*/
945 deb(va_alist)
946 va_dcl
947 {
948     va_list args;
949     char *pat;
950     register int i;
951
952     va_start(args);
953     fprintf(stderr,"%-4ld",(long)curcmd->c_line);
954     for (i=0; i<dlevel; i++)
955         fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
956
957     pat = va_arg(args, char *);
958     (void) vfprintf(stderr,pat,args);
959     va_end( args );
960 }
961 #  endif
962 #endif
963
964 copyopt(cmd,which)
965 register CMD *cmd;
966 register CMD *which;
967 {
968     cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
969     cmd->c_flags |= which->c_flags;
970     cmd->c_short = which->c_short;
971     cmd->c_slen = which->c_slen;
972     cmd->c_stab = which->c_stab;
973     return cmd->c_flags;
974 }
975
976 ARRAY *
977 saveary(stab)
978 STAB *stab;
979 {
980     register STR *str;
981
982     str = Str_new(10,0);
983     str->str_state = SS_SARY;
984     str->str_u.str_stab = stab;
985     if (str->str_ptr) {
986         Safefree(str->str_ptr);
987         str->str_len = 0;
988     }
989     str->str_ptr = (char*)stab_array(stab);
990     (void)apush(savestack,str); /* save array ptr */
991     stab_xarray(stab) = Null(ARRAY*);
992     return stab_xarray(aadd(stab));
993 }
994
995 HASH *
996 savehash(stab)
997 STAB *stab;
998 {
999     register STR *str;
1000
1001     str = Str_new(11,0);
1002     str->str_state = SS_SHASH;
1003     str->str_u.str_stab = stab;
1004     if (str->str_ptr) {
1005         Safefree(str->str_ptr);
1006         str->str_len = 0;
1007     }
1008     str->str_ptr = (char*)stab_hash(stab);
1009     (void)apush(savestack,str); /* save hash ptr */
1010     stab_xhash(stab) = Null(HASH*);
1011     return stab_xhash(hadd(stab));
1012 }
1013
1014 void
1015 saveitem(item)
1016 register STR *item;
1017 {
1018     register STR *str;
1019
1020     (void)apush(savestack,item);                /* remember the pointer */
1021     str = Str_new(12,0);
1022     str_sset(str,item);
1023     (void)apush(savestack,str);                 /* remember the value */
1024 }
1025
1026 void
1027 saveint(intp)
1028 int *intp;
1029 {
1030     register STR *str;
1031
1032     str = Str_new(13,0);
1033     str->str_state = SS_SINT;
1034     str->str_u.str_useful = (long)*intp;        /* remember value */
1035     if (str->str_ptr) {
1036         Safefree(str->str_ptr);
1037         str->str_len = 0;
1038     }
1039     str->str_ptr = (char*)intp;         /* remember pointer */
1040     (void)apush(savestack,str);
1041 }
1042
1043 void
1044 savelong(longp)
1045 long *longp;
1046 {
1047     register STR *str;
1048
1049     str = Str_new(14,0);
1050     str->str_state = SS_SLONG;
1051     str->str_u.str_useful = *longp;             /* remember value */
1052     if (str->str_ptr) {
1053         Safefree(str->str_ptr);
1054         str->str_len = 0;
1055     }
1056     str->str_ptr = (char*)longp;                /* remember pointer */
1057     (void)apush(savestack,str);
1058 }
1059
1060 void
1061 savesptr(sptr)
1062 STR **sptr;
1063 {
1064     register STR *str;
1065
1066     str = Str_new(15,0);
1067     str->str_state = SS_SSTRP;
1068     str->str_magic = *sptr;             /* remember value */
1069     if (str->str_ptr) {
1070         Safefree(str->str_ptr);
1071         str->str_len = 0;
1072     }
1073     str->str_ptr = (char*)sptr;         /* remember pointer */
1074     (void)apush(savestack,str);
1075 }
1076
1077 void
1078 savenostab(stab)
1079 STAB *stab;
1080 {
1081     register STR *str;
1082
1083     str = Str_new(16,0);
1084     str->str_state = SS_SNSTAB;
1085     str->str_magic = (STR*)stab;        /* remember which stab to free */
1086     (void)apush(savestack,str);
1087 }
1088
1089 void
1090 savehptr(hptr)
1091 HASH **hptr;
1092 {
1093     register STR *str;
1094
1095     str = Str_new(17,0);
1096     str->str_state = SS_SHPTR;
1097     str->str_u.str_hash = *hptr;        /* remember value */
1098     if (str->str_ptr) {
1099         Safefree(str->str_ptr);
1100         str->str_len = 0;
1101     }
1102     str->str_ptr = (char*)hptr;         /* remember pointer */
1103     (void)apush(savestack,str);
1104 }
1105
1106 void
1107 savelist(sarg,maxsarg)
1108 register STR **sarg;
1109 int maxsarg;
1110 {
1111     register STR *str;
1112     register int i;
1113
1114     for (i = 1; i <= maxsarg; i++) {
1115         (void)apush(savestack,sarg[i]);         /* remember the pointer */
1116         str = Str_new(18,0);
1117         str_sset(str,sarg[i]);
1118         (void)apush(savestack,str);                     /* remember the value */
1119         sarg[i]->str_u.str_useful = -1;
1120     }
1121 }
1122
1123 void
1124 restorelist(base)
1125 int base;
1126 {
1127     register STR *str;
1128     register STR *value;
1129     register STAB *stab;
1130
1131     if (base < -1)
1132         fatal("panic: corrupt saved stack index");
1133     while (savestack->ary_fill > base) {
1134         value = apop(savestack);
1135         switch (value->str_state) {
1136         case SS_NORM:                           /* normal string */
1137         case SS_INCR:
1138             str = apop(savestack);
1139             str_replace(str,value);
1140             STABSET(str);
1141             break;
1142         case SS_SARY:                           /* array reference */
1143             stab = value->str_u.str_stab;
1144             afree(stab_xarray(stab));
1145             stab_xarray(stab) = (ARRAY*)value->str_ptr;
1146             value->str_ptr = Nullch;
1147             str_free(value);
1148             break;
1149         case SS_SHASH:                          /* hash reference */
1150             stab = value->str_u.str_stab;
1151             (void)hfree(stab_xhash(stab), FALSE);
1152             stab_xhash(stab) = (HASH*)value->str_ptr;
1153             value->str_ptr = Nullch;
1154             str_free(value);
1155             break;
1156         case SS_SINT:                           /* int reference */
1157             *((int*)value->str_ptr) = (int)value->str_u.str_useful;
1158             value->str_ptr = Nullch;
1159             str_free(value);
1160             break;
1161         case SS_SLONG:                          /* long reference */
1162             *((long*)value->str_ptr) = value->str_u.str_useful;
1163             value->str_ptr = Nullch;
1164             str_free(value);
1165             break;
1166         case SS_SSTRP:                          /* STR* reference */
1167             *((STR**)value->str_ptr) = value->str_magic;
1168             value->str_magic = Nullstr;
1169             value->str_ptr = Nullch;
1170             str_free(value);
1171             break;
1172         case SS_SHPTR:                          /* HASH* reference */
1173             *((HASH**)value->str_ptr) = value->str_u.str_hash;
1174             value->str_ptr = Nullch;
1175             str_free(value);
1176             break;
1177         case SS_SNSTAB:
1178             stab = (STAB*)value->str_magic;
1179             value->str_magic = Nullstr;
1180             (void)stab_clear(stab);
1181             str_free(value);
1182             break;
1183         case SS_SCSV:                           /* callsave structure */
1184             {
1185                 CSV *csv = (CSV*) value->str_ptr;
1186
1187                 curcmd = csv->curcmd;
1188                 curcsv = csv->curcsv;
1189                 csv->sub->depth = csv->depth;
1190                 if (csv->hasargs) {             /* put back old @_ */
1191                     afree(csv->argarray);
1192                     stab_xarray(defstab) = csv->savearray;
1193                 }
1194                 str_free(value);
1195             }
1196             break;
1197         default:
1198             fatal("panic: restorelist inconsistency");
1199         }
1200     }
1201 }
1202
1203 #ifdef DEBUGGING
1204 void
1205 grow_dlevel()
1206 {
1207     dlmax += 128;
1208     Renew(debname, dlmax, char);
1209     Renew(debdelim, dlmax, char);
1210 }
1211 #endif