/* proto member is unused in version, it is used in CORE by non version xsubs */
# define VXSXSDP(x)
#endif
-#define VXS(name) XS(VXSp(name))
+
+#ifndef XS_INTERNAL
+# define XS_INTERNAL(name) static XSPROTO(name)
+#endif
+
+#define VXS(name) XS_INTERNAL(VXSp(name)); XS_INTERNAL(VXSp(name))
+
+/* uses PUSHs, so SP must be at start, PUSHs sv on Perl stack, then returns from
+ xsub; this is a little more machine code/tailcall friendly than mPUSHs(foo);
+ PUTBACK; return; */
+
+#define VXS_RETURN_M_SV(sv) \
+ STMT_START { \
+ SV * sv_vtc = sv; \
+ PUSHs(sv_vtc); \
+ PUTBACK; \
+ sv_2mortal(sv_vtc); \
+ return; \
+ } STMT_END
+
#ifdef VXS_XSUB_DETAILS
# ifdef PERL_CORE
VXS(universal_version)
{
- dVAR;
dXSARGS;
HV *pkg;
GV **gvp;
name, SvPVx_nolen_const(req));
#else
Perl_croak(aTHX_
- "%"HEKf" does not define $%"HEKf
+ "%" HEKf " does not define $%" HEKf
"::VERSION--version check failed",
HEKfARG(name), HEKfARG(name));
#endif
else {
#if PERL_VERSION >= 8
Perl_croak(aTHX_
- "%"SVf" defines neither package nor VERSION--version check failed",
+ "%" SVf " defines neither package nor VERSION--"
+ "version check failed",
(void*)(ST(0)) );
#else
Perl_croak(aTHX_ "%s does not define $%s::VERSION--version check failed",
req = VSTRINGIFY(req);
sv = VSTRINGIFY(sv);
}
- Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
- "this is only version %"SVf"", HEKfARG(HvNAME_HEK(pkg)),
+ Perl_croak(aTHX_ "%" HEKf " version %" SVf " required--"
+ "this is only version %" SVf, HEKfARG(HvNAME_HEK(pkg)),
SVfARG(sv_2mortal(req)),
SVfARG(sv_2mortal(sv)));
}
VXS(version_new)
{
- dVAR;
dXSARGS;
- SV *vs = items ? ST(1) : &PL_sv_undef;
+ SV *vs;
SV *rv;
const char * classname = "";
STRLEN len;
SP -= items;
- if (items > 3 || items == 0)
- Perl_croak(aTHX_ "Usage: version::new(class, version)");
-
- /* Just in case this is something like a tied hash */
- SvGETMAGIC(vs);
-
- if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
- /* create empty object */
- vs = sv_newmortal();
- sv_setpvs(vs,"undef");
- }
- else if (items == 3 ) {
+ switch((U32)items) {
+ case 3: {
SV * svarg2;
vs = sv_newmortal();
svarg2 = ST(2);
#else
Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(svarg2));
#endif
+ break;
}
+ case 2:
+ vs = ST(1);
+ /* Just in case this is something like a tied hash */
+ SvGETMAGIC(vs);
+ if(SvOK(vs))
+ break;
+ /* fall through */
+ case 1:
+ /* no param or explicit undef */
+ /* create empty object */
+ vs = sv_newmortal();
+ sv_setpvs(vs,"undef");
+ break;
+ default:
+ case 0:
+ Perl_croak_nocontext("Usage: version::new(class, version)");
+ }
+
svarg0 = ST(0);
if ( sv_isobject(svarg0) ) {
/* get the class if called as an object method */
#endif
}
else {
- classname = SvPV(svarg0, len);
+ classname = SvPV_nomg(svarg0, len);
flags = SvUTF8(svarg0);
}
sv_bless(rv, gv_stashpvn(classname, len, GV_ADD | flags));
#endif
- mPUSHs(rv);
- PUTBACK;
- return;
+ VXS_RETURN_M_SV(rv);
}
#define VTYPECHECK(var, val, varname) \
(var) = SvRV(sv_vtc); \
} \
else \
- Perl_croak(aTHX_ varname " is not of type version"); \
+ Perl_croak_nocontext(varname " is not of type version"); \
} STMT_END
VXS(version_stringify)
{
- dVAR;
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "lobj, ...");
SV * lobj;
VTYPECHECK(lobj, ST(0), "lobj");
- mPUSHs(VSTRINGIFY(lobj));
-
- PUTBACK;
- return;
+ VXS_RETURN_M_SV(VSTRINGIFY(lobj));
}
}
VXS(version_numify)
{
- dVAR;
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "lobj, ...");
{
SV * lobj;
VTYPECHECK(lobj, ST(0), "lobj");
- mPUSHs(VNUMIFY(lobj));
- PUTBACK;
- return;
+ VXS_RETURN_M_SV(VNUMIFY(lobj));
}
}
VXS(version_normal)
{
- dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "ver");
SV * ver;
VTYPECHECK(ver, ST(0), "ver");
- mPUSHs(VNORMAL(ver));
-
- PUTBACK;
- return;
+ VXS_RETURN_M_SV(VNORMAL(ver));
}
}
VXS(version_vcmp)
{
- dVAR;
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "lobj, ...");
rs = newSViv(VCMP(lobj,rvs));
}
- mPUSHs(rs);
+ VXS_RETURN_M_SV(rs);
}
-
- PUTBACK;
- return;
}
}
VXS(version_boolean)
{
- dVAR;
dXSARGS;
SV *lobj;
if (items < 1)
))
)
);
- mPUSHs(rs);
- PUTBACK;
- return;
+ VXS_RETURN_M_SV(rs);
}
}
VXS(version_noop)
{
- dVAR;
dXSARGS;
if (items < 1)
croak_xs_usage(cv, "lobj, ...");
void
S_version_check_key(pTHX_ CV * cv, const char * key, int keylen)
{
- dVAR;
dXSARGS;
if (items != 1)
croak_xs_usage(cv, "lobj");
VXS(version_qv)
{
- dVAR;
dXSARGS;
PERL_UNUSED_ARG(cv);
SP -= items;