1 /* $Header: cons.c,v 3.0.1.10 91/01/11 17:33:33 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.10 91/01/11 17:33:33 lwall
10 * patch42: the perl debugger was dumping core frequently
11 * patch42: the postincrement to preincrement optimizer was overzealous
12 * patch42: foreach didn't localize its temp array properly
14 * Revision 3.0.1.9 90/11/10 01:10:50 lwall
15 * patch38: random cleanup
17 * Revision 3.0.1.8 90/10/15 15:41:09 lwall
18 * patch29: added caller
19 * patch29: scripts now run at almost full speed under the debugger
20 * patch29: the debugger now understands packages and evals
21 * patch29: package behavior is now more consistent
23 * Revision 3.0.1.7 90/08/09 02:35:52 lwall
24 * patch19: did preliminary work toward debugging packages and evals
25 * patch19: Added support for linked-in C subroutines
26 * patch19: Numeric literals are now stored only in floating point
27 * patch19: Added -c switch to do compilation only
29 * Revision 3.0.1.6 90/03/27 15:35:21 lwall
30 * patch16: formats didn't work inside eval
31 * patch16: $foo++ now optimized to ++$foo where value not required
33 * Revision 3.0.1.5 90/03/12 16:23:10 lwall
34 * patch13: perl -d coredumped on scripts with subs that did explicit return
36 * Revision 3.0.1.4 90/02/28 16:44:00 lwall
37 * patch9: subs which return by both mechanisms can clobber local return data
38 * patch9: changed internal SUB label to _SUB_
39 * patch9: line numbers were bogus during certain portions of foreach evaluation
41 * Revision 3.0.1.3 89/12/21 19:20:25 lwall
42 * patch7: made nested or recursive foreach work right
44 * Revision 3.0.1.2 89/11/17 15:08:53 lwall
45 * patch5: nested foreach on same array didn't work
47 * Revision 3.0.1.1 89/10/26 23:09:01 lwall
48 * patch1: numeric switch optimization was broken
49 * patch1: unless was broken when run under the debugger
51 * Revision 3.0 89/10/18 15:10:23 lwall
60 extern char *tokename[];
63 static int cmd_tosave();
64 static int arg_tosave();
65 static int spat_tosave();
67 static bool saw_return;
75 STAB *stab = stabent(name,TRUE);
80 CMD *oldcurcmd = curcmd;
84 warn("Subroutine %s redefined",name);
87 if (stab_sub(stab)->cmd) {
88 cmd_free(stab_sub(stab)->cmd);
89 afree(stab_sub(stab)->tosave);
91 Safefree(stab_sub(stab));
93 sub->filestab = curcmd->c_filestab;
95 tosave = anew(Nullstab);
96 tosave->ary_fill = 0; /* make 1 based */
97 (void)cmd_tosave(cmd,FALSE); /* this builds the tosave array */
100 struct compcmd mycompblock;
102 mycompblock.comp_true = cmd;
103 mycompblock.comp_alt = Nullcmd;
104 cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
106 cmd->c_flags |= CF_TERM;
109 stab_sub(stab) = sub;
112 STR *tmpstr = str_static(&str_undef);
114 sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr,
116 str = str_make(buf,0);
118 sprintf(buf,"%ld",(long)curcmd->c_line);
120 name = str_get(subname);
121 stab_fullname(tmpstr,stab);
122 hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
123 str_set(subname,"main");
130 make_usub(name, ix, subaddr, filename)
137 STAB *stab = stabent(name,allstabs);
139 if (!stab) /* unused function */
141 Newz(101,sub,1,SUBR);
142 if (stab_sub(stab)) {
144 warn("Subroutine %s redefined",name);
145 if (stab_sub(stab)->cmd) {
146 cmd_free(stab_sub(stab)->cmd);
147 afree(stab_sub(stab)->tosave);
149 Safefree(stab_sub(stab));
151 sub->filestab = fstab(filename);
152 sub->usersub = subaddr;
154 stab_sub(stab) = sub;
162 if (stab_form(stab)) {
166 for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
167 nextfcmd = tmpfcmd->f_next;
169 arg_free(tmpfcmd->f_expr);
170 if (tmpfcmd->f_unparsed)
171 str_free(tmpfcmd->f_unparsed);
173 Safefree(tmpfcmd->f_pre);
177 stab_form(stab) = fcmd;
186 register int last_opt = 0;
187 register STAB *last_stab = Nullstab;
188 register int count = 0;
189 register CMD *switchbeg = Nullcmd;
191 if (tail == Nullcmd) {
196 for (tail = head; tail; tail = tail->c_next) {
198 /* save one measly dereference at runtime */
199 if (tail->c_type == C_IF) {
200 if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
201 tail->c_flags |= CF_TERM;
203 else if (tail->c_type == C_EXPR) {
206 if (tail->ucmd.acmd.ac_expr)
207 arg = tail->ucmd.acmd.ac_expr;
211 if (arg->arg_type == O_RETURN)
212 tail->c_flags |= CF_TERM;
213 else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
214 tail->c_flags |= CF_TERM;
218 tail->c_flags |= CF_TERM;
220 if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
221 opt_arg(tail,1, tail->c_type == C_EXPR);
223 /* now do a little optimization on case-ish structures */
224 switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
226 if (stabent("*",FALSE)) { /* bad assumption here!!! */
232 opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
238 opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
239 if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
245 if (opt && opt == last_opt && tail->c_stab == last_stab)
248 if (count >= 3) { /* is this the breakeven point? */
249 if (last_opt == CFT_NUMOP)
250 make_nswitch(switchbeg,count);
252 make_cswitch(switchbeg,count);
262 last_stab = tail->c_stab;
264 if (count >= 3) { /* is this the breakeven point? */
265 if (last_opt == CFT_NUMOP)
266 make_nswitch(switchbeg,count);
268 make_cswitch(switchbeg,count);
273 /* We've spotted a sequence of CMDs that all test the value of the same
274 * spat. Thus we can insert a SWITCH in front and jump directly
275 * to the correct one.
277 make_cswitch(head,count)
284 register int min = 255;
285 register int max = 0;
287 /* make a new head in the exact same spot */
288 New(102,cur, 1, CMD);
292 Copy(head,cur,1,CMD);
295 head->c_type = C_CSWITCH;
296 head->c_next = cur; /* insert new cmd at front of list */
297 head->c_stab = cur->c_stab;
299 Newz(103,loc,258,CMD*);
300 loc++; /* lie a little */
302 if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
303 for (i = 0; i <= 255; i++) {
304 if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
314 i = *cur->c_short->str_ptr & 255;
327 Copy(&loc[min],&loc[0], max - min, CMD*);
331 for (i = 0; i <= max; i++)
334 Renew(loc,max+1,CMD*); /* chop it down to size */
335 head->ucmd.scmd.sc_offset = min;
336 head->ucmd.scmd.sc_max = max;
337 head->ucmd.scmd.sc_next = loc;
340 make_nswitch(head,count)
344 register CMD *cur = head;
347 register int min = 32767;
348 register int max = -32768;
349 int origcount = count;
350 double value; /* or your money back! */
351 short changed; /* so triple your money back! */
354 i = (int)str_gnum(cur->c_short);
356 if (value != cur->c_short->str_u.str_nval)
357 return; /* fractional values--just forget it */
360 return; /* too big for a short */
361 if (cur->c_slen == O_LE)
363 else if (cur->c_slen == O_GE) /* we only do < or > here */
372 if (max - min > count * 2 + 10) /* too sparse? */
375 /* now make a new head in the exact same spot */
376 New(104,cur, 1, CMD);
380 Copy(head,cur,1,CMD);
383 head->c_type = C_NSWITCH;
384 head->c_next = cur; /* insert new cmd at front of list */
385 head->c_stab = cur->c_stab;
387 Newz(105,loc, max - min + 3, CMD*);
392 i = (int)str_gnum(cur->c_short);
394 switch(cur->c_slen) {
398 for (i--; i >= -1; i--)
405 for (i++; i <= max; i++)
419 for (i = 0; i <= max; i++)
422 head->ucmd.scmd.sc_offset = min;
423 head->ucmd.scmd.sc_max = max;
424 head->ucmd.scmd.sc_next = loc;
428 append_line(head,tail)
434 if (!tail->c_head) /* make sure tail is well formed */
436 if (head != Nullcmd) {
437 tail = tail->c_head; /* get to start of tail list */
439 head->c_head = head; /* start a new head list */
440 while (head->c_next) {
441 head->c_next->c_head = head->c_head;
442 head = head->c_next; /* get to end of head list */
444 head->c_next = tail; /* link to end of old list */
445 tail->c_head = head->c_head; /* propagate head pointer */
447 while (tail->c_next) {
448 tail->c_next->c_head = tail->c_head;
459 register CMD *head = cur->c_head;
466 str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
467 if (str == &str_undef || str->str_nok)
469 str->str_u.str_nval = (double)head->c_line;
472 str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
473 str->str_magic->str_u.str_cmd = cmd;
474 cmd->c_type = C_EXPR;
475 cmd->ucmd.acmd.ac_stab = Nullstab;
476 cmd->ucmd.acmd.ac_expr = Nullarg;
477 cmd->c_expr = make_op(O_SUBR, 2,
478 stab2arg(A_WORD,DBstab),
481 cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
482 cmd->c_line = head->c_line;
483 cmd->c_label = head->c_label;
484 cmd->c_filestab = curcmd->c_filestab;
485 cmd->c_stash = curstash;
486 return append_line(cmd, cur);
490 make_acmd(type,stab,cond,arg)
500 cmd->ucmd.acmd.ac_stab = stab;
501 cmd->ucmd.acmd.ac_expr = arg;
504 cmd->c_flags |= CF_COND;
505 if (cmdline == NOLINE)
506 cmd->c_line = curcmd->c_line;
508 cmd->c_line = cmdline;
511 cmd->c_filestab = curcmd->c_filestab;
512 cmd->c_stash = curstash;
519 make_ccmd(type,arg,cblock)
522 struct compcmd cblock;
526 Newz(108,cmd, 1, CMD);
529 cmd->ucmd.ccmd.cc_true = cblock.comp_true;
530 cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
532 cmd->c_flags |= CF_COND;
533 if (cmdline == NOLINE)
534 cmd->c_line = curcmd->c_line;
536 cmd->c_line = cmdline;
539 cmd->c_filestab = curcmd->c_filestab;
540 cmd->c_stash = curstash;
547 make_icmd(type,arg,cblock)
550 struct compcmd cblock;
556 struct compcmd ncblock;
558 Newz(109,cmd, 1, CMD);
562 cmd->ucmd.ccmd.cc_true = cblock.comp_true;
563 cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
565 cmd->c_flags |= CF_COND;
566 if (cmdline == NOLINE)
567 cmd->c_line = curcmd->c_line;
569 cmd->c_line = cmdline;
572 cmd->c_filestab = curcmd->c_filestab;
573 cmd->c_stash = curstash;
575 alt = cblock.comp_alt;
576 while (alt && alt->c_type == C_ELSIF) {
578 alt = alt->ucmd.ccmd.cc_alt;
580 if (alt) { /* a real life ELSE at the end? */
581 ncblock.comp_true = alt;
582 ncblock.comp_alt = Nullcmd;
583 alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
584 cur->ucmd.ccmd.cc_alt = alt;
587 alt = cur; /* no ELSE, so cur is proxy ELSE */
590 while (cmd) { /* now point everyone at the ELSE */
592 cmd = cur->ucmd.ccmd.cc_alt;
594 if (cur->c_type == C_ELSIF)
596 if (cur->c_type == C_IF)
597 cur->ucmd.ccmd.cc_alt = alt;
608 opt_arg(cmd,fliporflop,acmd)
617 int context = 0; /* 0 = normal, 1 = before &&, 2 = before || */
618 int flp = fliporflop;
622 if (!(arg = cmd->c_expr)) {
623 cmd->c_flags &= ~CF_COND;
627 /* Can we turn && and || into if and unless? */
629 if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
630 (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
632 arg[2].arg_type &= A_MASK; /* don't suppress eval */
634 cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
635 cmd->c_expr = arg[1].arg_ptr.arg_arg;
636 if (arg->arg_type == O_OR)
637 cmd->c_flags ^= CF_INVERT; /* || is like unless */
643 /* Turn "if (!expr)" into "unless (expr)" */
645 if (!(cmd->c_flags & CF_TERM)) { /* unless return value wanted */
646 while (arg->arg_type == O_NOT) {
648 cmd->c_flags ^= CF_INVERT; /* flip sense of cmd */
649 cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
651 arg = cmd->c_expr; /* here we go again */
655 if (!arg->arg_len) { /* sanity check */
660 /* for "cond .. cond" we set up for the initial check */
662 if (arg->arg_type == O_FLIP)
665 /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
668 if (arg->arg_type == O_AND)
670 else if (arg->arg_type == O_OR)
672 if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
673 arg = arg[flp].arg_ptr.arg_arg;
675 if (arg->arg_type == O_AND || arg->arg_type == O_OR)
678 if ((context & 3) == 3)
681 if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
683 if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
684 && cmd->c_expr->arg_type == O_ITEM) {
685 arg[flp].arg_flags &= ~AF_POST; /* prefer ++$foo to $foo++ */
686 arg[flp].arg_flags |= AF_PRE; /* if value not wanted */
688 return; /* side effect, can't optimize */
691 if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
692 arg->arg_type == O_AND || arg->arg_type == O_OR) {
693 if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
694 opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
695 cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
698 else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
699 (arg[flp].arg_type & A_MASK) == A_LVAL) {
700 cmd->c_stab = arg[flp].arg_ptr.arg_stab;
703 if (!context) { /* no && or ||? */
705 cmd->c_expr = Nullarg;
708 cmd->c_flags |= CF_EQSURE;
710 cmd->c_flags |= CF_NESURE;
713 else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
714 arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
715 if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
716 (arg[2].arg_type & A_MASK) == A_SPAT &&
717 arg[2].arg_ptr.arg_spat->spat_short ) {
718 cmd->c_stab = arg[1].arg_ptr.arg_stab;
719 cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
720 cmd->c_slen = arg[2].arg_ptr.arg_spat->spat_slen;
721 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
722 !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
723 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
724 sure |= CF_EQSURE; /* (SUBST must be forced even */
725 /* if we know it will work.) */
726 if (arg->arg_type != O_SUBST) {
727 arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
728 arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
730 sure |= CF_NESURE; /* normally only sure if it fails */
731 if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
732 cmd->c_flags |= CF_FIRSTNEG;
733 if (context & 1) { /* only sure if thing is false */
734 if (cmd->c_flags & CF_FIRSTNEG)
739 else if (context & 2) { /* only sure if thing is true */
740 if (cmd->c_flags & CF_FIRSTNEG)
745 if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
746 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
750 if (sure == (CF_EQSURE|CF_NESURE) /* really sure? */
751 && arg->arg_type == O_MATCH
753 && fliporflop == 1) {
754 spat_free(arg[2].arg_ptr.arg_spat);
755 arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
757 cmd->c_flags |= sure;
761 else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
762 arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
763 if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
764 if (arg[2].arg_type == A_SINGLE) {
765 char *junk = str_get(arg[2].arg_ptr.arg_str);
767 cmd->c_stab = arg[1].arg_ptr.arg_stab;
768 cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
769 cmd->c_slen = cmd->c_short->str_cur+1;
770 switch (arg->arg_type) {
771 case O_SLT: case O_SGT:
773 cmd->c_flags |= CF_FIRSTNEG;
776 cmd->c_flags |= CF_FIRSTNEG;
779 sure |= CF_NESURE|CF_EQSURE;
782 if (context & 1) { /* only sure if thing is false */
783 if (cmd->c_flags & CF_FIRSTNEG)
788 else if (context & 2) { /* only sure if thing is true */
789 if (cmd->c_flags & CF_FIRSTNEG)
794 if (sure & (CF_EQSURE|CF_NESURE)) {
796 cmd->c_flags |= sure;
801 else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
802 arg->arg_type == O_LE || arg->arg_type == O_GE ||
803 arg->arg_type == O_LT || arg->arg_type == O_GT) {
804 if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
805 if (arg[2].arg_type == A_SINGLE) {
806 cmd->c_stab = arg[1].arg_ptr.arg_stab;
808 STR *str = arg[2].arg_ptr.arg_str;
810 if ((!str->str_nok && !looks_like_number(str)))
811 warn("Possible use of == on string value");
813 cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
814 cmd->c_slen = arg->arg_type;
815 sure |= CF_NESURE|CF_EQSURE;
816 if (context & 1) { /* only sure if thing is false */
819 else if (context & 2) { /* only sure if thing is true */
822 if (sure & (CF_EQSURE|CF_NESURE)) {
824 cmd->c_flags |= sure;
829 else if (arg->arg_type == O_ASSIGN &&
830 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
831 arg[1].arg_ptr.arg_stab == defstab &&
832 arg[2].arg_type == A_EXPR ) {
833 arg2 = arg[2].arg_ptr.arg_arg;
834 if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
836 cmd->c_stab = arg2[1].arg_ptr.arg_stab;
837 if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
840 cmd->c_expr = Nullarg;
844 else if (arg->arg_type == O_CHOP &&
845 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
847 cmd->c_stab = arg[1].arg_ptr.arg_stab;
849 cmd->c_expr = Nullarg;
855 if (cmd->c_flags & CF_FLIP) {
856 if (fliporflop == 1) {
857 arg = cmd->c_expr; /* get back to O_FLIP arg */
858 New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
859 Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
860 New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
861 Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
862 opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
863 arg->arg_len = 2; /* this is a lie */
866 if ((opt & CF_OPTIMIZE) == CFT_EVAL)
867 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
888 cmd->c_flags |= CF_COND;
900 cmd->c_flags |= CF_COND|CF_LOOP;
902 if (!(cmd->c_flags & CF_INVERT))
903 while_io(cmd); /* add $_ =, if necessary */
905 if (cmd->c_type == C_BLOCK)
906 cmd->c_flags &= ~CF_COND;
908 arg = cmd->ucmd.acmd.ac_expr;
909 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
910 cmd->c_flags &= ~CF_COND; /* "do {} while" happens at least once */
911 if (arg && arg->arg_type == O_SUBR)
912 cmd->c_flags &= ~CF_COND; /* likewise for "do subr() while" */
921 register CMD *targ = cmd;
924 if (targ->c_flags & CF_DBSUB)
926 targ->c_flags ^= CF_INVERT;
935 char *tname = tmpbuf;
937 if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
938 oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
939 while (isspace(*oldoldbufptr))
941 strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
942 tmp2buf[bufptr - oldoldbufptr] = '\0';
943 sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
945 else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
946 oldbufptr != bufptr) {
947 while (isspace(*oldbufptr))
949 strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
950 tmp2buf[bufptr - oldbufptr] = '\0';
951 sprintf(tname,"next token \"%s\"",tmp2buf);
953 else if (yychar > 256)
954 tname = "next token ???";
956 (void)strcpy(tname,"at EOF");
957 else if (yychar < 32)
958 (void)sprintf(tname,"next char ^%c",yychar+64);
959 else if (yychar == 127)
960 (void)strcpy(tname,"at EOF");
962 (void)sprintf(tname,"next char %c",yychar);
963 (void)sprintf(buf, "%s in file %s at line %d, %s\n",
964 s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
965 if (curcmd->c_line == multi_end && multi_start < multi_end)
966 sprintf(buf+strlen(buf),
967 " (Might be a runaway multi-line %c%c string starting on line %d)\n",
968 multi_open,multi_close,multi_start);
970 str_cat(stab_val(stabent("@",TRUE)),buf);
973 if (++error_count >= 10)
974 fatal("%s has too many errors.\n",
975 stab_val(curcmd->c_filestab)->str_ptr);
982 register ARG *arg = cmd->c_expr;
985 /* hoist "while (<channel>)" up into command block */
987 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
988 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
989 cmd->c_flags |= CFT_GETS; /* and set it to do the input */
990 cmd->c_stab = arg[1].arg_ptr.arg_stab;
991 if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
992 cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */
993 stab2arg(A_LVAL,defstab), arg, Nullarg));
997 cmd->c_expr = Nullarg;
1000 else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
1001 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
1002 cmd->c_flags |= CFT_INDGETS; /* and set it to do the input */
1003 cmd->c_stab = arg[1].arg_ptr.arg_stab;
1005 cmd->c_expr = Nullarg;
1007 else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
1008 if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
1009 asgnstab = cmd->c_stab;
1012 cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$foo =" */
1013 stab2arg(A_LVAL,asgnstab), arg, Nullarg));
1014 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
1026 if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
1027 opt_arg(cmd,1, cmd->c_type == C_EXPR);
1029 while_io(cmd); /* add $_ =, if necessary */
1031 /* First find the end of the true list */
1033 tail = cmd->ucmd.ccmd.cc_true;
1034 if (tail == Nullcmd)
1036 New(112,newtail, 1, CMD); /* guaranteed continue */
1038 /* optimize "next" to point directly to continue block */
1039 if (tail->c_type == C_EXPR &&
1040 tail->ucmd.acmd.ac_expr &&
1041 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1042 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1045 tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1047 arg_free(tail->ucmd.acmd.ac_expr);
1048 tail->c_type = C_NEXT;
1049 if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1050 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1052 tail->ucmd.ccmd.cc_alt = newtail;
1053 tail->ucmd.ccmd.cc_true = Nullcmd;
1055 else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1056 if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1057 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1059 tail->ucmd.ccmd.cc_alt = newtail;
1061 else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1062 if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1063 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1064 if (!tail->ucmd.scmd.sc_next[i])
1065 tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
1068 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1069 if (!tail->ucmd.scmd.sc_next[i])
1070 tail->ucmd.scmd.sc_next[i] = newtail;
1076 tail = tail->c_next;
1079 /* if there's a continue block, link it to true block and find end */
1081 if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1082 tail->c_next = cmd->ucmd.ccmd.cc_alt;
1083 tail = tail->c_next;
1085 /* optimize "next" to point directly to continue block */
1086 if (tail->c_type == C_EXPR &&
1087 tail->ucmd.acmd.ac_expr &&
1088 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1089 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1092 tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1094 arg_free(tail->ucmd.acmd.ac_expr);
1095 tail->c_type = C_NEXT;
1096 tail->ucmd.ccmd.cc_alt = newtail;
1097 tail->ucmd.ccmd.cc_true = Nullcmd;
1099 else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1100 tail->ucmd.ccmd.cc_alt = newtail;
1102 else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1103 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1104 if (!tail->ucmd.scmd.sc_next[i])
1105 tail->ucmd.scmd.sc_next[i] = newtail;
1110 tail = tail->c_next;
1112 for ( ; tail->c_next; tail = tail->c_next) ;
1115 /* Here's the real trick: link the end of the list back to the beginning,
1116 * inserting a "last" block to break out of the loop. This saves one or
1117 * two procedure calls every time through the loop, because of how cmd_exec
1118 * does tail recursion.
1121 tail->c_next = newtail;
1123 if (!cmd->ucmd.ccmd.cc_alt)
1124 cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */
1127 (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
1129 tail->c_type = C_EXPR;
1130 tail->c_flags ^= CF_INVERT; /* turn into "last unless" */
1131 tail->c_next = tail->ucmd.ccmd.cc_true; /* loop directly back to top */
1132 tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
1133 tail->ucmd.acmd.ac_stab = Nullstab;
1142 /* hoist "for $foo (@bar)" up into command block */
1144 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
1145 cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */
1146 cmd->c_stab = eachstab;
1147 cmd->c_short = str_new(0); /* just to save a field in struct cmd */
1148 cmd->c_short->str_u.str_useful = -1;
1156 register CMD *tofree;
1157 register CMD *head = cmd;
1160 if (cmd->c_type != C_WHILE) { /* WHILE block is duplicated */
1162 Safefree(cmd->c_label);
1164 str_free(cmd->c_short);
1166 spat_free(cmd->c_spat);
1168 arg_free(cmd->c_expr);
1170 switch (cmd->c_type) {
1175 if (cmd->ucmd.ccmd.cc_true)
1176 cmd_free(cmd->ucmd.ccmd.cc_true);
1179 if (cmd->ucmd.acmd.ac_expr)
1180 arg_free(cmd->ucmd.acmd.ac_expr);
1185 if (tofree != head) /* to get Saber to shut up */
1187 if (cmd && cmd == head) /* reached end of while loop */
1198 for (i = 1; i <= arg->arg_len; i++) {
1199 switch (arg[i].arg_type & A_MASK) {
1203 if (arg->arg_type == O_AASSIGN &&
1204 arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
1206 stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
1208 if (strnEQ("_GEN_",name, 5)) /* array for foreach */
1209 hdelete(defstash,name,strlen(name));
1213 arg_free(arg[i].arg_ptr.arg_arg);
1216 cmd_free(arg[i].arg_ptr.arg_cmd);
1231 str_free(arg[i].arg_ptr.arg_str);
1234 spat_free(arg[i].arg_ptr.arg_spat);
1242 register SPAT *spat;
1247 if (spat->spat_runtime)
1248 arg_free(spat->spat_runtime);
1249 if (spat->spat_repl) {
1250 arg_free(spat->spat_repl);
1252 if (spat->spat_short) {
1253 str_free(spat->spat_short);
1255 if (spat->spat_regexp) {
1256 regfree(spat->spat_regexp);
1259 /* now unlink from spat list */
1261 for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
1262 register HASH *stash;
1263 STAB *stab = (STAB*)entry->hent_val;
1267 stash = stab_hash(stab);
1268 if (!stash || stash->tbl_spatroot == Null(SPAT*))
1270 if (stash->tbl_spatroot == spat)
1271 stash->tbl_spatroot = spat->spat_next;
1273 for (sp = stash->tbl_spatroot;
1274 sp && sp->spat_next != spat;
1278 sp->spat_next = spat->spat_next;
1284 /* Recursively descend a command sequence and push the address of any string
1285 * that needs saving on recursion onto the tosave array.
1289 cmd_tosave(cmd,willsave)
1291 int willsave; /* willsave passes down the tree */
1293 register CMD *head = cmd;
1294 int shouldsave = FALSE; /* shouldsave passes up the tree */
1296 register CMD *lastcmd = Nullcmd;
1300 shouldsave |= spat_tosave(cmd->c_spat);
1302 shouldsave |= arg_tosave(cmd->c_expr,willsave);
1303 switch (cmd->c_type) {
1305 if (cmd->ucmd.ccmd.cc_true) {
1306 tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1308 /* Here we check to see if the temporary array generated for
1309 * a foreach needs to be localized because of recursion.
1311 if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
1313 lastcmd->c_type == C_EXPR &&
1315 ARG *arg = lastcmd->c_expr;
1317 if (arg->arg_type == O_ASSIGN &&
1318 arg[1].arg_type == A_LEXPR &&
1319 arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
1322 arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
1323 5)) { /* array generated for foreach */
1324 (void)localize(arg);
1328 /* in any event, save the iterator */
1330 (void)apush(tosave,cmd->c_short);
1332 shouldsave |= tmpsave;
1338 if (cmd->ucmd.ccmd.cc_true)
1339 shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1342 if (cmd->ucmd.acmd.ac_expr)
1343 shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
1348 if (cmd && cmd == head) /* reached end of while loop */
1355 arg_tosave(arg,willsave)
1360 int shouldsave = FALSE;
1362 for (i = arg->arg_len; i >= 1; i--) {
1363 switch (arg[i].arg_type & A_MASK) {
1368 shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
1371 shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
1384 shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
1388 switch (arg->arg_type) {
1398 (void)apush(tosave,arg->arg_ptr.arg_str);
1404 register SPAT *spat;
1406 int shouldsave = FALSE;
1408 if (spat->spat_runtime)
1409 shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
1410 if (spat->spat_repl) {
1411 shouldsave |= arg_tosave(spat->spat_repl,FALSE);