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