Lots of C optimizations for both speed/correctness

Clean up a lot of the less efficient uses of various Perl
macros and functions, mostly from bulk88@hotmail.com.  Also
deal with the fact that older Perl's were not handling locale
setting in a consistent manner.  This means going back to the
less efficient but always correct method of ALWAYS copying the
old locale and switch to C and then restoring, for all Perl
releases prior to 5.19.0.  Discontinue support for Perl's prior
to v5.6.2.

1 files changed, 81 insertions, 78 deletions

diff --git a/vxs.inc b/vxs.inc
index 2e4f409390..0a02056561 100644
--- a/vxs.inc
+++ b/vxs.inc
@@ -4,49 +4,53 @@
 #ifdef PERL_CORE
 #  define VXS_CLASS "version"
 #  define VXSp(name) XS_##name
+/* VXSXSDP = XSUB Details Proto */
+#  define VXSXSDP(x) x
 #else
 #  define VXS_CLASS "version::vxs"
 #  define VXSp(name) VXS_##name
+/* 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))
 
 #ifdef VXS_XSUB_DETAILS
 #  ifdef PERL_CORE
-    {"UNIVERSAL::VERSION", VXSp(universal_version), NULL},
+    {"UNIVERSAL::VERSION", VXSp(universal_version), VXSXSDP(NULL)},
 #  endif
-    {VXS_CLASS "::_VERSION", VXSp(universal_version), NULL},
-    {VXS_CLASS "::()", VXSp(version_noop), NULL},
-    {VXS_CLASS "::new", VXSp(version_new), NULL},
-    {VXS_CLASS "::parse", VXSp(version_new), NULL},
-    {VXS_CLASS "::(\"\"", VXSp(version_stringify), NULL},
-    {VXS_CLASS "::stringify", VXSp(version_stringify), NULL},
-    {VXS_CLASS "::(0+", VXSp(version_numify), NULL},
-    {VXS_CLASS "::numify", VXSp(version_numify), NULL},
-    {VXS_CLASS "::normal", VXSp(version_normal), NULL},
-    {VXS_CLASS "::(cmp", VXSp(version_vcmp), NULL},
-    {VXS_CLASS "::(<=>", VXSp(version_vcmp), NULL},
+    {VXS_CLASS "::_VERSION", VXSp(universal_version), VXSXSDP(NULL)},
+    {VXS_CLASS "::()", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::new", VXSp(version_new), VXSXSDP(NULL)},
+    {VXS_CLASS "::parse", VXSp(version_new), VXSXSDP(NULL)},
+    {VXS_CLASS "::(\"\"", VXSp(version_stringify), VXSXSDP(NULL)},
+    {VXS_CLASS "::stringify", VXSp(version_stringify), VXSXSDP(NULL)},
+    {VXS_CLASS "::(0+", VXSp(version_numify), VXSXSDP(NULL)},
+    {VXS_CLASS "::numify", VXSp(version_numify), VXSXSDP(NULL)},
+    {VXS_CLASS "::normal", VXSp(version_normal), VXSXSDP(NULL)},
+    {VXS_CLASS "::(cmp", VXSp(version_vcmp), VXSXSDP(NULL)},
+    {VXS_CLASS "::(<=>", VXSp(version_vcmp), VXSXSDP(NULL)},
 #  ifdef PERL_CORE
-    {VXS_CLASS "::vcmp", XS_version_vcmp, NULL},
+    {VXS_CLASS "::vcmp", XS_version_vcmp, VXSXSDP(NULL)},
 #  else
-    {VXS_CLASS "::VCMP", VXS_version_vcmp, NULL},
+    {VXS_CLASS "::VCMP", VXS_version_vcmp, VXSXSDP(NULL)},
 #  endif
-    {VXS_CLASS "::(bool", VXSp(version_boolean), NULL},
-    {VXS_CLASS "::boolean", VXSp(version_boolean), NULL},
-    {VXS_CLASS "::(+", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(-", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(*", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(/", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(+=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(-=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(*=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(/=", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(abs", VXSp(version_noop), NULL},
-    {VXS_CLASS "::(nomethod", VXSp(version_noop), NULL},
-    {VXS_CLASS "::noop", VXSp(version_noop), NULL},
-    {VXS_CLASS "::is_alpha", VXSp(version_is_alpha), NULL},
-    {VXS_CLASS "::qv", VXSp(version_qv), NULL},
-    {VXS_CLASS "::declare", VXSp(version_qv), NULL},
-    {VXS_CLASS "::is_qv", VXSp(version_is_qv), NULL},
+    {VXS_CLASS "::(bool", VXSp(version_boolean), VXSXSDP(NULL)},
+    {VXS_CLASS "::boolean", VXSp(version_boolean), VXSXSDP(NULL)},
+    {VXS_CLASS "::(+", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(-", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(*", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(/", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(+=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(-=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(*=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(/=", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(abs", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::(nomethod", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::noop", VXSp(version_noop), VXSXSDP(NULL)},
+    {VXS_CLASS "::is_alpha", VXSp(version_is_alpha), VXSXSDP(NULL)},
+    {VXS_CLASS "::qv", VXSp(version_qv), VXSXSDP(NULL)},
+    {VXS_CLASS "::declare", VXSp(version_qv), VXSXSDP(NULL)},
+    {VXS_CLASS "::is_qv", VXSp(version_is_qv), VXSXSDP(NULL)},
 #else
 
 #ifndef dVAR
@@ -73,7 +77,6 @@ VXS(universal_version)
     HV *pkg;
     GV **gvp;
     GV *gv;
-    SV *ret;
     SV *sv;
     const char *undef;
     PERL_UNUSED_ARG(cv);
@@ -97,12 +100,12 @@ VXS(universal_version)
 
     if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
         sv = sv_mortalcopy(sv);
-	if ( ! ISA_CLASS_OBJ(sv, "version"))
+	if ( ! ISA_VERSION_OBJ(sv) )
 	    UPG_VERSION(sv, FALSE);
         undef = NULL;
     }
     else {
-        sv = ret = &PL_sv_undef;
+        sv = &PL_sv_undef;
         undef = "(undef)";
     }
 
@@ -135,7 +138,7 @@ VXS(universal_version)
 	    }
 	}
 
-	if ( ! ISA_CLASS_OBJ(req, "version")) {
+	if ( ! ISA_VERSION_OBJ(req) ) {
 	    /* req may very well be R/O, so create a new object */
 	    req = sv_2mortal( NEW_VERSION(req) );
 	}
@@ -155,10 +158,9 @@ VXS(universal_version)
 		SVfARG(sv_2mortal(sv)));
 	}
     }
-    ST(0) = ret;
 
     /* if the package's $VERSION is not undef, it is upgraded to be a version object */
-    if (ISA_CLASS_OBJ(sv, "version")) {
+    if (ISA_VERSION_OBJ(sv)) {
 	ST(0) = sv_2mortal(VSTRINGIFY(sv));
     } else {
 	ST(0) = sv;
@@ -176,6 +178,7 @@ VXS(version_new)
     const char * classname = "";
     STRLEN len;
     U32 flags = 0;
+    SV * svarg0 = NULL;
     PERL_UNUSED_VAR(cv);
 
     SP -= items;
@@ -192,16 +195,19 @@ VXS(version_new)
         sv_setpvs(vs,"undef");
     }
     else if (items == 3 ) {
+        SV * svarg2;
         vs = sv_newmortal();
+        svarg2 = ST(2);
 #if PERL_VERSION == 5
-        sv_setpvf(vs,"v%s",SvPV_nolen_const(ST(2)));
+        sv_setpvf(vs,"v%s",SvPV_nolen_const(svarg2));
 #else
-        Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
+        Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(svarg2));
 #endif
     }
-    if ( sv_isobject(ST(0)) ) {
+    svarg0 = ST(0);
+    if ( sv_isobject(svarg0) ) {
 	/* get the class if called as an object method */
-	const HV * stash = SvSTASH(SvRV(ST(0)));
+	const HV * stash = SvSTASH(SvRV(svarg0));
 	classname = HvNAME_get(stash);
 	len	  = HvNAMELEN_get(stash);
 #ifdef HvNAMEUTF8
@@ -209,8 +215,8 @@ VXS(version_new)
 #endif
     }
     else {
-	classname = SvPV(ST(0), len);
-	flags     = SvUTF8(ST(0));
+	classname = SvPV(svarg0, len);
+	flags     = SvUTF8(svarg0);
     }
 
     rv = NEW_VERSION(vs);
@@ -229,8 +235,9 @@ VXS(version_new)
 
 #define VTYPECHECK(var, val, varname) \
     STMT_START {							\
-	if (ISA_CLASS_OBJ(val, "version")) {				\
-	    (var) = SvRV(val);						\
+	SV * sv_vtc = val;						\
+	if (ISA_VERSION_OBJ(sv_vtc)) {				\
+	    (var) = SvRV(sv_vtc);						\
 	}								\
 	else								\
 	    Perl_croak(aTHX_ varname " is not of type version");	\
@@ -304,10 +311,9 @@ VXS(version_vcmp)
 	       SV * robj = ST(1);
 	       const IV	 swap = (IV)SvIV(ST(2));
 
-	       if ( !ISA_CLASS_OBJ(robj, "version") )
+	       if ( !ISA_VERSION_OBJ(robj) )
 	       {
-		    robj = NEW_VERSION(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
-		    sv_2mortal(robj);
+		    robj = sv_2mortal(NEW_VERSION(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP)));
 	       }
 	       rvs = SvRV(robj);
 
@@ -357,32 +363,40 @@ VXS(version_noop)
     dXSARGS;
     if (items < 1)
 	croak_xs_usage(cv, "lobj, ...");
-    if (ISA_CLASS_OBJ(ST(0), "version"))
+    if (ISA_VERSION_OBJ(ST(0)))
 	Perl_croak(aTHX_ "operation not supported with version object");
     else
 	Perl_croak(aTHX_ "lobj is not of type version");
     XSRETURN_EMPTY;
 }
 
-VXS(version_is_alpha)
+static
+void
+S_version_check_key(pTHX_ CV * cv, const char * key, int keylen)
 {
     dVAR;
     dXSARGS;
     if (items != 1)
 	croak_xs_usage(cv, "lobj");
-    SP -= items;
     {
-	SV *lobj;
-	VTYPECHECK(lobj, ST(0), "lobj");
-	if ( hv_exists(MUTABLE_HV(lobj), "alpha", 5 ) )
-	    XSRETURN_YES;
+	SV *lobj = POPs;
+	SV *ret;
+	VTYPECHECK(lobj, lobj, "lobj");
+	if ( hv_exists(MUTABLE_HV(lobj), key, keylen ) )
+	    ret = &PL_sv_yes;
 	else
-	    XSRETURN_NO;
+	    ret = &PL_sv_no;
+	PUSHs(ret);
 	PUTBACK;
 	return;
     }
 }
 
+VXS(version_is_alpha)
+{
+    S_version_check_key(aTHX_ cv, "alpha", 5);
+}
+
 VXS(version_qv)
 {
     dVAR;
@@ -391,20 +405,22 @@ VXS(version_qv)
     SP -= items;
     {
 	SV * ver = ST(0);
+	SV * sv0 = ver;
 	SV * rv;
         STRLEN len = 0;
         const char * classname = "";
         U32 flags = 0;
         if ( items == 2 ) {
-	    SvGETMAGIC(ST(1));
-	    if (SvOK(ST(1))) {
-		ver = ST(1);
+	    SV * sv1 = ST(1);
+	    SvGETMAGIC(sv1);
+	    if (SvOK(sv1)) {
+		ver = sv1;
 	    }
 	    else {
 		Perl_croak(aTHX_ "Invalid version format (version required)");
 	    }
-            if ( sv_isobject(ST(0)) ) { /* class called as an object method */
-                const HV * stash = SvSTASH(SvRV(ST(0)));
+            if ( sv_isobject(sv0) ) { /* class called as an object method */
+                const HV * stash = SvSTASH(SvRV(sv0));
                 classname = HvNAME_get(stash);
                 len       = HvNAMELEN_get(stash);
 #ifdef HvNAMEUTF8
@@ -412,8 +428,8 @@ VXS(version_qv)
 #endif
             }
             else {
-	       classname = SvPV(ST(0), len);
-                flags     = SvUTF8(ST(0));
+	       classname = SvPV(sv0, len);
+                flags     = SvUTF8(sv0);
             }
 	}
 	if ( !SvVOK(ver) ) { /* not already a v-string */
@@ -437,23 +453,10 @@ VXS(version_qv)
     return;
 }
 
+
 VXS(version_is_qv)
 {
-    dVAR;
-    dXSARGS;
-    if (items != 1)
-	croak_xs_usage(cv, "lobj");
-    SP -= items;
-    {
-	SV *lobj;
-	VTYPECHECK(lobj, ST(0), "lobj");
-	if ( hv_exists(MUTABLE_HV(lobj), "qv", 2 ) )
-	    XSRETURN_YES;
-	else
-	    XSRETURN_NO;
-	PUTBACK;
-	return;
-    }
+    S_version_check_key(aTHX_ cv, "qv", 2);
 }
 
 #endif