rmv context from Perl_croak_no_modify and Perl_croak_xs_usage

Remove the context/pTHX from Perl_croak_no_modify and Perl_croak_xs_usage.
For croak_no_modify, it now has no parameters (and always has been
no return), and on some compilers will now be optimized to a conditional
jump. For Perl_croak_xs_usage one push asm opcode is removed at the caller.
For both funcs, their footprint in their callers (which probably are hot
code) is smaller, which means a tiny bit more room in the cache. My text
section went from 0xC1A2F to 0xC198F after apply this. Also see
http://www.nntp.perl.org/group/perl.perl5.porters/2012/11/msg195233.html .

diff --git a/av.c b/av.c
index fe6cd9b..6d2b949 100644 (file)
--- a/av.c
+++ b/av.c
@@ -345,7 +345,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     }
 
     if (SvREADONLY(av) && key >= AvFILL(av))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
 
     if (!AvREAL(av) && AvREIFY(av))
        av_reify(av);
@@ -463,7 +463,7 @@ Perl_av_clear(pTHX_ register AV *av)
 #endif
 
     if (SvREADONLY(av))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
 
     /* Give any tie a chance to cleanup first */
     if (SvRMAGICAL(av)) {
@@ -579,7 +579,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
@@ -611,7 +611,7 @@ Perl_av_pop(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
        if (retval)
@@ -672,7 +672,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
@@ -737,7 +737,7 @@ Perl_av_shift(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
        if (retval)
@@ -853,7 +853,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic

diff --git a/doop.c b/doop.c
index f64ebb0..87bd180 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -633,7 +633,7 @@ Perl_do_trans(pTHX_ SV *sv)
 
     if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) {
         if (!SvIsCOW(sv))
-            Perl_croak_no_modify(aTHX);
+            Perl_croak_no_modify();
     }
     (void)SvPV_const(sv, len);
     if (!len)

diff --git a/embed.fnc b/embed.fnc
index d148ec8..cb5d827 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -246,8 +246,8 @@ Aprd        |void   |croak_sv       |NN SV *baseex
 : croak()'s first parm can be NULL.  Otherwise, mod_perl breaks.
 Afprd  |void   |croak          |NULLOK const char* pat|...
 Aprd   |void   |vcroak         |NULLOK const char* pat|NULLOK va_list* args
-Aprd   |void   |croak_no_modify
-Aprd   |void   |croak_xs_usage |NN const CV *const cv \
+Anprd  |void   |croak_no_modify
+Anprd  |void   |croak_xs_usage |NN const CV *const cv \
                                |NN const char *const params
 #if defined(WIN32)
 norx   |void   |win32_croak_not_implemented|NN const char * fname

diff --git a/embed.h b/embed.h
index 1d1fc47..941e0b8 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -77,9 +77,9 @@
 #define croak                  Perl_croak
 #endif
 #define croak_memory_wrap      S_croak_memory_wrap
-#define croak_no_modify()      Perl_croak_no_modify(aTHX)
+#define croak_no_modify                Perl_croak_no_modify
 #define croak_sv(a)            Perl_croak_sv(aTHX_ a)
-#define croak_xs_usage(a,b)    Perl_croak_xs_usage(aTHX_ a,b)
+#define croak_xs_usage         Perl_croak_xs_usage
 #define custom_op_desc(a)      Perl_custom_op_desc(aTHX_ a)
 #define custom_op_name(a)      Perl_custom_op_name(aTHX_ a)
 #define cv_clone(a)            Perl_cv_clone(aTHX_ a)

diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.pm b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
index 932e440..9702666 100644 (file)
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.pm
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
@@ -1,7 +1,7 @@
 use strict;
 package Tie::Hash::NamedCapture;
 
-our $VERSION = "0.08";
+our $VERSION = "0.09";
 
 require XSLoader;
 XSLoader::load(); # This returns true, which makes require happy.

diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.xs b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
index 58b7da7..04cc463 100644 (file)
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.xs
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
@@ -84,7 +84,7 @@ FETCH(...)
 
        if (!rx || !SvROK(ST(0))) {
            if (ix & UNDEF_FATAL)
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
            else
                XSRETURN_UNDEF;
        }

diff --git a/mg.c b/mg.c
index 0cb6052..761bf73 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -682,7 +682,7 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
-    Perl_croak_no_modify(aTHX);
+    Perl_croak_no_modify();
     NORETURN_FUNCTION_END;
 }
 
@@ -2477,7 +2477,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
              */
       croakparen:
             if (!PL_localizing) {
-                Perl_croak_no_modify(aTHX);
+                Perl_croak_no_modify();
             }
         }
         break;

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index abcd2ed..c573a61 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -132,6 +132,10 @@ L<CPAN> has been upgraded from version 1.98 to 1.99_51.
 
 L<DynaLoader> has been upgraded from version 1.16 to 1.17.
 
