comparison src/if_perl.xs @ 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 6ee6de3bbc94
children 8cbdd2cbf10a
comparison
equal deleted inserted replaced
33059:2b207221d6d3 33060:897f3ed27be2
34 #ifdef WIN32 34 #ifdef WIN32
35 # define WIN32_LEAN_AND_MEAN 35 # define WIN32_LEAN_AND_MEAN
36 #endif 36 #endif
37 37
38 #include "vim.h" 38 #include "vim.h"
39
40 /* Work around for perl-5.18.
41 * Don't include "perl\lib\CORE\inline.h" for now,
42 * include it after Perl_sv_free2 is defined. */
43 #ifdef DYNAMIC_PERL
44 # define PERL_NO_INLINE_FUNCTIONS
45 #endif
46 39
47 #ifdef _MSC_VER 40 #ifdef _MSC_VER
48 // Work around for using MSVC and ActivePerl 5.18. 41 // Work around for using MSVC and ActivePerl 5.18.
49 # define __inline__ __inline 42 # define __inline__ __inline
50 // Work around for using MSVC and Strawberry Perl 5.30. 43 // Work around for using MSVC and Strawberry Perl 5.30.
195 # define perl_construct dll_perl_construct 188 # define perl_construct dll_perl_construct
196 # define perl_parse dll_perl_parse 189 # define perl_parse dll_perl_parse
197 # define perl_run dll_perl_run 190 # define perl_run dll_perl_run
198 # define perl_destruct dll_perl_destruct 191 # define perl_destruct dll_perl_destruct
199 # define perl_free dll_perl_free 192 # define perl_free dll_perl_free
200 # define Perl_get_context dll_Perl_get_context 193 # if defined(WIN32) || ((PERL_REVISION == 5) && (PERL_VERSION < 38))
194 # define Perl_get_context dll_Perl_get_context
195 # endif
201 # define Perl_croak dll_Perl_croak 196 # define Perl_croak dll_Perl_croak
202 # ifdef PERL5101_OR_LATER 197 # ifdef PERL5101_OR_LATER
203 # define Perl_croak_xs_usage dll_Perl_croak_xs_usage 198 # define Perl_croak_xs_usage dll_Perl_croak_xs_usage
204 # endif 199 # endif
205 # ifndef PROTO 200 # ifndef PROTO
344 static void (*perl_construct)(PerlInterpreter*); 339 static void (*perl_construct)(PerlInterpreter*);
345 static void (*perl_destruct)(PerlInterpreter*); 340 static void (*perl_destruct)(PerlInterpreter*);
346 static void (*perl_free)(PerlInterpreter*); 341 static void (*perl_free)(PerlInterpreter*);
347 static int (*perl_run)(PerlInterpreter*); 342 static int (*perl_run)(PerlInterpreter*);
348 static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**); 343 static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
344 # if defined(WIN32) || ((PERL_REVISION == 5) && (PERL_VERSION < 38))
349 static void* (*Perl_get_context)(void); 345 static void* (*Perl_get_context)(void);
346 # endif
350 static void (*Perl_croak)(pTHX_ const char*, ...) __attribute__noreturn__; 347 static void (*Perl_croak)(pTHX_ const char*, ...) __attribute__noreturn__;
351 # ifdef PERL5101_OR_LATER 348 # ifdef PERL5101_OR_LATER
352 /* Perl-5.18 has a different Perl_croak_xs_usage signature. */ 349 /* Perl-5.18 has a different Perl_croak_xs_usage signature. */
353 # if (PERL_REVISION == 5) && (PERL_VERSION >= 18) 350 # if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
354 static void (*Perl_croak_xs_usage)(const CV *const, const char *const params) 351 static void (*Perl_croak_xs_usage)(const CV *const, const char *const params)
514 {"perl_construct", (PERL_PROC*)&perl_construct}, 511 {"perl_construct", (PERL_PROC*)&perl_construct},
515 {"perl_destruct", (PERL_PROC*)&perl_destruct}, 512 {"perl_destruct", (PERL_PROC*)&perl_destruct},
516 {"perl_free", (PERL_PROC*)&perl_free}, 513 {"perl_free", (PERL_PROC*)&perl_free},
517 {"perl_run", (PERL_PROC*)&perl_run}, 514 {"perl_run", (PERL_PROC*)&perl_run},
518 {"perl_parse", (PERL_PROC*)&perl_parse}, 515 {"perl_parse", (PERL_PROC*)&perl_parse},
516 # if defined(WIN32) || ((PERL_REVISION == 5) && (PERL_VERSION < 38))
519 {"Perl_get_context", (PERL_PROC*)&Perl_get_context}, 517 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
518 # endif
520 {"Perl_croak", (PERL_PROC*)&Perl_croak}, 519 {"Perl_croak", (PERL_PROC*)&Perl_croak},
521 # ifdef PERL5101_OR_LATER 520 # ifdef PERL5101_OR_LATER
522 {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage}, 521 {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
523 # endif 522 # endif
524 # ifdef PERL_IMPLICIT_CONTEXT 523 # ifdef PERL_IMPLICIT_CONTEXT
656 {"Perl_savetmps", (PERL_PROC*)&Perl_savetmps}, 655 {"Perl_savetmps", (PERL_PROC*)&Perl_savetmps},
657 # endif 656 # endif
658 {"", NULL}, 657 {"", NULL},
659 }; 658 };
660 659
661 /* Work around for perl-5.18. 660 # if (PERL_REVISION == 5) && (PERL_VERSION <= 30)
662 * For now, only the definitions of S_SvREFCNT_dec are needed in 661 // In 5.30, GIMME_V requires linking to Perl_block_gimme() instead of being
663 * "perl\lib\CORE\inline.h". */ 662 // completely inline. Just use the deprecated GIMME for simplicity.
664 # if (PERL_REVISION == 5) && (PERL_VERSION >= 18) 663 # undef GIMME_V
665 static void 664 # define GIMME_V GIMME
666 S_SvREFCNT_dec(pTHX_ SV *sv)
667 {
668 if (LIKELY(sv != NULL)) {
669 U32 rc = SvREFCNT(sv);
670 if (LIKELY(rc > 1))
671 SvREFCNT(sv) = rc - 1;
672 else
673 Perl_sv_free2(aTHX_ sv, rc);
674 }
675 }
676 # endif
677
678 /* perl-5.32 needs Perl_SvREFCNT_dec */
679 # if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
680 # define Perl_SvREFCNT_dec S_SvREFCNT_dec
681 # endif
682
683 /* perl-5.26 also needs S_TOPMARK and S_POPMARK. */
684 # if (PERL_REVISION == 5) && (PERL_VERSION >= 26)
685 PERL_STATIC_INLINE I32
686 S_TOPMARK(pTHX)
687 {
688 DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
689 "MARK top %p %" IVdf "\n",
690 PL_markstack_ptr,
691 (IV)*PL_markstack_ptr)));
692 return *PL_markstack_ptr;
693 }
694
695 PERL_STATIC_INLINE I32
696 S_POPMARK(pTHX)
697 {
698 DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
699 "MARK pop %p %" IVdf "\n",
700 (PL_markstack_ptr-1),
701 (IV)*(PL_markstack_ptr-1))));
702 assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");
703 return *PL_markstack_ptr--;
704 }
705 # endif
706
707 /* perl-5.32 needs Perl_POPMARK */
708 # if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
709 # define Perl_POPMARK S_POPMARK
710 # endif
711
712 # if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
713 PERL_STATIC_INLINE U8
714 Perl_gimme_V(pTHX)
715 {
716 I32 cxix;
717 U8 gimme = (PL_op->op_flags & OPf_WANT);
718
719 if (gimme)
720 return gimme;
721 cxix = PL_curstackinfo->si_cxsubix;
722 if (cxix < 0)
723 return
724 # if (PERL_REVISION == 5) && (PERL_VERSION >= 34)
725 PL_curstackinfo->si_type == PERLSI_SORT ? G_SCALAR:
726 # endif
727 G_VOID;
728 assert(cxstack[cxix].blk_gimme & G_WANT);
729 return (cxstack[cxix].blk_gimme & G_WANT);
730 }
731 # endif
732
733 # if (PERL_REVISION == 5) && (PERL_VERSION >= 38)
734 # define PERL_ARGS_ASSERT_SVPVXTRUE \
735 assert(sv)
736 PERL_STATIC_INLINE bool
737 Perl_SvPVXtrue(pTHX_ SV *sv)
738 {
739 PERL_ARGS_ASSERT_SVPVXTRUE;
740
741 if (! (XPV *) SvANY(sv)) {
742 return false;
743 }
744
745 if ( ((XPV *) SvANY(sv))->xpv_cur > 1) { /* length > 1 */
746 return true;
747 }
748
749 if (( (XPV *) SvANY(sv))->xpv_cur == 0) {
750 return false;
751 }
752
753 return *sv->sv_u.svu_pv != '0';
754 }
755
756 # define PERL_ARGS_ASSERT_SVGETMAGIC \
757 assert(sv)
758 PERL_STATIC_INLINE void
759 Perl_SvGETMAGIC(pTHX_ SV *sv)
760 {
761 PERL_ARGS_ASSERT_SVGETMAGIC;
762
763 if (UNLIKELY(SvGMAGICAL(sv))) {
764 mg_get(sv);
765 }
766 }
767
768 PERL_STATIC_INLINE char *
769 Perl_SvPV_helper(pTHX_
770 SV * const sv,
771 STRLEN * const lp,
772 const U32 flags,
773 const PL_SvPVtype type,
774 char * (*non_trivial)(pTHX_ SV *, STRLEN * const, const U32),
775 const bool or_null,
776 const U32 return_flags
777 )
778 {
779 /* 'type' should be known at compile time, so this is reduced to a single
780 * conditional at runtime */
781 if ( (type == SvPVbyte_type_ && SvPOK_byte_nog(sv))
782 || (type == SvPVforce_type_ && SvPOK_pure_nogthink(sv))
783 || (type == SvPVutf8_type_ && SvPOK_utf8_nog(sv))
784 || (type == SvPVnormal_type_ && SvPOK_nog(sv))
785 || (type == SvPVutf8_pure_type_ && SvPOK_utf8_pure_nogthink(sv))
786 || (type == SvPVbyte_pure_type_ && SvPOK_byte_pure_nogthink(sv))
787 ) {
788 if (lp) {
789 *lp = SvCUR(sv);
790 }
791
792 /* Similarly 'return_flags is known at compile time, so this becomes
793 * branchless */
794 if (return_flags & SV_MUTABLE_RETURN) {
795 return SvPVX_mutable(sv);
796 }
797 else if(return_flags & SV_CONST_RETURN) {
798 return (char *) SvPVX_const(sv);
799 }
800 else {
801 return SvPVX(sv);
802 }
803 }
804
805 if (or_null) { /* This is also known at compile time */
806 if (flags & SV_GMAGIC) { /* As is this */
807 SvGETMAGIC(sv);
808 }
809
810 if (! SvOK(sv)) {
811 if (lp) { /* As is this */
812 *lp = 0;
813 }
814
815 return NULL;
816 }
817 }
818
819 /* Can't trivially handle this, call the function */
820 return non_trivial(aTHX_ sv, lp, (flags|return_flags));
821 }
822
823 # define PERL_ARGS_ASSERT_SVNV \
824 assert(sv)
825 PERL_STATIC_INLINE NV
826 Perl_SvNV(pTHX_ SV *sv) {
827 PERL_ARGS_ASSERT_SVNV;
828
829 if (SvNOK_nog(sv))
830 return SvNVX(sv);
831 return sv_2nv(sv);
832 }
833
834 # define PERL_ARGS_ASSERT_SVIV \
835 assert(sv)
836 PERL_STATIC_INLINE IV
837 Perl_SvIV(pTHX_ SV *sv) {
838 PERL_ARGS_ASSERT_SVIV;
839
840 if (SvIOK_nog(sv))
841 return SvIVX(sv);
842 return sv_2iv(sv);
843 }
844 # endif
845
846 /* perl-5.34 needs Perl_SvTRUE_common; used in SvTRUE_nomg_NN */
847 # if (PERL_REVISION == 5) && (PERL_VERSION >= 34)
848 PERL_STATIC_INLINE bool
849 Perl_SvTRUE_common(pTHX_ SV * sv, const bool sv_2bool_is_fallback)
850 {
851 if (UNLIKELY(SvIMMORTAL_INTERP(sv)))
852 return SvIMMORTAL_TRUE(sv);
853
854 if (! SvOK(sv))
855 return FALSE;
856
857 if (SvPOK(sv))
858 return SvPVXtrue(sv);
859
860 if (SvIOK(sv))
861 return SvIVX(sv) != 0; /* casts to bool */
862
863 if (SvROK(sv) && !(SvOBJECT(SvRV(sv)) && HvAMAGIC(SvSTASH(SvRV(sv)))))
864 return TRUE;
865
866 if (sv_2bool_is_fallback)
867 return sv_2bool_nomg(sv);
868
869 return isGV_with_GP(sv);
870 }
871 # endif
872
873 /* perl-5.32 needs Perl_SvTRUE */
874 # if (PERL_REVISION == 5) && (PERL_VERSION >= 32)
875 PERL_STATIC_INLINE bool
876 Perl_SvTRUE(pTHX_ SV *sv) {
877 if (!LIKELY(sv))
878 return FALSE;
879 SvGETMAGIC(sv);
880 return SvTRUE_nomg_NN(sv);
881 }
882 # endif 665 # endif
883 666
884 /* 667 /*
885 * Make all runtime-links of perl. 668 * Make all runtime-links of perl.
886 * 669 *
1679 (void)eval_pv( "binmode(STDOUT, ':Vim')" 1462 (void)eval_pv( "binmode(STDOUT, ':Vim')"
1680 " && binmode(STDERR, ':Vim(ErrorMsg)');", 0); 1463 " && binmode(STDERR, ':Vim(ErrorMsg)');", 0);
1681 } 1464 }
1682 #endif /* PERLIO_LAYERS && !USE_SFIO */ 1465 #endif /* PERLIO_LAYERS && !USE_SFIO */
1683 1466
1467 #ifdef DYNAMIC_PERL
1468
1469 // Certain functionality that we use like SvREFCNT_dec are inlined for
1470 // performance reasons. They reference Perl APIs like Perl_sv_free2(), which
1471 // would cause linking errors in dynamic builds as we don't link against Perl
1472 // during build time. Manually fix it here by redirecting these functions
1473 // towards the dynamically loaded version.
1474
1475 # if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
1476 # undef Perl_sv_free2
1477 void Perl_sv_free2(pTHX_ SV* sv, const U32 refcnt)
1478 {
1479 (*dll_Perl_sv_free2)(aTHX_ sv, refcnt);
1480 }
1481 # else
1482 # undef Perl_sv_free2
1483 void Perl_sv_free2(pTHX_ SV* sv)
1484 {
1485 (*dll_Perl_sv_free2)(aTHX_ sv);
1486 }
1487 # endif
1488
1489 # if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
1490 # undef Perl_sv_2bool_flags
1491 bool Perl_sv_2bool_flags(pTHX_ SV* sv, I32 flags)
1492 {
1493 return (*dll_Perl_sv_2bool_flags)(aTHX_ sv, flags);
1494 }
1495 # endif
1496
1497 # if (PERL_REVISION == 5) && (PERL_VERSION >= 28)
1498 # undef Perl_mg_get
1499 int Perl_mg_get(pTHX_ SV* sv)
1500 {
1501 return (*dll_Perl_mg_get)(aTHX_ sv);
1502 }
1503 # endif
1504
1505 # undef Perl_sv_2nv_flags
1506 NV Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
1507 {
1508 return (*dll_Perl_sv_2nv_flags)(aTHX_ sv, flags);
1509 }
1510
1511 # ifdef PERL589_OR_LATER
1512 # undef Perl_sv_2iv_flags
1513 IV Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags)
1514 {
1515 return (*dll_Perl_sv_2iv_flags)(aTHX_ sv, flags);
1516 }
1517 # endif
1518
1519 # ifdef PERL_USE_THREAD_LOCAL
1520 PERL_THREAD_LOCAL void *PL_current_context;
1521 # endif
1522
1523 #endif // DYNAMIC_PERL
1524
1684 XS(boot_VIM); 1525 XS(boot_VIM);
1685 1526
1686 static void 1527 static void
1687 xs_init(pTHX) 1528 xs_init(pTHX)
1688 { 1529 {