changeset 33060:897f3ed27be2 v9.0.1818

patch 9.0.1818: dynamically linking perl is broken Commit: https://github.com/vim/vim/commit/55460da26c2756ec057c03c7d8641eda861bfcd2 Author: Christian Brabandt <cb@256bit.org> Date: Tue Aug 29 21:31:28 2023 +0200 patch 9.0.1818: dynamically linking perl is broken Problem: dynamically linking perl is broken Solution: Fix all issues This is a combination of several commits: 1) Fix if_perl.xs not being able to build on all versions of Perl (5.30) This fixes the dynamic builds of Perl interface. The Perl interface file previously had to manually copy and paste misc inline functions verbatim from the Perl headers, because we defined `PERL_NO_INLINE_FUNCTIONS` which prevents us form getting some function definitions. The original reason we defined it was because those inline functions would reference Perl functions that would cause linkage errors. This is a little fragile as every time a new version of Perl comes out, we inevitably have to copy over new versions of inline functions to our file, and it's also easy to miss updates to existing functions. Instead, remove the `PERL_NO_INLINE_FUNCTIONS` define, remove the manual copy-pasted inline functions. Simply add stub implementations of the missing linked functions like `Perl_sv_free2` and forward them to the DLL version of the function at runtime. There are only a few functions that need this treatment, and it's a simple stub so there is very low upkeep compared to copying whole implementations to the file. Also, fix the configure script so that if we are using dynamic linkage, we don't pass `-lperl` to the build flags, to avoid accidental external linkage while using dynamic builds. This is similar to how Python integration works. 2) Fix GIMME_V deprecation warnings in Perl 5.38 Just use GIMME_V, and only use GIMME when using 5.30 to avoid needing to link Perl_block_gimme. We could provide a stub like the other linked functions like Perl_sv_free2, but simply using GIMME is the simplest and it has always worked before. 3) Fix Perl 5.38 issues Fix two issues: 3.1. Perl 5.38 links against more functions in their inline headers, so we need to stub them too. 3.2. Perl 5.38 made Perl_get_context an inline function, but *only* for non-Windows build. Fix that. Note that this was happening in Vim currently, as it would build, but fail to run Perl code at runtime. 4) Fix Perl 5.36/5.38 when thread local is used Perl 5.36 introduced using `_Thread_local` for the current context, which causes inline functions to fail. Create a stub `PL_current_context` thread local variable to satisfy the linker for inlined functions. Note that this is going to result in a different `PL_current_context` being used than the one used in the library, but so far from testing it seems to work. 5) Add docs for how to build Perl for dynamic linking to work closes: #12827 closes: #12914 Signed-off-by: Christian Brabandt <cb@256bit.org> Co-authored-by: Yee Cheng Chin <ychin.git@gmail.com>
author Christian Brabandt <cb@256bit.org>
date Tue, 29 Aug 2023 22:15:03 +0200
parents 2b207221d6d3
children ee9f567bf596
files runtime/doc/if_perl.txt src/auto/configure src/configure.ac src/if_perl.xs src/version.c
diffstat 5 files changed, 80 insertions(+), 229 deletions(-) [+]
line wrap: on
line diff
--- a/runtime/doc/if_perl.txt
+++ b/runtime/doc/if_perl.txt
@@ -297,5 +297,11 @@ instead of DYNAMIC_PERL_DLL file what wa
 version of the shared library must match the Perl version Vim was compiled
 with.
 
+Note: If you are building Perl locally, you have to use a version compiled
+with threading support for it for Vim to successfully link against it. You can
+use the `-Dusethreads` flags when configuring Perl, and check that a Perl
+binary has it enabled by running `perl -V` and verify that `USE_ITHREADS` is
+under "Compile-time options".
+
 ==============================================================================
  vim:tw=78:ts=8:noet:ft=help:norl:
--- a/src/auto/configure
+++ b/src/auto/configure
@@ -6241,6 +6241,7 @@ rm -f core conftest.err conftest.$ac_obj
       $as_echo "#define DYNAMIC_PERL 1" >>confdefs.h
 
       PERL_CFLAGS="-DDYNAMIC_PERL_DLL=\\\"$libperl\\\" $PERL_CFLAGS"
+      PERL_LIBS=""
     fi
   fi
 