+=item *
+
+L<Tie::Hash::NamedCapture> has been upgraded from version 0.08 to 0.09.
+
 =back
 
 =head2 Removed Modules and Pragmata
@@ -334,6 +338,12 @@ well.
 
 =item *
 
+The private Perl_croak_no_modify has had its context parameter removed. It is
+now has a void prototype. Users of the public API croak_no_modify remain
+unaffected.
+
+=item *
+
 XXX
 
 =back

diff --git a/pp.c b/pp.c
index 5b0010f..6088a11 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -231,7 +231,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
                if (vivify_sv && sv != &PL_sv_undef) {
                    GV *gv;
                    if (SvREADONLY(sv))
-                       Perl_croak_no_modify(aTHX);
+                       Perl_croak_no_modify();
                    if (cUNOP->op_targ) {
                        SV * const namesv = PAD_SV(cUNOP->op_targ);
                        gv = MUTABLE_GV(newSV(0));
@@ -777,7 +777,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
            sv_force_normal_flags(sv, 0);
         }
         else
-            Perl_croak_no_modify(aTHX);
+            Perl_croak_no_modify();
     }
 
     if (PL_encoding) {
@@ -1040,7 +1040,7 @@ PP(pp_postinc)
     const bool inc =
        PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
     if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
     if (SvROK(TOPs))
        TARG = sv_newmortal();
     sv_setsv(TARG, TOPs);
@@ -5081,7 +5081,7 @@ PP(pp_push)
        SPAGAIN;
     }
     else {
-       if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify(aTHX);
+       if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify();
        PL_delaymagic = DM_DELAY;
        for (++MARK; MARK <= SP; MARK++) {
            SV *sv;

diff --git a/pp_hot.c b/pp_hot.c
index b5551bf..0cf1b7d 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -438,7 +438,7 @@ PP(pp_preinc)
     const bool inc =
        PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC;
     if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
     if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
     {
@@ -2161,7 +2161,7 @@ PP(pp_subst)
            || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
                  || SvTYPE(TARG) > SVt_PVLV)
                 && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
-       Perl_croak_no_modify(aTHX);
+       Perl_croak_no_modify();
     PUTBACK;
 
     s = SvPV_nomg(TARG, len);
@@ -2946,7 +2946,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
     SvGETMAGIC(sv);
     if (!SvOK(sv)) {
        if (SvREADONLY(sv))
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
        prepare_SV_for_RV(sv);
        switch (to_what) {
        case OPpDEREF_SV:

diff --git a/pp_sort.c b/pp_sort.c
index 30595f0..eae2098 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1586,7 +1586,7 @@ PP(pp_sort)
        }
        else {
            if (SvREADONLY(av))
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
            else
                SvREADONLY_on(av);
            p1 = p2 = AvARRAY(av);

diff --git a/pp_sys.c b/pp_sys.c
index 57679eb..938aafe 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1100,7 +1100,7 @@ PP(pp_sselect)
            if (SvIsCOW(sv))
                sv_force_normal_flags(sv, 0);
            if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
        }
        if (!SvPOK(sv)) {
            if (!SvPOKp(sv))

diff --git a/proto.h b/proto.h
index 8929439..83372f8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -643,7 +643,7 @@ PERL_CALLCONV_NO_RET void   Perl_croak(pTHX_ const char* pat, ...)
 PERL_STATIC_NO_RET void        S_croak_memory_wrap(void)
                        __attribute__noreturn__;
 
-PERL_CALLCONV_NO_RET void      Perl_croak_no_modify(pTHX)
+PERL_CALLCONV_NO_RET void      Perl_croak_no_modify(void)
                        __attribute__noreturn__;
 
 PERL_CALLCONV_NO_RET void      Perl_croak_sv(pTHX_ SV *baseex)
@@ -652,10 +652,10 @@ PERL_CALLCONV_NO_RET void Perl_croak_sv(pTHX_ SV *baseex)
 #define PERL_ARGS_ASSERT_CROAK_SV      \
        assert(baseex)
 
-PERL_CALLCONV_NO_RET void      Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+PERL_CALLCONV_NO_RET void      Perl_croak_xs_usage(const CV *const cv, const char *const params)
                        __attribute__noreturn__
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
+                       __attribute__nonnull__(1)
+                       __attribute__nonnull__(2);
 #define PERL_ARGS_ASSERT_CROAK_XS_USAGE        \
        assert(cv); assert(params)
 

diff --git a/regcomp.c b/regcomp.c
index 7007e55..83e0530 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6488,7 +6488,7 @@ Perl_reg_named_buff(pTHX_ REGEXP * const rx, SV * const key, SV * const value,
     if (flags & RXapif_FETCH) {
         return reg_named_buff_fetch(rx, key, flags);
     } else if (flags & (RXapif_STORE | RXapif_DELETE | RXapif_CLEAR)) {
-        Perl_croak_no_modify(aTHX);
+        Perl_croak_no_modify();
         return NULL;
     } else if (flags & RXapif_EXISTS) {
         return reg_named_buff_exists(rx, key, flags)
@@ -6810,7 +6810,7 @@ Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren,
     PERL_UNUSED_ARG(value);
 
     if (!PL_localizing)
-        Perl_croak_no_modify(aTHX);
+        Perl_croak_no_modify();
 }
 
 I32

diff --git a/sv.c b/sv.c
index 067a9e0..4a57a9a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4785,7 +4785,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
             }
        }
        else if (IN_PERL_RUNTIME)
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
     }
 #else
     if (SvREADONLY(sv)) {
@@ -4807,7 +4807,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
            unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
        }
        else if (IN_PERL_RUNTIME)
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
     }
 #endif
     if (SvROK(sv))
@@ -5320,7 +5320,7 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
            && !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
           )
        {
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
        }
     }
     if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {
@@ -7954,7 +7954,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
            sv_force_normal_flags(sv, 0);
        if (SvREADONLY(sv)) {
            if (IN_PERL_RUNTIME)
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
        }
        if (SvROK(sv)) {
            IV i;
@@ -8136,7 +8136,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
            sv_force_normal_flags(sv, 0);
        if (SvREADONLY(sv)) {
            if (IN_PERL_RUNTIME)
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
        }
        if (SvROK(sv)) {
            IV i;
@@ -9495,7 +9495,7 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
        if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
-           Perl_croak_no_modify(aTHX);
+           Perl_croak_no_modify();
        if (SvOBJECT(tmpRef)) {
            if (SvTYPE(tmpRef) != SVt_PVIO)
                --PL_sv_objcount;

diff --git a/universal.c b/universal.c
index 055d8ab..8cc6e63 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -298,7 +298,7 @@ C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
 */
 
 void
-Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+Perl_croak_xs_usage(const CV *const cv, const char *const params)
 {
     const GV *const gv = CvGV(cv);
 
@@ -308,16 +308,16 @@ 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: %"HEKf"::%"HEKf"(%s)",
+           Perl_croak_nocontext("Usage: %"HEKf"::%"HEKf"(%s)",
                                 HEKfARG(HvNAME_HEK(stash)),
                                 HEKfARG(GvNAME_HEK(gv)),
                                 params);
        else
-           Perl_croak(aTHX_ "Usage: %"HEKf"(%s)",
+           Perl_croak_nocontext("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);
+       Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
     }
 }
 

diff --git a/util.c b/util.c
index 28a5ff4..b7403e8 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1625,9 +1625,9 @@ paths reduces CPU cache pressure.
 */
 
 void
-Perl_croak_no_modify(pTHX)
+Perl_croak_no_modify()
 {
-    Perl_croak(aTHX_ "%s", PL_no_modify);
+    Perl_croak_nocontext( "%s", PL_no_modify);
 }
 
 /*