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