--- a/src/configure.ac
+++ b/src/configure.ac
@@ -1215,6 +1215,7 @@ if test "$enable_perlinterp" = "yes" -o 
     if test "$perl_ok" = "yes" -a "X$libperl" != "X"; then
       AC_DEFINE(DYNAMIC_PERL)
       PERL_CFLAGS="-DDYNAMIC_PERL_DLL=\\\"$libperl\\\" $PERL_CFLAGS"
+      PERL_LIBS=""
     fi
   fi
 
--- a/src/if_perl.xs
+++ b/src/if_perl.xs
@@ -37,13 +37,6 @@
 
 #include "vim.h"
 
-/* Work around for perl-5.18.
- * Don't include "perl\lib\CORE\inline.h" for now,
- * include it after Perl_sv_free2 is defined. */
-#ifdef DYNAMIC_PERL
-# define PERL_NO_INLINE_FUNCTIONS
-#endif
-
 #ifdef _MSC_VER
 // Work around for using MSVC and ActivePerl 5.18.
 # define __inline__ __inline
@@ -197,7 +190,9 @@ typedef int perl_key;
 # define perl_run dll_perl_run
 # define perl_destruct dll_perl_destruct
 # define perl_free dll_perl_free
-# define Perl_get_context dll_Perl_get_context
+# if defined(WIN32) || ((PERL_REVISION == 5) && (PERL_VERSION < 38))
+#  define Perl_get_context dll_Perl_get_context
+# endif
 # define Perl_croak dll_Perl_croak
 # ifdef PERL5101_OR_LATER
 #  define Perl_croak_xs_usage dll_Perl_croak_xs_usage
