1 /* $Header: cons.c,v 3.0.1.7 90/08/09 02:35:52 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.7 90/08/09 02:35:52 lwall
10 * patch19: did preliminary work toward debugging packages and evals
11 * patch19: Added support for linked-in C subroutines
12 * patch19: Numeric literals are now stored only in floating point
13 * patch19: Added -c switch to do compilation only
15 * Revision 3.0.1.6 90/03/27 15:35:21 lwall
16 * patch16: formats didn't work inside eval
17 * patch16: $foo++ now optimized to ++$foo where value not required
19 * Revision 3.0.1.5 90/03/12 16:23:10 lwall
20 * patch13: perl -d coredumped on scripts with subs that did explicit return
22 * Revision 3.0.1.4 90/02/28 16:44:00 lwall
23 * patch9: subs which return by both mechanisms can clobber local return data
24 * patch9: changed internal SUB label to _SUB_
25 * patch9: line numbers were bogus during certain portions of foreach evaluation
27 * Revision 3.0.1.3 89/12/21 19:20:25 lwall
28 * patch7: made nested or recursive foreach work right
30 * Revision 3.0.1.2 89/11/17 15:08:53 lwall
31 * patch5: nested foreach on same array didn't work
33 * Revision 3.0.1.1 89/10/26 23:09:01 lwall
34 * patch1: numeric switch optimization was broken
35 * patch1: unless was broken when run under the debugger
37 * Revision 3.0 89/10/18 15:10:23 lwall
46 extern char *tokename[];
49 static int cmd_tosave();
50 static int arg_tosave();
51 static int spat_tosave();
53 static bool saw_return;
61 STAB *stab = stabent(name,TRUE);
66 CMD *oldcurcmd = curcmd;
70 warn("Subroutine %s redefined",name);
73 if (stab_sub(stab)->cmd) {
74 cmd_free(stab_sub(stab)->cmd);
75 afree(stab_sub(stab)->tosave);
77 Safefree(stab_sub(stab));
79 sub->filename = filename;
81 tosave = anew(Nullstab);
82 tosave->ary_fill = 0; /* make 1 based */
83 (void)cmd_tosave(cmd,FALSE); /* this builds the tosave array */
86 struct compcmd mycompblock;
88 mycompblock.comp_true = cmd;
89 mycompblock.comp_alt = Nullcmd;
90 cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
92 cmd->c_flags |= CF_TERM;
97 STR *str = str_nmake((double)subline);
100 sprintf(buf,"%ld",(long)curcmd->c_line);
102 name = str_get(subname);
103 hstore(stab_xhash(DBsub),name,strlen(name),str,0);
104 str_set(subname,"main");
111 make_usub(name, ix, subaddr, filename)
118 STAB *stab = stabent(name,allstabs);
120 if (!stab) /* unused function */
122 Newz(101,sub,1,SUBR);
123 if (stab_sub(stab)) {
125 warn("Subroutine %s redefined",name);
126 if (stab_sub(stab)->cmd) {
127 cmd_free(stab_sub(stab)->cmd);
128 afree(stab_sub(stab)->tosave);
130 Safefree(stab_sub(stab));
132 sub->filename = filename;
133 sub->usersub = subaddr;
135 stab_sub(stab) = sub;
143 if (stab_form(stab)) {
147 for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
148 nextfcmd = tmpfcmd->f_next;
150 arg_free(tmpfcmd->f_expr);
151 if (tmpfcmd->f_unparsed)
152 str_free(tmpfcmd->f_unparsed);
154 Safefree(tmpfcmd->f_pre);
158 stab_form(stab) = fcmd;
167 register int last_opt = 0;
168 register STAB *last_stab = Nullstab;
169 register int count = 0;
170 register CMD *switchbeg = Nullcmd;
172 if (tail == Nullcmd) {
177 for (tail = head; tail; tail = tail->c_next) {
179 /* save one measly dereference at runtime */
180 if (tail->c_type == C_IF) {
181 if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
182 tail->c_flags |= CF_TERM;
184 else if (tail->c_type == C_EXPR) {
187 if (tail->ucmd.acmd.ac_expr)
188 arg = tail->ucmd.acmd.ac_expr;
192 if (arg->arg_type == O_RETURN)
193 tail->c_flags |= CF_TERM;
194 else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
195 tail->c_flags |= CF_TERM;
199 tail->c_flags |= CF_TERM;
201 if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
202 opt_arg(tail,1, tail->c_type == C_EXPR);
204 /* now do a little optimization on case-ish structures */
205 switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
207 if (stabent("*",FALSE)) { /* bad assumption here!!! */
213 opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
219 opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
220 if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
226 if (opt && opt == last_opt && tail->c_stab == last_stab)
229 if (count >= 3) { /* is this the breakeven point? */
230 if (last_opt == CFT_NUMOP)
231 make_nswitch(switchbeg,count);
233 make_cswitch(switchbeg,count);
243 last_stab = tail->c_stab;
245 if (count >= 3) { /* is this the breakeven point? */
246 if (last_opt == CFT_NUMOP)
247 make_nswitch(switchbeg,count);
249 make_cswitch(switchbeg,count);
254 /* We've spotted a sequence of CMDs that all test the value of the same
255 * spat. Thus we can insert a SWITCH in front and jump directly
256 * to the correct one.
258 make_cswitch(head,count)
265 register int min = 255;
266 register int max = 0;
268 /* make a new head in the exact same spot */
269 New(102,cur, 1, CMD);
273 Copy(head,cur,1,CMD);
276 head->c_type = C_CSWITCH;
277 head->c_next = cur; /* insert new cmd at front of list */
278 head->c_stab = cur->c_stab;
280 Newz(103,loc,258,CMD*);
281 loc++; /* lie a little */
283 if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
284 for (i = 0; i <= 255; i++) {
285 if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
295 i = *cur->c_short->str_ptr & 255;
308 Copy(&loc[min],&loc[0], max - min, CMD*);
312 for (i = 0; i <= max; i++)
315 Renew(loc,max+1,CMD*); /* chop it down to size */
316 head->ucmd.scmd.sc_offset = min;
317 head->ucmd.scmd.sc_max = max;
318 head->ucmd.scmd.sc_next = loc;
321 make_nswitch(head,count)
325 register CMD *cur = head;
328 register int min = 32767;
329 register int max = -32768;
330 int origcount = count;
331 double value; /* or your money back! */
332 short changed; /* so triple your money back! */
335 i = (int)str_gnum(cur->c_short);
337 if (value != cur->c_short->str_u.str_nval)
338 return; /* fractional values--just forget it */
341 return; /* too big for a short */
342 if (cur->c_slen == O_LE)
344 else if (cur->c_slen == O_GE) /* we only do < or > here */
353 if (max - min > count * 2 + 10) /* too sparse? */
356 /* now make a new head in the exact same spot */
357 New(104,cur, 1, CMD);
361 Copy(head,cur,1,CMD);
364 head->c_type = C_NSWITCH;
365 head->c_next = cur; /* insert new cmd at front of list */
366 head->c_stab = cur->c_stab;
368 Newz(105,loc, max - min + 3, CMD*);
373 i = (int)str_gnum(cur->c_short);
375 switch(cur->c_slen) {
379 for (i--; i >= -1; i--)
386 for (i++; i <= max; i++)
400 for (i = 0; i <= max; i++)
403 head->ucmd.scmd.sc_offset = min;
404 head->ucmd.scmd.sc_max = max;
405 head->ucmd.scmd.sc_next = loc;
409 append_line(head,tail)
415 if (!tail->c_head) /* make sure tail is well formed */
417 if (head != Nullcmd) {
418 tail = tail->c_head; /* get to start of tail list */
420 head->c_head = head; /* start a new head list */
421 while (head->c_next) {
422 head->c_next->c_head = head->c_head;
423 head = head->c_next; /* get to end of head list */
425 head->c_next = tail; /* link to end of old list */
426 tail->c_head = head->c_head; /* propagate head pointer */
428 while (tail->c_next) {
429 tail->c_next->c_head = tail->c_head;
440 register CMD *head = cur->c_head;
448 str = afetch(lineary,(int)head->c_line,FALSE);
449 if (!str || str->str_nok)
451 str->str_u.str_nval = (double)head->c_line;
454 cmd->c_type = C_EXPR;
455 cmd->ucmd.acmd.ac_stab = Nullstab;
456 cmd->ucmd.acmd.ac_expr = Nullarg;
457 arg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
458 arg[1].arg_type = A_SINGLE;
459 arg[1].arg_ptr.arg_str = str_nmake((double)head->c_line);
460 cmd->c_expr = make_op(O_SUBR, 2,
461 stab2arg(A_WORD,DBstab),
464 cmd->c_flags |= CF_COND|CF_DBSUB;
465 cmd->c_line = head->c_line;
466 cmd->c_label = head->c_label;
467 cmd->c_file = filename;
468 cmd->c_pack = curpack;
469 return append_line(cmd, cur);
473 make_acmd(type,stab,cond,arg)
483 cmd->ucmd.acmd.ac_stab = stab;
484 cmd->ucmd.acmd.ac_expr = arg;
487 cmd->c_flags |= CF_COND;
488 if (cmdline == NOLINE)
489 cmd->c_line = curcmd->c_line;
491 cmd->c_line = cmdline;
494 cmd->c_file = filename;
495 cmd->c_pack = curpack;
502 make_ccmd(type,arg,cblock)
505 struct compcmd cblock;
509 Newz(108,cmd, 1, CMD);
512 cmd->ucmd.ccmd.cc_true = cblock.comp_true;
513 cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
515 cmd->c_flags |= CF_COND;
516 if (cmdline == NOLINE)
517 cmd->c_line = curcmd->c_line;
519 cmd->c_line = cmdline;
528 make_icmd(type,arg,cblock)
531 struct compcmd cblock;
537 struct compcmd ncblock;
539 Newz(109,cmd, 1, CMD);
543 cmd->ucmd.ccmd.cc_true = cblock.comp_true;
544 cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
546 cmd->c_flags |= CF_COND;
547 if (cmdline == NOLINE)
548 cmd->c_line = curcmd->c_line;
550 cmd->c_line = cmdline;
554 alt = cblock.comp_alt;
555 while (alt && alt->c_type == C_ELSIF) {
557 alt = alt->ucmd.ccmd.cc_alt;
559 if (alt) { /* a real life ELSE at the end? */
560 ncblock.comp_true = alt;
561 ncblock.comp_alt = Nullcmd;
562 alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
563 cur->ucmd.ccmd.cc_alt = alt;
566 alt = cur; /* no ELSE, so cur is proxy ELSE */
569 while (cmd) { /* now point everyone at the ELSE */
571 cmd = cur->ucmd.ccmd.cc_alt;
573 if (cur->c_type == C_ELSIF)
575 if (cur->c_type == C_IF)
576 cur->ucmd.ccmd.cc_alt = alt;
587 opt_arg(cmd,fliporflop,acmd)
596 int context = 0; /* 0 = normal, 1 = before &&, 2 = before || */
597 int flp = fliporflop;
601 if (!(arg = cmd->c_expr)) {
602 cmd->c_flags &= ~CF_COND;
606 /* Can we turn && and || into if and unless? */
608 if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
609 (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
611 arg[2].arg_type &= A_MASK; /* don't suppress eval */
613 cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
614 cmd->c_expr = arg[1].arg_ptr.arg_arg;
615 if (arg->arg_type == O_OR)
616 cmd->c_flags ^= CF_INVERT; /* || is like unless */
622 /* Turn "if (!expr)" into "unless (expr)" */
624 if (!(cmd->c_flags & CF_TERM)) { /* unless return value wanted */
625 while (arg->arg_type == O_NOT) {
627 cmd->c_flags ^= CF_INVERT; /* flip sense of cmd */
628 cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
630 arg = cmd->c_expr; /* here we go again */
634 if (!arg->arg_len) { /* sanity check */
639 /* for "cond .. cond" we set up for the initial check */
641 if (arg->arg_type == O_FLIP)
644 /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
647 if (arg->arg_type == O_AND)
649 else if (arg->arg_type == O_OR)
651 if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
652 arg = arg[flp].arg_ptr.arg_arg;
654 if (arg->arg_type == O_AND || arg->arg_type == O_OR)
657 if ((context & 3) == 3)
660 if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
662 if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)) {
663 arg[flp].arg_flags &= ~AF_POST; /* prefer ++$foo to $foo++ */
664 arg[flp].arg_flags |= AF_PRE; /* if value not wanted */
666 return; /* side effect, can't optimize */
669 if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
670 arg->arg_type == O_AND || arg->arg_type == O_OR) {
671 if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
672 opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
673 cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
676 else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
677 (arg[flp].arg_type & A_MASK) == A_LVAL) {
678 cmd->c_stab = arg[flp].arg_ptr.arg_stab;
681 if (!context) { /* no && or ||? */
683 cmd->c_expr = Nullarg;
686 cmd->c_flags |= CF_EQSURE;
688 cmd->c_flags |= CF_NESURE;
691 else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
692 arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
693 if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
694 (arg[2].arg_type & A_MASK) == A_SPAT &&
695 arg[2].arg_ptr.arg_spat->spat_short ) {
696 cmd->c_stab = arg[1].arg_ptr.arg_stab;
697 cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
698 cmd->c_slen = arg[2].arg_ptr.arg_spat->spat_slen;
699 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
700 !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
701 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
702 sure |= CF_EQSURE; /* (SUBST must be forced even */
703 /* if we know it will work.) */
704 if (arg->arg_type != O_SUBST) {
705 arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
706 arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
708 sure |= CF_NESURE; /* normally only sure if it fails */
709 if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
710 cmd->c_flags |= CF_FIRSTNEG;
711 if (context & 1) { /* only sure if thing is false */
712 if (cmd->c_flags & CF_FIRSTNEG)
717 else if (context & 2) { /* only sure if thing is true */
718 if (cmd->c_flags & CF_FIRSTNEG)
723 if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
724 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
728 if (sure == (CF_EQSURE|CF_NESURE) /* really sure? */
729 && arg->arg_type == O_MATCH
731 && fliporflop == 1) {
732 spat_free(arg[2].arg_ptr.arg_spat);
733 arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
735 cmd->c_flags |= sure;
739 else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
740 arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
741 if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
742 if (arg[2].arg_type == A_SINGLE) {
743 char *junk = str_get(arg[2].arg_ptr.arg_str);
745 cmd->c_stab = arg[1].arg_ptr.arg_stab;
746 cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
747 cmd->c_slen = cmd->c_short->str_cur+1;
748 switch (arg->arg_type) {
749 case O_SLT: case O_SGT:
751 cmd->c_flags |= CF_FIRSTNEG;
754 cmd->c_flags |= CF_FIRSTNEG;
757 sure |= CF_NESURE|CF_EQSURE;
760 if (context & 1) { /* only sure if thing is false */
761 if (cmd->c_flags & CF_FIRSTNEG)
766 else if (context & 2) { /* only sure if thing is true */
767 if (cmd->c_flags & CF_FIRSTNEG)
772 if (sure & (CF_EQSURE|CF_NESURE)) {
774 cmd->c_flags |= sure;
779 else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
780 arg->arg_type == O_LE || arg->arg_type == O_GE ||
781 arg->arg_type == O_LT || arg->arg_type == O_GT) {
782 if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
783 if (arg[2].arg_type == A_SINGLE) {
784 cmd->c_stab = arg[1].arg_ptr.arg_stab;
786 STR *str = arg[2].arg_ptr.arg_str;
788 if ((!str->str_nok && !looks_like_number(str)))
789 warn("Possible use of == on string value");
791 cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
792 cmd->c_slen = arg->arg_type;
793 sure |= CF_NESURE|CF_EQSURE;
794 if (context & 1) { /* only sure if thing is false */
797 else if (context & 2) { /* only sure if thing is true */
800 if (sure & (CF_EQSURE|CF_NESURE)) {
802 cmd->c_flags |= sure;
807 else if (arg->arg_type == O_ASSIGN &&
808 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
809 arg[1].arg_ptr.arg_stab == defstab &&
810 arg[2].arg_type == A_EXPR ) {
811 arg2 = arg[2].arg_ptr.arg_arg;
812 if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
814 cmd->c_stab = arg2[1].arg_ptr.arg_stab;
815 if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
818 cmd->c_expr = Nullarg;
822 else if (arg->arg_type == O_CHOP &&
823 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
825 cmd->c_stab = arg[1].arg_ptr.arg_stab;
827 cmd->c_expr = Nullarg;
833 if (cmd->c_flags & CF_FLIP) {
834 if (fliporflop == 1) {
835 arg = cmd->c_expr; /* get back to O_FLIP arg */
836 New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
837 Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
838 New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
839 Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
840 opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
841 arg->arg_len = 2; /* this is a lie */
844 if ((opt & CF_OPTIMIZE) == CFT_EVAL)
845 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
866 cmd->c_flags |= CF_COND;
878 cmd->c_flags |= CF_COND|CF_LOOP;
880 if (!(cmd->c_flags & CF_INVERT))
881 while_io(cmd); /* add $_ =, if necessary */
883 if (cmd->c_type == C_BLOCK)
884 cmd->c_flags &= ~CF_COND;
886 arg = cmd->ucmd.acmd.ac_expr;
887 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
888 cmd->c_flags &= ~CF_COND; /* "do {} while" happens at least once */
889 if (arg && arg->arg_type == O_SUBR)
890 cmd->c_flags &= ~CF_COND; /* likewise for "do subr() while" */
899 register CMD *targ = cmd;
902 if (targ->c_flags & CF_DBSUB)
904 targ->c_flags ^= CF_INVERT;
913 char *tname = tmpbuf;
915 if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
916 oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
917 while (isspace(*oldoldbufptr))
919 strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
920 tmp2buf[bufptr - oldoldbufptr] = '\0';
921 sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
923 else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
924 oldbufptr != bufptr) {
925 while (isspace(*oldbufptr))
927 strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
928 tmp2buf[bufptr - oldbufptr] = '\0';
929 sprintf(tname,"next token \"%s\"",tmp2buf);
931 else if (yychar > 256)
932 tname = "next token ???";
934 (void)strcpy(tname,"at EOF");
935 else if (yychar < 32)
936 (void)sprintf(tname,"next char ^%c",yychar+64);
937 else if (yychar == 127)
938 (void)strcpy(tname,"at EOF");
940 (void)sprintf(tname,"next char %c",yychar);
941 (void)sprintf(buf, "%s in file %s at line %d, %s\n",
942 s,filename,curcmd->c_line,tname);
943 if (curcmd->c_line == multi_end && multi_start < multi_end)
944 sprintf(buf+strlen(buf),
945 " (Might be a runaway multi-line %c%c string starting on line %d)\n",
946 multi_open,multi_close,multi_start);
948 str_cat(stab_val(stabent("@",TRUE)),buf);
951 if (++error_count >= 10)
952 fatal("%s has too many errors.\n", filename);
959 register ARG *arg = cmd->c_expr;
962 /* hoist "while (<channel>)" up into command block */
964 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
965 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
966 cmd->c_flags |= CFT_GETS; /* and set it to do the input */
967 cmd->c_stab = arg[1].arg_ptr.arg_stab;
968 if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
969 cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */
970 stab2arg(A_LVAL,defstab), arg, Nullarg));
974 cmd->c_expr = Nullarg;
977 else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
978 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
979 cmd->c_flags |= CFT_INDGETS; /* and set it to do the input */
980 cmd->c_stab = arg[1].arg_ptr.arg_stab;
982 cmd->c_expr = Nullarg;
984 else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
985 if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
986 asgnstab = cmd->c_stab;
989 cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$foo =" */
990 stab2arg(A_LVAL,asgnstab), arg, Nullarg));
991 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
1003 if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
1004 opt_arg(cmd,1, cmd->c_type == C_EXPR);
1006 while_io(cmd); /* add $_ =, if necessary */
1008 /* First find the end of the true list */
1010 tail = cmd->ucmd.ccmd.cc_true;
1011 if (tail == Nullcmd)
1013 New(112,newtail, 1, CMD); /* guaranteed continue */
1015 /* optimize "next" to point directly to continue block */
1016 if (tail->c_type == C_EXPR &&
1017 tail->ucmd.acmd.ac_expr &&
1018 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1019 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1022 tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1024 arg_free(tail->ucmd.acmd.ac_expr);
1025 tail->c_type = C_NEXT;
1026 if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1027 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1029 tail->ucmd.ccmd.cc_alt = newtail;
1030 tail->ucmd.ccmd.cc_true = Nullcmd;
1032 else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1033 if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1034 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1036 tail->ucmd.ccmd.cc_alt = newtail;
1038 else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1039 if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1040 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1041 if (!tail->ucmd.scmd.sc_next[i])
1042 tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
1045 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1046 if (!tail->ucmd.scmd.sc_next[i])
1047 tail->ucmd.scmd.sc_next[i] = newtail;
1053 tail = tail->c_next;
1056 /* if there's a continue block, link it to true block and find end */
1058 if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1059 tail->c_next = cmd->ucmd.ccmd.cc_alt;
1060 tail = tail->c_next;
1062 /* optimize "next" to point directly to continue block */
1063 if (tail->c_type == C_EXPR &&
1064 tail->ucmd.acmd.ac_expr &&
1065 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1066 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1069 tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1071 arg_free(tail->ucmd.acmd.ac_expr);
1072 tail->c_type = C_NEXT;
1073 tail->ucmd.ccmd.cc_alt = newtail;
1074 tail->ucmd.ccmd.cc_true = Nullcmd;
1076 else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1077 tail->ucmd.ccmd.cc_alt = newtail;
1079 else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1080 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1081 if (!tail->ucmd.scmd.sc_next[i])
1082 tail->ucmd.scmd.sc_next[i] = newtail;
1087 tail = tail->c_next;
1089 for ( ; tail->c_next; tail = tail->c_next) ;
1092 /* Here's the real trick: link the end of the list back to the beginning,
1093 * inserting a "last" block to break out of the loop. This saves one or
1094 * two procedure calls every time through the loop, because of how cmd_exec
1095 * does tail recursion.
1098 tail->c_next = newtail;
1100 if (!cmd->ucmd.ccmd.cc_alt)
1101 cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */
1104 (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
1106 tail->c_type = C_EXPR;
1107 tail->c_flags ^= CF_INVERT; /* turn into "last unless" */
1108 tail->c_next = tail->ucmd.ccmd.cc_true; /* loop directly back to top */
1109 tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
1110 tail->ucmd.acmd.ac_stab = Nullstab;
1119 /* hoist "for $foo (@bar)" up into command block */
1121 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
1122 cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */
1123 cmd->c_stab = eachstab;
1124 cmd->c_short = str_new(0); /* just to save a field in struct cmd */
1125 cmd->c_short->str_u.str_useful = -1;
1133 register CMD *tofree;
1134 register CMD *head = cmd;
1137 if (cmd->c_type != C_WHILE) { /* WHILE block is duplicated */
1139 Safefree(cmd->c_label);
1141 str_free(cmd->c_short);
1143 spat_free(cmd->c_spat);
1145 arg_free(cmd->c_expr);
1147 switch (cmd->c_type) {
1152 if (cmd->ucmd.ccmd.cc_true)
1153 cmd_free(cmd->ucmd.ccmd.cc_true);
1156 if (cmd->ucmd.acmd.ac_expr)
1157 arg_free(cmd->ucmd.acmd.ac_expr);
1162 if (tofree != head) /* to get Saber to shut up */
1164 if (cmd && cmd == head) /* reached end of while loop */
1175 for (i = 1; i <= arg->arg_len; i++) {
1176 switch (arg[i].arg_type & A_MASK) {
1180 if (arg->arg_type == O_AASSIGN &&
1181 arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
1183 stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
1185 if (strnEQ("_GEN_",name, 5)) /* array for foreach */
1186 hdelete(defstash,name,strlen(name));
1190 arg_free(arg[i].arg_ptr.arg_arg);
1193 cmd_free(arg[i].arg_ptr.arg_cmd);
1208 str_free(arg[i].arg_ptr.arg_str);
1211 spat_free(arg[i].arg_ptr.arg_spat);
1219 register SPAT *spat;
1224 if (spat->spat_runtime)
1225 arg_free(spat->spat_runtime);
1226 if (spat->spat_repl) {
1227 arg_free(spat->spat_repl);
1229 if (spat->spat_short) {
1230 str_free(spat->spat_short);
1232 if (spat->spat_regexp) {
1233 regfree(spat->spat_regexp);
1236 /* now unlink from spat list */
1238 for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
1239 register HASH *stash;
1240 STAB *stab = (STAB*)entry->hent_val;
1244 stash = stab_hash(stab);
1245 if (!stash || stash->tbl_spatroot == Null(SPAT*))
1247 if (stash->tbl_spatroot == spat)
1248 stash->tbl_spatroot = spat->spat_next;
1250 for (sp = stash->tbl_spatroot;
1251 sp && sp->spat_next != spat;
1255 sp->spat_next = spat->spat_next;
1261 /* Recursively descend a command sequence and push the address of any string
1262 * that needs saving on recursion onto the tosave array.
1266 cmd_tosave(cmd,willsave)
1268 int willsave; /* willsave passes down the tree */
1270 register CMD *head = cmd;
1271 int shouldsave = FALSE; /* shouldsave passes up the tree */
1273 register CMD *lastcmd = Nullcmd;
1277 shouldsave |= spat_tosave(cmd->c_spat);
1279 shouldsave |= arg_tosave(cmd->c_expr,willsave);
1280 switch (cmd->c_type) {
1282 if (cmd->ucmd.ccmd.cc_true) {
1283 tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1285 /* Here we check to see if the temporary array generated for
1286 * a foreach needs to be localized because of recursion.
1288 if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
1290 lastcmd->c_type == C_EXPR &&
1291 lastcmd->ucmd.acmd.ac_expr) {
1292 ARG *arg = lastcmd->ucmd.acmd.ac_expr;
1294 if (arg->arg_type == O_ASSIGN &&
1295 arg[1].arg_type == A_LEXPR &&
1296 arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
1299 arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
1300 5)) { /* array generated for foreach */
1301 (void)localize(arg[1].arg_ptr.arg_arg);
1305 /* in any event, save the iterator */
1307 (void)apush(tosave,cmd->c_short);
1309 shouldsave |= tmpsave;
1315 if (cmd->ucmd.ccmd.cc_true)
1316 shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1319 if (cmd->ucmd.acmd.ac_expr)
1320 shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
1325 if (cmd && cmd == head) /* reached end of while loop */
1332 arg_tosave(arg,willsave)
1337 int shouldsave = FALSE;
1339 for (i = arg->arg_len; i >= 1; i--) {
1340 switch (arg[i].arg_type & A_MASK) {
1345 shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
1348 shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
1361 shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
1365 switch (arg->arg_type) {
1375 (void)apush(tosave,arg->arg_ptr.arg_str);
1381 register SPAT *spat;
1383 int shouldsave = FALSE;
1385 if (spat->spat_runtime)
1386 shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
1387 if (spat->spat_repl) {
1388 shouldsave |= arg_tosave(spat->spat_repl,FALSE);