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