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