/* This is a const op added to hold the hints hash for
pp_entereval. The hash can be modified by the code
being eval'ed, so we return a copy instead. */
- XPUSHs(sv_2mortal((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)));
+ mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
else
/* Normal const. */
XPUSHs(cSVOP_sv);
return NORMAL;
}
-PP(pp_setstate)
-{
- dVAR;
- PL_curcop = (COP*)PL_op;
- return NORMAL;
-}
-
PP(pp_pushmark)
{
dVAR;
/* mg_get(right) may happen here ... */
rpv = SvPV_const(right, rlen);
rbyte = !DO_UTF8(right);
- right = sv_2mortal(newSVpvn(rpv, rlen));
+ right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */
rcopied = TRUE;
}
sv_utf8_upgrade_nomg(TARG);
else {
if (!rcopied)
- right = sv_2mortal(newSVpvn(rpv, rlen));
+ right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
sv_utf8_upgrade_nomg(right);
rpv = SvPV_const(right, rlen);
}
*MARK = SvTIED_obj((SV*)io, mg);
PUTBACK;
ENTER;
+ if( PL_op->op_type == OP_SAY ) {
+ /* local $\ = "\n" */
+ SAVEGENERICSV(PL_ors_sv);
+ PL_ors_sv = newSVpvs("\n");
+ }
call_method("PRINT", G_SCALAR);
LEAVE;
SPAGAIN;
S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
{
dVAR;
+
+ PERL_ARGS_ASSERT_DO_ODDBALL;
+
if (*relem) {
SV *tmpstr;
const HE *didstore;
dVAR; dSP;
register PMOP * const pm = cPMOP;
REGEXP * rx = PM_GETRE(pm);
- SV * const pkg = CALLREG_PACKAGE(rx);
+ SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL;
SV * const rv = sv_newmortal();
- SV * const sv = newSVrv(rv, pkg ? SvPV_nolen(pkg) : NULL);
- if (rx->extflags & RXf_TAINTED)
+
+ SvUPGRADE(rv, SVt_IV);
+ /* This RV is about to own a reference to the regexp. (In addition to the
+ reference already owned by the PMOP. */
+ ReREFCNT_inc(rx);
+ SvRV_set(rv, (SV*) rx);
+ SvROK_on(rv);
+
+ if (pkg) {
+ HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+ (void)sv_bless(rv, stash);
+ }
+
+ if (RX_EXTFLAGS(rx) & RXf_TAINTED)
SvTAINTED_on(rv);
- sv_upgrade(sv, SVt_REGEXP);
- ((struct xregexp *)SvANY(sv))->xrx_regexp = ReREFCNT_inc(rx);
XPUSHs(rv);
RETURN;
}
register const char *s;
const char *strend;
I32 global;
- I32 r_flags = REXEC_CHECKED;
+ U8 r_flags = REXEC_CHECKED;
const char *truebase; /* Start of string */
register REGEXP *rx = PM_GETRE(pm);
bool rxtainted;
if (!s)
DIE(aTHX_ "panic: pp_match");
strend = s + len;
- rxtainted = ((rx->extflags & RXf_TAINTED) ||
+ rxtainted = ((RX_EXTFLAGS(rx) & RXf_TAINTED) ||
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
/* empty pattern special-cased to use last successful pattern if possible */
- if (!rx->prelen && PL_curpm) {
+ if (!RX_PRELEN(rx) && PL_curpm) {
pm = PL_curpm;
rx = PM_GETRE(pm);
}
- if (rx->minlen > (I32)len)
+ if (RX_MINLEN(rx) > (I32)len)
goto failure;
truebase = t = s;
/* XXXX What part of this is needed with true \G-support? */
if ((global = dynpm->op_pmflags & PMf_GLOBAL)) {
- rx->offs[0].start = -1;
+ RX_OFFS(rx)[0].start = -1;
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
if (mg && mg->mg_len >= 0) {
- if (!(rx->extflags & RXf_GPOS_SEEN))
- rx->offs[0].end = rx->offs[0].start = mg->mg_len;
- else if (rx->extflags & RXf_ANCH_GPOS) {
+ if (!(RX_EXTFLAGS(rx) & RXf_GPOS_SEEN))
+ RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+ else if (RX_EXTFLAGS(rx) & RXf_ANCH_GPOS) {
r_flags |= REXEC_IGNOREPOS;
- rx->offs[0].end = rx->offs[0].start = mg->mg_len;
- } else if (rx->extflags & RXf_GPOS_FLOAT)
+ RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+ } else if (RX_EXTFLAGS(rx) & RXf_GPOS_FLOAT)
gpos = mg->mg_len;
else
- rx->offs[0].end = rx->offs[0].start = mg->mg_len;
- minmatch = (mg->mg_flags & MGf_MINMATCH) ? rx->gofs + 1 : 0;
+ RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len;
+ minmatch = (mg->mg_flags & MGf_MINMATCH) ? RX_GOFS(rx) + 1 : 0;
update_minmatch = 0;
}
}
/g matches against large strings. So far a solution to this problem
appears to be quite tricky.
Test for the unsafe vars are TODO for now. */
- if (( !global && rx->nparens)
+ if (( !global && RX_NPARENS(rx))
|| SvTEMP(TARG) || PL_sawampersand ||
- (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
+ (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
r_flags |= REXEC_COPY_STR;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
play_it_again:
- if (global && rx->offs[0].start != -1) {
- t = s = rx->offs[0].end + truebase - rx->gofs;
- if ((s + rx->minlen) > strend || s < truebase)
+ if (global && RX_OFFS(rx)[0].start != -1) {
+ t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx);
+ if ((s + RX_MINLEN(rx)) > strend || s < truebase)
goto nope;
if (update_minmatch++)
minmatch = had_zerolen;
}
- if (rx->extflags & RXf_USE_INTUIT &&
- DO_UTF8(TARG) == ((rx->extflags & RXf_UTF8) != 0)) {
+ if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT &&
+ DO_UTF8(TARG) == (RX_UTF8(rx) != 0)) {
/* FIXME - can PL_bostr be made const char *? */
PL_bostr = (char *)truebase;
s = CALLREG_INTUIT_START(rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
if (!s)
goto nope;
- if ( (rx->extflags & RXf_CHECK_ALL)
+ if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
&& !PL_sawampersand
- && !(rx->extflags & RXf_PMf_KEEPCOPY)
- && ((rx->extflags & RXf_NOSCAN)
- || !((rx->extflags & RXf_INTUIT_TAIL)
+ && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY)
+ && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
+ || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
&& (r_flags & REXEC_SCREAM)))
&& !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */
goto yup;
RX_MATCH_TAINTED_on(rx);
TAINT_IF(RX_MATCH_TAINTED(rx));
if (gimme == G_ARRAY) {
- const I32 nparens = rx->nparens;
+ const I32 nparens = RX_NPARENS(rx);
I32 i = (global && !nparens) ? 1 : 0;
SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
- if ((rx->offs[i].start != -1) && rx->offs[i].end != -1 ) {
- const I32 len = rx->offs[i].end - rx->offs[i].start;
- s = rx->offs[i].start + truebase;
- if (rx->offs[i].end < 0 || rx->offs[i].start < 0 ||
+ if ((RX_OFFS(rx)[i].start != -1) && RX_OFFS(rx)[i].end != -1 ) {
+ const I32 len = RX_OFFS(rx)[i].end - RX_OFFS(rx)[i].start;
+ s = RX_OFFS(rx)[i].start + truebase;
+ if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 ||
len < 0 || len > strend - s)
DIE(aTHX_ "panic: pp_match start/end pointers");
sv_setpvn(*SP, s, len);
mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
&PL_vtbl_mglob, NULL, 0);
}
- if (rx->offs[0].start != -1) {
- mg->mg_len = rx->offs[0].end;
- if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
+ if (RX_OFFS(rx)[0].start != -1) {
+ mg->mg_len = RX_OFFS(rx)[0].end;
+ if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
mg->mg_flags |= MGf_MINMATCH;
else
mg->mg_flags &= ~MGf_MINMATCH;
}
}
- had_zerolen = (rx->offs[0].start != -1
- && (rx->offs[0].start + rx->gofs
- == (UV)rx->offs[0].end));
+ had_zerolen = (RX_OFFS(rx)[0].start != -1
+ && (RX_OFFS(rx)[0].start + RX_GOFS(rx)
+ == (UV)RX_OFFS(rx)[0].end));
PUTBACK; /* EVAL blocks may use stack */
r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
goto play_it_again;
mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
&PL_vtbl_mglob, NULL, 0);
}
- if (rx->offs[0].start != -1) {
- mg->mg_len = rx->offs[0].end;
- if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
+ if (RX_OFFS(rx)[0].start != -1) {
+ mg->mg_len = RX_OFFS(rx)[0].end;
+ if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end)
mg->mg_flags |= MGf_MINMATCH;
else
mg->mg_flags &= ~MGf_MINMATCH;
#endif
}
if (RX_MATCH_COPIED(rx))
- Safefree(rx->subbeg);
+ Safefree(RX_SUBBEG(rx));
RX_MATCH_COPIED_off(rx);
- rx->subbeg = NULL;
+ RX_SUBBEG(rx) = NULL;
if (global) {
/* FIXME - should rx->subbeg be const char *? */
- rx->subbeg = (char *) truebase;
- rx->offs[0].start = s - truebase;
+ RX_SUBBEG(rx) = (char *) truebase;
+ RX_OFFS(rx)[0].start = s - truebase;
if (RX_MATCH_UTF8(rx)) {
- char * const t = (char*)utf8_hop((U8*)s, rx->minlenret);
- rx->offs[0].end = t - truebase;
+ char * const t = (char*)utf8_hop((U8*)s, RX_MINLENRET(rx));
+ RX_OFFS(rx)[0].end = t - truebase;
}
else {
- rx->offs[0].end = s - truebase + rx->minlenret;
+ RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
}
- rx->sublen = strend - truebase;
+ RX_SUBLEN(rx) = strend - truebase;
goto gotcha;
}
- if (PL_sawampersand || rx->extflags & RXf_PMf_KEEPCOPY) {
+ if (PL_sawampersand || RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) {
I32 off;
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
(int) SvTYPE(TARG), (void*)truebase, (void*)t,
(int)(t-truebase));
}
- rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
- rx->subbeg = (char *) SvPVX_const(rx->saved_copy) + (t - truebase);
- assert (SvPOKp(rx->saved_copy));
+ RX_SAVED_COPY(rx) = sv_setsv_cow(RX_SAVED_COPY(rx), TARG);
+ RX_SUBBEG(rx)
+ = (char *) SvPVX_const(RX_SAVED_COPY(rx)) + (t - truebase);
+ assert (SvPOKp(RX_SAVED_COPY(rx)));
} else
#endif
{
- rx->subbeg = savepvn(t, strend - t);
+ RX_SUBBEG(rx) = savepvn(t, strend - t);
#ifdef PERL_OLD_COPY_ON_WRITE
- rx->saved_copy = NULL;
+ RX_SAVED_COPY(rx) = NULL;
#endif
}
- rx->sublen = strend - t;
+ RX_SUBLEN(rx) = strend - t;
RX_MATCH_COPIED_on(rx);
- off = rx->offs[0].start = s - t;
- rx->offs[0].end = off + rx->minlenret;
+ off = RX_OFFS(rx)[0].start = s - t;
+ RX_OFFS(rx)[0].end = off + RX_MINLENRET(rx);
}
else { /* startp/endp are used by @- @+. */
- rx->offs[0].start = s - truebase;
- rx->offs[0].end = s - truebase + rx->minlenret;
+ RX_OFFS(rx)[0].start = s - truebase;
+ RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx);
}
- /* including rx->nparens in the below code seems highly suspicious.
+ /* including RX_NPARENS(rx) in the below code seems highly suspicious.
-dmq */
- rx->nparens = rx->lastparen = rx->lastcloseparen = 0; /* used by @-, @+, and $^N */
+ RX_NPARENS(rx) = RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0; /* used by @-, @+, and $^N */
LEAVE_SCOPE(oldsave);
RETPUSHYES;
dVAR; dSP;
register PERL_CONTEXT *cx;
SV *sv, *oldsv;
- AV* av;
SV **itersvp;
+ AV *av = NULL; /* used for LOOP_FOR on arrays and the stack */
+ bool av_is_stack = FALSE;
EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
- if (CxTYPE(cx) != CXt_LOOP)
+ if (!CxTYPE_is_LOOP(cx))
DIE(aTHX_ "panic: pp_iter");
itersvp = CxITERVAR(cx);
- av = cx->blk_loop.iterary;
- if (SvTYPE(av) != SVt_PVAV) {
- /* iterate ($min .. $max) */
- if (cx->blk_loop.iterlval) {
+ if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
/* string increment */
- register SV* cur = cx->blk_loop.iterlval;
+ SV* cur = cx->blk_loop.state_u.lazysv.cur;
+ SV *end = cx->blk_loop.state_u.lazysv.end;
+ /* If the maximum is !SvOK(), pp_enteriter substitutes PL_sv_no.
+ It has SvPVX of "" and SvCUR of 0, which is what we want. */
STRLEN maxlen = 0;
- const char *max =
- SvOK((SV*)av) ?
- SvPV_const((SV*)av, maxlen) : (const char *)"";
+ const char *max = SvPV_const(end, maxlen);
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
RETPUSHYES;
}
RETPUSHNO;
- }
+ }
+ else if (CxTYPE(cx) == CXt_LOOP_LAZYIV) {
/* integer increment */
- if (cx->blk_loop.iterix > cx->blk_loop.itermax)
+ if (cx->blk_loop.state_u.lazyiv.cur > cx->blk_loop.state_u.lazyiv.end)
RETPUSHNO;
/* don't risk potential race */
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
- sv_setiv(*itersvp, cx->blk_loop.iterix++);
+ sv_setiv(*itersvp, cx->blk_loop.state_u.lazyiv.cur++);
}
else
{
* completely new SV for closures/references to work as they
* used to */
oldsv = *itersvp;
- *itersvp = newSViv(cx->blk_loop.iterix++);
+ *itersvp = newSViv(cx->blk_loop.state_u.lazyiv.cur++);
SvREFCNT_dec(oldsv);
}
+
+ /* Handle end of range at IV_MAX */
+ if ((cx->blk_loop.state_u.lazyiv.cur == IV_MIN) &&
+ (cx->blk_loop.state_u.lazyiv.end == IV_MAX))
+ {
+ cx->blk_loop.state_u.lazyiv.cur++;
+ cx->blk_loop.state_u.lazyiv.end++;
+ }
+
RETPUSHYES;
}
/* iterate array */
+ assert(CxTYPE(cx) == CXt_LOOP_FOR);
+ av = cx->blk_loop.state_u.ary.ary;
+ if (!av) {
+ av_is_stack = TRUE;
+ av = PL_curstack;
+ }
if (PL_op->op_private & OPpITER_REVERSED) {
- /* In reverse, use itermax as the min :-) */
- if (cx->blk_loop.iterix <= cx->blk_loop.itermax)
+ if (cx->blk_loop.state_u.ary.ix <= (av_is_stack
+ ? cx->blk_loop.resetsp + 1 : 0))
RETPUSHNO;
if (SvMAGICAL(av) || AvREIFY(av)) {
- SV * const * const svp = av_fetch(av, --cx->blk_loop.iterix, FALSE);
+ SV * const * const svp = av_fetch(av, --cx->blk_loop.state_u.ary.ix, FALSE);
sv = svp ? *svp : NULL;
}
else {
- sv = AvARRAY(av)[--cx->blk_loop.iterix];
+ sv = AvARRAY(av)[--cx->blk_loop.state_u.ary.ix];
}
}
else {
- if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp :
+ if (cx->blk_loop.state_u.ary.ix >= (av_is_stack ? cx->blk_oldsp :
AvFILL(av)))
RETPUSHNO;
if (SvMAGICAL(av) || AvREIFY(av)) {
- SV * const * const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+ SV * const * const svp = av_fetch(av, ++cx->blk_loop.state_u.ary.ix, FALSE);
sv = svp ? *svp : NULL;
}
else {
- sv = AvARRAY(av)[++cx->blk_loop.iterix];
+ sv = AvARRAY(av)[++cx->blk_loop.state_u.ary.ix];
}
}
Perl_croak(aTHX_ "Use of freed value in iteration");
}
- if (sv)
+ if (sv) {
SvTEMP_off(sv);
+ SvREFCNT_inc_simple_void_NN(sv);
+ }
else
sv = &PL_sv_undef;
- if (av != PL_curstack && sv == &PL_sv_undef) {
- SV *lv = cx->blk_loop.iterlval;
- if (lv && SvREFCNT(lv) > 1) {
- SvREFCNT_dec(lv);
- lv = NULL;
- }
- if (lv)
- SvREFCNT_dec(LvTARG(lv));
- else {
- lv = cx->blk_loop.iterlval = newSV_type(SVt_PVLV);
- LvTYPE(lv) = 'y';
- sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
- }
+ if (!av_is_stack && sv == &PL_sv_undef) {
+ SV *lv = newSV_type(SVt_PVLV);
+ LvTYPE(lv) = 'y';
+ sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
LvTARG(lv) = SvREFCNT_inc_simple(av);
- LvTARGOFF(lv) = cx->blk_loop.iterix;
+ LvTARGOFF(lv) = cx->blk_loop.state_u.ary.ix;
LvTARGLEN(lv) = (STRLEN)UV_MAX;
- sv = (SV*)lv;
+ sv = lv;
}
oldsv = *itersvp;
- *itersvp = SvREFCNT_inc_simple_NN(sv);
+ *itersvp = sv;
SvREFCNT_dec(oldsv);
RETPUSHYES;
I32 maxiters;
register I32 i;
bool once;
- bool rxtainted;
+ U8 rxtainted;
char *orig;
- I32 r_flags;
+ U8 r_flags;
register REGEXP *rx = PM_GETRE(pm);
STRLEN len;
int force_on_match = 0;
const I32 oldsave = PL_savestack_ix;
STRLEN slen;
bool doutf8 = FALSE;
+ I32 matched;
#ifdef PERL_OLD_COPY_ON_WRITE
bool is_cow;
#endif
s = SvPV_mutable(TARG, len);
if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
force_on_match = 1;
- rxtainted = ((rx->extflags & RXf_TAINTED) ||
+ rxtainted = ((RX_EXTFLAGS(rx) & RXf_TAINTED) ||
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
if (PL_tainted)
rxtainted |= 2;
position, once with zero-length,
second time with non-zero. */
- if (!rx->prelen && PL_curpm) {
+ if (!RX_PRELEN(rx) && PL_curpm) {
pm = PL_curpm;
rx = PM_GETRE(pm);
}
- r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand
- || (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
+ r_flags = (RX_NPARENS(rx) || SvTEMP(TARG) || PL_sawampersand
+ || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) )
? REXEC_COPY_STR : 0;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
orig = m = s;
- if (rx->extflags & RXf_USE_INTUIT) {
+ if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) {
PL_bostr = orig;
s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
if (!s)
goto nope;
/* How to do it in subst? */
-/* if ( (rx->extflags & RXf_CHECK_ALL)
+/* if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
&& !PL_sawampersand
- && !(rx->extflags & RXf_KEEPCOPY)
- && ((rx->extflags & RXf_NOSCAN)
- || !((rx->extflags & RXf_INTUIT_TAIL)
+ && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY)
+ && ((RX_EXTFLAGS(rx) & RXf_NOSCAN)
+ || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL)
&& (r_flags & REXEC_SCREAM))))
goto yup;
*/
/* only replace once? */
once = !(rpm->op_pmflags & PMf_GLOBAL);
-
+ matched = CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
+ r_flags | REXEC_CHECKED);
/* known replacement string? */
if (dstr) {
/* replacement needing upgrading? */
#ifdef PERL_OLD_COPY_ON_WRITE
&& !is_cow
#endif
- && (I32)clen <= rx->minlenret && (once || !(r_flags & REXEC_COPY_STR))
- && !(rx->extflags & RXf_LOOKBEHIND_SEEN)
+ && (I32)clen <= RX_MINLENRET(rx) && (once || !(r_flags & REXEC_COPY_STR))
+ && !(RX_EXTFLAGS(rx) & RXf_LOOKBEHIND_SEEN)
&& (!doutf8 || SvUTF8(TARG))) {
- if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
- r_flags | REXEC_CHECKED))
+ if (!matched)
{
SPAGAIN;
PUSHs(&PL_sv_no);
SvSCREAM_off(TARG); /* disable possible screamer */
if (once) {
rxtainted |= RX_MATCH_TAINTED(rx);
- m = orig + rx->offs[0].start;
- d = orig + rx->offs[0].end;
+ m = orig + RX_OFFS(rx)[0].start;
+ d = orig + RX_OFFS(rx)[0].end;
s = orig;
if (m - s > strend - d) { /* faster to shorten from end */
if (clen) {
else if ((i = m - s)) { /* faster from front */
d -= clen;
m = d;
+ Move(s, d - i, i, char);
sv_chop(TARG, d-i);
- s += i;
- while (i--)
- *--d = *--s;
if (clen)
Copy(c, m, clen, char);
}
if (iters++ > maxiters)
DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
- m = rx->offs[0].start + orig;
+ m = RX_OFFS(rx)[0].start + orig;
if ((i = m - s)) {
if (s != d)
Move(s, d, i, char);
Copy(c, d, clen, char);
d += clen;
}
- s = rx->offs[0].end + orig;
+ s = RX_OFFS(rx)[0].end + orig;
} while (CALLREGEXEC(rx, s, strend, orig, s == m,
TARG, NULL,
/* don't match same null twice */
}
TAINT_IF(rxtainted & 1);
SPAGAIN;
- PUSHs(sv_2mortal(newSViv((I32)iters)));
+ mPUSHi((I32)iters);
}
(void)SvPOK_only_UTF8(TARG);
TAINT_IF(rxtainted);
RETURN;
}
- if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
- r_flags | REXEC_CHECKED))
+ if (matched)
{
if (force_on_match) {
force_on_match = 0;
have_a_cow:
#endif
rxtainted |= RX_MATCH_TAINTED(rx);
- dstr = newSVpvn(m, s-m);
+ dstr = newSVpvn_utf8(m, s-m, DO_UTF8(TARG));
SAVEFREESV(dstr);
- if (DO_UTF8(TARG))
- SvUTF8_on(dstr);
PL_curpm = pm;
if (!c) {
register PERL_CONTEXT *cx;
if (iters++ > maxiters)
DIE(aTHX_ "Substitution loop");
rxtainted |= RX_MATCH_TAINTED(rx);
- if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+ if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
m = s;
s = orig;
- orig = rx->subbeg;
+ orig = RX_SUBBEG(rx);
s = orig + (m - s);
strend = s + (strend - m);
}
- m = rx->offs[0].start + orig;
+ m = RX_OFFS(rx)[0].start + orig;
if (doutf8 && !SvUTF8(dstr))
sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
else
sv_catpvn(dstr, s, m-s);
- s = rx->offs[0].end + orig;
+ s = RX_OFFS(rx)[0].end + orig;
if (clen)
sv_catpvn(dstr, c, clen);
if (once)
TAINT_IF(rxtainted & 1);
SPAGAIN;
- PUSHs(sv_2mortal(newSViv((I32)iters)));
+ mPUSHi((I32)iters);
(void)SvPOK_only(TARG);
if (doutf8)
TAINT_NOT;
- if (cx->blk_sub.lval & OPpENTERSUB_INARGS) {
+ if (CxLVAL(cx) & OPpENTERSUB_INARGS) {
/* We are an argument to a function or grep().
* This kind of lvalueness was legal before lvalue
* subroutines too, so be backward compatible:
}
}
}
- else if (cx->blk_sub.lval) { /* Leave it as it is if we can. */
+ else if (CxLVAL(cx)) { /* Leave it as it is if we can. */
/* Here we go for robustness, not for speed, so we change all
* the refcounts so the caller gets a live guy. Cannot set
* TEMP, so sv_2mortal is out of question. */
* stuff so that __WARN__ handlers can safely dounwind()
* if they want to
*/
- if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
+ if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION)
&& !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
sub_crush_depth(cv);
#if 0
void
Perl_sub_crush_depth(pTHX_ CV *cv)
{
+ PERL_ARGS_ASSERT_SUB_CRUSH_DEPTH;
+
if (CvANON(cv))
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
else {
void
Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
{
+ PERL_ARGS_ASSERT_VIVIFY_REF;
+
SvGETMAGIC(sv);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
const char * const name = SvPV_const(meth, namelen);
SV * const sv = *(PL_stack_base + TOPMARK + 1);
+ PERL_ARGS_ASSERT_METHOD_COMMON;
+
if (!sv)
Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
https://perl5.git.perl.org / perl5.git / blobdiff