blob: a2247f022c075c6e410c258fb867428bafe1f0ad [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/*
17 * Currently 32-bit version of ActivePerl is built with VC6.
18 * (http://community.activestate.com/faq/windows-compilers-perl-modules)
19 * It means that time_t should be 32-bit. However the default size of
20 * time_t is 64-bit since VC8. So we have to define _USE_32BIT_TIME_T.
21 */
22#if defined(WIN32) && !defined(_WIN64)
23# define _USE_32BIT_TIME_T
24#endif
25
Bram Moolenaar071d4272004-06-13 20:20:40 +000026#include "vim.h"
27
Bram Moolenaaraee1f4a2013-08-02 16:10:32 +020028#include <EXTERN.h>
29#include <perl.h>
30#include <XSUB.h>
31
Bram Moolenaar071d4272004-06-13 20:20:40 +000032
33/*
34 * Work around clashes between Perl and Vim namespace. proto.h doesn't
35 * include if_perl.pro and perlsfio.pro when IN_PERL_FILE is defined, because
36 * we need the CV typedef. proto.h can't be moved to after including
37 * if_perl.h, because we get all sorts of name clashes then.
38 */
39#ifndef PROTO
40#ifndef __MINGW32__
41# include "proto/if_perl.pro"
42# include "proto/if_perlsfio.pro"
43#endif
44#endif
45
46/* Perl compatibility stuff. This should ensure compatibility with older
47 * versions of Perl.
48 */
49
50#ifndef PERL_VERSION
51# include <patchlevel.h>
52# define PERL_REVISION 5
53# define PERL_VERSION PATCHLEVEL
54# define PERL_SUBVERSION SUBVERSION
55#endif
56
Bram Moolenaar700d1d72007-09-13 13:20:16 +000057/*
58 * Quoting Jan Dubois of Active State:
59 * ActivePerl build 822 still identifies itself as 5.8.8 but already
60 * contains many of the changes from the upcoming Perl 5.8.9 release.
61 *
62 * The changes include addition of two symbols (Perl_sv_2iv_flags,
63 * Perl_newXS_flags) not present in earlier releases.
64 *
Bram Moolenaar3b9b13e2007-09-15 12:49:35 +000065 * Jan Dubois suggested the following guarding scheme.
66 *
67 * Active State defined ACTIVEPERL_VERSION as a string in versions before
68 * 5.8.8; and so the comparison to 822 below needs to be guarded.
Bram Moolenaar700d1d72007-09-13 13:20:16 +000069 */
Bram Moolenaar3b9b13e2007-09-15 12:49:35 +000070#if (PERL_REVISION == 5) && (PERL_VERSION == 8) && (PERL_SUBVERSION >= 8)
71# if (ACTIVEPERL_VERSION >= 822) || (PERL_SUBVERSION >= 9)
72# define PERL589_OR_LATER
73# endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +000074#endif
75#if (PERL_REVISION == 5) && (PERL_VERSION >= 9)
76# define PERL589_OR_LATER
77#endif
78
Bram Moolenaar58cb0892010-03-02 15:14:33 +010079#if (PERL_REVISION == 5) && ((PERL_VERSION > 10) || \
80 (PERL_VERSION == 10) && (PERL_SUBVERSION >= 1))
81# define PERL5101_OR_LATER
82#endif
83
Bram Moolenaar9be6e212013-06-15 16:47:35 +020084#if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
85# define PERL5180_OR_LATER
86#endif
87
Bram Moolenaar071d4272004-06-13 20:20:40 +000088#ifndef pTHX
89# define pTHX void
90# define pTHX_
91#endif
92
93#ifndef EXTERN_C
94# define EXTERN_C
95#endif
96
Bram Moolenaarc271c482012-08-08 13:17:31 +020097#if (PERL_REVISION == 5) && (PERL_VERSION >= 14) && defined(_MSC_VER)
98/* Using PL_errgv to get the error message after perl_eval_sv() causes a crash
99 * with MSVC and Perl version 5.14. */
100# define AVOID_PL_ERRGV
101#endif
102
Bram Moolenaar071d4272004-06-13 20:20:40 +0000103/* Compatibility hacks over */
104
105static PerlInterpreter *perl_interp = NULL;
106static void xs_init __ARGS((pTHX));
107static void VIM_init __ARGS((void));
108EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
109
110/*
Bram Moolenaare06c1882010-07-21 22:05:20 +0200111 * For dynamic linked perl.
Bram Moolenaar071d4272004-06-13 20:20:40 +0000112 */
113#if defined(DYNAMIC_PERL) || defined(PROTO)
Bram Moolenaare06c1882010-07-21 22:05:20 +0200114
115#ifndef DYNAMIC_PERL /* just generating prototypes */
Bram Moolenaar766fb0d2010-07-22 11:34:16 +0200116#ifdef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +0200117typedef int HANDLE;
118#endif
119typedef int XSINIT_t;
120typedef int XSUBADDR_t;
121typedef int perl_key;
122#endif
123
Bram Moolenaar766fb0d2010-07-22 11:34:16 +0200124#ifndef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +0200125#include <dlfcn.h>
126#define HANDLE void*
127#define PERL_PROC void*
128#define load_dll(n) dlopen((n), RTLD_LAZY|RTLD_GLOBAL)
129#define symbol_from_dll dlsym
130#define close_dll dlclose
131#else
132#define PERL_PROC FARPROC
Bram Moolenaarebbcb822010-10-23 14:02:54 +0200133#define load_dll vimLoadLib
Bram Moolenaare06c1882010-07-21 22:05:20 +0200134#define symbol_from_dll GetProcAddress
135#define close_dll FreeLibrary
136#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000137/*
138 * Wrapper defines
139 */
140# define perl_alloc dll_perl_alloc
141# define perl_construct dll_perl_construct
142# define perl_parse dll_perl_parse
143# define perl_run dll_perl_run
144# define perl_destruct dll_perl_destruct
145# define perl_free dll_perl_free
146# define Perl_get_context dll_Perl_get_context
147# define Perl_croak dll_Perl_croak
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200148# ifndef PERL5180_OR_LATER
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100149# ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100150# define Perl_croak_xs_usage dll_Perl_croak_xs_usage
151# endif
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200152# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000153# ifndef PROTO
154# define Perl_croak_nocontext dll_Perl_croak_nocontext
155# define Perl_call_argv dll_Perl_call_argv
156# define Perl_call_pv dll_Perl_call_pv
157# define Perl_eval_sv dll_Perl_eval_sv
158# define Perl_get_sv dll_Perl_get_sv
159# define Perl_eval_pv dll_Perl_eval_pv
160# define Perl_call_method dll_Perl_call_method
161# endif
162# define Perl_dowantarray dll_Perl_dowantarray
163# define Perl_free_tmps dll_Perl_free_tmps
164# define Perl_gv_stashpv dll_Perl_gv_stashpv
165# define Perl_markstack_grow dll_Perl_markstack_grow
166# define Perl_mg_find dll_Perl_mg_find
167# define Perl_newXS dll_Perl_newXS
168# define Perl_newSV dll_Perl_newSV
169# define Perl_newSViv dll_Perl_newSViv
170# define Perl_newSVpv dll_Perl_newSVpv
171# define Perl_pop_scope dll_Perl_pop_scope
172# define Perl_push_scope dll_Perl_push_scope
173# define Perl_save_int dll_Perl_save_int
174# define Perl_stack_grow dll_Perl_stack_grow
175# define Perl_set_context dll_Perl_set_context
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200176# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
177# define Perl_sv_2bool_flags dll_Perl_sv_2bool_flags
Bram Moolenaar01c10522012-09-21 12:50:51 +0200178# define Perl_xs_apiversion_bootcheck dll_Perl_xs_apiversion_bootcheck
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200179# else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000180# define Perl_sv_2bool dll_Perl_sv_2bool
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200181# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000182# define Perl_sv_2iv dll_Perl_sv_2iv
183# define Perl_sv_2mortal dll_Perl_sv_2mortal
184# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
185# define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
186# define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
187# else
188# define Perl_sv_2pv dll_Perl_sv_2pv
189# endif
190# define Perl_sv_bless dll_Perl_sv_bless
191# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
192# define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
193# else
194# define Perl_sv_catpvn dll_Perl_sv_catpvn
195# endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000196#ifdef PERL589_OR_LATER
197# define Perl_sv_2iv_flags dll_Perl_sv_2iv_flags
198# define Perl_newXS_flags dll_Perl_newXS_flags
199#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000200# define Perl_sv_free dll_Perl_sv_free
Bram Moolenaarccf22172008-09-01 15:56:45 +0000201# if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
202# define Perl_sv_free2 dll_Perl_sv_free2
203# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000204# define Perl_sv_isa dll_Perl_sv_isa
205# define Perl_sv_magic dll_Perl_sv_magic
206# define Perl_sv_setiv dll_Perl_sv_setiv
207# define Perl_sv_setpv dll_Perl_sv_setpv
208# define Perl_sv_setpvn dll_Perl_sv_setpvn
209# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
210# define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
211# else
212# define Perl_sv_setsv dll_Perl_sv_setsv
213# endif
214# define Perl_sv_upgrade dll_Perl_sv_upgrade
215# define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
216# define Perl_Top_ptr dll_Perl_Top_ptr
217# define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
218# define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
219# define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
220# define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
221# define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
222# define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
223# define Perl_TSv_ptr dll_Perl_TSv_ptr
224# define Perl_TXpv_ptr dll_Perl_TXpv_ptr
225# define Perl_Tna_ptr dll_Perl_Tna_ptr
226# define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
227# define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
228# define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
229# define boot_DynaLoader dll_boot_DynaLoader
Bram Moolenaare06c1882010-07-21 22:05:20 +0200230# define Perl_Gthr_key_ptr dll_Perl_Gthr_key_ptr
Bram Moolenaar071d4272004-06-13 20:20:40 +0000231
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000232# define Perl_sys_init dll_Perl_sys_init
Bram Moolenaarc236c162008-07-13 17:41:49 +0000233# define Perl_sys_term dll_Perl_sys_term
234# define Perl_ISv_ptr dll_Perl_ISv_ptr
235# define Perl_Istack_max_ptr dll_Perl_Istack_max_ptr
236# define Perl_Istack_base_ptr dll_Perl_Istack_base_ptr
237# define Perl_Itmps_ix_ptr dll_Perl_Itmps_ix_ptr
238# define Perl_Itmps_floor_ptr dll_Perl_Itmps_floor_ptr
239# define Perl_IXpv_ptr dll_Perl_IXpv_ptr
240# define Perl_Ina_ptr dll_Perl_Ina_ptr
241# define Perl_Imarkstack_ptr_ptr dll_Perl_Imarkstack_ptr_ptr
242# define Perl_Imarkstack_max_ptr dll_Perl_Imarkstack_max_ptr
243# define Perl_Istack_sp_ptr dll_Perl_Istack_sp_ptr
244# define Perl_Iop_ptr dll_Perl_Iop_ptr
245# define Perl_call_list dll_Perl_call_list
246# define Perl_Iscopestack_ix_ptr dll_Perl_Iscopestack_ix_ptr
247# define Perl_Iunitcheckav_ptr dll_Perl_Iunitcheckav_ptr
Bram Moolenaar01c10522012-09-21 12:50:51 +0200248# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
249# define PL_thr_key *dll_PL_thr_key
250# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000251
Bram Moolenaar071d4272004-06-13 20:20:40 +0000252/*
253 * Declare HANDLE for perl.dll and function pointers.
254 */
255static HANDLE hPerlLib = NULL;
256
257static PerlInterpreter* (*perl_alloc)();
258static void (*perl_construct)(PerlInterpreter*);
259static void (*perl_destruct)(PerlInterpreter*);
260static void (*perl_free)(PerlInterpreter*);
261static int (*perl_run)(PerlInterpreter*);
262static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
263static void* (*Perl_get_context)(void);
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000264static void (*Perl_croak)(pTHX_ const char*, ...);
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200265#ifndef PERL5180_OR_LATER
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100266#ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100267static void (*Perl_croak_xs_usage)(pTHX_ const CV *const, const char *const params);
268#endif
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200269#endif
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000270static void (*Perl_croak_nocontext)(const char*, ...);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000271static I32 (*Perl_dowantarray)(pTHX);
272static void (*Perl_free_tmps)(pTHX);
273static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
274static void (*Perl_markstack_grow)(pTHX);
275static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
276static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
277static SV* (*Perl_newSV)(pTHX_ STRLEN);
278static SV* (*Perl_newSViv)(pTHX_ IV);
279static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
280static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
281static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
282static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
283static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
284static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
285static SV* (*Perl_call_method)(pTHX_ const char*, I32);
286static void (*Perl_pop_scope)(pTHX);
287static void (*Perl_push_scope)(pTHX);
288static void (*Perl_save_int)(pTHX_ int*);
289static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
290static SV** (*Perl_set_context)(void*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200291#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
292static bool (*Perl_sv_2bool_flags)(pTHX_ SV*, I32);
293static void (*Perl_xs_apiversion_bootcheck)(pTHX_ SV *module, const char *api_p, STRLEN api_len);
294#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000295static bool (*Perl_sv_2bool)(pTHX_ SV*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200296#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000297static IV (*Perl_sv_2iv)(pTHX_ SV*);
298static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
299#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
300static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
301static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
302#else
303static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
304#endif
305static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
306#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
307static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
308#else
309static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
310#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000311#ifdef PERL589_OR_LATER
312static IV (*Perl_sv_2iv_flags)(pTHX_ SV* sv, I32 flags);
313static CV * (*Perl_newXS_flags)(pTHX_ const char *name, XSUBADDR_t subaddr, const char *const filename, const char *const proto, U32 flags);
314#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000315static void (*Perl_sv_free)(pTHX_ SV*);
316static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
317static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
318static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
319static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
320static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
321#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
322static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
323#else
324static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
325#endif
326static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200327#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000328static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
329static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
330static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
331static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
332static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
333static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
334static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
335static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
336static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
337static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
338static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200339#else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000340static void (*Perl_sv_free2)(pTHX_ SV*);
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000341static void (*Perl_sys_init)(int* argc, char*** argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000342static void (*Perl_sys_term)(void);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200343static void (*Perl_call_list)(pTHX_ I32, AV*);
344# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
345# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000346static SV** (*Perl_ISv_ptr)(register PerlInterpreter*);
347static SV*** (*Perl_Istack_max_ptr)(register PerlInterpreter*);
348static SV*** (*Perl_Istack_base_ptr)(register PerlInterpreter*);
349static XPV** (*Perl_IXpv_ptr)(register PerlInterpreter*);
350static I32* (*Perl_Itmps_ix_ptr)(register PerlInterpreter*);
351static I32* (*Perl_Itmps_floor_ptr)(register PerlInterpreter*);
352static STRLEN* (*Perl_Ina_ptr)(register PerlInterpreter*);
353static I32** (*Perl_Imarkstack_ptr_ptr)(register PerlInterpreter*);
354static I32** (*Perl_Imarkstack_max_ptr)(register PerlInterpreter*);
355static SV*** (*Perl_Istack_sp_ptr)(register PerlInterpreter*);
356static OP** (*Perl_Iop_ptr)(register PerlInterpreter*);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000357static I32* (*Perl_Iscopestack_ix_ptr)(register PerlInterpreter*);
358static AV** (*Perl_Iunitcheckav_ptr)(register PerlInterpreter*);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200359# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000360#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000361
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200362#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
Bram Moolenaar01c10522012-09-21 12:50:51 +0200363static perl_key* dll_PL_thr_key;
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200364#else
Bram Moolenaare06c1882010-07-21 22:05:20 +0200365static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
366static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
367static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200368static perl_key* (*Perl_Gthr_key_ptr)_((pTHX));
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200369#endif
370static void (*boot_DynaLoader)_((pTHX_ CV*));
Bram Moolenaare06c1882010-07-21 22:05:20 +0200371
Bram Moolenaar071d4272004-06-13 20:20:40 +0000372/*
373 * Table of name to function pointer of perl.
374 */
Bram Moolenaar071d4272004-06-13 20:20:40 +0000375static struct {
376 char* name;
377 PERL_PROC* ptr;
378} perl_funcname_table[] = {
379 {"perl_alloc", (PERL_PROC*)&perl_alloc},
380 {"perl_construct", (PERL_PROC*)&perl_construct},
381 {"perl_destruct", (PERL_PROC*)&perl_destruct},
382 {"perl_free", (PERL_PROC*)&perl_free},
383 {"perl_run", (PERL_PROC*)&perl_run},
384 {"perl_parse", (PERL_PROC*)&perl_parse},
385 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
386 {"Perl_croak", (PERL_PROC*)&Perl_croak},
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200387#ifndef PERL5180_OR_LATER
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100388#ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100389 {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
390#endif
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200391#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000392 {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
393 {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
394 {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
395 {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
396 {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
397 {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
398 {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
399 {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
400 {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
401 {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
402 {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
403 {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
404 {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
405 {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
406 {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
407 {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
408 {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
409 {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
410 {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
411 {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
412 {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200413#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
414 {"Perl_sv_2bool_flags", (PERL_PROC*)&Perl_sv_2bool_flags},
415 {"Perl_xs_apiversion_bootcheck",(PERL_PROC*)&Perl_xs_apiversion_bootcheck},
416#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000417 {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200418#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000419 {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
420 {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
421#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
422 {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
423 {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
424#else
425 {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
426#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000427#ifdef PERL589_OR_LATER
428 {"Perl_sv_2iv_flags", (PERL_PROC*)&Perl_sv_2iv_flags},
429 {"Perl_newXS_flags", (PERL_PROC*)&Perl_newXS_flags},
430#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000431 {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
432#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
433 {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
434#else
435 {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
436#endif
437 {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
438 {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
439 {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
440 {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
441 {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
442 {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
443#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
444 {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
445#else
446 {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
447#endif
448 {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000449#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000450 {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
451 {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
452 {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
453 {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
454 {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
455 {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
456 {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
457 {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
458 {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
459 {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
460 {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000461#else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000462 {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000463 {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000464 {"Perl_sys_term", (PERL_PROC*)&Perl_sys_term},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200465 {"Perl_call_list", (PERL_PROC*)&Perl_call_list},
466# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
467# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000468 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000469 {"Perl_Istack_max_ptr", (PERL_PROC*)&Perl_Istack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200470 {"Perl_Istack_base_ptr", (PERL_PROC*)&Perl_Istack_base_ptr},
471 {"Perl_IXpv_ptr", (PERL_PROC*)&Perl_IXpv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000472 {"Perl_Itmps_ix_ptr", (PERL_PROC*)&Perl_Itmps_ix_ptr},
473 {"Perl_Itmps_floor_ptr", (PERL_PROC*)&Perl_Itmps_floor_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200474 {"Perl_Ina_ptr", (PERL_PROC*)&Perl_Ina_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000475 {"Perl_Imarkstack_ptr_ptr", (PERL_PROC*)&Perl_Imarkstack_ptr_ptr},
476 {"Perl_Imarkstack_max_ptr", (PERL_PROC*)&Perl_Imarkstack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200477 {"Perl_Istack_sp_ptr", (PERL_PROC*)&Perl_Istack_sp_ptr},
478 {"Perl_Iop_ptr", (PERL_PROC*)&Perl_Iop_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000479 {"Perl_Iscopestack_ix_ptr", (PERL_PROC*)&Perl_Iscopestack_ix_ptr},
480 {"Perl_Iunitcheckav_ptr", (PERL_PROC*)&Perl_Iunitcheckav_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200481# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000482#endif
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200483#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
Bram Moolenaar01c10522012-09-21 12:50:51 +0200484 {"PL_thr_key", (PERL_PROC*)&dll_PL_thr_key},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200485#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000486 {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
487 {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
488 {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200489 {"Perl_Gthr_key_ptr", (PERL_PROC*)&Perl_Gthr_key_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200490#endif
491 {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
Bram Moolenaar071d4272004-06-13 20:20:40 +0000492 {"", NULL},
493};
494
495/*
496 * Make all runtime-links of perl.
497 *
Bram Moolenaar364ab2f2013-08-02 20:05:32 +0200498 * 1. Get module handle using dlopen() or vimLoadLib().
Bram Moolenaar071d4272004-06-13 20:20:40 +0000499 * 2. Get pointer to perl function by GetProcAddress.
500 * 3. Repeat 2, until get all functions will be used.
501 *
502 * Parameter 'libname' provides name of DLL.
503 * Return OK or FAIL.
504 */
505 static int
506perl_runtime_link_init(char *libname, int verbose)
507{
508 int i;
509
510 if (hPerlLib != NULL)
511 return OK;
Bram Moolenaare06c1882010-07-21 22:05:20 +0200512 if ((hPerlLib = load_dll(libname)) == NULL)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000513 {
514 if (verbose)
515 EMSG2(_("E370: Could not load library %s"), libname);
516 return FAIL;
517 }
518 for (i = 0; perl_funcname_table[i].ptr; ++i)
519 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200520 if (!(*perl_funcname_table[i].ptr = symbol_from_dll(hPerlLib,
Bram Moolenaar071d4272004-06-13 20:20:40 +0000521 perl_funcname_table[i].name)))
522 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200523 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000524 hPerlLib = NULL;
525 if (verbose)
526 EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
527 return FAIL;
528 }
529 }
530 return OK;
531}
532
533/*
534 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
535 * There were no DLL loaded, return FALSE.
536 */
537 int
538perl_enabled(verbose)
539 int verbose;
540{
541 return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
542}
543#endif /* DYNAMIC_PERL */
544
545/*
546 * perl_init(): initialize perl interpreter
547 * We have to call perl_parse to initialize some structures,
548 * there's nothing to actually parse.
549 */
550 static void
551perl_init()
552{
Bram Moolenaarc236c162008-07-13 17:41:49 +0000553 char *bootargs[] = { "VI", NULL };
554 int argc = 3;
555 static char *argv[] = { "", "-e", "" };
Bram Moolenaar071d4272004-06-13 20:20:40 +0000556
Bram Moolenaarc236c162008-07-13 17:41:49 +0000557#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000558 Perl_sys_init(&argc, (char***)&argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000559#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000560 perl_interp = perl_alloc();
561 perl_construct(perl_interp);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000562 perl_parse(perl_interp, xs_init, argc, argv, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000563 perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
564 VIM_init();
565#ifdef USE_SFIO
566 sfdisc(PerlIO_stdout(), sfdcnewvim());
567 sfdisc(PerlIO_stderr(), sfdcnewvim());
568 sfsetbuf(PerlIO_stdout(), NULL, 0);
569 sfsetbuf(PerlIO_stderr(), NULL, 0);
570#endif
571}
572
573/*
574 * perl_end(): clean up after ourselves
575 */
576 void
577perl_end()
578{
579 if (perl_interp)
580 {
581 perl_run(perl_interp);
582 perl_destruct(perl_interp);
583 perl_free(perl_interp);
584 perl_interp = NULL;
Bram Moolenaarc236c162008-07-13 17:41:49 +0000585#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
586 Perl_sys_term();
587#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000588 }
589#ifdef DYNAMIC_PERL
590 if (hPerlLib)
591 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200592 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000593 hPerlLib = NULL;
594 }
595#endif
596}
597
598/*
599 * msg_split(): send a message to the message handling routines
600 * split at '\n' first though.
601 */
602 void
603msg_split(s, attr)
604 char_u *s;
605 int attr; /* highlighting attributes */
606{
607 char *next;
608 char *token = (char *)s;
609
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000610 while ((next = strchr(token, '\n')) && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000611 {
612 *next++ = '\0'; /* replace \n with \0 */
613 msg_attr((char_u *)token, attr);
614 token = next;
615 }
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000616 if (*token && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000617 msg_attr((char_u *)token, attr);
618}
619
620#ifndef FEAT_EVAL
621/*
622 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
623 * work properly.
624 */
625 char_u *
Bram Moolenaar362e1a32006-03-06 23:29:24 +0000626eval_to_string(arg, nextcmd, dolist)
Bram Moolenaarfeeaa682013-02-14 22:19:51 +0100627 char_u *arg UNUSED;
628 char_u **nextcmd UNUSED;
629 int dolist UNUSED;
Bram Moolenaar071d4272004-06-13 20:20:40 +0000630{
631 return NULL;
632}
633#endif
634
635/*
636 * Create a new reference to an SV pointing to the SCR structure
Bram Moolenaare344bea2005-09-01 20:46:49 +0000637 * The b_perl_private/w_perl_private part of the SCR structure points to the
638 * SV, so there can only be one such SV for a particular SCR structure. When
639 * the last reference has gone (DESTROY is called),
640 * b_perl_private/w_perl_private is reset; When the screen goes away before
Bram Moolenaar071d4272004-06-13 20:20:40 +0000641 * all references are gone, the value of the SV is reset;
642 * any subsequent use of any of those reference will produce
643 * a warning. (see typemap)
644 */
Bram Moolenaare344bea2005-09-01 20:46:49 +0000645
646 static SV *
647newWINrv(rv, ptr)
648 SV *rv;
649 win_T *ptr;
650{
651 sv_upgrade(rv, SVt_RV);
652 if (ptr->w_perl_private == NULL)
653 {
654 ptr->w_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100655 sv_setiv(ptr->w_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000656 }
657 else
658 SvREFCNT_inc(ptr->w_perl_private);
659 SvRV(rv) = ptr->w_perl_private;
660 SvROK_on(rv);
661 return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000662}
663
Bram Moolenaare344bea2005-09-01 20:46:49 +0000664 static SV *
665newBUFrv(rv, ptr)
666 SV *rv;
667 buf_T *ptr;
668{
669 sv_upgrade(rv, SVt_RV);
670 if (ptr->b_perl_private == NULL)
671 {
672 ptr->b_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100673 sv_setiv(ptr->b_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000674 }
675 else
676 SvREFCNT_inc(ptr->b_perl_private);
677 SvRV(rv) = ptr->b_perl_private;
678 SvROK_on(rv);
679 return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
680}
Bram Moolenaar071d4272004-06-13 20:20:40 +0000681
682/*
683 * perl_win_free
Bram Moolenaar84a05ac2013-05-06 04:24:17 +0200684 * Remove all references to the window to be destroyed
Bram Moolenaar071d4272004-06-13 20:20:40 +0000685 */
686 void
687perl_win_free(wp)
688 win_T *wp;
689{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000690 if (wp->w_perl_private)
691 sv_setiv((SV *)wp->w_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000692 return;
693}
694
695 void
696perl_buf_free(bp)
697 buf_T *bp;
698{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000699 if (bp->b_perl_private)
700 sv_setiv((SV *)bp->b_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000701 return;
702}
703
704#ifndef PROTO
705# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
706I32 cur_val(pTHX_ IV iv, SV *sv);
707# else
708I32 cur_val(IV iv, SV *sv);
709#endif
710
711/*
712 * Handler for the magic variables $main::curwin and $main::curbuf.
713 * The handler is put into the magic vtbl for these variables.
714 * (This is effectively a C-level equivalent of a tied variable).
715 * There is no "set" function as the variables are read-only.
716 */
717# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
718I32 cur_val(pTHX_ IV iv, SV *sv)
719# else
720I32 cur_val(IV iv, SV *sv)
721# endif
722{
723 SV *rv;
724 if (iv == 0)
725 rv = newWINrv(newSV(0), curwin);
726 else
727 rv = newBUFrv(newSV(0), curbuf);
728 sv_setsv(sv, rv);
729 return 0;
730}
731#endif /* !PROTO */
732
733struct ufuncs cw_funcs = { cur_val, 0, 0 };
734struct ufuncs cb_funcs = { cur_val, 0, 1 };
735
736/*
737 * VIM_init(): Vim-specific initialisation.
738 * Make the magical main::curwin and main::curbuf variables
739 */
740 static void
741VIM_init()
742{
743 static char cw[] = "main::curwin";
744 static char cb[] = "main::curbuf";
745 SV *sv;
746
747 sv = perl_get_sv(cw, TRUE);
748 sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
749 SvREADONLY_on(sv);
750
751 sv = perl_get_sv(cb, TRUE);
752 sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
753 SvREADONLY_on(sv);
754
755 /*
756 * Setup the Safe compartment.
757 * It shouldn't be a fatal error if the Safe module is missing.
758 * XXX: Only shares the 'Msg' routine (which has to be called
759 * like 'Msg(...)').
760 */
761 (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
762
763}
764
765#ifdef DYNAMIC_PERL
766static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
767#endif
768
769/*
770 * ":perl"
771 */
772 void
773ex_perl(eap)
774 exarg_T *eap;
775{
776 char *err;
777 char *script;
778 STRLEN length;
779 SV *sv;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200780#ifdef HAVE_SANDBOX
Bram Moolenaar071d4272004-06-13 20:20:40 +0000781 SV *safe;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200782#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000783
784 script = (char *)script_get(eap, eap->arg);
785 if (eap->skip)
786 {
787 vim_free(script);
788 return;
789 }
790
791 if (perl_interp == NULL)
792 {
793#ifdef DYNAMIC_PERL
794 if (!perl_enabled(TRUE))
795 {
796 EMSG(_(e_noperl));
797 vim_free(script);
798 return;
799 }
800#endif
801 perl_init();
802 }
803
804 {
805 dSP;
806 ENTER;
807 SAVETMPS;
808
809 if (script == NULL)
810 sv = newSVpv((char *)eap->arg, 0);
811 else
812 {
813 sv = newSVpv(script, 0);
814 vim_free(script);
815 }
816
817#ifdef HAVE_SANDBOX
818 if (sandbox)
819 {
Bram Moolenaara1711622011-07-27 14:15:46 +0200820 safe = perl_get_sv("VIM::safe", FALSE);
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000821# ifndef MAKE_TEST /* avoid a warning for unreachable code */
Bram Moolenaar954e8c52009-11-11 13:45:33 +0000822 if (safe == NULL || !SvTRUE(safe))
Bram Moolenaar071d4272004-06-13 20:20:40 +0000823 EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
824 else
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000825# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000826 {
827 PUSHMARK(SP);
828 XPUSHs(safe);
829 XPUSHs(sv);
830 PUTBACK;
831 perl_call_method("reval", G_DISCARD);
832 }
833 }
834 else
835#endif
836 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
837
838 SvREFCNT_dec(sv);
839
Bram Moolenaarc271c482012-08-08 13:17:31 +0200840#ifdef AVOID_PL_ERRGV
841 err = SvPV(perl_get_sv("@", GV_ADD), length);
842#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000843 err = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200844#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000845
846 FREETMPS;
847 LEAVE;
848
849 if (!length)
850 return;
851
852 msg_split((char_u *)err, highlight_attr[HLF_E]);
853 return;
854 }
855}
856
857 static int
858replace_line(line, end)
859 linenr_T *line, *end;
860{
861 char *str;
862
863 if (SvOK(GvSV(PL_defgv)))
864 {
865 str = SvPV(GvSV(PL_defgv), PL_na);
866 ml_replace(*line, (char_u *)str, 1);
867 changed_bytes(*line, 0);
868 }
869 else
870 {
871 ml_delete(*line, FALSE);
872 deleted_lines_mark(*line, 1L);
873 --(*end);
874 --(*line);
875 }
876 return OK;
877}
878
879/*
880 * ":perldo".
881 */
882 void
883ex_perldo(eap)
884 exarg_T *eap;
885{
886 STRLEN length;
887 SV *sv;
888 char *str;
889 linenr_T i;
890
891 if (bufempty())
892 return;
893
894 if (perl_interp == NULL)
895 {
896#ifdef DYNAMIC_PERL
897 if (!perl_enabled(TRUE))
898 {
899 EMSG(_(e_noperl));
900 return;
901 }
902#endif
903 perl_init();
904 }
905 {
906 dSP;
907 length = strlen((char *)eap->arg);
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000908 sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
909 sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000910 sv_catpvn(sv, (char *)eap->arg, length);
911 sv_catpvn(sv, "}", 1);
912 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
913 SvREFCNT_dec(sv);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200914#ifdef AVOID_PL_ERRGV
915 str = SvPV(perl_get_sv("@", GV_ADD), length);
916#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000917 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200918#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000919 if (length)
920 goto err;
921
922 if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
923 return;
924
925 ENTER;
926 SAVETMPS;
927 for (i = eap->line1; i <= eap->line2; i++)
928 {
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000929 sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000930 PUSHMARK(sp);
931 perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200932#ifdef AVOID_PL_ERRGV
933 str = SvPV(perl_get_sv("@", GV_ADD), length);
934#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000935 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200936#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000937 if (length)
938 break;
939 SPAGAIN;
940 if (SvTRUEx(POPs))
941 {
942 if (replace_line(&i, &eap->line2) != OK)
943 {
944 PUTBACK;
945 break;
946 }
947 }
948 PUTBACK;
949 }
950 FREETMPS;
951 LEAVE;
952 check_cursor();
953 update_screen(NOT_VALID);
954 if (!length)
955 return;
956
957err:
958 msg_split((char_u *)str, highlight_attr[HLF_E]);
959 return;
960 }
961}
962
Bram Moolenaar01dd60c2008-07-24 14:24:48 +0000963#ifndef FEAT_WINDOWS
964int win_valid(win_T *w) { return TRUE; }
965int win_count() { return 1; }
966win_T *win_find_nr(int n) { return curwin; }
967#endif
968
Bram Moolenaar071d4272004-06-13 20:20:40 +0000969XS(boot_VIM);
970
971 static void
972xs_init(pTHX)
973{
974 char *file = __FILE__;
975
976 /* DynaLoader is a special case */
977 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
978 newXS("VIM::bootstrap", boot_VIM, file);
979}
980
981typedef win_T * VIWIN;
982typedef buf_T * VIBUF;
983
984MODULE = VIM PACKAGE = VIM
985
986void
987Msg(text, hl=NULL)
988 char *text;
989 char *hl;
990
991 PREINIT:
992 int attr;
993 int id;
994
995 PPCODE:
996 if (text != NULL)
997 {
998 attr = 0;
999 if (hl != NULL)
1000 {
1001 id = syn_name2id((char_u *)hl);
1002 if (id != 0)
1003 attr = syn_id2attr(id);
1004 }
1005 msg_split((char_u *)text, attr);
1006 }
1007
1008void
1009SetOption(line)
1010 char *line;
1011
1012 PPCODE:
1013 if (line != NULL)
1014 do_set((char_u *)line, 0);
1015 update_screen(NOT_VALID);
1016
1017void
1018DoCommand(line)
1019 char *line;
1020
1021 PPCODE:
1022 if (line != NULL)
1023 do_cmdline_cmd((char_u *)line);
1024
1025void
1026Eval(str)
1027 char *str;
1028
1029 PREINIT:
1030 char_u *value;
1031 PPCODE:
Bram Moolenaar362e1a32006-03-06 23:29:24 +00001032 value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001033 if (value == NULL)
1034 {
1035 XPUSHs(sv_2mortal(newSViv(0)));
1036 XPUSHs(sv_2mortal(newSVpv("", 0)));
1037 }
1038 else
1039 {
1040 XPUSHs(sv_2mortal(newSViv(1)));
1041 XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
1042 vim_free(value);
1043 }
1044
1045void
1046Buffers(...)
1047
1048 PREINIT:
1049 buf_T *vimbuf;
1050 int i, b;
1051
1052 PPCODE:
1053 if (items == 0)
1054 {
1055 if (GIMME == G_SCALAR)
1056 {
1057 i = 0;
1058 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1059 ++i;
1060
1061 XPUSHs(sv_2mortal(newSViv(i)));
1062 }
1063 else
1064 {
1065 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1066 XPUSHs(newBUFrv(newSV(0), vimbuf));
1067 }
1068 }
1069 else
1070 {
1071 for (i = 0; i < items; i++)
1072 {
1073 SV *sv = ST(i);
1074 if (SvIOK(sv))
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001075 b = (int) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001076 else
1077 {
1078 char_u *pat;
1079 STRLEN len;
1080
1081 pat = (char_u *)SvPV(sv, len);
1082 ++emsg_off;
Bram Moolenaar0c279bb2013-03-19 14:25:54 +01001083 b = buflist_findpat(pat, pat+len, FALSE, FALSE, FALSE);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001084 --emsg_off;
1085 }
1086
1087 if (b >= 0)
1088 {
1089 vimbuf = buflist_findnr(b);
1090 if (vimbuf)
1091 XPUSHs(newBUFrv(newSV(0), vimbuf));
1092 }
1093 }
1094 }
1095
1096void
1097Windows(...)
1098
1099 PREINIT:
1100 win_T *vimwin;
1101 int i, w;
1102
1103 PPCODE:
1104 if (items == 0)
1105 {
1106 if (GIMME == G_SCALAR)
1107 XPUSHs(sv_2mortal(newSViv(win_count())));
1108 else
1109 {
1110 for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1111 XPUSHs(newWINrv(newSV(0), vimwin));
1112 }
1113 }
1114 else
1115 {
1116 for (i = 0; i < items; i++)
1117 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001118 w = (int) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001119 vimwin = win_find_nr(w);
1120 if (vimwin)
1121 XPUSHs(newWINrv(newSV(0), vimwin));
1122 }
1123 }
1124
1125MODULE = VIM PACKAGE = VIWIN
1126
1127void
1128DESTROY(win)
1129 VIWIN win
1130
1131 CODE:
1132 if (win_valid(win))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001133 win->w_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001134
1135SV *
1136Buffer(win)
1137 VIWIN win
1138
1139 CODE:
1140 if (!win_valid(win))
1141 win = curwin;
1142 RETVAL = newBUFrv(newSV(0), win->w_buffer);
1143 OUTPUT:
1144 RETVAL
1145
1146void
1147SetHeight(win, height)
1148 VIWIN win
1149 int height;
1150
1151 PREINIT:
1152 win_T *savewin;
1153
1154 PPCODE:
1155 if (!win_valid(win))
1156 win = curwin;
1157 savewin = curwin;
1158 curwin = win;
1159 win_setheight(height);
1160 curwin = savewin;
1161
1162void
1163Cursor(win, ...)
1164 VIWIN win
1165
1166 PPCODE:
Bram Moolenaara1711622011-07-27 14:15:46 +02001167 if (items == 1)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001168 {
1169 EXTEND(sp, 2);
1170 if (!win_valid(win))
1171 win = curwin;
1172 PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1173 PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1174 }
Bram Moolenaara1711622011-07-27 14:15:46 +02001175 else if (items == 3)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001176 {
1177 int lnum, col;
1178
1179 if (!win_valid(win))
1180 win = curwin;
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001181 lnum = (int) SvIV(ST(1));
1182 col = (int) SvIV(ST(2));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001183 win->w_cursor.lnum = lnum;
1184 win->w_cursor.col = col;
1185 check_cursor(); /* put cursor on an existing line */
1186 update_screen(NOT_VALID);
1187 }
1188
1189MODULE = VIM PACKAGE = VIBUF
1190
1191void
1192DESTROY(vimbuf)
1193 VIBUF vimbuf;
1194
1195 CODE:
1196 if (buf_valid(vimbuf))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001197 vimbuf->b_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001198
1199void
1200Name(vimbuf)
1201 VIBUF vimbuf;
1202
1203 PPCODE:
1204 if (!buf_valid(vimbuf))
1205 vimbuf = curbuf;
1206 /* No file name returns an empty string */
1207 if (vimbuf->b_fname == NULL)
1208 XPUSHs(sv_2mortal(newSVpv("", 0)));
1209 else
1210 XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1211
1212void
1213Number(vimbuf)
1214 VIBUF vimbuf;
1215
1216 PPCODE:
1217 if (!buf_valid(vimbuf))
1218 vimbuf = curbuf;
1219 XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1220
1221void
1222Count(vimbuf)
1223 VIBUF vimbuf;
1224
1225 PPCODE:
1226 if (!buf_valid(vimbuf))
1227 vimbuf = curbuf;
1228 XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1229
1230void
1231Get(vimbuf, ...)
1232 VIBUF vimbuf;
1233
1234 PREINIT:
1235 char_u *line;
1236 int i;
1237 long lnum;
1238 PPCODE:
1239 if (buf_valid(vimbuf))
1240 {
1241 for (i = 1; i < items; i++)
1242 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001243 lnum = (long) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001244 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1245 {
1246 line = ml_get_buf(vimbuf, lnum, FALSE);
1247 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1248 }
1249 }
1250 }
1251
1252void
1253Set(vimbuf, ...)
1254 VIBUF vimbuf;
1255
1256 PREINIT:
1257 int i;
1258 long lnum;
1259 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001260 PPCODE:
1261 if (buf_valid(vimbuf))
1262 {
1263 if (items < 3)
1264 croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1265
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001266 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001267 for(i = 2; i < items; i++, lnum++)
1268 {
1269 line = SvPV(ST(i),PL_na);
1270 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1271 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001272 aco_save_T aco;
1273
1274 /* set curwin/curbuf for "vimbuf" and save some things */
1275 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001276
Bram Moolenaar071d4272004-06-13 20:20:40 +00001277 if (u_savesub(lnum) == OK)
1278 {
1279 ml_replace(lnum, (char_u *)line, TRUE);
1280 changed_bytes(lnum, 0);
1281 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001282
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001283 /* restore curwin/curbuf and a few other things */
1284 aucmd_restbuf(&aco);
1285 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaar071d4272004-06-13 20:20:40 +00001286 }
1287 }
1288 }
1289
1290void
1291Delete(vimbuf, ...)
1292 VIBUF vimbuf;
1293
1294 PREINIT:
1295 long i, lnum = 0, count = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001296 PPCODE:
1297 if (buf_valid(vimbuf))
1298 {
1299 if (items == 2)
1300 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001301 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001302 count = 1;
1303 }
1304 else if (items == 3)
1305 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001306 lnum = (long) SvIV(ST(1));
1307 count = (long) 1 + SvIV(ST(2)) - lnum;
Bram Moolenaara1711622011-07-27 14:15:46 +02001308 if (count == 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001309 count = 1;
Bram Moolenaara1711622011-07-27 14:15:46 +02001310 if (count < 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001311 {
1312 lnum -= count;
1313 count = -count;
1314 }
1315 }
1316 if (items >= 2)
1317 {
1318 for (i = 0; i < count; i++)
1319 {
1320 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1321 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001322 aco_save_T aco;
1323
1324 /* set curwin/curbuf for "vimbuf" and save some things */
1325 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001326
Bram Moolenaar071d4272004-06-13 20:20:40 +00001327 if (u_savedel(lnum, 1) == OK)
1328 {
1329 ml_delete(lnum, 0);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00001330 check_cursor();
Bram Moolenaar071d4272004-06-13 20:20:40 +00001331 deleted_lines_mark(lnum, 1L);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001332 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001333
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001334 /* restore curwin/curbuf and a few other things */
1335 aucmd_restbuf(&aco);
1336 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001337
Bram Moolenaar071d4272004-06-13 20:20:40 +00001338 update_curbuf(VALID);
1339 }
1340 }
1341 }
1342 }
1343
1344void
1345Append(vimbuf, ...)
1346 VIBUF vimbuf;
1347
1348 PREINIT:
1349 int i;
1350 long lnum;
1351 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001352 PPCODE:
1353 if (buf_valid(vimbuf))
1354 {
1355 if (items < 3)
1356 croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1357
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001358 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001359 for (i = 2; i < items; i++, lnum++)
1360 {
1361 line = SvPV(ST(i),PL_na);
1362 if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1363 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001364 aco_save_T aco;
1365
1366 /* set curwin/curbuf for "vimbuf" and save some things */
1367 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001368
Bram Moolenaar071d4272004-06-13 20:20:40 +00001369 if (u_inssub(lnum + 1) == OK)
1370 {
1371 ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1372 appended_lines_mark(lnum, 1L);
1373 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001374
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001375 /* restore curwin/curbuf and a few other things */
1376 aucmd_restbuf(&aco);
1377 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001378
Bram Moolenaar071d4272004-06-13 20:20:40 +00001379 update_curbuf(VALID);
1380 }
1381 }
1382 }
1383