@@ -346,7 +341,9 @@ static void (*perl_destruct)(PerlInterpr
 static void (*perl_free)(PerlInterpreter*);
 static int (*perl_run)(PerlInterpreter*);
 static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
+# if defined(WIN32) || ((PERL_REVISION == 5) && (PERL_VERSION < 38))
 static void* (*Perl_get_context)(void);
+# endif
 static void (*Perl_croak)(pTHX_ const char*, ...) __attribute__noreturn__;
 # ifdef PERL5101_OR_LATER
 /* Perl-5.18 has a different Perl_croak_xs_usage signature. */
@@ -516,7 +513,9 @@ static struct {
     {"perl_free", (PERL_PROC*)&perl_free},
     {"perl_run", (PERL_PROC*)&perl_run},
     {"perl_parse", (PERL_PROC*)&perl_parse},
+# if defined(WIN32) || ((PERL_REVISION == 5) && (PERL_VERSION < 38))
     {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
+# endif
     {"Perl_croak", (PERL_PROC*)&Perl_croak},
 # ifdef PERL5101_OR_LATER
     {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
@@ -658,227 +657,11 @@ static struct {
     {"", NULL},
 };
 
-/* Work around for perl-5.18.
- * For now, only the definitions of S_SvREFCNT_dec are needed in
- * "perl\lib\CORE\inline.h". */
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
-static void
-S_SvREFCNT_dec(pTHX_ SV *sv)
-{
-    if (LIKELY(sv != NULL)) {
-	U32 rc = SvREFCNT(sv);
-	if (LIKELY(rc > 1))
-	    SvREFCNT(sv) = rc - 1;
-	else
-	    Perl_sv_free2(aTHX_ sv, rc);
-    }
-}
-# endif
-
-/* perl-5.32 needs Perl_SvREFCNT_dec */
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
-#  define Perl_SvREFCNT_dec S_SvREFCNT_dec
-# endif
-
-/* perl-5.26 also needs S_TOPMARK and S_POPMARK. */
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 26)
-PERL_STATIC_INLINE I32
-S_TOPMARK(pTHX)
-{
-    DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
-				 "MARK top  %p %" IVdf "\n",
-				  PL_markstack_ptr,
-				  (IV)*PL_markstack_ptr)));
-    return *PL_markstack_ptr;
-}
-
-PERL_STATIC_INLINE I32
-S_POPMARK(pTHX)
-{
-    DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
-				 "MARK pop  %p %" IVdf "\n",
-				  (PL_markstack_ptr-1),
-				  (IV)*(PL_markstack_ptr-1))));
-    assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");
-    return *PL_markstack_ptr--;
-}
-# endif
-
-/* perl-5.32 needs Perl_POPMARK */
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
-#  define Perl_POPMARK S_POPMARK
-# endif
-
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
-PERL_STATIC_INLINE U8
-Perl_gimme_V(pTHX)
-{
-    I32 cxix;
-    U8  gimme = (PL_op->op_flags & OPf_WANT);
-
-    if (gimme)
-        return gimme;
-    cxix = PL_curstackinfo->si_cxsubix;
-    if (cxix < 0)
-	return
-#  if (PERL_REVISION == 5) && (PERL_VERSION >= 34)
-	    PL_curstackinfo->si_type == PERLSI_SORT ? G_SCALAR:
-#  endif
-	    G_VOID;
-    assert(cxstack[cxix].blk_gimme & G_WANT);
-    return (cxstack[cxix].blk_gimme & G_WANT);
-}
-# endif
-
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 38)
-#  define PERL_ARGS_ASSERT_SVPVXTRUE             \
-        assert(sv)
-PERL_STATIC_INLINE bool
-Perl_SvPVXtrue(pTHX_ SV *sv)
-{
-    PERL_ARGS_ASSERT_SVPVXTRUE;
-
-    if (! (XPV *) SvANY(sv)) {
-        return false;
-    }
-
-    if ( ((XPV *) SvANY(sv))->xpv_cur > 1) { /* length > 1 */
-        return true;
-    }
-
-    if (( (XPV *) SvANY(sv))->xpv_cur == 0) {
-        return false;
-    }
-
-    return *sv->sv_u.svu_pv != '0';
-}
-
-#  define PERL_ARGS_ASSERT_SVGETMAGIC            \
-        assert(sv)
-PERL_STATIC_INLINE void
-Perl_SvGETMAGIC(pTHX_ SV *sv)
-{
-    PERL_ARGS_ASSERT_SVGETMAGIC;
-
-    if (UNLIKELY(SvGMAGICAL(sv))) {
-        mg_get(sv);
-    }
-}
-
-PERL_STATIC_INLINE char *
-Perl_SvPV_helper(pTHX_
-                 SV * const sv,
-                 STRLEN * const lp,
-                 const U32 flags,
-                 const PL_SvPVtype type,
-                 char * (*non_trivial)(pTHX_ SV *, STRLEN * const, const U32),
-                 const bool or_null,
-                 const U32 return_flags
-                )
-{
-    /* 'type' should be known at compile time, so this is reduced to a single
-     * conditional at runtime */
-    if (   (type == SvPVbyte_type_      && SvPOK_byte_nog(sv))
-        || (type == SvPVforce_type_     && SvPOK_pure_nogthink(sv))
-        || (type == SvPVutf8_type_      && SvPOK_utf8_nog(sv))
-        || (type == SvPVnormal_type_    && SvPOK_nog(sv))
-        || (type == SvPVutf8_pure_type_ && SvPOK_utf8_pure_nogthink(sv))
-        || (type == SvPVbyte_pure_type_ && SvPOK_byte_pure_nogthink(sv))
-   ) {
-        if (lp) {
-            *lp = SvCUR(sv);
-        }
-
-        /* Similarly 'return_flags is known at compile time, so this becomes
-         * branchless */
-        if (return_flags & SV_MUTABLE_RETURN) {
-            return SvPVX_mutable(sv);
-        }
-        else if(return_flags & SV_CONST_RETURN) {
-            return (char *) SvPVX_const(sv);
-        }
-        else {
-            return SvPVX(sv);
-        }
-    }
-
-    if (or_null) {  /* This is also known at compile time */
-        if (flags & SV_GMAGIC) {    /* As is this */
-            SvGETMAGIC(sv);
-        }
-
-        if (! SvOK(sv)) {
-            if (lp) {   /* As is this */
-                *lp = 0;
-            }
-
-            return NULL;
-        }
-    }
-
-    /* Can't trivially handle this, call the function */
-    return non_trivial(aTHX_ sv, lp, (flags|return_flags));
-}
-
-#  define PERL_ARGS_ASSERT_SVNV                  \
-        assert(sv)
-PERL_STATIC_INLINE NV
-Perl_SvNV(pTHX_ SV *sv) {
-    PERL_ARGS_ASSERT_SVNV;
-
-    if (SvNOK_nog(sv))
-        return SvNVX(sv);
-    return sv_2nv(sv);
-}
-
-#  define PERL_ARGS_ASSERT_SVIV                  \
-        assert(sv)
-PERL_STATIC_INLINE IV
-Perl_SvIV(pTHX_ SV *sv) {
-    PERL_ARGS_ASSERT_SVIV;
-
-    if (SvIOK_nog(sv))
-        return SvIVX(sv);
-    return sv_2iv(sv);
-}
-# endif
-
-/* perl-5.34 needs Perl_SvTRUE_common; used in SvTRUE_nomg_NN */
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 34)
-PERL_STATIC_INLINE bool
-Perl_SvTRUE_common(pTHX_ SV * sv, const bool sv_2bool_is_fallback)
-{
-    if (UNLIKELY(SvIMMORTAL_INTERP(sv)))
-	return SvIMMORTAL_TRUE(sv);
-
-    if (! SvOK(sv))
-	return FALSE;
-
-    if (SvPOK(sv))
-	return SvPVXtrue(sv);
-
-    if (SvIOK(sv))
-	return SvIVX(sv) != 0; /* casts to bool */
-
-    if (SvROK(sv) && !(SvOBJECT(SvRV(sv)) && HvAMAGIC(SvSTASH(SvRV(sv)))))
-	return TRUE;
-
-    if (sv_2bool_is_fallback)
-	return sv_2bool_nomg(sv);
-
-    return isGV_with_GP(sv);
-}
-# endif
-
-/* perl-5.32 needs Perl_SvTRUE */
-# if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
-PERL_STATIC_INLINE bool
-Perl_SvTRUE(pTHX_ SV *sv) {
-    if (!LIKELY(sv))
-	return FALSE;
-    SvGETMAGIC(sv);
-    return SvTRUE_nomg_NN(sv);
-}
+# if (PERL_REVISION == 5) && (PERL_VERSION <= 30)
+// In 5.30, GIMME_V requires linking to Perl_block_gimme() instead of being
+// completely inline. Just use the deprecated GIMME for simplicity.
+#  undef GIMME_V
+#  define GIMME_V GIMME
 # endif
 
 /*
@@ -1681,6 +1464,64 @@ vim_IOLayer_init(void)
 }
 #endif /* PERLIO_LAYERS && !USE_SFIO */
 
