/* pp_ctl.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#define WORD_ALIGN sizeof(U16)
#endif
+#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
+
+static OP *docatch _((OP *o));
static OP *doeval _((int gimme));
-static OP *dofindlabel _((OP *op, char *label, OP **opstack));
+static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
static void doparseform _((SV *sv));
static I32 dopoptoeval _((I32 startingblock));
static I32 dopoptolabel _((char *label));
PP(pp_wantarray)
{
- dSP;
+ djSP;
I32 cxix;
EXTEND(SP, 1);
if (cxix < 0)
RETPUSHUNDEF;
- if (cxstack[cxix].blk_gimme == G_ARRAY)
+ switch (cxstack[cxix].blk_gimme) {
+ case G_ARRAY:
RETPUSHYES;
- else
+ case G_SCALAR:
RETPUSHNO;
+ default:
+ RETPUSHUNDEF;
+ }
}
PP(pp_regcmaybe)
}
PP(pp_regcomp) {
- dSP;
+ djSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
register char *t;
SV *tmpstr;
pm->op_pmflags |= PMf_WHITE;
if (pm->op_pmflags & PMf_KEEP) {
- pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */
+ pm->op_private &= ~OPpRUNTIME; /* no point compiling again */
hoistmust(pm);
cLOGOP->op_first->op_next = op->op_next;
}
PP(pp_substcont)
{
- dSP;
+ djSP;
register PMOP *pm = (PMOP*) cLOGOP->op_other;
register CONTEXT *cx = &cxstack[cxstack_ix];
register SV *dstr = cx->sb_dstr;
char *orig = cx->sb_orig;
register REGEXP *rx = cx->sb_rx;
+ rxres_restore(&cx->sb_rxres, rx);
+
if (cx->sb_iters++) {
if (cx->sb_iters > cx->sb_maxiters)
DIE("Substitution loop");
if (!cx->sb_rxtainted)
cx->sb_rxtainted = SvTAINTED(TOPs);
sv_catsv(dstr, POPs);
- if (rx->subbase)
- Safefree(rx->subbase);
- rx->subbase = cx->sb_subbase;
/* Are we done */
if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig,
SV *targ = cx->sb_targ;
sv_catpvn(dstr, s, cx->sb_strend - s);
+ TAINT_IF(cx->sb_rxtainted || rx->exec_tainted);
+
(void)SvOOK_off(targ);
Safefree(SvPVX(targ));
SvPVX(targ) = SvPVX(dstr);
SvLEN_set(targ, SvLEN(dstr));
SvPVX(dstr) = 0;
sv_free(dstr);
-
(void)SvPOK_only(targ);
SvSETMAGIC(targ);
- if (cx->sb_rxtainted)
- SvTAINTED_on(targ);
+ SvTAINT(targ);
+
PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
LEAVE_SCOPE(cx->sb_oldsave);
POPSUBST(cx);
cx->sb_m = m = rx->startp[0];
sv_catpvn(dstr, s, m-s);
cx->sb_s = rx->endp[0];
- cx->sb_subbase = rx->subbase;
cx->sb_rxtainted |= rx->exec_tainted;
-
- rx->subbase = Nullch; /* so recursion works */
+ rxres_save(&cx->sb_rxres, rx);
RETURNOP(pm->op_pmreplstart);
}
+void
+rxres_save(void **rsp, REGEXP *rx)
+{
+ UV *p = (UV*)*rsp;
+ U32 i;
+
+ if (!p || p[1] < rx->nparens) {
+ i = 6 + rx->nparens * 2;
+ if (!p)
+ New(501, p, i, UV);
+ else
+ Renew(p, i, UV);
+ *rsp = (void*)p;
+ }
+
+ *p++ = (UV)rx->subbase;
+ rx->subbase = Nullch;
+
+ *p++ = rx->nparens;
+
+ *p++ = (UV)rx->subbeg;
+ *p++ = (UV)rx->subend;
+ for (i = 0; i <= rx->nparens; ++i) {
+ *p++ = (UV)rx->startp[i];
+ *p++ = (UV)rx->endp[i];
+ }
+}
+
+void
+rxres_restore(void **rsp, REGEXP *rx)
+{
+ UV *p = (UV*)*rsp;
+ U32 i;
+
+ Safefree(rx->subbase);
+ rx->subbase = (char*)(*p);
+ *p++ = 0;
+
+ rx->nparens = *p++;
+
+ rx->subbeg = (char*)(*p++);
+ rx->subend = (char*)(*p++);
+ for (i = 0; i <= rx->nparens; ++i) {
+ rx->startp[i] = (char*)(*p++);
+ rx->endp[i] = (char*)(*p++);
+ }
+}
+
+void
+rxres_free(void **rsp)
+{
+ UV *p = (UV*)*rsp;
+
+ if (p) {
+ Safefree((char*)(*p));
+ Safefree(p);
+ *rsp = Null(void*);
+ }
+}
+
PP(pp_formline)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV *form = *++MARK;
register U16 *fpc;
register char *t;
PP(pp_grepstart)
{
- dSP;
+ djSP;
SV *src;
if (stack_base + *markstack_ptr == sp) {
(void)POPMARK;
- if (GIMME != G_ARRAY)
+ if (GIMME_V == G_SCALAR)
XPUSHs(&sv_no);
RETURNOP(op->op_next->op_next);
}
stack_sp = stack_base + *markstack_ptr + 1;
- pp_pushmark(); /* push dst */
- pp_pushmark(); /* push src */
+ pp_pushmark(ARGS); /* push dst */
+ pp_pushmark(ARGS); /* push src */
ENTER; /* enter outer scope */
SAVETMPS;
PUTBACK;
if (op->op_type == OP_MAPSTART)
- pp_pushmark(); /* push top */
+ pp_pushmark(ARGS); /* push top */
return ((LOGOP*)op->op_next)->op_other;
}
PP(pp_mapwhile)
{
- dSP;
+ djSP;
I32 diff = (sp - stack_base) - *markstack_ptr;
I32 count;
I32 shift;
/* All done yet? */
if (markstack_ptr[-1] > *markstack_ptr) {
I32 items;
+ I32 gimme = GIMME_V;
(void)POPMARK; /* pop top */
LEAVE; /* exit outer scope */
items = --*markstack_ptr - markstack_ptr[-1];
(void)POPMARK; /* pop dst */
SP = stack_base + POPMARK; /* pop original mark */
- if (GIMME != G_ARRAY) {
+ if (gimme == G_SCALAR) {
dTARGET;
XPUSHi(items);
- RETURN;
}
- SP += items;
+ else if (gimme == G_ARRAY)
+ SP += items;
RETURN;
}
else {
PP(pp_sort)
{
- dSP; dMARK; dORIGMARK;
+ djSP; dMARK; dORIGMARK;
register SV **up;
SV **myorigmark = ORIGMARK;
register I32 max;
sortcop = CvSTART(cv);
SAVESPTR(CvROOT(cv)->op_ppaddr);
CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL];
-
+
SAVESPTR(curpad);
curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
}
while (MARK < SP) { /* This may or may not shift down one here. */
/*SUPPRESS 560*/
if (*up = *++MARK) { /* Weed out nulls. */
- if (!SvPOK(*up))
+ SvTEMP_off(*up);
+ if (!sortcop && !SvPOK(*up))
(void)sv_2pv(*up, &na);
- else
- SvTEMP_off(*up);
up++;
}
}
AV *oldstack;
CONTEXT *cx;
SV** newsp;
+ bool oldcatch = CATCH_GET;
SAVETMPS;
- SAVESPTR(op);
+ SAVEOP();
oldstack = curstack;
if (!sortstack) {
AvREAL_off(sortstack);
av_extend(sortstack, 32);
}
+ CATCH_SET(TRUE);
SWITCHSTACK(curstack, sortstack);
if (sortstash != stash) {
firstgv = gv_fetchpv("a", TRUE, SVt_PV);
SAVESPTR(GvSV(firstgv));
SAVESPTR(GvSV(secondgv));
- PUSHBLOCK(cx, CXt_LOOP, stack_base);
+
+ PUSHBLOCK(cx, CXt_NULL, stack_base);
+ if (!(op->op_flags & OPf_SPECIAL)) {
+ bool hasargs = FALSE;
+ cx->cx_type = CXt_SUB;
+ cx->blk_gimme = G_SCALAR;
+ PUSHSUB(cx);
+ if (!CvDEPTH(cv))
+ (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
+ }
sortcxix = cxstack_ix;
qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv);
POPBLOCK(cx,curpm);
SWITCHSTACK(sortstack, oldstack);
+ CATCH_SET(oldcatch);
}
LEAVE;
}
PP(pp_flip)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
if (op->op_flags & OPf_SPECIAL) {
sv_setiv(targ, 1);
+ SETs(targ);
RETURN;
}
else {
PP(pp_flop)
{
- dSP;
+ djSP;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
/* Control. */
static I32
-dopoptolabel(label)
-char *label;
+dopoptolabel(char *label)
{
+ dTHR;
register I32 i;
register CONTEXT *cx;
if (dowarn)
warn("Exiting eval via %s", op_name[op->op_type]);
break;
+ case CXt_NULL:
+ if (dowarn)
+ warn("Exiting pseudo-block via %s", op_name[op->op_type]);
+ return -1;
case CXt_LOOP:
if (!cx->blk_loop.label ||
strNE(label, cx->blk_loop.label) ) {
- DEBUG_l(deb("(Skipping label #%d %s)\n",
- i, cx->blk_loop.label));
+ DEBUG_l(deb("(Skipping label #%ld %s)\n",
+ (long)i, cx->blk_loop.label));
continue;
}
- DEBUG_l( deb("(Found label #%d %s)\n", i, label));
+ DEBUG_l( deb("(Found label #%ld %s)\n", (long)i, label));
return i;
}
}
}
I32
-dowantarray()
+dowantarray(void)
+{
+ I32 gimme = block_gimme();
+ return (gimme == G_VOID) ? G_SCALAR : gimme;
+}
+
+I32
+block_gimme(void)
{
+ dTHR;
I32 cxix;
cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
- return G_SCALAR;
+ return G_VOID;
- if (cxstack[cxix].blk_gimme == G_ARRAY)
- return G_ARRAY;
- else
+ switch (cxstack[cxix].blk_gimme) {
+ case G_SCALAR:
return G_SCALAR;
+ case G_ARRAY:
+ return G_ARRAY;
+ default:
+ croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
+ case G_VOID:
+ return G_VOID;
+ }
}
static I32
-dopoptosub(startingblock)
-I32 startingblock;
+dopoptosub(I32 startingblock)
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
continue;
case CXt_EVAL:
case CXt_SUB:
- DEBUG_l( deb("(Found sub #%d)\n", i));
+ DEBUG_l( deb("(Found sub #%ld)\n", (long)i));
return i;
}
}
}
static I32
-dopoptoeval(startingblock)
-I32 startingblock;
+dopoptoeval(I32 startingblock)
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
default:
continue;
case CXt_EVAL:
- DEBUG_l( deb("(Found eval #%d)\n", i));
+ DEBUG_l( deb("(Found eval #%ld)\n", (long)i));
return i;
}
}
}
static I32
-dopoptoloop(startingblock)
-I32 startingblock;
+dopoptoloop(I32 startingblock)
{
+ dTHR;
I32 i;
register CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
if (dowarn)
warn("Exiting eval via %s", op_name[op->op_type]);
break;
+ case CXt_NULL:
+ if (dowarn)
+ warn("Exiting pseudo-block via %s", op_name[op->op_type]);
+ return -1;
case CXt_LOOP:
- DEBUG_l( deb("(Found loop #%d)\n", i));
+ DEBUG_l( deb("(Found loop #%ld)\n", (long)i));
return i;
}
}
}
void
-dounwind(cxix)
-I32 cxix;
+dounwind(I32 cxix)
{
+ dTHR;
register CONTEXT *cx;
SV **newsp;
I32 optype;
while (cxstack_ix > cxix) {
- cx = &cxstack[cxstack_ix--];
- DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
- block_type[cx->cx_type]));
+ cx = &cxstack[cxstack_ix];
+ DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
+ (long) cxstack_ix+1, block_type[cx->cx_type]));
/* Note: we don't need to restore the base context info till the end. */
switch (cx->cx_type) {
+ case CXt_SUBST:
+ POPSUBST(cx);
+ continue; /* not break */
case CXt_SUB:
POPSUB(cx);
break;
case CXt_LOOP:
POPLOOP(cx);
break;
- case CXt_SUBST:
+ case CXt_NULL:
break;
}
+ cxstack_ix--;
}
}
OP *
-die_where(message)
-char *message;
+die_where(char *message)
{
+ dTHR;
if (in_eval) {
I32 cxix;
register CONTEXT *cx;
SV **svp;
STRLEN klen = strlen(message);
- svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+ svp = hv_fetch(errhv, message, klen, TRUE);
if (svp) {
if (!SvIOK(*svp)) {
static char prefix[] = "\t(in cleanup) ";
sv_upgrade(*svp, SVt_IV);
(void)SvIOK_only(*svp);
- SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
- sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
- sv_catpvn(GvSV(errgv), message, klen);
+ SvGROW(errsv, SvCUR(errsv)+sizeof(prefix)+klen);
+ sv_catpvn(errsv, prefix, sizeof(prefix)-1);
+ sv_catpvn(errsv, message, klen);
}
sv_inc(*svp);
}
}
else
- sv_setpv(GvSV(errgv), message);
+ sv_setpv(errsv, message);
cxix = dopoptoeval(cxstack_ix);
if (cxix >= 0) {
LEAVE;
- if (optype == OP_REQUIRE)
- DIE("%s", SvPVx(GvSV(errgv), na));
+ if (optype == OP_REQUIRE) {
+ char* msg = SvPV(errsv, na);
+ DIE("%s", *msg ? msg : "Compilation failed in require");
+ }
return pop_return();
}
}
PerlIO_printf(PerlIO_stderr(), "%s",message);
PerlIO_flush(PerlIO_stderr());
- if (e_tmpname) {
- if (e_fp) {
- PerlIO_close(e_fp);
- e_fp = Nullfp;
- }
- (void)UNLINK(e_tmpname);
- Safefree(e_tmpname);
- e_tmpname = Nullch;
- }
- statusvalue = SHIFTSTATUS(statusvalue);
-#ifdef VMS
- my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
-#else
- my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
-#endif
+ my_failure_exit();
+ /* NOTREACHED */
return 0;
}
PP(pp_xor)
{
- dSP; dPOPTOPssrl;
+ djSP; dPOPTOPssrl;
if (SvTRUE(left) != SvTRUE(right))
RETSETYES;
else
PP(pp_andassign)
{
- dSP;
+ djSP;
if (!SvTRUE(TOPs))
RETURN;
else
PP(pp_orassign)
{
- dSP;
+ djSP;
if (SvTRUE(TOPs))
RETURN;
else
RETURNOP(cLOGOP->op_other);
}
-#ifdef DEPRECATED
-PP(pp_entersubr)
-{
- dSP;
- SV** mark = (stack_base + *markstack_ptr + 1);
- SV* cv = *mark;
- while (mark < sp) { /* emulate old interface */
- *mark = mark[1];
- mark++;
- }
- *sp = cv;
- return pp_entersub();
-}
-#endif
-
PP(pp_caller)
{
- dSP;
+ djSP;
register I32 cxix = dopoptosub(cxstack_ix);
register CONTEXT *cx;
I32 dbcxix;
+ I32 gimme;
SV *sv;
I32 count = 0;
PUSHs(sv_2mortal(newSVpv("(eval)",0)));
PUSHs(sv_2mortal(newSViv(0)));
}
- PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme)));
+ gimme = (I32)cx->blk_gimme;
+ if (gimme == G_VOID)
+ PUSHs(&sv_undef);
+ else
+ PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
if (cx->cx_type == CXt_EVAL) {
if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
PUSHs(cx->blk_eval.cur_text);
}
static int
-sortcv(a, b)
-const void *a;
-const void *b;
+sortcv(const void *a, const void *b)
{
- SV **str1 = (SV **) a;
- SV **str2 = (SV **) b;
+ dTHR;
+ SV * const *str1 = (SV * const *)a;
+ SV * const *str2 = (SV * const *)b;
I32 oldsaveix = savestack_ix;
I32 oldscopeix = scopestack_ix;
I32 result;
}
static int
-sortcmp(a, b)
-const void *a;
-const void *b;
+sortcmp(const void *a, const void *b)
{
- return sv_cmp(*(SV **)a, *(SV **)b);
+ return sv_cmp(*(SV * const *)a, *(SV * const *)b);
}
static int
-sortcmp_locale(a, b)
-const void *a;
-const void *b;
+sortcmp_locale(const void *a, const void *b)
{
- return sv_cmp_locale(*(SV **)a, *(SV **)b);
+ return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b);
}
PP(pp_reset)
{
- dSP;
+ djSP;
char *tmps;
if (MAXARG < 1)
PP(pp_enteriter)
{
- dSP; dMARK;
+ djSP; dMARK;
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
SV **svp;
ENTER;
PP(pp_enterloop)
{
- dSP;
+ djSP;
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
PP(pp_leaveloop)
{
- dSP;
+ djSP;
register CONTEXT *cx;
+ struct block_loop cxloop;
I32 gimme;
SV **newsp;
PMOP *newpm;
POPBLOCK(cx,newpm);
mark = newsp;
- POPLOOP(cx);
- if (gimme == G_SCALAR) {
- if (op->op_private & OPpLEAVE_VOID)
- ;
- else {
- if (mark < SP)
- *++newsp = sv_mortalcopy(*SP);
- else
- *++newsp = &sv_undef;
- }
+ POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */
+
+ TAINT_NOT;
+ if (gimme == G_VOID)
+ ; /* do nothing */
+ else if (gimme == G_SCALAR) {
+ if (mark < SP)
+ *++newsp = sv_mortalcopy(*SP);
+ else
+ *++newsp = &sv_undef;
}
else {
- while (mark < SP)
+ while (mark < SP) {
*++newsp = sv_mortalcopy(*++mark);
+ TAINT_NOT; /* Each item is independent */
+ }
}
- curpm = newpm; /* Don't pop $1 et al till now */
- sp = newsp;
+ SP = newsp;
+ PUTBACK;
+
+ POPLOOP2(); /* Stack values are safe: release loop vars ... */
+ curpm = newpm; /* ... and pop $1 et al */
+
LEAVE;
LEAVE;
- RETURN;
+ return NORMAL;
}
PP(pp_return)
{
- dSP; dMARK;
+ djSP; dMARK;
I32 cxix;
register CONTEXT *cx;
+ struct block_sub cxsub;
+ bool popsub2 = FALSE;
I32 gimme;
SV **newsp;
PMOP *newpm;
I32 optype = 0;
if (curstack == sortstack) {
- if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
+ if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) {
if (cxstack_ix > sortcxix)
dounwind(sortcxix);
AvARRAY(curstack)[1] = *SP;
POPBLOCK(cx,newpm);
switch (cx->cx_type) {
case CXt_SUB:
- POPSUB(cx);
+ POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */
+ popsub2 = TRUE;
break;
case CXt_EVAL:
POPEVAL(cx);
if (optype == OP_REQUIRE &&
(MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
{
+ /* Unassume the success we assumed earlier. */
char *name = cx->blk_eval.old_name;
(void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
DIE("%s did not return a true value", name);
break;
default:
DIE("panic: return");
- break;
}
+ TAINT_NOT;
if (gimme == G_SCALAR) {
if (MARK < SP)
- *++newsp = sv_mortalcopy(*SP);
+ *++newsp = (popsub2 && SvTEMP(*SP))
+ ? *SP : sv_mortalcopy(*SP);
else
*++newsp = &sv_undef;
}
- else {
- while (MARK < SP)
- *++newsp = sv_mortalcopy(*++MARK);
+ else if (gimme == G_ARRAY) {
+ while (++MARK <= SP) {
+ *++newsp = (popsub2 && SvTEMP(*MARK))
+ ? *MARK : sv_mortalcopy(*MARK);
+ TAINT_NOT; /* Each item is independent */
+ }
}
- curpm = newpm; /* Don't pop $1 et al till now */
stack_sp = newsp;
+ /* Stack values are safe: */
+ if (popsub2) {
+ POPSUB2(); /* release CV and @_ ... */
+ }
+ curpm = newpm; /* ... and pop $1 et al */
+
LEAVE;
return pop_return();
}
PP(pp_last)
{
- dSP;
+ djSP;
I32 cxix;
register CONTEXT *cx;
+ struct block_loop cxloop;
+ struct block_sub cxsub;
+ I32 pop2 = 0;
I32 gimme;
I32 optype;
OP *nextop;
POPBLOCK(cx,newpm);
switch (cx->cx_type) {
case CXt_LOOP:
- POPLOOP(cx);
- nextop = cx->blk_loop.last_op->op_next;
- LEAVE;
+ POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */
+ pop2 = CXt_LOOP;
+ nextop = cxloop.last_op->op_next;
break;
- case CXt_EVAL:
- POPEVAL(cx);
+ case CXt_SUB:
+ POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */
+ pop2 = CXt_SUB;
nextop = pop_return();
break;
- case CXt_SUB:
- POPSUB(cx);
+ case CXt_EVAL:
+ POPEVAL(cx);
nextop = pop_return();
break;
default:
DIE("panic: last");
- break;
}
+ TAINT_NOT;
if (gimme == G_SCALAR) {
- if (mark < SP)
- *++newsp = sv_mortalcopy(*SP);
+ if (MARK < SP)
+ *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*SP))
+ ? *SP : sv_mortalcopy(*SP);
else
*++newsp = &sv_undef;
}
- else {
- while (mark < SP)
- *++newsp = sv_mortalcopy(*++mark);
+ else if (gimme == G_ARRAY) {
+ while (++MARK <= SP) {
+ *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK))
+ ? *MARK : sv_mortalcopy(*MARK);
+ TAINT_NOT; /* Each item is independent */
+ }
}
- curpm = newpm; /* Don't pop $1 et al till now */
- sp = newsp;
+ SP = newsp;
+ PUTBACK;
+
+ /* Stack values are safe: */
+ switch (pop2) {
+ case CXt_LOOP:
+ POPLOOP2(); /* release loop vars ... */
+ LEAVE;
+ break;
+ case CXt_SUB:
+ POPSUB2(); /* release CV and @_ ... */
+ break;
+ }
+ curpm = newpm; /* ... and pop $1 et al */
LEAVE;
- RETURNOP(nextop);
+ return nextop;
}
PP(pp_next)
static OP* lastgotoprobe;
static OP *
-dofindlabel(op,label,opstack)
-OP *op;
-char *label;
-OP **opstack;
+dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit)
{
OP *kid;
OP **ops = opstack;
-
- if (op->op_type == OP_LEAVE ||
- op->op_type == OP_SCOPE ||
- op->op_type == OP_LEAVELOOP ||
- op->op_type == OP_LEAVETRY)
- *ops++ = cUNOP->op_first;
+ static char too_deep[] = "Target of goto is too deeply nested";
+
+ if (ops >= oplimit)
+ croak(too_deep);
+ if (o->op_type == OP_LEAVE ||
+ o->op_type == OP_SCOPE ||
+ o->op_type == OP_LEAVELOOP ||
+ o->op_type == OP_LEAVETRY)
+ {
+ *ops++ = cUNOPo->op_first;
+ if (ops >= oplimit)
+ croak(too_deep);
+ }
*ops = 0;
- if (op->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS) {
/* First try all the kids at this level, since that's likeliest. */
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
kCOP->cop_label && strEQ(kCOP->cop_label, label))
return kid;
}
- for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (kid == lastgotoprobe)
continue;
- if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
- if (ops > opstack &&
- (ops[-1]->op_type == OP_NEXTSTATE ||
- ops[-1]->op_type == OP_DBSTATE))
- *ops = kid;
- else
- *ops++ = kid;
- }
- if (op = dofindlabel(kid,label,ops))
- return op;
+ if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
+ (ops == opstack ||
+ (ops[-1]->op_type != OP_NEXTSTATE &&
+ ops[-1]->op_type != OP_DBSTATE)))
+ *ops++ = kid;
+ if (o = dofindlabel(kid, label, ops, oplimit))
+ return o;
}
}
*ops = 0;
PP(pp_goto)
{
- dSP;
+ djSP;
OP *retop = 0;
I32 ix;
register CONTEXT *cx;
- OP *enterops[64];
+#define GOTO_DEPTH 64
+ OP *enterops[GOTO_DEPTH];
char *label;
int do_dump = (op->op_type == OP_DUMP);
EXTEND(stack_sp, items); /* @_ could have been extended. */
Copy(AvARRAY(av), stack_sp, items, SV*);
stack_sp += items;
+#ifndef USE_THREADS
SvREFCNT_dec(GvAV(defgv));
GvAV(defgv) = cx->blk_sub.savearray;
+#endif /* USE_THREADS */
AvREAL_off(av);
av_clear(av);
}
svp = AvARRAY(padlist);
}
}
+#ifdef USE_THREADS
+ if (!cx->blk_sub.hasargs) {
+ AV* av = (AV*)curpad[0];
+
+ items = AvFILL(av) + 1;
+ if (items) {
+ /* Mark is at the end of the stack. */
+ EXTEND(sp, items);
+ Copy(AvARRAY(av), sp + 1, items, SV*);
+ sp += items;
+ PUTBACK ;
+ }
+ }
+#endif /* USE_THREADS */
SAVESPTR(curpad);
curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
- if (cx->blk_sub.hasargs) {
+#ifndef USE_THREADS
+ if (cx->blk_sub.hasargs)
+#endif /* USE_THREADS */
+ {
AV* av = (AV*)curpad[0];
SV** ary;
+#ifndef USE_THREADS
cx->blk_sub.savearray = GvAV(defgv);
- cx->blk_sub.argarray = av;
GvAV(defgv) = (AV*)SvREFCNT_inc(av);
+#endif /* USE_THREADS */
+ cx->blk_sub.argarray = av;
++mark;
if (items >= AvMAX(av) + 1) {
mark++;
}
}
- if (perldb && curstash != debstash) {
+ if (PERLDB_SUB && curstash != debstash) {
/*
* We do not care about using sv to call CV;
* it's for informational purposes only.
for (ix = cxstack_ix; ix >= 0; ix--) {
cx = &cxstack[ix];
switch (cx->cx_type) {
- case CXt_SUB:
- gotoprobe = CvROOT(cx->blk_sub.cv);
- break;
case CXt_EVAL:
gotoprobe = eval_root; /* XXX not good for nested eval */
break;
else
gotoprobe = main_root;
break;
+ case CXt_SUB:
+ if (CvDEPTH(cx->blk_sub.cv)) {
+ gotoprobe = CvROOT(cx->blk_sub.cv);
+ break;
+ }
+ /* FALL THROUGH */
+ case CXt_NULL:
+ DIE("Can't \"goto\" outside a block");
default:
if (ix)
DIE("panic: goto");
- else
- gotoprobe = main_root;
+ gotoprobe = main_root;
break;
}
- retop = dofindlabel(gotoprobe, label, enterops);
+ retop = dofindlabel(gotoprobe, label,
+ enterops, enterops + GOTO_DEPTH);
if (retop)
break;
lastgotoprobe = gotoprobe;
OP *oldop = op;
for (ix = 1; enterops[ix]; ix++) {
op = enterops[ix];
- (*op->op_ppaddr)();
+ /* Eventually we may want to stack the needed arguments
+ * for each op. For now, we punt on the hard ones. */
+ if (op->op_type == OP_ENTERITER)
+ DIE("Can't \"goto\" into the middle of a foreach loop",
+ label);
+ (*op->op_ppaddr)(ARGS);
}
op = oldop;
}
if (curstack == signalstack) {
restartop = retop;
- Siglongjmp(top_env, 3);
+ JMPENV_JUMP(3);
}
RETURNOP(retop);
PP(pp_exit)
{
- dSP;
+ djSP;
I32 anum;
if (MAXARG < 1)
anum = 0;
- else
+ else {
anum = SvIVx(POPs);
+#ifdef VMSISH_EXIT
+ if (anum == 1 && VMSISH_EXIT)
+ anum = 0;
+#endif
+ }
my_exit(anum);
PUSHs(&sv_undef);
RETURN;
#ifdef NOTYET
PP(pp_nswitch)
{
- dSP;
+ djSP;
double value = SvNVx(GvSV(cCOP->cop_gv));
register I32 match = I_32(value);
PP(pp_cswitch)
{
- dSP;
+ djSP;
register I32 match;
if (multiline)
/* Eval. */
static void
-save_lines(array, sv)
-AV *array;
-SV *sv;
+save_lines(AV *array, SV *sv)
{
register char *s = SvPVX(sv);
register char *send = SvPVX(sv) + SvCUR(sv);
}
static OP *
-doeval(gimme)
-int gimme;
+docatch(OP *o)
+{
+ dTHR;
+ int ret;
+ I32 oldrunlevel = runlevel;
+ OP *oldop = op;
+ dJMPENV;
+
+ op = o;
+#ifdef DEBUGGING
+ assert(CATCH_GET == TRUE);
+ DEBUG_l(deb("(Setting up local jumplevel, runlevel = %ld)\n", (long)runlevel+1));
+#endif
+ JMPENV_PUSH(ret);
+ switch (ret) {
+ default: /* topmost level handles it */
+ JMPENV_POP;
+ runlevel = oldrunlevel;
+ op = oldop;
+ JMPENV_JUMP(ret);
+ /* NOTREACHED */
+ case 3:
+ if (!restartop) {
+ PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
+ break;
+ }
+ op = restartop;
+ restartop = 0;
+ /* FALL THROUGH */
+ case 0:
+ runops();
+ break;
+ }
+ JMPENV_POP;
+ runlevel = oldrunlevel;
+ op = oldop;
+ return Nullop;
+}
+
+/* With USE_THREADS, eval_owner must be held on entry to doeval */
+static OP *
+doeval(int gimme)
{
dSP;
OP *saveop = op;
compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)compcv, SVt_PVCV);
CvUNIQUE_on(compcv);
+#ifdef USE_THREADS
+ CvOWNER(compcv) = 0;
+ New(666, CvMUTEXP(compcv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(compcv));
+#endif /* USE_THREADS */
comppad = newAV();
+ av_push(comppad, Nullsv);
+ curpad = AvARRAY(comppad);
comppad_name = newAV();
comppad_name_fill = 0;
min_intro_pending = 0;
- av_push(comppad, Nullsv);
- curpad = AvARRAY(comppad);
padix = 0;
+#ifdef USE_THREADS
+ av_store(comppad_name, 0, newSVpv("@_", 2));
+ curpad[0] = (SV*)newAV();
+ SvPADMY_on(curpad[0]); /* XXX Needed? */
+#endif /* USE_THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
if (saveop->op_flags & OPf_SPECIAL)
in_eval |= 4;
else
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(errsv,"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
pop_return();
lex_end();
LEAVE;
- if (optype == OP_REQUIRE)
- DIE("%s", SvPVx(GvSV(errgv), na));
+ if (optype == OP_REQUIRE) {
+ char* msg = SvPV(errsv, na);
+ DIE("%s", *msg ? msg : "Compilation failed in require");
+ }
SvREFCNT_dec(rs);
rs = SvREFCNT_inc(nrs);
+#ifdef USE_THREADS
+ MUTEX_LOCK(&eval_mutex);
+ eval_owner = 0;
+ COND_SIGNAL(&eval_cond);
+ MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
RETPUSHUNDEF;
}
SvREFCNT_dec(rs);
rs = SvREFCNT_inc(nrs);
compiling.cop_line = 0;
SAVEFREEOP(eval_root);
- if (gimme & G_ARRAY)
+ if (gimme & G_VOID)
+ scalarvoid(eval_root);
+ else if (gimme & G_ARRAY)
list(eval_root);
else
scalar(eval_root);
DEBUG_x(dump_eval());
/* Register with debugger: */
-
- if (perldb && saveop->op_type == OP_REQUIRE) {
+ if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) {
CV *cv = perl_get_cv("DB::postponed", FALSE);
-
if (cv) {
dSP;
PUSHMARK(sp);
/* compiled okay, so do it */
+ CvDEPTH(compcv) = 1;
SP = stack_base + POPMARK; /* pop original mark */
+ op = saveop; /* The caller may need it. */
+#ifdef USE_THREADS
+ MUTEX_LOCK(&eval_mutex);
+ eval_owner = 0;
+ COND_SIGNAL(&eval_cond);
+ MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
+
RETURNOP(eval_start);
}
PP(pp_require)
{
- dSP;
+ djSP;
register CONTEXT *cx;
SV *sv;
char *name;
- char *tmpname;
+ char *tryname;
+ SV *namesv = Nullsv;
SV** svp;
I32 gimme = G_SCALAR;
PerlIO *tryrsfp = 0;
/* prepare to compile file */
- tmpname = savepv(name);
- if (*tmpname == '/' ||
- (*tmpname == '.' &&
- (tmpname[1] == '/' ||
- (tmpname[1] == '.' && tmpname[2] == '/')))
+ if (*name == '/' ||
+ (*name == '.' &&
+ (name[1] == '/' ||
+ (name[1] == '.' && name[2] == '/')))
#ifdef DOSISH
- || (tmpname[0] && tmpname[1] == ':')
+ || (name[0] && name[1] == ':')
+#endif
+#ifdef WIN32
+ || (name[0] == '\\' && name[1] == '\\') /* UNC path */
#endif
#ifdef VMS
- || (strchr(tmpname,':') || ((*tmpname == '[' || *tmpname == '<') &&
- (isALNUM(tmpname[1]) || strchr("$-_]>",tmpname[1]))))
+ || (strchr(name,':') || ((*name == '[' || *name == '<') &&
+ (isALNUM(name[1]) || strchr("$-_]>",name[1]))))
#endif
)
{
- tryrsfp = PerlIO_open(tmpname,"r");
+ tryname = name;
+ tryrsfp = PerlIO_open(name,"r");
}
else {
AV *ar = GvAVn(incgv);
I32 i;
#ifdef VMS
- char unixified[256];
- if (tounixspec_ts(tmpname,unixified) != NULL)
- for (i = 0; i <= AvFILL(ar); i++) {
- if (tounixpath_ts(SvPVx(*av_fetch(ar, i, TRUE), na),buf) == NULL)
- continue;
- strcat(buf,unixified);
+ char *unixname;
+ if ((unixname = tounixspec(name, Nullch)) != Nullch)
+#endif
+ {
+ namesv = NEWSV(806, 0);
+ for (i = 0; i <= AvFILL(ar); i++) {
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), na);
+#ifdef VMS
+ char *unixdir;
+ if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
+ continue;
+ sv_setpv(namesv, unixdir);
+ sv_catpv(namesv, unixname);
#else
- for (i = 0; i <= AvFILL(ar); i++) {
- (void)sprintf(buf, "%s/%s",
- SvPVx(*av_fetch(ar, i, TRUE), na), name);
+ sv_setpvf(namesv, "%s/%s", dir, name);
#endif
- tryrsfp = PerlIO_open(buf, "r");
- if (tryrsfp) {
- char *s = buf;
-
- if (*s == '.' && s[1] == '/')
- s += 2;
- Safefree(tmpname);
- tmpname = savepv(s);
- break;
+ tryname = SvPVX(namesv);
+ tryrsfp = PerlIO_open(tryname, "r");
+ if (tryrsfp) {
+ if (tryname[0] == '.' && tryname[1] == '/')
+ tryname += 2;
+ break;
+ }
}
}
}
SAVESPTR(compiling.cop_filegv);
- compiling.cop_filegv = gv_fetchfile(tmpname);
- Safefree(tmpname);
- tmpname = Nullch;
+ compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name);
+ SvREFCNT_dec(namesv);
if (!tryrsfp) {
if (op->op_type == OP_REQUIRE) {
- sprintf(tokenbuf,"Can't locate %s in @INC", name);
- if (instr(tokenbuf,".h "))
- strcat(tokenbuf," (change .h to .ph maybe?)");
- if (instr(tokenbuf,".ph "))
- strcat(tokenbuf," (did you run h2ph?)");
- DIE("%s",tokenbuf);
+ SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name));
+ SV *dirmsgsv = NEWSV(0, 0);
+ AV *ar = GvAVn(incgv);
+ I32 i;
+ if (instr(SvPVX(msg), ".h "))
+ sv_catpv(msg, " (change .h to .ph maybe?)");
+ if (instr(SvPVX(msg), ".ph "))
+ sv_catpv(msg, " (did you run h2ph?)");
+ sv_catpv(msg, " (@INC contains:");
+ for (i = 0; i <= AvFILL(ar); i++) {
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), na);
+ sv_setpvf(dirmsgsv, " %s", dir);
+ sv_catsv(msg, dirmsgsv);
+ }
+ sv_catpvn(msg, ")", 1);
+ SvREFCNT_dec(dirmsgsv);
+ DIE("%_", msg);
}
RETPUSHUNDEF;
compiling.cop_line = 0;
PUTBACK;
- return doeval(G_SCALAR);
+#ifdef USE_THREADS
+ MUTEX_LOCK(&eval_mutex);
+ if (eval_owner && eval_owner != thr)
+ while (eval_owner)
+ COND_WAIT(&eval_cond, &eval_mutex);
+ eval_owner = thr;
+ MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
+ return DOCATCH(doeval(G_SCALAR));
}
PP(pp_dofile)
PP(pp_entereval)
{
- dSP;
+ djSP;
register CONTEXT *cx;
dPOPss;
- I32 gimme = GIMME, was = sub_generation;
- char tmpbuf[32], *safestr;
+ I32 gimme = GIMME_V, was = sub_generation;
+ char tmpbuf[TYPE_DIGITS(long) + 12];
+ char *safestr;
STRLEN len;
OP *ret;
/* switch to eval mode */
SAVESPTR(compiling.cop_filegv);
- sprintf(tmpbuf, "_<(eval %d)", ++evalseq);
+ sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++evalseq);
compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
compiling.cop_line = 1;
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
/* prepare to compile string */
- if (perldb && curstash != debstash)
+ if (PERLDB_LINE && curstash != debstash)
save_lines(GvAV(compiling.cop_filegv), linestr);
PUTBACK;
+#ifdef USE_THREADS
+ MUTEX_LOCK(&eval_mutex);
+ if (eval_owner && eval_owner != thr)
+ while (eval_owner)
+ COND_WAIT(&eval_cond, &eval_mutex);
+ eval_owner = thr;
+ MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
ret = doeval(gimme);
- if (perldb && was != sub_generation) { /* Some subs defined here. */
+ if (PERLDB_INTER && was != sub_generation /* Some subs defined here. */
+ && ret != op->op_next) { /* Successive compilation. */
strcpy(safestr, "_<(eval )"); /* Anything fake and short. */
}
- return ret;
+ return DOCATCH(ret);
}
PP(pp_leaveeval)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
POPEVAL(cx);
retop = pop_return();
- if (gimme == G_SCALAR) {
- if (op->op_private & OPpLEAVE_VOID)
- MARK = newsp;
+ TAINT_NOT;
+ if (gimme == G_VOID)
+ MARK = newsp;
+ else if (gimme == G_SCALAR) {
+ MARK = newsp + 1;
+ if (MARK <= SP) {
+ if (SvFLAGS(TOPs) & SVs_TEMP)
+ *MARK = TOPs;
+ else
+ *MARK = sv_mortalcopy(TOPs);
+ }
else {
- MARK = newsp + 1;
- if (MARK <= SP) {
- if (SvFLAGS(TOPs) & SVs_TEMP)
- *MARK = TOPs;
- else
- *MARK = sv_mortalcopy(TOPs);
- }
- else {
- MEXTEND(mark,0);
- *MARK = &sv_undef;
- }
+ MEXTEND(mark,0);
+ *MARK = &sv_undef;
}
- SP = MARK;
}
else {
- for (mark = newsp + 1; mark <= SP; mark++)
- if (!(SvFLAGS(*mark) & SVs_TEMP))
+ /* in case LEAVE wipes old return values */
+ for (mark = newsp + 1; mark <= SP; mark++) {
+ if (!(SvFLAGS(*mark) & SVs_TEMP)) {
*mark = sv_mortalcopy(*mark);
- /* in case LEAVE wipes old return values */
+ TAINT_NOT; /* Each item is independent */
+ }
+ }
}
curpm = newpm; /* Don't pop $1 et al till now */
- if (optype == OP_REQUIRE &&
- !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
- char *name = cx->blk_eval.old_name;
+ /*
+ * Closures mentioned at top level of eval cannot be referenced
+ * again, and their presence indirectly causes a memory leak.
+ * (Note that the fact that compcv and friends are still set here
+ * is, AFAIK, an accident.) --Chip
+ */
+ if (AvFILL(comppad_name) >= 0) {
+ SV **svp = AvARRAY(comppad_name);
+ I32 ix;
+ for (ix = AvFILL(comppad_name); ix >= 0; ix--) {
+ SV *sv = svp[ix];
+ if (sv && sv != &sv_undef && *SvPVX(sv) == '&') {
+ SvREFCNT_dec(sv);
+ svp[ix] = &sv_undef;
+
+ sv = curpad[ix];
+ if (CvCLONE(sv)) {
+ SvREFCNT_dec(CvOUTSIDE(sv));
+ CvOUTSIDE(sv) = Nullcv;
+ }
+ else {
+ SvREFCNT_dec(sv);
+ sv = NEWSV(0,0);
+ SvPADTMP_on(sv);
+ curpad[ix] = sv;
+ }
+ }
+ }
+ }
+#ifdef DEBUGGING
+ assert(CvDEPTH(compcv) == 1);
+#endif
+ CvDEPTH(compcv) = 0;
+
+ if (optype == OP_REQUIRE &&
+ !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp))
+ {
/* Unassume the success we assumed earlier. */
+ char *name = cx->blk_eval.old_name;
(void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
retop = die("%s did not return a true value", name);
}
lex_end();
LEAVE;
+
if (!(save_flags & OPf_SPECIAL))
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(errsv,"");
RETURNOP(retop);
}
PP(pp_entertry)
{
- dSP;
+ djSP;
register CONTEXT *cx;
- I32 gimme = GIMME;
+ I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
- sv_setpv(GvSV(errgv),"");
- RETURN;
+ sv_setpv(errsv,"");
+ PUTBACK;
+ return DOCATCH(op->op_next);
}
PP(pp_leavetry)
{
- dSP;
+ djSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
POPEVAL(cx);
pop_return();
- if (gimme == G_SCALAR) {
- if (op->op_private & OPpLEAVE_VOID)
- MARK = newsp;
+ TAINT_NOT;
+ if (gimme == G_VOID)
+ SP = newsp;
+ else if (gimme == G_SCALAR) {
+ MARK = newsp + 1;
+ if (MARK <= SP) {
+ if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
+ *MARK = TOPs;
+ else
+ *MARK = sv_mortalcopy(TOPs);
+ }
else {
- MARK = newsp + 1;
- if (MARK <= SP) {
- if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
- *MARK = TOPs;
- else
- *MARK = sv_mortalcopy(TOPs);
- }
- else {
- MEXTEND(mark,0);
- *MARK = &sv_undef;
- }
+ MEXTEND(mark,0);
+ *MARK = &sv_undef;
}
SP = MARK;
}
else {
- for (mark = newsp + 1; mark <= SP; mark++)
- if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
+ /* in case LEAVE wipes old return values */
+ for (mark = newsp + 1; mark <= SP; mark++) {
+ if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
*mark = sv_mortalcopy(*mark);
- /* in case LEAVE wipes old return values */
+ TAINT_NOT; /* Each item is independent */
+ }
+ }
}
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(GvSV(errgv),"");
+ sv_setpv(errsv,"");
RETURN;
}
static void
-doparseform(sv)
-SV *sv;
+doparseform(SV *sv)
{
STRLEN len;
register char *s = SvPV_force(sv, len);
sv_magic(sv, Nullsv, 'f', Nullch, 0);
SvCOMPILED_on(sv);
}
+
https://perl5.git.perl.org / perl5.git / blobdiff