perl 4.0 patch 10: (combined patch)
[perl.git] / cons.c
1 /* $RCSfile: cons.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:31:15 $
2  *
3  *    Copyright (c) 1991, Larry Wall
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  * $Log:        cons.c,v $
9  * Revision 4.0.1.1  91/06/07  10:31:15  lwall
10  * patch4: new copyright notice
11  * patch4: added global modifier for pattern matches
12  * 
13  * Revision 4.0  91/03/20  01:05:51  lwall
14  * 4.0 baseline.
15  * 
16  */
17
18 #include "EXTERN.h"
19 #include "perl.h"
20 #include "perly.h"
21
22 extern char *tokename[];
23 extern int yychar;
24
25 static int cmd_tosave();
26 static int arg_tosave();
27 static int spat_tosave();
28
29 static bool saw_return;
30
31 SUBR *
32 make_sub(name,cmd)
33 char *name;
34 CMD *cmd;
35 {
36     register SUBR *sub;
37     STAB *stab = stabent(name,TRUE);
38
39     Newz(101,sub,1,SUBR);
40     if (stab_sub(stab)) {
41         if (dowarn) {
42             CMD *oldcurcmd = curcmd;
43
44             if (cmd)
45                 curcmd = cmd;
46             warn("Subroutine %s redefined",name);
47             curcmd = oldcurcmd;
48         }
49         if (stab_sub(stab)->cmd) {
50             cmd_free(stab_sub(stab)->cmd);
51             stab_sub(stab)->cmd = Nullcmd;
52             afree(stab_sub(stab)->tosave);
53         }
54         Safefree(stab_sub(stab));
55     }
56     stab_sub(stab) = sub;
57     sub->filestab = curcmd->c_filestab;
58     saw_return = FALSE;
59     tosave = anew(Nullstab);
60     tosave->ary_fill = 0;       /* make 1 based */
61     (void)cmd_tosave(cmd,FALSE);        /* this builds the tosave array */
62     sub->tosave = tosave;
63     if (saw_return) {
64         struct compcmd mycompblock;
65
66         mycompblock.comp_true = cmd;
67         mycompblock.comp_alt = Nullcmd;
68         cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
69         saw_return = FALSE;
70         cmd->c_flags |= CF_TERM;
71     }
72     sub->cmd = cmd;
73     if (perldb) {
74         STR *str;
75         STR *tmpstr = str_mortal(&str_undef);
76
77         sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr,
78           (long)subline);
79         str = str_make(buf,0);
80         str_cat(str,"-");
81         sprintf(buf,"%ld",(long)curcmd->c_line);
82         str_cat(str,buf);
83         name = str_get(subname);
84         stab_fullname(tmpstr,stab);
85         hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
86         str_set(subname,"main");
87     }
88     subline = 0;
89     return sub;
90 }
91
92 SUBR *
93 make_usub(name, ix, subaddr, filename)
94 char *name;
95 int ix;
96 int (*subaddr)();
97 char *filename;
98 {
99     register SUBR *sub;
100     STAB *stab = stabent(name,allstabs);
101
102     if (!stab)                          /* unused function */
103         return Null(SUBR*);
104     Newz(101,sub,1,SUBR);
105     if (stab_sub(stab)) {
106         if (dowarn)
107             warn("Subroutine %s redefined",name);
108         if (stab_sub(stab)->cmd) {
109             cmd_free(stab_sub(stab)->cmd);
110             stab_sub(stab)->cmd = Nullcmd;
111             afree(stab_sub(stab)->tosave);
112         }
113         Safefree(stab_sub(stab));
114     }
115     stab_sub(stab) = sub;
116     sub->filestab = fstab(filename);
117     sub->usersub = subaddr;
118     sub->userindex = ix;
119     return sub;
120 }
121
122 make_form(stab,fcmd)
123 STAB *stab;
124 FCMD *fcmd;
125 {
126     if (stab_form(stab)) {
127         FCMD *tmpfcmd;
128         FCMD *nextfcmd;
129
130         for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
131             nextfcmd = tmpfcmd->f_next;
132             if (tmpfcmd->f_expr)
133                 arg_free(tmpfcmd->f_expr);
134             if (tmpfcmd->f_unparsed)
135                 str_free(tmpfcmd->f_unparsed);
136             if (tmpfcmd->f_pre)
137                 Safefree(tmpfcmd->f_pre);
138             Safefree(tmpfcmd);
139         }
140     }
141     stab_form(stab) = fcmd;
142 }
143
144 CMD *
145 block_head(tail)
146 register CMD *tail;
147 {
148     CMD *head;
149     register int opt;
150     register int last_opt = 0;
151     register STAB *last_stab = Nullstab;
152     register int count = 0;
153     register CMD *switchbeg = Nullcmd;
154
155     if (tail == Nullcmd) {
156         return tail;
157     }
158     head = tail->c_head;
159
160     for (tail = head; tail; tail = tail->c_next) {
161
162         /* save one measly dereference at runtime */
163         if (tail->c_type == C_IF) {
164             if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
165                 tail->c_flags |= CF_TERM;
166         }
167         else if (tail->c_type == C_EXPR) {
168             ARG *arg;
169
170             if (tail->ucmd.acmd.ac_expr)
171                 arg = tail->ucmd.acmd.ac_expr;
172             else
173                 arg = tail->c_expr;
174             if (arg) {
175                 if (arg->arg_type == O_RETURN)
176                     tail->c_flags |= CF_TERM;
177                 else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
178                     tail->c_flags |= CF_TERM;
179             }
180         }
181         if (!tail->c_next)
182             tail->c_flags |= CF_TERM;
183
184         if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
185             opt_arg(tail,1, tail->c_type == C_EXPR);
186
187         /* now do a little optimization on case-ish structures */
188         switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
189         case CFT_ANCHOR:
190             if (stabent("*",FALSE)) {   /* bad assumption here!!! */
191                 opt = 0;
192                 break;
193             }
194             /* FALL THROUGH */
195         case CFT_STROP:
196             opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
197             break;
198         case CFT_CCLASS:
199             opt = CFT_STROP;
200             break;
201         case CFT_NUMOP:
202             opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
203             if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
204                 opt = 0;
205             break;
206         default:
207             opt = 0;
208         }
209         if (opt && opt == last_opt && tail->c_stab == last_stab)
210             count++;
211         else {
212             if (count >= 3) {           /* is this the breakeven point? */
213                 if (last_opt == CFT_NUMOP)
214                     make_nswitch(switchbeg,count);
215                 else
216                     make_cswitch(switchbeg,count);
217             }
218             if (opt) {
219                 count = 1;
220                 switchbeg = tail;
221             }
222             else
223                 count = 0;
224         }
225         last_opt = opt;
226         last_stab = tail->c_stab;
227     }
228     if (count >= 3) {           /* is this the breakeven point? */
229         if (last_opt == CFT_NUMOP)
230             make_nswitch(switchbeg,count);
231         else
232             make_cswitch(switchbeg,count);
233     }
234     return head;
235 }
236
237 /* We've spotted a sequence of CMDs that all test the value of the same
238  * spat.  Thus we can insert a SWITCH in front and jump directly
239  * to the correct one.
240  */
241 make_cswitch(head,count)
242 register CMD *head;
243 int count;
244 {
245     register CMD *cur;
246     register CMD **loc;
247     register int i;
248     register int min = 255;
249     register int max = 0;
250
251     /* make a new head in the exact same spot */
252     New(102,cur, 1, CMD);
253 #ifdef STRUCTCOPY
254     *cur = *head;
255 #else
256     Copy(head,cur,1,CMD);
257 #endif
258     Zero(head,1,CMD);
259     head->c_type = C_CSWITCH;
260     head->c_next = cur;         /* insert new cmd at front of list */
261     head->c_stab = cur->c_stab;
262
263     Newz(103,loc,258,CMD*);
264     loc++;                              /* lie a little */
265     while (count--) {
266         if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
267             for (i = 0; i <= 255; i++) {
268                 if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
269                     loc[i] = cur;
270                     if (i < min)
271                         min = i;
272                     if (i > max)
273                         max = i;
274                 }
275             }
276         }
277         else {
278             i = *cur->c_short->str_ptr & 255;
279             if (!loc[i]) {
280                 loc[i] = cur;
281                 if (i < min)
282                     min = i;
283                 if (i > max)
284                     max = i;
285             }
286         }
287         cur = cur->c_next;
288     }
289     max++;
290     if (min > 0)
291         Copy(&loc[min],&loc[0], max - min, CMD*);
292     loc--;
293     min--;
294     max -= min;
295     for (i = 0; i <= max; i++)
296         if (!loc[i])
297             loc[i] = cur;
298     Renew(loc,max+1,CMD*);      /* chop it down to size */
299     head->ucmd.scmd.sc_offset = min;
300     head->ucmd.scmd.sc_max = max;
301     head->ucmd.scmd.sc_next = loc;
302 }
303
304 make_nswitch(head,count)
305 register CMD *head;
306 int count;
307 {
308     register CMD *cur = head;
309     register CMD **loc;
310     register int i;
311     register int min = 32767;
312     register int max = -32768;
313     int origcount = count;
314     double value;               /* or your money back! */
315     short changed;              /* so triple your money back! */
316
317     while (count--) {
318         i = (int)str_gnum(cur->c_short);
319         value = (double)i;
320         if (value != cur->c_short->str_u.str_nval)
321             return;             /* fractional values--just forget it */
322         changed = i;
323         if (changed != i)
324             return;             /* too big for a short */
325         if (cur->c_slen == O_LE)
326             i++;
327         else if (cur->c_slen == O_GE)   /* we only do < or > here */
328             i--;
329         if (i < min)
330             min = i;
331         if (i > max)
332             max = i;
333         cur = cur->c_next;
334     }
335     count = origcount;
336     if (max - min > count * 2 + 10)             /* too sparse? */
337         return;
338
339     /* now make a new head in the exact same spot */
340     New(104,cur, 1, CMD);
341 #ifdef STRUCTCOPY
342     *cur = *head;
343 #else
344     Copy(head,cur,1,CMD);
345 #endif
346     Zero(head,1,CMD);
347     head->c_type = C_NSWITCH;
348     head->c_next = cur;         /* insert new cmd at front of list */
349     head->c_stab = cur->c_stab;
350
351     Newz(105,loc, max - min + 3, CMD*);
352     loc++;
353     max -= min;
354     max++;
355     while (count--) {
356         i = (int)str_gnum(cur->c_short);
357         i -= min;
358         switch(cur->c_slen) {
359         case O_LE:
360             i++;
361         case O_LT:
362             for (i--; i >= -1; i--)
363                 if (!loc[i])
364                     loc[i] = cur;
365             break;
366         case O_GE:
367             i--;
368         case O_GT:
369             for (i++; i <= max; i++)
370                 if (!loc[i])
371                     loc[i] = cur;
372             break;
373         case O_EQ:
374             if (!loc[i])
375                 loc[i] = cur;
376             break;
377         }
378         cur = cur->c_next;
379     }
380     loc--;
381     min--;
382     max++;
383     for (i = 0; i <= max; i++)
384         if (!loc[i])
385             loc[i] = cur;
386     head->ucmd.scmd.sc_offset = min;
387     head->ucmd.scmd.sc_max = max;
388     head->ucmd.scmd.sc_next = loc;
389 }
390
391 CMD *
392 append_line(head,tail)
393 register CMD *head;
394 register CMD *tail;
395 {
396     if (tail == Nullcmd)
397         return head;
398     if (!tail->c_head)                  /* make sure tail is well formed */
399         tail->c_head = tail;
400     if (head != Nullcmd) {
401         tail = tail->c_head;            /* get to start of tail list */
402         if (!head->c_head)
403             head->c_head = head;        /* start a new head list */
404         while (head->c_next) {
405             head->c_next->c_head = head->c_head;
406             head = head->c_next;        /* get to end of head list */
407         }
408         head->c_next = tail;            /* link to end of old list */
409         tail->c_head = head->c_head;    /* propagate head pointer */
410     }
411     while (tail->c_next) {
412         tail->c_next->c_head = tail->c_head;
413         tail = tail->c_next;
414     }
415     return tail;
416 }
417
418 CMD *
419 dodb(cur)
420 CMD *cur;
421 {
422     register CMD *cmd;
423     register CMD *head = cur->c_head;
424     STR *str;
425
426     if (!head)
427         head = cur;
428     if (!head->c_line)
429         return cur;
430     str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
431     if (str == &str_undef || str->str_nok)
432         return cur;
433     str->str_u.str_nval = (double)head->c_line;
434     str->str_nok = 1;
435     Newz(106,cmd,1,CMD);
436     str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
437     str->str_magic->str_u.str_cmd = cmd;
438     cmd->c_type = C_EXPR;
439     cmd->ucmd.acmd.ac_stab = Nullstab;
440     cmd->ucmd.acmd.ac_expr = Nullarg;
441     cmd->c_expr = make_op(O_SUBR, 2,
442         stab2arg(A_WORD,DBstab),
443         Nullarg,
444         Nullarg);
445     cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
446     cmd->c_line = head->c_line;
447     cmd->c_label = head->c_label;
448     cmd->c_filestab = curcmd->c_filestab;
449     cmd->c_stash = curstash;
450     return append_line(cmd, cur);
451 }
452
453 CMD *
454 make_acmd(type,stab,cond,arg)
455 int type;
456 STAB *stab;
457 ARG *cond;
458 ARG *arg;
459 {
460     register CMD *cmd;
461
462     Newz(107,cmd,1,CMD);
463     cmd->c_type = type;
464     cmd->ucmd.acmd.ac_stab = stab;
465     cmd->ucmd.acmd.ac_expr = arg;
466     cmd->c_expr = cond;
467     if (cond)
468         cmd->c_flags |= CF_COND;
469     if (cmdline == NOLINE)
470         cmd->c_line = curcmd->c_line;
471     else {
472         cmd->c_line = cmdline;
473         cmdline = NOLINE;
474     }
475     cmd->c_filestab = curcmd->c_filestab;
476     cmd->c_stash = curstash;
477     if (perldb)
478         cmd = dodb(cmd);
479     return cmd;
480 }
481
482 CMD *
483 make_ccmd(type,arg,cblock)
484 int type;
485 ARG *arg;
486 struct compcmd cblock;
487 {
488     register CMD *cmd;
489
490     Newz(108,cmd, 1, CMD);
491     cmd->c_type = type;
492     cmd->c_expr = arg;
493     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
494     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
495     if (arg)
496         cmd->c_flags |= CF_COND;
497     if (cmdline == NOLINE)
498         cmd->c_line = curcmd->c_line;
499     else {
500         cmd->c_line = cmdline;
501         cmdline = NOLINE;
502     }
503     cmd->c_filestab = curcmd->c_filestab;
504     cmd->c_stash = curstash;
505     if (perldb)
506         cmd = dodb(cmd);
507     return cmd;
508 }
509
510 CMD *
511 make_icmd(type,arg,cblock)
512 int type;
513 ARG *arg;
514 struct compcmd cblock;
515 {
516     register CMD *cmd;
517     register CMD *alt;
518     register CMD *cur;
519     register CMD *head;
520     struct compcmd ncblock;
521
522     Newz(109,cmd, 1, CMD);
523     head = cmd;
524     cmd->c_type = type;
525     cmd->c_expr = arg;
526     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
527     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
528     if (arg)
529         cmd->c_flags |= CF_COND;
530     if (cmdline == NOLINE)
531         cmd->c_line = curcmd->c_line;
532     else {
533         cmd->c_line = cmdline;
534         cmdline = NOLINE;
535     }
536     cmd->c_filestab = curcmd->c_filestab;
537     cmd->c_stash = curstash;
538     cur = cmd;
539     alt = cblock.comp_alt;
540     while (alt && alt->c_type == C_ELSIF) {
541         cur = alt;
542         alt = alt->ucmd.ccmd.cc_alt;
543     }
544     if (alt) {                  /* a real life ELSE at the end? */
545         ncblock.comp_true = alt;
546         ncblock.comp_alt = Nullcmd;
547         alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
548         cur->ucmd.ccmd.cc_alt = alt;
549     }
550     else
551         alt = cur;              /* no ELSE, so cur is proxy ELSE */
552
553     cur = cmd;
554     while (cmd) {               /* now point everyone at the ELSE */
555         cur = cmd;
556         cmd = cur->ucmd.ccmd.cc_alt;
557         cur->c_head = head;
558         if (cur->c_type == C_ELSIF)
559             cur->c_type = C_IF;
560         if (cur->c_type == C_IF)
561             cur->ucmd.ccmd.cc_alt = alt;
562         if (cur == alt)
563             break;
564         cur->c_next = cmd;
565     }
566     if (perldb)
567         cur = dodb(cur);
568     return cur;
569 }
570
571 void
572 opt_arg(cmd,fliporflop,acmd)
573 register CMD *cmd;
574 int fliporflop;
575 int acmd;
576 {
577     register ARG *arg;
578     int opt = CFT_EVAL;
579     int sure = 0;
580     ARG *arg2;
581     int context = 0;    /* 0 = normal, 1 = before &&, 2 = before || */
582     int flp = fliporflop;
583
584     if (!cmd)
585         return;
586     if (!(arg = cmd->c_expr)) {
587         cmd->c_flags &= ~CF_COND;
588         return;
589     }
590
591     /* Can we turn && and || into if and unless? */
592
593     if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
594       (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
595         dehoist(arg,1);
596         arg[2].arg_type &= A_MASK;      /* don't suppress eval */
597         dehoist(arg,2);
598         cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
599         cmd->c_expr = arg[1].arg_ptr.arg_arg;
600         if (arg->arg_type == O_OR)
601             cmd->c_flags ^= CF_INVERT;          /* || is like unless */
602         arg->arg_len = 0;
603         free_arg(arg);
604         arg = cmd->c_expr;
605     }
606
607     /* Turn "if (!expr)" into "unless (expr)" */
608
609     if (!(cmd->c_flags & CF_TERM)) {            /* unless return value wanted */
610         while (arg->arg_type == O_NOT) {
611             dehoist(arg,1);
612             cmd->c_flags ^= CF_INVERT;          /* flip sense of cmd */
613             cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
614             free_arg(arg);
615             arg = cmd->c_expr;                  /* here we go again */
616         }
617     }
618
619     if (!arg->arg_len) {                /* sanity check */
620         cmd->c_flags |= opt;
621         return;
622     }
623
624     /* for "cond .. cond" we set up for the initial check */
625
626     if (arg->arg_type == O_FLIP)
627         context |= 4;
628
629     /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
630
631   morecontext:
632     if (arg->arg_type == O_AND)
633         context |= 1;
634     else if (arg->arg_type == O_OR)
635         context |= 2;
636     if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
637         arg = arg[flp].arg_ptr.arg_arg;
638         flp = 1;
639         if (arg->arg_type == O_AND || arg->arg_type == O_OR)
640             goto morecontext;
641     }
642     if ((context & 3) == 3)
643         return;
644
645     if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
646         cmd->c_flags |= opt;
647         if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
648           && cmd->c_expr->arg_type == O_ITEM) {
649             arg[flp].arg_flags &= ~AF_POST;     /* prefer ++$foo to $foo++ */
650             arg[flp].arg_flags |= AF_PRE;       /*  if value not wanted */
651         }
652         return;                         /* side effect, can't optimize */
653     }
654
655     if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
656       arg->arg_type == O_AND || arg->arg_type == O_OR) {
657         if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
658             opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
659             cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
660             goto literal;
661         }
662         else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
663           (arg[flp].arg_type & A_MASK) == A_LVAL) {
664             cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
665             if (!context)
666                 arg[flp].arg_ptr.arg_stab = Nullstab;
667             opt = CFT_REG;
668           literal:
669             if (!context) {     /* no && or ||? */
670                 arg_free(arg);
671                 cmd->c_expr = Nullarg;
672             }
673             if (!(context & 1))
674                 cmd->c_flags |= CF_EQSURE;
675             if (!(context & 2))
676                 cmd->c_flags |= CF_NESURE;
677         }
678     }
679     else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
680              arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
681         if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
682                 (arg[2].arg_type & A_MASK) == A_SPAT &&
683                 arg[2].arg_ptr.arg_spat->spat_short &&
684                 (arg->arg_type == O_SUBST || arg->arg_type == O_NSUBST ||
685                  (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_GLOBAL) == 0 )) {
686             cmd->c_stab  = arg[1].arg_ptr.arg_stab;
687             cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
688             cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
689             if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
690                 !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
691                 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
692                 sure |= CF_EQSURE;              /* (SUBST must be forced even */
693                                                 /* if we know it will work.) */
694             if (arg->arg_type != O_SUBST) {
695                 arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
696                 arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
697             }
698             sure |= CF_NESURE;          /* normally only sure if it fails */
699             if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
700                 cmd->c_flags |= CF_FIRSTNEG;
701             if (context & 1) {          /* only sure if thing is false */
702                 if (cmd->c_flags & CF_FIRSTNEG)
703                     sure &= ~CF_NESURE;
704                 else
705                     sure &= ~CF_EQSURE;
706             }
707             else if (context & 2) {     /* only sure if thing is true */
708                 if (cmd->c_flags & CF_FIRSTNEG)
709                     sure &= ~CF_EQSURE;
710                 else
711                     sure &= ~CF_NESURE;
712             }
713             if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
714                 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
715                     opt = CFT_SCAN;
716                 else
717                     opt = CFT_ANCHOR;
718                 if (sure == (CF_EQSURE|CF_NESURE)       /* really sure? */
719                     && arg->arg_type == O_MATCH
720                     && context & 4
721                     && fliporflop == 1) {
722                     spat_free(arg[2].arg_ptr.arg_spat);
723                     arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
724                 }
725                 else
726                     cmd->c_spat = arg[2].arg_ptr.arg_spat;
727                 cmd->c_flags |= sure;
728             }
729         }
730     }
731     else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
732              arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
733         if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
734             if (arg[2].arg_type == A_SINGLE) {
735                 char *junk = str_get(arg[2].arg_ptr.arg_str);
736
737                 cmd->c_stab  = arg[1].arg_ptr.arg_stab;
738                 cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
739                 cmd->c_slen  = cmd->c_short->str_cur+1;
740                 switch (arg->arg_type) {
741                 case O_SLT: case O_SGT:
742                     sure |= CF_EQSURE;
743                     cmd->c_flags |= CF_FIRSTNEG;
744                     break;
745                 case O_SNE:
746                     cmd->c_flags |= CF_FIRSTNEG;
747                     /* FALL THROUGH */
748                 case O_SEQ:
749                     sure |= CF_NESURE|CF_EQSURE;
750                     break;
751                 }
752                 if (context & 1) {      /* only sure if thing is false */
753                     if (cmd->c_flags & CF_FIRSTNEG)
754                         sure &= ~CF_NESURE;
755                     else
756                         sure &= ~CF_EQSURE;
757                 }
758                 else if (context & 2) { /* only sure if thing is true */
759                     if (cmd->c_flags & CF_FIRSTNEG)
760                         sure &= ~CF_EQSURE;
761                     else
762                         sure &= ~CF_NESURE;
763                 }
764                 if (sure & (CF_EQSURE|CF_NESURE)) {
765                     opt = CFT_STROP;
766                     cmd->c_flags |= sure;
767                 }
768             }
769         }
770     }
771     else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
772              arg->arg_type == O_LE || arg->arg_type == O_GE ||
773              arg->arg_type == O_LT || arg->arg_type == O_GT) {
774         if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
775             if (arg[2].arg_type == A_SINGLE) {
776                 cmd->c_stab  = arg[1].arg_ptr.arg_stab;
777                 if (dowarn) {
778                     STR *str = arg[2].arg_ptr.arg_str;
779
780                     if ((!str->str_nok && !looks_like_number(str)))
781                         warn("Possible use of == on string value");
782                 }
783                 cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
784                 cmd->c_slen = arg->arg_type;
785                 sure |= CF_NESURE|CF_EQSURE;
786                 if (context & 1) {      /* only sure if thing is false */
787                     sure &= ~CF_EQSURE;
788                 }
789                 else if (context & 2) { /* only sure if thing is true */
790                     sure &= ~CF_NESURE;
791                 }
792                 if (sure & (CF_EQSURE|CF_NESURE)) {
793                     opt = CFT_NUMOP;
794                     cmd->c_flags |= sure;
795                 }
796             }
797         }
798     }
799     else if (arg->arg_type == O_ASSIGN &&
800              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
801              arg[1].arg_ptr.arg_stab == defstab &&
802              arg[2].arg_type == A_EXPR ) {
803         arg2 = arg[2].arg_ptr.arg_arg;
804         if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
805             opt = CFT_GETS;
806             cmd->c_stab = arg2[1].arg_ptr.arg_stab;
807             if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
808                 free_arg(arg2);
809                 arg[2].arg_ptr.arg_arg = Nullarg;
810                 free_arg(arg);
811                 cmd->c_expr = Nullarg;
812             }
813         }
814     }
815     else if (arg->arg_type == O_CHOP &&
816              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
817         opt = CFT_CHOP;
818         cmd->c_stab = arg[1].arg_ptr.arg_stab;
819         free_arg(arg);
820         cmd->c_expr = Nullarg;
821     }
822     if (context & 4)
823         opt |= CF_FLIP;
824     cmd->c_flags |= opt;
825
826     if (cmd->c_flags & CF_FLIP) {
827         if (fliporflop == 1) {
828             arg = cmd->c_expr;  /* get back to O_FLIP arg */
829             New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
830             Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
831             New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
832             Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
833             opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
834             arg->arg_len = 2;           /* this is a lie */
835         }
836         else {
837             if ((opt & CF_OPTIMIZE) == CFT_EVAL)
838                 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
839         }
840     }
841 }
842
843 CMD *
844 add_label(lbl,cmd)
845 char *lbl;
846 register CMD *cmd;
847 {
848     if (cmd)
849         cmd->c_label = lbl;
850     return cmd;
851 }
852
853 CMD *
854 addcond(cmd, arg)
855 register CMD *cmd;
856 register ARG *arg;
857 {
858     cmd->c_expr = arg;
859     cmd->c_flags |= CF_COND;
860     return cmd;
861 }
862
863 CMD *
864 addloop(cmd, arg)
865 register CMD *cmd;
866 register ARG *arg;
867 {
868     void while_io();
869
870     cmd->c_expr = arg;
871     cmd->c_flags |= CF_COND|CF_LOOP;
872
873     if (!(cmd->c_flags & CF_INVERT))
874         while_io(cmd);          /* add $_ =, if necessary */
875
876     if (cmd->c_type == C_BLOCK)
877         cmd->c_flags &= ~CF_COND;
878     else {
879         arg = cmd->ucmd.acmd.ac_expr;
880         if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
881             cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
882         if (arg && (arg->arg_flags & AF_DEPR) &&
883           (arg->arg_type == O_SUBR || arg->arg_type == O_DBSUBR) )
884             cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
885     }
886     return cmd;
887 }
888
889 CMD *
890 invert(cmd)
891 CMD *cmd;
892 {
893     register CMD *targ = cmd;
894     if (targ->c_head)
895         targ = targ->c_head;
896     if (targ->c_flags & CF_DBSUB)
897         targ = targ->c_next;
898     targ->c_flags ^= CF_INVERT;
899     return cmd;
900 }
901
902 yyerror(s)
903 char *s;
904 {
905     char tmpbuf[258];
906     char tmp2buf[258];
907     char *tname = tmpbuf;
908
909     if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
910       oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
911         while (isspace(*oldoldbufptr))
912             oldoldbufptr++;
913         strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
914         tmp2buf[bufptr - oldoldbufptr] = '\0';
915         sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
916     }
917     else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
918       oldbufptr != bufptr) {
919         while (isspace(*oldbufptr))
920             oldbufptr++;
921         strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
922         tmp2buf[bufptr - oldbufptr] = '\0';
923         sprintf(tname,"next token \"%s\"",tmp2buf);
924     }
925     else if (yychar > 256)
926         tname = "next token ???";
927     else if (!yychar)
928         (void)strcpy(tname,"at EOF");
929     else if (yychar < 32)
930         (void)sprintf(tname,"next char ^%c",yychar+64);
931     else if (yychar == 127)
932         (void)strcpy(tname,"at EOF");
933     else
934         (void)sprintf(tname,"next char %c",yychar);
935     (void)sprintf(buf, "%s in file %s at line %d, %s\n",
936       s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
937     if (curcmd->c_line == multi_end && multi_start < multi_end)
938         sprintf(buf+strlen(buf),
939           "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
940           multi_open,multi_close,multi_start);
941     if (in_eval)
942         str_cat(stab_val(stabent("@",TRUE)),buf);
943     else
944         fputs(buf,stderr);
945     if (++error_count >= 10)
946         fatal("%s has too many errors.\n",
947         stab_val(curcmd->c_filestab)->str_ptr);
948 }
949
950 void
951 while_io(cmd)
952 register CMD *cmd;
953 {
954     register ARG *arg = cmd->c_expr;
955     STAB *asgnstab;
956
957     /* hoist "while (<channel>)" up into command block */
958
959     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
960         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
961         cmd->c_flags |= CFT_GETS;       /* and set it to do the input */
962         cmd->c_stab = arg[1].arg_ptr.arg_stab;
963         if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
964             cmd->c_expr = l(make_op(O_ASSIGN, 2,        /* fake up "$_ =" */
965                stab2arg(A_LVAL,defstab), arg, Nullarg));
966         }
967         else {
968             free_arg(arg);
969             cmd->c_expr = Nullarg;
970         }
971     }
972     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
973         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
974         cmd->c_flags |= CFT_INDGETS;    /* and set it to do the input */
975         cmd->c_stab = arg[1].arg_ptr.arg_stab;
976         free_arg(arg);
977         cmd->c_expr = Nullarg;
978     }
979     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
980         if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
981             asgnstab = cmd->c_stab;
982         else
983             asgnstab = defstab;
984         cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$foo =" */
985            stab2arg(A_LVAL,asgnstab), arg, Nullarg));
986         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
987     }
988 }
989
990 CMD *
991 wopt(cmd)
992 register CMD *cmd;
993 {
994     register CMD *tail;
995     CMD *newtail;
996     register int i;
997
998     if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
999         opt_arg(cmd,1, cmd->c_type == C_EXPR);
1000
1001     while_io(cmd);              /* add $_ =, if necessary */
1002
1003     /* First find the end of the true list */
1004
1005     tail = cmd->ucmd.ccmd.cc_true;
1006     if (tail == Nullcmd)
1007         return cmd;
1008     New(112,newtail, 1, CMD);   /* guaranteed continue */
1009     for (;;) {
1010         /* optimize "next" to point directly to continue block */
1011         if (tail->c_type == C_EXPR &&
1012             tail->ucmd.acmd.ac_expr &&
1013             tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1014             (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1015              (cmd->c_label &&
1016               strEQ(cmd->c_label,
1017                     tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1018         {
1019             arg_free(tail->ucmd.acmd.ac_expr);
1020             tail->ucmd.acmd.ac_expr = Nullarg;
1021             tail->c_type = C_NEXT;
1022             if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1023                 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1024             else
1025                 tail->ucmd.ccmd.cc_alt = newtail;
1026             tail->ucmd.ccmd.cc_true = Nullcmd;
1027         }
1028         else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1029             if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1030                 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1031             else
1032                 tail->ucmd.ccmd.cc_alt = newtail;
1033         }
1034         else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1035             if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1036                 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1037                     if (!tail->ucmd.scmd.sc_next[i])
1038                         tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
1039             }
1040             else {
1041                 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1042                     if (!tail->ucmd.scmd.sc_next[i])
1043                         tail->ucmd.scmd.sc_next[i] = newtail;
1044             }
1045         }
1046
1047         if (!tail->c_next)
1048             break;
1049         tail = tail->c_next;
1050     }
1051
1052     /* if there's a continue block, link it to true block and find end */
1053
1054     if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1055         tail->c_next = cmd->ucmd.ccmd.cc_alt;
1056         tail = tail->c_next;
1057         for (;;) {
1058             /* optimize "next" to point directly to continue block */
1059             if (tail->c_type == C_EXPR &&
1060                 tail->ucmd.acmd.ac_expr &&
1061                 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1062                 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1063                  (cmd->c_label &&
1064                   strEQ(cmd->c_label,
1065                         tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1066             {
1067                 arg_free(tail->ucmd.acmd.ac_expr);
1068                 tail->ucmd.acmd.ac_expr = Nullarg;
1069                 tail->c_type = C_NEXT;
1070                 tail->ucmd.ccmd.cc_alt = newtail;
1071                 tail->ucmd.ccmd.cc_true = Nullcmd;
1072             }
1073             else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1074                 tail->ucmd.ccmd.cc_alt = newtail;
1075             }
1076             else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1077                 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1078                     if (!tail->ucmd.scmd.sc_next[i])
1079                         tail->ucmd.scmd.sc_next[i] = newtail;
1080             }
1081
1082             if (!tail->c_next)
1083                 break;
1084             tail = tail->c_next;
1085         }
1086         for ( ; tail->c_next; tail = tail->c_next) ;
1087     }
1088
1089     /* Here's the real trick: link the end of the list back to the beginning,
1090      * inserting a "last" block to break out of the loop.  This saves one or
1091      * two procedure calls every time through the loop, because of how cmd_exec
1092      * does tail recursion.
1093      */
1094
1095     tail->c_next = newtail;
1096     tail = newtail;
1097     if (!cmd->ucmd.ccmd.cc_alt)
1098         cmd->ucmd.ccmd.cc_alt = tail;   /* every loop has a continue now */
1099
1100 #ifndef lint
1101     (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
1102 #endif
1103     tail->c_type = C_EXPR;
1104     tail->c_flags ^= CF_INVERT;         /* turn into "last unless" */
1105     tail->c_next = tail->ucmd.ccmd.cc_true;     /* loop directly back to top */
1106     tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
1107     tail->ucmd.acmd.ac_stab = Nullstab;
1108     return cmd;
1109 }
1110
1111 CMD *
1112 over(eachstab,cmd)
1113 STAB *eachstab;
1114 register CMD *cmd;
1115 {
1116     /* hoist "for $foo (@bar)" up into command block */
1117
1118     cmd->c_flags &= ~CF_OPTIMIZE;       /* clear optimization type */
1119     cmd->c_flags |= CFT_ARRAY;          /* and set it to do the iteration */
1120     cmd->c_stab = eachstab;
1121     cmd->c_short = str_new(0);          /* just to save a field in struct cmd */
1122     cmd->c_short->str_u.str_useful = -1;
1123
1124     return cmd;
1125 }
1126
1127 cmd_free(cmd)
1128 register CMD *cmd;
1129 {
1130     register CMD *tofree;
1131     register CMD *head = cmd;
1132
1133     while (cmd) {
1134         if (cmd->c_type != C_WHILE) {   /* WHILE block is duplicated */
1135             if (cmd->c_label) {
1136                 Safefree(cmd->c_label);
1137                 cmd->c_label = Nullch;
1138             }
1139             if (cmd->c_short) {
1140                 str_free(cmd->c_short);
1141                 cmd->c_short = Nullstr;
1142             }
1143             if (cmd->c_expr) {
1144                 arg_free(cmd->c_expr);
1145                 cmd->c_expr = Nullarg;
1146             }
1147         }
1148         switch (cmd->c_type) {
1149         case C_WHILE:
1150         case C_BLOCK:
1151         case C_ELSE:
1152         case C_IF:
1153             if (cmd->ucmd.ccmd.cc_true) {
1154                 cmd_free(cmd->ucmd.ccmd.cc_true);
1155                 cmd->ucmd.ccmd.cc_true = Nullcmd;
1156             }
1157             break;
1158         case C_EXPR:
1159             if (cmd->ucmd.acmd.ac_expr) {
1160                 arg_free(cmd->ucmd.acmd.ac_expr);
1161                 cmd->ucmd.acmd.ac_expr = Nullarg;
1162             }
1163             break;
1164         }
1165         tofree = cmd;
1166         cmd = cmd->c_next;
1167         if (tofree != head)             /* to get Saber to shut up */
1168             Safefree(tofree);
1169         if (cmd && cmd == head)         /* reached end of while loop */
1170             break;
1171     }
1172     Safefree(head);
1173 }
1174
1175 arg_free(arg)
1176 register ARG *arg;
1177 {
1178     register int i;
1179
1180     for (i = 1; i <= arg->arg_len; i++) {
1181         switch (arg[i].arg_type & A_MASK) {
1182         case A_NULL:
1183             if (arg->arg_type == O_TRANS) {
1184                 Safefree(arg[i].arg_ptr.arg_cval);
1185                 arg[i].arg_ptr.arg_cval = Nullch;
1186             }
1187             break;
1188         case A_LEXPR:
1189             if (arg->arg_type == O_AASSIGN &&
1190               arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
1191                 char *name = 
1192                   stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
1193
1194                 if (strnEQ("_GEN_",name, 5))    /* array for foreach */
1195                     hdelete(defstash,name,strlen(name));
1196             }
1197             /* FALL THROUGH */
1198         case A_EXPR:
1199             arg_free(arg[i].arg_ptr.arg_arg);
1200             arg[i].arg_ptr.arg_arg = Nullarg;
1201             break;
1202         case A_CMD:
1203             cmd_free(arg[i].arg_ptr.arg_cmd);
1204             arg[i].arg_ptr.arg_cmd = Nullcmd;
1205             break;
1206         case A_WORD:
1207         case A_STAB:
1208         case A_LVAL:
1209         case A_READ:
1210         case A_GLOB:
1211         case A_ARYLEN:
1212         case A_LARYLEN:
1213         case A_ARYSTAB:
1214         case A_LARYSTAB:
1215             break;
1216         case A_SINGLE:
1217         case A_DOUBLE:
1218         case A_BACKTICK:
1219             str_free(arg[i].arg_ptr.arg_str);
1220             arg[i].arg_ptr.arg_str = Nullstr;
1221             break;
1222         case A_SPAT:
1223             spat_free(arg[i].arg_ptr.arg_spat);
1224             arg[i].arg_ptr.arg_spat = Nullspat;
1225             break;
1226         }
1227     }
1228     free_arg(arg);
1229 }
1230
1231 spat_free(spat)
1232 register SPAT *spat;
1233 {
1234     register SPAT *sp;
1235     HENT *entry;
1236
1237     if (spat->spat_runtime) {
1238         arg_free(spat->spat_runtime);
1239         spat->spat_runtime = Nullarg;
1240     }
1241     if (spat->spat_repl) {
1242         arg_free(spat->spat_repl);
1243         spat->spat_repl = Nullarg;
1244     }
1245     if (spat->spat_short) {
1246         str_free(spat->spat_short);
1247         spat->spat_short = Nullstr;
1248     }
1249     if (spat->spat_regexp) {
1250         regfree(spat->spat_regexp);
1251         spat->spat_regexp = Null(REGEXP*);
1252     }
1253
1254     /* now unlink from spat list */
1255
1256     for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
1257         register HASH *stash;
1258         STAB *stab = (STAB*)entry->hent_val;
1259
1260         if (!stab)
1261             continue;
1262         stash = stab_hash(stab);
1263         if (!stash || stash->tbl_spatroot == Null(SPAT*))
1264             continue;
1265         if (stash->tbl_spatroot == spat)
1266             stash->tbl_spatroot = spat->spat_next;
1267         else {
1268             for (sp = stash->tbl_spatroot;
1269               sp && sp->spat_next != spat;
1270               sp = sp->spat_next)
1271                 ;
1272             if (sp)
1273                 sp->spat_next = spat->spat_next;
1274         }
1275     }
1276     Safefree(spat);
1277 }
1278
1279 /* Recursively descend a command sequence and push the address of any string
1280  * that needs saving on recursion onto the tosave array.
1281  */
1282
1283 static int
1284 cmd_tosave(cmd,willsave)
1285 register CMD *cmd;
1286 int willsave;                           /* willsave passes down the tree */
1287 {
1288     register CMD *head = cmd;
1289     int shouldsave = FALSE;             /* shouldsave passes up the tree */
1290     int tmpsave;
1291     register CMD *lastcmd = Nullcmd;
1292
1293     while (cmd) {
1294         if (cmd->c_expr)
1295             shouldsave |= arg_tosave(cmd->c_expr,willsave);
1296         switch (cmd->c_type) {
1297         case C_WHILE:
1298             if (cmd->ucmd.ccmd.cc_true) {
1299                 tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1300
1301                 /* Here we check to see if the temporary array generated for
1302                  * a foreach needs to be localized because of recursion.
1303                  */
1304                 if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
1305                     if (lastcmd &&
1306                       lastcmd->c_type == C_EXPR &&
1307                       lastcmd->c_expr) {
1308                         ARG *arg = lastcmd->c_expr;
1309
1310                         if (arg->arg_type == O_ASSIGN &&
1311                             arg[1].arg_type == A_LEXPR &&
1312                             arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
1313                             strnEQ("_GEN_",
1314                               stab_name(
1315                                 arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
1316                               5)) {     /* array generated for foreach */
1317                             (void)localize(arg);
1318                         }
1319                     }
1320
1321                     /* in any event, save the iterator */
1322
1323                     (void)apush(tosave,cmd->c_short);
1324                 }
1325                 shouldsave |= tmpsave;
1326             }
1327             break;
1328         case C_BLOCK:
1329         case C_ELSE:
1330         case C_IF:
1331             if (cmd->ucmd.ccmd.cc_true)
1332                 shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1333             break;
1334         case C_EXPR:
1335             if (cmd->ucmd.acmd.ac_expr)
1336                 shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
1337             break;
1338         }
1339         lastcmd = cmd;
1340         cmd = cmd->c_next;
1341         if (cmd && cmd == head)         /* reached end of while loop */
1342             break;
1343     }
1344     return shouldsave;
1345 }
1346
1347 static int
1348 arg_tosave(arg,willsave)
1349 register ARG *arg;
1350 int willsave;
1351 {
1352     register int i;
1353     int shouldsave = FALSE;
1354
1355     for (i = arg->arg_len; i >= 1; i--) {
1356         switch (arg[i].arg_type & A_MASK) {
1357         case A_NULL:
1358             break;
1359         case A_LEXPR:
1360         case A_EXPR:
1361             shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
1362             break;
1363         case A_CMD:
1364             shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
1365             break;
1366         case A_WORD:
1367         case A_STAB:
1368         case A_LVAL:
1369         case A_READ:
1370         case A_GLOB:
1371         case A_ARYLEN:
1372         case A_SINGLE:
1373         case A_DOUBLE:
1374         case A_BACKTICK:
1375             break;
1376         case A_SPAT:
1377             shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
1378             break;
1379         }
1380     }
1381     switch (arg->arg_type) {
1382     case O_RETURN:
1383         saw_return = TRUE;
1384         break;
1385     case O_EVAL:
1386     case O_SUBR:
1387         shouldsave = TRUE;
1388         break;
1389     }
1390     if (willsave)
1391         (void)apush(tosave,arg->arg_ptr.arg_str);
1392     return shouldsave;
1393 }
1394
1395 static int
1396 spat_tosave(spat)
1397 register SPAT *spat;
1398 {
1399     int shouldsave = FALSE;
1400
1401     if (spat->spat_runtime)
1402         shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
1403     if (spat->spat_repl) {
1404         shouldsave |= arg_tosave(spat->spat_repl,FALSE);
1405     }
1406
1407     return shouldsave;
1408 }
1409