1/* 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
43/*
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 *
51 * 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.
55 */
56#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
60#endif
61#if (PERL_REVISION == 5) && (PERL_VERSION >= 9)
62# define PERL589_OR_LATER
63#endif
64
65#if (PERL_REVISION == 5) && ((PERL_VERSION > 10) || \
66    (PERL_VERSION == 10) && (PERL_SUBVERSION >= 1))
67# define PERL5101_OR_LATER
68#endif
69
70#ifndef pTHX
71#    define pTHX void
72#    define pTHX_
73#endif
74
75#ifndef EXTERN_C
76# define EXTERN_C
77#endif
78
79/* Compatibility hacks over */
80
81static PerlInterpreter *perl_interp = NULL;
82static void xs_init __ARGS((pTHX));
83static void VIM_init __ARGS((void));
84EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
85
86/*
87 * For dynamic linked perl.
88 */
89#if defined(DYNAMIC_PERL) || defined(PROTO)
90
91#ifndef DYNAMIC_PERL /* just generating prototypes */
92#ifdef WIN3264
93typedef int HANDLE;
94#endif
95typedef int XSINIT_t;
96typedef int XSUBADDR_t;
97typedef int perl_key;
98#endif
99
100#ifndef WIN3264
101#include <dlfcn.h>
102#define HANDLE void*
103#define PERL_PROC void*
104#define load_dll(n) dlopen((n), RTLD_LAZY|RTLD_GLOBAL)
105#define symbol_from_dll dlsym
106#define close_dll dlclose
107#else
108#define PERL_PROC FARPROC
109#define load_dll LoadLibrary
110#define symbol_from_dll GetProcAddress
111#define close_dll FreeLibrary
112#endif
113/*
114 * Wrapper defines
115 */
116# define perl_alloc dll_perl_alloc
117# define perl_construct dll_perl_construct
118# define perl_parse dll_perl_parse
119# define perl_run dll_perl_run
120# define perl_destruct dll_perl_destruct
121# define perl_free dll_perl_free
122# define Perl_get_context dll_Perl_get_context
123# define Perl_croak dll_Perl_croak
124# ifdef PERL5101_OR_LATER
125#  define Perl_croak_xs_usage dll_Perl_croak_xs_usage
126# endif
127# ifndef PROTO
128#  define Perl_croak_nocontext dll_Perl_croak_nocontext
129#  define Perl_call_argv dll_Perl_call_argv
130#  define Perl_call_pv dll_Perl_call_pv
131#  define Perl_eval_sv dll_Perl_eval_sv
132#  define Perl_get_sv dll_Perl_get_sv
133#  define Perl_eval_pv dll_Perl_eval_pv
134#  define Perl_call_method dll_Perl_call_method
135# endif
136# define Perl_dowantarray dll_Perl_dowantarray
137# define Perl_free_tmps dll_Perl_free_tmps
138# define Perl_gv_stashpv dll_Perl_gv_stashpv
139# define Perl_markstack_grow dll_Perl_markstack_grow
140# define Perl_mg_find dll_Perl_mg_find
141# define Perl_newXS dll_Perl_newXS
142# define Perl_newSV dll_Perl_newSV
143# define Perl_newSViv dll_Perl_newSViv
144# define Perl_newSVpv dll_Perl_newSVpv
145# define Perl_pop_scope dll_Perl_pop_scope
146# define Perl_push_scope dll_Perl_push_scope
147# define Perl_save_int dll_Perl_save_int
148# define Perl_stack_grow dll_Perl_stack_grow
149# define Perl_set_context dll_Perl_set_context
150# define Perl_sv_2bool dll_Perl_sv_2bool
151# define Perl_sv_2iv dll_Perl_sv_2iv
152# define Perl_sv_2mortal dll_Perl_sv_2mortal
153# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
154#  define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
155#  define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
156# else
157#  define Perl_sv_2pv dll_Perl_sv_2pv
158# endif
159# define Perl_sv_bless dll_Perl_sv_bless
160# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
161#  define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
162# else
163#  define Perl_sv_catpvn dll_Perl_sv_catpvn
164# endif
165#ifdef PERL589_OR_LATER
166#  define Perl_sv_2iv_flags dll_Perl_sv_2iv_flags
167#  define Perl_newXS_flags dll_Perl_newXS_flags
168#endif
169# define Perl_sv_free dll_Perl_sv_free
170# if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
171#  define Perl_sv_free2 dll_Perl_sv_free2
172# endif
173# define Perl_sv_isa dll_Perl_sv_isa
174# define Perl_sv_magic dll_Perl_sv_magic
175# define Perl_sv_setiv dll_Perl_sv_setiv
176# define Perl_sv_setpv dll_Perl_sv_setpv
177# define Perl_sv_setpvn dll_Perl_sv_setpvn
178# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
179#  define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
180# else
181#  define Perl_sv_setsv dll_Perl_sv_setsv
182# endif
183# define Perl_sv_upgrade dll_Perl_sv_upgrade
184# define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
185# define Perl_Top_ptr dll_Perl_Top_ptr
186# define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
187# define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
188# define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
189# define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
190# define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
191# define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
192# define Perl_TSv_ptr dll_Perl_TSv_ptr
193# define Perl_TXpv_ptr dll_Perl_TXpv_ptr
194# define Perl_Tna_ptr dll_Perl_Tna_ptr
195# define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
196# define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
197# define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
198# define boot_DynaLoader dll_boot_DynaLoader
199# define Perl_Gthr_key_ptr dll_Perl_Gthr_key_ptr
200
201# define Perl_sys_init dll_Perl_sys_init
202# define Perl_sys_term dll_Perl_sys_term
203# define Perl_ISv_ptr dll_Perl_ISv_ptr
204# define Perl_Istack_max_ptr dll_Perl_Istack_max_ptr
205# define Perl_Istack_base_ptr dll_Perl_Istack_base_ptr
206# define Perl_Itmps_ix_ptr dll_Perl_Itmps_ix_ptr
207# define Perl_Itmps_floor_ptr dll_Perl_Itmps_floor_ptr
208# define Perl_IXpv_ptr dll_Perl_IXpv_ptr
209# define Perl_Ina_ptr dll_Perl_Ina_ptr
210# define Perl_Imarkstack_ptr_ptr dll_Perl_Imarkstack_ptr_ptr
211# define Perl_Imarkstack_max_ptr dll_Perl_Imarkstack_max_ptr
212# define Perl_Istack_sp_ptr dll_Perl_Istack_sp_ptr
213# define Perl_Iop_ptr dll_Perl_Iop_ptr
214# define Perl_call_list dll_Perl_call_list
215# define Perl_Iscopestack_ix_ptr dll_Perl_Iscopestack_ix_ptr
216# define Perl_Iunitcheckav_ptr dll_Perl_Iunitcheckav_ptr
217
218/*
219 * Declare HANDLE for perl.dll and function pointers.
220 */
221static HANDLE hPerlLib = NULL;
222
223static PerlInterpreter* (*perl_alloc)();
224static void (*perl_construct)(PerlInterpreter*);
225static void (*perl_destruct)(PerlInterpreter*);
226static void (*perl_free)(PerlInterpreter*);
227static int (*perl_run)(PerlInterpreter*);
228static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
229static void* (*Perl_get_context)(void);
230static void (*Perl_croak)(pTHX_ const char*, ...);
231#ifdef PERL5101_OR_LATER
232static void (*Perl_croak_xs_usage)(pTHX_ const CV *const, const char *const params);
233#endif
234static void (*Perl_croak_nocontext)(const char*, ...);
235static I32 (*Perl_dowantarray)(pTHX);
236static void (*Perl_free_tmps)(pTHX);
237static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
238static void (*Perl_markstack_grow)(pTHX);
239static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
240static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
241static SV* (*Perl_newSV)(pTHX_ STRLEN);
242static SV* (*Perl_newSViv)(pTHX_ IV);
243static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
244static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
245static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
246static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
247static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
248static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
249static SV* (*Perl_call_method)(pTHX_ const char*, I32);
250static void (*Perl_pop_scope)(pTHX);
251static void (*Perl_push_scope)(pTHX);
252static void (*Perl_save_int)(pTHX_ int*);
253static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
254static SV** (*Perl_set_context)(void*);
255static bool (*Perl_sv_2bool)(pTHX_ SV*);
256static IV (*Perl_sv_2iv)(pTHX_ SV*);
257static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
258#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
259static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
260static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
261#else
262static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
263#endif
264static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
265#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
266static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
267#else
268static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
269#endif
270#ifdef PERL589_OR_LATER
271static IV (*Perl_sv_2iv_flags)(pTHX_ SV* sv, I32 flags);
272static CV * (*Perl_newXS_flags)(pTHX_ const char *name, XSUBADDR_t subaddr, const char *const filename, const char *const proto, U32 flags);
273#endif
274static void (*Perl_sv_free)(pTHX_ SV*);
275static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
276static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
277static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
278static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
279static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
280#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
281static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
282#else
283static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
284#endif
285static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
286#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
287static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
288static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
289static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
290static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
291static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
292static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
293static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
294static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
295static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
296static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
297static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
298#else
299static void (*Perl_sv_free2)(pTHX_ SV*);
300static void (*Perl_sys_init)(int* argc, char*** argv);
301static void (*Perl_sys_term)(void);
302static SV** (*Perl_ISv_ptr)(register PerlInterpreter*);
303static SV*** (*Perl_Istack_max_ptr)(register PerlInterpreter*);
304static SV*** (*Perl_Istack_base_ptr)(register PerlInterpreter*);
305static XPV** (*Perl_IXpv_ptr)(register PerlInterpreter*);
306static I32* (*Perl_Itmps_ix_ptr)(register PerlInterpreter*);
307static I32* (*Perl_Itmps_floor_ptr)(register PerlInterpreter*);
308static STRLEN* (*Perl_Ina_ptr)(register PerlInterpreter*);
309static I32** (*Perl_Imarkstack_ptr_ptr)(register PerlInterpreter*);
310static I32** (*Perl_Imarkstack_max_ptr)(register PerlInterpreter*);
311static SV*** (*Perl_Istack_sp_ptr)(register PerlInterpreter*);
312static OP** (*Perl_Iop_ptr)(register PerlInterpreter*);
313static void (*Perl_call_list)(pTHX_ I32, AV*);
314static I32* (*Perl_Iscopestack_ix_ptr)(register PerlInterpreter*);
315static AV** (*Perl_Iunitcheckav_ptr)(register PerlInterpreter*);
316#endif
317
318static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
319static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
320static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
321static void (*boot_DynaLoader)_((pTHX_ CV*));
322static perl_key* (*Perl_Gthr_key_ptr)_((pTHX));
323
324/*
325 * Table of name to function pointer of perl.
326 */
327static struct {
328    char* name;
329    PERL_PROC* ptr;
330} perl_funcname_table[] = {
331    {"perl_alloc", (PERL_PROC*)&perl_alloc},
332    {"perl_construct", (PERL_PROC*)&perl_construct},
333    {"perl_destruct", (PERL_PROC*)&perl_destruct},
334    {"perl_free", (PERL_PROC*)&perl_free},
335    {"perl_run", (PERL_PROC*)&perl_run},
336    {"perl_parse", (PERL_PROC*)&perl_parse},
337    {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
338    {"Perl_croak", (PERL_PROC*)&Perl_croak},
339#ifdef PERL5101_OR_LATER
340    {"Perl_croak_xs_usage", (PERL_PROC*)&Perl_croak_xs_usage},
341#endif
342    {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
343    {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
344    {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
345    {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
346    {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
347    {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
348    {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
349    {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
350    {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
351    {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
352    {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
353    {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
354    {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
355    {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
356    {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
357    {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
358    {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
359    {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
360    {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
361    {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
362    {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
363    {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
364    {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
365    {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
366#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
367    {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
368    {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
369#else
370    {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
371#endif
372#ifdef PERL589_OR_LATER
373    {"Perl_sv_2iv_flags", (PERL_PROC*)&Perl_sv_2iv_flags},
374    {"Perl_newXS_flags", (PERL_PROC*)&Perl_newXS_flags},
375#endif
376    {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
377#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
378    {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
379#else
380    {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
381#endif
382    {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
383    {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
384    {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
385    {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
386    {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
387    {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
388#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
389    {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
390#else
391    {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
392#endif
393    {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
394#if (PERL_REVISION == 5) && (PERL_VERSION < 10)
395    {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
396    {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
397    {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
398    {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
399    {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
400    {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
401    {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
402    {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
403    {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
404    {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
405    {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
406#else
407    {"Perl_sv_free2", (PERL_PROC*)&Perl_sv_free2},
408    {"Perl_sys_init", (PERL_PROC*)&Perl_sys_init},
409    {"Perl_sys_term", (PERL_PROC*)&Perl_sys_term},
410    {"Perl_ISv_ptr", (PERL_PROC*)&Perl_ISv_ptr},
411    {"Perl_Istack_max_ptr", (PERL_PROC*)&Perl_Istack_max_ptr},
412    {"Perl_Istack_base_ptr", (PERL_PROC*)&Perl_Istack_base_ptr},
413    {"Perl_IXpv_ptr", (PERL_PROC*)&Perl_IXpv_ptr},
414    {"Perl_Itmps_ix_ptr", (PERL_PROC*)&Perl_Itmps_ix_ptr},
415    {"Perl_Itmps_floor_ptr", (PERL_PROC*)&Perl_Itmps_floor_ptr},
416    {"Perl_Ina_ptr", (PERL_PROC*)&Perl_Ina_ptr},
417    {"Perl_Imarkstack_ptr_ptr", (PERL_PROC*)&Perl_Imarkstack_ptr_ptr},
418    {"Perl_Imarkstack_max_ptr", (PERL_PROC*)&Perl_Imarkstack_max_ptr},
419    {"Perl_Istack_sp_ptr", (PERL_PROC*)&Perl_Istack_sp_ptr},
420    {"Perl_Iop_ptr", (PERL_PROC*)&Perl_Iop_ptr},
421    {"Perl_call_list", (PERL_PROC*)&Perl_call_list},
422    {"Perl_Iscopestack_ix_ptr", (PERL_PROC*)&Perl_Iscopestack_ix_ptr},
423    {"Perl_Iunitcheckav_ptr", (PERL_PROC*)&Perl_Iunitcheckav_ptr},
424#endif
425    {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
426    {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
427    {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
428    {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
429    {"Perl_Gthr_key_ptr", (PERL_PROC*)&Perl_Gthr_key_ptr},
430    {"", NULL},
431};
432
433/*
434 * Make all runtime-links of perl.
435 *
436 * 1. Get module handle using LoadLibraryEx.
437 * 2. Get pointer to perl function by GetProcAddress.
438 * 3. Repeat 2, until get all functions will be used.
439 *
440 * Parameter 'libname' provides name of DLL.
441 * Return OK or FAIL.
442 */
443    static int
444perl_runtime_link_init(char *libname, int verbose)
445{
446    int i;
447
448    if (hPerlLib != NULL)
449	return OK;
450    if ((hPerlLib = load_dll(libname)) == NULL)
451    {
452	if (verbose)
453	    EMSG2(_("E370: Could not load library %s"), libname);
454	return FAIL;
455    }
456    for (i = 0; perl_funcname_table[i].ptr; ++i)
457    {
458	if (!(*perl_funcname_table[i].ptr = symbol_from_dll(hPerlLib,
459			perl_funcname_table[i].name)))
460	{
461	    close_dll(hPerlLib);
462	    hPerlLib = NULL;
463	    if (verbose)
464		EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
465	    return FAIL;
466	}
467    }
468    return OK;
469}
470
471/*
472 * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
473 * There were no DLL loaded, return FALSE.
474 */
475    int
476perl_enabled(verbose)
477    int		verbose;
478{
479    return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
480}
481#endif /* DYNAMIC_PERL */
482
483/*
484 * perl_init(): initialize perl interpreter
485 * We have to call perl_parse to initialize some structures,
486 * there's nothing to actually parse.
487 */
488    static void
489perl_init()
490{
491    char *bootargs[] = { "VI", NULL };
492    int argc = 3;
493    static char *argv[] = { "", "-e", "" };
494
495#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
496    Perl_sys_init(&argc, (char***)&argv);
497#endif
498    perl_interp = perl_alloc();
499    perl_construct(perl_interp);
500    perl_parse(perl_interp, xs_init, argc, argv, 0);
501    perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
502    VIM_init();
503#ifdef USE_SFIO
504    sfdisc(PerlIO_stdout(), sfdcnewvim());
505    sfdisc(PerlIO_stderr(), sfdcnewvim());
506    sfsetbuf(PerlIO_stdout(), NULL, 0);
507    sfsetbuf(PerlIO_stderr(), NULL, 0);
508#endif
509}
510
511/*
512 * perl_end(): clean up after ourselves
513 */
514    void
515perl_end()
516{
517    if (perl_interp)
518    {
519	perl_run(perl_interp);
520	perl_destruct(perl_interp);
521	perl_free(perl_interp);
522	perl_interp = NULL;
523#if (PERL_REVISION == 5) && (PERL_VERSION >= 10)
524        Perl_sys_term();
525#endif
526    }
527#ifdef DYNAMIC_PERL
528    if (hPerlLib)
529    {
530	close_dll(hPerlLib);
531	hPerlLib = NULL;
532    }
533#endif
534}
535
536/*
537 * msg_split(): send a message to the message handling routines
538 * split at '\n' first though.
539 */
540    void
541msg_split(s, attr)
542    char_u	*s;
543    int		attr;	/* highlighting attributes */
544{
545    char *next;
546    char *token = (char *)s;
547
548    while ((next = strchr(token, '\n')) && !got_int)
549    {
550	*next++ = '\0';			/* replace \n with \0 */
551	msg_attr((char_u *)token, attr);
552	token = next;
553    }
554    if (*token && !got_int)
555	msg_attr((char_u *)token, attr);
556}
557
558#ifndef FEAT_EVAL
559/*
560 * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
561 * work properly.
562 */
563    char_u *
564eval_to_string(arg, nextcmd, dolist)
565    char_u	*arg;
566    char_u	**nextcmd;
567    int		dolist;
568{
569    return NULL;
570}
571#endif
572
573/*
574 * Create a new reference to an SV pointing to the SCR structure
575 * The b_perl_private/w_perl_private part of the SCR structure points to the
576 * SV, so there can only be one such SV for a particular SCR structure.  When
577 * the last reference has gone (DESTROY is called),
578 * b_perl_private/w_perl_private is reset; When the screen goes away before
579 * all references are gone, the value of the SV is reset;
580 * any subsequent use of any of those reference will produce
581 * a warning. (see typemap)
582 */
583
584    static SV *
585newWINrv(rv, ptr)
586    SV	    *rv;
587    win_T   *ptr;
588{
589    sv_upgrade(rv, SVt_RV);
590    if (ptr->w_perl_private == NULL)
591    {
592	ptr->w_perl_private = newSV(0);
593	sv_setiv(ptr->w_perl_private, (IV)ptr);
594    }
595    else
596	SvREFCNT_inc(ptr->w_perl_private);
597    SvRV(rv) = ptr->w_perl_private;
598    SvROK_on(rv);
599    return sv_bless(rv, gv_stashpv("VIWIN", TRUE));
600}
601
602    static SV *
603newBUFrv(rv, ptr)
604    SV	    *rv;
605    buf_T   *ptr;
606{
607    sv_upgrade(rv, SVt_RV);
608    if (ptr->b_perl_private == NULL)
609    {
610	ptr->b_perl_private = newSV(0);
611	sv_setiv(ptr->b_perl_private, (IV)ptr);
612    }
613    else
614	SvREFCNT_inc(ptr->b_perl_private);
615    SvRV(rv) = ptr->b_perl_private;
616    SvROK_on(rv);
617    return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
618}
619
620/*
621 * perl_win_free
622 *	Remove all refences to the window to be destroyed
623 */
624    void
625perl_win_free(wp)
626    win_T *wp;
627{
628    if (wp->w_perl_private)
629	sv_setiv((SV *)wp->w_perl_private, 0);
630    return;
631}
632
633    void
634perl_buf_free(bp)
635    buf_T *bp;
636{
637    if (bp->b_perl_private)
638	sv_setiv((SV *)bp->b_perl_private, 0);
639    return;
640}
641
642#ifndef PROTO
643# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
644I32 cur_val(pTHX_ IV iv, SV *sv);
645# else
646I32 cur_val(IV iv, SV *sv);
647#endif
648
649/*
650 * Handler for the magic variables $main::curwin and $main::curbuf.
651 * The handler is put into the magic vtbl for these variables.
652 * (This is effectively a C-level equivalent of a tied variable).
653 * There is no "set" function as the variables are read-only.
654 */
655# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
656I32 cur_val(pTHX_ IV iv, SV *sv)
657# else
658I32 cur_val(IV iv, SV *sv)
659# endif
660{
661    SV *rv;
662    if (iv == 0)
663	rv = newWINrv(newSV(0), curwin);
664    else
665	rv = newBUFrv(newSV(0), curbuf);
666    sv_setsv(sv, rv);
667    return 0;
668}
669#endif /* !PROTO */
670
671struct ufuncs cw_funcs = { cur_val, 0, 0 };
672struct ufuncs cb_funcs = { cur_val, 0, 1 };
673
674/*
675 * VIM_init(): Vim-specific initialisation.
676 * Make the magical main::curwin and main::curbuf variables
677 */
678    static void
679VIM_init()
680{
681    static char cw[] = "main::curwin";
682    static char cb[] = "main::curbuf";
683    SV *sv;
684
685    sv = perl_get_sv(cw, TRUE);
686    sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
687    SvREADONLY_on(sv);
688
689    sv = perl_get_sv(cb, TRUE);
690    sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
691    SvREADONLY_on(sv);
692
693    /*
694     * Setup the Safe compartment.
695     * It shouldn't be a fatal error if the Safe module is missing.
696     * XXX: Only shares the 'Msg' routine (which has to be called
697     * like 'Msg(...)').
698     */
699    (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
700
701}
702
703#ifdef DYNAMIC_PERL
704static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
705#endif
706
707/*
708 * ":perl"
709 */
710    void
711ex_perl(eap)
712    exarg_T	*eap;
713{
714    char	*err;
715    char	*script;
716    STRLEN	length;
717    SV		*sv;
718#ifdef HAVE_SANDBOX
719    SV		*safe;
720#endif
721
722    script = (char *)script_get(eap, eap->arg);
723    if (eap->skip)
724    {
725	vim_free(script);
726	return;
727    }
728
729    if (perl_interp == NULL)
730    {
731#ifdef DYNAMIC_PERL
732	if (!perl_enabled(TRUE))
733	{
734	    EMSG(_(e_noperl));
735	    vim_free(script);
736	    return;
737	}
738#endif
739	perl_init();
740    }
741
742    {
743    dSP;
744    ENTER;
745    SAVETMPS;
746
747    if (script == NULL)
748	sv = newSVpv((char *)eap->arg, 0);
749    else
750    {
751	sv = newSVpv(script, 0);
752	vim_free(script);
753    }
754
755#ifdef HAVE_SANDBOX
756    if (sandbox)
757    {
758	safe = perl_get_sv( "VIM::safe", FALSE );
759# ifndef MAKE_TEST  /* avoid a warning for unreachable code */
760	if (safe == NULL || !SvTRUE(safe))
761	    EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
762	else
763# endif
764	{
765	    PUSHMARK(SP);
766	    XPUSHs(safe);
767	    XPUSHs(sv);
768	    PUTBACK;
769	    perl_call_method("reval", G_DISCARD);
770	}
771    }
772    else
773#endif
774	perl_eval_sv(sv, G_DISCARD | G_NOARGS);
775
776    SvREFCNT_dec(sv);
777
778    err = SvPV(GvSV(PL_errgv), length);
779
780    FREETMPS;
781    LEAVE;
782
783    if (!length)
784	return;
785
786    msg_split((char_u *)err, highlight_attr[HLF_E]);
787    return;
788    }
789}
790
791    static int
792replace_line(line, end)
793    linenr_T	*line, *end;
794{
795    char *str;
796
797    if (SvOK(GvSV(PL_defgv)))
798    {
799	str = SvPV(GvSV(PL_defgv), PL_na);
800	ml_replace(*line, (char_u *)str, 1);
801	changed_bytes(*line, 0);
802    }
803    else
804    {
805	ml_delete(*line, FALSE);
806	deleted_lines_mark(*line, 1L);
807	--(*end);
808	--(*line);
809    }
810    return OK;
811}
812
813/*
814 * ":perldo".
815 */
816    void
817ex_perldo(eap)
818    exarg_T	*eap;
819{
820    STRLEN	length;
821    SV		*sv;
822    char	*str;
823    linenr_T	i;
824
825    if (bufempty())
826	return;
827
828    if (perl_interp == NULL)
829    {
830#ifdef DYNAMIC_PERL
831	if (!perl_enabled(TRUE))
832	{
833	    EMSG(_(e_noperl));
834	    return;
835	}
836#endif
837	perl_init();
838    }
839    {
840    dSP;
841    length = strlen((char *)eap->arg);
842    sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
843    sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
844    sv_catpvn(sv, (char *)eap->arg, length);
845    sv_catpvn(sv, "}", 1);
846    perl_eval_sv(sv, G_DISCARD | G_NOARGS);
847    SvREFCNT_dec(sv);
848    str = SvPV(GvSV(PL_errgv), length);
849    if (length)
850	goto err;
851
852    if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
853	return;
854
855    ENTER;
856    SAVETMPS;
857    for (i = eap->line1; i <= eap->line2; i++)
858    {
859	sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
860	PUSHMARK(sp);
861	perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
862	str = SvPV(GvSV(PL_errgv), length);
863	if (length)
864	    break;
865	SPAGAIN;
866	if (SvTRUEx(POPs))
867	{
868	    if (replace_line(&i, &eap->line2) != OK)
869	    {
870		PUTBACK;
871		break;
872	    }
873	}
874	PUTBACK;
875    }
876    FREETMPS;
877    LEAVE;
878    check_cursor();
879    update_screen(NOT_VALID);
880    if (!length)
881	return;
882
883err:
884    msg_split((char_u *)str, highlight_attr[HLF_E]);
885    return;
886    }
887}
888
889#ifndef FEAT_WINDOWS
890int win_valid(win_T *w) { return TRUE; }
891int win_count() { return 1; }
892win_T *win_find_nr(int n) { return curwin; }
893#endif
894
895XS(XS_VIM_Msg);
896XS(XS_VIM_SetOption);
897XS(XS_VIM_DoCommand);
898XS(XS_VIM_Eval);
899XS(XS_VIM_Buffers);
900XS(XS_VIM_Windows);
901XS(XS_VIWIN_DESTROY);
902XS(XS_VIWIN_Buffer);
903XS(XS_VIWIN_SetHeight);
904XS(XS_VIWIN_Cursor);
905XS(XS_VIBUF_DESTROY);
906XS(XS_VIBUF_Name);
907XS(XS_VIBUF_Number);
908XS(XS_VIBUF_Count);
909XS(XS_VIBUF_Get);
910XS(XS_VIBUF_Set);
911XS(XS_VIBUF_Delete);
912XS(XS_VIBUF_Append);
913XS(boot_VIM);
914
915    static void
916xs_init(pTHX)
917{
918    char *file = __FILE__;
919
920    /* DynaLoader is a special case */
921    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
922    newXS("VIM::bootstrap", boot_VIM, file);
923}
924
925typedef win_T *	VIWIN;
926typedef buf_T *	VIBUF;
927
928MODULE = VIM	    PACKAGE = VIM
929
930void
931Msg(text, hl=NULL)
932    char	*text;
933    char	*hl;
934
935    PREINIT:
936    int		attr;
937    int		id;
938
939    PPCODE:
940    if (text != NULL)
941    {
942	attr = 0;
943	if (hl != NULL)
944	{
945	    id = syn_name2id((char_u *)hl);
946	    if (id != 0)
947		attr = syn_id2attr(id);
948	}
949	msg_split((char_u *)text, attr);
950    }
951
952void
953SetOption(line)
954    char *line;
955
956    PPCODE:
957    if (line != NULL)
958	do_set((char_u *)line, 0);
959    update_screen(NOT_VALID);
960
961void
962DoCommand(line)
963    char *line;
964
965    PPCODE:
966    if (line != NULL)
967	do_cmdline_cmd((char_u *)line);
968
969void
970Eval(str)
971    char *str;
972
973    PREINIT:
974	char_u *value;
975    PPCODE:
976	value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
977	if (value == NULL)
978	{
979	    XPUSHs(sv_2mortal(newSViv(0)));
980	    XPUSHs(sv_2mortal(newSVpv("", 0)));
981	}
982	else
983	{
984	    XPUSHs(sv_2mortal(newSViv(1)));
985	    XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
986	    vim_free(value);
987	}
988
989void
990Buffers(...)
991
992    PREINIT:
993    buf_T *vimbuf;
994    int i, b;
995
996    PPCODE:
997    if (items == 0)
998    {
999	if (GIMME == G_SCALAR)
1000	{
1001	    i = 0;
1002	    for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1003		++i;
1004
1005	    XPUSHs(sv_2mortal(newSViv(i)));
1006	}
1007	else
1008	{
1009	    for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
1010		XPUSHs(newBUFrv(newSV(0), vimbuf));
1011	}
1012    }
1013    else
1014    {
1015	for (i = 0; i < items; i++)
1016	{
1017	    SV *sv = ST(i);
1018	    if (SvIOK(sv))
1019		b = SvIV(ST(i));
1020	    else
1021	    {
1022		char_u *pat;
1023		STRLEN len;
1024
1025		pat = (char_u *)SvPV(sv, len);
1026		++emsg_off;
1027		b = buflist_findpat(pat, pat+len, FALSE, FALSE);
1028		--emsg_off;
1029	    }
1030
1031	    if (b >= 0)
1032	    {
1033		vimbuf = buflist_findnr(b);
1034		if (vimbuf)
1035		    XPUSHs(newBUFrv(newSV(0), vimbuf));
1036	    }
1037	}
1038    }
1039
1040void
1041Windows(...)
1042
1043    PREINIT:
1044    win_T   *vimwin;
1045    int	    i, w;
1046
1047    PPCODE:
1048    if (items == 0)
1049    {
1050	if (GIMME == G_SCALAR)
1051	    XPUSHs(sv_2mortal(newSViv(win_count())));
1052	else
1053	{
1054	    for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1055		XPUSHs(newWINrv(newSV(0), vimwin));
1056	}
1057    }
1058    else
1059    {
1060	for (i = 0; i < items; i++)
1061	{
1062	    w = SvIV(ST(i));
1063	    vimwin = win_find_nr(w);
1064	    if (vimwin)
1065		XPUSHs(newWINrv(newSV(0), vimwin));
1066	}
1067    }
1068
1069MODULE = VIM	    PACKAGE = VIWIN
1070
1071void
1072DESTROY(win)
1073    VIWIN win
1074
1075    CODE:
1076    if (win_valid(win))
1077	win->w_perl_private = 0;
1078
1079SV *
1080Buffer(win)
1081    VIWIN win
1082
1083    CODE:
1084    if (!win_valid(win))
1085	win = curwin;
1086    RETVAL = newBUFrv(newSV(0), win->w_buffer);
1087    OUTPUT:
1088    RETVAL
1089
1090void
1091SetHeight(win, height)
1092    VIWIN win
1093    int height;
1094
1095    PREINIT:
1096    win_T *savewin;
1097
1098    PPCODE:
1099    if (!win_valid(win))
1100	win = curwin;
1101    savewin = curwin;
1102    curwin = win;
1103    win_setheight(height);
1104    curwin = savewin;
1105
1106void
1107Cursor(win, ...)
1108    VIWIN win
1109
1110    PPCODE:
1111    if(items == 1)
1112    {
1113      EXTEND(sp, 2);
1114      if (!win_valid(win))
1115	  win = curwin;
1116      PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1117      PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1118    }
1119    else if(items == 3)
1120    {
1121      int lnum, col;
1122
1123      if (!win_valid(win))
1124	  win = curwin;
1125      lnum = SvIV(ST(1));
1126      col = SvIV(ST(2));
1127      win->w_cursor.lnum = lnum;
1128      win->w_cursor.col = col;
1129      check_cursor();		    /* put cursor on an existing line */
1130      update_screen(NOT_VALID);
1131    }
1132
1133MODULE = VIM	    PACKAGE = VIBUF
1134
1135void
1136DESTROY(vimbuf)
1137    VIBUF vimbuf;
1138
1139    CODE:
1140    if (buf_valid(vimbuf))
1141	vimbuf->b_perl_private = 0;
1142
1143void
1144Name(vimbuf)
1145    VIBUF vimbuf;
1146
1147    PPCODE:
1148    if (!buf_valid(vimbuf))
1149	vimbuf = curbuf;
1150    /* No file name returns an empty string */
1151    if (vimbuf->b_fname == NULL)
1152	XPUSHs(sv_2mortal(newSVpv("", 0)));
1153    else
1154	XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1155
1156void
1157Number(vimbuf)
1158    VIBUF vimbuf;
1159
1160    PPCODE:
1161    if (!buf_valid(vimbuf))
1162	vimbuf = curbuf;
1163    XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1164
1165void
1166Count(vimbuf)
1167    VIBUF vimbuf;
1168
1169    PPCODE:
1170    if (!buf_valid(vimbuf))
1171	vimbuf = curbuf;
1172    XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1173
1174void
1175Get(vimbuf, ...)
1176    VIBUF vimbuf;
1177
1178    PREINIT:
1179    char_u *line;
1180    int i;
1181    long lnum;
1182    PPCODE:
1183    if (buf_valid(vimbuf))
1184    {
1185	for (i = 1; i < items; i++)
1186	{
1187	    lnum = SvIV(ST(i));
1188	    if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1189	    {
1190		line = ml_get_buf(vimbuf, lnum, FALSE);
1191		XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1192	    }
1193	}
1194    }
1195
1196void
1197Set(vimbuf, ...)
1198    VIBUF vimbuf;
1199
1200    PREINIT:
1201    int i;
1202    long lnum;
1203    char *line;
1204    PPCODE:
1205    if (buf_valid(vimbuf))
1206    {
1207	if (items < 3)
1208	    croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1209
1210	lnum = SvIV(ST(1));
1211	for(i = 2; i < items; i++, lnum++)
1212	{
1213	    line = SvPV(ST(i),PL_na);
1214	    if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1215	    {
1216		aco_save_T	aco;
1217
1218		/* set curwin/curbuf for "vimbuf" and save some things */
1219		aucmd_prepbuf(&aco, vimbuf);
1220
1221		if (u_savesub(lnum) == OK)
1222		{
1223		    ml_replace(lnum, (char_u *)line, TRUE);
1224		    changed_bytes(lnum, 0);
1225		}
1226
1227		/* restore curwin/curbuf and a few other things */
1228		aucmd_restbuf(&aco);
1229		/* Careful: autocommands may have made "vimbuf" invalid! */
1230	    }
1231	}
1232    }
1233
1234void
1235Delete(vimbuf, ...)
1236    VIBUF vimbuf;
1237
1238    PREINIT:
1239    long i, lnum = 0, count = 0;
1240    PPCODE:
1241    if (buf_valid(vimbuf))
1242    {
1243	if (items == 2)
1244	{
1245	    lnum = SvIV(ST(1));
1246	    count = 1;
1247	}
1248	else if (items == 3)
1249	{
1250	    lnum = SvIV(ST(1));
1251	    count = 1 + SvIV(ST(2)) - lnum;
1252	    if(count == 0)
1253		count = 1;
1254	    if(count < 0)
1255	    {
1256		lnum -= count;
1257		count = -count;
1258	    }
1259	}
1260	if (items >= 2)
1261	{
1262	    for (i = 0; i < count; i++)
1263	    {
1264		if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1265		{
1266		    aco_save_T	aco;
1267
1268		    /* set curwin/curbuf for "vimbuf" and save some things */
1269		    aucmd_prepbuf(&aco, vimbuf);
1270
1271		    if (u_savedel(lnum, 1) == OK)
1272		    {
1273			ml_delete(lnum, 0);
1274			check_cursor();
1275			deleted_lines_mark(lnum, 1L);
1276		    }
1277
1278		    /* restore curwin/curbuf and a few other things */
1279		    aucmd_restbuf(&aco);
1280		    /* Careful: autocommands may have made "vimbuf" invalid! */
1281
1282		    update_curbuf(VALID);
1283		}
1284	    }
1285	}
1286    }
1287
1288void
1289Append(vimbuf, ...)
1290    VIBUF vimbuf;
1291
1292    PREINIT:
1293    int		i;
1294    long	lnum;
1295    char	*line;
1296    PPCODE:
1297    if (buf_valid(vimbuf))
1298    {
1299	if (items < 3)
1300	    croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1301
1302	lnum = SvIV(ST(1));
1303	for (i = 2; i < items; i++, lnum++)
1304	{
1305	    line = SvPV(ST(i),PL_na);
1306	    if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1307	    {
1308		aco_save_T	aco;
1309
1310		/* set curwin/curbuf for "vimbuf" and save some things */
1311		aucmd_prepbuf(&aco, vimbuf);
1312
1313		if (u_inssub(lnum + 1) == OK)
1314		{
1315		    ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1316		    appended_lines_mark(lnum, 1L);
1317		}
1318
1319		/* restore curwin/curbuf and a few other things */
1320		aucmd_restbuf(&aco);
1321		/* Careful: autocommands may have made "vimbuf" invalid! */
1322
1323		update_curbuf(VALID);
1324	    }
1325	}
1326    }
1327
1328