-/* $Header: cmd.c,v 3.0.1.7 90/03/27 15:32:37 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.7 90/03/27 15:32:37 lwall
- * patch16: non-terminal blocks should never have arrays requested of them
+ * 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.6 90/03/12 16:21:09 lwall
- * patch13: fixed some backwards VOLATILE declarations
- * patch13: while (s/x//) {} still caused some anomolies
- * patch13: greater-than test of numeric switch structures did less-than action
- *
- * Revision 3.0.1.5 90/02/28 16:38:31 lwall
- * patch9: volatilized some more variables for super-optimizing compilers
- * patch9: nested foreach loops didn't reset inner loop on next to outer loop
- * patch9: returned values were read from obsolete stack
- * patch9: added sanity check on longjmp() return value
- * patch9: substitutions that almost always succeed can corrupt label stack
- * patch9: subs which return by both mechanisms can clobber local return data
- *
- * Revision 3.0.1.4 89/12/21 19:17:41 lwall
- * patch7: arranged for certain registers to be restored after longjmp()
- * patch7: made nested or recursive foreach work right
- *
- * Revision 3.0.1.3 89/11/17 15:04:36 lwall
- * patch5: nested foreach on same array didn't work
- *
- * 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.
*
*/
#ifdef JMPCLOBBER
cmdparm = cmd;
#endif
- if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
+ match = setjmp(loop_stack[loop_ptr].loop_env);
+ if (match) {
st = stack->ary_array; /* possibly reallocated */
#ifdef JMPCLOBBER
cmd = cmdparm;
/* 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;
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:
}
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 && retstr)
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;
#ifdef JMPCLOBBER
cmdparm = cmd;
#endif
- if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
+ match = setjmp(loop_stack[loop_ptr].loop_env);
+ if (match) {
st = stack->ary_array; /* possibly reallocated */
#ifdef JMPCLOBBER
cmd = cmdparm;
if (savestack->ary_fill > oldsave) {
if (cmdflags & CF_TERM) {
for (match = sp + 1; match <= newsp; match++)
- st[match] = str_static(st[match]);
+ st[match] = str_mortal(st[match]);
retstr = st[newsp];
}
restorelist(oldsave);
}
#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;
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