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 .

17 files changed, 53 insertions, 43 deletions

diff --git a/av.c b/av.c
index fe6cd9bdf5..6d2b949357 100644
--- 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 f64ebb0674..87bd180bc6 100644
--- 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 d148ec8025..cb5d827bd6 100644
--- 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 1d1fc47563..941e0b82e7 100644
--- 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 932e4404d1..9702666799 100644
--- 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 58b7da7e0d..04cc4638e6 100644
--- 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 0cb605230d..761bf73452 100644
--- 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 abcd2edc6b..c573a61fe9 100644
--- 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 5b0010fb8c..6088a11394 100644
--- 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 b5551bf2de..0cf1b7d005 100644
--- 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 30595f062f..eae20984c2 100644
--- 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 57679eb3dd..938aafe0f2 100644
--- 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 8929439138..83372f8a09 100644
--- 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 7007e55acd..83e0530f0c 100644
--- 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 067a9e0a82..4a57a9a0a9 100644
--- 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 055d8ab176..8cc6e63a93 100644
--- 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 28a5ff477c..b7403e89c6 100644
--- 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);
 }
 
 /*