1 /* $Header: cons.c,v 3.0.1.8 90/10/15 15:41:09 lwall Locked $
3 * Copyright (c) 1989, Larry Wall
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.
9 * Revision 3.0.1.8 90/10/15 15:41:09 lwall
10 * patch29: added caller
11 * patch29: scripts now run at almost full speed under the debugger
12 * patch29: the debugger now understands packages and evals
13 * patch29: package behavior is now more consistent
15 * Revision 3.0.1.7 90/08/09 02:35:52 lwall
16 * patch19: did preliminary work toward debugging packages and evals
17 * patch19: Added support for linked-in C subroutines
18 * patch19: Numeric literals are now stored only in floating point
19 * patch19: Added -c switch to do compilation only
21 * Revision 3.0.1.6 90/03/27 15:35:21 lwall
22 * patch16: formats didn't work inside eval
23 * patch16: $foo++ now optimized to ++$foo where value not required
25 * Revision 3.0.1.5 90/03/12 16:23:10 lwall
26 * patch13: perl -d coredumped on scripts with subs that did explicit return
28 * Revision 3.0.1.4 90/02/28 16:44:00 lwall
29 * patch9: subs which return by both mechanisms can clobber local return data
30 * patch9: changed internal SUB label to _SUB_
31 * patch9: line numbers were bogus during certain portions of foreach evaluation
33 * Revision 3.0.1.3 89/12/21 19:20:25 lwall
34 * patch7: made nested or recursive foreach work right
36 * Revision 3.0.1.2 89/11/17 15:08:53 lwall
37 * patch5: nested foreach on same array didn't work
39 * Revision 3.0.1.1 89/10/26 23:09:01 lwall
40 * patch1: numeric switch optimization was broken
41 * patch1: unless was broken when run under the debugger
43 * Revision 3.0 89/10/18 15:10:23 lwall
52 extern char *tokename[];
55 static int cmd_tosave();
56 static int arg_tosave();
57 static int spat_tosave();
59 static bool saw_return;
67 STAB *stab = stabent(name,TRUE);
72 CMD *oldcurcmd = curcmd;
76 warn("Subroutine %s redefined",name);
79 if (stab_sub(stab)->cmd) {
80 cmd_free(stab_sub(stab)->cmd);
81 afree(stab_sub(stab)->tosave);
83 Safefree(stab_sub(stab));
85 sub->filestab = curcmd->c_filestab;
87 tosave = anew(Nullstab);
88 tosave->ary_fill = 0; /* make 1 based */
89 (void)cmd_tosave(cmd,FALSE); /* this builds the tosave array */
92 struct compcmd mycompblock;
94 mycompblock.comp_true = cmd;
95 mycompblock.comp_alt = Nullcmd;
96 cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
98 cmd->c_flags |= CF_TERM;
101 stab_sub(stab) = sub;
104 STR *tmpstr = str_static(&str_undef);
106 sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr,
108 str = str_make(buf,0);
110 sprintf(buf,"%ld",(long)curcmd->c_line);
112 name = str_get(subname);
113 stab_fullname(tmpstr,stab);
114 hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
115 str_set(subname,"main");
122 make_usub(name, ix, subaddr, filename)
129 STAB *stab = stabent(name,allstabs);
131 if (!stab) /* unused function */
133 Newz(101,sub,1,SUBR);
134 if (stab_sub(stab)) {
136 warn("Subroutine %s redefined",name);
137 if (stab_sub(stab)->cmd) {
138 cmd_free(stab_sub(stab)->cmd);
139 afree(stab_sub(stab)->tosave);
141 Safefree(stab_sub(stab));
143 sub->filestab = fstab(filename);
144 sub->usersub = subaddr;
146 stab_sub(stab) = sub;
154 if (stab_form(stab)) {
158 for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
159 nextfcmd = tmpfcmd->f_next;
161 arg_free(tmpfcmd->f_expr);
162 if (tmpfcmd->f_unparsed)
163 str_free(tmpfcmd->f_unparsed);
165 Safefree(tmpfcmd->f_pre);
169 stab_form(stab) = fcmd;
178 register int last_opt = 0;
179 register STAB *last_stab = Nullstab;
180 register int count = 0;
181 register CMD *switchbeg = Nullcmd;
183 if (tail == Nullcmd) {
188 for (tail = head; tail; tail = tail->c_next) {
190 /* save one measly dereference at runtime */
191 if (tail->c_type == C_IF) {
192 if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
193 tail->c_flags |= CF_TERM;
195 else if (tail->c_type == C_EXPR) {
198 if (tail->ucmd.acmd.ac_expr)
199 arg = tail->ucmd.acmd.ac_expr;
203 if (arg->arg_type == O_RETURN)
204 tail->c_flags |= CF_TERM;
205 else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
206 tail->c_flags |= CF_TERM;
210 tail->c_flags |= CF_TERM;
212 if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
213 opt_arg(tail,1, tail->c_type == C_EXPR);
215 /* now do a little optimization on case-ish structures */
216 switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
218 if (stabent("*",FALSE)) { /* bad assumption here!!! */
224 opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
230 opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
231 if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
237 if (opt && opt == last_opt && tail->c_stab == last_stab)
240 if (count >= 3) { /* is this the breakeven point? */
241 if (last_opt == CFT_NUMOP)
242 make_nswitch(switchbeg,count);
244 make_cswitch(switchbeg,count);
254 last_stab = tail->c_stab;
256 if (count >= 3) { /* is this the breakeven point? */
257 if (last_opt == CFT_NUMOP)
258 make_nswitch(switchbeg,count);
260 make_cswitch(switchbeg,count);
265 /* We've spotted a sequence of CMDs that all test the value of the same
266 * spat. Thus we can insert a SWITCH in front and jump directly
267 * to the correct one.
269 make_cswitch(head,count)
276 register int min = 255;
277 register int max = 0;
279 /* make a new head in the exact same spot */
280 New(102,cur, 1, CMD);
284 Copy(head,cur,1,CMD);
287 head->c_type = C_CSWITCH;
288 head->c_next = cur; /* insert new cmd at front of list */
289 head->c_stab = cur->c_stab;
291 Newz(103,loc,258,CMD*);
292 loc++; /* lie a little */
294 if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
295 for (i = 0; i <= 255; i++) {
296 if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
306 i = *cur->c_short->str_ptr & 255;
319 Copy(&loc[min],&loc[0], max - min, CMD*);
323 for (i = 0; i <= max; i++)
326 Renew(loc,max+1,CMD*); /* chop it down to size */
327 head->ucmd.scmd.sc_offset = min;
328 head->ucmd.scmd.sc_max = max;
329 head->ucmd.scmd.sc_next = loc;
332 make_nswitch(head,count)
336 register CMD *cur = head;
339 register int min = 32767;
340 register int max = -32768;
341 int origcount = count;
342 double value; /* or your money back! */
343 short changed; /* so triple your money back! */
346 i = (int)str_gnum(cur->c_short);
348 if (value != cur->c_short->str_u.str_nval)
349 return; /* fractional values--just forget it */
352 return; /* too big for a short */
353 if (cur->c_slen == O_LE)
355 else if (cur->c_slen == O_GE) /* we only do < or > here */
364 if (max - min > count * 2 + 10) /* too sparse? */
367 /* now make a new head in the exact same spot */
368 New(104,cur, 1, CMD);
372 Copy(head,cur,1,CMD);
375 head->c_type = C_NSWITCH;
376 head->c_next = cur; /* insert new cmd at front of list */
377 head->c_stab = cur->c_stab;
379 Newz(105,loc, max - min + 3, CMD*);
384 i = (int)str_gnum(cur->c_short);
386 switch(cur->c_slen) {
390 for (i--; i >= -1; i--)
397 for (i++; i <= max; i++)
411 for (i = 0; i <= max; i++)
414 head->ucmd.scmd.sc_offset = min;
415 head->ucmd.scmd.sc_max = max;
416 head->ucmd.scmd.sc_next = loc;
420 append_line(head,tail)
426 if (!tail->c_head) /* make sure tail is well formed */
428 if (head != Nullcmd) {
429 tail = tail->c_head; /* get to start of tail list */
431 head->c_head = head; /* start a new head list */
432 while (head->c_next) {
433 head->c_next->c_head = head->c_head;
434 head = head->c_next; /* get to end of head list */
436 head->c_next = tail; /* link to end of old list */
437 tail->c_head = head->c_head; /* propagate head pointer */
439 while (tail->c_next) {
440 tail->c_next->c_head = tail->c_head;
451 register CMD *head = cur->c_head;
459 str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
460 if (str == &str_undef || str->str_nok)
462 str->str_u.str_nval = (double)head->c_line;
465 str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
466 str->str_magic->str_u.str_cmd = cmd;
467 cmd->c_type = C_EXPR;
468 cmd->ucmd.acmd.ac_stab = Nullstab;
469 cmd->ucmd.acmd.ac_expr = Nullarg;
470 cmd->c_expr = make_op(O_SUBR, 1,
471 stab2arg(A_WORD,DBstab),
474 cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
475 cmd->c_line = head->c_line;
476 cmd->c_label = head->c_label;
477 cmd->c_filestab = curcmd->c_filestab;
478 cmd->c_stash = curstash;
479 return append_line(cmd, cur);
483 make_acmd(type,stab,cond,arg)
493 cmd->ucmd.acmd.ac_stab = stab;
494 cmd->ucmd.acmd.ac_expr = arg;
497 cmd->c_flags |= CF_COND;
498 if (cmdline == NOLINE)
499 cmd->c_line = curcmd->c_line;
501 cmd->c_line = cmdline;
504 cmd->c_filestab = curcmd->c_filestab;
505 cmd->c_stash = curstash;
512 make_ccmd(type,arg,cblock)
515 struct compcmd cblock;
519 Newz(108,cmd, 1, CMD);
522 cmd->ucmd.ccmd.cc_true = cblock.comp_true;
523 cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
525 cmd->c_flags |= CF_COND;
526 if (cmdline == NOLINE)
527 cmd->c_line = curcmd->c_line;
529 cmd->c_line = cmdline;
532 cmd->c_filestab = curcmd->c_filestab;
533 cmd->c_stash = curstash;
540 make_icmd(type,arg,cblock)
543 struct compcmd cblock;
549 struct compcmd ncblock;
551 Newz(109,cmd, 1, CMD);
555 cmd->ucmd.ccmd.cc_true = cblock.comp_true;
556 cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
558 cmd->c_flags |= CF_COND;
559 if (cmdline == NOLINE)
560 cmd->c_line = curcmd->c_line;
562 cmd->c_line = cmdline;
565 cmd->c_filestab = curcmd->c_filestab;
566 cmd->c_stash = curstash;
568 alt = cblock.comp_alt;
569 while (alt && alt->c_type == C_ELSIF) {
571 alt = alt->ucmd.ccmd.cc_alt;
573 if (alt) { /* a real life ELSE at the end? */
574 ncblock.comp_true = alt;
575 ncblock.comp_alt = Nullcmd;
576 alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
577 cur->ucmd.ccmd.cc_alt = alt;
580 alt = cur; /* no ELSE, so cur is proxy ELSE */
583 while (cmd) { /* now point everyone at the ELSE */
585 cmd = cur->ucmd.ccmd.cc_alt;
587 if (cur->c_type == C_ELSIF)
589 if (cur->c_type == C_IF)
590 cur->ucmd.ccmd.cc_alt = alt;
601 opt_arg(cmd,fliporflop,acmd)
610 int context = 0; /* 0 = normal, 1 = before &&, 2 = before || */
611 int flp = fliporflop;
615 if (!(arg = cmd->c_expr)) {
616 cmd->c_flags &= ~CF_COND;
620 /* Can we turn && and || into if and unless? */
622 if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
623 (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
625 arg[2].arg_type &= A_MASK; /* don't suppress eval */
627 cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
628 cmd->c_expr = arg[1].arg_ptr.arg_arg;
629 if (arg->arg_type == O_OR)
630 cmd->c_flags ^= CF_INVERT; /* || is like unless */
636 /* Turn "if (!expr)" into "unless (expr)" */
638 if (!(cmd->c_flags & CF_TERM)) { /* unless return value wanted */
639 while (arg->arg_type == O_NOT) {
641 cmd->c_flags ^= CF_INVERT; /* flip sense of cmd */
642 cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
644 arg = cmd->c_expr; /* here we go again */
648 if (!arg->arg_len) { /* sanity check */
653 /* for "cond .. cond" we set up for the initial check */
655 if (arg->arg_type == O_FLIP)
658 /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
661 if (arg->arg_type == O_AND)
663 else if (arg->arg_type == O_OR)
665 if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
666 arg = arg[flp].arg_ptr.arg_arg;
668 if (arg->arg_type == O_AND || arg->arg_type == O_OR)
671 if ((context & 3) == 3)
674 if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
676 if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)) {
677 arg[flp].arg_flags &= ~AF_POST; /* prefer ++$foo to $foo++ */
678 arg[flp].arg_flags |= AF_PRE; /* if value not wanted */
680 return; /* side effect, can't optimize */
683 if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
684 arg->arg_type == O_AND || arg->arg_type == O_OR) {
685 if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
686 opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
687 cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
690 else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
691 (arg[flp].arg_type & A_MASK) == A_LVAL) {
692 cmd->c_stab = arg[flp].arg_ptr.arg_stab;
695 if (!context) { /* no && or ||? */
697 cmd->c_expr = Nullarg;
700 cmd->c_flags |= CF_EQSURE;
702 cmd->c_flags |= CF_NESURE;
705 else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
706 arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
707 if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
708 (arg[2].arg_type & A_MASK) == A_SPAT &&
709 arg[2].arg_ptr.arg_spat->spat_short ) {
710 cmd->c_stab = arg[1].arg_ptr.arg_stab;
711 cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
712 cmd->c_slen = arg[2].arg_ptr.arg_spat->spat_slen;
713 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
714 !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
715 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
716 sure |= CF_EQSURE; /* (SUBST must be forced even */
717 /* if we know it will work.) */
718 if (arg->arg_type != O_SUBST) {
719 arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
720 arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
722 sure |= CF_NESURE; /* normally only sure if it fails */
723 if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
724 cmd->c_flags |= CF_FIRSTNEG;
725 if (context & 1) { /* only sure if thing is false */
726 if (cmd->c_flags & CF_FIRSTNEG)
731 else if (context & 2) { /* only sure if thing is true */
732 if (cmd->c_flags & CF_FIRSTNEG)
737 if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
738 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
742 if (sure == (CF_EQSURE|CF_NESURE) /* really sure? */
743 && arg->arg_type == O_MATCH
745 && fliporflop == 1) {
746 spat_free(arg[2].arg_ptr.arg_spat);
747 arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
749 cmd->c_flags |= sure;
753 else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
754 arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
755 if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
756 if (arg[2].arg_type == A_SINGLE) {
757 char *junk = str_get(arg[2].arg_ptr.arg_str);
759 cmd->c_stab = arg[1].arg_ptr.arg_stab;
760 cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
761 cmd->c_slen = cmd->c_short->str_cur+1;
762 switch (arg->arg_type) {
763 case O_SLT: case O_SGT:
765 cmd->c_flags |= CF_FIRSTNEG;
768 cmd->c_flags |= CF_FIRSTNEG;
771 sure |= CF_NESURE|CF_EQSURE;
774 if (context & 1) { /* only sure if thing is false */
775 if (cmd->c_flags & CF_FIRSTNEG)
780 else if (context & 2) { /* only sure if thing is true */
781 if (cmd->c_flags & CF_FIRSTNEG)
786 if (sure & (CF_EQSURE|CF_NESURE)) {
788 cmd->c_flags |= sure;
793 else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
794 arg->arg_type == O_LE || arg->arg_type == O_GE ||
795 arg->arg_type == O_LT || arg->arg_type == O_GT) {
796 if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
797 if (arg[2].arg_type == A_SINGLE) {
798 cmd->c_stab = arg[1].arg_ptr.arg_stab;
800 STR *str = arg[2].arg_ptr.arg_str;
802 if ((!str->str_nok && !looks_like_number(str)))
803 warn("Possible use of == on string value");
805 cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
806 cmd->c_slen = arg->arg_type;
807 sure |= CF_NESURE|CF_EQSURE;
808 if (context & 1) { /* only sure if thing is false */
811 else if (context & 2) { /* only sure if thing is true */
814 if (sure & (CF_EQSURE|CF_NESURE)) {
816 cmd->c_flags |= sure;
821 else if (arg->arg_type == O_ASSIGN &&
822 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
823 arg[1].arg_ptr.arg_stab == defstab &&
824 arg[2].arg_type == A_EXPR ) {
825 arg2 = arg[2].arg_ptr.arg_arg;
826 if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
828 cmd->c_stab = arg2[1].arg_ptr.arg_stab;
829 if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
832 cmd->c_expr = Nullarg;
836 else if (arg->arg_type == O_CHOP &&
837 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
839 cmd->c_stab = arg[1].arg_ptr.arg_stab;
841 cmd->c_expr = Nullarg;
847 if (cmd->c_flags & CF_FLIP) {
848 if (fliporflop == 1) {
849 arg = cmd->c_expr; /* get back to O_FLIP arg */
850 New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
851 Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
852 New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
853 Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
854 opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
855 arg->arg_len = 2; /* this is a lie */
858 if ((opt & CF_OPTIMIZE) == CFT_EVAL)
859 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
880 cmd->c_flags |= CF_COND;
892 cmd->c_flags |= CF_COND|CF_LOOP;
894 if (!(cmd->c_flags & CF_INVERT))
895 while_io(cmd); /* add $_ =, if necessary */
897 if (cmd->c_type == C_BLOCK)
898 cmd->c_flags &= ~CF_COND;
900 arg = cmd->ucmd.acmd.ac_expr;
901 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
902 cmd->c_flags &= ~CF_COND; /* "do {} while" happens at least once */
903 if (arg && arg->arg_type == O_SUBR)
904 cmd->c_flags &= ~CF_COND; /* likewise for "do subr() while" */
913 register CMD *targ = cmd;
916 if (targ->c_flags & CF_DBSUB)
918 targ->c_flags ^= CF_INVERT;
927 char *tname = tmpbuf;
929 if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
930 oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
931 while (isspace(*oldoldbufptr))
933 strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
934 tmp2buf[bufptr - oldoldbufptr] = '\0';
935 sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
937 else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
938 oldbufptr != bufptr) {
939 while (isspace(*oldbufptr))
941 strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
942 tmp2buf[bufptr - oldbufptr] = '\0';
943 sprintf(tname,"next token \"%s\"",tmp2buf);
945 else if (yychar > 256)
946 tname = "next token ???";
948 (void)strcpy(tname,"at EOF");
949 else if (yychar < 32)
950 (void)sprintf(tname,"next char ^%c",yychar+64);
951 else if (yychar == 127)
952 (void)strcpy(tname,"at EOF");
954 (void)sprintf(tname,"next char %c",yychar);
955 (void)sprintf(buf, "%s in file %s at line %d, %s\n",
956 s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
957 if (curcmd->c_line == multi_end && multi_start < multi_end)
958 sprintf(buf+strlen(buf),
959 " (Might be a runaway multi-line %c%c string starting on line %d)\n",
960 multi_open,multi_close,multi_start);
962 str_cat(stab_val(stabent("@",TRUE)),buf);
965 if (++error_count >= 10)
966 fatal("%s has too many errors.\n",
967 stab_val(curcmd->c_filestab)->str_ptr);
974 register ARG *arg = cmd->c_expr;
977 /* hoist "while (<channel>)" up into command block */
979 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
980 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
981 cmd->c_flags |= CFT_GETS; /* and set it to do the input */
982 cmd->c_stab = arg[1].arg_ptr.arg_stab;
983 if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
984 cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */
985 stab2arg(A_LVAL,defstab), arg, Nullarg));
989 cmd->c_expr = Nullarg;
992 else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
993 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
994 cmd->c_flags |= CFT_INDGETS; /* and set it to do the input */
995 cmd->c_stab = arg[1].arg_ptr.arg_stab;
997 cmd->c_expr = Nullarg;
999 else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
1000 if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
1001 asgnstab = cmd->c_stab;
1004 cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$foo =" */
1005 stab2arg(A_LVAL,asgnstab), arg, Nullarg));
1006 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
1018 if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
1019 opt_arg(cmd,1, cmd->c_type == C_EXPR);
1021 while_io(cmd); /* add $_ =, if necessary */
1023 /* First find the end of the true list */
1025 tail = cmd->ucmd.ccmd.cc_true;
1026 if (tail == Nullcmd)
1028 New(112,newtail, 1, CMD); /* guaranteed continue */
1030 /* optimize "next" to point directly to continue block */
1031 if (tail->c_type == C_EXPR &&
1032 tail->ucmd.acmd.ac_expr &&
1033 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1034 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1037 tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1039 arg_free(tail->ucmd.acmd.ac_expr);
1040 tail->c_type = C_NEXT;
1041 if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1042 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1044 tail->ucmd.ccmd.cc_alt = newtail;
1045 tail->ucmd.ccmd.cc_true = Nullcmd;
1047 else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1048 if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1049 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1051 tail->ucmd.ccmd.cc_alt = newtail;
1053 else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1054 if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1055 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1056 if (!tail->ucmd.scmd.sc_next[i])
1057 tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
1060 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1061 if (!tail->ucmd.scmd.sc_next[i])
1062 tail->ucmd.scmd.sc_next[i] = newtail;
1068 tail = tail->c_next;
1071 /* if there's a continue block, link it to true block and find end */
1073 if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1074 tail->c_next = cmd->ucmd.ccmd.cc_alt;
1075 tail = tail->c_next;
1077 /* optimize "next" to point directly to continue block */
1078 if (tail->c_type == C_EXPR &&
1079 tail->ucmd.acmd.ac_expr &&
1080 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1081 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1084 tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1086 arg_free(tail->ucmd.acmd.ac_expr);
1087 tail->c_type = C_NEXT;
1088 tail->ucmd.ccmd.cc_alt = newtail;
1089 tail->ucmd.ccmd.cc_true = Nullcmd;
1091 else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1092 tail->ucmd.ccmd.cc_alt = newtail;
1094 else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1095 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1096 if (!tail->ucmd.scmd.sc_next[i])
1097 tail->ucmd.scmd.sc_next[i] = newtail;
1102 tail = tail->c_next;
1104 for ( ; tail->c_next; tail = tail->c_next) ;
1107 /* Here's the real trick: link the end of the list back to the beginning,
1108 * inserting a "last" block to break out of the loop. This saves one or
1109 * two procedure calls every time through the loop, because of how cmd_exec
1110 * does tail recursion.
1113 tail->c_next = newtail;
1115 if (!cmd->ucmd.ccmd.cc_alt)
1116 cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */
1119 (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
1121 tail->c_type = C_EXPR;
1122 tail->c_flags ^= CF_INVERT; /* turn into "last unless" */
1123 tail->c_next = tail->ucmd.ccmd.cc_true; /* loop directly back to top */
1124 tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
1125 tail->ucmd.acmd.ac_stab = Nullstab;
1134 /* hoist "for $foo (@bar)" up into command block */
1136 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
1137 cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */
1138 cmd->c_stab = eachstab;
1139 cmd->c_short = str_new(0); /* just to save a field in struct cmd */
1140 cmd->c_short->str_u.str_useful = -1;
1148 register CMD *tofree;
1149 register CMD *head = cmd;
1152 if (cmd->c_type != C_WHILE) { /* WHILE block is duplicated */
1154 Safefree(cmd->c_label);
1156 str_free(cmd->c_short);
1158 spat_free(cmd->c_spat);
1160 arg_free(cmd->c_expr);
1162 switch (cmd->c_type) {
1167 if (cmd->ucmd.ccmd.cc_true)
1168 cmd_free(cmd->ucmd.ccmd.cc_true);
1171 if (cmd->ucmd.acmd.ac_expr)
1172 arg_free(cmd->ucmd.acmd.ac_expr);
1177 if (tofree != head) /* to get Saber to shut up */
1179 if (cmd && cmd == head) /* reached end of while loop */
1190 for (i = 1; i <= arg->arg_len; i++) {
1191 switch (arg[i].arg_type & A_MASK) {
1195 if (arg->arg_type == O_AASSIGN &&
1196 arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
1198 stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
1200 if (strnEQ("_GEN_",name, 5)) /* array for foreach */
1201 hdelete(defstash,name,strlen(name));
1205 arg_free(arg[i].arg_ptr.arg_arg);
1208 cmd_free(arg[i].arg_ptr.arg_cmd);
1223 str_free(arg[i].arg_ptr.arg_str);
1226 spat_free(arg[i].arg_ptr.arg_spat);
1234 register SPAT *spat;
1239 if (spat->spat_runtime)
1240 arg_free(spat->spat_runtime);
1241 if (spat->spat_repl) {
1242 arg_free(spat->spat_repl);
1244 if (spat->spat_short) {
1245 str_free(spat->spat_short);
1247 if (spat->spat_regexp) {
1248 regfree(spat->spat_regexp);
1251 /* now unlink from spat list */
1253 for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
1254 register HASH *stash;
1255 STAB *stab = (STAB*)entry->hent_val;
1259 stash = stab_hash(stab);
1260 if (!stash || stash->tbl_spatroot == Null(SPAT*))
1262 if (stash->tbl_spatroot == spat)
1263 stash->tbl_spatroot = spat->spat_next;
1265 for (sp = stash->tbl_spatroot;
1266 sp && sp->spat_next != spat;
1270 sp->spat_next = spat->spat_next;
1276 /* Recursively descend a command sequence and push the address of any string
1277 * that needs saving on recursion onto the tosave array.
1281 cmd_tosave(cmd,willsave)
1283 int willsave; /* willsave passes down the tree */
1285 register CMD *head = cmd;
1286 int shouldsave = FALSE; /* shouldsave passes up the tree */
1288 register CMD *lastcmd = Nullcmd;
1292 shouldsave |= spat_tosave(cmd->c_spat);
1294 shouldsave |= arg_tosave(cmd->c_expr,willsave);
1295 switch (cmd->c_type) {
1297 if (cmd->ucmd.ccmd.cc_true) {
1298 tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1300 /* Here we check to see if the temporary array generated for
1301 * a foreach needs to be localized because of recursion.
1303 if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
1305 lastcmd->c_type == C_EXPR &&
1306 lastcmd->ucmd.acmd.ac_expr) {
1307 ARG *arg = lastcmd->ucmd.acmd.ac_expr;
1309 if (arg->arg_type == O_ASSIGN &&
1310 arg[1].arg_type == A_LEXPR &&
1311 arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
1314 arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
1315 5)) { /* array generated for foreach */
1316 (void)localize(arg[1].arg_ptr.arg_arg);
1320 /* in any event, save the iterator */
1322 (void)apush(tosave,cmd->c_short);
1324 shouldsave |= tmpsave;
1330 if (cmd->ucmd.ccmd.cc_true)
1331 shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1334 if (cmd->ucmd.acmd.ac_expr)
1335 shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
1340 if (cmd && cmd == head) /* reached end of while loop */
1347 arg_tosave(arg,willsave)
1352 int shouldsave = FALSE;
1354 for (i = arg->arg_len; i >= 1; i--) {
1355 switch (arg[i].arg_type & A_MASK) {
1360 shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
1363 shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
1376 shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
1380 switch (arg->arg_type) {
1390 (void)apush(tosave,arg->arg_ptr.arg_str);
1396 register SPAT *spat;
1398 int shouldsave = FALSE;
1400 if (spat->spat_runtime)
1401 shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
1402 if (spat->spat_repl) {
1403 shouldsave |= arg_tosave(spat->spat_repl,FALSE);