blob: 118f60487100f181a7623d6cba5fbb28e72670f7 [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 Moolenaar9be6e212013-06-15 16:47:35 +020070#if (PERL_REVISION == 5) && (PERL_VERSION >= 18)
71# define PERL5180_OR_LATER
72#endif
73
Bram Moolenaar071d4272004-06-13 20:20:40 +000074#ifndef pTHX
75# define pTHX void
76# define pTHX_
77#endif
78
79#ifndef EXTERN_C
80# define EXTERN_C
81#endif
82
Bram Moolenaarc271c482012-08-08 13:17:31 +020083#if (PERL_REVISION == 5) && (PERL_VERSION >= 14) && defined(_MSC_VER)
84/* Using PL_errgv to get the error message after perl_eval_sv() causes a crash
85 * with MSVC and Perl version 5.14. */
86# define AVOID_PL_ERRGV
87#endif
88
Bram Moolenaar071d4272004-06-13 20:20:40 +000089/* Compatibility hacks over */
90
91static PerlInterpreter *perl_interp = NULL;
92static void xs_init __ARGS((pTHX));
93static void VIM_init __ARGS((void));
94EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
95
96/*
Bram Moolenaare06c1882010-07-21 22:05:20 +020097 * For dynamic linked perl.
Bram Moolenaar071d4272004-06-13 20:20:40 +000098 */
99#if defined(DYNAMIC_PERL) || defined(PROTO)
Bram Moolenaare06c1882010-07-21 22:05:20 +0200100
101#ifndef DYNAMIC_PERL /* just generating prototypes */
Bram Moolenaar766fb0d2010-07-22 11:34:16 +0200102#ifdef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +0200103typedef int HANDLE;
104#endif
105typedef int XSINIT_t;
106typedef int XSUBADDR_t;
107typedef int perl_key;
108#endif
109
Bram Moolenaar766fb0d2010-07-22 11:34:16 +0200110#ifndef WIN3264
Bram Moolenaare06c1882010-07-21 22:05:20 +0200111#include <dlfcn.h>
112#define HANDLE void*
113#define PERL_PROC void*
114#define load_dll(n) dlopen((n), RTLD_LAZY|RTLD_GLOBAL)
115#define symbol_from_dll dlsym
116#define close_dll dlclose
117#else
118#define PERL_PROC FARPROC
Bram Moolenaarebbcb822010-10-23 14:02:54 +0200119#define load_dll vimLoadLib
Bram Moolenaare06c1882010-07-21 22:05:20 +0200120#define symbol_from_dll GetProcAddress
121#define close_dll FreeLibrary
122#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000123/*
124 * Wrapper defines
125 */
126# define perl_alloc dll_perl_alloc
127# define perl_construct dll_perl_construct
128# define perl_parse dll_perl_parse
129# define perl_run dll_perl_run
130# define perl_destruct dll_perl_destruct
131# define perl_free dll_perl_free
132# define Perl_get_context dll_Perl_get_context
133# define Perl_croak dll_Perl_croak
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200134# ifndef PERL5180_OR_LATER
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100135# ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100136# define Perl_croak_xs_usage dll_Perl_croak_xs_usage
137# endif
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200138# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000139# ifndef PROTO
140# define Perl_croak_nocontext dll_Perl_croak_nocontext
141# define Perl_call_argv dll_Perl_call_argv
142# define Perl_call_pv dll_Perl_call_pv
143# define Perl_eval_sv dll_Perl_eval_sv
144# define Perl_get_sv dll_Perl_get_sv
145# define Perl_eval_pv dll_Perl_eval_pv
146# define Perl_call_method dll_Perl_call_method
147# endif
148# define Perl_dowantarray dll_Perl_dowantarray
149# define Perl_free_tmps dll_Perl_free_tmps
150# define Perl_gv_stashpv dll_Perl_gv_stashpv
151# define Perl_markstack_grow dll_Perl_markstack_grow
152# define Perl_mg_find dll_Perl_mg_find
153# define Perl_newXS dll_Perl_newXS
154# define Perl_newSV dll_Perl_newSV
155# define Perl_newSViv dll_Perl_newSViv
156# define Perl_newSVpv dll_Perl_newSVpv
157# define Perl_pop_scope dll_Perl_pop_scope
158# define Perl_push_scope dll_Perl_push_scope
159# define Perl_save_int dll_Perl_save_int
160# define Perl_stack_grow dll_Perl_stack_grow
161# define Perl_set_context dll_Perl_set_context
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200162# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
163# define Perl_sv_2bool_flags dll_Perl_sv_2bool_flags
Bram Moolenaar01c10522012-09-21 12:50:51 +0200164# define Perl_xs_apiversion_bootcheck dll_Perl_xs_apiversion_bootcheck
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200165# else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000166# define Perl_sv_2bool dll_Perl_sv_2bool
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200167# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000168# define Perl_sv_2iv dll_Perl_sv_2iv
169# define Perl_sv_2mortal dll_Perl_sv_2mortal
170# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
171# define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
172# define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
173# else
174# define Perl_sv_2pv dll_Perl_sv_2pv
175# endif
176# define Perl_sv_bless dll_Perl_sv_bless
177# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
178# define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
179# else
180# define Perl_sv_catpvn dll_Perl_sv_catpvn
181# endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000182#ifdef PERL589_OR_LATER
183# define Perl_sv_2iv_flags dll_Perl_sv_2iv_flags
184# define Perl_newXS_flags dll_Perl_newXS_flags
185#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000186# define Perl_sv_free dll_Perl_sv_free
Bram Moolenaarccf22172008-09-01 15:56:45 +0000187# if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
188# define Perl_sv_free2 dll_Perl_sv_free2
189# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000190# define Perl_sv_isa dll_Perl_sv_isa
191# define Perl_sv_magic dll_Perl_sv_magic
192# define Perl_sv_setiv dll_Perl_sv_setiv
193# define Perl_sv_setpv dll_Perl_sv_setpv
194# define Perl_sv_setpvn dll_Perl_sv_setpvn
195# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
196# define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
197# else
198# define Perl_sv_setsv dll_Perl_sv_setsv
199# endif
200# define Perl_sv_upgrade dll_Perl_sv_upgrade
201# define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
202# define Perl_Top_ptr dll_Perl_Top_ptr
203# define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
204# define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
205# define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
206# define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
207# define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
208# define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
209# define Perl_TSv_ptr dll_Perl_TSv_ptr
210# define Perl_TXpv_ptr dll_Perl_TXpv_ptr
211# define Perl_Tna_ptr dll_Perl_Tna_ptr
212# define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
213# define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
214# define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
215# define boot_DynaLoader dll_boot_DynaLoader
Bram Moolenaare06c1882010-07-21 22:05:20 +0200216# define Perl_Gthr_key_ptr dll_Perl_Gthr_key_ptr
Bram Moolenaar071d4272004-06-13 20:20:40 +0000217
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000218# define Perl_sys_init dll_Perl_sys_init
Bram Moolenaarc236c162008-07-13 17:41:49 +0000219# define Perl_sys_term dll_Perl_sys_term
220# define Perl_ISv_ptr dll_Perl_ISv_ptr
221# define Perl_Istack_max_ptr dll_Perl_Istack_max_ptr
222# define Perl_Istack_base_ptr dll_Perl_Istack_base_ptr
223# define Perl_Itmps_ix_ptr dll_Perl_Itmps_ix_ptr
224# define Perl_Itmps_floor_ptr dll_Perl_Itmps_floor_ptr
225# define Perl_IXpv_ptr dll_Perl_IXpv_ptr
226# define Perl_Ina_ptr dll_Perl_Ina_ptr
227# define Perl_Imarkstack_ptr_ptr dll_Perl_Imarkstack_ptr_ptr
228# define Perl_Imarkstack_max_ptr dll_Perl_Imarkstack_max_ptr
229# define Perl_Istack_sp_ptr dll_Perl_Istack_sp_ptr
230# define Perl_Iop_ptr dll_Perl_Iop_ptr
231# define Perl_call_list dll_Perl_call_list
232# define Perl_Iscopestack_ix_ptr dll_Perl_Iscopestack_ix_ptr
233# define Perl_Iunitcheckav_ptr dll_Perl_Iunitcheckav_ptr
Bram Moolenaar01c10522012-09-21 12:50:51 +0200234# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
235# define PL_thr_key *dll_PL_thr_key
236# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000237
Bram Moolenaar071d4272004-06-13 20:20:40 +0000238/*
239 * Declare HANDLE for perl.dll and function pointers.
240 */
241static HANDLE hPerlLib = NULL;
242
243static PerlInterpreter* (*perl_alloc)();
244static void (*perl_construct)(PerlInterpreter*);
245static void (*perl_destruct)(PerlInterpreter*);
246static void (*perl_free)(PerlInterpreter*);
247static int (*perl_run)(PerlInterpreter*);
248static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
249static void* (*Perl_get_context)(void);
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000250static void (*Perl_croak)(pTHX_ const char*, ...);
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200251#ifndef PERL5180_OR_LATER
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100252#ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100253static void (*Perl_croak_xs_usage)(pTHX_ const CV *const, const char *const params);
254#endif
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200255#endif
Bram Moolenaara7ecc562006-08-16 16:17:39 +0000256static void (*Perl_croak_nocontext)(const char*, ...);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000257static I32 (*Perl_dowantarray)(pTHX);
258static void (*Perl_free_tmps)(pTHX);
259static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
260static void (*Perl_markstack_grow)(pTHX);
261static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
262static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
263static SV* (*Perl_newSV)(pTHX_ STRLEN);
264static SV* (*Perl_newSViv)(pTHX_ IV);
265static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
266static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
267static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
268static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
269static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
270static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
271static SV* (*Perl_call_method)(pTHX_ const char*, I32);
272static void (*Perl_pop_scope)(pTHX);
273static void (*Perl_push_scope)(pTHX);
274static void (*Perl_save_int)(pTHX_ int*);
275static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
276static SV** (*Perl_set_context)(void*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200277#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
278static bool (*Perl_sv_2bool_flags)(pTHX_ SV*, I32);
279static void (*Perl_xs_apiversion_bootcheck)(pTHX_ SV *module, const char *api_p, STRLEN api_len);
280#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000281static bool (*Perl_sv_2bool)(pTHX_ SV*);
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200282#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000283static IV (*Perl_sv_2iv)(pTHX_ SV*);
284static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
285#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
286static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
287static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
288#else
289static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
290#endif
291static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
292#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
293static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
294#else
295static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
296#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000297#ifdef PERL589_OR_LATER
298static IV (*Perl_sv_2iv_flags)(pTHX_ SV* sv, I32 flags);
299static CV * (*Perl_newXS_flags)(pTHX_ const char *name, XSUBADDR_t subaddr, const char *const filename, const char *const proto, U32 flags);
300#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000301static void (*Perl_sv_free)(pTHX_ SV*);
302static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
303static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
304static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
305static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
306static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
307#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
308static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
309#else
310static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
311#endif
312static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200313#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000314static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
315static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
316static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
317static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
318static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
319static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
320static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
321static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
322static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
323static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
324static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200325#else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000326static void (*Perl_sv_free2)(pTHX_ SV*);
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000327static void (*Perl_sys_init)(int* argc, char*** argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000328static void (*Perl_sys_term)(void);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200329static void (*Perl_call_list)(pTHX_ I32, AV*);
330# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
331# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000332static SV** (*Perl_ISv_ptr)(register PerlInterpreter*);
333static SV*** (*Perl_Istack_max_ptr)(register PerlInterpreter*);
334static SV*** (*Perl_Istack_base_ptr)(register PerlInterpreter*);
335static XPV** (*Perl_IXpv_ptr)(register PerlInterpreter*);
336static I32* (*Perl_Itmps_ix_ptr)(register PerlInterpreter*);
337static I32* (*Perl_Itmps_floor_ptr)(register PerlInterpreter*);
338static STRLEN* (*Perl_Ina_ptr)(register PerlInterpreter*);
339static I32** (*Perl_Imarkstack_ptr_ptr)(register PerlInterpreter*);
340static I32** (*Perl_Imarkstack_max_ptr)(register PerlInterpreter*);
341static SV*** (*Perl_Istack_sp_ptr)(register PerlInterpreter*);
342static OP** (*Perl_Iop_ptr)(register PerlInterpreter*);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000343static I32* (*Perl_Iscopestack_ix_ptr)(register PerlInterpreter*);
344static AV** (*Perl_Iunitcheckav_ptr)(register PerlInterpreter*);
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200345# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000346#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000347
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200348#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
Bram Moolenaar01c10522012-09-21 12:50:51 +0200349static perl_key* dll_PL_thr_key;
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200350#else
Bram Moolenaare06c1882010-07-21 22:05:20 +0200351static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
352static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
353static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
Bram Moolenaare06c1882010-07-21 22:05:20 +0200354static perl_key* (*Perl_Gthr_key_ptr)_((pTHX));
Bram Moolenaarf5fe79a2012-09-21 12:42:44 +0200355#endif
356static void (*boot_DynaLoader)_((pTHX_ CV*));
Bram Moolenaare06c1882010-07-21 22:05:20 +0200357
Bram Moolenaar071d4272004-06-13 20:20:40 +0000358/*
359 * Table of name to function pointer of perl.
360 */
Bram Moolenaar071d4272004-06-13 20:20:40 +0000361static struct {
362 char* name;
363 PERL_PROC* ptr;
364} perl_funcname_table[] = {
365 {"perl_alloc", (PERL_PROC*)&perl_alloc},
366 {"perl_construct", (PERL_PROC*)&perl_construct},
367 {"perl_destruct", (PERL_PROC*)&perl_destruct},
368 {"perl_free", (PERL_PROC*)&perl_free},
369 {"perl_run", (PERL_PROC*)&perl_run},
370 {"perl_parse", (PERL_PROC*)&perl_parse},
371 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
372 {"Perl_croak", (PERL_PROC*)&Perl_croak},
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200373#ifndef PERL5180_OR_LATER
Bram Moolenaar58cb0892010-03-02 15:14:33 +0100374#ifdef PERL5101_OR_LATER
Bram Moolenaar3a0573a2010-02-17 16:40:58 +0100375 {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
376#endif
Bram Moolenaar9be6e212013-06-15 16:47:35 +0200377#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000378 {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
379 {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
380 {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
381 {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
382 {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
383 {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
384 {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
385 {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
386 {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
387 {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
388 {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
389 {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
390 {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
391 {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
392 {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
393 {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
394 {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
395 {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
396 {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
397 {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
398 {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200399#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
400 {"Perl_sv_2bool_flags", (PERL_PROC*)&Perl_sv_2bool_flags},
401 {"Perl_xs_apiversion_bootcheck",(PERL_PROC*)&Perl_xs_apiversion_bootcheck},
402#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000403 {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200404#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000405 {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
406 {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
407#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
408 {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
409 {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
410#else
411 {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
412#endif
Bram Moolenaar700d1d72007-09-13 13:20:16 +0000413#ifdef PERL589_OR_LATER
414 {"Perl_sv_2iv_flags", (PERL_PROC*)&Perl_sv_2iv_flags},
415 {"Perl_newXS_flags", (PERL_PROC*)&Perl_newXS_flags},
416#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000417 {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
418#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
419 {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
420#else
421 {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
422#endif
423 {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
424 {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
425 {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
426 {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
427 {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
428 {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
429#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
430 {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
431#else
432 {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
433#endif
434 {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000435#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000436 {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
437 {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
438 {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
439 {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
440 {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
441 {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
442 {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
443 {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
444 {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
445 {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
446 {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000447#else
Bram Moolenaarccf22172008-09-01 15:56:45 +0000448 {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000449 {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000450 {"Perl_sys_term", (PERL_PROC*)&Perl_sys_term},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200451 {"Perl_call_list", (PERL_PROC*)&Perl_call_list},
452# if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
453# else
Bram Moolenaarc236c162008-07-13 17:41:49 +0000454 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000455 {"Perl_Istack_max_ptr", (PERL_PROC*)&Perl_Istack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200456 {"Perl_Istack_base_ptr", (PERL_PROC*)&Perl_Istack_base_ptr},
457 {"Perl_IXpv_ptr", (PERL_PROC*)&Perl_IXpv_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000458 {"Perl_Itmps_ix_ptr", (PERL_PROC*)&Perl_Itmps_ix_ptr},
459 {"Perl_Itmps_floor_ptr", (PERL_PROC*)&Perl_Itmps_floor_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200460 {"Perl_Ina_ptr", (PERL_PROC*)&Perl_Ina_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000461 {"Perl_Imarkstack_ptr_ptr", (PERL_PROC*)&Perl_Imarkstack_ptr_ptr},
462 {"Perl_Imarkstack_max_ptr", (PERL_PROC*)&Perl_Imarkstack_max_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200463 {"Perl_Istack_sp_ptr", (PERL_PROC*)&Perl_Istack_sp_ptr},
464 {"Perl_Iop_ptr", (PERL_PROC*)&Perl_Iop_ptr},
Bram Moolenaarc236c162008-07-13 17:41:49 +0000465 {"Perl_Iscopestack_ix_ptr", (PERL_PROC*)&Perl_Iscopestack_ix_ptr},
466 {"Perl_Iunitcheckav_ptr", (PERL_PROC*)&Perl_Iunitcheckav_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200467# endif
Bram Moolenaarc236c162008-07-13 17:41:49 +0000468#endif
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200469#if (PERL_REVISION == 5) && (PERL_VERSION >= 14)
Bram Moolenaar01c10522012-09-21 12:50:51 +0200470 {"PL_thr_key", (PERL_PROC*)&dll_PL_thr_key},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200471#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000472 {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
473 {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
474 {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
Bram Moolenaare06c1882010-07-21 22:05:20 +0200475 {"Perl_Gthr_key_ptr", (PERL_PROC*)&Perl_Gthr_key_ptr},
Bram Moolenaar6dfff542011-09-07 18:47:23 +0200476#endif
477 {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
Bram Moolenaar071d4272004-06-13 20:20:40 +0000478 {"", NULL},
479};
480
481/*
482 * Make all runtime-links of perl.
483 *
484 * 1. Get module handle using LoadLibraryEx.
485 * 2. Get pointer to perl function by GetProcAddress.
486 * 3. Repeat 2, until get all functions will be used.
487 *
488 * Parameter 'libname' provides name of DLL.
489 * Return OK or FAIL.
490 */
491 static int
492perl_runtime_link_init(char *libname, int verbose)
493{
494 int i;
495
496 if (hPerlLib != NULL)
497 return OK;
Bram Moolenaare06c1882010-07-21 22:05:20 +0200498 if ((hPerlLib = load_dll(libname)) == NULL)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000499 {
500 if (verbose)
501 EMSG2(_("E370: Could not load library %s"), libname);
502 return FAIL;
503 }
504 for (i = 0; perl_funcname_table[i].ptr; ++i)
505 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200506 if (!(*perl_funcname_table[i].ptr = symbol_from_dll(hPerlLib,
Bram Moolenaar071d4272004-06-13 20:20:40 +0000507 perl_funcname_table[i].name)))
508 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200509 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000510 hPerlLib = NULL;
511 if (verbose)
512 EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
513 return FAIL;
514 }
515 }
516 return OK;
517}
518
519/*
520 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
521 * There were no DLL loaded, return FALSE.
522 */
523 int
524perl_enabled(verbose)
525 int verbose;
526{
527 return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
528}
529#endif /* DYNAMIC_PERL */
530
531/*
532 * perl_init(): initialize perl interpreter
533 * We have to call perl_parse to initialize some structures,
534 * there's nothing to actually parse.
535 */
536 static void
537perl_init()
538{
Bram Moolenaarc236c162008-07-13 17:41:49 +0000539 char *bootargs[] = { "VI", NULL };
540 int argc = 3;
541 static char *argv[] = { "", "-e", "" };
Bram Moolenaar071d4272004-06-13 20:20:40 +0000542
Bram Moolenaarc236c162008-07-13 17:41:49 +0000543#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
Bram Moolenaar4eac38f2008-12-03 12:18:55 +0000544 Perl_sys_init(&argc, (char***)&argv);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000545#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000546 perl_interp = perl_alloc();
547 perl_construct(perl_interp);
Bram Moolenaarc236c162008-07-13 17:41:49 +0000548 perl_parse(perl_interp, xs_init, argc, argv, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000549 perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
550 VIM_init();
551#ifdef USE_SFIO
552 sfdisc(PerlIO_stdout(), sfdcnewvim());
553 sfdisc(PerlIO_stderr(), sfdcnewvim());
554 sfsetbuf(PerlIO_stdout(), NULL, 0);
555 sfsetbuf(PerlIO_stderr(), NULL, 0);
556#endif
557}
558
559/*
560 * perl_end(): clean up after ourselves
561 */
562 void
563perl_end()
564{
565 if (perl_interp)
566 {
567 perl_run(perl_interp);
568 perl_destruct(perl_interp);
569 perl_free(perl_interp);
570 perl_interp = NULL;
Bram Moolenaarc236c162008-07-13 17:41:49 +0000571#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
572 Perl_sys_term();
573#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000574 }
575#ifdef DYNAMIC_PERL
576 if (hPerlLib)
577 {
Bram Moolenaare06c1882010-07-21 22:05:20 +0200578 close_dll(hPerlLib);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000579 hPerlLib = NULL;
580 }
581#endif
582}
583
584/*
585 * msg_split(): send a message to the message handling routines
586 * split at '\n' first though.
587 */
588 void
589msg_split(s, attr)
590 char_u *s;
591 int attr; /* highlighting attributes */
592{
593 char *next;
594 char *token = (char *)s;
595
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000596 while ((next = strchr(token, '\n')) && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000597 {
598 *next++ = '\0'; /* replace \n with \0 */
599 msg_attr((char_u *)token, attr);
600 token = next;
601 }
Bram Moolenaaraa8494a2007-10-09 08:47:27 +0000602 if (*token && !got_int)
Bram Moolenaar071d4272004-06-13 20:20:40 +0000603 msg_attr((char_u *)token, attr);
604}
605
606#ifndef FEAT_EVAL
607/*
608 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
609 * work properly.
610 */
611 char_u *
Bram Moolenaar362e1a32006-03-06 23:29:24 +0000612eval_to_string(arg, nextcmd, dolist)
Bram Moolenaarfeeaa682013-02-14 22:19:51 +0100613 char_u *arg UNUSED;
614 char_u **nextcmd UNUSED;
615 int dolist UNUSED;
Bram Moolenaar071d4272004-06-13 20:20:40 +0000616{
617 return NULL;
618}
619#endif
620
621/*
622 * Create a new reference to an SV pointing to the SCR structure
Bram Moolenaare344bea2005-09-01 20:46:49 +0000623 * The b_perl_private/w_perl_private part of the SCR structure points to the
624 * SV, so there can only be one such SV for a particular SCR structure. When
625 * the last reference has gone (DESTROY is called),
626 * b_perl_private/w_perl_private is reset; When the screen goes away before
Bram Moolenaar071d4272004-06-13 20:20:40 +0000627 * all references are gone, the value of the SV is reset;
628 * any subsequent use of any of those reference will produce
629 * a warning. (see typemap)
630 */
Bram Moolenaare344bea2005-09-01 20:46:49 +0000631
632 static SV *
633newWINrv(rv, ptr)
634 SV *rv;
635 win_T *ptr;
636{
637 sv_upgrade(rv, SVt_RV);
638 if (ptr->w_perl_private == NULL)
639 {
640 ptr->w_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100641 sv_setiv(ptr->w_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000642 }
643 else
644 SvREFCNT_inc(ptr->w_perl_private);
645 SvRV(rv) = ptr->w_perl_private;
646 SvROK_on(rv);
647 return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000648}
649
Bram Moolenaare344bea2005-09-01 20:46:49 +0000650 static SV *
651newBUFrv(rv, ptr)
652 SV *rv;
653 buf_T *ptr;
654{
655 sv_upgrade(rv, SVt_RV);
656 if (ptr->b_perl_private == NULL)
657 {
658 ptr->b_perl_private = newSV(0);
Bram Moolenaarbe747342012-02-12 00:31:52 +0100659 sv_setiv(ptr->b_perl_private, PTR2IV(ptr));
Bram Moolenaare344bea2005-09-01 20:46:49 +0000660 }
661 else
662 SvREFCNT_inc(ptr->b_perl_private);
663 SvRV(rv) = ptr->b_perl_private;
664 SvROK_on(rv);
665 return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
666}
Bram Moolenaar071d4272004-06-13 20:20:40 +0000667
668/*
669 * perl_win_free
Bram Moolenaar84a05ac2013-05-06 04:24:17 +0200670 * Remove all references to the window to be destroyed
Bram Moolenaar071d4272004-06-13 20:20:40 +0000671 */
672 void
673perl_win_free(wp)
674 win_T *wp;
675{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000676 if (wp->w_perl_private)
677 sv_setiv((SV *)wp->w_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000678 return;
679}
680
681 void
682perl_buf_free(bp)
683 buf_T *bp;
684{
Bram Moolenaare344bea2005-09-01 20:46:49 +0000685 if (bp->b_perl_private)
686 sv_setiv((SV *)bp->b_perl_private, 0);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000687 return;
688}
689
690#ifndef PROTO
691# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
692I32 cur_val(pTHX_ IV iv, SV *sv);
693# else
694I32 cur_val(IV iv, SV *sv);
695#endif
696
697/*
698 * Handler for the magic variables $main::curwin and $main::curbuf.
699 * The handler is put into the magic vtbl for these variables.
700 * (This is effectively a C-level equivalent of a tied variable).
701 * There is no "set" function as the variables are read-only.
702 */
703# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
704I32 cur_val(pTHX_ IV iv, SV *sv)
705# else
706I32 cur_val(IV iv, SV *sv)
707# endif
708{
709 SV *rv;
710 if (iv == 0)
711 rv = newWINrv(newSV(0), curwin);
712 else
713 rv = newBUFrv(newSV(0), curbuf);
714 sv_setsv(sv, rv);
715 return 0;
716}
717#endif /* !PROTO */
718
719struct ufuncs cw_funcs = { cur_val, 0, 0 };
720struct ufuncs cb_funcs = { cur_val, 0, 1 };
721
722/*
723 * VIM_init(): Vim-specific initialisation.
724 * Make the magical main::curwin and main::curbuf variables
725 */
726 static void
727VIM_init()
728{
729 static char cw[] = "main::curwin";
730 static char cb[] = "main::curbuf";
731 SV *sv;
732
733 sv = perl_get_sv(cw, TRUE);
734 sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
735 SvREADONLY_on(sv);
736
737 sv = perl_get_sv(cb, TRUE);
738 sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
739 SvREADONLY_on(sv);
740
741 /*
742 * Setup the Safe compartment.
743 * It shouldn't be a fatal error if the Safe module is missing.
744 * XXX: Only shares the 'Msg' routine (which has to be called
745 * like 'Msg(...)').
746 */
747 (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
748
749}
750
751#ifdef DYNAMIC_PERL
752static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
753#endif
754
755/*
756 * ":perl"
757 */
758 void
759ex_perl(eap)
760 exarg_T *eap;
761{
762 char *err;
763 char *script;
764 STRLEN length;
765 SV *sv;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200766#ifdef HAVE_SANDBOX
Bram Moolenaar071d4272004-06-13 20:20:40 +0000767 SV *safe;
Bram Moolenaar9d6650f2010-06-06 23:04:47 +0200768#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000769
770 script = (char *)script_get(eap, eap->arg);
771 if (eap->skip)
772 {
773 vim_free(script);
774 return;
775 }
776
777 if (perl_interp == NULL)
778 {
779#ifdef DYNAMIC_PERL
780 if (!perl_enabled(TRUE))
781 {
782 EMSG(_(e_noperl));
783 vim_free(script);
784 return;
785 }
786#endif
787 perl_init();
788 }
789
790 {
791 dSP;
792 ENTER;
793 SAVETMPS;
794
795 if (script == NULL)
796 sv = newSVpv((char *)eap->arg, 0);
797 else
798 {
799 sv = newSVpv(script, 0);
800 vim_free(script);
801 }
802
803#ifdef HAVE_SANDBOX
804 if (sandbox)
805 {
Bram Moolenaara1711622011-07-27 14:15:46 +0200806 safe = perl_get_sv("VIM::safe", FALSE);
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000807# ifndef MAKE_TEST /* avoid a warning for unreachable code */
Bram Moolenaar954e8c52009-11-11 13:45:33 +0000808 if (safe == NULL || !SvTRUE(safe))
Bram Moolenaar071d4272004-06-13 20:20:40 +0000809 EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
810 else
Bram Moolenaar3f947ea2009-07-14 14:04:54 +0000811# endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000812 {
813 PUSHMARK(SP);
814 XPUSHs(safe);
815 XPUSHs(sv);
816 PUTBACK;
817 perl_call_method("reval", G_DISCARD);
818 }
819 }
820 else
821#endif
822 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
823
824 SvREFCNT_dec(sv);
825
Bram Moolenaarc271c482012-08-08 13:17:31 +0200826#ifdef AVOID_PL_ERRGV
827 err = SvPV(perl_get_sv("@", GV_ADD), length);
828#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000829 err = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200830#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000831
832 FREETMPS;
833 LEAVE;
834
835 if (!length)
836 return;
837
838 msg_split((char_u *)err, highlight_attr[HLF_E]);
839 return;
840 }
841}
842
843 static int
844replace_line(line, end)
845 linenr_T *line, *end;
846{
847 char *str;
848
849 if (SvOK(GvSV(PL_defgv)))
850 {
851 str = SvPV(GvSV(PL_defgv), PL_na);
852 ml_replace(*line, (char_u *)str, 1);
853 changed_bytes(*line, 0);
854 }
855 else
856 {
857 ml_delete(*line, FALSE);
858 deleted_lines_mark(*line, 1L);
859 --(*end);
860 --(*line);
861 }
862 return OK;
863}
864
865/*
866 * ":perldo".
867 */
868 void
869ex_perldo(eap)
870 exarg_T *eap;
871{
872 STRLEN length;
873 SV *sv;
874 char *str;
875 linenr_T i;
876
877 if (bufempty())
878 return;
879
880 if (perl_interp == NULL)
881 {
882#ifdef DYNAMIC_PERL
883 if (!perl_enabled(TRUE))
884 {
885 EMSG(_(e_noperl));
886 return;
887 }
888#endif
889 perl_init();
890 }
891 {
892 dSP;
893 length = strlen((char *)eap->arg);
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000894 sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
895 sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
Bram Moolenaar071d4272004-06-13 20:20:40 +0000896 sv_catpvn(sv, (char *)eap->arg, length);
897 sv_catpvn(sv, "}", 1);
898 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
899 SvREFCNT_dec(sv);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200900#ifdef AVOID_PL_ERRGV
901 str = SvPV(perl_get_sv("@", GV_ADD), length);
902#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000903 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200904#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000905 if (length)
906 goto err;
907
908 if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
909 return;
910
911 ENTER;
912 SAVETMPS;
913 for (i = eap->line1; i <= eap->line2; i++)
914 {
Bram Moolenaar9d75c832005-01-25 21:57:23 +0000915 sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +0000916 PUSHMARK(sp);
917 perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200918#ifdef AVOID_PL_ERRGV
919 str = SvPV(perl_get_sv("@", GV_ADD), length);
920#else
Bram Moolenaar071d4272004-06-13 20:20:40 +0000921 str = SvPV(GvSV(PL_errgv), length);
Bram Moolenaarc271c482012-08-08 13:17:31 +0200922#endif
Bram Moolenaar071d4272004-06-13 20:20:40 +0000923 if (length)
924 break;
925 SPAGAIN;
926 if (SvTRUEx(POPs))
927 {
928 if (replace_line(&i, &eap->line2) != OK)
929 {
930 PUTBACK;
931 break;
932 }
933 }
934 PUTBACK;
935 }
936 FREETMPS;
937 LEAVE;
938 check_cursor();
939 update_screen(NOT_VALID);
940 if (!length)
941 return;
942
943err:
944 msg_split((char_u *)str, highlight_attr[HLF_E]);
945 return;
946 }
947}
948
Bram Moolenaar01dd60c2008-07-24 14:24:48 +0000949#ifndef FEAT_WINDOWS
950int win_valid(win_T *w) { return TRUE; }
951int win_count() { return 1; }
952win_T *win_find_nr(int n) { return curwin; }
953#endif
954
Bram Moolenaar071d4272004-06-13 20:20:40 +0000955XS(boot_VIM);
956
957 static void
958xs_init(pTHX)
959{
960 char *file = __FILE__;
961
962 /* DynaLoader is a special case */
963 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
964 newXS("VIM::bootstrap", boot_VIM, file);
965}
966
967typedef win_T * VIWIN;
968typedef buf_T * VIBUF;
969
970MODULE = VIM PACKAGE = VIM
971
972void
973Msg(text, hl=NULL)
974 char *text;
975 char *hl;
976
977 PREINIT:
978 int attr;
979 int id;
980
981 PPCODE:
982 if (text != NULL)
983 {
984 attr = 0;
985 if (hl != NULL)
986 {
987 id = syn_name2id((char_u *)hl);
988 if (id != 0)
989 attr = syn_id2attr(id);
990 }
991 msg_split((char_u *)text, attr);
992 }
993
994void
995SetOption(line)
996 char *line;
997
998 PPCODE:
999 if (line != NULL)
1000 do_set((char_u *)line, 0);
1001 update_screen(NOT_VALID);
1002
1003void
1004DoCommand(line)
1005 char *line;
1006
1007 PPCODE:
1008 if (line != NULL)
1009 do_cmdline_cmd((char_u *)line);
1010
1011void
1012Eval(str)
1013 char *str;
1014
1015 PREINIT:
1016 char_u *value;
1017 PPCODE:
Bram Moolenaar362e1a32006-03-06 23:29:24 +00001018 value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001019 if (value == NULL)
1020 {
1021 XPUSHs(sv_2mortal(newSViv(0)));
1022 XPUSHs(sv_2mortal(newSVpv("", 0)));
1023 }
1024 else
1025 {
1026 XPUSHs(sv_2mortal(newSViv(1)));
1027 XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
1028 vim_free(value);
1029 }
1030
1031void
1032Buffers(...)
1033
1034 PREINIT:
1035 buf_T *vimbuf;
1036 int i, b;
1037
1038 PPCODE:
1039 if (items == 0)
1040 {
1041 if (GIMME == G_SCALAR)
1042 {
1043 i = 0;
1044 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1045 ++i;
1046
1047 XPUSHs(sv_2mortal(newSViv(i)));
1048 }
1049 else
1050 {
1051 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1052 XPUSHs(newBUFrv(newSV(0), vimbuf));
1053 }
1054 }
1055 else
1056 {
1057 for (i = 0; i < items; i++)
1058 {
1059 SV *sv = ST(i);
1060 if (SvIOK(sv))
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001061 b = (int) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001062 else
1063 {
1064 char_u *pat;
1065 STRLEN len;
1066
1067 pat = (char_u *)SvPV(sv, len);
1068 ++emsg_off;
Bram Moolenaar0c279bb2013-03-19 14:25:54 +01001069 b = buflist_findpat(pat, pat+len, FALSE, FALSE, FALSE);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001070 --emsg_off;
1071 }
1072
1073 if (b >= 0)
1074 {
1075 vimbuf = buflist_findnr(b);
1076 if (vimbuf)
1077 XPUSHs(newBUFrv(newSV(0), vimbuf));
1078 }
1079 }
1080 }
1081
1082void
1083Windows(...)
1084
1085 PREINIT:
1086 win_T *vimwin;
1087 int i, w;
1088
1089 PPCODE:
1090 if (items == 0)
1091 {
1092 if (GIMME == G_SCALAR)
1093 XPUSHs(sv_2mortal(newSViv(win_count())));
1094 else
1095 {
1096 for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1097 XPUSHs(newWINrv(newSV(0), vimwin));
1098 }
1099 }
1100 else
1101 {
1102 for (i = 0; i < items; i++)
1103 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001104 w = (int) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001105 vimwin = win_find_nr(w);
1106 if (vimwin)
1107 XPUSHs(newWINrv(newSV(0), vimwin));
1108 }
1109 }
1110
1111MODULE = VIM PACKAGE = VIWIN
1112
1113void
1114DESTROY(win)
1115 VIWIN win
1116
1117 CODE:
1118 if (win_valid(win))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001119 win->w_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001120
1121SV *
1122Buffer(win)
1123 VIWIN win
1124
1125 CODE:
1126 if (!win_valid(win))
1127 win = curwin;
1128 RETVAL = newBUFrv(newSV(0), win->w_buffer);
1129 OUTPUT:
1130 RETVAL
1131
1132void
1133SetHeight(win, height)
1134 VIWIN win
1135 int height;
1136
1137 PREINIT:
1138 win_T *savewin;
1139
1140 PPCODE:
1141 if (!win_valid(win))
1142 win = curwin;
1143 savewin = curwin;
1144 curwin = win;
1145 win_setheight(height);
1146 curwin = savewin;
1147
1148void
1149Cursor(win, ...)
1150 VIWIN win
1151
1152 PPCODE:
Bram Moolenaara1711622011-07-27 14:15:46 +02001153 if (items == 1)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001154 {
1155 EXTEND(sp, 2);
1156 if (!win_valid(win))
1157 win = curwin;
1158 PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1159 PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1160 }
Bram Moolenaara1711622011-07-27 14:15:46 +02001161 else if (items == 3)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001162 {
1163 int lnum, col;
1164
1165 if (!win_valid(win))
1166 win = curwin;
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001167 lnum = (int) SvIV(ST(1));
1168 col = (int) SvIV(ST(2));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001169 win->w_cursor.lnum = lnum;
1170 win->w_cursor.col = col;
1171 check_cursor(); /* put cursor on an existing line */
1172 update_screen(NOT_VALID);
1173 }
1174
1175MODULE = VIM PACKAGE = VIBUF
1176
1177void
1178DESTROY(vimbuf)
1179 VIBUF vimbuf;
1180
1181 CODE:
1182 if (buf_valid(vimbuf))
Bram Moolenaare344bea2005-09-01 20:46:49 +00001183 vimbuf->b_perl_private = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001184
1185void
1186Name(vimbuf)
1187 VIBUF vimbuf;
1188
1189 PPCODE:
1190 if (!buf_valid(vimbuf))
1191 vimbuf = curbuf;
1192 /* No file name returns an empty string */
1193 if (vimbuf->b_fname == NULL)
1194 XPUSHs(sv_2mortal(newSVpv("", 0)));
1195 else
1196 XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1197
1198void
1199Number(vimbuf)
1200 VIBUF vimbuf;
1201
1202 PPCODE:
1203 if (!buf_valid(vimbuf))
1204 vimbuf = curbuf;
1205 XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1206
1207void
1208Count(vimbuf)
1209 VIBUF vimbuf;
1210
1211 PPCODE:
1212 if (!buf_valid(vimbuf))
1213 vimbuf = curbuf;
1214 XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1215
1216void
1217Get(vimbuf, ...)
1218 VIBUF vimbuf;
1219
1220 PREINIT:
1221 char_u *line;
1222 int i;
1223 long lnum;
1224 PPCODE:
1225 if (buf_valid(vimbuf))
1226 {
1227 for (i = 1; i < items; i++)
1228 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001229 lnum = (long) SvIV(ST(i));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001230 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1231 {
1232 line = ml_get_buf(vimbuf, lnum, FALSE);
1233 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1234 }
1235 }
1236 }
1237
1238void
1239Set(vimbuf, ...)
1240 VIBUF vimbuf;
1241
1242 PREINIT:
1243 int i;
1244 long lnum;
1245 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001246 PPCODE:
1247 if (buf_valid(vimbuf))
1248 {
1249 if (items < 3)
1250 croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1251
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001252 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001253 for(i = 2; i < items; i++, lnum++)
1254 {
1255 line = SvPV(ST(i),PL_na);
1256 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1257 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001258 aco_save_T aco;
1259
1260 /* set curwin/curbuf for "vimbuf" and save some things */
1261 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001262
Bram Moolenaar071d4272004-06-13 20:20:40 +00001263 if (u_savesub(lnum) == OK)
1264 {
1265 ml_replace(lnum, (char_u *)line, TRUE);
1266 changed_bytes(lnum, 0);
1267 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001268
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001269 /* restore curwin/curbuf and a few other things */
1270 aucmd_restbuf(&aco);
1271 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaar071d4272004-06-13 20:20:40 +00001272 }
1273 }
1274 }
1275
1276void
1277Delete(vimbuf, ...)
1278 VIBUF vimbuf;
1279
1280 PREINIT:
1281 long i, lnum = 0, count = 0;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001282 PPCODE:
1283 if (buf_valid(vimbuf))
1284 {
1285 if (items == 2)
1286 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001287 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001288 count = 1;
1289 }
1290 else if (items == 3)
1291 {
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001292 lnum = (long) SvIV(ST(1));
1293 count = (long) 1 + SvIV(ST(2)) - lnum;
Bram Moolenaara1711622011-07-27 14:15:46 +02001294 if (count == 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001295 count = 1;
Bram Moolenaara1711622011-07-27 14:15:46 +02001296 if (count < 0)
Bram Moolenaar071d4272004-06-13 20:20:40 +00001297 {
1298 lnum -= count;
1299 count = -count;
1300 }
1301 }
1302 if (items >= 2)
1303 {
1304 for (i = 0; i < count; i++)
1305 {
1306 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1307 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001308 aco_save_T aco;
1309
1310 /* set curwin/curbuf for "vimbuf" and save some things */
1311 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001312
Bram Moolenaar071d4272004-06-13 20:20:40 +00001313 if (u_savedel(lnum, 1) == OK)
1314 {
1315 ml_delete(lnum, 0);
Bram Moolenaarcdcaa582009-07-09 18:06:49 +00001316 check_cursor();
Bram Moolenaar071d4272004-06-13 20:20:40 +00001317 deleted_lines_mark(lnum, 1L);
Bram Moolenaar071d4272004-06-13 20:20:40 +00001318 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001319
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001320 /* restore curwin/curbuf and a few other things */
1321 aucmd_restbuf(&aco);
1322 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001323
Bram Moolenaar071d4272004-06-13 20:20:40 +00001324 update_curbuf(VALID);
1325 }
1326 }
1327 }
1328 }
1329
1330void
1331Append(vimbuf, ...)
1332 VIBUF vimbuf;
1333
1334 PREINIT:
1335 int i;
1336 long lnum;
1337 char *line;
Bram Moolenaar071d4272004-06-13 20:20:40 +00001338 PPCODE:
1339 if (buf_valid(vimbuf))
1340 {
1341 if (items < 3)
1342 croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1343
Bram Moolenaare9d47cd2013-02-06 19:58:43 +01001344 lnum = (long) SvIV(ST(1));
Bram Moolenaar071d4272004-06-13 20:20:40 +00001345 for (i = 2; i < items; i++, lnum++)
1346 {
1347 line = SvPV(ST(i),PL_na);
1348 if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1349 {
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001350 aco_save_T aco;
1351
1352 /* set curwin/curbuf for "vimbuf" and save some things */
1353 aucmd_prepbuf(&aco, vimbuf);
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001354
Bram Moolenaar071d4272004-06-13 20:20:40 +00001355 if (u_inssub(lnum + 1) == OK)
1356 {
1357 ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1358 appended_lines_mark(lnum, 1L);
1359 }
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001360
Bram Moolenaar334a3bf2006-08-08 14:45:44 +00001361 /* restore curwin/curbuf and a few other things */
1362 aucmd_restbuf(&aco);
1363 /* Careful: autocommands may have made "vimbuf" invalid! */
Bram Moolenaarf30e74c2006-08-16 17:35:00 +00001364
Bram Moolenaar071d4272004-06-13 20:20:40 +00001365 update_curbuf(VALID);
1366 }
1367 }
1368 }
1369