1 /* $Header: cmd.c,v 3.0.1.1 89/10/26 23:04:21 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.1 89/10/26 23:04:21 lwall
10 * patch1: heuristically disabled optimization could cause core dump
12 * Revision 3.0 89/10/18 15:09:02 lwall
28 /* This is the main command loop. We try to spend as much time in this loop
29 * as possible, so lots of optimizations do their activities in here. This
30 * means things get a little sloppy.
34 cmd_exec(cmd,gimme,sp)
35 #ifdef cray /* nobody else has complained yet */
50 register STR *retstr = &str_undef;
52 register int cmdflags;
54 register char *go_to = goto_targ;
55 register int newsp = -2;
56 register STR **st = stack->ary_array;
69 tainted = 0; /* Each statement is presumed innocent */
72 if (gimme == G_ARRAY && newsp > -2)
79 cmdflags = cmd->c_flags; /* hopefully load register */
81 if (cmd->c_label && strEQ(go_to,cmd->c_label))
82 goto_targ = go_to = Nullch; /* here at last */
84 switch (cmd->c_type) {
87 oldsave = savestack->ary_fill;
93 if (cmd->ucmd.ccmd.cc_true) {
96 debname[dlevel] = 't';
97 debdelim[dlevel] = '_';
98 if (++dlevel >= dlmax)
102 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
103 st = stack->ary_array; /* possibly reallocated */
109 if (savestack->ary_fill > oldsave)
110 restorelist(oldsave);
114 cmd = cmd->ucmd.ccmd.cc_alt;
115 goto tail_recursion_entry;
118 oldsave = savestack->ary_fill;
124 if (cmd->ucmd.ccmd.cc_true) {
127 debname[dlevel] = 'e';
128 debdelim[dlevel] = '_';
129 if (++dlevel >= dlmax)
133 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
134 st = stack->ary_array; /* possibly reallocated */
140 if (savestack->ary_fill > oldsave)
141 restorelist(oldsave);
148 if (!(cmdflags & CF_ONCE)) {
150 if (++loop_ptr >= loop_max) {
152 Renew(loop_stack, loop_max, struct loop);
154 loop_stack[loop_ptr].loop_label = cmd->c_label;
155 loop_stack[loop_ptr].loop_sp = sp;
158 deb("(Pushing label #%d %s)\n",
159 loop_ptr, cmd->c_label ? cmd->c_label : "");
163 switch (setjmp(loop_stack[loop_ptr].loop_env)) {
164 case O_LAST: /* not done unless go_to found */
166 st = stack->ary_array; /* possibly reallocated */
172 newsp = sp + lastsize;
179 if (savestack->ary_fill > oldsave)
180 restorelist(oldsave);
182 case O_NEXT: /* not done unless go_to found */
185 case O_REDO: /* not done unless go_to found */
190 oldsave = savestack->ary_fill;
194 if (cmd->ucmd.ccmd.cc_true) {
197 debname[dlevel] = 't';
198 debdelim[dlevel] = '_';
199 if (++dlevel >= dlmax)
203 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
204 st = stack->ary_array; /* possibly reallocated */
214 if (cmd->ucmd.ccmd.cc_alt) {
217 debname[dlevel] = 'a';
218 debdelim[dlevel] = '_';
219 if (++dlevel >= dlmax)
223 newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
224 st = stack->ary_array; /* possibly reallocated */
233 if (cmd && cmd->c_head == cmd)
234 /* reached end of while loop */
235 return sp; /* targ isn't in this block */
236 if (cmdflags & CF_ONCE) {
239 tmps = loop_stack[loop_ptr].loop_label;
240 deb("(Popping label #%d %s)\n",loop_ptr,
246 goto tail_recursion_entry;
252 /* Set line number so run-time errors can be located */
259 deb("%s (%lx) r%lx t%lx a%lx n%lx cs%lx\n",
260 cmdname[cmd->c_type],cmd,cmd->c_expr,
261 cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
264 debname[dlevel] = cmdname[cmd->c_type][0];
265 debdelim[dlevel] = '!';
266 if (++dlevel >= dlmax)
271 /* Here is some common optimization */
273 if (cmdflags & CF_COND) {
274 switch (cmdflags & CF_OPTIMIZE) {
277 retstr = cmd->c_short;
280 if (cmdflags & CF_NESURE)
284 retstr = cmd->c_short;
287 if (cmdflags & CF_EQSURE)
292 retstr = STAB_STR(cmd->c_stab);
294 match = str_true(retstr); /* => retstr = retstr, c2 should fix */
295 if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
299 case CFT_ANCHOR: /* /^pat/ optimization */
301 if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
302 goto scanner; /* just unanchor it */
304 break; /* must evaluate */
307 case CFT_STROP: /* string op optimization */
308 retstr = STAB_STR(cmd->c_stab);
311 if (*cmd->c_short->str_ptr == *str_get(retstr) &&
312 bcmp(cmd->c_short->str_ptr, str_get(retstr),
313 cmd->c_slen) == 0 ) {
314 if (cmdflags & CF_EQSURE) {
315 if (sawampersand && (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
318 str_nset(stab_val(leftstab),"",0);
320 str_sset(stab_val(amperstab),cmd->c_short);
322 str_nset(stab_val(rightstab),
323 retstr->str_ptr + cmd->c_slen,
324 retstr->str_cur - cmd->c_slen);
326 match = !(cmdflags & CF_FIRSTNEG);
331 else if (cmdflags & CF_NESURE) {
332 match = cmdflags & CF_FIRSTNEG;
338 char *zap1, *zap2, zap1c, zap2c;
341 zap1 = cmd->c_short->str_ptr;
342 zap2 = str_get(retstr);
345 zaplen = cmd->c_slen;
346 if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
347 if (cmdflags & CF_EQSURE) {
349 (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
352 str_nset(stab_val(leftstab),"",0);
354 str_sset(stab_val(amperstab),cmd->c_short);
356 str_nset(stab_val(rightstab),
357 retstr->str_ptr + cmd->c_slen,
358 retstr->str_cur - cmd->c_slen);
360 match = !(cmdflags & CF_FIRSTNEG);
365 else if (cmdflags & CF_NESURE) {
366 match = cmdflags & CF_FIRSTNEG;
372 break; /* must evaluate */
374 case CFT_SCAN: /* non-anchored search */
376 retstr = STAB_STR(cmd->c_stab);
378 if (retstr->str_pok & SP_STUDIED)
379 if (screamfirst[cmd->c_short->str_rare] >= 0)
380 tmps = screaminstr(retstr, cmd->c_short);
384 tmps = str_get(retstr); /* make sure it's pok */
386 tmps = fbminstr((unsigned char*)tmps,
387 (unsigned char*)tmps + retstr->str_cur, cmd->c_short);
391 if (cmdflags & CF_EQSURE) {
392 ++cmd->c_short->str_u.str_useful;
396 str_nset(stab_val(leftstab),retstr->str_ptr,
397 tmps - retstr->str_ptr);
399 str_sset(stab_val(amperstab),cmd->c_short);
401 str_nset(stab_val(rightstab),
402 tmps + cmd->c_short->str_cur,
403 retstr->str_cur - (tmps - retstr->str_ptr) -
404 cmd->c_short->str_cur);
406 match = !(cmdflags & CF_FIRSTNEG);
414 if (cmdflags & CF_NESURE) {
415 ++cmd->c_short->str_u.str_useful;
416 match = cmdflags & CF_FIRSTNEG;
421 if (--cmd->c_short->str_u.str_useful < 0) {
422 cmdflags &= ~CF_OPTIMIZE;
423 cmdflags |= CFT_EVAL; /* never try this optimization again */
424 cmd->c_flags = cmdflags;
426 break; /* must evaluate */
428 case CFT_NUMOP: /* numeric op optimization */
429 retstr = STAB_STR(cmd->c_stab);
431 switch (cmd->c_slen) {
434 if ((!retstr->str_nok && !looks_like_number(retstr)))
435 warn("Possible use of == on string value");
437 match = (str_gnum(retstr) == cmd->c_short->str_u.str_nval);
440 match = (str_gnum(retstr) != cmd->c_short->str_u.str_nval);
443 match = (str_gnum(retstr) < cmd->c_short->str_u.str_nval);
446 match = (str_gnum(retstr) <= cmd->c_short->str_u.str_nval);
449 match = (str_gnum(retstr) > cmd->c_short->str_u.str_nval);
452 match = (str_gnum(retstr) >= cmd->c_short->str_u.str_nval);
456 if (cmdflags & CF_EQSURE) {
461 else if (cmdflags & CF_NESURE) {
465 break; /* must evaluate */
467 case CFT_INDGETS: /* while (<$foo>) */
468 last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
469 if (!stab_io(last_in_stab))
470 stab_io(last_in_stab) = stio_new();
472 case CFT_GETS: /* really a while (<file>) */
473 last_in_stab = cmd->c_stab;
475 fp = stab_io(last_in_stab)->ifp;
476 retstr = stab_val(defstab);
478 if (fp && str_gets(retstr, fp, 0)) {
479 if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
483 stab_io(last_in_stab)->lines++;
485 else if (stab_io(last_in_stab)->flags & IOF_ARGV)
486 goto doeval; /* doesn't necessarily count as EOF yet */
495 while (tmps_max > tmps_base) /* clean up after last eval */
496 str_free(tmps_list[tmps_max--]);
497 newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
498 st = stack->ary_array; /* possibly reallocated */
500 match = str_true(retstr);
501 if (cmd->c_expr->arg_type == O_FLIP) /* undid itself? */
502 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
505 retstr = stab_val(cmd->c_stab);
507 match = (retstr->str_cur != 0);
508 tmps = str_get(retstr);
509 tmps += retstr->str_cur - match;
510 str_nset(&str_chop,tmps,match);
513 retstr->str_cur = tmps - retstr->str_ptr;
517 ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
518 match = ar->ary_index; /* just to get register */
520 if (match < 0) { /* first time through here? */
521 aryoptsave = savestack->ary_fill;
522 savesptr(&stab_val(cmd->c_stab));
523 saveint(&ar->ary_index);
526 if (match >= ar->ary_fill) { /* we're in LAST, probably */
528 ar->ary_index = -1; /* this is actually redundant */
533 retstr = stab_val(cmd->c_stab) = ar->ary_array[match];
534 ar->ary_index = match;
541 /* we have tried to make this normal case as abnormal as possible */
544 if (gimme == G_ARRAY) {
545 lastretstr = Nullstr;
547 lastsize = newsp - sp;
551 while (tmps_max > tmps_base) /* clean up after last eval */
552 str_free(tmps_list[tmps_max--]);
553 newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
554 st = stack->ary_array; /* possibly reallocated */
557 match = str_true(retstr);
562 /* if flipflop was true, flop it */
565 if (match && cmdflags & CF_FLIP) {
566 while (tmps_max > tmps_base) /* clean up after last eval */
567 str_free(tmps_list[tmps_max--]);
568 if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */
569 newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
570 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
573 newsp = eval(cmd->c_expr,G_SCALAR,sp);/* let eval do it */
574 if (cmd->c_expr->arg_type == O_FLOP) /* still toggled? */
575 cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
578 else if (cmdflags & CF_FLIP) {
579 if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */
580 match = TRUE; /* force on */
584 /* at this point, match says whether our expression was true */
587 if (cmdflags & CF_INVERT)
593 tainted = 0; /* modifier doesn't affect regular expression */
596 /* now to do the actual command, if any */
598 switch (cmd->c_type) {
600 fatal("panic: cmd_exec");
601 case C_EXPR: /* evaluated for side effects */
602 if (cmd->ucmd.acmd.ac_expr) { /* more to do? */
603 if (gimme == G_ARRAY) {
604 lastretstr = Nullstr;
606 lastsize = newsp - sp;
610 while (tmps_max > tmps_base) /* clean up after last eval */
611 str_free(tmps_list[tmps_max--]);
612 newsp = eval(cmd->ucmd.acmd.ac_expr,gimme && (cmdflags&CF_TERM),sp);
613 st = stack->ary_array; /* possibly reallocated */
618 match = (int)str_gnum(STAB_STR(cmd->c_stab));
621 match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
623 match -= cmd->ucmd.scmd.sc_offset;
626 else if (match > cmd->ucmd.scmd.sc_max)
628 cmd = cmd->ucmd.scmd.sc_next[match];
629 goto tail_recursion_entry;
631 cmd = cmd->ucmd.ccmd.cc_alt;
632 goto tail_recursion_entry;
634 fatal("panic: ELSIF");
637 oldsave = savestack->ary_fill;
643 if (cmd->ucmd.ccmd.cc_true) {
646 debname[dlevel] = 't';
647 debdelim[dlevel] = '_';
648 if (++dlevel >= dlmax)
652 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
653 st = stack->ary_array; /* possibly reallocated */
657 if (savestack->ary_fill > oldsave)
658 restorelist(oldsave);
662 cmd = cmd->ucmd.ccmd.cc_alt;
663 goto tail_recursion_entry;
666 oldsave = savestack->ary_fill;
672 if (cmd->ucmd.ccmd.cc_true) {
675 debname[dlevel] = 'e';
676 debdelim[dlevel] = '_';
677 if (++dlevel >= dlmax)
681 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
682 st = stack->ary_array; /* possibly reallocated */
686 if (savestack->ary_fill > oldsave)
687 restorelist(oldsave);
694 if (!(cmdflags & CF_ONCE)) { /* first time through here? */
696 if (++loop_ptr >= loop_max) {
698 Renew(loop_stack, loop_max, struct loop);
700 loop_stack[loop_ptr].loop_label = cmd->c_label;
701 loop_stack[loop_ptr].loop_sp = sp;
704 deb("(Pushing label #%d %s)\n",
705 loop_ptr, cmd->c_label ? cmd->c_label : "");
709 switch (setjmp(loop_stack[loop_ptr].loop_env)) {
711 /* retstr = lastretstr; */
712 st = stack->ary_array; /* possibly reallocated */
718 newsp = sp + lastsize;
722 if (savestack->ary_fill > oldsave)
723 restorelist(oldsave);
734 oldsave = savestack->ary_fill;
739 if (cmd->ucmd.ccmd.cc_true) {
742 debname[dlevel] = 't';
743 debdelim[dlevel] = '_';
744 if (++dlevel >= dlmax)
748 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
749 st = stack->ary_array; /* possibly reallocated */
752 /* actually, this spot is rarely reached anymore since the above
753 * cmd_exec() returns through longjmp(). Hooray for structure.
759 if (cmd->ucmd.ccmd.cc_alt) {
762 debname[dlevel] = 'a';
763 debdelim[dlevel] = '_';
764 if (++dlevel >= dlmax)
768 newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
769 st = stack->ary_array; /* possibly reallocated */
774 if (savestack->ary_fill > oldsave)
775 restorelist(oldsave);
777 dlevel = olddlevel - 1;
779 if (cmd->c_type != C_BLOCK)
780 goto until_loop; /* go back and evaluate conditional again */
782 if (cmdflags & CF_LOOP) {
783 cmdflags |= CF_COND; /* now test the condition */
790 if (cmdflags & CF_ONCE) {
793 tmps = loop_stack[loop_ptr].loop_label;
794 deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
798 if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY)
799 restorelist(aryoptsave);
802 goto tail_recursion_entry;
808 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
813 fprintf(stderr,"%-4ld",(long)line);
814 for (i=0; i<dlevel; i++)
815 fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
816 fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
828 fprintf(stderr,"%-4ld",(long)line);
829 for (i=0; i<dlevel; i++)
830 fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
832 pat = va_arg(args, char *);
833 (void) vfprintf(stderr,pat,args);
843 cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
844 cmd->c_flags |= which->c_flags;
845 cmd->c_short = which->c_short;
846 cmd->c_slen = which->c_slen;
847 cmd->c_stab = which->c_stab;
858 str->str_state = SS_SARY;
859 str->str_u.str_stab = stab;
861 Safefree(str->str_ptr);
864 str->str_ptr = (char*)stab_array(stab);
865 (void)apush(savestack,str); /* save array ptr */
866 stab_xarray(stab) = Null(ARRAY*);
867 return stab_xarray(aadd(stab));
877 str->str_state = SS_SHASH;
878 str->str_u.str_stab = stab;
880 Safefree(str->str_ptr);
883 str->str_ptr = (char*)stab_hash(stab);
884 (void)apush(savestack,str); /* save hash ptr */
885 stab_xhash(stab) = Null(HASH*);
886 return stab_xhash(hadd(stab));
895 (void)apush(savestack,item); /* remember the pointer */
898 (void)apush(savestack,str); /* remember the value */
908 str->str_state = SS_SINT;
909 str->str_u.str_useful = (long)*intp; /* remember value */
911 Safefree(str->str_ptr);
914 str->str_ptr = (char*)intp; /* remember pointer */
915 (void)apush(savestack,str);
925 str->str_state = SS_SLONG;
926 str->str_u.str_useful = *longp; /* remember value */
928 Safefree(str->str_ptr);
931 str->str_ptr = (char*)longp; /* remember pointer */
932 (void)apush(savestack,str);
942 str->str_state = SS_SSTRP;
943 str->str_magic = *sptr; /* remember value */
945 Safefree(str->str_ptr);
948 str->str_ptr = (char*)sptr; /* remember pointer */
949 (void)apush(savestack,str);
959 str->str_state = SS_SNSTAB;
960 str->str_magic = (STR*)stab; /* remember which stab to free */
961 (void)apush(savestack,str);
971 str->str_state = SS_SHPTR;
972 str->str_u.str_hash = *hptr; /* remember value */
974 Safefree(str->str_ptr);
977 str->str_ptr = (char*)hptr; /* remember pointer */
978 (void)apush(savestack,str);
982 savelist(sarg,maxsarg)
989 for (i = 1; i <= maxsarg; i++) {
990 (void)apush(savestack,sarg[i]); /* remember the pointer */
992 str_sset(str,sarg[i]);
993 (void)apush(savestack,str); /* remember the value */
1002 register STR *value;
1003 register STAB *stab;
1006 fatal("panic: corrupt saved stack index");
1007 while (savestack->ary_fill > base) {
1008 value = apop(savestack);
1009 switch (value->str_state) {
1010 case SS_NORM: /* normal string */
1012 str = apop(savestack);
1013 str_replace(str,value);
1016 case SS_SARY: /* array reference */
1017 stab = value->str_u.str_stab;
1018 afree(stab_xarray(stab));
1019 stab_xarray(stab) = (ARRAY*)value->str_ptr;
1020 value->str_ptr = Nullch;
1023 case SS_SHASH: /* hash reference */
1024 stab = value->str_u.str_stab;
1025 (void)hfree(stab_xhash(stab));
1026 stab_xhash(stab) = (HASH*)value->str_ptr;
1027 value->str_ptr = Nullch;
1030 case SS_SINT: /* int reference */
1031 *((int*)value->str_ptr) = (int)value->str_u.str_useful;
1032 value->str_ptr = Nullch;
1035 case SS_SLONG: /* long reference */
1036 *((long*)value->str_ptr) = value->str_u.str_useful;
1037 value->str_ptr = Nullch;
1040 case SS_SSTRP: /* STR* reference */
1041 *((STR**)value->str_ptr) = value->str_magic;
1042 value->str_magic = Nullstr;
1043 value->str_ptr = Nullch;
1046 case SS_SHPTR: /* HASH* reference */
1047 *((HASH**)value->str_ptr) = value->str_u.str_hash;
1048 value->str_ptr = Nullch;
1052 stab = (STAB*)value->str_magic;
1053 value->str_magic = Nullstr;
1054 (void)stab_clear(stab);
1058 fatal("panic: restorelist inconsistency");
1067 Renew(debname, dlmax, char);
1068 Renew(debdelim, dlmax, char);