From d0c0e7dd0ccf3d5c2f658529d3ee578a0bcb116e Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 7 Oct 2011 11:39:50 -0700 Subject: [PATCH 1/1] Use HEKf This avoids creating a lot of temporary SVs. --- doio.c | 20 ++++++++++++-------- gv.c | 28 ++++++++++++++++------------ mro.c | 5 +++-- pp_sys.c | 32 ++++++++++++++++---------------- sv.c | 20 ++++++++++++-------- universal.c | 25 +++++++++++++------------ 6 files changed, 72 insertions(+), 58 deletions(-) diff --git a/doio.c b/doio.c index b86eac4..06d9bcd 100644 --- a/doio.c +++ b/doio.c @@ -126,8 +126,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, if (result == EOF && fd > PL_maxsysfd) { /* Why is this not Perl_warn*() call ? */ PerlIO_printf(Perl_error_log, - "Warning: unable to close filehandle %"SVf" properly.\n", - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "Warning: unable to close filehandle %"HEKf" properly.\n", + HEKfARG(GvENAME_HEK(gv)) + ); } IoOFP(io) = IoIFP(io) = NULL; } @@ -541,14 +542,16 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, if ((IoTYPE(io) == IoTYPE_RDONLY) && (fp == PerlIO_stdout() || fp == PerlIO_stderr())) { Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle STD%s reopened as %"SVf" only for input", + "Filehandle STD%s reopened as %"HEKf + " only for input", ((fp == PerlIO_stdout()) ? "OUT" : "ERR"), - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + HEKfARG(GvENAME_HEK(gv))); } else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) { Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle STDIN reopened as %"SVf" only for output", - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "Filehandle STDIN reopened as %"HEKf" only for output", + HEKfARG(GvENAME_HEK(gv)) + ); } } @@ -1337,8 +1340,9 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) return PL_laststatval; } if (ckWARN(WARN_IO)) { - Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %"SVf, - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(cGVOP_gv))))); + Perl_warner(aTHX_ packWARN(WARN_IO), + "Use of -l on filehandle %"HEKf, + HEKfARG(GvENAME_HEK(cGVOP_gv))); } return (PL_laststatval = -1); } diff --git a/gv.c b/gv.c index edae045..24f4912 100644 --- a/gv.c +++ b/gv.c @@ -718,9 +718,9 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level, if (!cstash) { Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Can't locate package %"SVf" for @%"SVf"::ISA", + "Can't locate package %"SVf" for @%"HEKf"::ISA", SVfARG(linear_sv), - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash))))); + HEKfARG(HvNAME_HEK(stash))); continue; } @@ -1003,8 +1003,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le if (nsplit) { if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) { /* ->SUPER::method should really be looked up in original stash */ - SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"::SUPER", - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK((HV*)CopSTASH(PL_curcop))))))); + SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ + "%"HEKf"::SUPER", + HEKfARG(HvNAME_HEK((HV*)CopSTASH(PL_curcop))) + )); /* __PACKAGE__::SUPER stash should be autovivified */ stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr), SvUTF8(tmpstr)); DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n", @@ -1051,10 +1053,11 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le return gv; } Perl_croak(aTHX_ - "Can't locate object method \"%"SVf"\" via package \"%"SVf"\"", + "Can't locate object method \"%"SVf + "\" via package \"%"HEKf"\"", SVfARG(newSVpvn_flags(name, nend - name, SVs_TEMP | is_utf8)), - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash))))); + HEKfARG(HvNAME_HEK(stash))); } else { SV* packnamesv; @@ -2047,9 +2050,10 @@ Perl_gv_check(pTHX_ const HV *stash) = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0); #endif Perl_warner(aTHX_ packWARN(WARN_ONCE), - "Name \"%"SVf"::%"SVf"\" used only once: possible typo", - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))), - SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv))))); + "Name \"%"HEKf"::%"HEKf + "\" used only once: possible typo", + HEKfARG(HvNAME_HEK(stash)), + HEKfARG(GvNAME_HEK(gv))); } } } @@ -2299,13 +2303,13 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) : newSVpvs_flags("???", SVs_TEMP); Perl_croak(aTHX_ "%s method \"%"SVf256 "\" overloading \"%s\" "\ - "in package \"%"SVf256"\"", + "in package \"%"HEKf256"\"", (GvCVGEN(gv) ? "Stub found while resolving" : "Can't resolve"), SVfARG(name), cp, - SVfARG(sv_2mortal(newSVhek( + HEKfARG( HvNAME_HEK(stash) - )))); + )); } } cv = GvCV(gv = ngv); diff --git a/mro.c b/mro.c index 67c77eb..1d60387 100644 --- a/mro.c +++ b/mro.c @@ -224,8 +224,9 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) Perl_croak(aTHX_ "Can't linearize anonymous symbol table"); if (level > 100) - Perl_croak(aTHX_ "Recursive inheritance detected in package '%"SVf"'", - SVfARG(sv_2mortal(newSVhek(stashhek)))); + Perl_croak(aTHX_ + "Recursive inheritance detected in package '%"HEKf"'", + HEKfARG(stashhek)); meta = HvMROMETA(stash); diff --git a/pp_sys.c b/pp_sys.c index 2acacc7..19ba0cb 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -592,8 +592,8 @@ PP(pp_open) if (IoDIRP(io)) Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), - "Opening dirhandle %"SVf" also as a file", - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "Opening dirhandle %"HEKf" also as a file", + HEKfARG(GvENAME_HEK(gv))); mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { @@ -1389,8 +1389,8 @@ PP(pp_leavewrite) SV *topname; if (!IoFMT_NAME(io)) IoFMT_NAME(io) = savepv(GvNAME(gv)); - topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"_TOP", - SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv)))))); + topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"HEKf"_TOP", + HEKfARG(GvNAME_HEK(gv)))); topgv = gv_fetchsv(topname, 0, SVt_PVFM); if ((topgv && GvFORM(topgv)) || !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM)) @@ -3788,8 +3788,8 @@ PP(pp_open_dir) if ((IoIFP(io) || IoOFP(io))) Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), - "Opening filehandle %"SVf" also as a directory", - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))) ); + "Opening filehandle %"HEKf" also as a directory", + HEKfARG(GvENAME_HEK(gv)) ); if (IoDIRP(io)) PerlDir_close(IoDIRP(io)); if (!(IoDIRP(io) = PerlDir_open(dirname))) @@ -3824,8 +3824,8 @@ PP(pp_readdir) if (!io || !IoDIRP(io)) { Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "readdir() attempted on invalid dirhandle %"SVf, - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "readdir() attempted on invalid dirhandle %"HEKf, + HEKfARG(GvENAME_HEK(gv))); goto nope; } @@ -3876,8 +3876,8 @@ PP(pp_telldir) if (!io || !IoDIRP(io)) { Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "telldir() attempted on invalid dirhandle %"SVf, - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "telldir() attempted on invalid dirhandle %"HEKf, + HEKfARG(GvENAME_HEK(gv))); goto nope; } @@ -3902,8 +3902,8 @@ PP(pp_seekdir) if (!io || !IoDIRP(io)) { Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "seekdir() attempted on invalid dirhandle %"SVf, - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "seekdir() attempted on invalid dirhandle %"HEKf, + HEKfARG(GvENAME_HEK(gv))); goto nope; } (void)PerlDir_seek(IoDIRP(io), along); @@ -3927,8 +3927,8 @@ PP(pp_rewinddir) if (!io || !IoDIRP(io)) { Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "rewinddir() attempted on invalid dirhandle %"SVf, - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "rewinddir() attempted on invalid dirhandle %"HEKf, + HEKfARG(GvENAME_HEK(gv))); goto nope; } (void)PerlDir_rewind(IoDIRP(io)); @@ -3951,8 +3951,8 @@ PP(pp_closedir) if (!io || !IoDIRP(io)) { Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "closedir() attempted on invalid dirhandle %"SVf, - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv))))); + "closedir() attempted on invalid dirhandle %"HEKf, + HEKfARG(GvENAME_HEK(gv))); goto nope; } #ifdef VOID_CLOSEDIR diff --git a/sv.c b/sv.c index 158410d..3360bf4 100644 --- a/sv.c +++ b/sv.c @@ -3846,10 +3846,14 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr) Perl_warner(aTHX_ packWARN(WARN_REDEFINE), (const char *) (CvCONST(cv) - ? "Constant subroutine %"SVf"::%"SVf" redefined" - : "Subroutine %"SVf"::%"SVf" redefined"), - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(GvSTASH((const GV *)dstr))))), - SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(MUTABLE_GV(dstr)))))); + ? "Constant subroutine %"HEKf + "::%"HEKf" redefined" + : "Subroutine %"HEKf"::%"HEKf + " redefined"), + HEKfARG( + HvNAME_HEK(GvSTASH((const GV *)dstr)) + ), + HEKfARG(GvENAME_HEK(MUTABLE_GV(dstr)))); } } if (!intro) @@ -6352,8 +6356,8 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { if (check_refcnt && SvREFCNT(sv)) { if (PL_in_clean_objs) Perl_croak(aTHX_ - "DESTROY created new reference to dead object '%"SVf"'", - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash))))); + "DESTROY created new reference to dead object '%"HEKf"'", + HEKfARG(HvNAME_HEK(stash))); /* DESTROY gave object new lease on life */ return FALSE; } @@ -8859,8 +8863,8 @@ Perl_sv_2io(pTHX_ SV *const sv) gv = MUTABLE_GV(sv); io = GvIO(gv); if (!io) - Perl_croak(aTHX_ "Bad filehandle: %"SVf, - SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv))))); + Perl_croak(aTHX_ "Bad filehandle: %"HEKf, + HEKfARG(GvNAME_HEK(gv))); break; } /* FALL THROUGH */ diff --git a/universal.c b/universal.c index a03296d..d623a67 100644 --- a/universal.c +++ b/universal.c @@ -307,13 +307,13 @@ Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params) const HV *const stash = GvSTASH(gv); if (HvNAME_get(stash)) - Perl_croak(aTHX_ "Usage: %"SVf"::%"SVf"(%s)", - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))), - SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv)))), + Perl_croak(aTHX_ "Usage: %"HEKf"::%"HEKf"(%s)", + HEKfARG(HvNAME_HEK(stash)), + HEKfARG(GvNAME_HEK(gv)), params); else - Perl_croak(aTHX_ "Usage: %"SVf"(%s)", - SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv)))), params); + Perl_croak(aTHX_ "Usage: %"HEKf"(%s)", + HEKfARG(GvNAME_HEK(gv)), params); } else { /* Pants. I don't think that it should be possible to get here. */ Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params); @@ -437,10 +437,11 @@ XS(XS_UNIVERSAL_VERSION) if (undef) { if (pkg) { - const SV * const name = sv_2mortal(newSVhek(HvNAME_HEK(pkg))); + const HEK * const name = HvNAME_HEK(pkg); Perl_croak(aTHX_ - "%"SVf" does not define $%"SVf"::VERSION--version check failed", - SVfARG(name), SVfARG(name)); + "%"HEKf" does not define $%"HEKf + "::VERSION--version check failed", + HEKfARG(name), HEKfARG(name)); } else { Perl_croak(aTHX_ "%"SVf" defines neither package nor VERSION--version check failed", @@ -458,15 +459,15 @@ XS(XS_UNIVERSAL_VERSION) if ( vcmp( req, sv ) > 0 ) { if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) { - Perl_croak(aTHX_ "%"SVf" version %"SVf" required--" + Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--" "this is only version %"SVf"", - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(pkg)))), + HEKfARG(HvNAME_HEK(pkg)), SVfARG(sv_2mortal(vnormal(req))), SVfARG(sv_2mortal(vnormal(sv)))); } else { - Perl_croak(aTHX_ "%"SVf" version %"SVf" required--" + Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--" "this is only version %"SVf, - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(pkg)))), + HEKfARG(HvNAME_HEK(pkg)), SVfARG(sv_2mortal(vstringify(req))), SVfARG(sv_2mortal(vstringify(sv)))); } -- 1.8.3.1