Mercurial > vim
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 { |