dVAR;
dSP;
EXTEND(SP,1);
- if (PL_op->op_private & OPpLVAL_INTRO)
+ if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO))
PUSHs(save_scalar(cGVOP_gv));
else
PUSHs(GvSVn(cGVOP_gv));
SV * const temp = left;
left = right; right = temp;
}
- if (TAINTING_get && TAINT_get && !SvTAINTED(right))
+ if (TAINTING_get && UNLIKELY(TAINT_get) && !SvTAINTED(right))
TAINT_NOT;
- if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
+ if (UNLIKELY(PL_op->op_private & OPpASSIGN_CV_TO_GV)) {
+ /* *foo =\&bar */
SV * const cv = SvRV(right);
const U32 cv_type = SvTYPE(cv);
const bool is_gv = isGV_with_GP(left);
}
if (
- SvTEMP(left) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 &&
+ UNLIKELY(SvTEMP(left)) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 &&
(!isGV_with_GP(left) || SvFAKE(left)) && ckWARN(WARN_MISC)
)
Perl_warner(aTHX_
else
SvUTF8_off(TARG);
}
- else { /* $l .= $r */
- if (!SvOK(TARG)) {
+ else { /* $l .= $r and left == TARG */
+ if (!SvOK(left)) {
if (left == right && ckWARN(WARN_UNINITIALIZED)) /* $l .= $l */
report_uninit(right);
sv_setpvs(left, "");
}
- SvPV_force_nomg_nolen(left);
+ else {
+ SvPV_force_nomg_nolen(left);
+ }
lbyte = !DO_UTF8(left);
if (IN_BYTES)
- SvUTF8_off(TARG);
+ SvUTF8_off(left);
}
if (!rcopied) {
S_pushav(pTHX_ AV* const av)
{
dSP;
- const I32 maxarg = AvFILL(av) + 1;
+ const SSize_t maxarg = AvFILL(av) + 1;
EXTEND(SP, maxarg);
- if (SvRMAGICAL(av)) {
- U32 i;
- for (i=0; i < (U32)maxarg; i++) {
+ if (UNLIKELY(SvRMAGICAL(av))) {
+ PADOFFSET i;
+ for (i=0; i < (PADOFFSET)maxarg; i++) {
SV ** const svp = av_fetch(av, i, FALSE);
/* See note in pp_helem, and bug id #27839 */
SP[i+1] = svp
}
}
else {
- Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ PADOFFSET i;
+ for (i=0; i < (PADOFFSET)maxarg; i++) {
+ SV * const sv = AvARRAY(av)[i];
+ SP[i+1] = LIKELY(sv) ? sv : &PL_sv_undef;
+ }
}
SP += maxarg;
PUTBACK;
dVAR; dSP;
const bool inc =
PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC;
- if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
+ if (UNLIKELY(SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs))))
Perl_croak_no_modify();
- if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
+ if (LIKELY(!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs))
&& SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
{
SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1));
if (is_dor) {
PERL_ASYNC_CHECK();
sv = TOPs;
- if (!sv || !SvANY(sv)) {
+ if (UNLIKELY(!sv || !SvANY(sv))) {
if (op_type == OP_DOR)
--SP;
RETURNOP(cLOGOP->op_other);
else {
/* OP_DEFINED */
sv = POPs;
- if (!sv || !SvANY(sv))
+ if (UNLIKELY(!sv || !SvANY(sv)))
RETPUSHNO;
}
AV * const av = PL_op->op_type == OP_AELEMFAST_LEX
? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv);
const U32 lval = PL_op->op_flags & OPf_MOD;
- SV** const svp = av_fetch(av, PL_op->op_private, lval);
+ SV** const svp = av_fetch(av, (I8)PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
+
+ if (UNLIKELY(!svp && lval))
+ DIE(aTHX_ PL_no_aelem, (int)(I8)PL_op->op_private);
+
EXTEND(SP, 1);
if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */
mg_get(sv);
SvGETMAGIC(sv);
if (SvROK(sv)) {
- if (SvAMAGIC(sv)) {
+ if (UNLIKELY(SvAMAGIC(sv))) {
sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg);
}
sv = SvRV(sv);
- if (SvTYPE(sv) != type)
+ if (UNLIKELY(SvTYPE(sv) != type))
/* diag_listed_as: Not an ARRAY reference */
DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
- else if (PL_op->op_flags & OPf_MOD
- && PL_op->op_private & OPpLVAL_INTRO)
+ else if (UNLIKELY(PL_op->op_flags & OPf_MOD
+ && PL_op->op_private & OPpLVAL_INTRO))
Perl_croak(aTHX_ "%s", PL_no_localize_ref);
}
- else if (SvTYPE(sv) != type) {
+ else if (UNLIKELY(SvTYPE(sv) != type)) {
GV *gv;
if (!isGV_with_GP(sv)) {
SETs(sv);
RETURN;
}
- else if (PL_op->op_private & OPpMAYBE_LVSUB) {
+ else if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) {
const I32 flags = is_lvalue_sub();
if (flags && !(flags & OPpENTERSUB_INARGS)) {
if (gimme != G_ARRAY)
}
else if (gimme == G_SCALAR) {
dTARGET;
- const I32 maxarg = AvFILL(av) + 1;
+ const SSize_t maxarg = AvFILL(av) + 1;
SETi(maxarg);
}
} else {
&& (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied)))
SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
else if (gimme == G_SCALAR) {
- dTARGET;
+ dTARG;
TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));
- SPAGAIN;
SETTARG;
}
}
I32 gimme;
HV *hash;
- I32 i;
+ SSize_t i;
int magic;
U32 lval = 0;
) {
EXTEND_MORTAL(lastrelem - firstrelem + 1);
for (relem = firstrelem; relem <= lastrelem; relem++) {
- if ((sv = *relem)) {
+ if (LIKELY((sv = *relem))) {
TAINT_NOT; /* Each item is independent */
/* Dear TODO test in t/op/sort.t, I love you.
(It's relying on a panic, not a "semi-panic" from newSVsv()
and then an assertion failure below.) */
- if (SvIS_FREED(sv)) {
+ if (UNLIKELY(SvIS_FREED(sv))) {
Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p",
(void*)sv);
}
ary = NULL;
hash = NULL;
- while (lelem <= lastlelem) {
+ while (LIKELY(lelem <= lastlelem)) {
TAINT_NOT; /* Each item stands on its own, taintwise. */
sv = *lelem++;
switch (SvTYPE(sv)) {
i = 0;
while (relem <= lastrelem) { /* gobble up all the rest */
SV **didstore;
- assert(*relem);
- SvGETMAGIC(*relem); /* before newSV, in case it dies */
+ if (LIKELY(*relem))
+ SvGETMAGIC(*relem); /* before newSV, in case it dies */
sv = newSV(0);
sv_setsv_nomg(sv, *relem);
*(relem++) = sv;
}
TAINT_NOT;
}
- if (PL_delaymagic & DM_ARRAY_ISA)
+ if (UNLIKELY(PL_delaymagic & DM_ARRAY_ISA))
SvSETMAGIC(MUTABLE_SV(ary));
LEAVE;
break;
magic = SvMAGICAL(hash) != 0;
odd = ((lastrelem - firsthashrelem)&1)? 0 : 1;
- if ( odd ) {
+ if (UNLIKELY(odd)) {
do_oddball(lastrelem, firsthashrelem);
/* we have firstlelem to reuse, it's not needed anymore
*/
ENTER;
SAVEFREESV(SvREFCNT_inc_simple_NN(sv));
hv_clear(hash);
- while (relem < lastrelem+odd) { /* gobble up all the rest */
+ while (LIKELY(relem < lastrelem+odd)) { /* gobble up all the rest */
HE *didstore;
assert(*relem);
/* Copy the key if aassign is called in lvalue context,
break;
}
if (relem <= lastrelem) {
- if (
+ if (UNLIKELY(
SvTEMP(sv) && !SvSMAGICAL(sv) && SvREFCNT(sv) == 1 &&
(!isGV_with_GP(sv) || SvFAKE(sv)) && ckWARN(WARN_MISC)
- )
+ ))
Perl_warner(aTHX_
packWARN(WARN_MISC),
"Useless assignment to a temporary"
break;
}
}
- if (PL_delaymagic & ~DM_DELAY) {
+ if (UNLIKELY(PL_delaymagic & ~DM_DELAY)) {
+ int rc = 0;
/* Will be used to set PL_tainting below */
Uid_t tmp_uid = PerlProc_getuid();
Uid_t tmp_euid = PerlProc_geteuid();
if (PL_delaymagic & DM_UID) {
#ifdef HAS_SETRESUID
- (void)setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1,
+ rc = setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1,
(PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1,
(Uid_t)-1);
#else
# ifdef HAS_SETREUID
- (void)setreuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1,
+ rc = setreuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1,
(PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1);
# else
# ifdef HAS_SETRUID
if ((PL_delaymagic & DM_UID) == DM_RUID) {
- (void)setruid(PL_delaymagic_uid);
+ rc = setruid(PL_delaymagic_uid);
PL_delaymagic &= ~DM_RUID;
}
# endif /* HAS_SETRUID */
# ifdef HAS_SETEUID
if ((PL_delaymagic & DM_UID) == DM_EUID) {
- (void)seteuid(PL_delaymagic_euid);
+ rc = seteuid(PL_delaymagic_euid);
PL_delaymagic &= ~DM_EUID;
}
# endif /* HAS_SETEUID */
if (PL_delaymagic & DM_UID) {
if (PL_delaymagic_uid != PL_delaymagic_euid)
DIE(aTHX_ "No setreuid available");
- (void)PerlProc_setuid(PL_delaymagic_uid);
+ rc = PerlProc_setuid(PL_delaymagic_uid);
}
# endif /* HAS_SETREUID */
#endif /* HAS_SETRESUID */
+
+ /* XXX $> et al currently silently ignore failures */
+ PERL_UNUSED_VAR(rc);
+
tmp_uid = PerlProc_getuid();
tmp_euid = PerlProc_geteuid();
}
if (PL_delaymagic & DM_GID) {
#ifdef HAS_SETRESGID
- (void)setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1,
+ rc = setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1,
(PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1,
(Gid_t)-1);
#else
# ifdef HAS_SETREGID
- (void)setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1,
+ rc = setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1,
(PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1);
# else
# ifdef HAS_SETRGID
if ((PL_delaymagic & DM_GID) == DM_RGID) {
- (void)setrgid(PL_delaymagic_gid);
+ rc = setrgid(PL_delaymagic_gid);
PL_delaymagic &= ~DM_RGID;
}
# endif /* HAS_SETRGID */
# ifdef HAS_SETEGID
if ((PL_delaymagic & DM_GID) == DM_EGID) {
- (void)setegid(PL_delaymagic_egid);
+ rc = setegid(PL_delaymagic_egid);
PL_delaymagic &= ~DM_EGID;
}
# endif /* HAS_SETEGID */
if (PL_delaymagic & DM_GID) {
if (PL_delaymagic_gid != PL_delaymagic_egid)
DIE(aTHX_ "No setregid available");
- (void)PerlProc_setgid(PL_delaymagic_gid);
+ rc = PerlProc_setgid(PL_delaymagic_gid);
}
# endif /* HAS_SETREGID */
#endif /* HAS_SETRESGID */
+
+ /* XXX $> et al currently silently ignore failures */
+ PERL_UNUSED_VAR(rc);
+
tmp_gid = PerlProc_getgid();
tmp_egid = PerlProc_getegid();
}
SvROK_on(rv);
cvp = &( ReANY((REGEXP *)SvRV(rv))->qr_anoncv);
- if ((cv = *cvp) && CvCLONE(*cvp)) {
+ if (UNLIKELY((cv = *cvp) && CvCLONE(*cvp))) {
*cvp = cv_clone(cv);
SvREFCNT_dec_NN(cv);
}
(void)sv_bless(rv, stash);
}
- if (RX_ISTAINTED(rx)) {
+ if (UNLIKELY(RX_ISTAINTED(rx))) {
SvTAINTED_on(rv);
SvTAINTED_on(SvRV(rv));
}
PMOP *dynpm = pm;
const char *s;
const char *strend;
- I32 curpos = 0; /* initial pos() or current $+[0] */
+ SSize_t curpos = 0; /* initial pos() or current $+[0] */
I32 global;
U8 r_flags = 0;
const char *truebase; /* Start of string */
STRLEN len;
const I32 oldsave = PL_savestack_ix;
I32 had_zerolen = 0;
+ MAGIC *mg = NULL;
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
rx = PM_GETRE(pm);
}
- if (RX_MINLEN(rx) > (I32)len) {
- DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match\n"));
+ if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) {
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%"
+ UVuf" < %"IVdf")\n",
+ (UV)len, (IV)RX_MINLEN(rx)));
goto nope;
}
/* get pos() if //g */
if (global) {
- MAGIC * const mg = mg_find_mglob(TARG);
+ mg = mg_find_mglob(TARG);
if (mg && mg->mg_len >= 0) {
- curpos = mg->mg_len;
+ curpos = MgBYTEPOS(mg, TARG, truebase, len);
/* last time pos() was set, it was zero-length match */
if (mg->mg_flags & MGf_MINMATCH)
had_zerolen = 1;
s = truebase;
play_it_again:
- if (global) {
+ if (global)
s = truebase + curpos;
- }
if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase,
had_zerolen, TARG, NULL, r_flags))
goto nope;
PL_curpm = pm;
- if (dynpm->op_pmflags & PMf_ONCE) {
+ if (dynpm->op_pmflags & PMf_ONCE)
#ifdef USE_ITHREADS
SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]);
#else
dynpm->op_pmflags |= PMf_USED;
#endif
- }
if (rxtainted)
RX_MATCH_TAINTED_on(rx);
/* update pos */
if (global && (gimme != G_ARRAY || (dynpm->op_pmflags & PMf_CONTINUE))) {
- MAGIC *mg = mg_find_mglob(TARG);
- if (!mg) {
+ if (!mg)
mg = sv_magicext_mglob(TARG);
- }
- assert(RX_OFFS(rx)[0].start != -1); /* XXX get rid of next line? */
- if (RX_OFFS(rx)[0].start != -1) {
- mg->mg_len = RX_OFFS(rx)[0].end;
- if (RX_ZERO_LEN(rx))
- mg->mg_flags |= MGf_MINMATCH;
- else
- mg->mg_flags &= ~MGf_MINMATCH;
- }
+ MgBYTEPOS_set(mg, TARG, truebase, RX_OFFS(rx)[0].end);
+ if (RX_ZERO_LEN(rx))
+ mg->mg_flags |= MGf_MINMATCH;
+ else
+ mg->mg_flags &= ~MGf_MINMATCH;
}
if ((!RX_NPARENS(rx) && !global) || gimme != G_ARRAY) {
EXTEND_MORTAL(nparens + i);
for (i = !i; i <= nparens; i++) {
PUSHs(sv_newmortal());
- if ((RX_OFFS(rx)[i].start != -1) && RX_OFFS(rx)[i].end != -1 ) {
+ if (LIKELY((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;
const char * const 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)
+ if (UNLIKELY(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, i=%ld, "
"start=%ld, end=%ld, s=%p, strend=%p, len=%"UVuf,
(long) i, (long) RX_OFFS(rx)[i].start,
nope:
if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
- MAGIC* const mg = mg_find_mglob(TARG);
- if (mg)
- mg->mg_len = -1;
+ if (!mg)
+ mg = mg_find_mglob(TARG);
+ if (mg)
+ mg->mg_len = -1;
}
LEAVE_SCOPE(oldsave);
if (gimme == G_ARRAY)
if (IoFLAGS(io) & IOf_ARGV) {
if (IoFLAGS(io) & IOf_START) {
IoLINES(io) = 0;
- if (av_len(GvAVn(PL_last_in_gv)) < 0) {
+ if (av_tindex(GvAVn(PL_last_in_gv)) < 0) {
IoFLAGS(io) &= ~IOf_START;
- do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL);
+ do_open6(PL_last_in_gv, "-", 1, NULL, NULL, 0);
SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */
sv_setpvs(GvSVn(PL_last_in_gv), "-");
SvSETMAGIC(GvSV(PL_last_in_gv));
}
if (!fp) {
if ((!io || !(IoFLAGS(io) & IOf_START))
- && ckWARN2(WARN_GLOB, WARN_CLOSED))
+ && ckWARN(WARN_CLOSED)
+ && type != OP_GLOB)
{
- if (type == OP_GLOB)
- Perl_ck_warner_d(aTHX_ packWARN(WARN_GLOB),
- "glob failed (can't start child: %s)",
- Strerror(errno));
- else
- report_evil_fh(PL_last_in_gv);
+ report_evil_fh(PL_last_in_gv);
}
if (gimme == G_SCALAR) {
/* undef TARG, and push that undefined value */
}
}
for (t1 = SvPVX_const(sv); *t1; t1++)
- if (!isALPHANUMERIC(*t1) &&
- strchr("$&*(){}[]'\";\\|?<>~`", *t1))
+#ifdef __VMS
+ if (strchr("*%?", *t1))
+#else
+ if (strchr("$&*(){}[]'\";\\|?<>~`", *t1))
+#endif
break;
if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
(void)POPs; /* Unmatched wildcard? Chuck it... */
It has SvPVX of "" and SvCUR of 0, which is what we want. */
STRLEN maxlen = 0;
const char *max = SvPV_const(end, maxlen);
- if (SvNIOK(cur) || SvCUR(cur) > maxlen)
+ if (UNLIKELY(SvNIOK(cur) || SvCUR(cur) > maxlen))
RETPUSHNO;
oldsv = *itersvp;
- if (SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv)) {
+ if (LIKELY(SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv))) {
/* safe to reuse old SV */
sv_setsv(oldsv, cur);
}
case CXt_LOOP_LAZYIV: /* integer increment */
{
IV cur = cx->blk_loop.state_u.lazyiv.cur;
- if (cur > cx->blk_loop.state_u.lazyiv.end)
+ if (UNLIKELY(cur > cx->blk_loop.state_u.lazyiv.end))
RETPUSHNO;
oldsv = *itersvp;
/* don't risk potential race */
- if (SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv)) {
+ if (LIKELY(SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv))) {
/* safe to reuse old SV */
sv_setiv(oldsv, cur);
}
SvREFCNT_dec_NN(oldsv);
}
- if (cur == IV_MAX) {
+ if (UNLIKELY(cur == IV_MAX)) {
/* Handle end of range at IV_MAX */
cx->blk_loop.state_u.lazyiv.end = IV_MIN;
} else
}
if (PL_op->op_private & OPpITER_REVERSED) {
ix = --cx->blk_loop.state_u.ary.ix;
- if (ix <= (av_is_stack ? cx->blk_loop.resetsp : -1))
+ if (UNLIKELY(ix <= (av_is_stack ? cx->blk_loop.resetsp : -1)))
RETPUSHNO;
}
else {
ix = ++cx->blk_loop.state_u.ary.ix;
- if (ix > (av_is_stack ? cx->blk_oldsp : AvFILL(av)))
+ if (UNLIKELY(ix > (av_is_stack ? cx->blk_oldsp : AvFILL(av))))
RETPUSHNO;
}
- if (SvMAGICAL(av) || AvREIFY(av)) {
+ if (UNLIKELY(SvMAGICAL(av) || AvREIFY(av))) {
SV * const * const svp = av_fetch(av, ix, FALSE);
sv = svp ? *svp : NULL;
}
sv = AvARRAY(av)[ix];
}
- if (sv) {
- if (SvIS_FREED(sv)) {
+ if (LIKELY(sv)) {
+ if (UNLIKELY(SvIS_FREED(sv))) {
*itersvp = NULL;
Perl_croak(aTHX_ "Use of freed value in iteration");
}
- if (SvPADTMP(sv) && !IS_PADGV(sv))
+ if (SvPADTMP(sv)) {
+ assert(!IS_PADGV(sv));
sv = newSVsv(sv);
+ }
else {
SvTEMP_off(sv);
SvREFCNT_inc_simple_void_NN(sv);
}
}
+ else if (!av_is_stack) {
+ sv = newSVavdefelem(av, ix, 0);
+ }
else
sv = &PL_sv_undef;
- 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) = ix;
- LvTARGLEN(lv) = (STRLEN)UV_MAX;
- sv = lv;
- }
-
oldsv = *itersvp;
*itersvp = sv;
SvREFCNT_dec(oldsv);
PL_tainted will get set (via TAINT_set) if any component of the pattern
is tainted, e.g. /.*$tainted/. At the end of pattern compilation,
the RXf_TAINTED flag is set on the pattern if PL_tainted is set (via
-TAINT_get).
+TAINT_get). It will also be set if any component of the pattern matches
+based on locale-dependent behavior.
When the pattern is copied, e.g. $r = qr/..../, the SV holding the ref to
the pattern is marked as tainted. This means that subsequent usage, such
as /x$r/, will set PL_tainted using TAINT_set, and thus RXf_TAINTED,
on the new pattern too.
-At the start of execution of a pattern, the RXf_TAINTED_SEEN flag on the
-regex is cleared; during execution, locale-variant ops such as POSIXL may
-set RXf_TAINTED_SEEN.
-
RXf_TAINTED_SEEN is used post-execution by the get magic code
of $1 et al to indicate whether the returned value should be tainted.
It is the responsibility of the caller of the pattern (i.e. pp_match,
sv_force_normal_flags(TARG,0);
#endif
if (!(rpm->op_pmflags & PMf_NONDESTRUCT)
-#ifdef PERL_ANY_COW
- && !is_cow
-#endif
&& (SvREADONLY(TARG)
|| ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
|| SvTYPE(TARG) > SVt_PVLV)
&& !is_cow
#endif
&& (I32)clen <= RX_MINLENRET(rx)
- && (once || !(r_flags & REXEC_COPY_STR))
+ && ( once
+ || !(r_flags & REXEC_COPY_STR)
+ || (!SvGMAGICAL(dstr) && !(RX_EXTFLAGS(rx) & RXf_EVAL_SEEN))
+ )
&& !(RX_EXTFLAGS(rx) & RXf_NO_INPLACE_SUBST)
&& (!doutf8 || SvUTF8(TARG))
&& !(rpm->op_pmflags & PMf_NONDESTRUCT))
d = s = RX_OFFS(rx)[0].start + orig;
do {
I32 i;
- if (iters++ > maxiters)
+ if (UNLIKELY(iters++ > maxiters))
DIE(aTHX_ "Substitution loop");
- if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */
+ if (UNLIKELY(RX_MATCH_TAINTED(rx))) /* run time pattern taint, eg locale */
rxtainted |= SUBST_TAINT_PAT;
m = RX_OFFS(rx)[0].start + orig;
if ((i = m - s)) {
d += clen;
}
s = RX_OFFS(rx)[0].end + orig;
- } while (CALLREGEXEC(rx, s, strend, orig, s == m,
+ } while (CALLREGEXEC(rx, s, strend, orig,
+ s == m, /* don't match same null twice */
TARG, NULL,
- /* don't match same null twice */
REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW));
if (s != d) {
I32 i = strend - s;
}
first = TRUE;
do {
- if (iters++ > maxiters)
+ if (UNLIKELY(iters++ > maxiters))
DIE(aTHX_ "Substitution loop");
- if (RX_MATCH_TAINTED(rx))
+ if (UNLIKELY(RX_MATCH_TAINTED(rx)))
rxtainted |= SUBST_TAINT_PAT;
if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
char *old_s = s;
sv_catsv(dstr, nsv);
}
else sv_catsv(dstr, repl);
- if (SvTAINTED(repl))
+ if (UNLIKELY(SvTAINTED(repl)))
rxtainted |= SUBST_TAINT_REPL;
}
if (once)
LEAVE_with_name("grep_item"); /* exit inner scope */
/* All done yet? */
- if (PL_stack_base + *PL_markstack_ptr > SP) {
+ if (UNLIKELY(PL_stack_base + *PL_markstack_ptr > SP)) {
I32 items;
const I32 gimme = GIMME_V;
SAVEVPTR(PL_curpm);
src = PL_stack_base[*PL_markstack_ptr];
- if (SvPADTMP(src) && !IS_PADGV(src)) {
+ if (SvPADTMP(src)) {
+ assert(!IS_PADGV(src));
src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
PL_tmps_floor++;
}
TAINT_NOT;
if (gimme == G_SCALAR) {
MARK = newsp + 1;
- if (MARK <= SP) {
+ if (LIKELY(MARK <= SP)) {
if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1
&& !SvMAGICAL(TOPs)) {
PUTBACK;
LEAVE;
- cxstack_ix--;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
+ cxstack_ix--;
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
I32 gimme;
const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
- if (!sv)
+ if (UNLIKELY(!sv))
DIE(aTHX_ "Not a CODE reference");
- switch (SvTYPE(sv)) {
- /* This is overwhelming the most common case: */
- case SVt_PVGV:
- we_have_a_glob:
- if (!(cv = GvCVu((const GV *)sv))) {
- HV *stash;
- cv = sv_2cv(sv, &stash, &gv, 0);
- }
- if (!cv) {
- ENTER;
- SAVETMPS;
- goto try_autoload;
- }
- break;
- case SVt_PVLV:
- if(isGV_with_GP(sv)) goto we_have_a_glob;
- /*FALLTHROUGH*/
- default:
- if (sv == &PL_sv_yes) { /* unfound import, ignore */
- if (hasargs)
- SP = PL_stack_base + POPMARK;
- else
- (void)POPMARK;
- RETURN;
- }
- SvGETMAGIC(sv);
- if (SvROK(sv)) {
- if (SvAMAGIC(sv)) {
- sv = amagic_deref_call(sv, to_cv_amg);
- /* Don't SPAGAIN here. */
- }
- }
- else {
- const char *sym;
- STRLEN len;
- if (!SvOK(sv))
- DIE(aTHX_ PL_no_usym, "a subroutine");
- sym = SvPV_nomg_const(sv, len);
- if (PL_op->op_private & HINT_STRICT_REFS)
- DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : "");
- cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
- break;
- }
- cv = MUTABLE_CV(SvRV(sv));
- if (SvTYPE(cv) == SVt_PVCV)
- break;
- /* FALL THROUGH */
- case SVt_PVHV:
- case SVt_PVAV:
- DIE(aTHX_ "Not a CODE reference");
- /* This is the second most common case: */
- case SVt_PVCV:
- cv = MUTABLE_CV(sv);
- break;
+ /* This is overwhelmingly the most common case: */
+ if (!LIKELY(SvTYPE(sv) == SVt_PVGV && (cv = GvCVu((const GV *)sv)))) {
+ switch (SvTYPE(sv)) {
+ case SVt_PVGV:
+ we_have_a_glob:
+ if (!(cv = GvCVu((const GV *)sv))) {
+ HV *stash;
+ cv = sv_2cv(sv, &stash, &gv, 0);
+ }
+ if (!cv) {
+ ENTER;
+ SAVETMPS;
+ goto try_autoload;
+ }
+ break;
+ case SVt_PVLV:
+ if(isGV_with_GP(sv)) goto we_have_a_glob;
+ /*FALLTHROUGH*/
+ default:
+ if (sv == &PL_sv_yes) { /* unfound import, ignore */
+ if (hasargs)
+ SP = PL_stack_base + POPMARK;
+ else
+ (void)POPMARK;
+ RETURN;
+ }
+ SvGETMAGIC(sv);
+ if (SvROK(sv)) {
+ if (SvAMAGIC(sv)) {
+ sv = amagic_deref_call(sv, to_cv_amg);
+ /* Don't SPAGAIN here. */
+ }
+ }
+ else {
+ const char *sym;
+ STRLEN len;
+ if (!SvOK(sv))
+ DIE(aTHX_ PL_no_usym, "a subroutine");
+ sym = SvPV_nomg_const(sv, len);
+ if (PL_op->op_private & HINT_STRICT_REFS)
+ DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : "");
+ cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
+ break;
+ }
+ cv = MUTABLE_CV(SvRV(sv));
+ if (SvTYPE(cv) == SVt_PVCV)
+ break;
+ /* FALL THROUGH */
+ case SVt_PVHV:
+ case SVt_PVAV:
+ DIE(aTHX_ "Not a CODE reference");
+ /* This is the second most common case: */
+ case SVt_PVCV:
+ cv = MUTABLE_CV(sv);
+ break;
+ }
}
ENTER;
retry:
- if (CvCLONE(cv) && ! CvCLONED(cv))
+ if (UNLIKELY(CvCLONE(cv) && ! CvCLONED(cv)))
DIE(aTHX_ "Closure prototype called");
- if (!CvROOT(cv) && !CvXSUB(cv)) {
+ if (UNLIKELY(!CvROOT(cv) && !CvXSUB(cv))) {
GV* autogv;
SV* sub_name;
goto retry;
}
- gimme = GIMME_V;
- if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
+ if (UNLIKELY((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub)
+ && !CvNODEBUG(cv)))
+ {
Perl_get_db_sub(aTHX_ &sv, cv);
if (CvISXSUB(cv))
PL_curcopdb = PL_curcop;
if (CvLVALUE(cv)) {
/* check for lsub that handles lvalue subroutines */
- cv = GvCV(gv_HVadd(gv_fetchpvs("DB::lsub", GV_ADDMULTI, SVt_PVHV)));
+ cv = GvCV(gv_fetchpvs("DB::lsub", GV_ADDMULTI, SVt_PVCV));
/* if lsub not found then fall back to DB::sub */
if (!cv) cv = GvCV(PL_DBsub);
} else {
DIE(aTHX_ "No DB::sub routine defined");
}
+ gimme = GIMME_V;
+
if (!(CvISXSUB(cv))) {
/* This path taken at least 75% of the time */
dMARK;
- I32 items = SP - MARK;
PADLIST * const padlist = CvPADLIST(cv);
+ I32 depth;
+
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
cx->blk_sub.retop = PL_op->op_next;
- CvDEPTH(cv)++;
- if (CvDEPTH(cv) >= 2) {
+ if (UNLIKELY((depth = ++CvDEPTH(cv)) >= 2)) {
PERL_STACK_OVERFLOW_CHECK();
- pad_push(padlist, CvDEPTH(cv));
+ pad_push(padlist, depth);
}
SAVECOMPPAD();
- PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
- if (hasargs) {
+ PAD_SET_CUR_NOSAVE(padlist, depth);
+ if (LIKELY(hasargs)) {
AV *const av = MUTABLE_AV(PAD_SVl(0));
- if (AvREAL(av)) {
+ SSize_t items;
+ AV **defavp;
+
+ if (UNLIKELY(AvREAL(av))) {
/* @_ is normally not REAL--this should only ever
* happen when DB::sub() calls things that modify @_ */
av_clear(av);
AvREAL_off(av);
AvREIFY_on(av);
}
- cx->blk_sub.savearray = GvAV(PL_defgv);
- GvAV(PL_defgv) = MUTABLE_AV(SvREFCNT_inc_simple(av));
+ defavp = &GvAV(PL_defgv);
+ cx->blk_sub.savearray = *defavp;
+ *defavp = MUTABLE_AV(SvREFCNT_inc_simple_NN(av));
CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
- ++MARK;
+ items = SP - MARK;
- if (items - 1 > AvMAX(av)) {
+ if (UNLIKELY(items - 1 > AvMAX(av))) {
SV **ary = AvALLOC(av);
AvMAX(av) = items - 1;
Renew(ary, items, SV*);
AvARRAY(av) = ary;
}
- Copy(MARK,AvARRAY(av),items,SV*);
+ Copy(MARK+1,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;
MARK = AvARRAY(av);
while (items--) {
if (*MARK)
{
- if (SvPADTMP(*MARK) && !IS_PADGV(*MARK))
+ if (SvPADTMP(*MARK)) {
+ assert(!IS_PADGV(*MARK));
*MARK = sv_mortalcopy(*MARK);
+ }
SvTEMP_off(*MARK);
}
MARK++;
}
}
SAVETMPS;
- if ((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
- !CvLVALUE(cv))
+ if (UNLIKELY((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
+ !CvLVALUE(cv)))
DIE(aTHX_ "Can't modify non-lvalue subroutine call");
/* warning must come *after* we fully set up the context
* stuff so that __WARN__ handlers can safely dounwind()
* if they want to
*/
- if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION)
- && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
+ if (UNLIKELY(depth == PERL_SUB_DEPTH_WARN
+ && ckWARN(WARN_RECURSION)
+ && !(PERLDB_SUB && cv == GvCV(PL_DBsub))))
sub_crush_depth(cv);
RETURNOP(CvSTART(cv));
}
else {
- I32 markix = TOPMARK;
+ SSize_t markix = TOPMARK;
SAVETMPS;
PUTBACK;
- if (((PL_op->op_private
+ if (UNLIKELY(((PL_op->op_private
& PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub)
) & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
- !CvLVALUE(cv))
+ !CvLVALUE(cv)))
DIE(aTHX_ "Can't modify non-lvalue subroutine call");
- if (!hasargs) {
+ if (UNLIKELY(!hasargs && GvAV(PL_defgv))) {
/* Need to copy @_ to stack. Alternative may be to
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
AV * const av = GvAV(PL_defgv);
- const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */
+ const SSize_t items = AvFILL(av) + 1;
if (items) {
+ SSize_t i = 0;
+ const bool m = cBOOL(SvRMAGICAL(av));
/* Mark is at the end of the stack. */
EXTEND(SP, items);
- Copy(AvARRAY(av), SP + 1, items, SV*);
+ for (; i < items; ++i)
+ {
+ SV *sv;
+ if (m) {
+ SV ** const svp = av_fetch(av, i, 0);
+ sv = svp ? *svp : NULL;
+ }
+ else sv = AvARRAY(av)[i];
+ if (sv) SP[i+1] = sv;
+ else {
+ SP[i+1] = newSVavdefelem(av, i, 1);
+ }
+ }
SP += items;
PUTBACK ;
}
}
+ else {
+ SV **mark = PL_stack_base + markix;
+ SSize_t items = SP - mark;
+ while (items--) {
+ mark++;
+ if (*mark && SvPADTMP(*mark)) {
+ assert(!IS_PADGV(*mark));
+ *mark = sv_mortalcopy(*mark);
+ }
+ }
+ }
/* We assume first XSUB in &DB::sub is the called one. */
- if (PL_curcopdb) {
+ if (UNLIKELY(PL_curcopdb)) {
SAVEVPTR(PL_curcop);
PL_curcop = PL_curcopdb;
PL_curcopdb = NULL;
CvXSUB(cv)(aTHX_ cv);
/* Enforce some sanity in scalar context. */
- if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
- if (markix > PL_stack_sp - PL_stack_base)
- *(PL_stack_base + markix) = &PL_sv_undef;
- else
- *(PL_stack_base + markix) = *PL_stack_sp;
- PL_stack_sp = PL_stack_base + markix;
+ if (gimme == G_SCALAR) {
+ SV **svp = PL_stack_base + markix + 1;
+ if (svp != PL_stack_sp) {
+ *svp = svp > PL_stack_sp ? &PL_sv_undef : *PL_stack_sp;
+ PL_stack_sp = svp;
+ }
}
LEAVE;
return NORMAL;
IV elem = SvIV(elemsv);
AV *const av = MUTABLE_AV(POPs);
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
- const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
+ const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
bool preeminent = TRUE;
SV *sv;
- if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
+ if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)))
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Use of reference \"%"SVf"\" as array index",
SVfARG(elemsv));
- if (SvTYPE(av) != SVt_PVAV)
+ if (UNLIKELY(SvTYPE(av) != SVt_PVAV))
RETPUSHUNDEF;
- if (localizing) {
+ if (UNLIKELY(localizing)) {
MAGIC *mg;
HV *stash;
MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
}
#endif
- if (!svp || *svp == &PL_sv_undef) {
- SV* lv;
+ if (!svp || !*svp) {
+ IV len;
if (!defer)
DIE(aTHX_ PL_no_aelem, elem);
- lv = sv_newmortal();
- sv_upgrade(lv, SVt_PVLV);
- LvTYPE(lv) = 'y';
- sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
- LvTARG(lv) = SvREFCNT_inc_simple(av);
- LvTARGOFF(lv) = elem;
- LvTARGLEN(lv) = 1;
- PUSHs(lv);
+ len = av_tindex(av);
+ mPUSHs(newSVavdefelem(av,
+ /* Resolve a negative index now, unless it points before the
+ beginning of the array, in which case record it for error
+ reporting in magic_setdefelem. */
+ elem < 0 && len + elem >= 0 ? len + elem : elem,
+ 1));
RETURN;
}
- if (localizing) {
+ if (UNLIKELY(localizing)) {
if (preeminent)
save_aelem(av, elem, svp);
else
PERL_ARGS_ASSERT_METHOD_COMMON;
- if (!sv)
+ if (UNLIKELY(!sv))
undefined:
Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value",
SVfARG(meth));
https://perl5.git.perl.org / perl5.git / blobdiff