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