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