1 /* $Header: cmd.c,v 3.0 89/10/18 15:09:02 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 89/10/18 15:09:02 lwall
25 /* This is the main command loop. We try to spend as much time in this loop
26 * as possible, so lots of optimizations do their activities in here. This
27 * means things get a little sloppy.
31 cmd_exec(cmd,gimme,sp)
32 #ifdef cray /* nobody else has complained yet */
47 register STR *retstr = &str_undef;
49 register int cmdflags;
51 register char *go_to = goto_targ;
52 register int newsp = -2;
53 register STR **st = stack->ary_array;
66 tainted = 0; /* Each statement is presumed innocent */
69 if (gimme == G_ARRAY && newsp > -2)
76 cmdflags = cmd->c_flags; /* hopefully load register */
78 if (cmd->c_label && strEQ(go_to,cmd->c_label))
79 goto_targ = go_to = Nullch; /* here at last */
81 switch (cmd->c_type) {
84 oldsave = savestack->ary_fill;
90 if (cmd->ucmd.ccmd.cc_true) {
93 debname[dlevel] = 't';
94 debdelim[dlevel] = '_';
95 if (++dlevel >= dlmax)
99 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
100 st = stack->ary_array; /* possibly reallocated */
106 if (savestack->ary_fill > oldsave)
107 restorelist(oldsave);
111 cmd = cmd->ucmd.ccmd.cc_alt;
112 goto tail_recursion_entry;
115 oldsave = savestack->ary_fill;
121 if (cmd->ucmd.ccmd.cc_true) {
124 debname[dlevel] = 'e';
125 debdelim[dlevel] = '_';
126 if (++dlevel >= dlmax)
130 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
131 st = stack->ary_array; /* possibly reallocated */
137 if (savestack->ary_fill > oldsave)
138 restorelist(oldsave);
145 if (!(cmdflags & CF_ONCE)) {
147 if (++loop_ptr >= loop_max) {
149 Renew(loop_stack, loop_max, struct loop);
151 loop_stack[loop_ptr].loop_label = cmd->c_label;
152 loop_stack[loop_ptr].loop_sp = sp;
155 deb("(Pushing label #%d %s)\n",
156 loop_ptr, cmd->c_label ? cmd->c_label : "");
160 switch (setjmp(loop_stack[loop_ptr].loop_env)) {
161 case O_LAST: /* not done unless go_to found */
163 st = stack->ary_array; /* possibly reallocated */
169 newsp = sp + lastsize;
176 if (savestack->ary_fill > oldsave)
177 restorelist(oldsave);
179 case O_NEXT: /* not done unless go_to found */
182 case O_REDO: /* not done unless go_to found */
187 oldsave = savestack->ary_fill;
191 if (cmd->ucmd.ccmd.cc_true) {
194 debname[dlevel] = 't';
195 debdelim[dlevel] = '_';
196 if (++dlevel >= dlmax)
200 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
201 st = stack->ary_array; /* possibly reallocated */
211 if (cmd->ucmd.ccmd.cc_alt) {
214 debname[dlevel] = 'a';
215 debdelim[dlevel] = '_';
216 if (++dlevel >= dlmax)
220 newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
221 st = stack->ary_array; /* possibly reallocated */
230 if (cmd && cmd->c_head == cmd)
231 /* reached end of while loop */
232 return sp; /* targ isn't in this block */
233 if (cmdflags & CF_ONCE) {
236 tmps = loop_stack[loop_ptr].loop_label;
237 deb("(Popping label #%d %s)\n",loop_ptr,
243 goto tail_recursion_entry;
249 /* Set line number so run-time errors can be located */
256 deb("%s (%lx) r%lx t%lx a%lx n%lx cs%lx\n",
257 cmdname[cmd->c_type],cmd,cmd->c_expr,
258 cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
261 debname[dlevel] = cmdname[cmd->c_type][0];
262 debdelim[dlevel] = '!';
263 if (++dlevel >= dlmax)
268 /* Here is some common optimization */
270 if (cmdflags & CF_COND) {
271 switch (cmdflags & CF_OPTIMIZE) {
274 retstr = cmd->c_short;
277 if (cmdflags & CF_NESURE)
281 retstr = cmd->c_short;
284 if (cmdflags & CF_EQSURE)
289 retstr = STAB_STR(cmd->c_stab);
291 match = str_true(retstr); /* => retstr = retstr, c2 should fix */
292 if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
296 case CFT_ANCHOR: /* /^pat/ optimization */
298 if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
299 goto scanner; /* just unanchor it */
301 break; /* must evaluate */
304 case CFT_STROP: /* string op optimization */
305 retstr = STAB_STR(cmd->c_stab);
308 if (*cmd->c_short->str_ptr == *str_get(retstr) &&
309 bcmp(cmd->c_short->str_ptr, str_get(retstr),
310 cmd->c_slen) == 0 ) {
311 if (cmdflags & CF_EQSURE) {
312 if (sawampersand && (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
315 str_nset(stab_val(leftstab),"",0);
317 str_sset(stab_val(amperstab),cmd->c_short);
319 str_nset(stab_val(rightstab),
320 retstr->str_ptr + cmd->c_slen,
321 retstr->str_cur - cmd->c_slen);
323 match = !(cmdflags & CF_FIRSTNEG);
328 else if (cmdflags & CF_NESURE) {
329 match = cmdflags & CF_FIRSTNEG;
335 char *zap1, *zap2, zap1c, zap2c;
338 zap1 = cmd->c_short->str_ptr;
339 zap2 = str_get(retstr);
342 zaplen = cmd->c_slen;
343 if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
344 if (cmdflags & CF_EQSURE) {
346 (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
349 str_nset(stab_val(leftstab),"",0);
351 str_sset(stab_val(amperstab),cmd->c_short);
353 str_nset(stab_val(rightstab),
354 retstr->str_ptr + cmd->c_slen,
355 retstr->str_cur - cmd->c_slen);
357 match = !(cmdflags & CF_FIRSTNEG);
362 else if (cmdflags & CF_NESURE) {
363 match = cmdflags & CF_FIRSTNEG;
369 break; /* must evaluate */
371 case CFT_SCAN: /* non-anchored search */
373 retstr = STAB_STR(cmd->c_stab);
375 if (retstr->str_pok & SP_STUDIED)
376 if (screamfirst[cmd->c_short->str_rare] >= 0)
377 tmps = screaminstr(retstr, cmd->c_short);
381 tmps = str_get(retstr); /* make sure it's pok */
383 tmps = fbminstr((unsigned char*)tmps,
384 (unsigned char*)tmps + retstr->str_cur, cmd->c_short);
388 if (cmdflags & CF_EQSURE) {
389 ++cmd->c_short->str_u.str_useful;
393 str_nset(stab_val(leftstab),retstr->str_ptr,
394 tmps - retstr->str_ptr);
396 str_sset(stab_val(amperstab),cmd->c_short);
398 str_nset(stab_val(rightstab),
399 tmps + cmd->c_short->str_cur,
400 retstr->str_cur - (tmps - retstr->str_ptr) -
401 cmd->c_short->str_cur);
403 match = !(cmdflags & CF_FIRSTNEG);
411 if (cmdflags & CF_NESURE) {
412 ++cmd->c_short->str_u.str_useful;
413 match = cmdflags & CF_FIRSTNEG;
418 if (--cmd->c_short->str_u.str_useful < 0) {
419 str_free(cmd->c_short);
420 cmd->c_short = Nullstr;
421 cmdflags &= ~CF_OPTIMIZE;
422 cmdflags |= CFT_EVAL; /* never try this optimization again */
423 cmd->c_flags = cmdflags;
425 break; /* must evaluate */
427 case CFT_NUMOP: /* numeric op optimization */
428 retstr = STAB_STR(cmd->c_stab);
430 switch (cmd->c_slen) {
433 if ((!retstr->str_nok && !looks_like_number(retstr)))
434 warn("Possible use of == on string value");
436 match = (str_gnum(retstr) == cmd->c_short->str_u.str_nval);
439 match = (str_gnum(retstr) != cmd->c_short->str_u.str_nval);
442 match = (str_gnum(retstr) < cmd->c_short->str_u.str_nval);
445 match = (str_gnum(retstr) <= cmd->c_short->str_u.str_nval);
448 match = (str_gnum(retstr) > cmd->c_short->str_u.str_nval);
451 match = (str_gnum(retstr) >= cmd->c_short->str_u.str_nval);
455 if (cmdflags & CF_EQSURE) {
460 else if (cmdflags & CF_NESURE) {
464 break; /* must evaluate */
466 case CFT_INDGETS: /* while (<$foo>) */
467 last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
468 if (!stab_io(last_in_stab))
469 stab_io(last_in_stab) = stio_new();
471 case CFT_GETS: /* really a while (<file>) */
472 last_in_stab = cmd->c_stab;
474 fp = stab_io(last_in_stab)->ifp;
475 retstr = stab_val(defstab);
477 if (fp && str_gets(retstr, fp, 0)) {
478 if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
482 stab_io(last_in_stab)->lines++;
484 else if (stab_io(last_in_stab)->flags & IOF_ARGV)
485 goto doeval; /* doesn't necessarily count as EOF yet */
494 while (tmps_max > tmps_base) /* clean up after last eval */
495 str_free(tmps_list[tmps_max--]);
496 newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
497 st = stack->ary_array; /* possibly reallocated */
499 match = str_true(retstr);
500 if (cmd->c_expr->arg_type == O_FLIP) /* undid itself? */
501 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
504 retstr = stab_val(cmd->c_stab);
506 match = (retstr->str_cur != 0);
507 tmps = str_get(retstr);
508 tmps += retstr->str_cur - match;
509 str_nset(&str_chop,tmps,match);
512 retstr->str_cur = tmps - retstr->str_ptr;
516 ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
517 match = ar->ary_index; /* just to get register */
519 if (match < 0) { /* first time through here? */
520 aryoptsave = savestack->ary_fill;
521 savesptr(&stab_val(cmd->c_stab));
522 saveint(&ar->ary_index);
525 if (match >= ar->ary_fill) { /* we're in LAST, probably */
527 ar->ary_index = -1; /* this is actually redundant */
532 retstr = stab_val(cmd->c_stab) = ar->ary_array[match];
533 ar->ary_index = match;
540 /* we have tried to make this normal case as abnormal as possible */
543 if (gimme == G_ARRAY) {
544 lastretstr = Nullstr;
546 lastsize = newsp - sp;
550 while (tmps_max > tmps_base) /* clean up after last eval */
551 str_free(tmps_list[tmps_max--]);
552 newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
553 st = stack->ary_array; /* possibly reallocated */
556 match = str_true(retstr);
561 /* if flipflop was true, flop it */
564 if (match && cmdflags & CF_FLIP) {
565 while (tmps_max > tmps_base) /* clean up after last eval */
566 str_free(tmps_list[tmps_max--]);
567 if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */
568 newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
569 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
572 newsp = eval(cmd->c_expr,G_SCALAR,sp);/* let eval do it */
573 if (cmd->c_expr->arg_type == O_FLOP) /* still toggled? */
574 cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
577 else if (cmdflags & CF_FLIP) {
578 if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */
579 match = TRUE; /* force on */
583 /* at this point, match says whether our expression was true */
586 if (cmdflags & CF_INVERT)
592 tainted = 0; /* modifier doesn't affect regular expression */
595 /* now to do the actual command, if any */
597 switch (cmd->c_type) {
599 fatal("panic: cmd_exec");
600 case C_EXPR: /* evaluated for side effects */
601 if (cmd->ucmd.acmd.ac_expr) { /* more to do? */
602 if (gimme == G_ARRAY) {
603 lastretstr = Nullstr;
605 lastsize = newsp - sp;
609 while (tmps_max > tmps_base) /* clean up after last eval */
610 str_free(tmps_list[tmps_max--]);
611 newsp = eval(cmd->ucmd.acmd.ac_expr,gimme && (cmdflags&CF_TERM),sp);
612 st = stack->ary_array; /* possibly reallocated */
617 match = (int)str_gnum(STAB_STR(cmd->c_stab));
620 match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
622 match -= cmd->ucmd.scmd.sc_offset;
625 else if (match > cmd->ucmd.scmd.sc_max)
627 cmd = cmd->ucmd.scmd.sc_next[match];
628 goto tail_recursion_entry;
630 cmd = cmd->ucmd.ccmd.cc_alt;
631 goto tail_recursion_entry;
633 fatal("panic: ELSIF");
636 oldsave = savestack->ary_fill;
642 if (cmd->ucmd.ccmd.cc_true) {
645 debname[dlevel] = 't';
646 debdelim[dlevel] = '_';
647 if (++dlevel >= dlmax)
651 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
652 st = stack->ary_array; /* possibly reallocated */
656 if (savestack->ary_fill > oldsave)
657 restorelist(oldsave);
661 cmd = cmd->ucmd.ccmd.cc_alt;
662 goto tail_recursion_entry;
665 oldsave = savestack->ary_fill;
671 if (cmd->ucmd.ccmd.cc_true) {
674 debname[dlevel] = 'e';
675 debdelim[dlevel] = '_';
676 if (++dlevel >= dlmax)
680 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
681 st = stack->ary_array; /* possibly reallocated */
685 if (savestack->ary_fill > oldsave)
686 restorelist(oldsave);
693 if (!(cmdflags & CF_ONCE)) { /* first time through here? */
695 if (++loop_ptr >= loop_max) {
697 Renew(loop_stack, loop_max, struct loop);
699 loop_stack[loop_ptr].loop_label = cmd->c_label;
700 loop_stack[loop_ptr].loop_sp = sp;
703 deb("(Pushing label #%d %s)\n",
704 loop_ptr, cmd->c_label ? cmd->c_label : "");
708 switch (setjmp(loop_stack[loop_ptr].loop_env)) {
710 /* retstr = lastretstr; */
711 st = stack->ary_array; /* possibly reallocated */
717 newsp = sp + lastsize;
721 if (savestack->ary_fill > oldsave)
722 restorelist(oldsave);
733 oldsave = savestack->ary_fill;
738 if (cmd->ucmd.ccmd.cc_true) {
741 debname[dlevel] = 't';
742 debdelim[dlevel] = '_';
743 if (++dlevel >= dlmax)
747 newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
748 st = stack->ary_array; /* possibly reallocated */
751 /* actually, this spot is rarely reached anymore since the above
752 * cmd_exec() returns through longjmp(). Hooray for structure.
758 if (cmd->ucmd.ccmd.cc_alt) {
761 debname[dlevel] = 'a';
762 debdelim[dlevel] = '_';
763 if (++dlevel >= dlmax)
767 newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
768 st = stack->ary_array; /* possibly reallocated */
773 if (savestack->ary_fill > oldsave)
774 restorelist(oldsave);
776 dlevel = olddlevel - 1;
778 if (cmd->c_type != C_BLOCK)
779 goto until_loop; /* go back and evaluate conditional again */
781 if (cmdflags & CF_LOOP) {
782 cmdflags |= CF_COND; /* now test the condition */
789 if (cmdflags & CF_ONCE) {
792 tmps = loop_stack[loop_ptr].loop_label;
793 deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
797 if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY)
798 restorelist(aryoptsave);
801 goto tail_recursion_entry;
807 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
812 fprintf(stderr,"%-4ld",(long)line);
813 for (i=0; i<dlevel; i++)
814 fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
815 fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
827 fprintf(stderr,"%-4ld",(long)line);
828 for (i=0; i<dlevel; i++)
829 fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
831 pat = va_arg(args, char *);
832 (void) vfprintf(stderr,pat,args);
842 cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
843 cmd->c_flags |= which->c_flags;
844 cmd->c_short = which->c_short;
845 cmd->c_slen = which->c_slen;
846 cmd->c_stab = which->c_stab;
857 str->str_state = SS_SARY;
858 str->str_u.str_stab = stab;
860 Safefree(str->str_ptr);
863 str->str_ptr = (char*)stab_array(stab);
864 (void)apush(savestack,str); /* save array ptr */
865 stab_xarray(stab) = Null(ARRAY*);
866 return stab_xarray(aadd(stab));
876 str->str_state = SS_SHASH;
877 str->str_u.str_stab = stab;
879 Safefree(str->str_ptr);
882 str->str_ptr = (char*)stab_hash(stab);
883 (void)apush(savestack,str); /* save hash ptr */
884 stab_xhash(stab) = Null(HASH*);
885 return stab_xhash(hadd(stab));
894 (void)apush(savestack,item); /* remember the pointer */
897 (void)apush(savestack,str); /* remember the value */
907 str->str_state = SS_SINT;
908 str->str_u.str_useful = (long)*intp; /* remember value */
910 Safefree(str->str_ptr);
913 str->str_ptr = (char*)intp; /* remember pointer */
914 (void)apush(savestack,str);
924 str->str_state = SS_SLONG;
925 str->str_u.str_useful = *longp; /* remember value */
927 Safefree(str->str_ptr);
930 str->str_ptr = (char*)longp; /* remember pointer */
931 (void)apush(savestack,str);
941 str->str_state = SS_SSTRP;
942 str->str_magic = *sptr; /* remember value */
944 Safefree(str->str_ptr);
947 str->str_ptr = (char*)sptr; /* remember pointer */
948 (void)apush(savestack,str);
958 str->str_state = SS_SNSTAB;
959 str->str_magic = (STR*)stab; /* remember which stab to free */
960 (void)apush(savestack,str);
970 str->str_state = SS_SHPTR;
971 str->str_u.str_hash = *hptr; /* remember value */
973 Safefree(str->str_ptr);
976 str->str_ptr = (char*)hptr; /* remember pointer */
977 (void)apush(savestack,str);
981 savelist(sarg,maxsarg)
988 for (i = 1; i <= maxsarg; i++) {
989 (void)apush(savestack,sarg[i]); /* remember the pointer */
991 str_sset(str,sarg[i]);
992 (void)apush(savestack,str); /* remember the value */
1001 register STR *value;
1002 register STAB *stab;
1005 fatal("panic: corrupt saved stack index");
1006 while (savestack->ary_fill > base) {
1007 value = apop(savestack);
1008 switch (value->str_state) {
1009 case SS_NORM: /* normal string */
1011 str = apop(savestack);
1012 str_replace(str,value);
1015 case SS_SARY: /* array reference */
1016 stab = value->str_u.str_stab;
1017 afree(stab_xarray(stab));
1018 stab_xarray(stab) = (ARRAY*)value->str_ptr;
1019 value->str_ptr = Nullch;
1022 case SS_SHASH: /* hash reference */
1023 stab = value->str_u.str_stab;
1024 (void)hfree(stab_xhash(stab));
1025 stab_xhash(stab) = (HASH*)value->str_ptr;
1026 value->str_ptr = Nullch;
1029 case SS_SINT: /* int reference */
1030 *((int*)value->str_ptr) = (int)value->str_u.str_useful;
1031 value->str_ptr = Nullch;
1034 case SS_SLONG: /* long reference */
1035 *((long*)value->str_ptr) = value->str_u.str_useful;
1036 value->str_ptr = Nullch;
1039 case SS_SSTRP: /* STR* reference */
1040 *((STR**)value->str_ptr) = value->str_magic;
1041 value->str_magic = Nullstr;
1042 value->str_ptr = Nullch;
1045 case SS_SHPTR: /* HASH* reference */
1046 *((HASH**)value->str_ptr) = value->str_u.str_hash;
1047 value->str_ptr = Nullch;
1051 stab = (STAB*)value->str_magic;
1052 value->str_magic = Nullstr;
1053 (void)stab_clear(stab);
1057 fatal("panic: restorelist inconsistency");
1066 Renew(debname, dlmax, char);
1067 Renew(debdelim, dlmax, char);