X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=eeb82c0d8245fc2e5ff7e34fdf0a3e9b5db2802a;hb=2e6a7e23333d305fb863f36ae0c2231e95e85865;hp=2d73123117c90fb5f43590e49bc64c2fbe935417;hpb=292890215fdbc36b4a0e17df565919fb3f5b8694;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 2d73123..eeb82c0 100644 --- a/pp.c +++ b/pp.c @@ -1,7 +1,7 @@ /* pp.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 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. @@ -13,6 +13,13 @@ * and no knowing what you'll find around a corner. And Elves, sir!" --Samwise */ +/* This file contains general 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. + */ + #include "EXTERN.h" #define PERL_IN_PP_C #include "perl.h" @@ -28,6 +35,14 @@ extern Pid_t getpid (void); #endif +/* + * Some BSDs and Cygwin default to POSIX math instead of IEEE. + * This switches them over to IEEE. + */ +#if defined(LIBM_LIB_VERSION) + _LIB_VERSION_TYPE _LIB_VERSION = _IEEE_; +#endif + /* variations on pp_null */ PP(pp_stub) @@ -38,11 +53,6 @@ PP(pp_stub) RETURN; } -PP(pp_scalar) -{ - return NORMAL; -} - /* Pushy stuff. */ PP(pp_padav) @@ -63,12 +73,12 @@ PP(pp_padav) } gimme = GIMME_V; if (gimme == G_ARRAY) { - I32 maxarg = AvFILL((AV*)TARG) + 1; + const I32 maxarg = AvFILL((AV*)TARG) + 1; EXTEND(SP, maxarg); if (SvMAGICAL(TARG)) { U32 i; for (i=0; i < (U32)maxarg; i++) { - SV **svp = av_fetch((AV*)TARG, i, FALSE); + SV * const * const svp = av_fetch((AV*)TARG, i, FALSE); SP[i+1] = (svp) ? *svp : &PL_sv_undef; } } @@ -78,8 +88,8 @@ PP(pp_padav) SP += maxarg; } else if (gimme == G_SCALAR) { - SV* sv = sv_newmortal(); - I32 maxarg = AvFILL((AV*)TARG) + 1; + SV* const sv = sv_newmortal(); + const I32 maxarg = AvFILL((AV*)TARG) + 1; sv_setiv(sv, maxarg); PUSHs(sv); } @@ -106,17 +116,12 @@ PP(pp_padhv) RETURNOP(do_kv()); } else if (gimme == G_SCALAR) { - SV* sv = Perl_hv_scalar(aTHX_ (HV*)TARG); + SV* const sv = Perl_hv_scalar(aTHX_ (HV*)TARG); SETs(sv); } RETURN; } -PP(pp_padany) -{ - DIE(aTHX_ "NOT IMPL LINE %d",__LINE__); -} - /* Translations. */ PP(pp_rv2gv) @@ -129,7 +134,7 @@ PP(pp_rv2gv) sv = SvRV(sv); if (SvTYPE(sv) == SVt_PVIO) { - GV *gv = (GV*) sv_newmortal(); + GV * const gv = (GV*) sv_newmortal(); gv_init(gv, 0, "", 0, 0); GvIOp(gv) = (IO *)sv; (void)SvREFCNT_inc(sv); @@ -140,9 +145,6 @@ PP(pp_rv2gv) } else { if (SvTYPE(sv) != SVt_PVGV) { - char *sym; - STRLEN len; - if (SvGMAGICAL(sv)) { mg_get(sv); if (SvROK(sv)) @@ -152,29 +154,29 @@ PP(pp_rv2gv) /* If this is a 'my' scalar and flag is set then vivify * NI-S 1999/05/07 */ + if (SvREADONLY(sv)) + Perl_croak(aTHX_ PL_no_modify); if (PL_op->op_private & OPpDEREF) { - char *name; GV *gv; if (cUNOP->op_targ) { STRLEN len; - SV *namesv = PAD_SV(cUNOP->op_targ); - name = SvPV(namesv, len); + SV * const namesv = PAD_SV(cUNOP->op_targ); + const char * const name = SvPV(namesv, len); gv = (GV*)NEWSV(0,0); gv_init(gv, CopSTASH(PL_curcop), name, len, 0); } else { - name = CopSTASHPV(PL_curcop); + const char * const name = CopSTASHPV(PL_curcop); gv = newGVgen(name); } if (SvTYPE(sv) < SVt_RV) sv_upgrade(sv, SVt_RV); - if (SvPVX(sv)) { - (void)SvOOK_off(sv); /* backoff */ - if (SvLEN(sv)) - Safefree(SvPVX(sv)); - SvLEN(sv)=SvCUR(sv)=0; + if (SvPVX_const(sv)) { + SvPV_free(sv); + SvLEN_set(sv, 0); + SvCUR_set(sv, 0); } - SvRV(sv) = (SV*)gv; + SvRV_set(sv, (SV*)gv); SvROK_on(sv); SvSETMAGIC(sv); goto wasref; @@ -186,22 +188,21 @@ PP(pp_rv2gv) report_uninit(sv); RETSETUNDEF; } - sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV); - if (!sv - && (!is_gv_magical(sym,len,0) - || !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV)))) - { + SV * const temp = (SV*)gv_fetchsv(sv, FALSE, SVt_PVGV); + if (!temp + && (!is_gv_magical_sv(sv,0) + || !(sv = (SV*)gv_fetchsv(sv, TRUE, SVt_PVGV)))) { RETSETUNDEF; } + sv = temp; } else { if (PL_op->op_private & HINT_STRICT_REFS) - DIE(aTHX_ PL_no_symref, sym, "a symbol"); - sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); + DIE(aTHX_ PL_no_symref_sv, sv, "a symbol"); + sv = (SV*)gv_fetchsv(sv, TRUE, SVt_PVGV); } } } @@ -229,8 +230,6 @@ PP(pp_rv2sv) } } else { - char *sym; - STRLEN len; gv = (GV*)sv; if (SvTYPE(gv) != SVt_PVGV) { @@ -239,33 +238,35 @@ PP(pp_rv2sv) if (SvROK(sv)) goto wasref; } + if (PL_op->op_private & HINT_STRICT_REFS) { + if (SvOK(sv)) + DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR"); + else + DIE(aTHX_ PL_no_usym, "a SCALAR"); + } if (!SvOK(sv)) { - if (PL_op->op_flags & OPf_REF || - PL_op->op_private & HINT_STRICT_REFS) + if (PL_op->op_flags & OPf_REF) DIE(aTHX_ PL_no_usym, "a SCALAR"); if (ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); RETSETUNDEF; } - sym = SvPV(sv, len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV); + gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PV); if (!gv - && (!is_gv_magical(sym,len,0) - || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV)))) + && (!is_gv_magical_sv(sv, 0) + || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PV)))) { RETSETUNDEF; } } else { - if (PL_op->op_private & HINT_STRICT_REFS) - DIE(aTHX_ PL_no_symref, sym, "a SCALAR"); - gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV); + gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PV); } } - sv = GvSV(gv); + sv = GvSVn(gv); } if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) { @@ -286,14 +287,14 @@ PP(pp_rv2sv) PP(pp_av2arylen) { dSP; - AV *av = (AV*)TOPs; - SV *sv = AvARYLEN(av); - if (!sv) { - AvARYLEN(av) = sv = NEWSV(0,0); - sv_upgrade(sv, SVt_IV); - sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0); - } - SETs(sv); + AV * const av = (AV*)TOPs; + SV ** const sv = Perl_av_arylen_p(aTHX_ (AV*)av); + if (!*sv) { + *sv = NEWSV(0,0); + sv_upgrade(*sv, SVt_PVMG); + sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0); + } + SETs(*sv); RETURN; } @@ -317,10 +318,8 @@ PP(pp_pos) RETURN; } else { - MAGIC* mg; - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { - mg = mg_find(sv, PERL_MAGIC_regex_global); + const MAGIC * const mg = mg_find(sv, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { I32 i = mg->mg_len; if (DO_UTF8(sv)) @@ -368,18 +367,17 @@ PP(pp_prototype) ret = &PL_sv_undef; if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) { - char *s = SvPVX(TOPs); + const char * const s = SvPVX_const(TOPs); if (strnEQ(s, "CORE::", 6)) { - int code; - - code = keyword(s + 6, SvCUR(TOPs) - 6); + const int code = keyword(s + 6, SvCUR(TOPs) - 6); if (code < 0) { /* Overridable. */ #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2) int i = 0, n = 0, seen_question = 0; I32 oa; char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */ - if (code == -KEY_chop || code == -KEY_chomp) + if (code == -KEY_chop || code == -KEY_chomp + || code == -KEY_exec || code == -KEY_system) goto set; while (i < MAXO) { /* The slow way. */ if (strEQ(s + 6, PL_op_name[i]) @@ -397,8 +395,6 @@ PP(pp_prototype) seen_question = 1; str[n++] = ';'; } - else if (n && str[0] == ';' && seen_question) - goto set; /* XXXX system, exec */ if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF /* But globs are already references (kinda) */ @@ -422,7 +418,7 @@ PP(pp_prototype) } cv = sv_2cv(TOPs, &stash, &gv, FALSE); if (cv && SvPOK(cv)) - ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv))); + ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv))); set: SETs(ret); RETURN; @@ -491,7 +487,7 @@ S_refto(pTHX_ SV *sv) } rv = sv_newmortal(); sv_upgrade(rv, SVt_RV); - SvRV(rv) = sv; + SvRV_set(rv, sv); SvROK_on(rv); return rv; } @@ -499,19 +495,16 @@ S_refto(pTHX_ SV *sv) PP(pp_ref) { dSP; dTARGET; - SV *sv; - char *pv; + const char *pv; + SV * const sv = POPs; - sv = POPs; - - if (sv && SvGMAGICAL(sv)) - mg_get(sv); + if (sv) + SvGETMAGIC(sv); if (!sv || !SvROK(sv)) RETPUSHNO; - sv = SvRV(sv); - pv = sv_reftype(sv,TRUE); + pv = sv_reftype(SvRV(sv),TRUE); PUSHp(pv, strlen(pv)); RETURN; } @@ -524,14 +517,14 @@ PP(pp_bless) if (MAXARG == 1) stash = CopSTASH(PL_curcop); else { - SV *ssv = POPs; + SV * const ssv = POPs; STRLEN len; - char *ptr; + const char *ptr; if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv)) Perl_croak(aTHX_ "Attempt to bless into a reference"); - ptr = SvPV(ssv,len); - if (ckWARN(WARN_MISC) && len == 0) + ptr = SvPV_const(ssv,len); + if (len == 0 && ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), "Explicit blessing to '' (assuming package main)"); stash = gv_stashpvn(ptr, len, TRUE); @@ -543,66 +536,63 @@ PP(pp_bless) PP(pp_gelem) { - GV *gv; - SV *sv; - SV *tmpRef; - char *elem; dSP; - STRLEN n_a; - sv = POPs; - elem = SvPV(sv, n_a); - gv = (GV*)POPs; - tmpRef = Nullsv; + SV *sv = POPs; + const char * const elem = SvPV_nolen_const(sv); + GV * const gv = (GV*)POPs; + SV * tmpRef = Nullsv; + sv = Nullsv; - switch (elem ? *elem : '\0') - { - case 'A': - if (strEQ(elem, "ARRAY")) - tmpRef = (SV*)GvAV(gv); - break; - case 'C': - if (strEQ(elem, "CODE")) - tmpRef = (SV*)GvCVu(gv); - break; - case 'F': - if (strEQ(elem, "FILEHANDLE")) { - /* finally deprecated in 5.8.0 */ - deprecate("*glob{FILEHANDLE}"); - tmpRef = (SV*)GvIOp(gv); + if (elem) { + /* elem will always be NUL terminated. */ + const char * const second_letter = elem + 1; + switch (*elem) { + case 'A': + if (strEQ(second_letter, "RRAY")) + tmpRef = (SV*)GvAV(gv); + break; + case 'C': + if (strEQ(second_letter, "ODE")) + tmpRef = (SV*)GvCVu(gv); + break; + case 'F': + if (strEQ(second_letter, "ILEHANDLE")) { + /* finally deprecated in 5.8.0 */ + deprecate("*glob{FILEHANDLE}"); + tmpRef = (SV*)GvIOp(gv); + } + else + if (strEQ(second_letter, "ORMAT")) + tmpRef = (SV*)GvFORM(gv); + break; + case 'G': + if (strEQ(second_letter, "LOB")) + tmpRef = (SV*)gv; + break; + case 'H': + if (strEQ(second_letter, "ASH")) + tmpRef = (SV*)GvHV(gv); + break; + case 'I': + if (*second_letter == 'O' && !elem[2]) + tmpRef = (SV*)GvIOp(gv); + break; + case 'N': + if (strEQ(second_letter, "AME")) + sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv)); + break; + case 'P': + if (strEQ(second_letter, "ACKAGE")) { + const HEK *hek = HvNAME_HEK(GvSTASH(gv)); + sv = hek ? newSVhek(hek) : newSVpvn("__ANON__", 8); + } + break; + case 'S': + if (strEQ(second_letter, "CALAR")) + tmpRef = GvSV(gv); + break; } - else - if (strEQ(elem, "FORMAT")) - tmpRef = (SV*)GvFORM(gv); - break; - case 'G': - if (strEQ(elem, "GLOB")) - tmpRef = (SV*)gv; - break; - case 'H': - if (strEQ(elem, "HASH")) - tmpRef = (SV*)GvHV(gv); - break; - case 'I': - if (strEQ(elem, "IO")) - tmpRef = (SV*)GvIOp(gv); - break; - case 'N': - if (strEQ(elem, "NAME")) - sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv)); - break; - case 'P': - if (strEQ(elem, "PACKAGE")) { - if (HvNAME(GvSTASH(gv))) - sv = newSVpv(HvNAME(GvSTASH(gv)), 0); - else - sv = newSVpv("__ANON__",0); - } - break; - case 'S': - if (strEQ(elem, "SCALAR")) - tmpRef = GvSV(gv); - break; } if (tmpRef) sv = newRV(tmpRef); @@ -645,8 +635,8 @@ PP(pp_study) if (pos > PL_maxscream) { if (PL_maxscream < 0) { PL_maxscream = pos + 80; - New(301, PL_screamfirst, 256, I32); - New(302, PL_screamnext, PL_maxscream, I32); + Newx(PL_screamfirst, 256, I32); + Newx(PL_screamnext, PL_maxscream, I32); } else { PL_maxscream = pos + pos / 4; @@ -665,7 +655,7 @@ PP(pp_study) sfirst -= 256; while (--pos >= 0) { - ch = s[pos]; + register const I32 ch = s[pos]; if (sfirst[ch] >= 0) snext[pos] = sfirst[ch] - pos; else @@ -713,7 +703,7 @@ PP(pp_chop) while (MARK < SP) do_chop(TARG, *++MARK); SP = ORIGMARK; - PUSHTARG; + XPUSHTARG; RETURN; } @@ -731,42 +721,10 @@ PP(pp_chomp) while (SP > MARK) count += do_chomp(POPs); - PUSHi(count); + XPUSHi(count); RETURN; } -PP(pp_defined) -{ - dSP; - register SV* sv; - - sv = POPs; - if (!sv || !SvANY(sv)) - RETPUSHNO; - switch (SvTYPE(sv)) { - case SVt_PVAV: - if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) - || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) - RETPUSHYES; - break; - case SVt_PVHV: - if (HvARRAY(sv) || SvGMAGICAL(sv) - || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) - RETPUSHYES; - break; - case SVt_PVCV: - if (CvROOT(sv) || CvXSUB(sv)) - RETPUSHYES; - break; - default: - if (SvGMAGICAL(sv)) - mg_get(sv); - if (SvOK(sv)) - RETPUSHYES; - } - RETPUSHNO; -} - PP(pp_undef) { dSP; @@ -793,14 +751,14 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: - if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv)) + if (cv_const_sv((CV*)sv) && ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined", CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); /* FALL THROUGH */ case SVt_PVFM: { /* let user-undef'd sub keep its identity */ - GV* gv = CvGV((CV*)sv); + GV* const gv = CvGV((CV*)sv); cv_undef((CV*)sv); CvGV((CV*)sv) = gv; } @@ -811,7 +769,7 @@ PP(pp_undef) else { GP *gp; gp_free((GV*)sv); - Newz(602, gp, 1, GP); + Newxz(gp, 1, GP); GvGP(sv) = gp_ref(gp); GvSV(sv) = NEWSV(72,0); GvLINE(sv) = CopLINE(PL_curcop); @@ -820,13 +778,12 @@ PP(pp_undef) } break; default: - if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { - (void)SvOOK_off(sv); - Safefree(SvPVX(sv)); + if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) { + SvPV_free(sv); SvPV_set(sv, Nullch); SvLEN_set(sv, 0); } - (void)SvOK_off(sv); + SvOK_off(sv); SvSETMAGIC(sv); } @@ -841,7 +798,7 @@ PP(pp_predec) if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MIN) { - --SvIVX(TOPs); + SvIV_set(TOPs, SvIVX(TOPs) - 1); SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); } else @@ -859,7 +816,7 @@ PP(pp_postinc) if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MAX) { - ++SvIVX(TOPs); + SvIV_set(TOPs, SvIVX(TOPs) + 1); SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); } else @@ -881,7 +838,7 @@ PP(pp_postdec) if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MIN) { - --SvIVX(TOPs); + SvIV_set(TOPs, SvIVX(TOPs) - 1); SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); } else @@ -905,36 +862,37 @@ PP(pp_pow) we're sure it is safe; otherwise we call pow() and try to convert to integer afterwards. */ { - SvIV_please(TOPm1s); - if (SvIOK(TOPm1s)) { - bool baseuok = SvUOK(TOPm1s); - UV baseuv; + SvIV_please(TOPs); + if (SvIOK(TOPs)) { + SvIV_please(TOPm1s); + if (SvIOK(TOPm1s)) { + UV power; + bool baseuok; + UV baseuv; - if (baseuok) { - baseuv = SvUVX(TOPm1s); - } else { - IV iv = SvIVX(TOPm1s); - if (iv >= 0) { - baseuv = iv; - baseuok = TRUE; /* effectively it's a UV now */ - } else { - baseuv = -iv; /* abs, baseuok == false records sign */ - } - } - SvIV_please(TOPs); - if (SvIOK(TOPs)) { - UV power; + if (SvUOK(TOPs)) { + power = SvUVX(TOPs); + } else { + const IV iv = SvIVX(TOPs); + if (iv >= 0) { + power = iv; + } else { + goto float_it; /* Can't do negative powers this way. */ + } + } - if (SvUOK(TOPs)) { - power = SvUVX(TOPs); - } else { - IV iv = SvIVX(TOPs); - if (iv >= 0) { - power = iv; - } else { - goto float_it; /* Can't do negative powers this way. */ - } - } + baseuok = SvUOK(TOPm1s); + if (baseuok) { + baseuv = SvUVX(TOPm1s); + } else { + const IV iv = SvIVX(TOPm1s); + if (iv >= 0) { + baseuv = iv; + baseuok = TRUE; /* effectively it's a UV now */ + } else { + baseuv = -iv; /* abs, baseuok == false records sign */ + } + } /* now we have integer ** positive integer. */ is_int = 1; @@ -950,34 +908,28 @@ PP(pp_pow) programmers to notice ** not doing what they mean. */ NV result = 1.0; NV base = baseuok ? baseuv : -(NV)baseuv; - int n = 0; - - for (; power; base *= base, n++) { - /* Do I look like I trust gcc with long longs here? - Do I hell. */ - UV bit = (UV)1 << (UV)n; - if (power & bit) { - result *= base; - /* Only bother to clear the bit if it is set. */ - power -= bit; - /* Avoid squaring base again if we're done. */ - if (power == 0) break; - } - } + + if (power & 1) { + result *= base; + } + while (power >>= 1) { + base *= base; + if (power & 1) { + result *= base; + } + } SP--; SETn( result ); SvIV_please(TOPs); RETURN; } else { register unsigned int highbit = 8 * sizeof(UV); - register unsigned int lowbit = 0; - register unsigned int diff; - bool odd_power = (bool)(power & 1); - while ((diff = (highbit - lowbit) >> 1)) { - if (baseuv & ~((1 << (lowbit + diff)) - 1)) - lowbit += diff; - else - highbit -= diff; + register unsigned int diff = 8 * sizeof(UV); + while (diff >>= 1) { + highbit -= diff; + if (baseuv >> highbit) { + highbit += diff; + } } /* we now have baseuv < 2 ** highbit */ if (power * highbit <= 8 * sizeof(UV)) { @@ -985,13 +937,14 @@ PP(pp_pow) on same algorithm as above */ register UV result = 1; register UV base = baseuv; - register int n = 0; - for (; power; base *= base, n++) { - register UV bit = (UV)1 << (UV)n; - if (power & bit) { + const bool odd_power = (bool)(power & 1); + if (odd_power) { + result *= base; + } + while (power >>= 1) { + base *= base; + if (power & 1) { result *= base; - power -= bit; - if (power == 0) break; } } SP--; @@ -1050,7 +1003,7 @@ PP(pp_multiply) if (auvok) { alow = SvUVX(TOPm1s); } else { - IV aiv = SvIVX(TOPm1s); + const IV aiv = SvIVX(TOPm1s); if (aiv >= 0) { alow = aiv; auvok = TRUE; /* effectively it's a UV now */ @@ -1061,7 +1014,7 @@ PP(pp_multiply) if (buvok) { blow = SvUVX(TOPs); } else { - IV biv = SvIVX(TOPs); + const IV biv = SvIVX(TOPs); if (biv >= 0) { blow = biv; buvok = TRUE; /* effectively it's a UV now */ @@ -1182,7 +1135,7 @@ PP(pp_divide) right = SvUVX(TOPs); } else { - IV biv = SvIVX(TOPs); + const IV biv = SvIVX(TOPs); if (biv >= 0) { right = biv; right_non_neg = TRUE; /* effectively it's a UV now */ @@ -1203,7 +1156,7 @@ PP(pp_divide) left = SvUVX(TOPm1s); } else { - IV aiv = SvIVX(TOPm1s); + const IV aiv = SvIVX(TOPm1s); if (aiv >= 0) { left = aiv; left_non_neg = TRUE; /* effectively it's a UV now */ @@ -1229,7 +1182,7 @@ PP(pp_divide) #endif ) { /* Integer division can't overflow, but it can be imprecise. */ - UV result = left / right; + const UV result = left / right; if (result * right == left) { SP--; /* result is valid */ if (left_non_neg == right_non_neg) { @@ -1278,7 +1231,7 @@ PP(pp_modulo) if (!right_neg) { right = SvUVX(POPs); } else { - IV biv = SvIVX(POPs); + const IV biv = SvIVX(POPs); if (biv >= 0) { right = biv; right_neg = FALSE; /* effectively it's a UV now */ @@ -1310,7 +1263,7 @@ PP(pp_modulo) if (!left_neg) { left = SvUVX(POPs); } else { - IV aiv = SvIVX(POPs); + const IV aiv = SvIVX(POPs); if (aiv >= 0) { left = aiv; left_neg = FALSE; /* effectively it's a UV now */ @@ -1391,19 +1344,43 @@ PP(pp_repeat) { dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); { - register IV count = POPi; - if (count < 0) - count = 0; + register IV count; + dPOPss; + SvGETMAGIC(sv); + if (SvIOKp(sv)) { + if (SvUOK(sv)) { + const UV uv = SvUV(sv); + if (uv > IV_MAX) + count = IV_MAX; /* The best we can do? */ + else + count = uv; + } else { + const IV iv = SvIV(sv); + if (iv < 0) + count = 0; + else + count = iv; + } + } + else if (SvNOKp(sv)) { + const NV nv = SvNV(sv); + if (nv < 0.0) + count = 0; + else + count = (IV)nv; + } + else + count = SvIVx(sv); if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { dMARK; - I32 items = SP - MARK; - I32 max; - static const char list_extend[] = "panic: list extend"; + static const char oom_list_extend[] = "Out of memory during list extend"; + const I32 items = SP - MARK; + const I32 max = items * count; - max = items * count; - MEM_WRAP_CHECK_1(max, SV*, list_extend); + MEM_WRAP_CHECK_1(max, SV*, oom_list_extend); + /* Did the max computation overflow? */ if (items > 0 && max > 0 && (max < items || max < count)) - Perl_croak(aTHX_ list_extend); + Perl_croak(aTHX_ oom_list_extend); MEXTEND(MARK, max); if (count > 1) { while (SP > MARK) { @@ -1445,9 +1422,11 @@ PP(pp_repeat) SP -= items; } else { /* Note: mark already snarfed by pp_list */ - SV *tmpstr = POPs; + SV * const tmpstr = POPs; STRLEN len; bool isutf; + static const char oom_string_extend[] = + "Out of memory during string extend"; SvSetSV(TARG, tmpstr); SvPV_force(TARG, len); @@ -1456,10 +1435,13 @@ PP(pp_repeat) if (count < 1) SvCUR_set(TARG, 0); else { - MEM_WRAP_CHECK_1(count, len, "panic: string extend"); - SvGROW(TARG, (count * len) + 1); + STRLEN max = (UV)count * len; + if (len > ((MEM_SIZE)~0)/count) + Perl_croak(aTHX_ oom_string_extend); + MEM_WRAP_CHECK_1(max, char, oom_string_extend); + SvGROW(TARG, max + 1); repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1); - SvCUR(TARG) *= count; + SvCUR_set(TARG, SvCUR(TARG) * count); } *SvEND(TARG) = '\0'; } @@ -1510,7 +1492,7 @@ PP(pp_subtract) if ((auvok = SvUOK(TOPm1s))) auv = SvUVX(TOPm1s); else { - register IV aiv = SvIVX(TOPm1s); + register const IV aiv = SvIVX(TOPm1s); if (aiv >= 0) { auv = aiv; auvok = 1; /* Now acting as a sign flag. */ @@ -1530,7 +1512,7 @@ PP(pp_subtract) if (buvok) buv = SvUVX(TOPs); else { - register IV biv = SvIVX(TOPs); + register const IV biv = SvIVX(TOPs); if (biv >= 0) { buv = biv; buvok = 1; @@ -1604,7 +1586,7 @@ PP(pp_left_shift) { dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { - IV shift = POPi; + const IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { IV i = TOPi; SETi(i << shift); @@ -1621,13 +1603,13 @@ PP(pp_right_shift) { dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { - IV shift = POPi; + const IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { - IV i = TOPi; + const IV i = TOPi; SETi(i >> shift); } else { - UV u = TOPu; + const UV u = TOPu; SETu(u >> shift); } RETURN; @@ -1646,16 +1628,16 @@ PP(pp_lt) bool buvok = SvUOK(TOPs); if (!auvok && !buvok) { /* ## IV < IV ## */ - IV aiv = SvIVX(TOPm1s); - IV biv = SvIVX(TOPs); + const IV aiv = SvIVX(TOPm1s); + const IV biv = SvIVX(TOPs); SP--; SETs(boolSV(aiv < biv)); RETURN; } if (auvok && buvok) { /* ## UV < UV ## */ - UV auv = SvUVX(TOPm1s); - UV buv = SvUVX(TOPs); + const UV auv = SvUVX(TOPm1s); + const UV buv = SvUVX(TOPs); SP--; SETs(boolSV(auv < buv)); @@ -1663,9 +1645,7 @@ PP(pp_lt) } if (auvok) { /* ## UV < IV ## */ UV auv; - IV biv; - - biv = SvIVX(TOPs); + const IV biv = SvIVX(TOPs); SP--; if (biv < 0) { /* As (a) is a UV, it's >=0, so it cannot be < */ @@ -1677,10 +1657,9 @@ PP(pp_lt) RETURN; } { /* ## IV < UV ## */ - IV aiv; + const IV aiv = SvIVX(TOPm1s); UV buv; - aiv = SvIVX(TOPm1s); if (aiv < 0) { /* As (b) is a UV, it's >=0, so it must be < */ SP--; @@ -1699,11 +1678,11 @@ PP(pp_lt) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { - SP--; - SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s))); - RETURN; - } + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { + SP--; + SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s))); + RETURN; + } #endif { dPOPnv; @@ -1724,16 +1703,16 @@ PP(pp_gt) bool buvok = SvUOK(TOPs); if (!auvok && !buvok) { /* ## IV > IV ## */ - IV aiv = SvIVX(TOPm1s); - IV biv = SvIVX(TOPs); - + const IV aiv = SvIVX(TOPm1s); + const IV biv = SvIVX(TOPs); + SP--; SETs(boolSV(aiv > biv)); RETURN; } if (auvok && buvok) { /* ## UV > UV ## */ - UV auv = SvUVX(TOPm1s); - UV buv = SvUVX(TOPs); + const UV auv = SvUVX(TOPm1s); + const UV buv = SvUVX(TOPs); SP--; SETs(boolSV(auv > buv)); @@ -1741,9 +1720,8 @@ PP(pp_gt) } if (auvok) { /* ## UV > IV ## */ UV auv; - IV biv; - - biv = SvIVX(TOPs); + const IV biv = SvIVX(TOPs); + SP--; if (biv < 0) { /* As (a) is a UV, it's >=0, so it must be > */ @@ -1755,10 +1733,9 @@ PP(pp_gt) RETURN; } { /* ## IV > UV ## */ - IV aiv; + const IV aiv = SvIVX(TOPm1s); UV buv; - aiv = SvIVX(TOPm1s); if (aiv < 0) { /* As (b) is a UV, it's >=0, so it cannot be > */ SP--; @@ -1777,7 +1754,7 @@ PP(pp_gt) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) > SvRV(TOPp1s))); RETURN; @@ -1802,8 +1779,8 @@ PP(pp_le) bool buvok = SvUOK(TOPs); if (!auvok && !buvok) { /* ## IV <= IV ## */ - IV aiv = SvIVX(TOPm1s); - IV biv = SvIVX(TOPs); + const IV aiv = SvIVX(TOPm1s); + const IV biv = SvIVX(TOPs); SP--; SETs(boolSV(aiv <= biv)); @@ -1819,9 +1796,8 @@ PP(pp_le) } if (auvok) { /* ## UV <= IV ## */ UV auv; - IV biv; - - biv = SvIVX(TOPs); + const IV biv = SvIVX(TOPs); + SP--; if (biv < 0) { /* As (a) is a UV, it's >=0, so a cannot be <= */ @@ -1833,10 +1809,9 @@ PP(pp_le) RETURN; } { /* ## IV <= UV ## */ - IV aiv; + const IV aiv = SvIVX(TOPm1s); UV buv; - - aiv = SvIVX(TOPm1s); + if (aiv < 0) { /* As (b) is a UV, it's >=0, so a must be <= */ SP--; @@ -1855,7 +1830,7 @@ PP(pp_le) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) <= SvRV(TOPp1s))); RETURN; @@ -1880,26 +1855,25 @@ PP(pp_ge) bool buvok = SvUOK(TOPs); if (!auvok && !buvok) { /* ## IV >= IV ## */ - IV aiv = SvIVX(TOPm1s); - IV biv = SvIVX(TOPs); - + const IV aiv = SvIVX(TOPm1s); + const IV biv = SvIVX(TOPs); + SP--; SETs(boolSV(aiv >= biv)); RETURN; } if (auvok && buvok) { /* ## UV >= UV ## */ - UV auv = SvUVX(TOPm1s); - UV buv = SvUVX(TOPs); - + const UV auv = SvUVX(TOPm1s); + const UV buv = SvUVX(TOPs); + SP--; SETs(boolSV(auv >= buv)); RETURN; } if (auvok) { /* ## UV >= IV ## */ UV auv; - IV biv; - - biv = SvIVX(TOPs); + const IV biv = SvIVX(TOPs); + SP--; if (biv < 0) { /* As (a) is a UV, it's >=0, so it must be >= */ @@ -1911,10 +1885,9 @@ PP(pp_ge) RETURN; } { /* ## IV >= UV ## */ - IV aiv; + const IV aiv = SvIVX(TOPm1s); UV buv; - - aiv = SvIVX(TOPm1s); + if (aiv < 0) { /* As (b) is a UV, it's >=0, so a cannot be >= */ SP--; @@ -1933,7 +1906,7 @@ PP(pp_ge) #ifdef PERL_PRESERVE_IVUV else #endif - if (SvROK(TOPs) && SvROK(TOPm1s)) { + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; SETs(boolSV(SvRV(TOPs) >= SvRV(TOPp1s))); RETURN; @@ -1950,7 +1923,7 @@ PP(pp_ne) { dSP; tryAMAGICbinSET(ne,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; @@ -1961,8 +1934,8 @@ PP(pp_ne) if (SvIOK(TOPs)) { SvIV_please(TOPm1s); if (SvIOK(TOPm1s)) { - bool auvok = SvUOK(TOPm1s); - bool buvok = SvUOK(TOPs); + const bool auvok = SvUOK(TOPm1s); + const bool buvok = SvUOK(TOPs); if (auvok == buvok) { /* ## IV == IV or UV == UV ## */ /* Casting IV to UV before comparison isn't going to matter @@ -1971,9 +1944,9 @@ PP(pp_ne) differ from normal zero. As I understand it. (Need to check - is negative zero implementation defined behaviour anyway?). NWC */ - UV buv = SvUVX(POPs); - UV auv = SvUVX(TOPs); - + const UV buv = SvUVX(POPs); + const UV auv = SvUVX(TOPs); + SETs(boolSV(auv != buv)); RETURN; } @@ -2019,9 +1992,9 @@ PP(pp_ncmp) { dSP; dTARGET; tryAMAGICbin(ncmp,0); #ifndef NV_PRESERVES_UV - if (SvROK(TOPs) && SvROK(TOPm1s)) { - UV right = PTR2UV(SvRV(POPs)); - UV left = PTR2UV(SvRV(TOPs)); + if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { + const UV right = PTR2UV(SvRV(POPs)); + const UV left = PTR2UV(SvRV(TOPs)); SETi((left > right) - (left < right)); RETURN; } @@ -2032,12 +2005,12 @@ PP(pp_ncmp) if (SvIOK(TOPs)) { SvIV_please(TOPm1s); if (SvIOK(TOPm1s)) { - bool leftuvok = SvUOK(TOPm1s); - bool rightuvok = SvUOK(TOPs); + const bool leftuvok = SvUOK(TOPm1s); + const bool rightuvok = SvUOK(TOPs); I32 value; if (!leftuvok && !rightuvok) { /* ## IV <=> IV ## */ - IV leftiv = SvIVX(TOPm1s); - IV rightiv = SvIVX(TOPs); + const IV leftiv = SvIVX(TOPm1s); + const IV rightiv = SvIVX(TOPs); if (leftiv > rightiv) value = 1; @@ -2046,8 +2019,8 @@ PP(pp_ncmp) else value = 0; } else if (leftuvok && rightuvok) { /* ## UV <=> UV ## */ - UV leftuv = SvUVX(TOPm1s); - UV rightuv = SvUVX(TOPs); + const UV leftuv = SvUVX(TOPm1s); + const UV rightuv = SvUVX(TOPs); if (leftuv > rightuv) value = 1; @@ -2056,15 +2029,12 @@ PP(pp_ncmp) else value = 0; } else if (leftuvok) { /* ## UV <=> IV ## */ - UV leftuv; - IV rightiv; - - rightiv = SvIVX(TOPs); + const IV rightiv = SvIVX(TOPs); if (rightiv < 0) { /* As (a) is a UV, it's >=0, so it cannot be < */ value = 1; } else { - leftuv = SvUVX(TOPm1s); + const UV leftuv = SvUVX(TOPm1s); if (leftuv > (UV)rightiv) { value = 1; } else if (leftuv < (UV)rightiv) { @@ -2074,15 +2044,12 @@ PP(pp_ncmp) } } } else { /* ## IV <=> UV ## */ - IV leftiv; - UV rightuv; - - leftiv = SvIVX(TOPm1s); + const IV leftiv = SvIVX(TOPm1s); if (leftiv < 0) { /* As (b) is a UV, it's >=0, so it must be < */ value = -1; } else { - rightuv = SvUVX(TOPs); + const UV rightuv = SvUVX(TOPs); if ((UV)leftiv > rightuv) { value = 1; } else if ((UV)leftiv < rightuv) { @@ -2125,54 +2092,40 @@ PP(pp_ncmp) } } -PP(pp_slt) +PP(pp_sle) { - dSP; tryAMAGICbinSET(slt,0); - { - dPOPTOPssrl; - int cmp = (IN_LOCALE_RUNTIME - ? sv_cmp_locale(left, right) - : sv_cmp(left, right)); - SETs(boolSV(cmp < 0)); - RETURN; - } -} + dSP; -PP(pp_sgt) -{ - dSP; tryAMAGICbinSET(sgt,0); - { - dPOPTOPssrl; - int cmp = (IN_LOCALE_RUNTIME - ? sv_cmp_locale(left, right) - : sv_cmp(left, right)); - SETs(boolSV(cmp > 0)); - RETURN; - } -} + int amg_type = sle_amg; + int multiplier = 1; + int rhs = 1; -PP(pp_sle) -{ - dSP; tryAMAGICbinSET(sle,0); - { - dPOPTOPssrl; - int cmp = (IN_LOCALE_RUNTIME - ? sv_cmp_locale(left, right) - : sv_cmp(left, right)); - SETs(boolSV(cmp <= 0)); - RETURN; + switch (PL_op->op_type) { + case OP_SLT: + amg_type = slt_amg; + /* cmp < 0 */ + rhs = 0; + break; + case OP_SGT: + amg_type = sgt_amg; + /* cmp > 0 */ + multiplier = -1; + rhs = 0; + break; + case OP_SGE: + amg_type = sge_amg; + /* cmp >= 0 */ + multiplier = -1; + break; } -} -PP(pp_sge) -{ - dSP; tryAMAGICbinSET(sge,0); + tryAMAGICbinSET_var(amg_type,0); { dPOPTOPssrl; - int cmp = (IN_LOCALE_RUNTIME + const int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); - SETs(boolSV(cmp >= 0)); + SETs(boolSV(cmp * multiplier < rhs)); RETURN; } } @@ -2202,7 +2155,7 @@ PP(pp_scmp) dSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; - int cmp = (IN_LOCALE_RUNTIME + const int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETi( cmp ); @@ -2215,15 +2168,15 @@ PP(pp_bit_and) dSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; - if (SvGMAGICAL(left)) mg_get(left); - if (SvGMAGICAL(right)) mg_get(right); + SvGETMAGIC(left); + SvGETMAGIC(right); if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = SvIV_nomg(left) & SvIV_nomg(right); + const IV i = SvIV_nomg(left) & SvIV_nomg(right); SETi(i); } else { - UV u = SvUV_nomg(left) & SvUV_nomg(right); + const UV u = SvUV_nomg(left) & SvUV_nomg(right); SETu(u); } } @@ -2240,15 +2193,15 @@ PP(pp_bit_xor) dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); { dPOPTOPssrl; - if (SvGMAGICAL(left)) mg_get(left); - if (SvGMAGICAL(right)) mg_get(right); + SvGETMAGIC(left); + SvGETMAGIC(right); if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right); + const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right); SETi(i); } else { - UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right); + const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right); SETu(u); } } @@ -2265,15 +2218,15 @@ PP(pp_bit_or) dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); { dPOPTOPssrl; - if (SvGMAGICAL(left)) mg_get(left); - if (SvGMAGICAL(right)) mg_get(right); + SvGETMAGIC(left); + SvGETMAGIC(right); if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right); + const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right); SETi(i); } else { - UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right); + const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right); SETu(u); } } @@ -2290,9 +2243,8 @@ PP(pp_negate) dSP; dTARGET; tryAMAGICun(neg); { dTOPss; - int flags = SvFLAGS(sv); - if (SvGMAGICAL(sv)) - mg_get(sv); + const int flags = SvFLAGS(sv); + SvGETMAGIC(sv); if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) { /* It's publicly an integer, or privately an integer-not-float */ oops_its_an_int: @@ -2322,7 +2274,7 @@ PP(pp_negate) SETn(-SvNV(sv)); else if (SvPOKp(sv)) { STRLEN len; - char *s = SvPV(sv, len); + const char *s = SvPV_const(sv, len); if (isIDFIRST(*s)) { sv_setpvn(TARG, "-", 1); sv_catsv(TARG, sv); @@ -2368,15 +2320,14 @@ PP(pp_complement) dSP; dTARGET; tryAMAGICun(compl); { dTOPss; - if (SvGMAGICAL(sv)) - mg_get(sv); + SvGETMAGIC(sv); if (SvNIOKp(sv)) { if (PL_op->op_private & HINT_INTEGER) { - IV i = ~SvIV_nomg(sv); + const IV i = ~SvIV_nomg(sv); SETi(i); } else { - UV u = ~SvUV_nomg(sv); + const UV u = ~SvUV_nomg(sv); SETu(u); } } @@ -2385,7 +2336,7 @@ PP(pp_complement) register I32 anum; STRLEN len; - (void)SvPV_nomg(sv,len); /* force check for uninit var */ + (void)SvPV_nomg_const(sv,len); /* force check for uninit var */ sv_setsv_nomg(TARG, sv); tmps = (U8*)SvPV_force(TARG, len); anum = len; @@ -2400,7 +2351,7 @@ PP(pp_complement) send = tmps + len; while (tmps < send) { - UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); + const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); tmps += UTF8SKIP(tmps); targlen += UNISKIP(~c); nchar++; @@ -2412,9 +2363,9 @@ PP(pp_complement) tmps -= len; if (nwide) { - Newz(0, result, targlen + 1, U8); + Newxz(result, targlen + 1, U8); while (tmps < send) { - UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); + const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); tmps += UTF8SKIP(tmps); result = uvchr_to_utf8_flags(result, ~c, UNICODE_ALLOW_ANY); } @@ -2424,9 +2375,9 @@ PP(pp_complement) SvUTF8_on(TARG); } else { - Newz(0, result, nchar + 1, U8); + Newxz(result, nchar + 1, U8); while (tmps < send) { - U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY); + const U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY); tmps += UTF8SKIP(tmps); *result++ = ~c; } @@ -2488,7 +2439,7 @@ STATIC PP(pp_i_modulo_0) { /* This is the vanilla old i_modulo. */ - dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -2505,7 +2456,7 @@ PP(pp_i_modulo_1) /* This is the i_modulo with the workaround for the _moddi3 bug * in (at least) glibc 2.2.5 (the PERL_ABS() the workaround). * See below for pp_i_modulo. */ - dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -2518,7 +2469,7 @@ PP(pp_i_modulo_1) PP(pp_i_modulo) { - dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -2526,7 +2477,7 @@ PP(pp_i_modulo) /* The assumption is to use hereafter the old vanilla version... */ PL_op->op_ppaddr = PL_ppaddr[OP_I_MODULO] = - &Perl_pp_i_modulo_0; + Perl_pp_i_modulo_0; /* .. but if we have glibc, we might have a buggy _moddi3 * (at least glicb 2.2.5 is known to have this bug), in other * words our integer modulus with negative quad as the second @@ -2677,10 +2628,8 @@ PP(pp_sin) { dSP; dTARGET; tryAMAGICun(sin); { - NV value; - value = POPn; - value = Perl_sin(value); - XPUSHn(value); + const NV value = POPn; + XPUSHn(Perl_sin(value)); RETURN; } } @@ -2689,10 +2638,8 @@ PP(pp_cos) { dSP; dTARGET; tryAMAGICun(cos); { - NV value; - value = POPn; - value = Perl_cos(value); - XPUSHn(value); + const NV value = POPn; + XPUSHn(Perl_cos(value)); RETURN; } } @@ -2734,11 +2681,7 @@ PP(pp_rand) PP(pp_srand) { dSP; - UV anum; - if (MAXARG < 1) - anum = seed(); - else - anum = POPu; + const UV anum = (MAXARG < 1) ? seed() : POPu; (void)seedDrand01((Rand_seed_t)anum); PL_srand_called = TRUE; EXTEND(SP, 1); @@ -2761,14 +2704,12 @@ PP(pp_log) { dSP; dTARGET; tryAMAGICun(log); { - NV value; - value = POPn; + const NV value = POPn; if (value <= 0.0) { SET_NUMERIC_STANDARD(); DIE(aTHX_ "Can't take log of %"NVgf, value); } - value = Perl_log(value); - XPUSHn(value); + XPUSHn(Perl_log(value)); RETURN; } } @@ -2777,14 +2718,12 @@ PP(pp_sqrt) { dSP; dTARGET; tryAMAGICun(sqrt); { - NV value; - value = POPn; + const NV value = POPn; if (value < 0.0) { SET_NUMERIC_STANDARD(); DIE(aTHX_ "Can't take sqrt of %"NVgf, value); } - value = Perl_sqrt(value); - XPUSHn(value); + XPUSHn(Perl_sqrt(value)); RETURN; } } @@ -2793,8 +2732,7 @@ PP(pp_int) { dSP; dTARGET; tryAMAGICun(int); { - NV value; - IV iv = TOPi; /* attempt to convert to IV if possible. */ + const IV iv = TOPi; /* attempt to convert to IV if possible. */ /* XXX it's arguable that compiler casting to IV might be subtly different from modf (for numbers inside (IV_MIN,UV_MAX)) in which else preferring IV has introduced a subtle behaviour change bug. OTOH @@ -2804,12 +2742,12 @@ PP(pp_int) SETu(0); else if (SvIOK(TOPs)) { if (SvIsUV(TOPs)) { - UV uv = TOPu; + const UV uv = TOPu; SETu(uv); } else SETi(iv); } else { - value = TOPn; + const NV value = TOPn; if (value >= 0.0) { if (value < (NV)UV_MAX + 0.5) { SETu(U_V(value)); @@ -2834,7 +2772,7 @@ PP(pp_abs) dSP; dTARGET; tryAMAGICun(abs); { /* This will cache the NV value if string isn't actually integer */ - IV iv = TOPi; + const IV iv = TOPi; if (!SvOK(TOPs)) SETu(0); @@ -2856,10 +2794,11 @@ PP(pp_abs) } } } else{ - NV value = TOPn; + const NV value = TOPn; if (value < 0.0) - value = -value; - SETn(value); + SETn(-value); + else + SETn(value); } } RETURN; @@ -2869,22 +2808,22 @@ PP(pp_abs) PP(pp_hex) { dSP; dTARGET; - char *tmps; + const char *tmps; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; STRLEN len; NV result_nv; UV result_uv; - SV* sv = POPs; + SV* const sv = POPs; - tmps = (SvPVx(sv, len)); + tmps = (SvPV_const(sv, len)); if (DO_UTF8(sv)) { /* If Unicode, try to downgrade * If not possible, croak. */ - SV* tsv = sv_2mortal(newSVsv(sv)); + SV* const tsv = sv_2mortal(newSVsv(sv)); SvUTF8_on(tsv); sv_utf8_downgrade(tsv, FALSE); - tmps = SvPVX(tsv); + tmps = SvPV_const(tsv, len); } result_uv = grok_hex (tmps, &len, &flags, &result_nv); if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) { @@ -2899,22 +2838,22 @@ PP(pp_hex) PP(pp_oct) { dSP; dTARGET; - char *tmps; + const char *tmps; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; STRLEN len; NV result_nv; UV result_uv; - SV* sv = POPs; + SV* const sv = POPs; - tmps = (SvPVx(sv, len)); + tmps = (SvPV_const(sv, len)); if (DO_UTF8(sv)) { /* If Unicode, try to downgrade * If not possible, croak. */ - SV* tsv = sv_2mortal(newSVsv(sv)); + SV* const tsv = sv_2mortal(newSVsv(sv)); SvUTF8_on(tsv); sv_utf8_downgrade(tsv, FALSE); - tmps = SvPVX(tsv); + tmps = SvPV_const(tsv, len); } while (*tmps && len && isSPACE(*tmps)) tmps++, len--; @@ -2941,7 +2880,7 @@ PP(pp_oct) PP(pp_length) { dSP; dTARGET; - SV *sv = TOPs; + SV * const sv = TOPs; if (DO_UTF8(sv)) SETi(sv_len_utf8(sv)); @@ -2960,13 +2899,13 @@ PP(pp_substr) I32 pos; I32 rem; I32 fail; - I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; - char *tmps; - I32 arybase = PL_curcop->cop_arybase; + const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; + const char *tmps; + const I32 arybase = PL_curcop->cop_arybase; SV *repl_sv = NULL; - char *repl = 0; + const char *repl = 0; STRLEN repl_len; - int num_args = PL_op->op_private & 7; + const int num_args = PL_op->op_private & 7; bool repl_need_utf8_upgrade = FALSE; bool repl_is_utf8 = FALSE; @@ -2975,7 +2914,7 @@ PP(pp_substr) if (num_args > 2) { if (num_args > 3) { repl_sv = POPs; - repl = SvPV(repl_sv, repl_len); + repl = SvPV_const(repl_sv, repl_len); repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv); } len = POPi; @@ -2991,7 +2930,7 @@ PP(pp_substr) else if (DO_UTF8(sv)) repl_need_utf8_upgrade = TRUE; } - tmps = SvPV(sv, curlen); + tmps = SvPV_const(sv, curlen); if (DO_UTF8(sv)) { utf8_curlen = sv_len_utf8(sv); if (utf8_curlen == curlen) @@ -3043,8 +2982,8 @@ PP(pp_substr) RETPUSHUNDEF; } else { - I32 upos = pos; - I32 urem = rem; + const I32 upos = pos; + const I32 urem = rem; if (utf8_curlen) sv_pos_u2b(sv, &pos, &rem); tmps += pos; @@ -3073,7 +3012,7 @@ PP(pp_substr) if (repl_need_utf8_upgrade) { repl_sv_copy = newSVsv(repl_sv); sv_utf8_upgrade(repl_sv_copy); - repl = SvPV(repl_sv_copy, repl_len); + repl = SvPV_const(repl_sv_copy, repl_len); repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv); } sv_insert(sv, pos, rem, repl, repl_len); @@ -3085,8 +3024,7 @@ PP(pp_substr) else if (lvalue) { /* it's an lvalue! */ if (!SvGMAGICAL(sv)) { if (SvROK(sv)) { - STRLEN n_a; - SvPV_force(sv,n_a); + SvPV_force_nolen(sv); if (ckWARN(WARN_SUBSTR)) Perl_warner(aTHX_ packWARN(WARN_SUBSTR), "Attempt to use reference as lvalue in substr"); @@ -3102,7 +3040,7 @@ PP(pp_substr) sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0); } else - (void)SvOK_off(TARG); + SvOK_off(TARG); LvTYPE(TARG) = 'x'; if (LvTARG(TARG) != sv) { @@ -3122,10 +3060,10 @@ PP(pp_substr) PP(pp_vec) { dSP; dTARGET; - register IV size = POPi; - register IV offset = POPi; - register SV *src = POPs; - I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; + register const IV size = POPi; + register const IV offset = POPi; + register SV * const src = POPs; + const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; SvTAINTED_off(TARG); /* decontaminate */ if (lvalue) { /* it's an lvalue! */ @@ -3155,12 +3093,15 @@ PP(pp_index) dSP; dTARGET; SV *big; SV *little; + SV *temp = Nullsv; I32 offset; I32 retval; - char *tmps; - char *tmps2; + const char *tmps; + const char *tmps2; STRLEN biglen; - I32 arybase = PL_curcop->cop_arybase; + const I32 arybase = PL_curcop->cop_arybase; + int big_utf8; + int little_utf8; if (MAXARG < 3) offset = 0; @@ -3168,9 +3109,31 @@ PP(pp_index) offset = POPi - arybase; little = POPs; big = POPs; - tmps = SvPV(big, biglen); - if (offset > 0 && DO_UTF8(big)) + big_utf8 = DO_UTF8(big); + little_utf8 = DO_UTF8(little); + if (big_utf8 ^ little_utf8) { + /* One needs to be upgraded. */ + SV * const bytes = little_utf8 ? big : little; + STRLEN len; + const char * const p = SvPV_const(bytes, len); + + temp = newSVpvn(p, len); + + if (PL_encoding) { + sv_recode_to_utf8(temp, PL_encoding); + } else { + sv_utf8_upgrade(temp); + } + if (little_utf8) { + big = temp; + big_utf8 = TRUE; + } else { + little = temp; + } + } + if (big_utf8 && offset > 0) sv_pos_u2b(big, &offset, 0); + tmps = SvPV_const(big, biglen); if (offset < 0) offset = 0; else if (offset > (I32)biglen) @@ -3180,8 +3143,10 @@ PP(pp_index) retval = -1; else retval = tmps2 - tmps; - if (retval > 0 && DO_UTF8(big)) + if (retval > 0 && big_utf8) sv_pos_b2u(big, &retval); + if (temp) + SvREFCNT_dec(temp); PUSHi(retval + arybase); RETURN; } @@ -3191,24 +3156,50 @@ PP(pp_rindex) dSP; dTARGET; SV *big; SV *little; + SV *temp = Nullsv; STRLEN blen; STRLEN llen; I32 offset; I32 retval; - char *tmps; - char *tmps2; - I32 arybase = PL_curcop->cop_arybase; + const char *tmps; + const char *tmps2; + const I32 arybase = PL_curcop->cop_arybase; + int big_utf8; + int little_utf8; if (MAXARG >= 3) offset = POPi; little = POPs; big = POPs; - tmps2 = SvPV(little, llen); - tmps = SvPV(big, blen); + big_utf8 = DO_UTF8(big); + little_utf8 = DO_UTF8(little); + if (big_utf8 ^ little_utf8) { + /* One needs to be upgraded. */ + SV * const bytes = little_utf8 ? big : little; + STRLEN len; + const char *p = SvPV_const(bytes, len); + + temp = newSVpvn(p, len); + + if (PL_encoding) { + sv_recode_to_utf8(temp, PL_encoding); + } else { + sv_utf8_upgrade(temp); + } + if (little_utf8) { + big = temp; + big_utf8 = TRUE; + } else { + little = temp; + } + } + tmps2 = SvPV_const(little, llen); + tmps = SvPV_const(big, blen); + if (MAXARG < 3) offset = blen; else { - if (offset > 0 && DO_UTF8(big)) + if (offset > 0 && big_utf8) sv_pos_u2b(big, &offset, 0); offset = offset - arybase + llen; } @@ -3221,8 +3212,10 @@ PP(pp_rindex) retval = -1; else retval = tmps2 - tmps; - if (retval > 0 && DO_UTF8(big)) + if (retval > 0 && big_utf8) sv_pos_b2u(big, &retval); + if (temp) + SvREFCNT_dec(temp); PUSHi(retval + arybase); RETURN; } @@ -3232,8 +3225,6 @@ PP(pp_sprintf) dSP; dMARK; dORIGMARK; dTARGET; do_sprintf(TARG, SP-MARK, MARK+1); TAINT_IF(SvTAINTED(TARG)); - if (DO_UTF8(*(MARK+1))) - SvUTF8_on(TARG); SP = ORIGMARK; PUSHTARG; RETURN; @@ -3244,7 +3235,7 @@ PP(pp_ord) dSP; dTARGET; SV *argsv = POPs; STRLEN len; - U8 *s = (U8*)SvPVx(argsv, len); + const U8 *s = (U8*)SvPV_const(argsv, len); SV *tmpsv; if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) { @@ -3254,7 +3245,7 @@ PP(pp_ord) } XPUSHu(DO_UTF8(argsv) ? - utf8n_to_uvchr(s, UTF8_MAXLEN, 0, UTF8_ALLOW_ANYUV) : + utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, UTF8_ALLOW_ANYUV) : (*s & 0xff)); RETURN; @@ -3264,14 +3255,27 @@ PP(pp_chr) { dSP; dTARGET; char *tmps; - UV value = POPu; + UV value; + + if (((SvIOK_notUV(TOPs) && SvIV(TOPs) < 0) + || + (SvNOK(TOPs) && SvNV(TOPs) < 0.0))) { + if (IN_BYTES) { + value = POPu; /* chr(-1) eq chr(0xff), etc. */ + } else { + (void) POPs; /* Ignore the argument value. */ + value = UNICODE_REPLACEMENT; + } + } else { + value = POPu; + } - (void)SvUPGRADE(TARG,SVt_PV); + SvUPGRADE(TARG,SVt_PV); if (value > 255 && !IN_BYTES) { SvGROW(TARG, (STRLEN)UNISKIP(value)+1); tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0); - SvCUR_set(TARG, tmps - SvPVX(TARG)); + SvCUR_set(TARG, tmps - SvPVX_const(TARG)); *tmps = '\0'; (void)SvPOK_only(TARG); SvUTF8_on(TARG); @@ -3305,22 +3309,21 @@ PP(pp_chr) PP(pp_crypt) { - dSP; dTARGET; #ifdef HAS_CRYPT + dSP; dTARGET; dPOPTOPssrl; - STRLEN n_a; STRLEN len; - char *tmps = SvPV(left, len); + const char *tmps = SvPV_const(left, len); if (DO_UTF8(left)) { /* If Unicode, try to downgrade. * If not possible, croak. * Yes, we made this up. */ - SV* tsv = sv_2mortal(newSVsv(left)); + SV* const tsv = sv_2mortal(newSVsv(left)); SvUTF8_on(tsv); sv_utf8_downgrade(tsv, FALSE); - tmps = SvPVX(tsv); + tmps = SvPV_const(tsv, len); } # ifdef USE_ITHREADS # ifdef HAS_CRYPT_R @@ -3341,9 +3344,9 @@ PP(pp_crypt) # endif /* HAS_CRYPT_R */ # endif /* USE_ITHREADS */ # ifdef FCRYPT - sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a))); + sv_setpv(TARG, fcrypt(tmps, SvPV_nolen_const(right))); # else - sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a))); + sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right))); # endif SETs(TARG); RETURN; @@ -3357,30 +3360,34 @@ PP(pp_ucfirst) { dSP; SV *sv = TOPs; - register U8 *s; + const U8 *s; STRLEN slen; + const int op_type = PL_op->op_type; SvGETMAGIC(sv); if (DO_UTF8(sv) && - (s = (U8*)SvPV_nomg(sv, slen)) && slen && + (s = (const U8*)SvPV_nomg_const(sv, slen)) && slen && UTF8_IS_START(*s)) { - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; + U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; STRLEN ulen; STRLEN tculen; utf8_to_uvchr(s, &ulen); - toTITLE_utf8(s, tmpbuf, &tculen); - utf8_to_uvchr(tmpbuf, 0); + if (op_type == OP_UCFIRST) { + toTITLE_utf8(s, tmpbuf, &tculen); + } else { + toLOWER_utf8(s, tmpbuf, &tculen); + } - if (!SvPADTMP(sv) || SvREADONLY(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv) || ulen != tculen) { dTARGET; /* slen is the byte length of the whole SV. * ulen is the byte length of the original Unicode character * stored as UTF-8 at s. - * tculen is the byte length of the freshly titlecased - * Unicode character stored as UTF-8 at tmpbuf. - * We first set the result to be the titlecased character, - * and then append the rest of the SV data. */ + * tculen is the byte length of the freshly titlecased (or + * lowercased) Unicode character stored as UTF-8 at tmpbuf. + * We first set the result to be the titlecased (/lowercased) + * character, and then append the rest of the SV data. */ sv_setpvn(TARG, (char*)tmpbuf, tculen); if (slen > ulen) sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); @@ -3393,6 +3400,7 @@ PP(pp_ucfirst) } } else { + U8 *s1; if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; SvUTF8_off(TARG); /* decontaminate */ @@ -3400,71 +3408,16 @@ PP(pp_ucfirst) sv = TARG; SETs(sv); } - s = (U8*)SvPV_force_nomg(sv, slen); - if (*s) { - if (IN_LOCALE_RUNTIME) { - TAINT; - SvTAINTED_on(sv); - *s = toUPPER_LC(*s); - } - else - *s = toUPPER(*s); - } - } - SvSETMAGIC(sv); - RETURN; -} - -PP(pp_lcfirst) -{ - dSP; - SV *sv = TOPs; - register U8 *s; - STRLEN slen; - - SvGETMAGIC(sv); - if (DO_UTF8(sv) && - (s = (U8*)SvPV_nomg(sv, slen)) && slen && - UTF8_IS_START(*s)) { - STRLEN ulen; - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; - U8 *tend; - UV uv; - - toLOWER_utf8(s, tmpbuf, &ulen); - uv = utf8_to_uvchr(tmpbuf, 0); - tend = uvchr_to_utf8(tmpbuf, uv); - - if (!SvPADTMP(sv) || (STRLEN)(tend - tmpbuf) != ulen || SvREADONLY(sv)) { - dTARGET; - sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf); - if (slen > ulen) - sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); - SvUTF8_on(TARG); - SETs(TARG); - } - else { - s = (U8*)SvPV_force_nomg(sv, slen); - Copy(tmpbuf, s, ulen, U8); - } - } - else { - if (!SvPADTMP(sv) || SvREADONLY(sv)) { - dTARGET; - SvUTF8_off(TARG); /* decontaminate */ - sv_setsv_nomg(TARG, sv); - sv = TARG; - SETs(sv); - } - s = (U8*)SvPV_force_nomg(sv, slen); - if (*s) { + s1 = (U8*)SvPV_force_nomg(sv, slen); + if (*s1) { if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); - *s = toLOWER_LC(*s); + *s1 = (op_type == OP_UCFIRST) + ? toUPPER_LC(*s1) : toLOWER_LC(*s1); } else - *s = toLOWER(*s); + *s1 = (op_type == OP_UCFIRST) ? toUPPER(*s1) : toLOWER(*s1); } } SvSETMAGIC(sv); @@ -3475,7 +3428,6 @@ PP(pp_uc) { dSP; SV *sv = TOPs; - register U8 *s; STRLEN len; SvGETMAGIC(sv); @@ -3483,36 +3435,52 @@ PP(pp_uc) dTARGET; STRLEN ulen; register U8 *d; - U8 *send; - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; + const U8 *s; + const U8 *send; + U8 tmpbuf[UTF8_MAXBYTES+1]; - s = (U8*)SvPV_nomg(sv,len); + s = (const U8*)SvPV_nomg_const(sv,len); if (!len) { SvUTF8_off(TARG); /* decontaminate */ sv_setpvn(TARG, "", 0); SETs(TARG); } else { - STRLEN nchar = utf8_length(s, s + len); + STRLEN min = len + 1; - (void)SvUPGRADE(TARG, SVt_PV); - SvGROW(TARG, (nchar * UTF8_MAXLEN_UCLC) + 1); + SvUPGRADE(TARG, SVt_PV); + SvGROW(TARG, min); (void)SvPOK_only(TARG); d = (U8*)SvPVX(TARG); send = s + len; while (s < send) { + STRLEN u = UTF8SKIP(s); + toUPPER_utf8(s, tmpbuf, &ulen); + if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) { + /* If the eventually required minimum size outgrows + * the available space, we need to grow. */ + const UV o = d - (U8*)SvPVX_const(TARG); + + /* If someone uppercases one million U+03B0s we + * SvGROW() one million times. Or we could try + * guessing how much to allocate without allocating + * too much. Such is life. */ + SvGROW(TARG, min); + d = (U8*)SvPVX(TARG) + o; + } Copy(tmpbuf, d, ulen, U8); d += ulen; - s += UTF8SKIP(s); + s += u; } *d = '\0'; SvUTF8_on(TARG); - SvCUR_set(TARG, d - (U8*)SvPVX(TARG)); + SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG)); SETs(TARG); } } else { + U8 *s; if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; SvUTF8_off(TARG); /* decontaminate */ @@ -3522,7 +3490,7 @@ PP(pp_uc) } s = (U8*)SvPV_force_nomg(sv, len); if (len) { - register U8 *send = s + len; + register const U8 *send = s + len; if (IN_LOCALE_RUNTIME) { TAINT; @@ -3544,34 +3512,36 @@ PP(pp_lc) { dSP; SV *sv = TOPs; - register U8 *s; STRLEN len; SvGETMAGIC(sv); if (DO_UTF8(sv)) { dTARGET; + const U8 *s; STRLEN ulen; register U8 *d; - U8 *send; - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; + const U8 *send; + U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; - s = (U8*)SvPV_nomg(sv,len); + s = (const U8*)SvPV_nomg_const(sv,len); if (!len) { SvUTF8_off(TARG); /* decontaminate */ sv_setpvn(TARG, "", 0); SETs(TARG); } else { - STRLEN nchar = utf8_length(s, s + len); + STRLEN min = len + 1; - (void)SvUPGRADE(TARG, SVt_PV); - SvGROW(TARG, (nchar * UTF8_MAXLEN_UCLC) + 1); + SvUPGRADE(TARG, SVt_PV); + SvGROW(TARG, min); (void)SvPOK_only(TARG); d = (U8*)SvPVX(TARG); send = s + len; while (s < send) { - UV uv = toLOWER_utf8(s, tmpbuf, &ulen); -#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode */ + const STRLEN u = UTF8SKIP(s); + const UV uv = toLOWER_utf8(s, tmpbuf, &ulen); + +#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode U+03A3 */ if (uv == GREEK_CAPITAL_LETTER_SIGMA) { /* * Now if the sigma is NOT followed by @@ -3585,20 +3555,35 @@ PP(pp_lc) * then it should be mapped to 0x03C2, * (GREEK SMALL LETTER FINAL SIGMA), * instead of staying 0x03A3. - * See lib/unicore/SpecCase.txt. + * "should be": in other words, + * this is not implemented yet. + * See lib/unicore/SpecialCasing.txt. */ } + if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) { + /* If the eventually required minimum size outgrows + * the available space, we need to grow. */ + const UV o = d - (U8*)SvPVX_const(TARG); + + /* If someone lowercases one million U+0130s we + * SvGROW() one million times. Or we could try + * guessing how much to allocate without allocating. + * too much. Such is life. */ + SvGROW(TARG, min); + d = (U8*)SvPVX(TARG) + o; + } Copy(tmpbuf, d, ulen, U8); d += ulen; - s += UTF8SKIP(s); + s += u; } *d = '\0'; SvUTF8_on(TARG); - SvCUR_set(TARG, d - (U8*)SvPVX(TARG)); + SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG)); SETs(TARG); } } else { + U8 *s; if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; SvUTF8_off(TARG); /* decontaminate */ @@ -3609,7 +3594,7 @@ PP(pp_lc) s = (U8*)SvPV_force_nomg(sv, len); if (len) { - register U8 *send = s + len; + register const U8 * const send = s + len; if (IN_LOCALE_RUNTIME) { TAINT; @@ -3630,14 +3615,14 @@ PP(pp_lc) PP(pp_quotemeta) { dSP; dTARGET; - SV *sv = TOPs; + SV * const sv = TOPs; STRLEN len; - register char *s = SvPV(sv,len); - register char *d; + register const char *s = SvPV_const(sv,len); SvUTF8_off(TARG); /* decontaminate */ if (len) { - (void)SvUPGRADE(TARG, SVt_PV); + register char *d; + SvUPGRADE(TARG, SVt_PV); SvGROW(TARG, (len * 2) + 1); d = SvPVX(TARG); if (DO_UTF8(sv)) { @@ -3667,7 +3652,7 @@ PP(pp_quotemeta) } } *d = '\0'; - SvCUR_set(TARG, d - SvPVX(TARG)); + SvCUR_set(TARG, d - SvPVX_const(TARG)); (void)SvPOK_only_UTF8(TARG); } else @@ -3683,17 +3668,16 @@ PP(pp_quotemeta) PP(pp_aslice) { dSP; dMARK; dORIGMARK; - register SV** svp; - register AV* av = (AV*)POPs; - register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); - I32 arybase = PL_curcop->cop_arybase; - I32 elem; + register AV* const av = (AV*)POPs; + register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); if (SvTYPE(av) == SVt_PVAV) { + const I32 arybase = PL_curcop->cop_arybase; if (lval && PL_op->op_private & OPpLVAL_INTRO) { + register SV **svp; I32 max = -1; for (svp = MARK + 1; svp <= SP; svp++) { - elem = SvIVx(*svp); + const I32 elem = SvIVx(*svp); if (elem > max) max = elem; } @@ -3701,7 +3685,8 @@ PP(pp_aslice) av_extend(av, max); } while (++MARK <= SP) { - elem = SvIVx(*MARK); + register SV **svp; + I32 elem = SvIVx(*MARK); if (elem > 0) elem -= arybase; @@ -3717,7 +3702,7 @@ PP(pp_aslice) } if (GIMME != G_ARRAY) { MARK = ORIGMARK; - *++MARK = *SP; + *++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef; SP = MARK; } RETURN; @@ -3728,9 +3713,9 @@ PP(pp_aslice) PP(pp_each) { dSP; - HV *hash = (HV*)POPs; + HV * const hash = (HV*)POPs; HE *entry; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; PUTBACK; /* might clobber stack_sp */ @@ -3739,7 +3724,7 @@ PP(pp_each) EXTEND(SP, 2); if (entry) { - SV* sv = hv_iterkeysv(entry); + SV* const sv = hv_iterkeysv(entry); PUSHs(sv); /* won't clobber stack_sp */ if (gimme == G_ARRAY) { SV *val; @@ -3756,39 +3741,26 @@ PP(pp_each) RETURN; } -PP(pp_values) -{ - return do_kv(); -} - -PP(pp_keys) -{ - return do_kv(); -} - PP(pp_delete) { dSP; - I32 gimme = GIMME_V; - I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; - SV *sv; - HV *hv; + const I32 gimme = GIMME_V; + const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; if (PL_op->op_private & OPpSLICE) { dMARK; dORIGMARK; - U32 hvtype; - hv = (HV*)POPs; - hvtype = SvTYPE(hv); + HV * const hv = (HV*)POPs; + const U32 hvtype = SvTYPE(hv); if (hvtype == SVt_PVHV) { /* hash element */ while (++MARK <= SP) { - sv = hv_delete_ent(hv, *MARK, discard, 0); + SV * const sv = hv_delete_ent(hv, *MARK, discard, 0); *MARK = sv ? sv : &PL_sv_undef; } } else if (hvtype == SVt_PVAV) { /* array element */ if (PL_op->op_flags & OPf_SPECIAL) { while (++MARK <= SP) { - sv = av_delete((AV*)hv, SvIV(*MARK), discard); + SV * const sv = av_delete((AV*)hv, SvIV(*MARK), discard); *MARK = sv ? sv : &PL_sv_undef; } } @@ -3808,7 +3780,8 @@ PP(pp_delete) } else { SV *keysv = POPs; - hv = (HV*)POPs; + HV * const hv = (HV*)POPs; + SV *sv; if (SvTYPE(hv) == SVt_PVHV) sv = hv_delete_ent(hv, keysv, discard, 0); else if (SvTYPE(hv) == SVt_PVAV) { @@ -3835,9 +3808,8 @@ PP(pp_exists) if (PL_op->op_private & OPpEXISTS_SUB) { GV *gv; - CV *cv; - SV *sv = POPs; - cv = sv_2cv(sv, &hv, &gv, FALSE); + SV * const sv = POPs; + CV * const cv = sv_2cv(sv, &hv, &gv, FALSE); if (cv) RETPUSHYES; if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv)) @@ -3865,9 +3837,9 @@ PP(pp_exists) PP(pp_hslice) { dSP; dMARK; dORIGMARK; - register HV *hv = (HV*)POPs; - register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); - bool localizing = PL_op->op_private & OPpLVAL_INTRO ? TRUE : FALSE; + register HV * const hv = (HV*)POPs; + register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); + const bool localizing = PL_op->op_private & OPpLVAL_INTRO; bool other_magic = FALSE; if (localizing) { @@ -3885,7 +3857,7 @@ PP(pp_hslice) } while (++MARK <= SP) { - SV *keysv = *MARK; + SV * const keysv = *MARK; SV **svp; HE *he; bool preeminent = FALSE; @@ -3900,15 +3872,14 @@ PP(pp_hslice) if (lval) { if (!svp || *svp == &PL_sv_undef) { - STRLEN n_a; - DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a)); + DIE(aTHX_ PL_no_helem_sv, keysv); } if (localizing) { if (preeminent) save_helem(hv, keysv, svp); else { STRLEN keylen; - char *key = SvPV(keysv, keylen); + const char *key = SvPV_const(keysv, keylen); SAVEDELETE(hv, savepvn(key,keylen), keylen); } } @@ -3917,7 +3888,7 @@ PP(pp_hslice) } if (GIMME != G_ARRAY) { MARK = ORIGMARK; - *++MARK = *SP; + *++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef; SP = MARK; } RETURN; @@ -3941,20 +3912,18 @@ PP(pp_list) PP(pp_lslice) { dSP; - SV **lastrelem = PL_stack_sp; - SV **lastlelem = PL_stack_base + POPMARK; - SV **firstlelem = PL_stack_base + POPMARK + 1; - register SV **firstrelem = lastlelem + 1; - I32 arybase = PL_curcop->cop_arybase; - I32 lval = PL_op->op_flags & OPf_MOD; - I32 is_something_there = lval; - - register I32 max = lastrelem - lastlelem; + SV ** const lastrelem = PL_stack_sp; + SV ** const lastlelem = PL_stack_base + POPMARK; + SV ** const firstlelem = PL_stack_base + POPMARK + 1; + register SV ** const firstrelem = lastlelem + 1; + const I32 arybase = PL_curcop->cop_arybase; + I32 is_something_there = PL_op->op_flags & OPf_MOD; + + register const I32 max = lastrelem - lastlelem; register SV **lelem; - register I32 ix; if (GIMME != G_ARRAY) { - ix = SvIVx(*lastlelem); + I32 ix = SvIVx(*lastlelem); if (ix < 0) ix += max; else @@ -3973,7 +3942,7 @@ PP(pp_lslice) } for (lelem = firstlelem; lelem <= lastlelem; lelem++) { - ix = SvIVx(*lelem); + I32 ix = SvIVx(*lelem); if (ix < 0) ix += max; else @@ -3996,8 +3965,8 @@ PP(pp_lslice) PP(pp_anonlist) { dSP; dMARK; dORIGMARK; - I32 items = SP - MARK; - SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); + const I32 items = SP - MARK; + SV * const av = sv_2mortal((SV*)av_make(items, MARK+1)); SP = ORIGMARK; /* av_make() might realloc stack_sp */ XPUSHs(av); RETURN; @@ -4006,11 +3975,11 @@ PP(pp_anonlist) PP(pp_anonhash) { dSP; dMARK; dORIGMARK; - HV* hv = (HV*)sv_2mortal((SV*)newHV()); + HV* const hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { - SV* key = *++MARK; - SV *val = NEWSV(46, 0); + SV * const key = *++MARK; + SV * const val = NEWSV(46, 0); if (MARK < SP) sv_setsv(val, *++MARK); else if (ckWARN(WARN_MISC)) @@ -4024,7 +3993,7 @@ PP(pp_anonhash) PP(pp_splice) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; register AV *ary = (AV*)*++MARK; register SV **src; register SV **dst; @@ -4035,9 +4004,9 @@ PP(pp_splice) I32 after; I32 diff; SV **tmparyval = 0; - MAGIC *mg; + const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied); - if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { + if (mg) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -4093,9 +4062,15 @@ PP(pp_splice) if (newlen && !AvREAL(ary) && AvREIFY(ary)) av_reify(ary); + /* make new elements SVs now: avoid problems if they're from the array */ + for (dst = MARK, i = newlen; i; i--) { + SV * const h = *dst; + *dst++ = newSVsv(h); + } + if (diff < 0) { /* shrinking the area */ if (newlen) { - New(451, tmparyval, newlen, SV*); /* so remember insertion */ + Newx(tmparyval, newlen, SV*); /* so remember insertion */ Copy(MARK, tmparyval, newlen, SV*); } @@ -4132,7 +4107,7 @@ PP(pp_splice) *dst-- = *src--; } dst = AvARRAY(ary); - SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */ + SvPV_set(ary, (char*)(AvARRAY(ary) - diff)); /* diff is negative */ AvMAX(ary) += diff; } else { @@ -4149,17 +4124,13 @@ PP(pp_splice) dst[--i] = &PL_sv_undef; if (newlen) { - for (src = tmparyval, dst = AvARRAY(ary) + offset; - newlen; newlen--) { - *dst = NEWSV(46, 0); - sv_setsv(*dst++, *src++); - } + Copy( tmparyval, AvARRAY(ary) + offset, newlen, SV* ); Safefree(tmparyval); } } else { /* no, expanding (or same) */ if (length) { - New(452, tmparyval, length, SV*); /* so remember deletion */ + Newx(tmparyval, length, SV*); /* so remember deletion */ Copy(AvARRAY(ary)+offset, tmparyval, length, SV*); } @@ -4173,7 +4144,7 @@ PP(pp_splice) dst = src - diff; Move(src, dst, offset, SV*); } - SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */ + SvPV_set(ary, (char*)(AvARRAY(ary) - diff));/* diff is positive */ AvMAX(ary) += diff; AvFILLp(ary) += diff; } @@ -4192,10 +4163,10 @@ PP(pp_splice) } } - for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) { - *dst = NEWSV(46, 0); - sv_setsv(*dst++, *src++); + if (newlen) { + Copy( MARK, AvARRAY(ary) + offset, newlen, SV* ); } + MARK = ORIGMARK + 1; if (GIMME == G_ARRAY) { /* copy return vals to stack */ if (length) { @@ -4229,12 +4200,11 @@ PP(pp_splice) PP(pp_push) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; - register SV *sv = &PL_sv_undef; - MAGIC *mg; + const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied); - if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { + if (mg) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -4242,26 +4212,27 @@ PP(pp_push) call_method("PUSH",G_SCALAR|G_DISCARD); LEAVE; SPAGAIN; + SP = ORIGMARK; + PUSHi( AvFILL(ary) + 1 ); } else { - /* Why no pre-extend of ary here ? */ for (++MARK; MARK <= SP; MARK++) { - sv = NEWSV(51, 0); + SV * const sv = NEWSV(51, 0); if (*MARK) sv_setsv(sv, *MARK); - av_push(ary, sv); + av_store(ary, AvFILLp(ary)+1, sv); } + SP = ORIGMARK; + PUSHi( AvFILLp(ary) + 1 ); } - SP = ORIGMARK; - PUSHi( AvFILL(ary) + 1 ); RETURN; } PP(pp_pop) { dSP; - AV *av = (AV*)POPs; - SV *sv = av_pop(av); + AV * const av = (AV*)POPs; + SV * const sv = av_pop(av); if (AvREAL(av)) (void)sv_2mortal(sv); PUSHs(sv); @@ -4271,8 +4242,8 @@ PP(pp_pop) PP(pp_shift) { dSP; - AV *av = (AV*)POPs; - SV *sv = av_shift(av); + AV * const av = (AV*)POPs; + SV * const sv = av_shift(av); EXTEND(SP, 1); if (!sv) RETPUSHUNDEF; @@ -4284,13 +4255,11 @@ PP(pp_shift) PP(pp_unshift) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; - register SV *sv; - register I32 i = 0; - MAGIC *mg; + const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied); - if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { + if (mg) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -4300,10 +4269,10 @@ PP(pp_unshift) SPAGAIN; } else { + register I32 i = 0; av_unshift(ary, SP - MARK); while (MARK < SP) { - sv = NEWSV(27, 0); - sv_setsv(sv, *++MARK); + SV * const sv = newSVsv(*++MARK); (void)av_store(ary, i++, sv); } } @@ -4315,13 +4284,12 @@ PP(pp_unshift) PP(pp_reverse) { dSP; dMARK; - register SV *tmp; - SV **oldsp = SP; + SV ** const oldsp = SP; if (GIMME == G_ARRAY) { MARK++; while (MARK < SP) { - tmp = *MARK; + register SV * const tmp = *MARK; *MARK++ = *SP; *SP-- = tmp; } @@ -4349,7 +4317,7 @@ PP(pp_reverse) if (len > 1) { if (DO_UTF8(TARG)) { /* first reverse each character */ U8* s = (U8*)SvPVX(TARG); - U8* send = (U8*)(s + len); + const U8* send = (U8*)(s + len); while (s < send) { if (UTF8_IS_INVARIANT(*s)) { s++; @@ -4387,30 +4355,29 @@ PP(pp_reverse) PP(pp_split) { - dSP; dTARG; + dVAR; dSP; dTARG; AV *ary; register IV limit = POPi; /* note, negative is forever */ - SV *sv = POPs; + SV * const sv = POPs; STRLEN len; - register char *s = SvPV(sv, len); - bool do_utf8 = DO_UTF8(sv); - char *strend = s + len; + register const char *s = SvPV_const(sv, len); + const bool do_utf8 = DO_UTF8(sv); + const char *strend = s + len; register PMOP *pm; register REGEXP *rx; register SV *dstr; - register char *m; + register const char *m; I32 iters = 0; - STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s); + const STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s); I32 maxiters = slen + 10; - I32 i; - char *orig; - I32 origlimit = limit; + const char *orig; + const I32 origlimit = limit; I32 realarray = 0; I32 base; - AV *oldstack = PL_curstack; - I32 gimme = GIMME_V; - I32 oldsave = PL_savestack_ix; + const I32 gimme = GIMME_V; + const I32 oldsave = PL_savestack_ix; I32 make_mortal = 1; + bool multiline = 0; MAGIC *mg = (MAGIC *) NULL; #ifdef DEBUGGING @@ -4450,14 +4417,14 @@ PP(pp_split) } else { if (!AvREAL(ary)) { + I32 i; AvREAL_on(ary); AvREIFY_off(ary); for (i = AvFILLp(ary); i >= 0; i--) AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */ } /* temporarily switch stacks */ - SWITCHSTACK(PL_curstack, ary); - PL_curstackinfo->si_stack = ary; + SAVESWITCHSTACK(PL_curstack, ary); make_mortal = 0; } } @@ -4473,9 +4440,8 @@ PP(pp_split) s++; } } - if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) { - SAVEINT(PL_multiline); - PL_multiline = pm->op_pmflags & PMf_MULTILINE; + if (pm->op_pmflags & PMf_MULTILINE) { + multiline = 1; } if (!limit) @@ -4490,8 +4456,7 @@ PP(pp_split) if (m >= strend) break; - dstr = NEWSV(30, m-s); - sv_setpvn(dstr, s, m-s); + dstr = newSVpvn(s, m-s); if (make_mortal) sv_2mortal(dstr); if (do_utf8) @@ -4505,15 +4470,14 @@ PP(pp_split) ++s; } } - else if (strEQ("^", rx->precomp)) { + else if (rx->precomp[0] == '^' && rx->precomp[1] == '\0') { while (--limit) { - /*SUPPRESS 530*/ - for (m = s; m < strend && *m != '\n'; m++) ; + for (m = s; m < strend && *m != '\n'; m++) + ; m++; if (m >= strend) break; - dstr = NEWSV(30, m-s); - sv_setpvn(dstr, s, m-s); + dstr = newSVpvn(s, m-s); if (make_mortal) sv_2mortal(dstr); if (do_utf8) @@ -4526,20 +4490,18 @@ PP(pp_split) (rx->reganch & RE_USE_INTUIT) && !rx->nparens && (rx->reganch & ROPT_CHECK_ALL) && !(rx->reganch & ROPT_ANCH)) { - int tail = (rx->reganch & RE_INTUIT_TAIL); - SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx); + const int tail = (rx->reganch & RE_INTUIT_TAIL); + SV * const csv = CALLREG_INTUIT_STRING(aTHX_ rx); len = rx->minlen; if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) { - STRLEN n_a; - char c = *SvPV(csv, n_a); + const char c = *SvPV_nolen_const(csv); while (--limit) { - /*SUPPRESS 530*/ - for (m = s; m < strend && *m != c; m++) ; + for (m = s; m < strend && *m != c; m++) + ; if (m >= strend) break; - dstr = NEWSV(30, m-s); - sv_setpvn(dstr, s, m-s); + dstr = newSVpvn(s, m-s); if (make_mortal) sv_2mortal(dstr); if (do_utf8) @@ -4554,14 +4516,11 @@ PP(pp_split) } } else { -#ifndef lint while (s < strend && --limit && (m = fbm_instr((unsigned char*)s, (unsigned char*)strend, - csv, PL_multiline ? FBMrf_MULTILINE : 0)) ) -#endif + csv, multiline ? FBMrf_MULTILINE : 0)) ) { - dstr = NEWSV(31, m-s); - sv_setpvn(dstr, s, m-s); + dstr = newSVpvn(s, m-s); if (make_mortal) sv_2mortal(dstr); if (do_utf8) @@ -4580,10 +4539,12 @@ PP(pp_split) maxiters += slen * rx->nparens; while (s < strend && --limit) { + I32 rex_return; PUTBACK; - i = CALLREGEXEC(aTHX_ rx, s, strend, orig, 1 , sv, NULL, 0); + rex_return = CALLREGEXEC(aTHX_ rx, (char*)s, (char*)strend, (char*)orig, 1 , + sv, NULL, 0); SPAGAIN; - if (i == 0) + if (rex_return == 0) break; TAINT_IF(RX_MATCH_TAINTED(rx)); if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) { @@ -4594,14 +4555,14 @@ PP(pp_split) strend = s + (strend - m); } m = rx->startp[0] + orig; - dstr = NEWSV(32, m-s); - sv_setpvn(dstr, s, m-s); + dstr = newSVpvn(s, m-s); if (make_mortal) sv_2mortal(dstr); if (do_utf8) (void)SvUTF8_on(dstr); XPUSHs(dstr); if (rx->nparens) { + I32 i; for (i = 1; i <= (I32)rx->nparens; i++) { s = rx->startp[i] + orig; m = rx->endp[i] + orig; @@ -4610,8 +4571,7 @@ PP(pp_split) parens that didn't match -- they should be set to undef, not the empty string */ if (m >= orig && s >= orig) { - dstr = NEWSV(33, m-s); - sv_setpvn(dstr, s, m-s); + dstr = newSVpvn(s, m-s); } else dstr = &PL_sv_undef; /* undef, not "" */ @@ -4626,16 +4586,14 @@ PP(pp_split) } } - LEAVE_SCOPE(oldsave); iters = (SP - PL_stack_base) - base; if (iters > maxiters) DIE(aTHX_ "Split loop"); /* keep field after final delim? */ if (s < strend || (iters && origlimit)) { - STRLEN l = strend - s; - dstr = NEWSV(34, l); - sv_setpvn(dstr, s, l); + const STRLEN l = strend - s; + dstr = newSVpvn(s, l); if (make_mortal) sv_2mortal(dstr); if (do_utf8) @@ -4652,10 +4610,11 @@ PP(pp_split) } } + PUTBACK; + LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */ + SPAGAIN; if (realarray) { if (!mg) { - SWITCHSTACK(ary, oldstack); - PL_curstackinfo->si_stack = oldstack; if (SvSMAGICAL(ary)) { PUTBACK; mg_set((SV*)ary); @@ -4675,6 +4634,7 @@ PP(pp_split) LEAVE; SPAGAIN; if (gimme == G_ARRAY) { + I32 i; /* EXTEND should not be needed - we just popped them */ EXTEND(SP, iters); for (i=0; i < iters; i++) { @@ -4709,7 +4669,19 @@ PP(pp_lock) RETURN; } -PP(pp_threadsv) + +PP(unimplemented_op) { - DIE(aTHX_ "tried to access per-thread data in non-threaded perl"); + DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op), + PL_op->op_type); } + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */