-/* $Header: cmd.c,v 3.0.1.3 89/11/17 15:04:36 lwall Locked $
+/* $RCSfile: cmd.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:36:16 $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: cmd.c,v $
- * Revision 3.0.1.3 89/11/17 15:04:36 lwall
- * patch5: nested foreach on same array didn't work
+ * Revision 4.0.1.1 91/04/11 17:36:16 lwall
+ * patch1: you may now use "die" and "caller" in a signal handler
*
- * Revision 3.0.1.2 89/11/11 04:08:56 lwall
- * patch2: non-BSD machines required two ^D's for <>
- * patch2: grow_dlevel() not inside #ifdef DEBUGGING
- *
- * Revision 3.0.1.1 89/10/26 23:04:21 lwall
- * patch1: heuristically disabled optimization could cause core dump
- *
- * Revision 3.0 89/10/18 15:09:02 lwall
- * 3.0 baseline
+ * Revision 4.0 91/03/20 01:04:18 lwall
+ * 4.0 baseline.
*
*/
void grow_dlevel();
+/* do longjmps() clobber register variables? */
+
+#if defined(cray) || defined(__STDC__)
+#define JMPCLOBBER
+#endif
+
/* This is the main command loop. We try to spend as much time in this loop
* as possible, so lots of optimizations do their activities in here. This
* means things get a little sloppy.
*/
int
-cmd_exec(cmd,gimme,sp)
-#ifdef cray /* nobody else has complained yet */
-CMD *cmd;
-#else
-register CMD *cmd;
-#endif
-int gimme;
-int sp;
+cmd_exec(cmdparm,gimme,sp)
+CMD *VOLATILE cmdparm;
+VOLATILE int gimme;
+VOLATILE int sp;
{
- SPAT *oldspat;
- int oldsave;
- int aryoptsave;
+ register CMD *cmd = cmdparm;
+ SPAT *VOLATILE oldspat;
+ VOLATILE int firstsave = savestack->ary_fill;
+ VOLATILE int oldsave;
+ VOLATILE int aryoptsave;
#ifdef DEBUGGING
- int olddlevel;
- int entdlevel;
+ VOLATILE int olddlevel;
+ VOLATILE int entdlevel;
#endif
register STR *retstr = &str_undef;
register char *tmps;
register char *go_to = goto_targ;
register int newsp = -2;
register STR **st = stack->ary_array;
- FILE *fp;
- ARRAY *ar;
+ FILE *VOLATILE fp;
+ ARRAY *VOLATILE ar;
lastsize = 0;
#ifdef DEBUGGING
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
}
#endif
}
- switch (setjmp(loop_stack[loop_ptr].loop_env)) {
- case O_LAST: /* not done unless go_to found */
- go_to = Nullch;
+#ifdef JMPCLOBBER
+ cmdparm = cmd;
+#endif
+ match = setjmp(loop_stack[loop_ptr].loop_env);
+ if (match) {
st = stack->ary_array; /* possibly reallocated */
- if (lastretstr) {
- retstr = lastretstr;
- newsp = -2;
- }
- else {
- newsp = sp + lastsize;
- retstr = st[newsp];
- }
-#ifdef DEBUGGING
- olddlevel = dlevel;
+#ifdef JMPCLOBBER
+ cmd = cmdparm;
+ cmdflags = cmd->c_flags|CF_ONCE;
#endif
- curspat = oldspat;
if (savestack->ary_fill > oldsave)
restorelist(oldsave);
- goto next_cmd;
- case O_NEXT: /* not done unless go_to found */
- go_to = Nullch;
- goto next_iter;
- case O_REDO: /* not done unless go_to found */
- go_to = Nullch;
- goto doit;
+ switch (match) {
+ default:
+ fatal("longjmp returned bad value (%d)",match);
+ case O_LAST: /* not done unless go_to found */
+ go_to = Nullch;
+ if (lastretstr) {
+ retstr = lastretstr;
+ newsp = -2;
+ }
+ else {
+ newsp = sp + lastsize;
+ retstr = st[newsp];
+ }
+#ifdef DEBUGGING
+ olddlevel = dlevel;
+#endif
+ curspat = oldspat;
+ goto next_cmd;
+ case O_NEXT: /* not done unless go_to found */
+ go_to = Nullch;
+#ifdef JMPCLOBBER
+ newsp = -2;
+ retstr = &str_undef;
+#endif
+ goto next_iter;
+ case O_REDO: /* not done unless go_to found */
+ go_to = Nullch;
+#ifdef JMPCLOBBER
+ newsp = -2;
+ retstr = &str_undef;
+#endif
+ goto doit;
+ }
}
oldspat = curspat;
oldsave = savestack->ary_fill;
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
/* Set line number so run-time errors can be located */
- line = cmd->c_line;
+ curcmd = cmd;
#ifdef DEBUGGING
if (debug) {
retstr->str_ptr + cmd->c_slen,
retstr->str_cur - cmd->c_slen);
}
+ if (cmd->c_spat)
+ lastspat = cmd->c_spat;
match = !(cmdflags & CF_FIRSTNEG);
retstr = &str_yes;
goto flipmaybe;
retstr->str_ptr + cmd->c_slen,
retstr->str_cur - cmd->c_slen);
}
+ if (cmd->c_spat)
+ lastspat = cmd->c_spat;
match = !(cmdflags & CF_FIRSTNEG);
retstr = &str_yes;
goto flipmaybe;
str_nset(stab_val(leftstab),retstr->str_ptr,
tmps - retstr->str_ptr);
if (amperstab)
- str_sset(stab_val(amperstab),cmd->c_short);
+ str_nset(stab_val(amperstab),
+ tmps, cmd->c_short->str_cur);
if (rightstab)
str_nset(stab_val(rightstab),
tmps + cmd->c_short->str_cur,
retstr->str_cur - (tmps - retstr->str_ptr) -
cmd->c_short->str_cur);
}
+ lastspat = cmd->c_spat;
match = !(cmdflags & CF_FIRSTNEG);
retstr = &str_yes;
goto flipmaybe;
if (--cmd->c_short->str_u.str_useful < 0) {
cmdflags &= ~CF_OPTIMIZE;
cmdflags |= CFT_EVAL; /* never try this optimization again */
- cmd->c_flags = cmdflags;
+ cmd->c_flags = (cmdflags & ~CF_ONCE);
}
break; /* must evaluate */
case CFT_EVAL:
break;
case CFT_UNFLIP:
- while (tmps_max > tmps_base) /* clean up after last eval */
- str_free(tmps_list[tmps_max--]);
+ while (tmps_max > tmps_base) { /* clean up after last eval */
+ str_free(tmps_list[tmps_max]);
+ tmps_list[tmps_max--] = Nullstr;
+ }
newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
*tmps = '\0';
retstr->str_nok = 0;
retstr->str_cur = tmps - retstr->str_ptr;
+ STABSET(retstr);
retstr = &str_chop;
goto flipmaybe;
case CFT_ARRAY:
savesptr(&stab_val(cmd->c_stab));
savelong(&cmd->c_short->str_u.str_useful);
}
- else
+ else {
ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
+ if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave)
+ restorelist(firstsave);
+ }
if (match >= ar->ary_fill) { /* we're in LAST, probably */
retstr = &str_undef;
}
else {
match++;
- retstr = stab_val(cmd->c_stab) = ar->ary_array[match];
+ if (!(retstr = ar->ary_array[match]))
+ retstr = afetch(ar,match,TRUE);
+ stab_val(cmd->c_stab) = retstr;
cmd->c_short->str_u.str_useful = match;
match = TRUE;
}
newsp = -2;
goto maybe;
+ case CFT_D1:
+ break;
+ case CFT_D0:
+ if (DBsingle->str_u.str_nval != 0)
+ break;
+ if (DBsignal->str_u.str_nval != 0)
+ break;
+ if (DBtrace->str_u.str_nval != 0)
+ break;
+ goto next_cmd;
}
/* we have tried to make this normal case as abnormal as possible */
lastretstr = Nullstr;
lastspbase = sp;
lastsize = newsp - sp;
+ if (lastsize < 0)
+ lastsize = 0;
}
else
lastretstr = retstr;
- while (tmps_max > tmps_base) /* clean up after last eval */
- str_free(tmps_list[tmps_max--]);
- newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
+ while (tmps_max > tmps_base) { /* clean up after last eval */
+ str_free(tmps_list[tmps_max]);
+ tmps_list[tmps_max--] = Nullstr;
+ }
+ newsp = eval(cmd->c_expr,
+ gimme && (cmdflags & CF_TERM) && cmd->c_type == C_EXPR &&
+ !cmd->ucmd.acmd.ac_expr,
+ sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
- if (newsp > sp)
+ if (newsp > sp && retstr)
match = str_true(retstr);
else
match = FALSE;
flipmaybe:
if (match && cmdflags & CF_FLIP) {
- while (tmps_max > tmps_base) /* clean up after last eval */
- str_free(tmps_list[tmps_max--]);
+ while (tmps_max > tmps_base) { /* clean up after last eval */
+ str_free(tmps_list[tmps_max]);
+ tmps_list[tmps_max--] = Nullstr;
+ }
if (cmd->c_expr->arg_type == O_FLOP) { /* currently toggled? */
newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
lastretstr = Nullstr;
lastspbase = sp;
lastsize = newsp - sp;
+ if (lastsize < 0)
+ lastsize = 0;
}
else
lastretstr = retstr;
- while (tmps_max > tmps_base) /* clean up after last eval */
- str_free(tmps_list[tmps_max--]);
+ while (tmps_max > tmps_base) { /* clean up after last eval */
+ str_free(tmps_list[tmps_max]);
+ tmps_list[tmps_max--] = Nullstr;
+ }
newsp = eval(cmd->ucmd.acmd.ac_expr,gimme && (cmdflags&CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
break;
case C_NSWITCH:
- match = (int)str_gnum(STAB_STR(cmd->c_stab));
+ {
+ double value = str_gnum(STAB_STR(cmd->c_stab));
+
+ match = (int)value;
+ if (value < 0.0) {
+ if (((double)match) > value)
+ --match; /* was fractional--truncate other way */
+ }
+ }
goto doswitch;
case C_CSWITCH:
match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
if (match < 0)
match = 0;
else if (match > cmd->ucmd.scmd.sc_max)
- match = cmd->c_slen;
+ match = cmd->ucmd.scmd.sc_max;
cmd = cmd->ucmd.scmd.sc_next[match];
goto tail_recursion_entry;
case C_NEXT:
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
}
#endif
}
- switch (setjmp(loop_stack[loop_ptr].loop_env)) {
- case O_LAST:
- /* retstr = lastretstr; */
+#ifdef JMPCLOBBER
+ cmdparm = cmd;
+#endif
+ match = setjmp(loop_stack[loop_ptr].loop_env);
+ if (match) {
st = stack->ary_array; /* possibly reallocated */
- if (lastretstr) {
- retstr = lastretstr;
- newsp = -2;
- }
- else {
- newsp = sp + lastsize;
- retstr = st[newsp];
- }
- curspat = oldspat;
+#ifdef JMPCLOBBER
+ cmd = cmdparm;
+ cmdflags = cmd->c_flags|CF_ONCE;
+ go_to = goto_targ;
+#endif
if (savestack->ary_fill > oldsave)
restorelist(oldsave);
- goto next_cmd;
- case O_NEXT:
- goto next_iter;
- case O_REDO:
+ switch (match) {
+ default:
+ fatal("longjmp returned bad value (%d)",match);
+ case O_LAST:
+ if (lastretstr) {
+ retstr = lastretstr;
+ newsp = -2;
+ }
+ else {
+ newsp = sp + lastsize;
+ retstr = st[newsp];
+ }
+ curspat = oldspat;
+ goto next_cmd;
+ case O_NEXT:
+#ifdef JMPCLOBBER
+ newsp = -2;
+ retstr = &str_undef;
+#endif
+ goto next_iter;
+ case O_REDO:
#ifdef DEBUGGING
- dlevel = olddlevel;
+ dlevel = olddlevel;
#endif
- goto doit;
+#ifdef JMPCLOBBER
+ newsp = -2;
+ retstr = &str_undef;
+#endif
+ goto doit;
+ }
}
oldspat = curspat;
oldsave = savestack->ary_fill;
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
grow_dlevel();
}
#endif
- newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme,sp);
+ newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
st = stack->ary_array; /* possibly reallocated */
retstr = st[newsp];
}
finish_while:
curspat = oldspat;
- if (savestack->ary_fill > oldsave)
+ if (savestack->ary_fill > oldsave) {
+ if (cmdflags & CF_TERM) {
+ for (match = sp + 1; match <= newsp; match++)
+ st[match] = str_mortal(st[match]);
+ retstr = st[newsp];
+ }
restorelist(oldsave);
+ }
#ifdef DEBUGGING
dlevel = olddlevel - 1;
#endif
}
#endif
loop_ptr--;
- if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY)
+ if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY &&
+ savestack->ary_fill > aryoptsave)
restorelist(aryoptsave);
}
cmd = cmd->c_next;
}
#ifdef DEBUGGING
-# ifndef VARARGS
+# ifndef I_VARARGS
/*VARARGS1*/
deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
char *pat;
{
register int i;
- fprintf(stderr,"%-4ld",(long)line);
+ fprintf(stderr,"%-4ld",(long)curcmd->c_line);
for (i=0; i<dlevel; i++)
fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
register int i;
va_start(args);
- fprintf(stderr,"%-4ld",(long)line);
+ fprintf(stderr,"%-4ld",(long)curcmd->c_line);
for (i=0; i<dlevel; i++)
fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
str->str_u.str_stab = stab;
if (str->str_ptr) {
Safefree(str->str_ptr);
+ str->str_ptr = Nullch;
str->str_len = 0;
}
str->str_ptr = (char*)stab_array(stab);
str->str_u.str_stab = stab;
if (str->str_ptr) {
Safefree(str->str_ptr);
+ str->str_ptr = Nullch;
str->str_len = 0;
}
str->str_ptr = (char*)stab_hash(stab);
}
void
+saveaptr(aptr)
+ARRAY **aptr;
+{
+ register STR *str;
+
+ str = Str_new(17,0);
+ str->str_state = SS_SAPTR;
+ str->str_u.str_array = *aptr; /* remember value */
+ if (str->str_ptr) {
+ Safefree(str->str_ptr);
+ str->str_len = 0;
+ }
+ str->str_ptr = (char*)aptr; /* remember pointer */
+ (void)apush(savestack,str);
+}
+
+void
savelist(sarg,maxsarg)
register STR **sarg;
int maxsarg;
str = Str_new(18,0);
str_sset(str,sarg[i]);
(void)apush(savestack,str); /* remember the value */
+ sarg[i]->str_u.str_useful = -1;
}
}
break;
case SS_SHASH: /* hash reference */
stab = value->str_u.str_stab;
- (void)hfree(stab_xhash(stab));
+ (void)hfree(stab_xhash(stab), FALSE);
stab_xhash(stab) = (HASH*)value->str_ptr;
value->str_ptr = Nullch;
str_free(value);
value->str_ptr = Nullch;
str_free(value);
break;
+ case SS_SAPTR: /* ARRAY* reference */
+ *((ARRAY**)value->str_ptr) = value->str_u.str_array;
+ value->str_ptr = Nullch;
+ str_free(value);
+ break;
case SS_SNSTAB:
stab = (STAB*)value->str_magic;
value->str_magic = Nullstr;
(void)stab_clear(stab);
str_free(value);
break;
+ case SS_SCSV: /* callsave structure */
+ {
+ CSV *csv = (CSV*) value->str_ptr;
+
+ curcmd = csv->curcmd;
+ curcsv = csv->curcsv;
+ csv->sub->depth = csv->depth;
+ if (csv->hasargs) { /* put back old @_ */
+ afree(csv->argarray);
+ stab_xarray(defstab) = csv->savearray;
+ }
+ str_free(value);
+ }
+ break;
default:
fatal("panic: restorelist inconsistency");
}
https://perl5.git.perl.org / perl5.git / blobdiff