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