blob: 56e0eb3a1ae20b1efd213911142766324d2fe93d [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
16#include "vim.h"
17
18
19/*
20 * Work around clashes between Perl and Vim namespace. proto.h doesn't
21 * include if_perl.pro and perlsfio.pro when IN_PERL_FILE is defined, because
22 * we need the CV typedef. proto.h can't be moved to after including
23 * if_perl.h, because we get all sorts of name clashes then.
24 */
25#ifndef PROTO
26#ifndef __MINGW32__
27# include "proto/if_perl.pro"
28# include "proto/if_perlsfio.pro"
29#endif
30#endif
31
32/* Perl compatibility stuff. This should ensure compatibility with older
33 * versions of Perl.
34 */
35
36#ifndef PERL_VERSION
37# include <patchlevel.h>
38# define PERL_REVISION 5
39# define PERL_VERSION PATCHLEVEL
40# define PERL_SUBVERSION SUBVERSION
41#endif
42
Bram Moolenaar700d1d72007-09-13 13:20:16 +000043/*
44 * Quoting Jan Dubois of Active State:
45 * ActivePerl build 822 still identifies itself as 5.8.8 but already
46 * contains many of the changes from the upcoming Perl 5.8.9 release.
47 *
48 * The changes include addition of two symbols (Perl_sv_2iv_flags,
49 * Perl_newXS_flags) not present in earlier releases.
50 *
Bram Moolenaar3b9b13e2007-09-15 12:49:35 +000051 * Jan Dubois suggested the following guarding scheme.
52 *
53 * Active State defined ACTIVEPERL_VERSION as a string in versions before
54 * 5.8.8; and so the comparison to 822 below needs to be guarded.
Bram Moolenaar700d1d72007-09-13 13:20:16 +000055 */
Bram Moolenaar3b9b13e2007-09-15 12:49:35 +000056#if (PERL_REVISION == 5) && (PERL_VERSION == 8) && (PERL_SUBVERSION >= 8)
57# if (ACTIVEPERL_VERSION >= 822) || (PERL_SUBVERSION >= 9)
58# define PERL589_OR_LATER
59# endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +000060#endif
61#if (PERL_REVISION == 5) && (PERL_VERSION >= 9)
62# define PERL589_OR_LATER
63#endif
64
Bram Moolenaar58cb0892010-03-02 15:14:33 +010065#if (PERL_REVISION == 5) && ((PERL_VERSION > 10) || \
66 (PERL_VERSION == 10) && (PERL_SUBVERSION >= 1))
67# define PERL5101_OR_LATER
68#endif
69
Bram Moolenaar071d4272004-06-13 20:20:40 +000070#ifndef pTHX
71# define pTHX void
72# define pTHX_
73#endif
74
75#ifndef EXTERN_C
76# define EXTERN_C
77#endif
78
Bram Moolenaarc271c482012-08-08 13:17:31 +020079#if (PERL_REVISION == 5) && (PERL_VERSION >= 14) && defined(_MSC_VER)
80/* Using PL_errgv to get the error message after perl_eval_sv() causes a crash
81 * with MSVC and Perl version 5.14. */
82# define AVOID_PL_ERRGV
83#endif
84
Bram Moolenaar071d4272004-06-13 20:20:40 +000085/* Compatibility hacks over */
86
87static PerlInterpreter *perl_interp = NULL;
88static void xs_init __ARGS((pTHX));
89static void VIM_init __ARGS((void));
90EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
91
92/*
Bram Moolenaare06c1882010-07-21 22:05:20 +020093 * For dynamic linked perl.
Bram Moolenaar071d4272004-06-13 20:20:40 +000094 */
95#if defined(DYNAMIC_PERL) || defined(PROTO)
Bram Moolenaare06c1882010-07-21 22:05:20 +020096
97#ifndef DYNAMIC_PERL /* just generating prototypes */
Bram Moolenaar766fb0d2010-07-22 11:34:16 +020098#ifdef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +020099typedef int HANDLE;
100#endif
101typedef int XSINIT_t;
102typedef int XSUBADDR_t;
103typedef int perl_key;
104#endif
105
Bram Moolenaar766fb0d2010-07-22 11:34:16 +0200106#ifndef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +0200107#include <dlfcn.h>
108#define HANDLE void*
109#define PERL_PROC void*
110#define load_dll(n) dlopen((n), RTLD_LAZY|RTLD_GLOBAL)
111#define symbol_from_dll dlsym
112#define close_dll dlclose
113#else
114#define PERL_PROC FARPROC
Bram Moolenaarebbcb822010-10-23 14:02:54 +0200115#define load_dll vimLoadLib
Bram Moolenaare06c1882010-07-21 22:05:20 +0200116#define symbol_from_dll GetProcAddress
117#define close_dll FreeLibrary
118#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000119/*
120 * Wrapper defines
121 */
122# define perl_alloc dll_perl_alloc
123# define perl_construct dll_perl_construct
124# define perl_parse dll_perl_parse
125# define perl_run dll_perl_run
126# define perl_destruct dll_perl_destruct
127# define perl_free dll_perl_free
128# define Perl_get_context dll_Perl_get_context
129# define Perl_croak dll_Perl_croak
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100130# ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100131# define Perl_croak_xs_usage dll_Perl_croak_xs_usage
132# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000133# ifndef PROTO
134# define Perl_croak_nocontext dll_Perl_croak_nocontext
135# define Perl_call_argv dll_Perl_call_argv
136# define Perl_call_pv dll_Perl_call_pv
137# define Perl_eval_sv dll_Perl_eval_sv
138# define Perl_get_sv dll_Perl_get_sv
139# define Perl_eval_pv dll_Perl_eval_pv
140# define Perl_call_method dll_Perl_call_method
141# endif
142# define Perl_dowantarray dll_Perl_dowantarray
143# define Perl_free_tmps dll_Perl_free_tmps
144# define Perl_gv_stashpv dll_Perl_gv_stashpv
145# define Perl_markstack_grow dll_Perl_markstack_grow
146# define Perl_mg_find dll_Perl_mg_find
147# define Perl_newXS dll_Perl_newXS
148# define Perl_newSV dll_Perl_newSV
149# define Perl_newSViv dll_Perl_newSViv
150# define Perl_newSVpv dll_Perl_newSVpv
151# define Perl_pop_scope dll_Perl_pop_scope
152# define Perl_push_scope dll_Perl_push_scope
153# define Perl_save_int dll_Perl_save_int
154# define Perl_stack_grow dll_Perl_stack_grow
155# define Perl_set_context dll_Perl_set_context
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200156# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
157# define Perl_sv_2bool_flags dll_Perl_sv_2bool_flags
158# define Perl_xs_apiversion_bootcheck dll_Perl_xs_apiversion_bootcheck
159# else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000160# define Perl_sv_2bool dll_Perl_sv_2bool
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200161# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000162# define Perl_sv_2iv dll_Perl_sv_2iv
163# define Perl_sv_2mortal dll_Perl_sv_2mortal
164# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
165# define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
166# define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
167# else
168# define Perl_sv_2pv dll_Perl_sv_2pv
169# endif
170# define Perl_sv_bless dll_Perl_sv_bless
171# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
172# define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
173# else
174# define Perl_sv_catpvn dll_Perl_sv_catpvn
175# endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000176#ifdef PERL589_OR_LATER
177# define Perl_sv_2iv_flags dll_Perl_sv_2iv_flags
178# define Perl_newXS_flags dll_Perl_newXS_flags
179#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000180# define Perl_sv_free dll_Perl_sv_free
Bram Moolenaarccf22172008-09-01 15:56:45 +0000181# if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
182# define Perl_sv_free2 dll_Perl_sv_free2
183# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000184# define Perl_sv_isa dll_Perl_sv_isa
185# define Perl_sv_magic dll_Perl_sv_magic
186# define Perl_sv_setiv dll_Perl_sv_setiv
187# define Perl_sv_setpv dll_Perl_sv_setpv
188# define Perl_sv_setpvn dll_Perl_sv_setpvn
189# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
190# define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
191# else
192# define Perl_sv_setsv dll_Perl_sv_setsv
193# endif
194# define Perl_sv_upgrade dll_Perl_sv_upgrade
195# define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
196# define Perl_Top_ptr dll_Perl_Top_ptr
197# define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
198# define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
199# define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
200# define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
201# define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
202# define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
203# define Perl_TSv_ptr dll_Perl_TSv_ptr
204# define Perl_TXpv_ptr dll_Perl_TXpv_ptr
205# define Perl_Tna_ptr dll_Perl_Tna_ptr
206# define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
207# define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
208# define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
209# define boot_DynaLoader dll_boot_DynaLoader
Bram Moolenaare06c1882010-07-21 22:05:20 +0200210# define Perl_Gthr_key_ptr dll_Perl_Gthr_key_ptr
Bram Moolenaar071d4272004-06-13 20:20:40 +0000211
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000212# define Perl_sys_init dll_Perl_sys_init
Bram Moolenaarc236c162008-07-13 17:41:49 +0000213# define Perl_sys_term dll_Perl_sys_term
214# define Perl_ISv_ptr dll_Perl_ISv_ptr
215# define Perl_Istack_max_ptr dll_Perl_Istack_max_ptr
216# define Perl_Istack_base_ptr dll_Perl_Istack_base_ptr
217# define Perl_Itmps_ix_ptr dll_Perl_Itmps_ix_ptr
218# define Perl_Itmps_floor_ptr dll_Perl_Itmps_floor_ptr
219# define Perl_IXpv_ptr dll_Perl_IXpv_ptr
220# define Perl_Ina_ptr dll_Perl_Ina_ptr
221# define Perl_Imarkstack_ptr_ptr dll_Perl_Imarkstack_ptr_ptr
222# define Perl_Imarkstack_max_ptr dll_Perl_Imarkstack_max_ptr
223# define Perl_Istack_sp_ptr dll_Perl_Istack_sp_ptr
224# define Perl_Iop_ptr dll_Perl_Iop_ptr
225# define Perl_call_list dll_Perl_call_list
226# define Perl_Iscopestack_ix_ptr dll_Perl_Iscopestack_ix_ptr
227# define Perl_Iunitcheckav_ptr dll_Perl_Iunitcheckav_ptr
228
Bram Moolenaar071d4272004-06-13 20:20:40 +0000229/*
230 * Declare HANDLE for perl.dll and function pointers.
231 */
232static HANDLE hPerlLib = NULL;
233
234static PerlInterpreter* (*perl_alloc)();
235static void (*perl_construct)(PerlInterpreter*);
236static void (*perl_destruct)(PerlInterpreter*);
237static void (*perl_free)(PerlInterpreter*);
238static int (*perl_run)(PerlInterpreter*);
239static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
240static void* (*Perl_get_context)(void);
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000241static void (*Perl_croak)(pTHX_ const char*, ...);
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100242#ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100243static void (*Perl_croak_xs_usage)(pTHX_ const CV *const, const char *const params);
244#endif
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000245static void (*Perl_croak_nocontext)(const char*, ...);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000246static I32 (*Perl_dowantarray)(pTHX);
247static void (*Perl_free_tmps)(pTHX);
248static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
249static void (*Perl_markstack_grow)(pTHX);
250static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
251static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
252static SV* (*Perl_newSV)(pTHX_ STRLEN);
253static SV* (*Perl_newSViv)(pTHX_ IV);
254static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
255static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
256static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
257static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
258static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
259static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
260static SV* (*Perl_call_method)(pTHX_ const char*, I32);
261static void (*Perl_pop_scope)(pTHX);
262static void (*Perl_push_scope)(pTHX);
263static void (*Perl_save_int)(pTHX_ int*);
264static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
265static SV** (*Perl_set_context)(void*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200266#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
267static bool (*Perl_sv_2bool_flags)(pTHX_ SV*, I32);
268static void (*Perl_xs_apiversion_bootcheck)(pTHX_ SV *module, const char *api_p, STRLEN api_len);
269#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000270static bool (*Perl_sv_2bool)(pTHX_ SV*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200271#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000272static IV (*Perl_sv_2iv)(pTHX_ SV*);
273static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
274#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
275static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
276static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
277#else
278static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
279#endif
280static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
281#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
282static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
283#else
284static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
285#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000286#ifdef PERL589_OR_LATER
287static IV (*Perl_sv_2iv_flags)(pTHX_ SV* sv, I32 flags);
288static CV * (*Perl_newXS_flags)(pTHX_ const char *name, XSUBADDR_t subaddr, const char *const filename, const char *const proto, U32 flags);
289#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000290static void (*Perl_sv_free)(pTHX_ SV*);
291static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
292static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
293static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
294static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
295static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
296#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
297static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
298#else
299static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
300#endif
301static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200302#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000303static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
304static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
305static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
306static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
307static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
308static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
309static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
310static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
311static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
312static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
313static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200314#else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000315static void (*Perl_sv_free2)(pTHX_ SV*);
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000316static void (*Perl_sys_init)(int* argc, char*** argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000317static void (*Perl_sys_term)(void);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200318static void (*Perl_call_list)(pTHX_ I32, AV*);
319# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
320# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000321static SV** (*Perl_ISv_ptr)(register PerlInterpreter*);
322static SV*** (*Perl_Istack_max_ptr)(register PerlInterpreter*);
323static SV*** (*Perl_Istack_base_ptr)(register PerlInterpreter*);
324static XPV** (*Perl_IXpv_ptr)(register PerlInterpreter*);
325static I32* (*Perl_Itmps_ix_ptr)(register PerlInterpreter*);
326static I32* (*Perl_Itmps_floor_ptr)(register PerlInterpreter*);
327static STRLEN* (*Perl_Ina_ptr)(register PerlInterpreter*);
328static I32** (*Perl_Imarkstack_ptr_ptr)(register PerlInterpreter*);
329static I32** (*Perl_Imarkstack_max_ptr)(register PerlInterpreter*);
330static SV*** (*Perl_Istack_sp_ptr)(register PerlInterpreter*);
331static OP** (*Perl_Iop_ptr)(register PerlInterpreter*);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000332static I32* (*Perl_Iscopestack_ix_ptr)(register PerlInterpreter*);
333static AV** (*Perl_Iunitcheckav_ptr)(register PerlInterpreter*);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200334# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000335#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000336
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200337#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
338#else
Bram Moolenaare06c1882010-07-21 22:05:20 +0200339static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
340static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
341static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200342static perl_key* (*Perl_Gthr_key_ptr)_((pTHX));
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200343#endif
344static void (*boot_DynaLoader)_((pTHX_ CV*));
Bram Moolenaare06c1882010-07-21 22:05:20 +0200345
Bram Moolenaar071d4272004-06-13 20:20:40 +0000346/*
347 * Table of name to function pointer of perl.
348 */
Bram Moolenaar071d4272004-06-13 20:20:40 +0000349static struct {
350 char* name;
351 PERL_PROC* ptr;
352} perl_funcname_table[] = {
353 {"perl_alloc", (PERL_PROC*)&perl_alloc},
354 {"perl_construct", (PERL_PROC*)&perl_construct},
355 {"perl_destruct", (PERL_PROC*)&perl_destruct},
356 {"perl_free", (PERL_PROC*)&perl_free},
357 {"perl_run", (PERL_PROC*)&perl_run},
358 {"perl_parse", (PERL_PROC*)&perl_parse},
359 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
360 {"Perl_croak", (PERL_PROC*)&Perl_croak},
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100361#ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100362 {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
363#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000364 {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
365 {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
366 {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
367 {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
368 {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
369 {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
370 {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
371 {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
372 {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
373 {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
374 {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
375 {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
376 {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
377 {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
378 {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
379 {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
380 {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
381 {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
382 {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
383 {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
384 {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200385#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
386 {"Perl_sv_2bool_flags", (PERL_PROC*)&Perl_sv_2bool_flags},
387 {"Perl_xs_apiversion_bootcheck",(PERL_PROC*)&Perl_xs_apiversion_bootcheck},
388#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000389 {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200390#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000391 {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
392 {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
393#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
394 {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
395 {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
396#else
397 {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
398#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000399#ifdef PERL589_OR_LATER
400 {"Perl_sv_2iv_flags", (PERL_PROC*)&Perl_sv_2iv_flags},
401 {"Perl_newXS_flags", (PERL_PROC*)&Perl_newXS_flags},
402#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000403 {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
404#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
405 {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
406#else
407 {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
408#endif
409 {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
410 {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
411 {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
412 {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
413 {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
414 {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
415#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
416 {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
417#else
418 {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
419#endif
420 {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000421#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000422 {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
423 {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
424 {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
425 {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
426 {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
427 {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
428 {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
429 {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
430 {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
431 {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
432 {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000433#else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000434 {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000435 {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000436 {"Perl_sys_term", (PERL_PROC*)&Perl_sys_term},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200437 {"Perl_call_list", (PERL_PROC*)&Perl_call_list},
438# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
439# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000440 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000441 {"Perl_Istack_max_ptr", (PERL_PROC*)&Perl_Istack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200442 {"Perl_Istack_base_ptr", (PERL_PROC*)&Perl_Istack_base_ptr},
443 {"Perl_IXpv_ptr", (PERL_PROC*)&Perl_IXpv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000444 {"Perl_Itmps_ix_ptr", (PERL_PROC*)&Perl_Itmps_ix_ptr},
445 {"Perl_Itmps_floor_ptr", (PERL_PROC*)&Perl_Itmps_floor_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200446 {"Perl_Ina_ptr", (PERL_PROC*)&Perl_Ina_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000447 {"Perl_Imarkstack_ptr_ptr", (PERL_PROC*)&Perl_Imarkstack_ptr_ptr},
448 {"Perl_Imarkstack_max_ptr", (PERL_PROC*)&Perl_Imarkstack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200449 {"Perl_Istack_sp_ptr", (PERL_PROC*)&Perl_Istack_sp_ptr},
450 {"Perl_Iop_ptr", (PERL_PROC*)&Perl_Iop_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000451 {"Perl_Iscopestack_ix_ptr", (PERL_PROC*)&Perl_Iscopestack_ix_ptr},
452 {"Perl_Iunitcheckav_ptr", (PERL_PROC*)&Perl_Iunitcheckav_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200453# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000454#endif
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200455#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
456#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000457 {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
458 {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
459 {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200460 {"Perl_Gthr_key_ptr", (PERL_PROC*)&Perl_Gthr_key_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200461#endif
462 {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
Bram Moolenaar071d4272004-06-13 20:20:40 +0000463 {"", NULL},
464};
465
466/*
467 * Make all runtime-links of perl.
468 *
469 * 1. Get module handle using LoadLibraryEx.
470 * 2. Get pointer to perl function by GetProcAddress.
471 * 3. Repeat 2, until get all functions will be used.
472 *
473 * Parameter 'libname' provides name of DLL.
474 * Return OK or FAIL.
475 */
476 static int
477perl_runtime_link_init(char *libname, int verbose)
478{
479 int i;
480
481 if (hPerlLib != NULL)
482 return OK;
Bram Moolenaare06c1882010-07-21 22:05:20 +0200483 if ((hPerlLib = load_dll(libname)) == NULL)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000484 {
485 if (verbose)
486 EMSG2(_("E370: Could not load library %s"), libname);
487 return FAIL;
488 }
489 for (i = 0; perl_funcname_table[i].ptr; ++i)
490 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200491 if (!(*perl_funcname_table[i].ptr = symbol_from_dll(hPerlLib,
Bram Moolenaar071d4272004-06-13 20:20:40 +0000492 perl_funcname_table[i].name)))
493 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200494 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000495 hPerlLib = NULL;
496 if (verbose)
497 EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
498 return FAIL;
499 }
500 }
501 return OK;
502}
503
504/*
505 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
506 * There were no DLL loaded, return FALSE.
507 */
508 int
509perl_enabled(verbose)
510 int verbose;
511{
512 return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
513}
514#endif /* DYNAMIC_PERL */
515
516/*
517 * perl_init(): initialize perl interpreter
518 * We have to call perl_parse to initialize some structures,
519 * there's nothing to actually parse.
520 */
521 static void
522perl_init()
523{
Bram Moolenaarc236c162008-07-13 17:41:49 +0000524 char *bootargs[] = { "VI", NULL };
525 int argc = 3;
526 static char *argv[] = { "", "-e", "" };
Bram Moolenaar071d4272004-06-13 20:20:40 +0000527
Bram Moolenaarc236c162008-07-13 17:41:49 +0000528#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000529 Perl_sys_init(&argc, (char***)&argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000530#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000531 perl_interp = perl_alloc();
532 perl_construct(perl_interp);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000533 perl_parse(perl_interp, xs_init, argc, argv, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000534 perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
535 VIM_init();
536#ifdef USE_SFIO
537 sfdisc(PerlIO_stdout(), sfdcnewvim());
538 sfdisc(PerlIO_stderr(), sfdcnewvim());
539 sfsetbuf(PerlIO_stdout(), NULL, 0);
540 sfsetbuf(PerlIO_stderr(), NULL, 0);
541#endif
542}
543
544/*
545 * perl_end(): clean up after ourselves
546 */
547 void
548perl_end()
549{
550 if (perl_interp)
551 {
552 perl_run(perl_interp);
553 perl_destruct(perl_interp);
554 perl_free(perl_interp);
555 perl_interp = NULL;
Bram Moolenaarc236c162008-07-13 17:41:49 +0000556#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
557 Perl_sys_term();
558#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000559 }
560#ifdef DYNAMIC_PERL
561 if (hPerlLib)
562 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200563 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000564 hPerlLib = NULL;
565 }
566#endif
567}
568
569/*
570 * msg_split(): send a message to the message handling routines
571 * split at '\n' first though.
572 */
573 void
574msg_split(s, attr)
575 char_u *s;
576 int attr; /* highlighting attributes */
577{
578 char *next;
579 char *token = (char *)s;
580
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000581 while ((next = strchr(token, '\n')) && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000582 {
583 *next++ = '\0'; /* replace \n with \0 */
584 msg_attr((char_u *)token, attr);
585 token = next;
586 }
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000587 if (*token && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000588 msg_attr((char_u *)token, attr);
589}
590
591#ifndef FEAT_EVAL
592/*
593 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
594 * work properly.
595 */
596 char_u *
Bram Moolenaar362e1a32006-03-06 23:29:24 +0000597eval_to_string(arg, nextcmd, dolist)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000598 char_u *arg;
599 char_u **nextcmd;
Bram Moolenaar362e1a32006-03-06 23:29:24 +0000600 int dolist;
Bram Moolenaar071d4272004-06-13 20:20:40 +0000601{
602 return NULL;
603}
604#endif
605
606/*
607 * Create a new reference to an SV pointing to the SCR structure
Bram Moolenaare344bea2005-09-01 20:46:49 +0000608 * The b_perl_private/w_perl_private part of the SCR structure points to the
609 * SV, so there can only be one such SV for a particular SCR structure. When
610 * the last reference has gone (DESTROY is called),
611 * b_perl_private/w_perl_private is reset; When the screen goes away before
Bram Moolenaar071d4272004-06-13 20:20:40 +0000612 * all references are gone, the value of the SV is reset;
613 * any subsequent use of any of those reference will produce
614 * a warning. (see typemap)
615 */
Bram Moolenaare344bea2005-09-01 20:46:49 +0000616
617 static SV *
618newWINrv(rv, ptr)
619 SV *rv;
620 win_T *ptr;
621{
622 sv_upgrade(rv, SVt_RV);
623 if (ptr->w_perl_private == NULL)
624 {
625 ptr->w_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100626 sv_setiv(ptr->w_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000627 }
628 else
629 SvREFCNT_inc(ptr->w_perl_private);
630 SvRV(rv) = ptr->w_perl_private;
631 SvROK_on(rv);
632 return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000633}
634
Bram Moolenaare344bea2005-09-01 20:46:49 +0000635 static SV *
636newBUFrv(rv, ptr)
637 SV *rv;
638 buf_T *ptr;
639{
640 sv_upgrade(rv, SVt_RV);
641 if (ptr->b_perl_private == NULL)
642 {
643 ptr->b_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100644 sv_setiv(ptr->b_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000645 }
646 else
647 SvREFCNT_inc(ptr->b_perl_private);
648 SvRV(rv) = ptr->b_perl_private;
649 SvROK_on(rv);
650 return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
651}
Bram Moolenaar071d4272004-06-13 20:20:40 +0000652
653/*
654 * perl_win_free
655 * Remove all refences to the window to be destroyed
656 */
657 void
658perl_win_free(wp)
659 win_T *wp;
660{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000661 if (wp->w_perl_private)
662 sv_setiv((SV *)wp->w_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000663 return;
664}
665
666 void
667perl_buf_free(bp)
668 buf_T *bp;
669{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000670 if (bp->b_perl_private)
671 sv_setiv((SV *)bp->b_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000672 return;
673}
674
675#ifndef PROTO
676# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
677I32 cur_val(pTHX_ IV iv, SV *sv);
678# else
679I32 cur_val(IV iv, SV *sv);
680#endif
681
682/*
683 * Handler for the magic variables $main::curwin and $main::curbuf.
684 * The handler is put into the magic vtbl for these variables.
685 * (This is effectively a C-level equivalent of a tied variable).
686 * There is no "set" function as the variables are read-only.
687 */
688# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
689I32 cur_val(pTHX_ IV iv, SV *sv)
690# else
691I32 cur_val(IV iv, SV *sv)
692# endif
693{
694 SV *rv;
695 if (iv == 0)
696 rv = newWINrv(newSV(0), curwin);
697 else
698 rv = newBUFrv(newSV(0), curbuf);
699 sv_setsv(sv, rv);
700 return 0;
701}
702#endif /* !PROTO */
703
704struct ufuncs cw_funcs = { cur_val, 0, 0 };
705struct ufuncs cb_funcs = { cur_val, 0, 1 };
706
707/*
708 * VIM_init(): Vim-specific initialisation.
709 * Make the magical main::curwin and main::curbuf variables
710 */
711 static void
712VIM_init()
713{
714 static char cw[] = "main::curwin";
715 static char cb[] = "main::curbuf";
716 SV *sv;
717
718 sv = perl_get_sv(cw, TRUE);
719 sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
720 SvREADONLY_on(sv);
721
722 sv = perl_get_sv(cb, TRUE);
723 sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
724 SvREADONLY_on(sv);
725
726 /*
727 * Setup the Safe compartment.
728 * It shouldn't be a fatal error if the Safe module is missing.
729 * XXX: Only shares the 'Msg' routine (which has to be called
730 * like 'Msg(...)').
731 */
732 (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
733
734}
735
736#ifdef DYNAMIC_PERL
737static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
738#endif
739
740/*
741 * ":perl"
742 */
743 void
744ex_perl(eap)
745 exarg_T *eap;
746{
747 char *err;
748 char *script;
749 STRLEN length;
750 SV *sv;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200751#ifdef HAVE_SANDBOX
Bram Moolenaar071d4272004-06-13 20:20:40 +0000752 SV *safe;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200753#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000754
755 script = (char *)script_get(eap, eap->arg);
756 if (eap->skip)
757 {
758 vim_free(script);
759 return;
760 }
761
762 if (perl_interp == NULL)
763 {
764#ifdef DYNAMIC_PERL
765 if (!perl_enabled(TRUE))
766 {
767 EMSG(_(e_noperl));
768 vim_free(script);
769 return;
770 }
771#endif
772 perl_init();
773 }
774
775 {
776 dSP;
777 ENTER;
778 SAVETMPS;
779
780 if (script == NULL)
781 sv = newSVpv((char *)eap->arg, 0);
782 else
783 {
784 sv = newSVpv(script, 0);
785 vim_free(script);
786 }
787
788#ifdef HAVE_SANDBOX
789 if (sandbox)
790 {
Bram Moolenaara1711622011-07-27 14:15:46 +0200791 safe = perl_get_sv("VIM::safe", FALSE);
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000792# ifndef MAKE_TEST /* avoid a warning for unreachable code */
Bram Moolenaar954e8c52009-11-11 13:45:33 +0000793 if (safe == NULL || !SvTRUE(safe))
Bram Moolenaar071d4272004-06-13 20:20:40 +0000794 EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
795 else
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000796# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000797 {
798 PUSHMARK(SP);
799 XPUSHs(safe);
800 XPUSHs(sv);
801 PUTBACK;
802 perl_call_method("reval", G_DISCARD);
803 }
804 }
805 else
806#endif
807 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
808
809 SvREFCNT_dec(sv);
810
Bram Moolenaarc271c482012-08-08 13:17:31 +0200811#ifdef AVOID_PL_ERRGV
812 err = SvPV(perl_get_sv("@", GV_ADD), length);
813#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000814 err = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200815#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000816
817 FREETMPS;
818 LEAVE;
819
820 if (!length)
821 return;
822
823 msg_split((char_u *)err, highlight_attr[HLF_E]);
824 return;
825 }
826}
827
828 static int
829replace_line(line, end)
830 linenr_T *line, *end;
831{
832 char *str;
833
834 if (SvOK(GvSV(PL_defgv)))
835 {
836 str = SvPV(GvSV(PL_defgv), PL_na);
837 ml_replace(*line, (char_u *)str, 1);
838 changed_bytes(*line, 0);
839 }
840 else
841 {
842 ml_delete(*line, FALSE);
843 deleted_lines_mark(*line, 1L);
844 --(*end);
845 --(*line);
846 }
847 return OK;
848}
849
850/*
851 * ":perldo".
852 */
853 void
854ex_perldo(eap)
855 exarg_T *eap;
856{
857 STRLEN length;
858 SV *sv;
859 char *str;
860 linenr_T i;
861
862 if (bufempty())
863 return;
864
865 if (perl_interp == NULL)
866 {
867#ifdef DYNAMIC_PERL
868 if (!perl_enabled(TRUE))
869 {
870 EMSG(_(e_noperl));
871 return;
872 }
873#endif
874 perl_init();
875 }
876 {
877 dSP;
878 length = strlen((char *)eap->arg);
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000879 sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
880 sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000881 sv_catpvn(sv, (char *)eap->arg, length);
882 sv_catpvn(sv, "}", 1);
883 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
884 SvREFCNT_dec(sv);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200885#ifdef AVOID_PL_ERRGV
886 str = SvPV(perl_get_sv("@", GV_ADD), length);
887#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000888 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200889#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000890 if (length)
891 goto err;
892
893 if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
894 return;
895
896 ENTER;
897 SAVETMPS;
898 for (i = eap->line1; i <= eap->line2; i++)
899 {
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000900 sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000901 PUSHMARK(sp);
902 perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200903#ifdef AVOID_PL_ERRGV
904 str = SvPV(perl_get_sv("@", GV_ADD), length);
905#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000906 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200907#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000908 if (length)
909 break;
910 SPAGAIN;
911 if (SvTRUEx(POPs))
912 {
913 if (replace_line(&i, &eap->line2) != OK)
914 {
915 PUTBACK;
916 break;
917 }
918 }
919 PUTBACK;
920 }
921 FREETMPS;
922 LEAVE;
923 check_cursor();
924 update_screen(NOT_VALID);
925 if (!length)
926 return;
927
928err:
929 msg_split((char_u *)str, highlight_attr[HLF_E]);
930 return;
931 }
932}
933
Bram Moolenaar01dd60c2008-07-24 14:24:48 +0000934#ifndef FEAT_WINDOWS
935int win_valid(win_T *w) { return TRUE; }
936int win_count() { return 1; }
937win_T *win_find_nr(int n) { return curwin; }
938#endif
939
Bram Moolenaar071d4272004-06-13 20:20:40 +0000940XS(boot_VIM);
941
942 static void
943xs_init(pTHX)
944{
945 char *file = __FILE__;
946
947 /* DynaLoader is a special case */
948 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
949 newXS("VIM::bootstrap", boot_VIM, file);
950}
951
952typedef win_T * VIWIN;
953typedef buf_T * VIBUF;
954
955MODULE = VIM PACKAGE = VIM
956
957void
958Msg(text, hl=NULL)
959 char *text;
960 char *hl;
961
962 PREINIT:
963 int attr;
964 int id;
965
966 PPCODE:
967 if (text != NULL)
968 {
969 attr = 0;
970 if (hl != NULL)
971 {
972 id = syn_name2id((char_u *)hl);
973 if (id != 0)
974 attr = syn_id2attr(id);
975 }
976 msg_split((char_u *)text, attr);
977 }
978
979void
980SetOption(line)
981 char *line;
982
983 PPCODE:
984 if (line != NULL)
985 do_set((char_u *)line, 0);
986 update_screen(NOT_VALID);
987
988void
989DoCommand(line)
990 char *line;
991
992 PPCODE:
993 if (line != NULL)
994 do_cmdline_cmd((char_u *)line);
995
996void
997Eval(str)
998 char *str;
999
1000 PREINIT:
1001 char_u *value;
1002 PPCODE:
Bram Moolenaar362e1a32006-03-06 23:29:24 +00001003 value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001004 if (value == NULL)
1005 {
1006 XPUSHs(sv_2mortal(newSViv(0)));
1007 XPUSHs(sv_2mortal(newSVpv("", 0)));
1008 }
1009 else
1010 {
1011 XPUSHs(sv_2mortal(newSViv(1)));
1012 XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
1013 vim_free(value);
1014 }
1015
1016void
1017Buffers(...)
1018
1019 PREINIT:
1020 buf_T *vimbuf;
1021 int i, b;
1022
1023 PPCODE:
1024 if (items == 0)
1025 {
1026 if (GIMME == G_SCALAR)
1027 {
1028 i = 0;
1029 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1030 ++i;
1031
1032 XPUSHs(sv_2mortal(newSViv(i)));
1033 }
1034 else
1035 {
1036 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1037 XPUSHs(newBUFrv(newSV(0), vimbuf));
1038 }
1039 }
1040 else
1041 {
1042 for (i = 0; i < items; i++)
1043 {
1044 SV *sv = ST(i);
1045 if (SvIOK(sv))
1046 b = SvIV(ST(i));
1047 else
1048 {
1049 char_u *pat;
1050 STRLEN len;
1051
1052 pat = (char_u *)SvPV(sv, len);
1053 ++emsg_off;
1054 b = buflist_findpat(pat, pat+len, FALSE, FALSE);
1055 --emsg_off;
1056 }
1057
1058 if (b >= 0)
1059 {
1060 vimbuf = buflist_findnr(b);
1061 if (vimbuf)
1062 XPUSHs(newBUFrv(newSV(0), vimbuf));
1063 }
1064 }
1065 }
1066
1067void
1068Windows(...)
1069
1070 PREINIT:
1071 win_T *vimwin;
1072 int i, w;
1073
1074 PPCODE:
1075 if (items == 0)
1076 {
1077 if (GIMME == G_SCALAR)
1078 XPUSHs(sv_2mortal(newSViv(win_count())));
1079 else
1080 {
1081 for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1082 XPUSHs(newWINrv(newSV(0), vimwin));
1083 }
1084 }
1085 else
1086 {
1087 for (i = 0; i < items; i++)
1088 {
1089 w = SvIV(ST(i));
1090 vimwin = win_find_nr(w);
1091 if (vimwin)
1092 XPUSHs(newWINrv(newSV(0), vimwin));
1093 }
1094 }
1095
1096MODULE = VIM PACKAGE = VIWIN
1097
1098void
1099DESTROY(win)
1100 VIWIN win
1101
1102 CODE:
1103 if (win_valid(win))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001104 win->w_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001105
1106SV *
1107Buffer(win)
1108 VIWIN win
1109
1110 CODE:
1111 if (!win_valid(win))
1112 win = curwin;
1113 RETVAL = newBUFrv(newSV(0), win->w_buffer);
1114 OUTPUT:
1115 RETVAL
1116
1117void
1118SetHeight(win, height)
1119 VIWIN win
1120 int height;
1121
1122 PREINIT:
1123 win_T *savewin;
1124
1125 PPCODE:
1126 if (!win_valid(win))
1127 win = curwin;
1128 savewin = curwin;
1129 curwin = win;
1130 win_setheight(height);
1131 curwin = savewin;
1132
1133void
1134Cursor(win, ...)
1135 VIWIN win
1136
1137 PPCODE:
Bram Moolenaara1711622011-07-27 14:15:46 +02001138 if (items == 1)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001139 {
1140 EXTEND(sp, 2);
1141 if (!win_valid(win))
1142 win = curwin;
1143 PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1144 PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1145 }
Bram Moolenaara1711622011-07-27 14:15:46 +02001146 else if (items == 3)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001147 {
1148 int lnum, col;
1149
1150 if (!win_valid(win))
1151 win = curwin;
1152 lnum = SvIV(ST(1));
1153 col = SvIV(ST(2));
1154 win->w_cursor.lnum = lnum;
1155 win->w_cursor.col = col;
1156 check_cursor(); /* put cursor on an existing line */
1157 update_screen(NOT_VALID);
1158 }
1159
1160MODULE = VIM PACKAGE = VIBUF
1161
1162void
1163DESTROY(vimbuf)
1164 VIBUF vimbuf;
1165
1166 CODE:
1167 if (buf_valid(vimbuf))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001168 vimbuf->b_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001169
1170void
1171Name(vimbuf)
1172 VIBUF vimbuf;
1173
1174 PPCODE:
1175 if (!buf_valid(vimbuf))
1176 vimbuf = curbuf;
1177 /* No file name returns an empty string */
1178 if (vimbuf->b_fname == NULL)
1179 XPUSHs(sv_2mortal(newSVpv("", 0)));
1180 else
1181 XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1182
1183void
1184Number(vimbuf)
1185 VIBUF vimbuf;
1186
1187 PPCODE:
1188 if (!buf_valid(vimbuf))
1189 vimbuf = curbuf;
1190 XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1191
1192void
1193Count(vimbuf)
1194 VIBUF vimbuf;
1195
1196 PPCODE:
1197 if (!buf_valid(vimbuf))
1198 vimbuf = curbuf;
1199 XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1200
1201void
1202Get(vimbuf, ...)
1203 VIBUF vimbuf;
1204
1205 PREINIT:
1206 char_u *line;
1207 int i;
1208 long lnum;
1209 PPCODE:
1210 if (buf_valid(vimbuf))
1211 {
1212 for (i = 1; i < items; i++)
1213 {
1214 lnum = SvIV(ST(i));
1215 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1216 {
1217 line = ml_get_buf(vimbuf, lnum, FALSE);
1218 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1219 }
1220 }
1221 }
1222
1223void
1224Set(vimbuf, ...)
1225 VIBUF vimbuf;
1226
1227 PREINIT:
1228 int i;
1229 long lnum;
1230 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001231 PPCODE:
1232 if (buf_valid(vimbuf))
1233 {
1234 if (items < 3)
1235 croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1236
1237 lnum = SvIV(ST(1));
1238 for(i = 2; i < items; i++, lnum++)
1239 {
1240 line = SvPV(ST(i),PL_na);
1241 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1242 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001243 aco_save_T aco;
1244
1245 /* set curwin/curbuf for "vimbuf" and save some things */
1246 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001247
Bram Moolenaar071d4272004-06-13 20:20:40 +00001248 if (u_savesub(lnum) == OK)
1249 {
1250 ml_replace(lnum, (char_u *)line, TRUE);
1251 changed_bytes(lnum, 0);
1252 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001253
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001254 /* restore curwin/curbuf and a few other things */
1255 aucmd_restbuf(&aco);
1256 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaar071d4272004-06-13 20:20:40 +00001257 }
1258 }
1259 }
1260
1261void
1262Delete(vimbuf, ...)
1263 VIBUF vimbuf;
1264
1265 PREINIT:
1266 long i, lnum = 0, count = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001267 PPCODE:
1268 if (buf_valid(vimbuf))
1269 {
1270 if (items == 2)
1271 {
1272 lnum = SvIV(ST(1));
1273 count = 1;
1274 }
1275 else if (items == 3)
1276 {
1277 lnum = SvIV(ST(1));
1278 count = 1 + SvIV(ST(2)) - lnum;
Bram Moolenaara1711622011-07-27 14:15:46 +02001279 if (count == 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001280 count = 1;
Bram Moolenaara1711622011-07-27 14:15:46 +02001281 if (count < 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001282 {
1283 lnum -= count;
1284 count = -count;
1285 }
1286 }
1287 if (items >= 2)
1288 {
1289 for (i = 0; i < count; i++)
1290 {
1291 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1292 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001293 aco_save_T aco;
1294
1295 /* set curwin/curbuf for "vimbuf" and save some things */
1296 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001297
Bram Moolenaar071d4272004-06-13 20:20:40 +00001298 if (u_savedel(lnum, 1) == OK)
1299 {
1300 ml_delete(lnum, 0);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00001301 check_cursor();
Bram Moolenaar071d4272004-06-13 20:20:40 +00001302 deleted_lines_mark(lnum, 1L);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001303 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001304
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001305 /* restore curwin/curbuf and a few other things */
1306 aucmd_restbuf(&aco);
1307 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001308
Bram Moolenaar071d4272004-06-13 20:20:40 +00001309 update_curbuf(VALID);
1310 }
1311 }
1312 }
1313 }
1314
1315void
1316Append(vimbuf, ...)
1317 VIBUF vimbuf;
1318
1319 PREINIT:
1320 int i;
1321 long lnum;
1322 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001323 PPCODE:
1324 if (buf_valid(vimbuf))
1325 {
1326 if (items < 3)
1327 croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1328
1329 lnum = SvIV(ST(1));
1330 for (i = 2; i < items; i++, lnum++)
1331 {
1332 line = SvPV(ST(i),PL_na);
1333 if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1334 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001335 aco_save_T aco;
1336
1337 /* set curwin/curbuf for "vimbuf" and save some things */
1338 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001339
Bram Moolenaar071d4272004-06-13 20:20:40 +00001340 if (u_inssub(lnum + 1) == OK)
1341 {
1342 ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1343 appended_lines_mark(lnum, 1L);
1344 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001345
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001346 /* restore curwin/curbuf and a few other things */
1347 aucmd_restbuf(&aco);
1348 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001349
Bram Moolenaar071d4272004-06-13 20:20:40 +00001350 update_curbuf(VALID);
1351 }
1352 }
1353 }
1354