if (SvROK(tmpstr)) {
SV * const sv = SvRV(tmpstr);
if (SvTYPE(sv) == SVt_REGEXP)
- re = sv;
+ re = (REGEXP*) sv;
}
if (re) {
re = reg_temp_copy(re);
STRLEN len;
const char *t = SvOK(tmpstr) ? SvPV_const(tmpstr, len) : "";
re = PM_GETRE(pm);
+ assert (re != (REGEXP*) &PL_sv_undef);
/* Check against the last compiled regexp. */
- if (!re || !RX_PRECOMP(re) || RX_PRELEN(re) != (I32)len ||
+ if (!re || !RX_PRECOMP(re) || RX_PRELEN(re) != len ||
memNE(RX_PRECOMP(re), t, len))
{
const regexp_engine *eng = re ? RX_ENGINE(re) : NULL;
U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
if (re) {
ReREFCNT_dec(re);
+#ifdef USE_ITHREADS
+ PM_SETRE(pm, (REGEXP*) &PL_sv_undef);
+#else
PM_SETRE(pm, NULL); /* crucial if regcomp aborts */
+#endif
} else if (PL_curcop->cop_hints_hash) {
SV *ptr = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
"regcomp", 7, 0, 0);
FREETMPS; /* Prevent excess tmp stack */
/* Are we done */
- if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
+ if (CxONCE(cx) || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
s == m, cx->sb_targ, NULL,
((cx->sb_rflags & REXEC_COPY_STR)
? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
if (CxTYPE(cx) == CXt_NULL)
return -1;
break;
- case CXt_LOOP:
- if ( !cx->blk_loop.label || strNE(label, cx->blk_loop.label) ) {
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
+ if ( !CxLABEL(cx) || strNE(label, CxLABEL(cx)) ) {
DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n",
- (long)i, cx->blk_loop.label));
+ (long)i, CxLABEL(cx)));
continue;
}
DEBUG_l( Perl_deb(aTHX_ "(Found label #%ld %s)\n", (long)i, label));
const I32 cxix = dopoptosub(cxstack_ix);
assert(cxix >= 0); /* We should only be called from inside subs */
- if (cxstack[cxix].blk_sub.lval && CvLVALUE(cxstack[cxix].blk_sub.cv))
- return cxstack[cxix].blk_sub.lval;
+ if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv))
+ return CxLVAL(cxstack + cxix);
else
return 0;
}
if ((CxTYPE(cx)) == CXt_NULL)
return -1;
break;
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i));
return i;
}
case CXt_GIVEN:
DEBUG_l( Perl_deb(aTHX_ "(Found given #%ld)\n", (long)i));
return i;
- case CXt_LOOP:
+ case CXt_LOOP_PLAIN:
+ assert(!CxFOREACHDEF(cx));
+ break;
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
if (CxFOREACHDEF(cx)) {
DEBUG_l( Perl_deb(aTHX_ "(Found foreach #%ld)\n", (long)i));
return i;
case CXt_EVAL:
POPEVAL(cx);
break;
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
POPLOOP(cx);
break;
case CXt_NULL:
SV * const sv = newSV(0);
gv_efullname3(sv, cvgv, NULL);
mPUSHs(sv);
- mPUSHi((I32)cx->blk_sub.hasargs);
+ PUSHs(boolSV(CxHASARGS(cx)));
}
else {
PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP));
- mPUSHi((I32)cx->blk_sub.hasargs);
+ PUSHs(boolSV(CxHASARGS(cx)));
}
}
else {
if (gimme == G_VOID)
PUSHs(&PL_sv_undef);
else
- mPUSHi(gimme & G_ARRAY);
+ PUSHs(boolSV((gimme & G_WANT) == G_ARRAY));
if (CxTYPE(cx) == CXt_EVAL) {
/* eval STRING */
- if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
+ if (CxOLD_OP_TYPE(cx) == OP_ENTEREVAL) {
PUSHs(cx->blk_eval.cur_text);
PUSHs(&PL_sv_no);
}
PUSHs(&PL_sv_undef);
PUSHs(&PL_sv_undef);
}
- if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs
+ if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)
&& CopSTASH_eq(PL_curcop, PL_debstash))
{
AV * const ary = cx->blk_sub.argarray;
register PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
SV **svp;
- U16 cxtype = CXt_LOOP | CXp_FOREACH;
+ U8 cxtype = CXt_LOOP_FOR;
#ifdef USE_ITHREADS
- void *iterdata;
+ PAD *iterdata;
#endif
ENTER;
SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ),
SVs_PADSTALE, SVs_PADSTALE);
}
+ SAVEPADSVANDMORTALIZE(PL_op->op_targ);
#ifndef USE_ITHREADS
svp = &PAD_SVl(PL_op->op_targ); /* "my" variable */
- SAVESPTR(*svp);
#else
- SAVEPADSV(PL_op->op_targ);
- iterdata = INT2PTR(void*, PL_op->op_targ);
- cxtype |= CXp_PADVAR;
+ iterdata = NULL;
#endif
}
else {
SAVEGENERICSV(*svp);
*svp = newSV(0);
#ifdef USE_ITHREADS
- iterdata = (void*)gv;
+ iterdata = (PAD*)gv;
#endif
}
PUSHBLOCK(cx, cxtype, SP);
#ifdef USE_ITHREADS
- PUSHLOOP(cx, iterdata, MARK);
+ PUSHLOOP_FOR(cx, iterdata, MARK, PL_op->op_targ);
#else
- PUSHLOOP(cx, svp, MARK);
+ PUSHLOOP_FOR(cx, svp, MARK, 0);
#endif
if (PL_op->op_flags & OPf_STACKED) {
- cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
- if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+ SV *maybe_ary = POPs;
+ if (SvTYPE(maybe_ary) != SVt_PVAV) {
dPOPss;
- SV * const right = (SV*)cx->blk_loop.iterary;
+ SV * const right = maybe_ary;
SvGETMAGIC(sv);
SvGETMAGIC(right);
if (RANGE_IS_NUMERIC(sv,right)) {
- if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
- (SvOK(right) && SvNV(right) >= IV_MAX))
+ cx->cx_type &= ~CXTYPEMASK;
+ cx->cx_type |= CXt_LOOP_LAZYIV;
+ /* Make sure that no-one re-orders cop.h and breaks our
+ assumptions */
+ assert(CxTYPE(cx) == CXt_LOOP_LAZYIV);
+#ifdef NV_PRESERVES_UV
+ if ((SvOK(sv) && ((SvNV(sv) < (NV)IV_MIN) ||
+ (SvNV(sv) > (NV)IV_MAX)))
+ ||
+ (SvOK(right) && ((SvNV(right) > (NV)IV_MAX) ||
+ (SvNV(right) < (NV)IV_MIN))))
+#else
+ if ((SvOK(sv) && ((SvNV(sv) <= (NV)IV_MIN)
+ ||
+ ((SvNV(sv) > 0) &&
+ ((SvUV(sv) > (UV)IV_MAX) ||
+ (SvNV(sv) > (NV)UV_MAX)))))
+ ||
+ (SvOK(right) && ((SvNV(right) <= (NV)IV_MIN)
+ ||
+ ((SvNV(right) > 0) &&
+ ((SvUV(right) > (UV)IV_MAX) ||
+ (SvNV(right) > (NV)UV_MAX))))))
+#endif
DIE(aTHX_ "Range iterator outside integer range");
- cx->blk_loop.iterix = SvIV(sv);
- cx->blk_loop.itermax = SvIV(right);
+ cx->blk_loop.state_u.lazyiv.cur = SvIV(sv);
+ cx->blk_loop.state_u.lazyiv.end = SvIV(right);
#ifdef DEBUGGING
/* for correct -Dstv display */
cx->blk_oldsp = sp - PL_stack_base;
#endif
}
else {
- cx->blk_loop.iterlval = newSVsv(sv);
- (void) SvPV_force_nolen(cx->blk_loop.iterlval);
+ cx->cx_type &= ~CXTYPEMASK;
+ cx->cx_type |= CXt_LOOP_LAZYSV;
+ /* Make sure that no-one re-orders cop.h and breaks our
+ assumptions */
+ assert(CxTYPE(cx) == CXt_LOOP_LAZYSV);
+ cx->blk_loop.state_u.lazysv.cur = newSVsv(sv);
+ cx->blk_loop.state_u.lazysv.end = right;
+ SvREFCNT_inc(right);
+ (void) SvPV_force_nolen(cx->blk_loop.state_u.lazysv.cur);
+ /* This will do the upgrade to SVt_PV, and warn if the value
+ is uninitialised. */
(void) SvPV_nolen_const(right);
+ /* Doing this avoids a check every time in pp_iter in pp_hot.c
+ to replace !SvOK() with a pointer to "". */
+ if (!SvOK(right)) {
+ SvREFCNT_dec(right);
+ cx->blk_loop.state_u.lazysv.end = &PL_sv_no;
+ }
}
}
- else if (PL_op->op_private & OPpITER_REVERSED) {
- cx->blk_loop.itermax = 0;
- cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary) + 1;
-
+ else /* SvTYPE(maybe_ary) == SVt_PVAV */ {
+ cx->blk_loop.state_u.ary.ary = (AV*)maybe_ary;
+ SvREFCNT_inc(maybe_ary);
+ cx->blk_loop.state_u.ary.ix =
+ (PL_op->op_private & OPpITER_REVERSED) ?
+ AvFILL(cx->blk_loop.state_u.ary.ary) + 1 :
+ -1;
}
}
- else {
- cx->blk_loop.iterary = PL_curstack;
- AvFILLp(PL_curstack) = SP - PL_stack_base;
+ else { /* iterating over items on the stack */
+ cx->blk_loop.state_u.ary.ary = NULL; /* means to use the stack */
if (PL_op->op_private & OPpITER_REVERSED) {
- cx->blk_loop.itermax = MARK - PL_stack_base + 1;
- cx->blk_loop.iterix = cx->blk_oldsp + 1;
+ cx->blk_loop.state_u.ary.ix = cx->blk_oldsp + 1;
}
else {
- cx->blk_loop.iterix = MARK - PL_stack_base;
+ cx->blk_loop.state_u.ary.ix = MARK - PL_stack_base;
}
}
SAVETMPS;
ENTER;
- PUSHBLOCK(cx, CXt_LOOP, SP);
- PUSHLOOP(cx, 0, SP);
+ PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
+ PUSHLOOP_PLAIN(cx, SP);
RETURN;
}
SV **mark;
POPBLOCK(cx,newpm);
- assert(CxTYPE(cx) == CXt_LOOP);
+ assert(CxTYPE_is_LOOP(cx));
mark = newsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;
cxstack_ix++; /* temporarily protect top context */
mark = newsp;
switch (CxTYPE(cx)) {
- case CXt_LOOP:
- pop2 = CXt_LOOP;
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
+ pop2 = CxTYPE(cx);
newsp = PL_stack_base + cx->blk_loop.resetsp;
nextop = cx->blk_loop.my_op->op_lastop->op_next;
break;
cxstack_ix--;
/* Stack values are safe: */
switch (pop2) {
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_PLAIN:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
POPLOOP(cx); /* release loop vars ... */
LEAVE;
break;
}
else if (CxMULTICALL(cx))
DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
- if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
+ if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
/* put @_ back onto stack */
AV* av = cx->blk_sub.argarray;
else {
AV* const padlist = CvPADLIST(cv);
if (CxTYPE(cx) == CXt_EVAL) {
- PL_in_eval = cx->blk_eval.old_in_eval;
+ PL_in_eval = CxOLD_IN_EVAL(cx);
PL_eval_root = cx->blk_eval.old_eval_root;
cx->cx_type = CXt_SUB;
- cx->blk_sub.hasargs = 0;
}
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
if (CvDEPTH(cv) < 2)
SvREFCNT_inc_simple_void_NN(cv);
else {
- if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
+ if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION))
sub_crush_depth(cv);
pad_push(padlist, CvDEPTH(cv));
}
SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
- if (cx->blk_sub.hasargs)
+ if (CxHASARGS(cx))
{
AV* const av = (AV*)PAD_SVl(0);
break;
}
/* else fall through */
- case CXt_LOOP:
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
gotoprobe = cx->blk_oldcop->op_sibling;
break;
case CXt_SUBST:
PL_op->op_type = OP_ENTEREVAL;
PL_op->op_flags = 0; /* Avoid uninit warning. */
PUSHBLOCK(cx, CXt_EVAL|(IN_PERL_COMPILETIME ? 0 : CXp_REAL), SP);
- PUSHEVAL(cx, 0, NULL);
+ PUSHEVAL(cx, 0);
if (runtime)
(void) doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
&& cLISTOPx(cUNOPx(PL_eval_root)->op_first)->op_last->op_type
== OP_REQUIRE)
scalar(PL_eval_root);
- else if (gimme & G_VOID)
+ else if ((gimme & G_WANT) == G_VOID)
scalarvoid(PL_eval_root);
- else if (gimme & G_ARRAY)
+ else if ((gimme & G_WANT) == G_ARRAY)
list(PL_eval_root);
else
scalar(PL_eval_root);
sv = POPs;
if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
- if ( SvVOK(sv) && ckWARN(WARN_PORTABLE) ) { /* require v5.6.1 */
- HV * hinthv = GvHV(PL_hintgv);
- SV ** ptr = NULL;
- if (hinthv) ptr = hv_fetchs(hinthv, "v_string", FALSE);
- if ( !(ptr && *ptr && SvIOK(*ptr) && SvIV(*ptr)) )
- Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
- "v-string in use/require non-portable");
- }
sv = new_version(sv);
if (!sv_derived_from(PL_patchlevel, "version"))
upg_version(PL_patchlevel, TRUE);
/* We do this only with use, not require. */
if (PL_compcv &&
- /* If we request a version >= 5.6.0, then v-string are OK
- so set $^H{v_string} to suppress the v-string warning */
- vcmp(sv, sv_2mortal(upg_version(newSVnv(5.006), FALSE))) >= 0) {
- HV * hinthv = GvHV(PL_hintgv);
- if( hinthv ) {
- SV *hint = newSViv(1);
- (void)hv_stores(hinthv, "v_string", hint);
- /* This will call through to Perl_magic_sethint() which in turn
- sets PL_hints correctly. */
- SvSETMAGIC(hint);
- }
/* If we request a version >= 5.9.5, load feature.pm with the
* feature bundle that corresponds to the required version. */
- if (vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
+ vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
SV *const importsv = vnormal(sv);
*SvPVX_mutable(importsv) = ':';
ENTER;
Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
LEAVE;
- }
}
RETPUSHYES;
if (vms_unixname)
#endif
{
- namesv = newSV(0);
- sv_upgrade(namesv, SVt_PV);
+ namesv = newSV_type(SVt_PV);
for (i = 0; i <= AvFILL(ar); i++) {
SV * const dirsv = *av_fetch(ar, i, TRUE);
/* switch to eval mode */
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name, NULL);
+ PUSHEVAL(cx, name);
cx->blk_eval.retop = PL_op->op_next;
SAVECOPLINE(&PL_compiling);
runcv = find_runcv(&seq);
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
- PUSHEVAL(cx, 0, NULL);
+ PUSHEVAL(cx, 0);
cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
SAVETMPS;
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
- PUSHEVAL(cx, 0, 0);
+ PUSHEVAL(cx, 0);
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
# define SM_REGEX ( \
(SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP) \
- && (this_regex = This) \
+ && (this_regex = (REGEXP*) This) \
&& (Other = e)) \
|| \
(SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_REGEXP) \
- && (this_regex = This) \
+ && (this_regex = (REGEXP*) This) \
&& (Other = d)) )
# define SM_OTHER_REGEX (SvROK(Other) \
&& (SvTYPE(SvRV(Other)) == SVt_REGEXP) \
- && (other_regex = SvRV(Other)))
+ && (other_regex = (REGEXP*) SvRV(Other)))
# define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \
projects / p5sagit/p5-mst-13.2.git / blobdiff