/* 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();
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, rx);
+ SvRV_set(rv, (SV*) rx);
SvROK_on(rv);
if (pkg) {
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;
minmatch = had_zerolen;
}
if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT &&
- DO_UTF8(TARG) == ((RX_EXTFLAGS(rx) & RXf_UTF8) != 0)) {
+ 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);
(int) SvTYPE(TARG), (void*)truebase, (void*)t,
(int)(t-truebase));
}
- rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
- RX_SUBBEG(rx) = (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(rx) = savepvn(t, strend - t);
#ifdef PERL_OLD_COPY_ON_WRITE
- rx->saved_copy = NULL;
+ RX_SAVED_COPY(rx) = NULL;
#endif
}
RX_SUBLEN(rx) = strend - t;
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;
}
TAINT_IF(rxtainted & 1);
SPAGAIN;
- PUSHs(sv_2mortal(newSViv((I32)iters)));
+ mPUSHi((I32)iters);
}
(void)SvPOK_only_UTF8(TARG);
TAINT_IF(rxtainted);
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