blob: 0094627210693f76193cdf2841527f59d9b6981c [file] [log] [blame]
Bram Moolenaar071d4272004-06-13 20:20:40 +00001/* vi:set ts=8 sts=4 sw=4:
2 *
3 * VIM - Vi IMproved by Bram Moolenaar
4 *
5 * Do ":help uganda" in Vim to read copying and usage conditions.
6 * Do ":help credits" in Vim to see a list of people who contributed.
7 */
8/*
9 * if_perl.xs: Main code for Perl interface support.
10 * Mostly written by Sven Verdoolaege.
11 */
12
13#define _memory_h /* avoid memset redeclaration */
14#define IN_PERL_FILE /* don't include if_perl.pro from proto.h */
15
Bram Moolenaaraee1f4a2013-08-02 16:10:32 +020016/*
Bram Moolenaar6b107212013-12-11 15:06:40 +010017 * Currently 32-bit version of ActivePerl is built with VC6 (or MinGW since
18 * ActivePerl 5.18).
Bram Moolenaaraee1f4a2013-08-02 16:10:32 +020019 * (http://community.activestate.com/faq/windows-compilers-perl-modules)
20 * It means that time_t should be 32-bit. However the default size of
21 * time_t is 64-bit since VC8. So we have to define _USE_32BIT_TIME_T.
22 */
23#if defined(WIN32) && !defined(_WIN64)
24# define _USE_32BIT_TIME_T
25#endif
26
Bram Moolenaar6b107212013-12-11 15:06:40 +010027/* Work around for perl-5.18.
28 * Don't include "perl\lib\CORE\inline.h" for now,
29 * include it after Perl_sv_free2 is defined. */
30#define PERL_NO_INLINE_FUNCTIONS
31
32/*
33 * Prevent including winsock.h. perl.h tries to detect whether winsock.h is
34 * already included before including winsock2.h, because winsock2.h isn't
35 * compatible with winsock.h. However the detection doesn't work with some
36 * versions of MinGW. If WIN32_LEAN_AND_MEAN is defined, windows.h will not
37 * include winsock.h.
38 */
39#ifdef WIN32
40# define WIN32_LEAN_AND_MEAN
41#endif
42
Bram Moolenaar071d4272004-06-13 20:20:40 +000043#include "vim.h"
44
Bram Moolenaaraee1f4a2013-08-02 16:10:32 +020045#include <EXTERN.h>
46#include <perl.h>
47#include <XSUB.h>
48
Bram Moolenaar071d4272004-06-13 20:20:40 +000049
50/*
51 * Work around clashes between Perl and Vim namespace. proto.h doesn't
52 * include if_perl.pro and perlsfio.pro when IN_PERL_FILE is defined, because
53 * we need the CV typedef. proto.h can't be moved to after including
54 * if_perl.h, because we get all sorts of name clashes then.
55 */
56#ifndef PROTO
57#ifndef __MINGW32__
58# include "proto/if_perl.pro"
59# include "proto/if_perlsfio.pro"
60#endif
61#endif
62
63/* Perl compatibility stuff. This should ensure compatibility with older
64 * versions of Perl.
65 */
66
67#ifndef PERL_VERSION
68# include <patchlevel.h>
69# define PERL_REVISION 5
70# define PERL_VERSION PATCHLEVEL
71# define PERL_SUBVERSION SUBVERSION
72#endif
73
Bram Moolenaar700d1d72007-09-13 13:20:16 +000074/*
75 * Quoting Jan Dubois of Active State:
76 * ActivePerl build 822 still identifies itself as 5.8.8 but already
77 * contains many of the changes from the upcoming Perl 5.8.9 release.
78 *
79 * The changes include addition of two symbols (Perl_sv_2iv_flags,
80 * Perl_newXS_flags) not present in earlier releases.
81 *
Bram Moolenaar3b9b13e2007-09-15 12:49:35 +000082 * Jan Dubois suggested the following guarding scheme.
83 *
84 * Active State defined ACTIVEPERL_VERSION as a string in versions before
85 * 5.8.8; and so the comparison to 822 below needs to be guarded.
Bram Moolenaar700d1d72007-09-13 13:20:16 +000086 */
Bram Moolenaar3b9b13e2007-09-15 12:49:35 +000087#if (PERL_REVISION == 5) && (PERL_VERSION == 8) && (PERL_SUBVERSION >= 8)
88# if (ACTIVEPERL_VERSION >= 822) || (PERL_SUBVERSION >= 9)
89# define PERL589_OR_LATER
90# endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +000091#endif
92#if (PERL_REVISION == 5) && (PERL_VERSION >= 9)
93# define PERL589_OR_LATER
94#endif
95
Bram Moolenaar58cb0892010-03-02 15:14:33 +010096#if (PERL_REVISION == 5) && ((PERL_VERSION > 10) || \
97 (PERL_VERSION == 10) && (PERL_SUBVERSION >= 1))
98# define PERL5101_OR_LATER
99#endif
100
Bram Moolenaar071d4272004-06-13 20:20:40 +0000101#ifndef pTHX
102# define pTHX void
103# define pTHX_
104#endif
105
106#ifndef EXTERN_C
107# define EXTERN_C
108#endif
109
Bram Moolenaarc271c482012-08-08 13:17:31 +0200110#if (PERL_REVISION == 5) && (PERL_VERSION >= 14) && defined(_MSC_VER)
111/* Using PL_errgv to get the error message after perl_eval_sv() causes a crash
112 * with MSVC and Perl version 5.14. */
113# define AVOID_PL_ERRGV
114#endif
115
Bram Moolenaar071d4272004-06-13 20:20:40 +0000116/* Compatibility hacks over */
117
118static PerlInterpreter *perl_interp = NULL;
119static void xs_init __ARGS((pTHX));
120static void VIM_init __ARGS((void));
121EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
122
123/*
Bram Moolenaare06c1882010-07-21 22:05:20 +0200124 * For dynamic linked perl.
Bram Moolenaar071d4272004-06-13 20:20:40 +0000125 */
126#if defined(DYNAMIC_PERL) || defined(PROTO)
Bram Moolenaare06c1882010-07-21 22:05:20 +0200127
128#ifndef DYNAMIC_PERL /* just generating prototypes */
Bram Moolenaar766fb0d2010-07-22 11:34:16 +0200129#ifdef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +0200130typedef int HANDLE;
131#endif
132typedef int XSINIT_t;
133typedef int XSUBADDR_t;
134typedef int perl_key;
135#endif
136
Bram Moolenaar766fb0d2010-07-22 11:34:16 +0200137#ifndef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +0200138#include <dlfcn.h>
139#define HANDLE void*
140#define PERL_PROC void*
141#define load_dll(n) dlopen((n), RTLD_LAZY|RTLD_GLOBAL)
142#define symbol_from_dll dlsym
143#define close_dll dlclose
144#else
145#define PERL_PROC FARPROC
Bram Moolenaarebbcb822010-10-23 14:02:54 +0200146#define load_dll vimLoadLib
Bram Moolenaare06c1882010-07-21 22:05:20 +0200147#define symbol_from_dll GetProcAddress
148#define close_dll FreeLibrary
149#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000150/*
151 * Wrapper defines
152 */
153# define perl_alloc dll_perl_alloc
154# define perl_construct dll_perl_construct
155# define perl_parse dll_perl_parse
156# define perl_run dll_perl_run
157# define perl_destruct dll_perl_destruct
158# define perl_free dll_perl_free
159# define Perl_get_context dll_Perl_get_context
160# define Perl_croak dll_Perl_croak
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100161# ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100162# define Perl_croak_xs_usage dll_Perl_croak_xs_usage
163# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000164# ifndef PROTO
165# define Perl_croak_nocontext dll_Perl_croak_nocontext
166# define Perl_call_argv dll_Perl_call_argv
167# define Perl_call_pv dll_Perl_call_pv
168# define Perl_eval_sv dll_Perl_eval_sv
169# define Perl_get_sv dll_Perl_get_sv
170# define Perl_eval_pv dll_Perl_eval_pv
171# define Perl_call_method dll_Perl_call_method
172# endif
173# define Perl_dowantarray dll_Perl_dowantarray
174# define Perl_free_tmps dll_Perl_free_tmps
175# define Perl_gv_stashpv dll_Perl_gv_stashpv
176# define Perl_markstack_grow dll_Perl_markstack_grow
177# define Perl_mg_find dll_Perl_mg_find
178# define Perl_newXS dll_Perl_newXS
179# define Perl_newSV dll_Perl_newSV
180# define Perl_newSViv dll_Perl_newSViv
181# define Perl_newSVpv dll_Perl_newSVpv
182# define Perl_pop_scope dll_Perl_pop_scope
183# define Perl_push_scope dll_Perl_push_scope
184# define Perl_save_int dll_Perl_save_int
185# define Perl_stack_grow dll_Perl_stack_grow
186# define Perl_set_context dll_Perl_set_context
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200187# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
188# define Perl_sv_2bool_flags dll_Perl_sv_2bool_flags
Bram Moolenaar01c10522012-09-21 12:50:51 +0200189# define Perl_xs_apiversion_bootcheck dll_Perl_xs_apiversion_bootcheck
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200190# else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000191# define Perl_sv_2bool dll_Perl_sv_2bool
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200192# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000193# define Perl_sv_2iv dll_Perl_sv_2iv
194# define Perl_sv_2mortal dll_Perl_sv_2mortal
195# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
196# define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
197# define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
198# else
199# define Perl_sv_2pv dll_Perl_sv_2pv
200# endif
201# define Perl_sv_bless dll_Perl_sv_bless
202# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
203# define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
204# else
205# define Perl_sv_catpvn dll_Perl_sv_catpvn
206# endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000207#ifdef PERL589_OR_LATER
208# define Perl_sv_2iv_flags dll_Perl_sv_2iv_flags
209# define Perl_newXS_flags dll_Perl_newXS_flags
210#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000211# define Perl_sv_free dll_Perl_sv_free
Bram Moolenaarccf22172008-09-01 15:56:45 +0000212# if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
213# define Perl_sv_free2 dll_Perl_sv_free2
214# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000215# define Perl_sv_isa dll_Perl_sv_isa
216# define Perl_sv_magic dll_Perl_sv_magic
217# define Perl_sv_setiv dll_Perl_sv_setiv
218# define Perl_sv_setpv dll_Perl_sv_setpv
219# define Perl_sv_setpvn dll_Perl_sv_setpvn
220# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
221# define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
222# else
223# define Perl_sv_setsv dll_Perl_sv_setsv
224# endif
225# define Perl_sv_upgrade dll_Perl_sv_upgrade
226# define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
227# define Perl_Top_ptr dll_Perl_Top_ptr
228# define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
229# define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
230# define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
231# define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
232# define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
233# define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
234# define Perl_TSv_ptr dll_Perl_TSv_ptr
235# define Perl_TXpv_ptr dll_Perl_TXpv_ptr
236# define Perl_Tna_ptr dll_Perl_Tna_ptr
237# define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
238# define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
239# define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
240# define boot_DynaLoader dll_boot_DynaLoader
Bram Moolenaare06c1882010-07-21 22:05:20 +0200241# define Perl_Gthr_key_ptr dll_Perl_Gthr_key_ptr
Bram Moolenaar071d4272004-06-13 20:20:40 +0000242
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000243# define Perl_sys_init dll_Perl_sys_init
Bram Moolenaarc236c162008-07-13 17:41:49 +0000244# define Perl_sys_term dll_Perl_sys_term
245# define Perl_ISv_ptr dll_Perl_ISv_ptr
246# define Perl_Istack_max_ptr dll_Perl_Istack_max_ptr
247# define Perl_Istack_base_ptr dll_Perl_Istack_base_ptr
248# define Perl_Itmps_ix_ptr dll_Perl_Itmps_ix_ptr
249# define Perl_Itmps_floor_ptr dll_Perl_Itmps_floor_ptr
250# define Perl_IXpv_ptr dll_Perl_IXpv_ptr
251# define Perl_Ina_ptr dll_Perl_Ina_ptr
252# define Perl_Imarkstack_ptr_ptr dll_Perl_Imarkstack_ptr_ptr
253# define Perl_Imarkstack_max_ptr dll_Perl_Imarkstack_max_ptr
254# define Perl_Istack_sp_ptr dll_Perl_Istack_sp_ptr
255# define Perl_Iop_ptr dll_Perl_Iop_ptr
256# define Perl_call_list dll_Perl_call_list
257# define Perl_Iscopestack_ix_ptr dll_Perl_Iscopestack_ix_ptr
258# define Perl_Iunitcheckav_ptr dll_Perl_Iunitcheckav_ptr
Bram Moolenaar01c10522012-09-21 12:50:51 +0200259# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
260# define PL_thr_key *dll_PL_thr_key
261# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000262
Bram Moolenaar071d4272004-06-13 20:20:40 +0000263/*
264 * Declare HANDLE for perl.dll and function pointers.
265 */
266static HANDLE hPerlLib = NULL;
267
268static PerlInterpreter* (*perl_alloc)();
269static void (*perl_construct)(PerlInterpreter*);
270static void (*perl_destruct)(PerlInterpreter*);
271static void (*perl_free)(PerlInterpreter*);
272static int (*perl_run)(PerlInterpreter*);
273static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
274static void* (*Perl_get_context)(void);
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000275static void (*Perl_croak)(pTHX_ const char*, ...);
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100276#ifdef PERL5101_OR_LATER
Bram Moolenaar6b107212013-12-11 15:06:40 +0100277/* Perl-5.18 has a different Perl_croak_xs_usage signature. */
278# if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
279static void (*Perl_croak_xs_usage)(const CV *const, const char *const params);
280# else
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100281static void (*Perl_croak_xs_usage)(pTHX_ const CV *const, const char *const params);
Bram Moolenaar6b107212013-12-11 15:06:40 +0100282# endif
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200283#endif
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000284static void (*Perl_croak_nocontext)(const char*, ...);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000285static I32 (*Perl_dowantarray)(pTHX);
286static void (*Perl_free_tmps)(pTHX);
287static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
288static void (*Perl_markstack_grow)(pTHX);
289static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
290static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
291static SV* (*Perl_newSV)(pTHX_ STRLEN);
292static SV* (*Perl_newSViv)(pTHX_ IV);
293static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
294static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
295static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
296static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
297static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
298static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
299static SV* (*Perl_call_method)(pTHX_ const char*, I32);
300static void (*Perl_pop_scope)(pTHX);
301static void (*Perl_push_scope)(pTHX);
302static void (*Perl_save_int)(pTHX_ int*);
303static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
304static SV** (*Perl_set_context)(void*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200305#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
306static bool (*Perl_sv_2bool_flags)(pTHX_ SV*, I32);
307static void (*Perl_xs_apiversion_bootcheck)(pTHX_ SV *module, const char *api_p, STRLEN api_len);
308#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000309static bool (*Perl_sv_2bool)(pTHX_ SV*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200310#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000311static IV (*Perl_sv_2iv)(pTHX_ SV*);
312static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
313#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
314static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
315static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
316#else
317static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
318#endif
319static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
320#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
321static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
322#else
323static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
324#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000325#ifdef PERL589_OR_LATER
326static IV (*Perl_sv_2iv_flags)(pTHX_ SV* sv, I32 flags);
327static CV * (*Perl_newXS_flags)(pTHX_ const char *name, XSUBADDR_t subaddr, const char *const filename, const char *const proto, U32 flags);
328#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000329static void (*Perl_sv_free)(pTHX_ SV*);
330static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
331static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
332static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
333static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
334static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
335#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
336static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
337#else
338static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
339#endif
340static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200341#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000342static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
343static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
344static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
345static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
346static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
347static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
348static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
349static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
350static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
351static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
352static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200353#else
Bram Moolenaar6b107212013-12-11 15:06:40 +0100354/* Perl-5.18 has a different Perl_sv_free2 signature. */
355# if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
356static void (*Perl_sv_free2)(pTHX_ SV*, const U32);
357# else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000358static void (*Perl_sv_free2)(pTHX_ SV*);
Bram Moolenaar6b107212013-12-11 15:06:40 +0100359# endif
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000360static void (*Perl_sys_init)(int* argc, char*** argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000361static void (*Perl_sys_term)(void);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200362static void (*Perl_call_list)(pTHX_ I32, AV*);
363# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
364# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000365static SV** (*Perl_ISv_ptr)(register PerlInterpreter*);
366static SV*** (*Perl_Istack_max_ptr)(register PerlInterpreter*);
367static SV*** (*Perl_Istack_base_ptr)(register PerlInterpreter*);
368static XPV** (*Perl_IXpv_ptr)(register PerlInterpreter*);
369static I32* (*Perl_Itmps_ix_ptr)(register PerlInterpreter*);
370static I32* (*Perl_Itmps_floor_ptr)(register PerlInterpreter*);
371static STRLEN* (*Perl_Ina_ptr)(register PerlInterpreter*);
372static I32** (*Perl_Imarkstack_ptr_ptr)(register PerlInterpreter*);
373static I32** (*Perl_Imarkstack_max_ptr)(register PerlInterpreter*);
374static SV*** (*Perl_Istack_sp_ptr)(register PerlInterpreter*);
375static OP** (*Perl_Iop_ptr)(register PerlInterpreter*);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000376static I32* (*Perl_Iscopestack_ix_ptr)(register PerlInterpreter*);
377static AV** (*Perl_Iunitcheckav_ptr)(register PerlInterpreter*);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200378# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000379#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000380
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200381#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
Bram Moolenaar01c10522012-09-21 12:50:51 +0200382static perl_key* dll_PL_thr_key;
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200383#else
Bram Moolenaare06c1882010-07-21 22:05:20 +0200384static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
385static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
386static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200387static perl_key* (*Perl_Gthr_key_ptr)_((pTHX));
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200388#endif
389static void (*boot_DynaLoader)_((pTHX_ CV*));
Bram Moolenaare06c1882010-07-21 22:05:20 +0200390
Bram Moolenaar071d4272004-06-13 20:20:40 +0000391/*
392 * Table of name to function pointer of perl.
393 */
Bram Moolenaar071d4272004-06-13 20:20:40 +0000394static struct {
395 char* name;
396 PERL_PROC* ptr;
397} perl_funcname_table[] = {
398 {"perl_alloc", (PERL_PROC*)&perl_alloc},
399 {"perl_construct", (PERL_PROC*)&perl_construct},
400 {"perl_destruct", (PERL_PROC*)&perl_destruct},
401 {"perl_free", (PERL_PROC*)&perl_free},
402 {"perl_run", (PERL_PROC*)&perl_run},
403 {"perl_parse", (PERL_PROC*)&perl_parse},
404 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
405 {"Perl_croak", (PERL_PROC*)&Perl_croak},
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100406#ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100407 {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
408#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000409 {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
410 {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
411 {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
412 {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
413 {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
414 {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
415 {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
416 {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
417 {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
418 {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
419 {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
420 {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
421 {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
422 {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
423 {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
424 {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
425 {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
426 {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
427 {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
428 {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
429 {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200430#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
431 {"Perl_sv_2bool_flags", (PERL_PROC*)&Perl_sv_2bool_flags},
432 {"Perl_xs_apiversion_bootcheck",(PERL_PROC*)&Perl_xs_apiversion_bootcheck},
433#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000434 {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200435#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000436 {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
437 {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
438#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
439 {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
440 {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
441#else
442 {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
443#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000444#ifdef PERL589_OR_LATER
445 {"Perl_sv_2iv_flags", (PERL_PROC*)&Perl_sv_2iv_flags},
446 {"Perl_newXS_flags", (PERL_PROC*)&Perl_newXS_flags},
447#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000448 {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
449#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
450 {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
451#else
452 {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
453#endif
454 {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
455 {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
456 {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
457 {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
458 {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
459 {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
460#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
461 {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
462#else
463 {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
464#endif
465 {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000466#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000467 {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
468 {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
469 {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
470 {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
471 {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
472 {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
473 {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
474 {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
475 {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
476 {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
477 {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000478#else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000479 {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000480 {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000481 {"Perl_sys_term", (PERL_PROC*)&Perl_sys_term},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200482 {"Perl_call_list", (PERL_PROC*)&Perl_call_list},
483# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
484# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000485 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000486 {"Perl_Istack_max_ptr", (PERL_PROC*)&Perl_Istack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200487 {"Perl_Istack_base_ptr", (PERL_PROC*)&Perl_Istack_base_ptr},
488 {"Perl_IXpv_ptr", (PERL_PROC*)&Perl_IXpv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000489 {"Perl_Itmps_ix_ptr", (PERL_PROC*)&Perl_Itmps_ix_ptr},
490 {"Perl_Itmps_floor_ptr", (PERL_PROC*)&Perl_Itmps_floor_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200491 {"Perl_Ina_ptr", (PERL_PROC*)&Perl_Ina_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000492 {"Perl_Imarkstack_ptr_ptr", (PERL_PROC*)&Perl_Imarkstack_ptr_ptr},
493 {"Perl_Imarkstack_max_ptr", (PERL_PROC*)&Perl_Imarkstack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200494 {"Perl_Istack_sp_ptr", (PERL_PROC*)&Perl_Istack_sp_ptr},
495 {"Perl_Iop_ptr", (PERL_PROC*)&Perl_Iop_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000496 {"Perl_Iscopestack_ix_ptr", (PERL_PROC*)&Perl_Iscopestack_ix_ptr},
497 {"Perl_Iunitcheckav_ptr", (PERL_PROC*)&Perl_Iunitcheckav_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200498# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000499#endif
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200500#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
Bram Moolenaar01c10522012-09-21 12:50:51 +0200501 {"PL_thr_key", (PERL_PROC*)&dll_PL_thr_key},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200502#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000503 {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
504 {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
505 {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200506 {"Perl_Gthr_key_ptr", (PERL_PROC*)&Perl_Gthr_key_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200507#endif
508 {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
Bram Moolenaar071d4272004-06-13 20:20:40 +0000509 {"", NULL},
510};
511
Bram Moolenaar6b107212013-12-11 15:06:40 +0100512/* Work around for perl-5.18.
513 * The definitions of S_SvREFCNT_inc and S_SvREFCNT_dec are needed, so include
514 * "perl\lib\CORE\inline.h", after Perl_sv_free2 is defined.
515 * The linker won't complain about undefined __impl_Perl_sv_free2. */
516#if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
517# include <inline.h>
518#endif
519
Bram Moolenaar071d4272004-06-13 20:20:40 +0000520/*
521 * Make all runtime-links of perl.
522 *
Bram Moolenaar364ab2f2013-08-02 20:05:32 +0200523 * 1. Get module handle using dlopen() or vimLoadLib().
Bram Moolenaar071d4272004-06-13 20:20:40 +0000524 * 2. Get pointer to perl function by GetProcAddress.
525 * 3. Repeat 2, until get all functions will be used.
526 *
527 * Parameter 'libname' provides name of DLL.
528 * Return OK or FAIL.
529 */
530 static int
531perl_runtime_link_init(char *libname, int verbose)
532{
533 int i;
534
535 if (hPerlLib != NULL)
536 return OK;
Bram Moolenaare06c1882010-07-21 22:05:20 +0200537 if ((hPerlLib = load_dll(libname)) == NULL)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000538 {
539 if (verbose)
540 EMSG2(_("E370: Could not load library %s"), libname);
541 return FAIL;
542 }
543 for (i = 0; perl_funcname_table[i].ptr; ++i)
544 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200545 if (!(*perl_funcname_table[i].ptr = symbol_from_dll(hPerlLib,
Bram Moolenaar071d4272004-06-13 20:20:40 +0000546 perl_funcname_table[i].name)))
547 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200548 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000549 hPerlLib = NULL;
550 if (verbose)
551 EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
552 return FAIL;
553 }
554 }
555 return OK;
556}
557
558/*
559 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
560 * There were no DLL loaded, return FALSE.
561 */
562 int
563perl_enabled(verbose)
564 int verbose;
565{
566 return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
567}
568#endif /* DYNAMIC_PERL */
569
570/*
571 * perl_init(): initialize perl interpreter
572 * We have to call perl_parse to initialize some structures,
573 * there's nothing to actually parse.
574 */
575 static void
576perl_init()
577{
Bram Moolenaarc236c162008-07-13 17:41:49 +0000578 char *bootargs[] = { "VI", NULL };
579 int argc = 3;
580 static char *argv[] = { "", "-e", "" };
Bram Moolenaar071d4272004-06-13 20:20:40 +0000581
Bram Moolenaarc236c162008-07-13 17:41:49 +0000582#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000583 Perl_sys_init(&argc, (char***)&argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000584#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000585 perl_interp = perl_alloc();
586 perl_construct(perl_interp);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000587 perl_parse(perl_interp, xs_init, argc, argv, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000588 perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
589 VIM_init();
590#ifdef USE_SFIO
591 sfdisc(PerlIO_stdout(), sfdcnewvim());
592 sfdisc(PerlIO_stderr(), sfdcnewvim());
593 sfsetbuf(PerlIO_stdout(), NULL, 0);
594 sfsetbuf(PerlIO_stderr(), NULL, 0);
595#endif
596}
597
598/*
599 * perl_end(): clean up after ourselves
600 */
601 void
602perl_end()
603{
604 if (perl_interp)
605 {
606 perl_run(perl_interp);
607 perl_destruct(perl_interp);
608 perl_free(perl_interp);
609 perl_interp = NULL;
Bram Moolenaarc236c162008-07-13 17:41:49 +0000610#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
611 Perl_sys_term();
612#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000613 }
614#ifdef DYNAMIC_PERL
615 if (hPerlLib)
616 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200617 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000618 hPerlLib = NULL;
619 }
620#endif
621}
622
623/*
624 * msg_split(): send a message to the message handling routines
625 * split at '\n' first though.
626 */
627 void
628msg_split(s, attr)
629 char_u *s;
630 int attr; /* highlighting attributes */
631{
632 char *next;
633 char *token = (char *)s;
634
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000635 while ((next = strchr(token, '\n')) && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000636 {
637 *next++ = '\0'; /* replace \n with \0 */
638 msg_attr((char_u *)token, attr);
639 token = next;
640 }
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000641 if (*token && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000642 msg_attr((char_u *)token, attr);
643}
644
645#ifndef FEAT_EVAL
646/*
647 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
648 * work properly.
649 */
650 char_u *
Bram Moolenaar362e1a32006-03-06 23:29:24 +0000651eval_to_string(arg, nextcmd, dolist)
Bram Moolenaarfeeaa682013-02-14 22:19:51 +0100652 char_u *arg UNUSED;
653 char_u **nextcmd UNUSED;
654 int dolist UNUSED;
Bram Moolenaar071d4272004-06-13 20:20:40 +0000655{
656 return NULL;
657}
658#endif
659
660/*
661 * Create a new reference to an SV pointing to the SCR structure
Bram Moolenaare344bea2005-09-01 20:46:49 +0000662 * The b_perl_private/w_perl_private part of the SCR structure points to the
663 * SV, so there can only be one such SV for a particular SCR structure. When
664 * the last reference has gone (DESTROY is called),
665 * b_perl_private/w_perl_private is reset; When the screen goes away before
Bram Moolenaar071d4272004-06-13 20:20:40 +0000666 * all references are gone, the value of the SV is reset;
667 * any subsequent use of any of those reference will produce
668 * a warning. (see typemap)
669 */
Bram Moolenaare344bea2005-09-01 20:46:49 +0000670
671 static SV *
672newWINrv(rv, ptr)
673 SV *rv;
674 win_T *ptr;
675{
676 sv_upgrade(rv, SVt_RV);
677 if (ptr->w_perl_private == NULL)
678 {
679 ptr->w_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100680 sv_setiv(ptr->w_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000681 }
682 else
683 SvREFCNT_inc(ptr->w_perl_private);
684 SvRV(rv) = ptr->w_perl_private;
685 SvROK_on(rv);
686 return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000687}
688
Bram Moolenaare344bea2005-09-01 20:46:49 +0000689 static SV *
690newBUFrv(rv, ptr)
691 SV *rv;
692 buf_T *ptr;
693{
694 sv_upgrade(rv, SVt_RV);
695 if (ptr->b_perl_private == NULL)
696 {
697 ptr->b_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100698 sv_setiv(ptr->b_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000699 }
700 else
701 SvREFCNT_inc(ptr->b_perl_private);
702 SvRV(rv) = ptr->b_perl_private;
703 SvROK_on(rv);
704 return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
705}
Bram Moolenaar071d4272004-06-13 20:20:40 +0000706
707/*
708 * perl_win_free
Bram Moolenaar84a05ac2013-05-06 04:24:17 +0200709 * Remove all references to the window to be destroyed
Bram Moolenaar071d4272004-06-13 20:20:40 +0000710 */
711 void
712perl_win_free(wp)
713 win_T *wp;
714{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000715 if (wp->w_perl_private)
716 sv_setiv((SV *)wp->w_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000717 return;
718}
719
720 void
721perl_buf_free(bp)
722 buf_T *bp;
723{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000724 if (bp->b_perl_private)
725 sv_setiv((SV *)bp->b_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000726 return;
727}
728
729#ifndef PROTO
730# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
731I32 cur_val(pTHX_ IV iv, SV *sv);
732# else
733I32 cur_val(IV iv, SV *sv);
734#endif
735
736/*
737 * Handler for the magic variables $main::curwin and $main::curbuf.
738 * The handler is put into the magic vtbl for these variables.
739 * (This is effectively a C-level equivalent of a tied variable).
740 * There is no "set" function as the variables are read-only.
741 */
742# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
743I32 cur_val(pTHX_ IV iv, SV *sv)
744# else
745I32 cur_val(IV iv, SV *sv)
746# endif
747{
748 SV *rv;
749 if (iv == 0)
750 rv = newWINrv(newSV(0), curwin);
751 else
752 rv = newBUFrv(newSV(0), curbuf);
753 sv_setsv(sv, rv);
754 return 0;
755}
756#endif /* !PROTO */
757
758struct ufuncs cw_funcs = { cur_val, 0, 0 };
759struct ufuncs cb_funcs = { cur_val, 0, 1 };
760
761/*
762 * VIM_init(): Vim-specific initialisation.
763 * Make the magical main::curwin and main::curbuf variables
764 */
765 static void
766VIM_init()
767{
768 static char cw[] = "main::curwin";
769 static char cb[] = "main::curbuf";
770 SV *sv;
771
772 sv = perl_get_sv(cw, TRUE);
773 sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
774 SvREADONLY_on(sv);
775
776 sv = perl_get_sv(cb, TRUE);
777 sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
778 SvREADONLY_on(sv);
779
780 /*
781 * Setup the Safe compartment.
782 * It shouldn't be a fatal error if the Safe module is missing.
783 * XXX: Only shares the 'Msg' routine (which has to be called
784 * like 'Msg(...)').
785 */
786 (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
787
788}
789
790#ifdef DYNAMIC_PERL
791static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
792#endif
793
794/*
795 * ":perl"
796 */
797 void
798ex_perl(eap)
799 exarg_T *eap;
800{
801 char *err;
802 char *script;
803 STRLEN length;
804 SV *sv;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200805#ifdef HAVE_SANDBOX
Bram Moolenaar071d4272004-06-13 20:20:40 +0000806 SV *safe;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200807#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000808
809 script = (char *)script_get(eap, eap->arg);
810 if (eap->skip)
811 {
812 vim_free(script);
813 return;
814 }
815
816 if (perl_interp == NULL)
817 {
818#ifdef DYNAMIC_PERL
819 if (!perl_enabled(TRUE))
820 {
821 EMSG(_(e_noperl));
822 vim_free(script);
823 return;
824 }
825#endif
826 perl_init();
827 }
828
829 {
830 dSP;
831 ENTER;
832 SAVETMPS;
833
834 if (script == NULL)
835 sv = newSVpv((char *)eap->arg, 0);
836 else
837 {
838 sv = newSVpv(script, 0);
839 vim_free(script);
840 }
841
842#ifdef HAVE_SANDBOX
843 if (sandbox)
844 {
Bram Moolenaara1711622011-07-27 14:15:46 +0200845 safe = perl_get_sv("VIM::safe", FALSE);
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000846# ifndef MAKE_TEST /* avoid a warning for unreachable code */
Bram Moolenaar954e8c52009-11-11 13:45:33 +0000847 if (safe == NULL || !SvTRUE(safe))
Bram Moolenaar071d4272004-06-13 20:20:40 +0000848 EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
849 else
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000850# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000851 {
852 PUSHMARK(SP);
853 XPUSHs(safe);
854 XPUSHs(sv);
855 PUTBACK;
856 perl_call_method("reval", G_DISCARD);
857 }
858 }
859 else
860#endif
861 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
862
863 SvREFCNT_dec(sv);
864
Bram Moolenaarc271c482012-08-08 13:17:31 +0200865#ifdef AVOID_PL_ERRGV
866 err = SvPV(perl_get_sv("@", GV_ADD), length);
867#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000868 err = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200869#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000870
871 FREETMPS;
872 LEAVE;
873
874 if (!length)
875 return;
876
877 msg_split((char_u *)err, highlight_attr[HLF_E]);
878 return;
879 }
880}
881
882 static int
883replace_line(line, end)
884 linenr_T *line, *end;
885{
886 char *str;
887
888 if (SvOK(GvSV(PL_defgv)))
889 {
890 str = SvPV(GvSV(PL_defgv), PL_na);
891 ml_replace(*line, (char_u *)str, 1);
892 changed_bytes(*line, 0);
893 }
894 else
895 {
896 ml_delete(*line, FALSE);
897 deleted_lines_mark(*line, 1L);
898 --(*end);
899 --(*line);
900 }
901 return OK;
902}
903
904/*
905 * ":perldo".
906 */
907 void
908ex_perldo(eap)
909 exarg_T *eap;
910{
911 STRLEN length;
912 SV *sv;
913 char *str;
914 linenr_T i;
915
916 if (bufempty())
917 return;
918
919 if (perl_interp == NULL)
920 {
921#ifdef DYNAMIC_PERL
922 if (!perl_enabled(TRUE))
923 {
924 EMSG(_(e_noperl));
925 return;
926 }
927#endif
928 perl_init();
929 }
930 {
931 dSP;
932 length = strlen((char *)eap->arg);
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000933 sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
934 sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000935 sv_catpvn(sv, (char *)eap->arg, length);
936 sv_catpvn(sv, "}", 1);
937 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
938 SvREFCNT_dec(sv);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200939#ifdef AVOID_PL_ERRGV
940 str = SvPV(perl_get_sv("@", GV_ADD), length);
941#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000942 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200943#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000944 if (length)
945 goto err;
946
947 if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
948 return;
949
950 ENTER;
951 SAVETMPS;
952 for (i = eap->line1; i <= eap->line2; i++)
953 {
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000954 sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000955 PUSHMARK(sp);
956 perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200957#ifdef AVOID_PL_ERRGV
958 str = SvPV(perl_get_sv("@", GV_ADD), length);
959#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000960 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200961#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000962 if (length)
963 break;
964 SPAGAIN;
965 if (SvTRUEx(POPs))
966 {
967 if (replace_line(&i, &eap->line2) != OK)
968 {
969 PUTBACK;
970 break;
971 }
972 }
973 PUTBACK;
974 }
975 FREETMPS;
976 LEAVE;
977 check_cursor();
978 update_screen(NOT_VALID);
979 if (!length)
980 return;
981
982err:
983 msg_split((char_u *)str, highlight_attr[HLF_E]);
984 return;
985 }
986}
987
Bram Moolenaar01dd60c2008-07-24 14:24:48 +0000988#ifndef FEAT_WINDOWS
989int win_valid(win_T *w) { return TRUE; }
990int win_count() { return 1; }
991win_T *win_find_nr(int n) { return curwin; }
992#endif
993
Bram Moolenaar071d4272004-06-13 20:20:40 +0000994XS(boot_VIM);
995
996 static void
997xs_init(pTHX)
998{
999 char *file = __FILE__;
1000
1001 /* DynaLoader is a special case */
1002 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
1003 newXS("VIM::bootstrap", boot_VIM, file);
1004}
1005
1006typedef win_T * VIWIN;
1007typedef buf_T * VIBUF;
1008
1009MODULE = VIM PACKAGE = VIM
1010
1011void
1012Msg(text, hl=NULL)
1013 char *text;
1014 char *hl;
1015
1016 PREINIT:
1017 int attr;
1018 int id;
1019
1020 PPCODE:
1021 if (text != NULL)
1022 {
1023 attr = 0;
1024 if (hl != NULL)
1025 {
1026 id = syn_name2id((char_u *)hl);
1027 if (id != 0)
1028 attr = syn_id2attr(id);
1029 }
1030 msg_split((char_u *)text, attr);
1031 }
1032
1033void
1034SetOption(line)
1035 char *line;
1036
1037 PPCODE:
1038 if (line != NULL)
1039 do_set((char_u *)line, 0);
1040 update_screen(NOT_VALID);
1041
1042void
1043DoCommand(line)
1044 char *line;
1045
1046 PPCODE:
1047 if (line != NULL)
1048 do_cmdline_cmd((char_u *)line);
1049
1050void
1051Eval(str)
1052 char *str;
1053
1054 PREINIT:
1055 char_u *value;
1056 PPCODE:
Bram Moolenaar362e1a32006-03-06 23:29:24 +00001057 value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001058 if (value == NULL)
1059 {
1060 XPUSHs(sv_2mortal(newSViv(0)));
1061 XPUSHs(sv_2mortal(newSVpv("", 0)));
1062 }
1063 else
1064 {
1065 XPUSHs(sv_2mortal(newSViv(1)));
1066 XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
1067 vim_free(value);
1068 }
1069
1070void
1071Buffers(...)
1072
1073 PREINIT:
1074 buf_T *vimbuf;
1075 int i, b;
1076
1077 PPCODE:
1078 if (items == 0)
1079 {
1080 if (GIMME == G_SCALAR)
1081 {
1082 i = 0;
1083 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1084 ++i;
1085
1086 XPUSHs(sv_2mortal(newSViv(i)));
1087 }
1088 else
1089 {
1090 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1091 XPUSHs(newBUFrv(newSV(0), vimbuf));
1092 }
1093 }
1094 else
1095 {
1096 for (i = 0; i < items; i++)
1097 {
1098 SV *sv = ST(i);
1099 if (SvIOK(sv))
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001100 b = (int) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001101 else
1102 {
1103 char_u *pat;
1104 STRLEN len;
1105
1106 pat = (char_u *)SvPV(sv, len);
1107 ++emsg_off;
Bram Moolenaar0c279bb2013-03-19 14:25:54 +01001108 b = buflist_findpat(pat, pat+len, FALSE, FALSE, FALSE);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001109 --emsg_off;
1110 }
1111
1112 if (b >= 0)
1113 {
1114 vimbuf = buflist_findnr(b);
1115 if (vimbuf)
1116 XPUSHs(newBUFrv(newSV(0), vimbuf));
1117 }
1118 }
1119 }
1120
1121void
1122Windows(...)
1123
1124 PREINIT:
1125 win_T *vimwin;
1126 int i, w;
1127
1128 PPCODE:
1129 if (items == 0)
1130 {
1131 if (GIMME == G_SCALAR)
1132 XPUSHs(sv_2mortal(newSViv(win_count())));
1133 else
1134 {
1135 for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1136 XPUSHs(newWINrv(newSV(0), vimwin));
1137 }
1138 }
1139 else
1140 {
1141 for (i = 0; i < items; i++)
1142 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001143 w = (int) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001144 vimwin = win_find_nr(w);
1145 if (vimwin)
1146 XPUSHs(newWINrv(newSV(0), vimwin));
1147 }
1148 }
1149
1150MODULE = VIM PACKAGE = VIWIN
1151
1152void
1153DESTROY(win)
1154 VIWIN win
1155
1156 CODE:
1157 if (win_valid(win))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001158 win->w_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001159
1160SV *
1161Buffer(win)
1162 VIWIN win
1163
1164 CODE:
1165 if (!win_valid(win))
1166 win = curwin;
1167 RETVAL = newBUFrv(newSV(0), win->w_buffer);
1168 OUTPUT:
1169 RETVAL
1170
1171void
1172SetHeight(win, height)
1173 VIWIN win
1174 int height;
1175
1176 PREINIT:
1177 win_T *savewin;
1178
1179 PPCODE:
1180 if (!win_valid(win))
1181 win = curwin;
1182 savewin = curwin;
1183 curwin = win;
1184 win_setheight(height);
1185 curwin = savewin;
1186
1187void
1188Cursor(win, ...)
1189 VIWIN win
1190
1191 PPCODE:
Bram Moolenaara1711622011-07-27 14:15:46 +02001192 if (items == 1)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001193 {
1194 EXTEND(sp, 2);
1195 if (!win_valid(win))
1196 win = curwin;
1197 PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1198 PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1199 }
Bram Moolenaara1711622011-07-27 14:15:46 +02001200 else if (items == 3)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001201 {
1202 int lnum, col;
1203
1204 if (!win_valid(win))
1205 win = curwin;
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001206 lnum = (int) SvIV(ST(1));
1207 col = (int) SvIV(ST(2));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001208 win->w_cursor.lnum = lnum;
1209 win->w_cursor.col = col;
1210 check_cursor(); /* put cursor on an existing line */
1211 update_screen(NOT_VALID);
1212 }
1213
1214MODULE = VIM PACKAGE = VIBUF
1215
1216void
1217DESTROY(vimbuf)
1218 VIBUF vimbuf;
1219
1220 CODE:
1221 if (buf_valid(vimbuf))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001222 vimbuf->b_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001223
1224void
1225Name(vimbuf)
1226 VIBUF vimbuf;
1227
1228 PPCODE:
1229 if (!buf_valid(vimbuf))
1230 vimbuf = curbuf;
1231 /* No file name returns an empty string */
1232 if (vimbuf->b_fname == NULL)
1233 XPUSHs(sv_2mortal(newSVpv("", 0)));
1234 else
1235 XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1236
1237void
1238Number(vimbuf)
1239 VIBUF vimbuf;
1240
1241 PPCODE:
1242 if (!buf_valid(vimbuf))
1243 vimbuf = curbuf;
1244 XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1245
1246void
1247Count(vimbuf)
1248 VIBUF vimbuf;
1249
1250 PPCODE:
1251 if (!buf_valid(vimbuf))
1252 vimbuf = curbuf;
1253 XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1254
1255void
1256Get(vimbuf, ...)
1257 VIBUF vimbuf;
1258
1259 PREINIT:
1260 char_u *line;
1261 int i;
1262 long lnum;
1263 PPCODE:
1264 if (buf_valid(vimbuf))
1265 {
1266 for (i = 1; i < items; i++)
1267 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001268 lnum = (long) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001269 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1270 {
1271 line = ml_get_buf(vimbuf, lnum, FALSE);
1272 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1273 }
1274 }
1275 }
1276
1277void
1278Set(vimbuf, ...)
1279 VIBUF vimbuf;
1280
1281 PREINIT:
1282 int i;
1283 long lnum;
1284 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001285 PPCODE:
1286 if (buf_valid(vimbuf))
1287 {
1288 if (items < 3)
1289 croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1290
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001291 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001292 for(i = 2; i < items; i++, lnum++)
1293 {
1294 line = SvPV(ST(i),PL_na);
1295 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1296 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001297 aco_save_T aco;
1298
1299 /* set curwin/curbuf for "vimbuf" and save some things */
1300 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001301
Bram Moolenaar071d4272004-06-13 20:20:40 +00001302 if (u_savesub(lnum) == OK)
1303 {
1304 ml_replace(lnum, (char_u *)line, TRUE);
1305 changed_bytes(lnum, 0);
1306 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001307
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001308 /* restore curwin/curbuf and a few other things */
1309 aucmd_restbuf(&aco);
1310 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaar071d4272004-06-13 20:20:40 +00001311 }
1312 }
1313 }
1314
1315void
1316Delete(vimbuf, ...)
1317 VIBUF vimbuf;
1318
1319 PREINIT:
1320 long i, lnum = 0, count = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001321 PPCODE:
1322 if (buf_valid(vimbuf))
1323 {
1324 if (items == 2)
1325 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001326 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001327 count = 1;
1328 }
1329 else if (items == 3)
1330 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001331 lnum = (long) SvIV(ST(1));
1332 count = (long) 1 + SvIV(ST(2)) - lnum;
Bram Moolenaara1711622011-07-27 14:15:46 +02001333 if (count == 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001334 count = 1;
Bram Moolenaara1711622011-07-27 14:15:46 +02001335 if (count < 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001336 {
1337 lnum -= count;
1338 count = -count;
1339 }
1340 }
1341 if (items >= 2)
1342 {
1343 for (i = 0; i < count; i++)
1344 {
1345 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1346 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001347 aco_save_T aco;
1348
1349 /* set curwin/curbuf for "vimbuf" and save some things */
1350 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001351
Bram Moolenaar071d4272004-06-13 20:20:40 +00001352 if (u_savedel(lnum, 1) == OK)
1353 {
1354 ml_delete(lnum, 0);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00001355 check_cursor();
Bram Moolenaar071d4272004-06-13 20:20:40 +00001356 deleted_lines_mark(lnum, 1L);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001357 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001358
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001359 /* restore curwin/curbuf and a few other things */
1360 aucmd_restbuf(&aco);
1361 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001362
Bram Moolenaar071d4272004-06-13 20:20:40 +00001363 update_curbuf(VALID);
1364 }
1365 }
1366 }
1367 }
1368
1369void
1370Append(vimbuf, ...)
1371 VIBUF vimbuf;
1372
1373 PREINIT:
1374 int i;
1375 long lnum;
1376 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001377 PPCODE:
1378 if (buf_valid(vimbuf))
1379 {
1380 if (items < 3)
1381 croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1382
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001383 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001384 for (i = 2; i < items; i++, lnum++)
1385 {
1386 line = SvPV(ST(i),PL_na);
1387 if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1388 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001389 aco_save_T aco;
1390
1391 /* set curwin/curbuf for "vimbuf" and save some things */
1392 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001393
Bram Moolenaar071d4272004-06-13 20:20:40 +00001394 if (u_inssub(lnum + 1) == OK)
1395 {
1396 ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1397 appended_lines_mark(lnum, 1L);
1398 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001399
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001400 /* restore curwin/curbuf and a few other things */
1401 aucmd_restbuf(&aco);
1402 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001403
Bram Moolenaar071d4272004-06-13 20:20:40 +00001404 update_curbuf(VALID);
1405 }
1406 }
1407 }
1408