1 /* vi:set ts=8 sts=4 sw=4:
3 * VIM - Vi IMproved by Bram Moolenaar
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.
9 * if_perl.xs: Main code for Perl interface support.
10 * Mostly written by Sven Verdoolaege.
13 #define _memory_h /* avoid memset redeclaration */
14 #define IN_PERL_FILE /* don't include if_perl.pro from proto.h */
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.
27 # include "proto/if_perl.pro"
28 # include "proto/if_perlsfio.pro"
32 /* Perl compatibility stuff. This should ensure compatibility with older
37 # include <patchlevel.h>
38 # define PERL_REVISION 5
39 # define PERL_VERSION PATCHLEVEL
40 # define PERL_SUBVERSION SUBVERSION
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.
48 * The changes include addition of two symbols (Perl_sv_2iv_flags,
49 * Perl_newXS_flags) not present in earlier releases.
51 * Jan Dubois suggested the following guarding scheme.
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.
56 #if (PERL_REVISION == 5) && (PERL_VERSION == 8) && (PERL_SUBVERSION >= 8)
57 # if (ACTIVEPERL_VERSION >= 822) || (PERL_SUBVERSION >= 9)
58 # define PERL589_OR_LATER
61 #if (PERL_REVISION == 5) && (PERL_VERSION >= 9)
62 # define PERL589_OR_LATER
65 #if (PERL_REVISION == 5) && ((PERL_VERSION > 10) || \
66 (PERL_VERSION == 10) && (PERL_SUBVERSION >= 1))
67 # define PERL5101_OR_LATER
79 /* Compatibility hacks over */
81 static PerlInterpreter *perl_interp = NULL;
82 static void xs_init __ARGS((pTHX));
83 static void VIM_init __ARGS((void));
84 EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
87 * For dynamic linked perl. (Windows)
89 #if defined(DYNAMIC_PERL) || defined(PROTO)
93 # define perl_alloc dll_perl_alloc
94 # define perl_construct dll_perl_construct
95 # define perl_parse dll_perl_parse
96 # define perl_run dll_perl_run
97 # define perl_destruct dll_perl_destruct
98 # define perl_free dll_perl_free
99 # define Perl_get_context dll_Perl_get_context
100 # define Perl_croak dll_Perl_croak
101 # ifdef PERL5101_OR_LATER
102 # define Perl_croak_xs_usage dll_Perl_croak_xs_usage
105 # define Perl_croak_nocontext dll_Perl_croak_nocontext
106 # define Perl_call_argv dll_Perl_call_argv
107 # define Perl_call_pv dll_Perl_call_pv
108 # define Perl_eval_sv dll_Perl_eval_sv
109 # define Perl_get_sv dll_Perl_get_sv
110 # define Perl_eval_pv dll_Perl_eval_pv
111 # define Perl_call_method dll_Perl_call_method
113 # define Perl_dowantarray dll_Perl_dowantarray
114 # define Perl_free_tmps dll_Perl_free_tmps
115 # define Perl_gv_stashpv dll_Perl_gv_stashpv
116 # define Perl_markstack_grow dll_Perl_markstack_grow
117 # define Perl_mg_find dll_Perl_mg_find
118 # define Perl_newXS dll_Perl_newXS
119 # define Perl_newSV dll_Perl_newSV
120 # define Perl_newSViv dll_Perl_newSViv
121 # define Perl_newSVpv dll_Perl_newSVpv
122 # define Perl_pop_scope dll_Perl_pop_scope
123 # define Perl_push_scope dll_Perl_push_scope
124 # define Perl_save_int dll_Perl_save_int
125 # define Perl_stack_grow dll_Perl_stack_grow
126 # define Perl_set_context dll_Perl_set_context
127 # define Perl_sv_2bool dll_Perl_sv_2bool
128 # define Perl_sv_2iv dll_Perl_sv_2iv
129 # define Perl_sv_2mortal dll_Perl_sv_2mortal
130 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
131 # define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
132 # define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
134 # define Perl_sv_2pv dll_Perl_sv_2pv
136 # define Perl_sv_bless dll_Perl_sv_bless
137 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
138 # define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
140 # define Perl_sv_catpvn dll_Perl_sv_catpvn
142 #ifdef PERL589_OR_LATER
143 # define Perl_sv_2iv_flags dll_Perl_sv_2iv_flags
144 # define Perl_newXS_flags dll_Perl_newXS_flags
146 # define Perl_sv_free dll_Perl_sv_free
147 # if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
148 # define Perl_sv_free2 dll_Perl_sv_free2
150 # define Perl_sv_isa dll_Perl_sv_isa
151 # define Perl_sv_magic dll_Perl_sv_magic
152 # define Perl_sv_setiv dll_Perl_sv_setiv
153 # define Perl_sv_setpv dll_Perl_sv_setpv
154 # define Perl_sv_setpvn dll_Perl_sv_setpvn
155 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
156 # define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
158 # define Perl_sv_setsv dll_Perl_sv_setsv
160 # define Perl_sv_upgrade dll_Perl_sv_upgrade
161 # define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
162 # define Perl_Top_ptr dll_Perl_Top_ptr
163 # define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
164 # define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
165 # define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
166 # define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
167 # define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
168 # define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
169 # define Perl_TSv_ptr dll_Perl_TSv_ptr
170 # define Perl_TXpv_ptr dll_Perl_TXpv_ptr
171 # define Perl_Tna_ptr dll_Perl_Tna_ptr
172 # define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
173 # define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
174 # define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
175 # define boot_DynaLoader dll_boot_DynaLoader
177 # define Perl_sys_init dll_Perl_sys_init
178 # define Perl_sys_term dll_Perl_sys_term
179 # define Perl_ISv_ptr dll_Perl_ISv_ptr
180 # define Perl_Istack_max_ptr dll_Perl_Istack_max_ptr
181 # define Perl_Istack_base_ptr dll_Perl_Istack_base_ptr
182 # define Perl_Itmps_ix_ptr dll_Perl_Itmps_ix_ptr
183 # define Perl_Itmps_floor_ptr dll_Perl_Itmps_floor_ptr
184 # define Perl_IXpv_ptr dll_Perl_IXpv_ptr
185 # define Perl_Ina_ptr dll_Perl_Ina_ptr
186 # define Perl_Imarkstack_ptr_ptr dll_Perl_Imarkstack_ptr_ptr
187 # define Perl_Imarkstack_max_ptr dll_Perl_Imarkstack_max_ptr
188 # define Perl_Istack_sp_ptr dll_Perl_Istack_sp_ptr
189 # define Perl_Iop_ptr dll_Perl_Iop_ptr
190 # define Perl_call_list dll_Perl_call_list
191 # define Perl_Iscopestack_ix_ptr dll_Perl_Iscopestack_ix_ptr
192 # define Perl_Iunitcheckav_ptr dll_Perl_Iunitcheckav_ptr
194 #ifndef DYNAMIC_PERL /* just generating prototypes */
196 typedef int XSINIT_t;
197 typedef int XSUBADDR_t;
201 * Declare HANDLE for perl.dll and function pointers.
203 static HANDLE hPerlLib = NULL;
205 static PerlInterpreter* (*perl_alloc)();
206 static void (*perl_construct)(PerlInterpreter*);
207 static void (*perl_destruct)(PerlInterpreter*);
208 static void (*perl_free)(PerlInterpreter*);
209 static int (*perl_run)(PerlInterpreter*);
210 static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
211 static void* (*Perl_get_context)(void);
212 static void (*Perl_croak)(pTHX_ const char*, ...);
213 #ifdef PERL5101_OR_LATER
214 static void (*Perl_croak_xs_usage)(pTHX_ const CV *const, const char *const params);
216 static void (*Perl_croak_nocontext)(const char*, ...);
217 static I32 (*Perl_dowantarray)(pTHX);
218 static void (*Perl_free_tmps)(pTHX);
219 static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
220 static void (*Perl_markstack_grow)(pTHX);
221 static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
222 static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
223 static SV* (*Perl_newSV)(pTHX_ STRLEN);
224 static SV* (*Perl_newSViv)(pTHX_ IV);
225 static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
226 static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
227 static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
228 static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
229 static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
230 static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
231 static SV* (*Perl_call_method)(pTHX_ const char*, I32);
232 static void (*Perl_pop_scope)(pTHX);
233 static void (*Perl_push_scope)(pTHX);
234 static void (*Perl_save_int)(pTHX_ int*);
235 static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
236 static SV** (*Perl_set_context)(void*);
237 static bool (*Perl_sv_2bool)(pTHX_ SV*);
238 static IV (*Perl_sv_2iv)(pTHX_ SV*);
239 static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
240 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
241 static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
242 static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
244 static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
246 static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
247 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
248 static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
250 static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
252 #ifdef PERL589_OR_LATER
253 static IV (*Perl_sv_2iv_flags)(pTHX_ SV* sv, I32 flags);
254 static CV * (*Perl_newXS_flags)(pTHX_ const char *name, XSUBADDR_t subaddr, const char *const filename, const char *const proto, U32 flags);
256 static void (*Perl_sv_free)(pTHX_ SV*);
257 static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
258 static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
259 static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
260 static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
261 static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
262 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
263 static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
265 static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
267 static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
268 static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
269 static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
270 static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
271 static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
272 static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
273 static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
274 static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
275 static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
276 static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
277 static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
278 static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
279 static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
280 static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
281 static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
282 static void (*boot_DynaLoader)_((pTHX_ CV*));
284 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
285 static void (*Perl_sv_free2)(pTHX_ SV*);
286 static void (*Perl_sys_init)(int* argc, char*** argv);
287 static void (*Perl_sys_term)(void);
288 static SV** (*Perl_ISv_ptr)(register PerlInterpreter*);
289 static SV*** (*Perl_Istack_max_ptr)(register PerlInterpreter*);
290 static SV*** (*Perl_Istack_base_ptr)(register PerlInterpreter*);
291 static XPV** (*Perl_IXpv_ptr)(register PerlInterpreter*);
292 static I32* (*Perl_Itmps_ix_ptr)(register PerlInterpreter*);
293 static I32* (*Perl_Itmps_floor_ptr)(register PerlInterpreter*);
294 static STRLEN* (*Perl_Ina_ptr)(register PerlInterpreter*);
295 static I32** (*Perl_Imarkstack_ptr_ptr)(register PerlInterpreter*);
296 static I32** (*Perl_Imarkstack_max_ptr)(register PerlInterpreter*);
297 static SV*** (*Perl_Istack_sp_ptr)(register PerlInterpreter*);
298 static OP** (*Perl_Iop_ptr)(register PerlInterpreter*);
299 static void (*Perl_call_list)(pTHX_ I32, AV*);
300 static I32* (*Perl_Iscopestack_ix_ptr)(register PerlInterpreter*);
301 static AV** (*Perl_Iunitcheckav_ptr)(register PerlInterpreter*);
305 * Table of name to function pointer of perl.
307 #define PERL_PROC FARPROC
311 } perl_funcname_table[] = {
312 {"perl_alloc", (PERL_PROC*)&perl_alloc},
313 {"perl_construct", (PERL_PROC*)&perl_construct},
314 {"perl_destruct", (PERL_PROC*)&perl_destruct},
315 {"perl_free", (PERL_PROC*)&perl_free},
316 {"perl_run", (PERL_PROC*)&perl_run},
317 {"perl_parse", (PERL_PROC*)&perl_parse},
318 {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
319 {"Perl_croak", (PERL_PROC*)&Perl_croak},
320 #ifdef PERL5101_OR_LATER
321 {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
323 {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
324 {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
325 {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
326 {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
327 {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
328 {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
329 {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
330 {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
331 {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
332 {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
333 {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
334 {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
335 {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
336 {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
337 {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
338 {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
339 {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
340 {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
341 {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
342 {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
343 {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
344 {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
345 {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
346 {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
347 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
348 {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
349 {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
351 {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
353 #ifdef PERL589_OR_LATER
354 {"Perl_sv_2iv_flags", (PERL_PROC*)&Perl_sv_2iv_flags},
355 {"Perl_newXS_flags", (PERL_PROC*)&Perl_newXS_flags},
357 {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
358 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
359 {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
361 {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
363 {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
364 {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
365 {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
366 {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
367 {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
368 {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
369 #if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
370 {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
372 {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
374 {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
375 #if (PERL_REVISION == 5) && (PERL_VERSION < 10)
376 {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
377 {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
378 {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
379 {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
380 {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
381 {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
382 {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
383 {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
384 {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
385 {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
386 {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
388 {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
389 {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
390 {"Perl_sys_term", (PERL_PROC*)&Perl_sys_term},
391 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
392 {"Perl_Istack_sp_ptr", (PERL_PROC*)&Perl_Istack_sp_ptr},
393 {"Perl_Iop_ptr", (PERL_PROC*)&Perl_Iop_ptr},
394 {"Perl_Istack_base_ptr", (PERL_PROC*)&Perl_Istack_base_ptr},
395 {"Perl_Istack_max_ptr", (PERL_PROC*)&Perl_Istack_max_ptr},
396 {"Perl_Itmps_ix_ptr", (PERL_PROC*)&Perl_Itmps_ix_ptr},
397 {"Perl_Itmps_floor_ptr", (PERL_PROC*)&Perl_Itmps_floor_ptr},
398 {"Perl_Imarkstack_ptr_ptr", (PERL_PROC*)&Perl_Imarkstack_ptr_ptr},
399 {"Perl_Imarkstack_max_ptr", (PERL_PROC*)&Perl_Imarkstack_max_ptr},
400 {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
401 {"Perl_IXpv_ptr", (PERL_PROC*)&Perl_IXpv_ptr},
402 {"Perl_Ina_ptr", (PERL_PROC*)&Perl_Ina_ptr},
403 {"Perl_call_list", (PERL_PROC*)&Perl_call_list},
404 {"Perl_Iscopestack_ix_ptr", (PERL_PROC*)&Perl_Iscopestack_ix_ptr},
405 {"Perl_Iunitcheckav_ptr", (PERL_PROC*)&Perl_Iunitcheckav_ptr},
407 {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
408 {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
409 {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
410 {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
415 * Make all runtime-links of perl.
417 * 1. Get module handle using LoadLibraryEx.
418 * 2. Get pointer to perl function by GetProcAddress.
419 * 3. Repeat 2, until get all functions will be used.
421 * Parameter 'libname' provides name of DLL.
425 perl_runtime_link_init(char *libname, int verbose)
429 if (hPerlLib != NULL)
431 if (!(hPerlLib = LoadLibraryEx(libname, NULL, 0)))
434 EMSG2(_("E370: Could not load library %s"), libname);
437 for (i = 0; perl_funcname_table[i].ptr; ++i)
439 if (!(*perl_funcname_table[i].ptr = GetProcAddress(hPerlLib,
440 perl_funcname_table[i].name)))
442 FreeLibrary(hPerlLib);
445 EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
453 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
454 * There were no DLL loaded, return FALSE.
457 perl_enabled(verbose)
460 return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
462 #endif /* DYNAMIC_PERL */
465 * perl_init(): initialize perl interpreter
466 * We have to call perl_parse to initialize some structures,
467 * there's nothing to actually parse.
472 char *bootargs[] = { "VI", NULL };
474 static char *argv[] = { "", "-e", "" };
476 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
477 Perl_sys_init(&argc, (char***)&argv);
479 perl_interp = perl_alloc();
480 perl_construct(perl_interp);
481 perl_parse(perl_interp, xs_init, argc, argv, 0);
482 perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
485 sfdisc(PerlIO_stdout(), sfdcnewvim());
486 sfdisc(PerlIO_stderr(), sfdcnewvim());
487 sfsetbuf(PerlIO_stdout(), NULL, 0);
488 sfsetbuf(PerlIO_stderr(), NULL, 0);
493 * perl_end(): clean up after ourselves
500 perl_run(perl_interp);
501 perl_destruct(perl_interp);
502 perl_free(perl_interp);
504 #if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
511 FreeLibrary(hPerlLib);
518 * msg_split(): send a message to the message handling routines
519 * split at '\n' first though.
524 int attr; /* highlighting attributes */
527 char *token = (char *)s;
529 while ((next = strchr(token, '\n')) && !got_int)
531 *next++ = '\0'; /* replace \n with \0 */
532 msg_attr((char_u *)token, attr);
535 if (*token && !got_int)
536 msg_attr((char_u *)token, attr);
541 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
545 eval_to_string(arg, nextcmd, dolist)
555 * Create a new reference to an SV pointing to the SCR structure
556 * The b_perl_private/w_perl_private part of the SCR structure points to the
557 * SV, so there can only be one such SV for a particular SCR structure. When
558 * the last reference has gone (DESTROY is called),
559 * b_perl_private/w_perl_private is reset; When the screen goes away before
560 * all references are gone, the value of the SV is reset;
561 * any subsequent use of any of those reference will produce
562 * a warning. (see typemap)
570 sv_upgrade(rv, SVt_RV);
571 if (ptr->w_perl_private == NULL)
573 ptr->w_perl_private = newSV(0);
574 sv_setiv(ptr->w_perl_private, (IV)ptr);
577 SvREFCNT_inc(ptr->w_perl_private);
578 SvRV(rv) = ptr->w_perl_private;
580 return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
588 sv_upgrade(rv, SVt_RV);
589 if (ptr->b_perl_private == NULL)
591 ptr->b_perl_private = newSV(0);
592 sv_setiv(ptr->b_perl_private, (IV)ptr);
595 SvREFCNT_inc(ptr->b_perl_private);
596 SvRV(rv) = ptr->b_perl_private;
598 return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
603 * Remove all refences to the window to be destroyed
609 if (wp->w_perl_private)
610 sv_setiv((SV *)wp->w_perl_private, 0);
618 if (bp->b_perl_private)
619 sv_setiv((SV *)bp->b_perl_private, 0);
624 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
625 I32 cur_val(pTHX_ IV iv, SV *sv);
627 I32 cur_val(IV iv, SV *sv);
631 * Handler for the magic variables $main::curwin and $main::curbuf.
632 * The handler is put into the magic vtbl for these variables.
633 * (This is effectively a C-level equivalent of a tied variable).
634 * There is no "set" function as the variables are read-only.
636 # if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
637 I32 cur_val(pTHX_ IV iv, SV *sv)
639 I32 cur_val(IV iv, SV *sv)
644 rv = newWINrv(newSV(0), curwin);
646 rv = newBUFrv(newSV(0), curbuf);
652 struct ufuncs cw_funcs = { cur_val, 0, 0 };
653 struct ufuncs cb_funcs = { cur_val, 0, 1 };
656 * VIM_init(): Vim-specific initialisation.
657 * Make the magical main::curwin and main::curbuf variables
662 static char cw[] = "main::curwin";
663 static char cb[] = "main::curbuf";
666 sv = perl_get_sv(cw, TRUE);
667 sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
670 sv = perl_get_sv(cb, TRUE);
671 sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
675 * Setup the Safe compartment.
676 * It shouldn't be a fatal error if the Safe module is missing.
677 * XXX: Only shares the 'Msg' routine (which has to be called
680 (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
685 static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
701 script = (char *)script_get(eap, eap->arg);
708 if (perl_interp == NULL)
711 if (!perl_enabled(TRUE))
727 sv = newSVpv((char *)eap->arg, 0);
730 sv = newSVpv(script, 0);
737 safe = perl_get_sv( "VIM::safe", FALSE );
738 # ifndef MAKE_TEST /* avoid a warning for unreachable code */
739 if (safe == NULL || !SvTRUE(safe))
740 EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
748 perl_call_method("reval", G_DISCARD);
753 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
757 err = SvPV(GvSV(PL_errgv), length);
765 msg_split((char_u *)err, highlight_attr[HLF_E]);
771 replace_line(line, end)
772 linenr_T *line, *end;
776 if (SvOK(GvSV(PL_defgv)))
778 str = SvPV(GvSV(PL_defgv), PL_na);
779 ml_replace(*line, (char_u *)str, 1);
780 changed_bytes(*line, 0);
784 ml_delete(*line, FALSE);
785 deleted_lines_mark(*line, 1L);
807 if (perl_interp == NULL)
810 if (!perl_enabled(TRUE))
820 length = strlen((char *)eap->arg);
821 sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
822 sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
823 sv_catpvn(sv, (char *)eap->arg, length);
824 sv_catpvn(sv, "}", 1);
825 perl_eval_sv(sv, G_DISCARD | G_NOARGS);
827 str = SvPV(GvSV(PL_errgv), length);
831 if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
836 for (i = eap->line1; i <= eap->line2; i++)
838 sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
840 perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
841 str = SvPV(GvSV(PL_errgv), length);
847 if (replace_line(&i, &eap->line2) != OK)
858 update_screen(NOT_VALID);
863 msg_split((char_u *)str, highlight_attr[HLF_E]);
869 int win_valid(win_T *w) { return TRUE; }
870 int win_count() { return 1; }
871 win_T *win_find_nr(int n) { return curwin; }
875 XS(XS_VIM_SetOption);
876 XS(XS_VIM_DoCommand);
880 XS(XS_VIWIN_DESTROY);
882 XS(XS_VIWIN_SetHeight);
884 XS(XS_VIBUF_DESTROY);
897 char *file = __FILE__;
899 /* DynaLoader is a special case */
900 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
901 newXS("VIM::bootstrap", boot_VIM, file);
904 typedef win_T * VIWIN;
905 typedef buf_T * VIBUF;
907 MODULE = VIM PACKAGE = VIM
924 id = syn_name2id((char_u *)hl);
926 attr = syn_id2attr(id);
928 msg_split((char_u *)text, attr);
937 do_set((char_u *)line, 0);
938 update_screen(NOT_VALID);
946 do_cmdline_cmd((char_u *)line);
955 value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
958 XPUSHs(sv_2mortal(newSViv(0)));
959 XPUSHs(sv_2mortal(newSVpv("", 0)));
963 XPUSHs(sv_2mortal(newSViv(1)));
964 XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
978 if (GIMME == G_SCALAR)
981 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
984 XPUSHs(sv_2mortal(newSViv(i)));
988 for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
989 XPUSHs(newBUFrv(newSV(0), vimbuf));
994 for (i = 0; i < items; i++)
1004 pat = (char_u *)SvPV(sv, len);
1006 b = buflist_findpat(pat, pat+len, FALSE, FALSE);
1012 vimbuf = buflist_findnr(b);
1014 XPUSHs(newBUFrv(newSV(0), vimbuf));
1029 if (GIMME == G_SCALAR)
1030 XPUSHs(sv_2mortal(newSViv(win_count())));
1033 for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1034 XPUSHs(newWINrv(newSV(0), vimwin));
1039 for (i = 0; i < items; i++)
1042 vimwin = win_find_nr(w);
1044 XPUSHs(newWINrv(newSV(0), vimwin));
1048 MODULE = VIM PACKAGE = VIWIN
1056 win->w_perl_private = 0;
1063 if (!win_valid(win))
1065 RETVAL = newBUFrv(newSV(0), win->w_buffer);
1070 SetHeight(win, height)
1078 if (!win_valid(win))
1082 win_setheight(height);
1093 if (!win_valid(win))
1095 PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1096 PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1102 if (!win_valid(win))
1106 win->w_cursor.lnum = lnum;
1107 win->w_cursor.col = col;
1108 check_cursor(); /* put cursor on an existing line */
1109 update_screen(NOT_VALID);
1112 MODULE = VIM PACKAGE = VIBUF
1119 if (buf_valid(vimbuf))
1120 vimbuf->b_perl_private = 0;
1127 if (!buf_valid(vimbuf))
1129 /* No file name returns an empty string */
1130 if (vimbuf->b_fname == NULL)
1131 XPUSHs(sv_2mortal(newSVpv("", 0)));
1133 XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1140 if (!buf_valid(vimbuf))
1142 XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1149 if (!buf_valid(vimbuf))
1151 XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1162 if (buf_valid(vimbuf))
1164 for (i = 1; i < items; i++)
1167 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1169 line = ml_get_buf(vimbuf, lnum, FALSE);
1170 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1184 if (buf_valid(vimbuf))
1187 croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1190 for(i = 2; i < items; i++, lnum++)
1192 line = SvPV(ST(i),PL_na);
1193 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1197 /* set curwin/curbuf for "vimbuf" and save some things */
1198 aucmd_prepbuf(&aco, vimbuf);
1200 if (u_savesub(lnum) == OK)
1202 ml_replace(lnum, (char_u *)line, TRUE);
1203 changed_bytes(lnum, 0);
1206 /* restore curwin/curbuf and a few other things */
1207 aucmd_restbuf(&aco);
1208 /* Careful: autocommands may have made "vimbuf" invalid! */
1218 long i, lnum = 0, count = 0;
1220 if (buf_valid(vimbuf))
1227 else if (items == 3)
1230 count = 1 + SvIV(ST(2)) - lnum;
1241 for (i = 0; i < count; i++)
1243 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1247 /* set curwin/curbuf for "vimbuf" and save some things */
1248 aucmd_prepbuf(&aco, vimbuf);
1250 if (u_savedel(lnum, 1) == OK)
1254 deleted_lines_mark(lnum, 1L);
1257 /* restore curwin/curbuf and a few other things */
1258 aucmd_restbuf(&aco);
1259 /* Careful: autocommands may have made "vimbuf" invalid! */
1261 update_curbuf(VALID);
1276 if (buf_valid(vimbuf))
1279 croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1282 for (i = 2; i < items; i++, lnum++)
1284 line = SvPV(ST(i),PL_na);
1285 if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1289 /* set curwin/curbuf for "vimbuf" and save some things */
1290 aucmd_prepbuf(&aco, vimbuf);
1292 if (u_inssub(lnum + 1) == OK)
1294 ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1295 appended_lines_mark(lnum, 1L);
1298 /* restore curwin/curbuf and a few other things */
1299 aucmd_restbuf(&aco);
1300 /* Careful: autocommands may have made "vimbuf" invalid! */
1302 update_curbuf(VALID);