X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=97a5cfba8a90f8ea51dbacebcdab49aa4c6e75d1;hb=a3874608cd3bf4e33ccd66b8bb03b2aeda20af14;hp=94a278a9d9d82dc19eae040659c00c809d6cf6c3;hpb=ac53db4c3f7e2209c2c3f33df2423b5511eedd24;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 94a278a..97a5cfb 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. @@ -35,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) @@ -70,7 +78,7 @@ 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; @@ -86,7 +94,7 @@ PP(pp_padav) } else if (gimme == G_SCALAR) { SV* sv = sv_newmortal(); - I32 maxarg = AvFILL((AV*)TARG) + 1; + const I32 maxarg = AvFILL((AV*)TARG) + 1; sv_setiv(sv, maxarg); PUSHs(sv); } @@ -147,9 +155,6 @@ PP(pp_rv2gv) } else { if (SvTYPE(sv) != SVt_PVGV) { - char *sym; - STRLEN len; - if (SvGMAGICAL(sv)) { mg_get(sv); if (SvROK(sv)) @@ -162,28 +167,26 @@ PP(pp_rv2gv) 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); + const char *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 *name = CopSTASHPV(PL_curcop); gv = newGVgen(name); } if (SvTYPE(sv) < SVt_RV) sv_upgrade(sv, SVt_RV); - if (SvPVX(sv)) { - 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; @@ -195,22 +198,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 * 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); } } } @@ -238,8 +240,6 @@ PP(pp_rv2sv) } } else { - char *sym; - STRLEN len; gv = (GV*)sv; if (SvTYPE(gv) != SVt_PVGV) { @@ -256,22 +256,21 @@ PP(pp_rv2sv) 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); + DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR"); + gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PV); } } sv = GvSV(gv); @@ -296,13 +295,13 @@ 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); + SV **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); + SETs(*sv); RETURN; } @@ -377,18 +376,17 @@ PP(pp_prototype) ret = &PL_sv_undef; if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) { - char *s = SvPVX(TOPs); + const char *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]) @@ -406,8 +404,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) */ @@ -431,7 +427,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; @@ -500,7 +496,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; } @@ -509,7 +505,7 @@ PP(pp_ref) { dSP; dTARGET; SV *sv; - char *pv; + const char *pv; sv = POPs; @@ -535,7 +531,7 @@ PP(pp_bless) else { SV *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"); @@ -555,7 +551,7 @@ PP(pp_gelem) GV *gv; SV *sv; SV *tmpRef; - char *elem; + const char *elem; dSP; STRLEN n_a; @@ -564,54 +560,56 @@ PP(pp_gelem) gv = (GV*)POPs; 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 *elem2 = elem + 1; + switch (*elem) { + case 'A': + if (strEQ(elem2, "RRAY")) + tmpRef = (SV*)GvAV(gv); + break; + case 'C': + if (strEQ(elem2, "ODE")) + tmpRef = (SV*)GvCVu(gv); + break; + case 'F': + if (strEQ(elem2, "ILEHANDLE")) { + /* finally deprecated in 5.8.0 */ + deprecate("*glob{FILEHANDLE}"); + tmpRef = (SV*)GvIOp(gv); + } + else + if (strEQ(elem2, "ORMAT")) + tmpRef = (SV*)GvFORM(gv); + break; + case 'G': + if (strEQ(elem2, "LOB")) + tmpRef = (SV*)gv; + break; + case 'H': + if (strEQ(elem2, "ASH")) + tmpRef = (SV*)GvHV(gv); + break; + case 'I': + if (*elem2 == 'O' && !elem[2]) + tmpRef = (SV*)GvIOp(gv); + break; + case 'N': + if (strEQ(elem2, "AME")) + sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv)); + break; + case 'P': + if (strEQ(elem2, "ACKAGE")) { + const char *name = HvNAME_get(GvSTASH(gv)); + sv = newSVpvn(name ? name : "__ANON__", + name ? HvNAMELEN_get(GvSTASH(gv)) : 8); + } + break; + case 'S': + if (strEQ(elem2, "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); @@ -829,9 +827,8 @@ PP(pp_undef) } break; default: - if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { - 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); } @@ -850,7 +847,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 @@ -868,7 +865,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 @@ -890,7 +887,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 @@ -1494,13 +1491,13 @@ PP(pp_repeat) if (count < 1) SvCUR_set(TARG, 0); else { - IV max = count * len; + 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, (count * len) + 1); + 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'; } @@ -2529,7 +2526,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) @@ -2546,7 +2543,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) @@ -2559,7 +2556,7 @@ PP(pp_i_modulo_1) PP(pp_i_modulo) { - dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -3001,11 +2998,11 @@ 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; bool repl_need_utf8_upgrade = FALSE; @@ -3196,12 +3193,15 @@ PP(pp_index) dSP; dTARGET; SV *big; SV *little; + SV *temp = Nullsv; I32 offset; I32 retval; char *tmps; char *tmps2; STRLEN biglen; I32 arybase = PL_curcop->cop_arybase; + int big_utf8; + int little_utf8; if (MAXARG < 3) offset = 0; @@ -3209,9 +3209,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 *bytes = little_utf8 ? big : little; + STRLEN len; + char *p = SvPV(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(big, biglen); if (offset < 0) offset = 0; else if (offset > (I32)biglen) @@ -3221,8 +3243,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; } @@ -3232,6 +3256,7 @@ PP(pp_rindex) dSP; dTARGET; SV *big; SV *little; + SV *temp = Nullsv; STRLEN blen; STRLEN llen; I32 offset; @@ -3239,17 +3264,42 @@ PP(pp_rindex) char *tmps; char *tmps2; I32 arybase = PL_curcop->cop_arybase; + int big_utf8; + int little_utf8; if (MAXARG >= 3) offset = POPi; little = POPs; big = POPs; + big_utf8 = DO_UTF8(big); + little_utf8 = DO_UTF8(little); + if (big_utf8 ^ little_utf8) { + /* One needs to be upgraded. */ + SV *bytes = little_utf8 ? big : little; + STRLEN len; + char *p = SvPV(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(little, llen); tmps = SvPV(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; } @@ -3262,8 +3312,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; } @@ -3295,7 +3347,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; @@ -3346,8 +3398,8 @@ PP(pp_chr) PP(pp_crypt) { - dSP; dTARGET; #ifdef HAS_CRYPT + dSP; dTARGET; dPOPTOPssrl; STRLEN n_a; STRLEN len; @@ -3405,7 +3457,7 @@ PP(pp_ucfirst) if (DO_UTF8(sv) && (s = (U8*)SvPV_nomg(sv, slen)) && slen && UTF8_IS_START(*s)) { - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; + U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; STRLEN ulen; STRLEN tculen; @@ -3468,7 +3520,7 @@ PP(pp_lcfirst) (s = (U8*)SvPV_nomg(sv, slen)) && slen && UTF8_IS_START(*s)) { STRLEN ulen; - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; + U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; U8 *tend; UV uv; @@ -3525,7 +3577,7 @@ PP(pp_uc) STRLEN ulen; register U8 *d; U8 *send; - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; + U8 tmpbuf[UTF8_MAXBYTES+1]; s = (U8*)SvPV_nomg(sv,len); if (!len) { @@ -3534,18 +3586,32 @@ PP(pp_uc) 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); + 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. */ + UV o = d - (U8*)SvPVX(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); @@ -3594,7 +3660,7 @@ PP(pp_lc) STRLEN ulen; register U8 *d; U8 *send; - U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; + U8 tmpbuf[UTF8_MAXBYTES_CASE+1]; s = (U8*)SvPV_nomg(sv,len); if (!len) { @@ -3603,16 +3669,18 @@ PP(pp_lc) 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); + SvGROW(TARG, min); (void)SvPOK_only(TARG); d = (U8*)SvPVX(TARG); send = s + len; while (s < send) { + STRLEN u = UTF8SKIP(s); UV uv = toLOWER_utf8(s, tmpbuf, &ulen); -#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode */ + +#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode U+03A3 */ if (uv == GREEK_CAPITAL_LETTER_SIGMA) { /* * Now if the sigma is NOT followed by @@ -3626,12 +3694,26 @@ 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. */ + UV o = d - (U8*)SvPVX(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); @@ -3771,7 +3853,7 @@ PP(pp_each) dSP; HV *hash = (HV*)POPs; HE *entry; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; PUTBACK; /* might clobber stack_sp */ @@ -3810,8 +3892,8 @@ PP(pp_keys) PP(pp_delete) { dSP; - I32 gimme = GIMME_V; - I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; + const I32 gimme = GIMME_V; + const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; SV *sv; HV *hv; @@ -3941,8 +4023,7 @@ 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) @@ -4065,7 +4146,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; @@ -4137,8 +4218,7 @@ PP(pp_splice) /* make new elements SVs now: avoid problems if they're from the array */ for (dst = MARK, i = newlen; i; i--) { SV *h = *dst; - *dst = NEWSV(46, 0); - sv_setsv(*dst++, h); + *dst++ = newSVsv(h); } if (diff < 0) { /* shrinking the area */ @@ -4180,7 +4260,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 { @@ -4217,7 +4297,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; } @@ -4273,7 +4353,7 @@ 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; @@ -4328,7 +4408,7 @@ 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; @@ -4346,8 +4426,7 @@ PP(pp_unshift) else { av_unshift(ary, SP - MARK); while (MARK < SP) { - sv = NEWSV(27, 0); - sv_setsv(sv, *++MARK); + sv = newSVsv(*++MARK); (void)av_store(ary, i++, sv); } } @@ -4431,7 +4510,7 @@ PP(pp_reverse) PP(pp_split) { - dSP; dTARG; + dVAR; dSP; dTARG; AV *ary; register IV limit = POPi; /* note, negative is forever */ SV *sv = POPs; @@ -4444,16 +4523,17 @@ PP(pp_split) register SV *dstr; register 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; I32 realarray = 0; I32 base; - 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 @@ -4515,9 +4595,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) @@ -4532,8 +4611,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) @@ -4547,15 +4625,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++) ; 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) @@ -4580,8 +4657,7 @@ PP(pp_split) 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) @@ -4596,14 +4672,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) @@ -4636,8 +4709,7 @@ 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) @@ -4652,8 +4724,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 "" */ @@ -4675,8 +4746,7 @@ PP(pp_split) /* keep field after final delim? */ if (s < strend || (iters && origlimit)) { STRLEN l = strend - s; - dstr = NEWSV(34, l); - sv_setpvn(dstr, s, l); + dstr = newSVpvn(s, l); if (make_mortal) sv_2mortal(dstr); if (do_utf8) @@ -4755,3 +4825,13 @@ PP(pp_threadsv) { DIE(aTHX_ "tried to access per-thread data in non-threaded perl"); } + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */