add xs_handshake API

This API elevates the amount of ABI compatibility protection between XS
modules and the interp. It also makes each boot XSUB smaller in machine
code by removing function calls and factoring out code into the new
Perl_xs_handshake and Perl_xs_epilog functions.

sv.c :
- revise padlist duping code to reduce code bloat/asserts on DEBUGGING

ext/DynaLoader/dlutils.c :
- disable version checking so interp startup is faster, ABI mismatches are
  impossible because DynaLoader is never available as a shared library

ext/XS-APItest/XSUB-redefined-macros.xs :
- "" means dont check the version, so switch to " " to make the test in
  xsub_h.t pass, see ML thread "XS_APIVERSION_BOOTCHECK and XS_VERSION
  is CPP defined but "", mow what?"

ext/re/re.xs :
- disable API version checking until #123007 is resolved

ParseXS/Utilities.pm :
109-standard_XS_defs.t :
- remove context from S_croak_xs_usage similar to core commit cb077ed296 .
  CvGV doesn't need a context until 5.21.4 and commit ae77754ae2 and
  by then core's croak_xs_uage API has been long available and this
  backport doesn't need to account for newer perls
- fix test where lack of having PERL_IMPLICIT_CONTEXT caused it to fail

26 files changed, 332 insertions, 68 deletions

diff --git a/XSUB.h b/XSUB.h
index 004a0d678b..547cd46eb9 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -170,6 +170,17 @@ is a lexical $_ in scope.
 #else
 #  define dXSARGS \
 	dSP; dAXMARK; dITEMS
+/* These 2 macros are specialized replacements for dXSARGS macro. They may be
+   replaced with dXSARGS if no version checking is desired. The 2 macros factor
+   out common code in every BOOT XSUB. Computation of vars mark and items will
+   optimize away in most BOOT functions. Var ax can never be optimized away
+   since BOOT must return &PL_sv_yes by default from xsubpp */
+#  define dXSBOOTARGSXSAPIVERCHK  \
+	I32 ax = XS_BOTHVERSION_POPMARK_BOOTCHECK;	\
+	SV **mark = PL_stack_base + ax; dSP; dITEMS
+#  define dXSBOOTARGSAPIVERCHK  \
+	I32 ax = XS_APIVERSION_POPMARK_BOOTCHECK;	\
+	SV **mark = PL_stack_base + ax; dSP; dITEMS
 #endif
 
 #define dXSTARG SV * const targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
@@ -325,13 +336,36 @@ Rethrows a previously caught exception.  See L<perlguts/"Exception Handling">.
 
 #ifdef XS_VERSION
 #  define XS_VERSION_BOOTCHECK						\
-    Perl_xs_version_bootcheck(aTHX_ items, ax, STR_WITH_LEN(XS_VERSION))
+    Perl_xs_handshake(HS_KEY(FALSE, "", XS_VERSION), HS_CXT, items, ax, XS_VERSION)
 #else
 #  define XS_VERSION_BOOTCHECK
 #endif
 
 #define XS_APIVERSION_BOOTCHECK						\
-    Perl_xs_apiversion_bootcheck(ST(0), STR_WITH_LEN("v" PERL_API_VERSION_STRING))
+    Perl_xs_handshake(HS_KEY(FALSE, "v" PERL_API_VERSION_STRING, ""), HS_CXT, items, ax, "v" PERL_API_VERSION_STRING)
+/* public API, this is a combination of XS_VERSION_BOOTCHECK and
+   XS_APIVERSION_BOOTCHECK in 1, and is backportable */
+#ifdef XS_VERSION
+#  define XS_BOTHVERSION_BOOTCHECK						\
+    Perl_xs_handshake(HS_KEY(FALSE, "v" PERL_API_VERSION_STRING, XS_VERSION)	\
+    , HS_CXT, items, ax, "v" PERL_API_VERSION_STRING, XS_VERSION)
+#else
+/* should this be a #error? if you want both checked, you better supply XS_VERSION right? */
+#  define XS_BOTHVERSION_BOOTCHECK XS_APIVERSION_BOOTCHECK
+#endif
+
+/* private API */
+#  define XS_APIVERSION_POPMARK_BOOTCHECK					\
+    Perl_xs_handshake(HS_KEY(TRUE, "v" PERL_API_VERSION_STRING, "")	\
+    , HS_CXT, "v" PERL_API_VERSION_STRING)
+#ifdef XS_VERSION
+#  define XS_BOTHVERSION_POPMARK_BOOTCHECK					\
+    Perl_xs_handshake(HS_KEY(TRUE, "v" PERL_API_VERSION_STRING, XS_VERSION)	\
+    , HS_CXT, "v" PERL_API_VERSION_STRING, XS_VERSION)
+#else
+/* should this be a #error? if you want both checked, you better supply XS_VERSION right? */
+#  define XS_BOTHVERSION_POPMARK_BOOTCHECK XS_APIVERSION_POPMARK_BOOTCHECK
+#endif
 
 #ifdef NO_XSLOCKS
 #  define dXCPT             dJMPENV; int rEtV = 0
diff --git a/cv.h b/cv.h
index f532b4524c..d7106b1469 100644
--- a/cv.h
+++ b/cv.h
@@ -75,9 +75,8 @@ See L<perlguts/Autoloading with XSUBs>.
 #else
 #  define CvPADLIST_set(sv, padlist) (CvPADLIST(sv) = (padlist))
 #endif
-/* CvRESERVED is a placeholder and will be going away soon */
-#define CvRESERVED(sv)	  *(assert_(CvISXSUB((CV*)(sv))) \
-	&(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_reserved))
+#define CvHSCXT(sv)	  *(assert_(CvISXSUB((CV*)(sv))) \
+	&(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_hscxt))
 #ifdef DEBUGGING
 #  if PTRSIZE == 8
 #    define PoisonPADLIST(sv) \
diff --git a/dist/ExtUtils-ParseXS/Changes b/dist/ExtUtils-ParseXS/Changes
index 41966fd1cc..233a8a1302 100644
--- a/dist/ExtUtils-ParseXS/Changes
+++ b/dist/ExtUtils-ParseXS/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension ExtUtils::ParseXS.
 
+3.26 - not released yet
+  - Support added for XS handshake API introduced in 5.21.6.
+  - backported S_croak_xs_usage optimized on threaded builds
+
 3.24 - Wed Mar  5 18:20:00 CET 2014
   - Native Android build fixes
   - More lenient syntax for embedded TYPEMAP blocks in XS:
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index d63bcc682f..70a6445b16 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -891,11 +891,13 @@ EOF
   print Q(<<"EOF");
 #XS_EXTERNAL(boot_$self->{Module_cname}); /* prototype to pass -Wmissing-prototypes */
 #XS_EXTERNAL(boot_$self->{Module_cname})
-EOF
-
-  print Q(<<"EOF");
 #[[
+##if PERL_VERSION_LE(5, 21, 5)
 #    dVAR; dXSARGS;
+##else
+#    dVAR; ${\($self->{WantVersionChk} ?
+     'dXSBOOTARGSXSAPIVERCHK;' : 'dXSBOOTARGSAPIVERCHK;')}
+##endif
 EOF
 
   #Under 5.8.x and lower, newXS is declared in proto.h as expecting a non-const
@@ -916,15 +918,26 @@ EOF
   print Q(<<"EOF");
 #    PERL_UNUSED_VAR(cv); /* -W */
 #    PERL_UNUSED_VAR(items); /* -W */
-##ifdef XS_APIVERSION_BOOTCHECK
+EOF
+
+  if( $self->{WantVersionChk}){
+    print Q(<<"EOF") ;
+##if PERL_VERSION_LE(5, 21, 5)
+#    XS_VERSION_BOOTCHECK;
+##  ifdef XS_APIVERSION_BOOTCHECK
 #    XS_APIVERSION_BOOTCHECK;
+##  endif
 ##endif
+
 EOF
+  } else {
+    print Q(<<"EOF") ;
+##if PERL_VERSION_LE(5, 21, 5) && defined(XS_APIVERSION_BOOTCHECK)
+#  XS_APIVERSION_BOOTCHECK;
+##endif
 
-  print Q(<<"EOF") if $self->{WantVersionChk};
-#    XS_VERSION_BOOTCHECK;
-#
 EOF
+  }
 
   print Q(<<"EOF") if defined $self->{XsubAliases} or defined $self->{interfaces};
 #    {
@@ -960,14 +973,15 @@ EOF
   }
 
   print Q(<<'EOF');
-##if (PERL_REVISION == 5 && PERL_VERSION >= 9)
-#  if (PL_unitcheckav)
-#       call_list(PL_scopestack_ix, PL_unitcheckav);
-##endif
-EOF
-
-  print Q(<<"EOF");
+##if PERL_VERSION_LE(5, 21, 5)
+##  if PERL_VERSION_GE(5, 9, 0)
+#    if (PL_unitcheckav)
+#        call_list(PL_scopestack_ix, PL_unitcheckav);
+##  endif
 #    XSRETURN_YES;
+##else
+#    Perl_xs_boot_epilog(aTHX_ ax);
+##endif
 #]]
 #
 EOF
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index 1a1f171d9c..7f957595fd 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -453,10 +453,10 @@ EOF
 
 /* prototype to pass -Wmissing-prototypes */
 STATIC void
-S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);
+S_croak_xs_usage(const CV *const cv, const char *const params);
 
 STATIC void
-S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+S_croak_xs_usage(const CV *const cv, const char *const params)
 {
     const GV *const gv = CvGV(cv);
 
@@ -468,21 +468,17 @@ S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
         const char *const hvname = stash ? HvNAME(stash) : NULL;
 
         if (hvname)
-            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
+	    Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
         else
-            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
+	    Perl_croak_nocontext("Usage: %s(%s)", gvname, 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);
     }
 }
 #undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE
 
-#ifdef PERL_IMPLICIT_CONTEXT
-#define croak_xs_usage(a,b)    S_croak_xs_usage(aTHX_ a,b)
-#else
 #define croak_xs_usage        S_croak_xs_usage
-#endif
 
 #endif
 
diff --git a/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t b/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t
index 0d11c47841..da039205e3 100644
--- a/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t
+++ b/dist/ExtUtils-ParseXS/t/109-standard_XS_defs.t
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 $| = 1;
-use Test::More tests => 5;
+use Test::More tests => 4;
 use File::Spec;
 use lib (-d 't' ? File::Spec->catdir(qw(t lib)) : 'lib');
 use ExtUtils::ParseXS::Utilities qw(
@@ -13,7 +13,6 @@ use PrimitiveCapture;
 my @statements = (
     '#ifndef PERL_UNUSED_VAR',
     '#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE',
-    '#ifdef PERL_IMPLICIT_CONTEXT',
     '#ifdef newXS_flags',
 );
 
diff --git a/dump.c b/dump.c
index 62e29dae36..26544022e5 100644
--- a/dump.c
+++ b/dump.c
@@ -1990,7 +1990,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	    }
 	}
 	else
-	    Perl_dump_indent(aTHX_ level, file, "  RESERVED = 0x%p\n", CvRESERVED(sv));
+	    Perl_dump_indent(aTHX_ level, file, "  HSCXT = 0x%p\n", CvHSCXT(sv));
 	{
 	    const CV * const outside = CvOUTSIDE(sv);
 	    Perl_dump_indent(aTHX_ level, file, "  OUTSIDE = 0x%"UVxf" (%s)\n",
diff --git a/embed.fnc b/embed.fnc
index 3b43acd0d1..7a733fb053 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -275,6 +275,7 @@ Anprd	|void	|croak_xs_usage	|NN const CV *const cv \
 				|NN const char *const params
 npr	|void	|croak_no_mem
 nprX	|void	|croak_popstack
+fnprx	|void	|noperl_die|NN const char* pat|...
 #if defined(WIN32)
 norx	|void	|win32_croak_not_implemented|NN const char * fname
 #endif
@@ -2695,11 +2696,8 @@ Apo	|void*	|my_cxt_init	|NN int *index|size_t size
 : XS_VERSION_BOOTCHECK
 Xpo	|void	|xs_version_bootcheck|U32 items|U32 ax|NN const char *xs_p \
 				|STRLEN xs_len
-: This function is an implementation detail. The public API for this is
-: XS_APIVERSION_BOOTCHECK
-Xpon	|void	|xs_apiversion_bootcheck|NN SV *module|NN const char *api_p \
-				|STRLEN api_len
-
+Xpon	|I32	|xs_handshake	|const U32 key|NN void * v_my_perl|...
+Xp	|void	|xs_boot_epilog	|const U32 ax
 #ifndef HAS_STRLCAT
 Apnod	|Size_t	|my_strlcat	|NULLOK char *dst|NULLOK const char *src|Size_t size
 #endif
diff --git a/embed.h b/embed.h
index 1a98de566f..122b3d0c1c 100644
--- a/embed.h
+++ b/embed.h
@@ -1257,6 +1257,7 @@
 #define newSVavdefelem(a,b,c)	Perl_newSVavdefelem(aTHX_ a,b,c)
 #define newXS_len_flags(a,b,c,d,e,f,g)	Perl_newXS_len_flags(aTHX_ a,b,c,d,e,f,g)
 #define nextargv(a,b)		Perl_nextargv(aTHX_ a,b)
+#define noperl_die		Perl_noperl_die
 #define oopsAV(a)		Perl_oopsAV(aTHX_ a)
 #define oopsHV(a)		Perl_oopsHV(aTHX_ a)
 #define op_const_sv(a,b)	Perl_op_const_sv(aTHX_ a,b)
@@ -1318,6 +1319,7 @@
 #define wait4pid(a,b,c)		Perl_wait4pid(aTHX_ a,b,c)
 #define watch(a)		Perl_watch(aTHX_ a)
 #define write_to_stderr(a)	Perl_write_to_stderr(aTHX_ a)
+#define xs_boot_epilog(a)	Perl_xs_boot_epilog(aTHX_ a)
 #define yyerror(a)		Perl_yyerror(aTHX_ a)
 #define yyerror_pv(a,b)		Perl_yyerror_pv(aTHX_ a,b)
 #define yyerror_pvn(a,b,c)	Perl_yyerror_pvn(aTHX_ a,b,c)
diff --git a/ext/B/B.xs b/ext/B/B.xs
index e4707787d3..f5c332df7c 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1947,10 +1947,10 @@ CvPADLIST(cv)
 #endif
 
 SV *
-CvRESERVED(cv)
+CvHSCXT(cv)
 	B::CV	cv
     CODE:
-	RETVAL = newSViv(CvISXSUB(cv) ? PTR2IV(CvRESERVED(cv)) : 0);
+	RETVAL = newSVuv(CvISXSUB(cv) ? PTR2UV(CvHSCXT(cv)) : 0);
     OUTPUT:
 	RETVAL
 
diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 57dbe41da7..118b35ef6a 100644
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -689,7 +689,7 @@ do_test('constant subroutine',
     FLAGS = 0x100c				# $] >= 5.015
     OUTSIDE_SEQ = 0
     PADLIST = 0x0				# $] < 5.021006
-    RESERVED = $ADDR				# $] >= 5.021006
+    HSCXT = $ADDR				# $] >= 5.021006
     OUTSIDE = 0x0 \\(null\\)');	
 
 do_test('isUV should show on PVMG',
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 70703b15f4..cd489e5129 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -20,6 +20,10 @@
 #endif
 #define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION
 
+/* disable version checking since DynaLoader can't be DynaLoaded */
+#undef dXSBOOTARGSXSAPIVERCHK
+#define dXSBOOTARGSXSAPIVERCHK dXSARGS
+
 typedef struct {
     SV*		x_dl_last_error;	/* pointer to allocated memory for
 					   last error message */
diff --git a/ext/XS-APItest/XSUB-redefined-macros.xs b/ext/XS-APItest/XSUB-redefined-macros.xs
index 275f380d94..ad3132947d 100644
--- a/ext/XS-APItest/XSUB-redefined-macros.xs
+++ b/ext/XS-APItest/XSUB-redefined-macros.xs
@@ -4,7 +4,7 @@
 /* We have to be in a different .xs so that we can do this:  */
 
 #undef XS_VERSION
-#define XS_VERSION ""
+#define XS_VERSION " "
 #undef PERL_API_VERSION_STRING
 #define PERL_API_VERSION_STRING "1.0.16"
 #include "XSUB.h"
diff --git a/ext/re/re.pm b/ext/re/re.pm
index 511c1c4b9a..7c2044e72a 100644
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -4,7 +4,7 @@ package re;
 use strict;
 use warnings;
 
-our $VERSION     = "0.27";
+our $VERSION     = "0.28";
 our @ISA         = qw(Exporter);
 our @EXPORT_OK   = ('regmust',
                     qw(is_regexp regexp_pattern
diff --git a/ext/re/re.xs b/ext/re/re.xs
index 2be0773ffb..444997b4ac 100644
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -8,6 +8,10 @@
 #include "XSUB.h"
 #include "re_comp.h"
 
+#undef dXSBOOTARGSXSAPIVERCHK
+/* skip API version checking due to different interp struct size but,
+   this hack is until #123007 is resolved */
+#define dXSBOOTARGSXSAPIVERCHK dXSARGS
 
 START_EXTERN_C
 
diff --git a/op.c b/op.c
index 27c301918b..0b345187da 100644
--- a/op.c
+++ b/op.c
@@ -8852,7 +8852,11 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
         assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */
         CvISXSUB_on(cv);
         CvXSUB(cv) = subaddr;
+#ifndef PERL_IMPLICIT_CONTEXT
+        CvHSCXT(cv) = &PL_stack_sp;
+#else
         PoisonPADLIST(cv);
+#endif
     
         if (name)
             process_special_blocks(0, name, gv, cv);
diff --git a/pad.c b/pad.c
index 8abd90ad79..6e38f13bc6 100644
--- a/pad.c
+++ b/pad.c
@@ -504,8 +504,8 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags)
 	Safefree(padlist);
 	CvPADLIST_set(&cvbody, NULL);
     }
-    else if (CvISXSUB(&cvbody)) /* future union */
-	CvRESERVED(&cvbody) = NULL;
+    else if (CvISXSUB(&cvbody))
+	CvHSCXT(&cvbody) = NULL;
     /* else is (!CvISXSUB(&cvbody) && !CvPADLIST(&cvbody)) {do nothing;} */
 
 
diff --git a/perl.c b/perl.c
index d61436aec0..a5f159224e 100644
--- a/perl.c
+++ b/perl.c
@@ -5035,6 +5035,15 @@ read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
     return 1;
 }
 
+/* removes boilerplate code at the end of each boot_Module xsub */
+void
+Perl_xs_boot_epilog(pTHX_ const U32 ax)
+{
+  if (PL_unitcheckav)
+	call_list(PL_scopestack_ix, PL_unitcheckav);
+    XSRETURN_YES;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/perl.h b/perl.h
index b31dcb34dd..c7bb858a69 100644
--- a/perl.h
+++ b/perl.h
@@ -5495,6 +5495,26 @@ END_EXTERN_C
 #undef PERLVARI
 #undef PERLVARIC
 
+#if !defined(MULTIPLICITY)
+/* Set up PERLVAR macros for populating structs */
+#  define PERLVAR(prefix,var,type) type prefix##var;
+/* 'var' is an array of length 'n' */
+#  define PERLVARA(prefix,var,n,type) type prefix##var[n];
+/* initialize 'var' to init' */
+#  define PERLVARI(prefix,var,type,init) type prefix##var;
+/* like PERLVARI, but make 'var' a const */
+#  define PERLVARIC(prefix,var,type,init) type prefix##var;
+
+/* this is never instantiated, is it just used for sizeof(struct PerlHandShakeInterpreter) */
+struct PerlHandShakeInterpreter {
+#  include "intrpvar.h"
+};
+#  undef PERLVAR
+#  undef PERLVARA
+#  undef PERLVARI
+#  undef PERLVARIC
+#endif
+
 START_EXTERN_C
 
 /* dummy variables that hold pointers to both runops functions, thus forcing
diff --git a/perlio.c b/perlio.c
index b0e0259014..a05e414b0d 100644
--- a/perlio.c
+++ b/perlio.c
@@ -5217,6 +5217,22 @@ vfprintf(FILE *fd, char *pat, char *args)
 
 #endif
 
+/* print a failure format string message to stderr and fail exit the process
+   using only libc without depending on any perl data structures being
+   initialized.
+*/
+
+void
+Perl_noperl_die(const char* pat, ...)
+{
+    va_list(arglist);
+    PERL_ARGS_ASSERT_NOPERL_DIE;
+    va_start(arglist, pat);
+    vfprintf(stderr, pat, arglist);
+    va_end(arglist);
+    exit(1);
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index c4264b44d4..86a525b848 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -549,6 +549,12 @@ copiable.
 (P) When starting a new thread or returning values from a thread, Perl
 encountered an invalid data type.
 
+=item BOOT:: Invalid handshake key got %X needed %X, binaries are mismatched
+
+(P) A dynamic loading library C<.so> or C<.dll> was being loaded into the
+process that was built against a different build of perl than the said
+library was compiled against.
+
 =item Buffer overflow in prime_env_iter: %s
 
 (W internal) A warning peculiar to VMS.  While Perl was preparing to
diff --git a/proto.h b/proto.h
index 95ad1beec9..ee8ba004d3 100644
--- a/proto.h
+++ b/proto.h
@@ -3164,6 +3164,13 @@ PERL_CALLCONV char*	Perl_ninstr(const char* big, const char* bigend, const char*
 #define PERL_ARGS_ASSERT_NINSTR	\
 	assert(big); assert(bigend); assert(little); assert(lend)
 
+PERL_CALLCONV_NO_RET void	Perl_noperl_die(const char* pat, ...)
+			__attribute__noreturn__
+			__attribute__format__(__printf__,1,2)
+			__attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_NOPERL_DIE	\
+	assert(pat)
+
 PERL_CALLCONV int	Perl_nothreadhook(pTHX);
 PERL_CALLCONV OP*	Perl_oopsAV(pTHX_ OP* o)
 			__attribute__warn_unused_result__
@@ -5153,11 +5160,11 @@ PERL_CALLCONV void	Perl_write_to_stderr(pTHX_ SV* msv)
 #define PERL_ARGS_ASSERT_WRITE_TO_STDERR	\
 	assert(msv)
 
-PERL_CALLCONV void	Perl_xs_apiversion_bootcheck(SV *module, const char *api_p, STRLEN api_len)
-			__attribute__nonnull__(1)
+PERL_CALLCONV void	Perl_xs_boot_epilog(pTHX_ const U32 ax);
+PERL_CALLCONV I32	Perl_xs_handshake(const U32 key, void * v_my_perl, ...)
 			__attribute__nonnull__(2);
-#define PERL_ARGS_ASSERT_XS_APIVERSION_BOOTCHECK	\
-	assert(module); assert(api_p)
+#define PERL_ARGS_ASSERT_XS_HANDSHAKE	\
+	assert(v_my_perl)
 
 PERL_CALLCONV void	Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p, STRLEN xs_len)
 			__attribute__nonnull__(pTHX_3);
diff --git a/sv.c b/sv.c
index 6b56726f84..d3f10e2ca1 100644
--- a/sv.c
+++ b/sv.c
@@ -13631,13 +13631,14 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 			: gv_dup(CvGV(sstr), param);
 
 		if (!CvISXSUB(sstr)) {
-                    if(CvPADLIST(sstr))
-                        CvPADLIST_set(dstr, padlist_dup(CvPADLIST(sstr), param));
-                    else
-                        CvPADLIST_set(dstr, NULL);
-                } else { /* future union here */
-                    CvRESERVED(dstr) = NULL;
-                }
+		    PADLIST * padlist = CvPADLIST(sstr);
+		    if(padlist)
+			padlist = padlist_dup(padlist, param);
+		    CvPADLIST_set(dstr, padlist);
+		} else
+/* unthreaded perl can't sv_dup so we dont support unthreaded's CvHSCXT */
+		    PoisonPADLIST(dstr);
+
 		CvOUTSIDE(dstr)	=
 		    CvWEAKOUTSIDE(sstr)
 		    ? cv_dup(    CvOUTSIDE(dstr), param)
diff --git a/sv.h b/sv.h
index b8618174ea..bb3d57296a 100644
--- a/sv.h
+++ b/sv.h
@@ -594,7 +594,7 @@ typedef U32 cv_flags_t;
     char *	xcv_file;							\
     union {									\
 	PADLIST *	xcv_padlist;						\
-	void *		xcv_reserved;						\
+	void *		xcv_hscxt;						\
     }		xcv_padlist_u;							\
     CV *	xcv_outside;							\
     U32		xcv_outside_seq; /* the COP sequence (at the point of our	\
diff --git a/util.c b/util.c
index d12ac8895d..e1753870bf 100644
--- a/util.c
+++ b/util.c
@@ -5331,6 +5331,108 @@ Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
 #endif /* #ifndef PERL_GLOBAL_STRUCT_PRIVATE */
 #endif /* PERL_IMPLICIT_CONTEXT */
 
+
+/* The meaning of the varargs is determined U32 key arg. This is not a format
+   string. The U32 key is assembled with HS_KEY.
+
+   v_my_perl arg is "PerlInterpreter * my_perl" if PERL_IMPLICIT_CONTEXT and
+   otherwise "CV * cv" (boot xsub's CV *). v_my_perl will catch where a threaded
+   future perl526.dll calling IO.dll for example, and IO.dll was linked with
+   threaded perl524.dll, and both perl526.dll and perl524.dll are in %PATH and
+   the Win32 DLL loader sucessfully can load IO.dll into the process but
+   simultaniously it loaded a interp of a different version into the process,
+   and XS code will naturally pass SV*s created by perl524.dll for perl526.dll
+   to use through perl526.dll's my_perl->Istack_base.
+
+   v_my_perl (v=void) can not be the first arg since then key will be out of
+   place in a threaded vs non-threaded mixup and analyzing the key number's
+   bitfields won't reveal the problem since it will be a valid key
+   (unthreaded perl) on interp side, but croak reports the XS mod's key as
+   gibberish (it is really my_perl ptr) (threaded XS mod), or if threaded perl
+   and unthreaded XS module, threaded perl will look at uninit C stack or uninit
+   register to get var key (remember it assumes 1st arg is interp cxt).
+
+Perl_xs_handshake(U32 key, void * v_my_perl, [U32 items, U32 ax], [char * api_version], [char * xs_version]) */
+I32
+Perl_xs_handshake(const U32 key, void * v_my_perl, ...)
+{
+    va_list args;
+    U32 items, ax;
+#ifdef PERL_IMPLICIT_CONTEXT
+    dTHX;
+#endif
+    PERL_ARGS_ASSERT_XS_HANDSHAKE;
+    va_start(args, v_my_perl);
+
+    if((key & HSm_KEY_MATCH) != (HS_KEY(FALSE, "", "") & HSm_KEY_MATCH))
+	noperl_die("BOOT:: Invalid handshake key got %X needed %X"
+			", binaries are mismatched",    (key & HSm_KEY_MATCH)
+			, (HS_KEY(FALSE, "", "") & HSm_KEY_MATCH));
+/* try to catch where a 2nd threaded perl interp DLL is loaded into a process
+   by a XS DLL compiled against the wrong interl DLL b/c of bad @INC, and the
+   2nd threaded perl interp DLL never initialized its TLS/PERL_SYS_INIT3 so
+   dTHX call from 2nd interp DLL can't return the my_perl that pp_entersub
+   passed to the XS DLL */
+    {
+	void * got;
+	void * need;
+#ifdef PERL_IMPLICIT_CONTEXT
+	tTHX xs_interp = (tTHX)v_my_perl;
+	got = xs_interp;
+	need = my_perl;
+#else
+/* try to catch where an unthreaded perl interp DLL (for ex. perl522.dll) is
+   loaded into a process by a XS DLL built by an unthreaded perl522.dll perl,
+   but the DynaLoder/Perl that started the process and loaded the XS DLL is
+   unthreaded perl524.dll, since unthreadeds don't pass my_perl (a unique *)
+   through pp_entersub, use a unique value (which is a pointer to PL_stack_sp's
+   location in the unthreaded perl binary) stored in CV * to figure out if this
+   Perl_xs_handshake was called by the same pp_entersub */
+	CV* cv = (CV*)v_my_perl;
+	SV *** xs_spp = (SV***)CvHSCXT(cv);
+	got = xs_spp;
+	need = &PL_stack_sp;
+#endif
+	if(got != need)/* recycle branch and string from above */
+	    noperl_die("BOOT:: Invalid handshake key got %X needed %X"
+			    ", binaries are mismatched", got, need);
+    }
+
+    if(key & HSf_POPMARK) {
+	ax = POPMARK;
+	{   SV **mark = PL_stack_base + ax++;
+	    {   dSP;
+		items = (I32)(SP - MARK);
+	    }
+	}
+    } else {
+	items = va_arg(args, U32);
+	ax = va_arg(args, U32);
+    }
+    {
+	U32 apiverlen;
+	assert(HS_GETAPIVERLEN(key) <= UCHAR_MAX);
+	if(apiverlen = HS_GETAPIVERLEN(key)) {
+	    char * api_p = va_arg(args, char*);
+	    if(apiverlen != sizeof("v" PERL_API_VERSION_STRING)-1
+		|| memNE(api_p, "v" PERL_API_VERSION_STRING,
+			 sizeof("v" PERL_API_VERSION_STRING)-1))
+		Perl_croak_nocontext("Perl API version %s of %"SVf" does not match %s",
+				    api_p, SVfARG(PL_stack_base[ax + 0]),
+				    "v" PERL_API_VERSION_STRING);
+	}
+    }
+    {
+	U32 xsverlen;
+	assert(HS_GETXSVERLEN(key) <= UCHAR_MAX && HS_GETXSVERLEN(key) <= HS_APIVERLEN_MAX);
+	if(xsverlen = HS_GETXSVERLEN(key))
+	    Perl_xs_version_bootcheck(aTHX_
+		items, ax, va_arg(args, char*), xsverlen);
+    }
+    va_end(args);
+    return ax;
+}
+
 void
 Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
 			  STRLEN xs_len)
@@ -5379,19 +5481,6 @@ Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
     }
 }
 
-void
-Perl_xs_apiversion_bootcheck(SV *module, const char *api_p,
-			     STRLEN api_len)
-{
-    PERL_ARGS_ASSERT_XS_APIVERSION_BOOTCHECK;
-
-    if(api_len != sizeof("v" PERL_API_VERSION_STRING)-1
-	|| memNE(api_p, "v" PERL_API_VERSION_STRING, sizeof("v" PERL_API_VERSION_STRING)-1)) {
-	Perl_croak_nocontext("Perl API version %s of %"SVf" does not match %s",
-			    api_p, SVfARG(module), "v" PERL_API_VERSION_STRING);
-    }
-}
-
 /*
 =for apidoc my_strlcat
 
diff --git a/util.h b/util.h
index 736f978edf..172723353c 100644
--- a/util.h
+++ b/util.h
@@ -163,6 +163,64 @@ typedef struct {
 
 #endif /* USE_C_BACKTRACE */
 
+/* Use a packed 32 bit constant "key" to start the handshake. The key defines
+   ABI compatibility, and how to process the vararg list.
+
+   Note, some bits may be taken from INTRPSIZE (but then a simple x86 AX register
+   can't be used to read it) and 4 bits from API version len can also be taken,
+   since v00.00.00 is 9 bytes long. XS version length should not have any bits
+   taken since XS_VERSION lengths can get quite long since they are user
+   selectable. These spare bits allow for additional features for the varargs
+   stuff or ABI compat test flags in the future.
+*/
+#define HSm_APIVERLEN 0x0000003F /* perl version string won't be more than 63 chars */
+#define HS_APIVERLEN_MAX HSm_APIVERLEN
+#define HSm_XSVERLEN 0x0000FF00 /* if 0, not present, dont check, die if over 255*/
+#define HS_XSVERLEN_MAX 0xFF
+#define HSf_POPMARK 0x00000040 /* popmark mode or you must supply ax and items */
+#define HSf_IMP_CXT 0x00000080 /* ABI, threaded/PERL_IMPLICIT_CONTEXT, pTHX_ present */
+#define HSm_INTRPSIZE 0xFFFF0000 /* ABI, interp struct size */
+/* a mask where these bits must always match between a XS mod and interp */
+/* and maybe HSm_APIVERLEN one day if Perl_xs_apiversion_bootcheck is changed to a memcmp */
+#define HSm_KEY_MATCH (HSm_INTRPSIZE|HSf_IMP_CXT)
+
+
+#define HS_GETINTERPSIZE(key) ((key) >> 16)
+/* if in the future "" and NULL must be separated, XSVERLEN would be 0
+means arg not present, 1 is empty string/null byte */
+/* (((key) & 0x0000FF00) >> 8) is less efficient on Visual C */
+#define HS_GETXSVERLEN(key) ((key) >> 8 & 0xFF)
+#define HS_GETAPIVERLEN(key) ((key) & HSm_APIVERLEN)
+
+/* internal to util.h macro to create a packed handshake key, all args must be constants */
+/* U32 return = (U16 interpsize, bool cxt, bool popmark, U6 (SIX!) apiverlen, U8 xsverlen) */
+#define HS_KEYp(interpsize, cxt, popmark, apiverlen, xsverlen) \
+    (((interpsize)  << 16) \
+    | ((xsverlen) > HS_XSVERLEN_MAX \
+        ? (Perl_croak_nocontext("panic: handshake overflow"), HS_XSVERLEN_MAX) \
+        : (xsverlen) << 8) \
+    | (cBOOL(cxt) ? HSf_IMP_CXT : 0) \
+    | (cBOOL(popmark) ? HSf_POPMARK : 0) \
+    | ((apiverlen) > HS_APIVERLEN_MAX \
+        ? (Perl_croak_nocontext("panic: handshake overflow"), HS_APIVERLEN_MAX) \
+        : (apiverlen)))
+/* overflows above will optimize away unless they will execute */
+
+/* public macro for core usage to create a packed handshake key but this is
+   not public API. This more friendly version already collected all ABI info */
+/* U32 return = (bool popmark, "litteral_string_api_ver", "litteral_string_xs_ver") */
+#ifdef PERL_IMPLICIT_CONTEXT
+#  define HS_KEY(popmark, apiver, xsver) \
+    HS_KEYp(sizeof(PerlInterpreter), TRUE, popmark, \
+    sizeof("" apiver "")-1, sizeof("" xsver "")-1)
+#  define HS_CXT aTHX
+#else
+#  define HS_KEY(popmark, apiver, xsver) \
+    HS_KEYp(sizeof(struct PerlHandShakeInterpreter), FALSE, popmark, \
+    sizeof("" apiver "")-1, sizeof("" xsver "")-1)
+#  define HS_CXT cv
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd