X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=1054d1df104f0b99f423ddc945d72bd8a2f28d17;hb=40996b7810cf32994b2b30ccaee4f9d870d60be0;hp=fc2b9c5925f97c73746c37ecb1983b5b40de7fff;hpb=e27ad1f20b87bf08f3461d0be498f8d4da22a576;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index fc2b9c5..1054d1d 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1,7 +1,7 @@ /* pp_hot.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -16,6 +16,19 @@ * Fire, Foes! Awake! */ +/* This file contains 'hot' pp ("push/pop") functions that + * execute the opcodes that make up a perl program. A typical pp function + * expects to find its arguments on the stack, and usually pushes its + * results onto the stack, hence the 'pp' terminology. Each OP structure + * contains a pointer to the relevant pp_foo() function. + * + * By 'hot', we mean common ops whose execution speed is critical. + * By gathering them together into a single file, we encourage + * CPU cache hits on hot code. Also it could be taken as a warning not to + * change any code in this file unless you're sure it won't affect + * performance. + */ + #include "EXTERN.h" #define PERL_IN_PP_HOT_C #include "perl.h" @@ -137,17 +150,17 @@ PP(pp_concat) bool lbyte; STRLEN rlen; char* rpv = SvPV(right, rlen); /* mg_get(right) happens here */ - bool rbyte = !SvUTF8(right), rcopied = FALSE; + bool rbyte = !DO_UTF8(right), rcopied = FALSE; if (TARG == right && right != left) { right = sv_2mortal(newSVpvn(rpv, rlen)); - rpv = SvPV(right, rlen); /* no point setting UTF8 here */ + rpv = SvPV(right, rlen); /* no point setting UTF-8 here */ rcopied = TRUE; } if (TARG != left) { lpv = SvPV(left, llen); /* mg_get(left) may happen here */ - lbyte = !SvUTF8(left); + lbyte = !DO_UTF8(left); sv_setpvn(TARG, lpv, llen); if (!lbyte) SvUTF8_on(TARG); @@ -160,7 +173,9 @@ PP(pp_concat) if (!SvOK(TARG)) sv_setpv(left, ""); lpv = SvPV_nomg(left, llen); - lbyte = !SvUTF8(left); + lbyte = !DO_UTF8(left); + if (IN_BYTES) + SvUTF8_off(TARG); } #if defined(PERL_Y2KWARN) @@ -198,7 +213,7 @@ PP(pp_padsv) if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) SAVECLEARSV(PAD_SVl(PL_op->op_targ)); - else if (PL_op->op_private & OPpDEREF) { + if (PL_op->op_private & OPpDEREF) { PUTBACK; vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF); SPAGAIN; @@ -229,7 +244,7 @@ PP(pp_eq) { dSP; tryAMAGICbinSET(eq,0); #ifndef NV_PRESERVES_UV - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s))); RETURN; @@ -295,7 +310,7 @@ PP(pp_eq) PP(pp_preinc) { dSP; - if (SvTYPE(TOPs) > SVt_PVLV) + if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV) DIE(aTHX_ PL_no_modify); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MAX) @@ -521,7 +536,8 @@ PP(pp_add) PP(pp_aelemfast) { dSP; - AV *av = GvAV(cGVOP_gv); + AV *av = PL_op->op_flags & OPf_SPECIAL ? + (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv); U32 lval = PL_op->op_flags & OPf_MOD; SV** svp = av_fetch(av, PL_op->op_private, lval); SV *sv = (svp ? *svp : &PL_sv_undef); @@ -722,7 +738,7 @@ PP(pp_rv2av) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "an ARRAY"); if (ckWARN(WARN_UNINITIALIZED)) - report_uninit(); + report_uninit(sv); if (GIMME == G_ARRAY) { (void)POPs; RETURN; @@ -775,7 +791,10 @@ PP(pp_rv2av) U32 i; for (i=0; i < (U32)maxarg; i++) { SV **svp = av_fetch(av, i, FALSE); - SP[i+1] = (svp) ? *svp : &PL_sv_undef; + /* See note in pp_helem, and bug id #27839 */ + SP[i+1] = svp + ? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp + : &PL_sv_undef; } } else { @@ -795,6 +814,7 @@ PP(pp_rv2hv) { dSP; dTOPss; HV *hv; + I32 gimme = GIMME_V; if (SvROK(sv)) { wasref: @@ -808,7 +828,7 @@ PP(pp_rv2hv) RETURN; } else if (LVRET) { - if (GIMME != G_SCALAR) + if (gimme != G_ARRAY) Perl_croak(aTHX_ "Can't return hash to lvalue scalar context"); SETs((SV*)hv); RETURN; @@ -825,7 +845,7 @@ PP(pp_rv2hv) RETURN; } else if (LVRET) { - if (GIMME == G_SCALAR) + if (gimme != G_ARRAY) Perl_croak(aTHX_ "Can't return hash to lvalue" " scalar context"); SETs((SV*)hv); @@ -849,8 +869,8 @@ PP(pp_rv2hv) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a HASH"); if (ckWARN(WARN_UNINITIALIZED)) - report_uninit(); - if (GIMME == G_ARRAY) { + report_uninit(sv); + if (gimme == G_ARRAY) { SP--; RETURN; } @@ -885,7 +905,7 @@ PP(pp_rv2hv) RETURN; } else if (LVRET) { - if (GIMME == G_SCALAR) + if (gimme != G_ARRAY) Perl_croak(aTHX_ "Can't return hash to lvalue" " scalar context"); SETs((SV*)hv); @@ -894,21 +914,16 @@ PP(pp_rv2hv) } } - if (GIMME == G_ARRAY) { /* array wanted */ + if (gimme == G_ARRAY) { /* array wanted */ *PL_stack_sp = (SV*)hv; return do_kv(); } - else { + else if (gimme == G_SCALAR) { dTARGET; - if (HvFILL(hv)) - Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf, - (IV)HvFILL(hv), (IV)HvMAX(hv) + 1); - else - sv_setiv(TARG, 0); - + TARG = Perl_hv_scalar(aTHX_ hv); SETTARG; - RETURN; } + RETURN; } STATIC void @@ -962,8 +977,12 @@ PP(pp_aassign) HV *hash; I32 i; int magic; + int duplicates = 0; + SV **firsthashrelem = 0; /* "= 0" keeps gcc 2.95 quiet */ + PL_delaymagic = DM_DELAY; /* catch simultaneous items */ + gimme = GIMME_V; /* If there's a common identifier on both sides we have to take * special care that assigning the identifier on the left doesn't @@ -1017,6 +1036,7 @@ PP(pp_aassign) hash = (HV*)sv; magic = SvMAGICAL(hash) != 0; hv_clear(hash); + firsthashrelem = relem; while (relem < lastrelem) { /* gobble up all the rest */ HE *didstore; @@ -1028,6 +1048,9 @@ PP(pp_aassign) if (*relem) sv_setsv(tmpstr,*relem); /* value */ *(relem++) = tmpstr; + if (gimme != G_VOID && hv_exists_ent(hash, sv, 0)) + /* key overwrites an existing entry */ + duplicates += 2; didstore = hv_store_ent(hash,sv,tmpstr,0); if (magic) { if (SvSMAGICAL(tmpstr)) @@ -1062,10 +1085,13 @@ PP(pp_aassign) if (PL_delaymagic & ~DM_DELAY) { if (PL_delaymagic & DM_UID) { #ifdef HAS_SETRESUID - (void)setresuid(PL_uid,PL_euid,(Uid_t)-1); + (void)setresuid((PL_delaymagic & DM_RUID) ? PL_uid : (Uid_t)-1, + (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1, + (Uid_t)-1); #else # ifdef HAS_SETREUID - (void)setreuid(PL_uid,PL_euid); + (void)setreuid((PL_delaymagic & DM_RUID) ? PL_uid : (Uid_t)-1, + (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1); # else # ifdef HAS_SETRUID if ((PL_delaymagic & DM_UID) == DM_RUID) { @@ -1075,7 +1101,7 @@ PP(pp_aassign) # endif /* HAS_SETRUID */ # ifdef HAS_SETEUID if ((PL_delaymagic & DM_UID) == DM_EUID) { - (void)seteuid(PL_uid); + (void)seteuid(PL_euid); PL_delaymagic &= ~DM_EUID; } # endif /* HAS_SETEUID */ @@ -1091,10 +1117,13 @@ PP(pp_aassign) } if (PL_delaymagic & DM_GID) { #ifdef HAS_SETRESGID - (void)setresgid(PL_gid,PL_egid,(Gid_t)-1); + (void)setresgid((PL_delaymagic & DM_RGID) ? PL_gid : (Gid_t)-1, + (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1, + (Gid_t)-1); #else # ifdef HAS_SETREGID - (void)setregid(PL_gid,PL_egid); + (void)setregid((PL_delaymagic & DM_RGID) ? PL_gid : (Gid_t)-1, + (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1); # else # ifdef HAS_SETRGID if ((PL_delaymagic & DM_GID) == DM_RGID) { @@ -1104,7 +1133,7 @@ PP(pp_aassign) # endif /* HAS_SETRGID */ # ifdef HAS_SETEGID if ((PL_delaymagic & DM_GID) == DM_EGID) { - (void)setegid(PL_gid); + (void)setegid(PL_egid); PL_delaymagic &= ~DM_EGID; } # endif /* HAS_SETEGID */ @@ -1122,17 +1151,26 @@ PP(pp_aassign) } PL_delaymagic = 0; - gimme = GIMME_V; if (gimme == G_VOID) SP = firstrelem - 1; else if (gimme == G_SCALAR) { dTARGET; SP = firstrelem; - SETi(lastrelem - firstrelem + 1); + SETi(lastrelem - firstrelem + 1 - duplicates); } else { - if (ary || hash) + if (ary) SP = lastrelem; + else if (hash) { + if (duplicates) { + /* Removes from the stack the entries which ended up as + * duplicated keys in the hash (fix for [perl #24380]) */ + Move(firsthashrelem + duplicates, + firsthashrelem, duplicates, SV**); + lastrelem -= duplicates; + } + SP = lastrelem; + } else SP = firstrelem + (lastlelem - firstlelem); lelem = firstlelem + (relem - firstrelem); @@ -1176,6 +1214,8 @@ PP(pp_match) if (PL_op->op_flags & OPf_STACKED) TARG = POPs; + else if (PL_op->op_private & OPpTARGET_MY) + GETTARGET; else { TARG = DEFSV; EXTEND(SP,1); @@ -1234,7 +1274,7 @@ PP(pp_match) if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; - if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) { SAVEINT(PL_multiline); PL_multiline = pm->op_pmflags & PMf_MULTILINE; } @@ -1293,10 +1333,10 @@ play_it_again: /*SUPPRESS 560*/ if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) { len = rx->endp[i] - rx->startp[i]; + s = rx->startp[i] + truebase; if (rx->endp[i] < 0 || rx->startp[i] < 0 || len < 0 || len > strend - s) DIE(aTHX_ "panic: pp_match start/end pointers"); - s = rx->startp[i] + truebase; sv_setpvn(*SP, s, len); if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len)) SvUTF8_on(*SP); @@ -1406,7 +1446,7 @@ yup: /* Confirmed by INTUIT */ rx->startp[0] = s - truebase; rx->endp[0] = s - truebase + rx->minlen; } - rx->nparens = rx->lastparen = 0; /* used by @- and @+ */ + rx->nparens = rx->lastparen = rx->lastcloseparen = 0; /* used by @-, @+, and $^N */ LEAVE_SCOPE(oldsave); RETPUSHYES; @@ -1497,7 +1537,7 @@ Perl_do_readline(pTHX) /* undef TARG, and push that undefined value */ if (type != OP_RCATLINE) { SV_CHECK_THINKFIRST_COW_DROP(TARG); - (void)SvOK_off(TARG); + SvOK_off(TARG); } PUSHTARG; } @@ -1541,7 +1581,9 @@ Perl_do_readline(pTHX) for (;;) { PUTBACK; if (!sv_gets(sv, fp, offset) - && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv))) + && (type == OP_GLOB + || SNARF_EOF(gimme, PL_rs, io, sv) + || PerlIO_error(fp))) { PerlIO_clearerr(fp); if (IoFLAGS(io) & IOf_ARGV) { @@ -1561,7 +1603,7 @@ Perl_do_readline(pTHX) if (gimme == G_SCALAR) { if (type != OP_RCATLINE) { SV_CHECK_THINKFIRST_COW_DROP(TARG); - (void)SvOK_off(TARG); + SvOK_off(TARG); } SPAGAIN; PUSHTARG; @@ -1593,6 +1635,17 @@ Perl_do_readline(pTHX) (void)POPs; /* Unmatched wildcard? Chuck it... */ continue; } + } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */ + U8 *s = (U8*)SvPVX(sv) + offset; + STRLEN len = SvCUR(sv) - offset; + U8 *f; + + if (ckWARN(WARN_UTF8) && + !Perl_is_utf8_string_loc(aTHX_ s, len, &f)) + /* Emulate :encoding(utf8) warning in the same case. */ + Perl_warner(aTHX_ packWARN(WARN_UTF8), + "utf8 \"\\x%02X\" does not map to Unicode", + f < (U8*)SvEND(sv) ? *f : 0); } if (gimme == G_ARRAY) { if (SvLEN(sv) - SvCUR(sv) > 20) { @@ -1784,7 +1837,7 @@ PP(pp_iter) { dSP; register PERL_CONTEXT *cx; - SV* sv; + SV *sv, *oldsv; AV* av; SV **itersvp; @@ -1800,8 +1853,8 @@ PP(pp_iter) if (cx->blk_loop.iterlval) { /* string increment */ register SV* cur = cx->blk_loop.iterlval; - STRLEN maxlen; - char *max = SvPV((SV*)av, maxlen); + STRLEN maxlen = 0; + char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : ""; if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) { /* safe to reuse old SV */ @@ -1812,8 +1865,9 @@ PP(pp_iter) /* we need a fresh SV every time so that loop body sees a * completely new SV for closures/references to work as * they used to */ - SvREFCNT_dec(*itersvp); + oldsv = *itersvp; *itersvp = newSVsv(cur); + SvREFCNT_dec(oldsv); } if (strEQ(SvPVX(cur), max)) sv_setiv(cur, 0); /* terminate next time */ @@ -1837,32 +1891,50 @@ PP(pp_iter) /* we need a fresh SV every time so that loop body sees a * completely new SV for closures/references to work as they * used to */ - SvREFCNT_dec(*itersvp); + oldsv = *itersvp; *itersvp = newSViv(cx->blk_loop.iterix++); + SvREFCNT_dec(oldsv); } RETPUSHYES; } /* iterate array */ - if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av))) - RETPUSHNO; - - SvREFCNT_dec(*itersvp); + if (PL_op->op_private & OPpITER_REVERSED) { + /* In reverse, use itermax as the min :-) */ + if (cx->blk_loop.iterix <= cx->blk_loop.itermax) + RETPUSHNO; - if (SvMAGICAL(av) || AvREIFY(av)) { - SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE); - if (svp) - sv = *svp; - else - sv = Nullsv; + if (SvMAGICAL(av) || AvREIFY(av)) { + SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE); + if (svp) + sv = *svp; + else + sv = Nullsv; + } + else { + sv = AvARRAY(av)[cx->blk_loop.iterix--]; + } } else { - sv = AvARRAY(av)[++cx->blk_loop.iterix]; + if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : + AvFILL(av))) + RETPUSHNO; + + if (SvMAGICAL(av) || AvREIFY(av)) { + SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE); + if (svp) + sv = *svp; + else + sv = Nullsv; + } + else { + sv = AvARRAY(av)[++cx->blk_loop.iterix]; + } } + if (sv && SvREFCNT(sv) == 0) { *itersvp = Nullsv; - Perl_croak(aTHX_ - "Use of freed value in iteration (perhaps you modified the iterated array within the loop?)"); + Perl_croak(aTHX_ "Use of freed value in iteration"); } if (sv) @@ -1889,7 +1961,10 @@ PP(pp_iter) sv = (SV*)lv; } + oldsv = *itersvp; *itersvp = SvREFCNT_inc(sv); + SvREFCNT_dec(oldsv); + RETPUSHYES; } @@ -1927,6 +2002,8 @@ PP(pp_subst) dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv; if (PL_op->op_flags & OPf_STACKED) TARG = POPs; + else if (PL_op->op_private & OPpTARGET_MY) + GETTARGET; else { TARG = DEFSV; EXTEND(SP,1); @@ -1945,8 +2022,8 @@ PP(pp_subst) !is_cow && #endif (SvREADONLY(TARG) - || (SvTYPE(TARG) > SVt_PVLV - && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) + || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV) + && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) DIE(aTHX_ PL_no_modify); PUTBACK; @@ -1979,7 +2056,7 @@ PP(pp_subst) ? REXEC_COPY_STR : 0; if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; - if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) { SAVEINT(PL_multiline); PL_multiline = pm->op_pmflags & PMf_MULTILINE; } @@ -2205,7 +2282,7 @@ PP(pp_subst) } else #endif { - (void)SvOOK_off(TARG); + SvOOK_off(TARG); if (SvLEN(TARG)) Safefree(SvPVX(TARG)); } @@ -2259,8 +2336,15 @@ PP(pp_grepwhile) (void)POPMARK; /* pop dst */ SP = PL_stack_base + POPMARK; /* pop original mark */ if (gimme == G_SCALAR) { - dTARGET; - XPUSHi(items); + if (PL_op->op_private & OPpGREP_LEX) { + SV* sv = sv_newmortal(); + sv_setiv(sv, items); + PUSHs(sv); + } + else { + dTARGET; + XPUSHi(items); + } } else if (gimme == G_ARRAY) SP += items; @@ -2274,7 +2358,10 @@ PP(pp_grepwhile) src = PL_stack_base[*PL_markstack_ptr]; SvTEMP_off(src); - DEFSV = src; + if (PL_op->op_private & OPpGREP_LEX) + PAD_SVl(PL_op->op_targ) = src; + else + DEFSV = src; RETURNOP(cLOGOP->op_other); } @@ -2291,6 +2378,7 @@ PP(pp_leavesub) SV *sv; POPBLOCK(cx,newpm); + cxstack_ix++; /* temporarily protect top context */ TAINT_NOT; if (gimme == G_SCALAR) { @@ -2329,11 +2417,12 @@ PP(pp_leavesub) PUTBACK; LEAVE; + cxstack_ix--; POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */ PL_curpm = newpm; /* ... and pop $1 et al */ LEAVESUB(sv); - return pop_return(); + return cx->blk_sub.retop; } /* This duplicates the above code because the above code must not @@ -2349,6 +2438,7 @@ PP(pp_leavesublv) SV *sv; POPBLOCK(cx,newpm); + cxstack_ix++; /* temporarily protect top context */ TAINT_NOT; @@ -2385,6 +2475,7 @@ PP(pp_leavesublv) * TEMP, so sv_2mortal is out of question. */ if (!CvLVALUE(cx->blk_sub.cv)) { LEAVE; + cxstack_ix--; POPSUB(cx,sv); PL_curpm = newpm; LEAVESUB(sv); @@ -2396,6 +2487,7 @@ PP(pp_leavesublv) if (MARK == SP) { if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { LEAVE; + cxstack_ix--; POPSUB(cx,sv); PL_curpm = newpm; LEAVESUB(sv); @@ -2411,6 +2503,7 @@ PP(pp_leavesublv) } else { /* Should not happen? */ LEAVE; + cxstack_ix--; POPSUB(cx,sv); PL_curpm = newpm; LEAVESUB(sv); @@ -2427,6 +2520,7 @@ PP(pp_leavesublv) /* Might be flattened array after $#array = */ PUTBACK; LEAVE; + cxstack_ix--; POPSUB(cx,sv); PL_curpm = newpm; LEAVESUB(sv); @@ -2481,11 +2575,12 @@ PP(pp_leavesublv) PUTBACK; LEAVE; + cxstack_ix--; POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */ PL_curpm = newpm; /* ... and pop $1 et al */ LEAVESUB(sv); - return pop_return(); + return cx->blk_sub.retop; } @@ -2615,18 +2710,16 @@ PP(pp_entersub) dMARK; register I32 items = SP - MARK; AV* padlist = CvPADLIST(cv); - push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_SUB, MARK); PUSHSUB(cx); + cx->blk_sub.retop = PL_op->op_next; CvDEPTH(cv)++; /* XXX This would be a natural place to set C so * that eval'' ops within this sub know the correct lexical space. * Owing the speed considerations, we choose instead to search for * the cv using find_runcv() when calling doeval(). */ - if (CvDEPTH(cv) < 2) - (void)SvREFCNT_inc(cv); - else { + if (CvDEPTH(cv) >= 2) { PERL_STACK_OVERFLOW_CHECK(); pad_push(padlist, CvDEPTH(cv), 1); } @@ -2822,6 +2915,18 @@ PP(pp_aelem) RETPUSHUNDEF; svp = av_fetch(av, elem, lval && !defer); if (lval) { +#ifdef PERL_MALLOC_WRAP + static const char oom_array_extend[] = + "Out of memory during array extend"; /* Duplicated in av.c */ + if (SvUOK(elemsv)) { + UV uv = SvUV(elemsv); + elem = uv > IV_MAX ? IV_MAX : uv; + } + else if (SvNOK(elemsv)) + elem = (IV)SvNV(elemsv); + if (elem > 0) + MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend); +#endif if (!svp || *svp == &PL_sv_undef) { SV* lv; if (!defer) @@ -2859,7 +2964,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) if (SvTYPE(sv) < SVt_RV) sv_upgrade(sv, SVt_RV); else if (SvTYPE(sv) >= SVt_PV) { - (void)SvOOK_off(sv); + SvOOK_off(sv); Safefree(SvPVX(sv)); SvLEN(sv) = SvCUR(sv) = 0; }