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 .
}
if (SvREADONLY(av) && key >= AvFILL(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (!AvREAL(av) && AvREIFY(av))
av_reify(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)) {
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,
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)
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",
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)
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
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)
: 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
#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)
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.
if (!rx || !SvROK(ST(0))) {
if (ix & UNDEF_FATAL)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
else
XSRETURN_UNDEF;
}
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;
}
*/
croakparen:
if (!PL_localizing) {
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
}
break;
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
=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
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));
sv_force_normal_flags(sv, 0);
}
else
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
if (PL_encoding) {
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);
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;
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))
{
|| ( ((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);
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:
}
else {
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
else
SvREADONLY_on(av);
p1 = p2 = AvARRAY(av);
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))
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)
#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)
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)
PERL_UNUSED_ARG(value);
if (!PL_localizing)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
I32
}
}
else if (IN_PERL_RUNTIME)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
#else
if (SvREADONLY(sv)) {
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))
&& !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)) {
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;
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;
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;
*/
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);
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);
}
}
*/
void
-Perl_croak_no_modify(pTHX)
+Perl_croak_no_modify()
{
- Perl_croak(aTHX_ "%s", PL_no_modify);
+ Perl_croak_nocontext( "%s", PL_no_modify);
}
/*