+#ifdef DYNAMIC_PERL
+
+// Certain functionality that we use like SvREFCNT_dec are inlined for
+// performance reasons. They reference Perl APIs like Perl_sv_free2(), which
+// would cause linking errors in dynamic builds as we don't link against Perl
+// during build time. Manually fix it here by redirecting these functions
+// towards the dynamically loaded version.
+
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
+#  undef Perl_sv_free2
+void Perl_sv_free2(pTHX_ SV* sv, const U32 refcnt)
+{
+    (*dll_Perl_sv_free2)(aTHX_ sv, refcnt);
+}
+# else
+#  undef Perl_sv_free2
+void Perl_sv_free2(pTHX_ SV* sv)
+{
+    (*dll_Perl_sv_free2)(aTHX_ sv);
+}
+# endif
+
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
+#  undef Perl_sv_2bool_flags
+bool Perl_sv_2bool_flags(pTHX_ SV* sv, I32 flags)
+{
+    return (*dll_Perl_sv_2bool_flags)(aTHX_ sv, flags);
+}
+# endif
+
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 28)
+#  undef Perl_mg_get
+int Perl_mg_get(pTHX_ SV* sv)
+{
+    return (*dll_Perl_mg_get)(aTHX_ sv);
+}
+# endif
+
+# undef Perl_sv_2nv_flags
+NV Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
+{
+    return (*dll_Perl_sv_2nv_flags)(aTHX_ sv, flags);
+}
+
+# ifdef PERL589_OR_LATER
+#  undef Perl_sv_2iv_flags
+IV Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags)
+{
+    return (*dll_Perl_sv_2iv_flags)(aTHX_ sv, flags);
+}
+# endif
+
+# ifdef PERL_USE_THREAD_LOCAL
+PERL_THREAD_LOCAL void *PL_current_context;
+# endif
+
+#endif // DYNAMIC_PERL
+
 XS(boot_VIM);
 
     static void
--- a/src/version.c
+++ b/src/version.c
@@ -700,6 +700,8 @@ static char *(features[]) =
 static int included_patches[] =
 {   /* Add new patch number below this line */
 /**/
+    1818,
+/**/
     1817,
 /**/
     1816,