X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/798bec46ce5ad8ebd5417d3924d03658fcf2ed0b..10203f3889ee494c4dc3885f18f1f4aa1c012a32:/pp_hot.c diff --git a/pp_hot.c b/pp_hot.c index 813b606..aa792bf 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1,7 +1,7 @@ /* pp_hot.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 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. @@ -37,6 +37,7 @@ PP(pp_const) { + dVAR; dSP; XPUSHs(cSVOP_sv); RETURN; @@ -44,6 +45,7 @@ PP(pp_const) PP(pp_nextstate) { + dVAR; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -53,6 +55,7 @@ PP(pp_nextstate) PP(pp_gvsv) { + dVAR; dSP; EXTEND(SP,1); if (PL_op->op_private & OPpLVAL_INTRO) @@ -64,24 +67,27 @@ PP(pp_gvsv) PP(pp_null) { + dVAR; return NORMAL; } PP(pp_setstate) { + dVAR; PL_curcop = (COP*)PL_op; return NORMAL; } PP(pp_pushmark) { + dVAR; PUSHMARK(PL_stack_sp); return NORMAL; } PP(pp_stringify) { - dSP; dTARGET; + dVAR; dSP; dTARGET; sv_copypv(TARG,TOPs); SETTARG; RETURN; @@ -89,14 +95,14 @@ PP(pp_stringify) PP(pp_gv) { - dSP; + dVAR; dSP; XPUSHs((SV*)cGVOP_gv); RETURN; } PP(pp_and) { - dSP; + dVAR; dSP; if (!SvTRUE(TOPs)) RETURN; else { @@ -108,14 +114,73 @@ PP(pp_and) PP(pp_sassign) { - dSP; dPOPTOPssrl; + dVAR; dSP; dPOPTOPssrl; if (PL_op->op_private & OPpASSIGN_BACKWARDS) { - SV *temp; - temp = left; left = right; right = temp; + SV * const temp = left; + left = right; right = temp; + } + else if (PL_op->op_private & OPpASSIGN_STATE) { + if (SvPADSTALE(right)) + SvPADSTALE_off(right); + else + RETURN; /* ignore assignment */ } if (PL_tainting && PL_tainted && !SvTAINTED(left)) TAINT_NOT; + if (PL_op->op_private & OPpASSIGN_CV_TO_GV) { + SV * const cv = SvRV(left); + const U32 cv_type = SvTYPE(cv); + const U32 gv_type = SvTYPE(right); + const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM; + + if (!got_coderef) { + assert(SvROK(cv)); + } + + /* Can do the optimisation if right (LVAUE) is not a typeglob, + left (RVALUE) is a reference to something, and we're in void + context. */ + if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) { + /* Is the target symbol table currently empty? */ + GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV); + if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) { + /* Good. Create a new proxy constant subroutine in the target. + The gv becomes a(nother) reference to the constant. */ + SV *const value = SvRV(cv); + + SvUPGRADE((SV *)gv, SVt_RV); + SvROK_on(gv); + SvRV_set(gv, value); + SvREFCNT_inc_simple_void(value); + SETs(right); + RETURN; + } + } + + /* Need to fix things up. */ + if (gv_type != SVt_PVGV) { + /* Need to fix GV. */ + right = (SV*)gv_fetchsv(right, GV_ADD, SVt_PVGV); + } + + if (!got_coderef) { + /* We've been returned a constant rather than a full subroutine, + but they expect a subroutine reference to apply. */ + ENTER; + SvREFCNT_inc_void(SvRV(cv)); + /* newCONSTSUB takes a reference count on the passed in SV + from us. We set the name to NULL, otherwise we get into + all sorts of fun as the reference to our new sub is + donated to the GV that we're about to assign to. + */ + SvRV_set(left, (SV *)newCONSTSUB(GvSTASH(right), NULL, + SvRV(cv))); + SvREFCNT_dec(cv); + LEAVE; + } + + } SvSetMagicSV(right, left); SETs(right); RETURN; @@ -123,7 +188,7 @@ PP(pp_sassign) PP(pp_cond_expr) { - dSP; + dVAR; dSP; if (SvTRUEx(POPs)) RETURNOP(cLOGOP->op_other); else @@ -132,6 +197,7 @@ PP(pp_cond_expr) PP(pp_unstack) { + dVAR; I32 oldsave; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -143,16 +209,19 @@ PP(pp_unstack) PP(pp_concat) { - dSP; dATARGET; tryAMAGICbin(concat,opASSIGN); + dVAR; dSP; dATARGET; tryAMAGICbin(concat,opASSIGN); { dPOPTOPssrl; bool lbyte; STRLEN rlen; - const char *rpv = SvPV_const(right, rlen); /* mg_get(right) happens here */ - const bool rbyte = !DO_UTF8(right); + const char *rpv = NULL; + bool rbyte = FALSE; bool rcopied = FALSE; if (TARG == right && right != left) { + /* mg_get(right) may happen here ... */ + rpv = SvPV_const(right, rlen); + rbyte = !DO_UTF8(right); right = sv_2mortal(newSVpvn(rpv, rlen)); rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */ rcopied = TRUE; @@ -171,14 +240,22 @@ PP(pp_concat) else { /* TARG == left */ STRLEN llen; SvGETMAGIC(left); /* or mg_get(left) may happen here */ - if (!SvOK(TARG)) + if (!SvOK(TARG)) { + if (left == right && ckWARN(WARN_UNINITIALIZED)) + report_uninit(right); sv_setpvn(left, "", 0); + } (void)SvPV_nomg_const(left, llen); /* Needed to set UTF8 flag */ lbyte = !DO_UTF8(left); if (IN_BYTES) SvUTF8_off(TARG); } + /* or mg_get(right) may happen here */ + if (!rcopied) { + rpv = SvPV_const(right, rlen); + rbyte = !DO_UTF8(right); + } if (lbyte != rbyte) { if (lbyte) sv_utf8_upgrade_nomg(TARG); @@ -198,11 +275,12 @@ PP(pp_concat) PP(pp_padsv) { - dSP; dTARGET; + dVAR; dSP; dTARGET; XPUSHs(TARG); if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) - SAVECLEARSV(PAD_SVl(PL_op->op_targ)); + if (!(PL_op->op_private & OPpPAD_STATE)) + SAVECLEARSV(PAD_SVl(PL_op->op_targ)); if (PL_op->op_private & OPpDEREF) { PUTBACK; vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF); @@ -214,6 +292,7 @@ PP(pp_padsv) PP(pp_readline) { + dVAR; tryAMAGICunTARGET(iter, 0); PL_last_in_gv = (GV*)(*PL_stack_sp--); if (SvTYPE(PL_last_in_gv) != SVt_PVGV) { @@ -232,7 +311,7 @@ PP(pp_readline) PP(pp_eq) { - dSP; tryAMAGICbinSET(eq,0); + dVAR; dSP; tryAMAGICbinSET(eq,0); #ifndef NV_PRESERVES_UV if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) { SP--; @@ -248,8 +327,8 @@ PP(pp_eq) right argument if we know the left is integer. */ 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 @@ -258,8 +337,8 @@ PP(pp_eq) 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; @@ -278,28 +357,34 @@ PP(pp_eq) ivp = *--SP; } iv = SvIVX(ivp); - if (iv < 0) { + if (iv < 0) /* As uv is a UV, it's >0, so it cannot be == */ SETs(&PL_sv_no); - RETURN; - } - /* we know iv is >= 0 */ - SETs(boolSV((UV)iv == SvUVX(uvp))); + else + /* we know iv is >= 0 */ + SETs(boolSV((UV)iv == SvUVX(uvp))); RETURN; } } } #endif { +#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) + dPOPTOPnnrl; + if (Perl_isnan(left) || Perl_isnan(right)) + RETSETNO; + SETs(boolSV(left == right)); +#else dPOPnv; SETs(boolSV(TOPn == value)); +#endif RETURN; } } PP(pp_preinc) { - dSP; + dVAR; dSP; if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV) DIE(aTHX_ PL_no_modify); if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) @@ -316,7 +401,7 @@ PP(pp_preinc) PP(pp_or) { - dSP; + dVAR; dSP; if (SvTRUE(TOPs)) RETURN; else { @@ -328,12 +413,13 @@ PP(pp_or) PP(pp_defined) { - dSP; - register SV* sv = NULL; - bool defined = FALSE; + dVAR; dSP; + register SV* sv; + bool defined; const int op_type = PL_op->op_type; + const int is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN); - if(op_type == OP_DOR || op_type == OP_DORASSIGN) { + if (is_dor) { sv = TOPs; if (!sv || !SvANY(sv)) { if (op_type == OP_DOR) @@ -347,6 +433,7 @@ PP(pp_defined) } else DIE(aTHX_ "panic: Invalid op (%s) in pp_defined()", OP_NAME(PL_op)); + defined = FALSE; switch (SvTYPE(sv)) { case SVt_PVAV: if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) @@ -364,9 +451,10 @@ PP(pp_defined) SvGETMAGIC(sv); if (SvOK(sv)) defined = TRUE; + break; } - - if(op_type == OP_DOR || op_type == OP_DORASSIGN) { + + if (is_dor) { if(defined) RETURN; if(op_type == OP_DOR) @@ -381,7 +469,7 @@ PP(pp_defined) PP(pp_add) { - dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); + dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); useleft = USE_LEFT(TOPm1s); #ifdef PERL_PRESERVE_IVUV /* We must see if we can perform the addition with integers if possible, @@ -543,11 +631,11 @@ PP(pp_add) PP(pp_aelemfast) { - dSP; - AV *av = PL_op->op_flags & OPf_SPECIAL ? + dVAR; dSP; + AV * const av = PL_op->op_flags & OPf_SPECIAL ? (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv); const U32 lval = PL_op->op_flags & OPf_MOD; - SV** svp = av_fetch(av, PL_op->op_private, lval); + SV** const svp = av_fetch(av, PL_op->op_private, lval); SV *sv = (svp ? *svp : &PL_sv_undef); EXTEND(SP, 1); if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */ @@ -558,7 +646,7 @@ PP(pp_aelemfast) PP(pp_join) { - dSP; dMARK; dTARGET; + dVAR; dSP; dMARK; dTARGET; MARK++; do_join(TARG, *MARK, MARK, SP); SP = MARK; @@ -568,7 +656,7 @@ PP(pp_join) PP(pp_pushre) { - dSP; + dVAR; dSP; #ifdef DEBUGGING /* * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs @@ -590,15 +678,10 @@ PP(pp_pushre) PP(pp_print) { dVAR; dSP; dMARK; dORIGMARK; - GV *gv; IO *io; register PerlIO *fp; MAGIC *mg; - - if (PL_op->op_flags & OPf_STACKED) - gv = (GV*)*++MARK; - else - gv = PL_defoutgv; + GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv; if (gv && (io = GvIO(gv)) && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) @@ -690,7 +773,7 @@ PP(pp_print) PP(pp_rv2av) { - dSP; dTOPss; + dVAR; dSP; dTOPss; AV *av; if (SvROK(sv)) { @@ -753,10 +836,10 @@ PP(pp_rv2av) if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PVAV); + gv = (GV*)gv_fetchsv(sv, 0, SVt_PVAV); if (!gv && (!is_gv_magical_sv(sv,0) - || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVAV)))) + || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV)))) { RETSETUNDEF; } @@ -764,7 +847,7 @@ PP(pp_rv2av) else { if (PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_symref_sv, sv, "an ARRAY"); - gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVAV); + gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVAV); } } else { @@ -816,7 +899,7 @@ PP(pp_rv2av) PP(pp_rv2hv) { - dSP; dTOPss; + dVAR; dSP; dTOPss; HV *hv; const I32 gimme = GIMME_V; static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context"; @@ -880,10 +963,10 @@ PP(pp_rv2hv) if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PVHV); + gv = (GV*)gv_fetchsv(sv, 0, SVt_PVHV); if (!gv && (!is_gv_magical_sv(sv,0) - || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVHV)))) + || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV)))) { RETSETUNDEF; } @@ -891,7 +974,7 @@ PP(pp_rv2hv) else { if (PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_symref_sv, sv, "a HASH"); - gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVHV); + gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PVHV); } } else { @@ -928,6 +1011,7 @@ PP(pp_rv2hv) STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) { + dVAR; if (*relem) { SV *tmpstr; const HE *didstore; @@ -946,7 +1030,7 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) Perl_warner(aTHX_ packWARN(WARN_MISC), err); } - tmpstr = NEWSV(29,0); + tmpstr = newSV(0); didstore = hv_store_ent(hash,*relem,tmpstr,0); if (SvMAGICAL(hash)) { if (SvSMAGICAL(tmpstr)) @@ -977,7 +1061,7 @@ PP(pp_aassign) I32 i; int magic; int duplicates = 0; - SV **firsthashrelem = 0; /* "= 0" keeps gcc 2.95 quiet */ + SV **firsthashrelem = NULL; /* "= 0" keeps gcc 2.95 quiet */ PL_delaymagic = DM_DELAY; /* catch simultaneous items */ @@ -996,11 +1080,17 @@ PP(pp_aassign) } } } + if (PL_op->op_private & OPpASSIGN_STATE) { + if (SvPADSTALE(*firstlelem)) + SvPADSTALE_off(*firstlelem); + else + RETURN; /* ignore assignment */ + } relem = firstrelem; lelem = firstlelem; - ary = Null(AV*); - hash = Null(HV*); + ary = NULL; + hash = NULL; while (lelem <= lastlelem) { TAINT_NOT; /* Each item stands on its own, taintwise. */ @@ -1037,11 +1127,9 @@ PP(pp_aassign) while (relem < lastrelem) { /* gobble up all the rest */ HE *didstore; - if (*relem) - sv = *(relem++); - else - sv = &PL_sv_no, relem++; - tmpstr = NEWSV(29,0); + sv = *relem ? *relem : &PL_sv_no; + relem++; + tmpstr = newSV(0); if (*relem) sv_setsv(tmpstr,*relem); /* value */ *(relem++) = tmpstr; @@ -1179,7 +1267,7 @@ PP(pp_aassign) PP(pp_qr) { - dSP; + dVAR; dSP; register PMOP * const pm = cPMOP; SV * const rv = sv_newmortal(); SV * const sv = newSVrv(rv, "Regexp"); @@ -1191,7 +1279,7 @@ PP(pp_qr) PP(pp_match) { - dSP; dTARG; + dVAR; dSP; dTARG; register PMOP *pm = cPMOP; PMOP *dynpm = pm; register const char *t; @@ -1252,7 +1340,7 @@ PP(pp_match) if ((global = dynpm->op_pmflags & PMf_GLOBAL)) { rx->startp[0] = -1; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { - MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global); + MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { if (!(rx->reganch & ROPT_GPOS_SEEN)) rx->endp[0] = rx->startp[0] = mg->mg_len; @@ -1266,7 +1354,7 @@ PP(pp_match) } } if ((!global && rx->nparens) - || SvTEMP(TARG) || PL_sawampersand) + || SvTEMP(TARG) || PL_sawampersand || (pm->op_pmflags & PMf_EVAL)) r_flags |= REXEC_COPY_STR; if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; @@ -1332,12 +1420,16 @@ play_it_again: } if (global) { if (dynpm->op_pmflags & PMf_CONTINUE) { - MAGIC* mg = 0; + MAGIC* mg = NULL; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) mg = mg_find(TARG, PERL_MAGIC_regex_global); if (!mg) { - sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0); - mg = mg_find(TARG, PERL_MAGIC_regex_global); +#ifdef PERL_OLD_COPY_ON_WRITE + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG, 0); +#endif + mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global, + &PL_vtbl_mglob, NULL, 0); } if (rx->startp[0] != -1) { mg->mg_len = rx->endp[0]; @@ -1360,12 +1452,18 @@ play_it_again: } else { if (global) { - MAGIC* mg = 0; + MAGIC* mg; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) mg = mg_find(TARG, PERL_MAGIC_regex_global); + else + mg = NULL; if (!mg) { - sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0); - mg = mg_find(TARG, PERL_MAGIC_regex_global); +#ifdef PERL_OLD_COPY_ON_WRITE + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG, 0); +#endif + mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global, + &PL_vtbl_mglob, NULL, 0); } if (rx->startp[0] != -1) { mg->mg_len = rx->endp[0]; @@ -1389,7 +1487,7 @@ yup: /* Confirmed by INTUIT */ if (RX_MATCH_COPIED(rx)) Safefree(rx->subbeg); RX_MATCH_COPIED_off(rx); - rx->subbeg = Nullch; + rx->subbeg = NULL; if (global) { /* FIXME - should rx->subbeg be const char *? */ rx->subbeg = (char *) truebase; @@ -1423,7 +1521,7 @@ yup: /* Confirmed by INTUIT */ rx->subbeg = savepvn(t, strend - t); #ifdef PERL_OLD_COPY_ON_WRITE - rx->saved_copy = Nullsv; + rx->saved_copy = NULL; #endif } rx->sublen = strend - t; @@ -1443,7 +1541,7 @@ nope: ret_no: if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) { if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { - MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global); + MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global); if (mg) mg->mg_len = -1; } @@ -1465,24 +1563,26 @@ Perl_do_readline(pTHX) register IO * const io = GvIO(PL_last_in_gv); register const I32 type = PL_op->op_type; const I32 gimme = GIMME_V; - MAGIC *mg; - if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { - PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)io, mg)); - PUTBACK; - ENTER; - call_method("READLINE", gimme); - LEAVE; - SPAGAIN; - if (gimme == G_SCALAR) { - SV* result = POPs; - SvSetSV_nosteal(TARG, result); - PUSHTARG; + if (io) { + MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar); + if (mg) { + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)io, mg)); + PUTBACK; + ENTER; + call_method("READLINE", gimme); + LEAVE; + SPAGAIN; + if (gimme == G_SCALAR) { + SV* const result = POPs; + SvSetSV_nosteal(TARG, result); + PUSHTARG; + } + RETURN; } - RETURN; } - fp = Nullfp; + fp = NULL; if (io) { fp = IoIFP(io); if (!fp) { @@ -1491,7 +1591,7 @@ Perl_do_readline(pTHX) IoLINES(io) = 0; if (av_len(GvAVn(PL_last_in_gv)) < 0) { IoFLAGS(io) &= ~IOf_START; - do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp); + do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL); sv_setpvn(GvSVn(PL_last_in_gv), "-", 1); SvSETMAGIC(GvSV(PL_last_in_gv)); fp = IoIFP(io); @@ -1538,6 +1638,9 @@ Perl_do_readline(pTHX) sv = TARG; if (SvROK(sv)) sv_unref(sv); + else if (isGV_with_GP(sv)) { + SvPV_force_nolen(sv); + } SvUPGRADE(sv, SVt_PV); tmplen = SvLEN(sv); /* remember if already alloced */ if (!tmplen && !SvREADONLY(sv)) @@ -1551,7 +1654,7 @@ Perl_do_readline(pTHX) } } else { - sv = sv_2mortal(NEWSV(57, 80)); + sv = sv_2mortal(newSV(80)); offset = 0; } @@ -1607,11 +1710,10 @@ Perl_do_readline(pTHX) SPAGAIN; XPUSHs(sv); if (type == OP_GLOB) { - char *tmps; const char *t1; if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) { - tmps = SvEND(sv) - 1; + char * const tmps = SvEND(sv) - 1; if (*tmps == *SvPVX_const(PL_rs)) { *tmps = '\0'; SvCUR_set(sv, SvCUR(sv) - 1); @@ -1626,22 +1728,23 @@ Perl_do_readline(pTHX) continue; } } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */ - const U8 *s = (const U8*)SvPVX_const(sv) + offset; - const STRLEN len = SvCUR(sv) - offset; - const U8 *f; - - if (ckWARN(WARN_UTF8) && - !is_utf8_string_loc(s, len, &f)) - /* Emulate :encoding(utf8) warning in the same case. */ - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "utf8 \"\\x%02X\" does not map to Unicode", - f < (U8*)SvEND(sv) ? *f : 0); + if (ckWARN(WARN_UTF8)) { + const U8 * const s = (const U8*)SvPVX_const(sv) + offset; + const STRLEN len = SvCUR(sv) - offset; + const U8 *f; + + if (!is_utf8_string_loc(s, len, &f)) + /* Emulate :encoding(utf8) warning in the same case. */ + Perl_warner(aTHX_ packWARN(WARN_UTF8), + "utf8 \"\\x%02X\" does not map to Unicode", + f < (U8*)SvEND(sv) ? *f : 0); + } } if (gimme == G_ARRAY) { if (SvLEN(sv) - SvCUR(sv) > 20) { SvPV_shrink_to_cur(sv); } - sv = sv_2mortal(NEWSV(58, 80)); + sv = sv_2mortal(newSV(80)); continue; } else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) { @@ -1677,43 +1780,39 @@ PP(pp_enter) PP(pp_helem) { - dSP; + dVAR; dSP; HE* he; SV **svp; - SV *keysv = POPs; - HV *hv = (HV*)POPs; + SV * const keysv = POPs; + HV * const hv = (HV*)POPs; const U32 lval = PL_op->op_flags & OPf_MOD || LVRET; const U32 defer = PL_op->op_private & OPpLVAL_DEFER; SV *sv; const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0; I32 preeminent = 0; - if (SvTYPE(hv) == SVt_PVHV) { - if (PL_op->op_private & OPpLVAL_INTRO) { - MAGIC *mg; - HV *stash; - /* does the element we're localizing already exist? */ - preeminent = - /* can we determine whether it exists? */ - ( !SvRMAGICAL(hv) - || mg_find((SV*)hv, PERL_MAGIC_env) - || ( (mg = mg_find((SV*)hv, PERL_MAGIC_tied)) - /* Try to preserve the existenceness of a tied hash - * element by using EXISTS and DELETE if possible. - * Fallback to FETCH and STORE otherwise */ - && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg)))) - && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) - && gv_fetchmethod_autoload(stash, "DELETE", TRUE) - ) - ) ? hv_exists_ent(hv, keysv, 0) : 1; - - } - he = hv_fetch_ent(hv, keysv, lval && !defer, hash); - svp = he ? &HeVAL(he) : 0; - } - else { + if (SvTYPE(hv) != SVt_PVHV) RETPUSHUNDEF; - } + + if (PL_op->op_private & OPpLVAL_INTRO) { + MAGIC *mg; + HV *stash; + /* does the element we're localizing already exist? */ + preeminent = /* can we determine whether it exists? */ + ( !SvRMAGICAL(hv) + || mg_find((SV*)hv, PERL_MAGIC_env) + || ( (mg = mg_find((SV*)hv, PERL_MAGIC_tied)) + /* Try to preserve the existenceness of a tied hash + * element by using EXISTS and DELETE if possible. + * Fallback to FETCH and STORE otherwise */ + && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg)))) + && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) + && gv_fetchmethod_autoload(stash, "DELETE", TRUE) + ) + ) ? hv_exists_ent(hv, keysv, 0) : 1; + } + he = hv_fetch_ent(hv, keysv, lval && !defer, hash); + svp = he ? &HeVAL(he) : NULL; if (lval) { if (!svp || *svp == &PL_sv_undef) { SV* lv; @@ -1724,9 +1823,9 @@ PP(pp_helem) lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; - sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, Nullch, 0); + sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, NULL, 0); SvREFCNT_dec(key2); /* sv_magic() increments refcount */ - LvTARG(lv) = SvREFCNT_inc(hv); + LvTARG(lv) = SvREFCNT_inc_simple(hv); LvTARGLEN(lv) = 1; PUSHs(lv); RETURN; @@ -1738,7 +1837,8 @@ PP(pp_helem) if (!preeminent) { STRLEN keylen; const char * const key = SvPV_const(keysv, keylen); - SAVEDELETE(hv, savepvn(key,keylen), keylen); + SAVEDELETE(hv, savepvn(key,keylen), + SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); } else save_helem(hv, keysv, svp); } @@ -1818,7 +1918,7 @@ PP(pp_leave) PP(pp_iter) { - dSP; + dVAR; dSP; register PERL_CONTEXT *cx; SV *sv, *oldsv; AV* av; @@ -1837,7 +1937,9 @@ PP(pp_iter) /* string increment */ register SV* cur = cx->blk_loop.iterlval; STRLEN maxlen = 0; - const char *max = SvOK((SV*)av) ? SvPV_const((SV*)av, maxlen) : ""; + const char *max = + SvOK((SV*)av) ? + SvPV_const((SV*)av, maxlen) : (const char *)""; if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) { /* safe to reuse old SV */ @@ -1888,11 +1990,11 @@ PP(pp_iter) RETPUSHNO; if (SvMAGICAL(av) || AvREIFY(av)) { - SV ** const svp = av_fetch(av, cx->blk_loop.iterix--, FALSE); - sv = svp ? *svp : Nullsv; + SV * const * const svp = av_fetch(av, --cx->blk_loop.iterix, FALSE); + sv = svp ? *svp : NULL; } else { - sv = AvARRAY(av)[cx->blk_loop.iterix--]; + sv = AvARRAY(av)[--cx->blk_loop.iterix]; } } else { @@ -1901,8 +2003,8 @@ PP(pp_iter) RETPUSHNO; if (SvMAGICAL(av) || AvREIFY(av)) { - SV ** const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE); - sv = svp ? *svp : Nullsv; + SV * const * const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE); + sv = svp ? *svp : NULL; } else { sv = AvARRAY(av)[++cx->blk_loop.iterix]; @@ -1910,7 +2012,7 @@ PP(pp_iter) } if (sv && SvIS_FREED(sv)) { - *itersvp = Nullsv; + *itersvp = NULL; Perl_croak(aTHX_ "Use of freed value in iteration"); } @@ -1922,24 +2024,24 @@ PP(pp_iter) SV *lv = cx->blk_loop.iterlval; if (lv && SvREFCNT(lv) > 1) { SvREFCNT_dec(lv); - lv = Nullsv; + lv = NULL; } if (lv) SvREFCNT_dec(LvTARG(lv)); else { - lv = cx->blk_loop.iterlval = NEWSV(26, 0); + lv = cx->blk_loop.iterlval = newSV(0); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; - sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0); + sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0); } - LvTARG(lv) = SvREFCNT_inc(av); + LvTARG(lv) = SvREFCNT_inc_simple(av); LvTARGOFF(lv) = cx->blk_loop.iterix; LvTARGLEN(lv) = (STRLEN)UV_MAX; sv = (SV*)lv; } oldsv = *itersvp; - *itersvp = SvREFCNT_inc(sv); + *itersvp = SvREFCNT_inc_simple_NN(sv); SvREFCNT_dec(oldsv); RETPUSHYES; @@ -1947,10 +2049,9 @@ PP(pp_iter) PP(pp_subst) { - dSP; dTARG; + dVAR; dSP; dTARG; register PMOP *pm = cPMOP; PMOP *rpm = pm; - register SV *dstr; register char *s; char *strend; register char *m; @@ -1973,10 +2074,10 @@ PP(pp_subst) #ifdef PERL_OLD_COPY_ON_WRITE bool is_cow; #endif - SV *nsv = Nullsv; + SV *nsv = NULL; /* known replacement string? */ - dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv; + register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL; if (PL_op->op_flags & OPf_STACKED) TARG = POPs; else if (PL_op->op_private & OPpTARGET_MY) @@ -2029,7 +2130,8 @@ PP(pp_subst) pm = PL_curpm; rx = PM_GETRE(pm); } - r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand) + r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand + || (pm->op_pmflags & PMf_EVAL)) ? REXEC_COPY_STR : 0; if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; @@ -2073,7 +2175,7 @@ PP(pp_subst) } } else { - c = Nullch; + c = NULL; doutf8 = FALSE; } @@ -2203,13 +2305,13 @@ PP(pp_subst) #endif rxtainted |= RX_MATCH_TAINTED(rx); dstr = newSVpvn(m, s-m); + SAVEFREESV(dstr); if (DO_UTF8(TARG)) SvUTF8_on(dstr); PL_curpm = pm; if (!c) { register PERL_CONTEXT *cx; SPAGAIN; - (void)ReREFCNT_inc(rx); PUSHSUBST(cx); RETURNOP(cPMOP->op_pmreplroot); } @@ -2259,8 +2361,7 @@ PP(pp_subst) SvCUR_set(TARG, SvCUR(dstr)); SvLEN_set(TARG, SvLEN(dstr)); doutf8 |= DO_UTF8(dstr); - SvPV_set(dstr, (char*)0); - sv_free(dstr); + SvPV_set(dstr, NULL); TAINT_IF(rxtainted & 1); SPAGAIN; @@ -2433,13 +2534,13 @@ PP(pp_leavesublv) EXTEND_MORTAL(SP - newsp); for (mark = newsp + 1; mark <= SP; mark++) { if (SvTEMP(*mark)) - /* empty */ ; + NOOP; else if (SvFLAGS(*mark) & (SVs_PADTMP | SVf_READONLY)) *mark = sv_mortalcopy(*mark); else { /* Can be a localized value subject to deletion. */ PL_tmps_stack[++PL_tmps_ix] = *mark; - (void)SvREFCNT_inc(*mark); + SvREFCNT_inc_void(*mark); } } } @@ -2476,7 +2577,7 @@ PP(pp_leavesublv) else { /* Can be a localized value * subject to deletion. */ PL_tmps_stack[++PL_tmps_ix] = *mark; - (void)SvREFCNT_inc(*mark); + SvREFCNT_inc_void(*mark); } } else { /* Should not happen? */ @@ -2508,7 +2609,7 @@ PP(pp_leavesublv) else { /* Can be a localized value subject to deletion. */ PL_tmps_stack[++PL_tmps_ix] = *mark; - (void)SvREFCNT_inc(*mark); + SvREFCNT_inc_void(*mark); } } } @@ -2565,17 +2666,17 @@ PP(pp_leavesublv) STATIC CV * S_get_db_sub(pTHX_ SV **svp, CV *cv) { + dVAR; SV * const dbsv = GvSVn(PL_DBsub); save_item(dbsv); if (!PERLDB_SUB_NN) { - GV *gv = CvGV(cv); + GV * const gv = CvGV(cv); if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || strEQ(GvNAME(gv), "END") || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */ - !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) - && (gv = (GV*)*svp) ))) { + !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) ))) { /* Use GV from the stack as a fallback. */ /* GV is potentially non-unique, or contain different CV. */ SV * const tmp = newRV((SV*)cv); @@ -2583,7 +2684,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv) SvREFCNT_dec(tmp); } else { - gv_efullname3(dbsv, gv, Nullch); + gv_efullname3(dbsv, gv, NULL); } } else { @@ -2594,7 +2695,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv) SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */ } - if (CvXSUB(cv)) + if (CvISXSUB(cv)) PL_curcopdb = PL_curcop; cv = GvCV(PL_DBsub); return cv; @@ -2604,7 +2705,6 @@ PP(pp_entersub) { dVAR; dSP; dPOPss; GV *gv; - HV *stash; register CV *cv; register PERL_CONTEXT *cx; I32 gimme; @@ -2615,8 +2715,10 @@ PP(pp_entersub) switch (SvTYPE(sv)) { /* This is overwhelming the most common case: */ case SVt_PVGV: - if (!(cv = GvCVu((GV*)sv))) - cv = sv_2cv(sv, &stash, &gv, FALSE); + if (!(cv = GvCVu((GV*)sv))) { + HV *stash; + cv = sv_2cv(sv, &stash, &gv, 0); + } if (!cv) { ENTER; SAVETMPS; @@ -2635,7 +2737,7 @@ PP(pp_entersub) mg_get(sv); if (SvROK(sv)) goto got_rv; - sym = SvPOKp(sv) ? SvPVX_const(sv) : Nullch; + sym = SvPOKp(sv) ? SvPVX_const(sv) : NULL; } else { sym = SvPV_nolen_const(sv); @@ -2670,7 +2772,35 @@ PP(pp_entersub) retry: if (!CvROOT(cv) && !CvXSUB(cv)) { - goto fooey; + GV* autogv; + SV* sub_name; + + /* anonymous or undef'd function leaves us no recourse */ + if (CvANON(cv) || !(gv = CvGV(cv))) + DIE(aTHX_ "Undefined subroutine called"); + + /* autoloaded stub? */ + if (cv != GvCV(gv)) { + cv = GvCV(gv); + } + /* should call AUTOLOAD now? */ + else { +try_autoload: + if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), + FALSE))) + { + cv = GvCV(autogv); + } + /* sorry */ + else { + sub_name = sv_newmortal(); + gv_efullname3(sub_name, gv, NULL); + DIE(aTHX_ "Undefined subroutine &%"SVf" called", (void*)sub_name); + } + } + if (!cv) + DIE(aTHX_ "Not a CODE reference"); + goto retry; } gimme = GIMME_V; @@ -2683,7 +2813,7 @@ PP(pp_entersub) DIE(aTHX_ "No DB::sub routine defined"); } - if (!(CvXSUB(cv))) { + if (!(CvISXSUB(cv))) { /* This path taken at least 75% of the time */ dMARK; register I32 items = SP - MARK; @@ -2703,8 +2833,7 @@ PP(pp_entersub) } SAVECOMPPAD(); PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); - if (hasargs) - { + if (hasargs) { AV* const av = (AV*)PAD_SVl(0); if (AvREAL(av)) { /* @_ is normally not REAL--this should only ever @@ -2714,7 +2843,7 @@ PP(pp_entersub) AvREIFY_on(av); } cx->blk_sub.savearray = GvAV(PL_defgv); - GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); + GvAV(PL_defgv) = (AV*)SvREFCNT_inc_simple(av); CX_CURPAD_SAVE(cx->blk_sub); cx->blk_sub.argarray = av; ++MARK; @@ -2755,103 +2884,46 @@ PP(pp_entersub) RETURNOP(CvSTART(cv)); } else { -#ifdef PERL_XSUB_OLDSTYLE - if (CvOLDSTYLE(cv)) { - I32 (*fp3)(int,int,int); - dMARK; - register I32 items = SP - MARK; - /* We dont worry to copy from @_. */ - while (SP > mark) { - SP[1] = SP[0]; - SP--; - } - PL_stack_sp = mark + 1; - fp3 = (I32(*)(int,int,int))CvXSUB(cv); - items = (*fp3)(CvXSUBANY(cv).any_i32, - MARK - PL_stack_base + 1, - items); - PL_stack_sp = PL_stack_base + items; - } - else -#endif /* PERL_XSUB_OLDSTYLE */ - { - I32 markix = TOPMARK; + I32 markix = TOPMARK; - PUTBACK; + PUTBACK; - if (!hasargs) { - /* Need to copy @_ to stack. Alternative may be to - * switch stack to @_, and copy return values - * back. This would allow popping @_ in XSUB, e.g.. XXXX */ - AV * const av = GvAV(PL_defgv); - const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */ - - if (items) { - /* Mark is at the end of the stack. */ - EXTEND(SP, items); - Copy(AvARRAY(av), SP + 1, items, SV*); - SP += items; - PUTBACK ; - } - } - /* We assume first XSUB in &DB::sub is the called one. */ - if (PL_curcopdb) { - SAVEVPTR(PL_curcop); - PL_curcop = PL_curcopdb; - PL_curcopdb = NULL; - } - /* Do we need to open block here? XXXX */ + if (!hasargs) { + /* Need to copy @_ to stack. Alternative may be to + * switch stack to @_, and copy return values + * back. This would allow popping @_ in XSUB, e.g.. XXXX */ + AV * const av = GvAV(PL_defgv); + const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */ + + if (items) { + /* Mark is at the end of the stack. */ + EXTEND(SP, items); + Copy(AvARRAY(av), SP + 1, items, SV*); + SP += items; + PUTBACK ; + } + } + /* We assume first XSUB in &DB::sub is the called one. */ + if (PL_curcopdb) { + SAVEVPTR(PL_curcop); + PL_curcop = PL_curcopdb; + PL_curcopdb = NULL; + } + /* Do we need to open block here? XXXX */ + if (CvXSUB(cv)) /* XXX this is supposed to be true */ (void)(*CvXSUB(cv))(aTHX_ cv); - /* Enforce some sanity in scalar context. */ - if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) { - if (markix > PL_stack_sp - PL_stack_base) - *(PL_stack_base + markix) = &PL_sv_undef; - else - *(PL_stack_base + markix) = *PL_stack_sp; - PL_stack_sp = PL_stack_base + markix; - } + /* Enforce some sanity in scalar context. */ + if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) { + if (markix > PL_stack_sp - PL_stack_base) + *(PL_stack_base + markix) = &PL_sv_undef; + else + *(PL_stack_base + markix) = *PL_stack_sp; + PL_stack_sp = PL_stack_base + markix; } LEAVE; return NORMAL; } - - /*NOTREACHED*/ - assert (0); /* Cannot get here. */ - /* This is deliberately moved here as spaghetti code to keep it out of the - hot path. */ - { - GV* autogv; - SV* sub_name; - - fooey: - /* anonymous or undef'd function leaves us no recourse */ - if (CvANON(cv) || !(gv = CvGV(cv))) - DIE(aTHX_ "Undefined subroutine called"); - - /* autoloaded stub? */ - if (cv != GvCV(gv)) { - cv = GvCV(gv); - } - /* should call AUTOLOAD now? */ - else { -try_autoload: - if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), - FALSE))) - { - cv = GvCV(autogv); - } - /* sorry */ - else { - sub_name = sv_newmortal(); - gv_efullname3(sub_name, gv, Nullch); - DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name); - } - } - if (!cv) - DIE(aTHX_ "Not a CODE reference"); - goto retry; - } } void @@ -2861,15 +2933,15 @@ Perl_sub_crush_depth(pTHX_ CV *cv) Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); else { SV* const tmpstr = sv_newmortal(); - gv_efullname3(tmpstr, CvGV(cv), Nullch); + gv_efullname3(tmpstr, CvGV(cv), NULL); Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"", - tmpstr); + (void*)tmpstr); } } PP(pp_aelem) { - dSP; + dVAR; dSP; SV** svp; SV* const elemsv = POPs; IV elem = SvIV(elemsv); @@ -2879,9 +2951,11 @@ PP(pp_aelem) SV *sv; if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)) - Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", elemsv); + Perl_warner(aTHX_ packWARN(WARN_MISC), + "Use of reference \"%"SVf"\" as array index", + (void*)elemsv); if (elem > 0) - elem -= PL_curcop->cop_arybase; + elem -= CopARYBASE_get(PL_curcop); if (SvTYPE(av) != SVt_PVAV) RETPUSHUNDEF; svp = av_fetch(av, elem, lval && !defer); @@ -2906,8 +2980,8 @@ PP(pp_aelem) lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; - sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0); - LvTARG(lv) = SvREFCNT_inc(av); + sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0); + LvTARG(lv) = SvREFCNT_inc_simple(av); LvTARGOFF(lv) = elem; LvTARGLEN(lv) = 1; PUSHs(lv); @@ -2941,7 +3015,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) } switch (to_what) { case OPpDEREF_SV: - SvRV_set(sv, NEWSV(355,0)); + SvRV_set(sv, newSV(0)); break; case OPpDEREF_AV: SvRV_set(sv, (SV*)newAV()); @@ -2957,7 +3031,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) PP(pp_method) { - dSP; + dVAR; dSP; SV* const sv = TOPs; if (SvROK(sv)) { @@ -2968,13 +3042,13 @@ PP(pp_method) } } - SETs(method_common(sv, Null(U32*))); + SETs(method_common(sv, NULL)); RETURN; } PP(pp_method_named) { - dSP; + dVAR; dSP; SV* const sv = cSVOP_sv; U32 hash = SvSHARED_HASH(sv); @@ -2985,12 +3059,13 @@ PP(pp_method_named) STATIC SV * S_method_common(pTHX_ SV* meth, U32* hashp) { + dVAR; SV* ob; GV* gv; HV* stash; STRLEN namelen; - const char* packname = Nullch; - SV *packsv = Nullsv; + const char* packname = NULL; + SV *packsv = NULL; STRLEN packlen; const char * const name = SvPV_const(meth, namelen); SV * const sv = *(PL_stack_base + TOPMARK + 1); @@ -3015,7 +3090,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) if (!SvOK(sv) || !(packname) || - !(iogv = gv_fetchsv(sv, FALSE, SVt_PVIO)) || + !(iogv = gv_fetchsv(sv, 0, SVt_PVIO)) || !(ob=(SV*)GvIO(iogv))) { /* this isn't the name of a filehandle either */ @@ -3034,7 +3109,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) if (!stash) packsv = sv; else { - SV* ref = newSViv(PTR2IV(stash)); + SV* const ref = newSViv(PTR2IV(stash)); hv_store(PL_stashcache, packname, packlen, ref, 0); } goto fetch; @@ -3080,7 +3155,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) don't want that. */ const char* leaf = name; - const char* sep = Nullch; + const char* sep = NULL; const char* p; for (p = name; *p; p++) {