updated for version 7.0001v7.0001

1 files changed, 1150 insertions, 0 deletions

diff --git a/src/if_perl.xs b/src/if_perl.xs
new file mode 100644
index 000000000..96608ef6b
--- /dev/null
+++ b/src/if_perl.xs
@@ -0,0 +1,1150 @@
+/* vi:set ts=8 sts=4 sw=4:
+ *
+ * VIM - Vi IMproved	by Bram Moolenaar
+ *
+ * Do ":help uganda"  in Vim to read copying and usage conditions.
+ * Do ":help credits" in Vim to see a list of people who contributed.
+ */
+/*
+ * if_perl.xs: Main code for Perl interface support.
+ *		Mostly written by Sven Verdoolaege.
+ */
+
+#define _memory_h	/* avoid memset redeclaration */
+#define IN_PERL_FILE	/* don't include if_perl.pro from proto.h */
+
+#include "vim.h"
+
+
+/*
+ * Work around clashes between Perl and Vim namespace.	proto.h doesn't
+ * include if_perl.pro and perlsfio.pro when IN_PERL_FILE is defined, because
+ * we need the CV typedef.  proto.h can't be moved to after including
+ * if_perl.h, because we get all sorts of name clashes then.
+ */
+#ifndef PROTO
+#ifndef __MINGW32__
+# include "proto/if_perl.pro"
+# include "proto/if_perlsfio.pro"
+#endif
+#endif
+
+/* Perl compatibility stuff. This should ensure compatibility with older
+ * versions of Perl.
+ */
+
+#ifndef PERL_VERSION
+#    include <patchlevel.h>
+#    define PERL_REVISION   5
+#    define PERL_VERSION    PATCHLEVEL
+#    define PERL_SUBVERSION SUBVERSION
+#endif
+
+#ifndef pTHX
+#    define pTHX void
+#    define pTHX_
+#endif
+
+#ifndef EXTERN_C
+# define EXTERN_C
+#endif
+
+/* Compatibility hacks over */
+
+static PerlInterpreter *perl_interp = NULL;
+static void xs_init __ARGS((pTHX));
+static void VIM_init __ARGS((void));
+EXTERN_C void boot_DynaLoader __ARGS((pTHX_ CV*));
+
+/*
+ * For dynamic linked perl. (Windows)
+ */
+#if defined(DYNAMIC_PERL) || defined(PROTO)
+/*
+ * Wrapper defines
+ */
+# define perl_alloc dll_perl_alloc
+# define perl_construct dll_perl_construct
+# define perl_parse dll_perl_parse
+# define perl_run dll_perl_run
+# define perl_destruct dll_perl_destruct
+# define perl_free dll_perl_free
+# define Perl_get_context dll_Perl_get_context
+# define Perl_croak dll_Perl_croak
+# ifndef PROTO
+#  define Perl_croak_nocontext dll_Perl_croak_nocontext
+#  define Perl_call_argv dll_Perl_call_argv
+#  define Perl_call_pv dll_Perl_call_pv
+#  define Perl_eval_sv dll_Perl_eval_sv
+#  define Perl_get_sv dll_Perl_get_sv
+#  define Perl_eval_pv dll_Perl_eval_pv
+#  define Perl_call_method dll_Perl_call_method
+# endif
+# define Perl_dowantarray dll_Perl_dowantarray
+# define Perl_free_tmps dll_Perl_free_tmps
+# define Perl_gv_stashpv dll_Perl_gv_stashpv
+# define Perl_markstack_grow dll_Perl_markstack_grow
+# define Perl_mg_find dll_Perl_mg_find
+# define Perl_newXS dll_Perl_newXS
+# define Perl_newSV dll_Perl_newSV
+# define Perl_newSViv dll_Perl_newSViv
+# define Perl_newSVpv dll_Perl_newSVpv
+# define Perl_pop_scope dll_Perl_pop_scope
+# define Perl_push_scope dll_Perl_push_scope
+# define Perl_save_int dll_Perl_save_int
+# define Perl_stack_grow dll_Perl_stack_grow
+# define Perl_set_context dll_Perl_set_context
+# define Perl_sv_2bool dll_Perl_sv_2bool
+# define Perl_sv_2iv dll_Perl_sv_2iv
+# define Perl_sv_2mortal dll_Perl_sv_2mortal
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+#  define Perl_sv_2pv_flags dll_Perl_sv_2pv_flags
+#  define Perl_sv_2pv_nolen dll_Perl_sv_2pv_nolen
+# else
+#  define Perl_sv_2pv dll_Perl_sv_2pv
+# endif
+# define Perl_sv_bless dll_Perl_sv_bless
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+#  define Perl_sv_catpvn_flags dll_Perl_sv_catpvn_flags
+# else
+#  define Perl_sv_catpvn dll_Perl_sv_catpvn
+# endif
+# define Perl_sv_free dll_Perl_sv_free
+# define Perl_sv_isa dll_Perl_sv_isa
+# define Perl_sv_magic dll_Perl_sv_magic
+# define Perl_sv_setiv dll_Perl_sv_setiv
+# define Perl_sv_setpv dll_Perl_sv_setpv
+# define Perl_sv_setpvn dll_Perl_sv_setpvn
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+#  define Perl_sv_setsv_flags dll_Perl_sv_setsv_flags
+# else
+#  define Perl_sv_setsv dll_Perl_sv_setsv
+# endif
+# define Perl_sv_upgrade dll_Perl_sv_upgrade
+# define Perl_Tstack_sp_ptr dll_Perl_Tstack_sp_ptr
+# define Perl_Top_ptr dll_Perl_Top_ptr
+# define Perl_Tstack_base_ptr dll_Perl_Tstack_base_ptr
+# define Perl_Tstack_max_ptr dll_Perl_Tstack_max_ptr
+# define Perl_Ttmps_ix_ptr dll_Perl_Ttmps_ix_ptr
+# define Perl_Ttmps_floor_ptr dll_Perl_Ttmps_floor_ptr
+# define Perl_Tmarkstack_ptr_ptr dll_Perl_Tmarkstack_ptr_ptr
+# define Perl_Tmarkstack_max_ptr dll_Perl_Tmarkstack_max_ptr
+# define Perl_TSv_ptr dll_Perl_TSv_ptr
+# define Perl_TXpv_ptr dll_Perl_TXpv_ptr
+# define Perl_Tna_ptr dll_Perl_Tna_ptr
+# define Perl_Idefgv_ptr dll_Perl_Idefgv_ptr
+# define Perl_Ierrgv_ptr dll_Perl_Ierrgv_ptr
+# define Perl_Isv_yes_ptr dll_Perl_Isv_yes_ptr
+# define boot_DynaLoader dll_boot_DynaLoader
+
+#ifndef DYNAMIC_PERL /* just generating prototypes */
+typedef int HANDLE;
+typedef int XSINIT_t;
+typedef int XSUBADDR_t;
+#endif
+
+/*
+ * Declare HANDLE for perl.dll and function pointers.
+ */
+static HANDLE hPerlLib = NULL;
+
+static PerlInterpreter* (*perl_alloc)();
+static void (*perl_construct)(PerlInterpreter*);
+static void (*perl_destruct)(PerlInterpreter*);
+static void (*perl_free)(PerlInterpreter*);
+static int (*perl_run)(PerlInterpreter*);
+static int (*perl_parse)(PerlInterpreter*, XSINIT_t, int, char**, char**);
+static void* (*Perl_get_context)(void);
+static void (*Perl_croak)(pTHX_ const char*, ...) __attribute__((noreturn));
+static void (*Perl_croak_nocontext)(const char*, ...) __attribute__((noreturn));
+static I32 (*Perl_dowantarray)(pTHX);
+static void (*Perl_free_tmps)(pTHX);
+static HV* (*Perl_gv_stashpv)(pTHX_ const char*, I32);
+static void (*Perl_markstack_grow)(pTHX);
+static MAGIC* (*Perl_mg_find)(pTHX_ SV*, int);
+static CV* (*Perl_newXS)(pTHX_ char*, XSUBADDR_t, char*);
+static SV* (*Perl_newSV)(pTHX_ STRLEN);
+static SV* (*Perl_newSViv)(pTHX_ IV);
+static SV* (*Perl_newSVpv)(pTHX_ const char*, STRLEN);
+static I32 (*Perl_call_argv)(pTHX_ const char*, I32, char**);
+static I32 (*Perl_call_pv)(pTHX_ const char*, I32);
+static I32 (*Perl_eval_sv)(pTHX_ SV*, I32);
+static SV* (*Perl_get_sv)(pTHX_ const char*, I32);
+static SV* (*Perl_eval_pv)(pTHX_ const char*, I32);
+static SV* (*Perl_call_method)(pTHX_ const char*, I32);
+static void (*Perl_pop_scope)(pTHX);
+static void (*Perl_push_scope)(pTHX);
+static void (*Perl_save_int)(pTHX_ int*);
+static SV** (*Perl_stack_grow)(pTHX_ SV**, SV**p, int);
+static SV** (*Perl_set_context)(void*);
+static bool (*Perl_sv_2bool)(pTHX_ SV*);
+static IV (*Perl_sv_2iv)(pTHX_ SV*);
+static SV* (*Perl_sv_2mortal)(pTHX_ SV*);
+#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+static char* (*Perl_sv_2pv_flags)(pTHX_ SV*, STRLEN*, I32);
+static char* (*Perl_sv_2pv_nolen)(pTHX_ SV*);
+#else
+static char* (*Perl_sv_2pv)(pTHX_ SV*, STRLEN*);
+#endif
+static SV* (*Perl_sv_bless)(pTHX_ SV*, HV*);
+#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+static void (*Perl_sv_catpvn_flags)(pTHX_ SV* , const char*, STRLEN, I32);
+#else
+static void (*Perl_sv_catpvn)(pTHX_ SV*, const char*, STRLEN);
+#endif
+static void (*Perl_sv_free)(pTHX_ SV*);
+static int (*Perl_sv_isa)(pTHX_ SV*, const char*);
+static void (*Perl_sv_magic)(pTHX_ SV*, SV*, int, const char*, I32);
+static void (*Perl_sv_setiv)(pTHX_ SV*, IV);
+static void (*Perl_sv_setpv)(pTHX_ SV*, const char*);
+static void (*Perl_sv_setpvn)(pTHX_ SV*, const char*, STRLEN);
+#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+static void (*Perl_sv_setsv_flags)(pTHX_ SV*, SV*, I32);
+#else
+static void (*Perl_sv_setsv)(pTHX_ SV*, SV*);
+#endif
+static bool (*Perl_sv_upgrade)(pTHX_ SV*, U32);
+static SV*** (*Perl_Tstack_sp_ptr)(register PerlInterpreter*);
+static OP** (*Perl_Top_ptr)(register PerlInterpreter*);
+static SV*** (*Perl_Tstack_base_ptr)(register PerlInterpreter*);
+static SV*** (*Perl_Tstack_max_ptr)(register PerlInterpreter*);
+static I32* (*Perl_Ttmps_ix_ptr)(register PerlInterpreter*);
+static I32* (*Perl_Ttmps_floor_ptr)(register PerlInterpreter*);
+static I32** (*Perl_Tmarkstack_ptr_ptr)(register PerlInterpreter*);
+static I32** (*Perl_Tmarkstack_max_ptr)(register PerlInterpreter*);
+static SV** (*Perl_TSv_ptr)(register PerlInterpreter*);
+static XPV** (*Perl_TXpv_ptr)(register PerlInterpreter*);
+static STRLEN* (*Perl_Tna_ptr)(register PerlInterpreter*);
+static GV** (*Perl_Idefgv_ptr)(register PerlInterpreter*);
+static GV** (*Perl_Ierrgv_ptr)(register PerlInterpreter*);
+static SV* (*Perl_Isv_yes_ptr)(register PerlInterpreter*);
+static void (*boot_DynaLoader)_((pTHX_ CV*));
+
+
+/*
+ * Table of name to function pointer of perl.
+ */
+#define PERL_PROC FARPROC
+static struct {
+    char* name;
+    PERL_PROC* ptr;
+} perl_funcname_table[] = {
+    {"perl_alloc", (PERL_PROC*)&perl_alloc},
+    {"perl_construct", (PERL_PROC*)&perl_construct},
+    {"perl_destruct", (PERL_PROC*)&perl_destruct},
+    {"perl_free", (PERL_PROC*)&perl_free},
+    {"perl_run", (PERL_PROC*)&perl_run},
+    {"perl_parse", (PERL_PROC*)&perl_parse},
+    {"Perl_get_context", (PERL_PROC*)&Perl_get_context},
+    {"Perl_croak", (PERL_PROC*)&Perl_croak},
+    {"Perl_croak_nocontext", (PERL_PROC*)&Perl_croak_nocontext},
+    {"Perl_dowantarray", (PERL_PROC*)&Perl_dowantarray},
+    {"Perl_free_tmps", (PERL_PROC*)&Perl_free_tmps},
+    {"Perl_gv_stashpv", (PERL_PROC*)&Perl_gv_stashpv},
+    {"Perl_markstack_grow", (PERL_PROC*)&Perl_markstack_grow},
+    {"Perl_mg_find", (PERL_PROC*)&Perl_mg_find},
+    {"Perl_newXS", (PERL_PROC*)&Perl_newXS},
+    {"Perl_newSV", (PERL_PROC*)&Perl_newSV},
+    {"Perl_newSViv", (PERL_PROC*)&Perl_newSViv},
+    {"Perl_newSVpv", (PERL_PROC*)&Perl_newSVpv},
+    {"Perl_call_argv", (PERL_PROC*)&Perl_call_argv},
+    {"Perl_call_pv", (PERL_PROC*)&Perl_call_pv},
+    {"Perl_eval_sv", (PERL_PROC*)&Perl_eval_sv},
+    {"Perl_get_sv", (PERL_PROC*)&Perl_get_sv},
+    {"Perl_eval_pv", (PERL_PROC*)&Perl_eval_pv},
+    {"Perl_call_method", (PERL_PROC*)&Perl_call_method},
+    {"Perl_pop_scope", (PERL_PROC*)&Perl_pop_scope},
+    {"Perl_push_scope", (PERL_PROC*)&Perl_push_scope},
+    {"Perl_save_int", (PERL_PROC*)&Perl_save_int},
+    {"Perl_stack_grow", (PERL_PROC*)&Perl_stack_grow},
+    {"Perl_set_context", (PERL_PROC*)&Perl_set_context},
+    {"Perl_sv_2bool", (PERL_PROC*)&Perl_sv_2bool},
+    {"Perl_sv_2iv", (PERL_PROC*)&Perl_sv_2iv},
+    {"Perl_sv_2mortal", (PERL_PROC*)&Perl_sv_2mortal},
+#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+    {"Perl_sv_2pv_flags", (PERL_PROC*)&Perl_sv_2pv_flags},
+    {"Perl_sv_2pv_nolen", (PERL_PROC*)&Perl_sv_2pv_nolen},
+#else
+    {"Perl_sv_2pv", (PERL_PROC*)&Perl_sv_2pv},
+#endif
+    {"Perl_sv_bless", (PERL_PROC*)&Perl_sv_bless},
+#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+    {"Perl_sv_catpvn_flags", (PERL_PROC*)&Perl_sv_catpvn_flags},
+#else
+    {"Perl_sv_catpvn", (PERL_PROC*)&Perl_sv_catpvn},
+#endif
+    {"Perl_sv_free", (PERL_PROC*)&Perl_sv_free},
+    {"Perl_sv_isa", (PERL_PROC*)&Perl_sv_isa},
+    {"Perl_sv_magic", (PERL_PROC*)&Perl_sv_magic},
+    {"Perl_sv_setiv", (PERL_PROC*)&Perl_sv_setiv},
+    {"Perl_sv_setpv", (PERL_PROC*)&Perl_sv_setpv},
+    {"Perl_sv_setpvn", (PERL_PROC*)&Perl_sv_setpvn},
+#if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+    {"Perl_sv_setsv_flags", (PERL_PROC*)&Perl_sv_setsv_flags},
+#else
+    {"Perl_sv_setsv", (PERL_PROC*)&Perl_sv_setsv},
+#endif
+    {"Perl_sv_upgrade", (PERL_PROC*)&Perl_sv_upgrade},
+    {"Perl_Tstack_sp_ptr", (PERL_PROC*)&Perl_Tstack_sp_ptr},
+    {"Perl_Top_ptr", (PERL_PROC*)&Perl_Top_ptr},
+    {"Perl_Tstack_base_ptr", (PERL_PROC*)&Perl_Tstack_base_ptr},
+    {"Perl_Tstack_max_ptr", (PERL_PROC*)&Perl_Tstack_max_ptr},
+    {"Perl_Ttmps_ix_ptr", (PERL_PROC*)&Perl_Ttmps_ix_ptr},
+    {"Perl_Ttmps_floor_ptr", (PERL_PROC*)&Perl_Ttmps_floor_ptr},
+    {"Perl_Tmarkstack_ptr_ptr", (PERL_PROC*)&Perl_Tmarkstack_ptr_ptr},
+    {"Perl_Tmarkstack_max_ptr", (PERL_PROC*)&Perl_Tmarkstack_max_ptr},
+    {"Perl_TSv_ptr", (PERL_PROC*)&Perl_TSv_ptr},
+    {"Perl_TXpv_ptr", (PERL_PROC*)&Perl_TXpv_ptr},
+    {"Perl_Tna_ptr", (PERL_PROC*)&Perl_Tna_ptr},
+    {"Perl_Idefgv_ptr", (PERL_PROC*)&Perl_Idefgv_ptr},
+    {"Perl_Ierrgv_ptr", (PERL_PROC*)&Perl_Ierrgv_ptr},
+    {"Perl_Isv_yes_ptr", (PERL_PROC*)&Perl_Isv_yes_ptr},
+    {"boot_DynaLoader", (PERL_PROC*)&boot_DynaLoader},
+    {"", NULL},
+};
+
+/*
+ * Make all runtime-links of perl.
+ *
+ * 1. Get module handle using LoadLibraryEx.
+ * 2. Get pointer to perl function by GetProcAddress.
+ * 3. Repeat 2, until get all functions will be used.
+ *
+ * Parameter 'libname' provides name of DLL.
+ * Return OK or FAIL.
+ */
+    static int
+perl_runtime_link_init(char *libname, int verbose)
+{
+    int i;
+
+    if (hPerlLib != NULL)
+	return OK;
+    if (!(hPerlLib = LoadLibraryEx(libname, NULL, 0)))
+    {
+	if (verbose)
+	    EMSG2(_("E370: Could not load library %s"), libname);
+	return FAIL;
+    }
+    for (i = 0; perl_funcname_table[i].ptr; ++i)
+    {
+	if (!(*perl_funcname_table[i].ptr = GetProcAddress(hPerlLib,
+			perl_funcname_table[i].name)))
+	{
+	    FreeLibrary(hPerlLib);
+	    hPerlLib = NULL;
+	    if (verbose)
+		EMSG2(_(e_loadfunc), perl_funcname_table[i].name);
+	    return FAIL;
+	}
+    }
+    return OK;
+}
+
+/*
+ * If runtime-link-perl(DLL) was loaded successfully, return TRUE.
+ * There were no DLL loaded, return FALSE.
+ */
+    int
+perl_enabled(verbose)
+    int		verbose;
+{
+    return perl_runtime_link_init(DYNAMIC_PERL_DLL, verbose) == OK;
+}
+#endif /* DYNAMIC_PERL */
+
+/*
+ * perl_init(): initialize perl interpreter
+ * We have to call perl_parse to initialize some structures,
+ * there's nothing to actually parse.
+ */
+    static void
+perl_init()
+{
+    char	*bootargs[] = { "VI", NULL };
+    static char *args[] = { "", "-e", "" };
+
+    perl_interp = perl_alloc();
+    perl_construct(perl_interp);
+    perl_parse(perl_interp, xs_init, 3, args, 0);
+    perl_call_argv("VIM::bootstrap", (long)G_DISCARD, bootargs);
+    VIM_init();
+#ifdef USE_SFIO
+    sfdisc(PerlIO_stdout(), sfdcnewvim());
+    sfdisc(PerlIO_stderr(), sfdcnewvim());
+    sfsetbuf(PerlIO_stdout(), NULL, 0);
+    sfsetbuf(PerlIO_stderr(), NULL, 0);
+#endif
+}
+
+/*
+ * perl_end(): clean up after ourselves
+ */
+    void
+perl_end()
+{
+    if (perl_interp)
+    {
+	perl_run(perl_interp);
+	perl_destruct(perl_interp);
+	perl_free(perl_interp);
+	perl_interp = NULL;
+    }
+#ifdef DYNAMIC_PERL
+    if (hPerlLib)
+    {
+	FreeLibrary(hPerlLib);
+	hPerlLib = NULL;
+    }
+#endif
+}
+
+/*
+ * msg_split(): send a message to the message handling routines
+ * split at '\n' first though.
+ */
+    void
+msg_split(s, attr)
+    char_u	*s;
+    int		attr;	/* highlighting attributes */
+{
+    char *next;
+    char *token = (char *)s;
+
+    while ((next = strchr(token, '\n')))
+    {
+	*next++ = '\0';			/* replace \n with \0 */
+	msg_attr((char_u *)token, attr);
+	token = next;
+    }
+    if (*token)
+	msg_attr((char_u *)token, attr);
+}
+
+#ifndef FEAT_EVAL
+/*
+ * This stub is needed because an "#ifdef FEAT_EVAL" around Eval() doesn't
+ * work properly.
+ */
+    char_u *
+eval_to_string(arg, nextcmd)
+    char_u	*arg;
+    char_u	**nextcmd;
+{
+    return NULL;
+}
+#endif
+
+/*
+ * Create a new reference to an SV pointing to the SCR structure
+ * The perl_private part of the SCR structure points to the SV,
+ * so there can only be one such SV for a particular SCR structure.
+ * When the last reference has gone (DESTROY is called),
+ * perl_private is reset; When the screen goes away before
+ * all references are gone, the value of the SV is reset;
+ * any subsequent use of any of those reference will produce
+ * a warning. (see typemap)
+ */
+#define newANYrv(TYPE, TNAME)					\
+static SV *							\
+new ## TNAME ## rv(rv, ptr)					\
+    SV *rv;							\
+    TYPE *ptr;							\
+{								\
+    sv_upgrade(rv, SVt_RV);					\
+    if (!ptr->perl_private)					\
+    {								\
+	ptr->perl_private = newSV(0);				\
+	sv_setiv(ptr->perl_private, (IV)ptr);			\
+    }								\
+    else							\
+	SvREFCNT_inc(ptr->perl_private);			\
+    SvRV(rv) = ptr->perl_private;				\
+    SvROK_on(rv);						\
+    return sv_bless(rv, gv_stashpv("VI" #TNAME, TRUE));		\
+}
+
+newANYrv(win_T, WIN)
+newANYrv(buf_T, BUF)
+
+/*
+ * perl_win_free
+ *	Remove all refences to the window to be destroyed
+ */
+    void
+perl_win_free(wp)
+    win_T *wp;
+{
+    if (wp->perl_private)
+	sv_setiv((SV *)wp->perl_private, 0);
+    return;
+}
+
+    void
+perl_buf_free(bp)
+    buf_T *bp;
+{
+    if (bp->perl_private)
+	sv_setiv((SV *)bp->perl_private, 0);
+    return;
+}
+
+#ifndef PROTO
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+I32 cur_val(pTHX_ IV iv, SV *sv);
+# else
+I32 cur_val(IV iv, SV *sv);
+#endif
+
+/*
+ * Handler for the magic variables $main::curwin and $main::curbuf.
+ * The handler is put into the magic vtbl for these variables.
+ * (This is effectively a C-level equivalent of a tied variable).
+ * There is no "set" function as the variables are read-only.
+ */
+# if (PERL_REVISION == 5) && (PERL_VERSION >= 8)
+I32 cur_val(pTHX_ IV iv, SV *sv)
+# else
+I32 cur_val(IV iv, SV *sv)
+# endif
+{
+    SV *rv;
+    if (iv == 0)
+	rv = newWINrv(newSV(0), curwin);
+    else
+	rv = newBUFrv(newSV(0), curbuf);
+    sv_setsv(sv, rv);
+    return 0;
+}
+#endif /* !PROTO */
+
+struct ufuncs cw_funcs = { cur_val, 0, 0 };
+struct ufuncs cb_funcs = { cur_val, 0, 1 };
+
+/*
+ * VIM_init(): Vim-specific initialisation.
+ * Make the magical main::curwin and main::curbuf variables
+ */
+    static void
+VIM_init()
+{
+    static char cw[] = "main::curwin";
+    static char cb[] = "main::curbuf";
+    SV *sv;
+
+    sv = perl_get_sv(cw, TRUE);
+    sv_magic(sv, NULL, 'U', (char *)&cw_funcs, sizeof(cw_funcs));
+    SvREADONLY_on(sv);
+
+    sv = perl_get_sv(cb, TRUE);
+    sv_magic(sv, NULL, 'U', (char *)&cb_funcs, sizeof(cb_funcs));
+    SvREADONLY_on(sv);
+
+    /*
+     * Setup the Safe compartment.
+     * It shouldn't be a fatal error if the Safe module is missing.
+     * XXX: Only shares the 'Msg' routine (which has to be called
+     * like 'Msg(...)').
+     */
+    (void)perl_eval_pv( "if ( eval( 'require Safe' ) ) { $VIM::safe = Safe->new(); $VIM::safe->share_from( 'VIM', ['Msg'] ); }", G_DISCARD | G_VOID );
+
+}
+
+#ifdef DYNAMIC_PERL
+static char *e_noperl = N_("Sorry, this command is disabled: the Perl library could not be loaded.");
+#endif
+
+/*
+ * ":perl"
+ */
+    void
+ex_perl(eap)
+    exarg_T	*eap;
+{
+    char	*err;
+    char	*script;
+    STRLEN	length;
+    SV		*sv;
+    SV		*safe;
+
+    script = (char *)script_get(eap, eap->arg);
+    if (eap->skip)
+    {
+	vim_free(script);
+	return;
+    }
+
+    if (perl_interp == NULL)
+    {
+#ifdef DYNAMIC_PERL
+	if (!perl_enabled(TRUE))
+	{
+	    EMSG(_(e_noperl));
+	    vim_free(script);
+	    return;
+	}
+#endif
+	perl_init();
+    }
+
+    {
+    dSP;
+    ENTER;
+    SAVETMPS;
+
+    if (script == NULL)
+	sv = newSVpv((char *)eap->arg, 0);
+    else
+    {
+	sv = newSVpv(script, 0);
+	vim_free(script);
+    }
+
+#ifdef HAVE_SANDBOX
+    if (sandbox)
+    {
+	if ((safe = perl_get_sv( "VIM::safe", FALSE )) == NULL || !SvTRUE(safe))
+	    EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
+	else
+	{
+	    PUSHMARK(SP);
+	    XPUSHs(safe);
+	    XPUSHs(sv);
+	    PUTBACK;
+	    perl_call_method("reval", G_DISCARD);
+	}
+    }
+    else
+#endif
+	perl_eval_sv(sv, G_DISCARD | G_NOARGS);
+
+    SvREFCNT_dec(sv);
+
+    err = SvPV(GvSV(PL_errgv), length);
+
+    FREETMPS;
+    LEAVE;
+
+    if (!length)
+	return;
+
+    msg_split((char_u *)err, highlight_attr[HLF_E]);
+    return;
+    }
+}
+
+    static int
+replace_line(line, end)
+    linenr_T	*line, *end;
+{
+    char *str;
+
+    if (SvOK(GvSV(PL_defgv)))
+    {
+	str = SvPV(GvSV(PL_defgv), PL_na);
+	ml_replace(*line, (char_u *)str, 1);
+	changed_bytes(*line, 0);
+    }
+    else
+    {
+	ml_delete(*line, FALSE);
+	deleted_lines_mark(*line, 1L);
+	--(*end);
+	--(*line);
+    }
+    return OK;
+}
+
+/*
+ * ":perldo".
+ */
+    void
+ex_perldo(eap)
+    exarg_T	*eap;
+{
+    STRLEN	length;
+    SV		*sv;
+    char	*str;
+    linenr_T	i;
+
+    if (bufempty())
+	return;
+
+    if (perl_interp == NULL)
+    {
+#ifdef DYNAMIC_PERL
+	if (!perl_enabled(TRUE))
+	{
+	    EMSG(_(e_noperl));
+	    return;
+	}
+#endif
+	perl_init();
+    }
+    {
+    dSP;
+    length = strlen((char *)eap->arg);
+    sv = newSV(length + sizeof("sub VIM::perldo {")-1 + 1);
+    sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {")-1);
+    sv_catpvn(sv, (char *)eap->arg, length);
+    sv_catpvn(sv, "}", 1);
+    perl_eval_sv(sv, G_DISCARD | G_NOARGS);
+    SvREFCNT_dec(sv);
+    str = SvPV(GvSV(PL_errgv), length);
+    if (length)
+	goto err;
+
+    if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
+	return;
+
+    ENTER;
+    SAVETMPS;
+    for (i = eap->line1; i <= eap->line2; i++)
+    {
+	sv_setpv(GvSV(PL_defgv),(char *)ml_get(i));
+	PUSHMARK(sp);
+	perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
+	str = SvPV(GvSV(PL_errgv), length);
+	if (length)
+	    break;
+	SPAGAIN;
+	if (SvTRUEx(POPs))
+	{
+	    if (replace_line(&i, &eap->line2) != OK)
+	    {
+		PUTBACK;
+		break;
+	    }
+	}
+	PUTBACK;
+    }
+    FREETMPS;
+    LEAVE;
+    check_cursor();
+    update_screen(NOT_VALID);
+    if (!length)
+	return;
+
+err:
+    msg_split((char_u *)str, highlight_attr[HLF_E]);
+    return;
+    }
+}
+
+XS(XS_VIM_Msg);
+XS(XS_VIM_SetOption);
+XS(XS_VIM_DoCommand);
+XS(XS_VIM_Eval);
+XS(XS_VIM_Buffers);
+XS(XS_VIM_Windows);
+XS(XS_VIWIN_DESTROY);
+XS(XS_VIWIN_Buffer);
+XS(XS_VIWIN_SetHeight);
+XS(XS_VIWIN_Cursor);
+XS(XS_VIBUF_DESTROY);
+XS(XS_VIBUF_Name);
+XS(XS_VIBUF_Number);
+XS(XS_VIBUF_Count);
+XS(XS_VIBUF_Get);
+XS(XS_VIBUF_Set);
+XS(XS_VIBUF_Delete);
+XS(XS_VIBUF_Append);
+XS(boot_VIM);
+
+    static void
+xs_init(pTHX)
+{
+    char *file = __FILE__;
+
+    /* DynaLoader is a special case */
+    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+    newXS("VIM::bootstrap", boot_VIM, file);
+}
+
+typedef win_T *	VIWIN;
+typedef buf_T *	VIBUF;
+
+MODULE = VIM	    PACKAGE = VIM
+
+void
+Msg(text, hl=NULL)
+    char	*text;
+    char	*hl;
+
+    PREINIT:
+    int		attr;
+    int		id;
+
+    PPCODE:
+    if (text != NULL)
+    {
+	attr = 0;
+	if (hl != NULL)
+	{
+	    id = syn_name2id((char_u *)hl);
+	    if (id != 0)
+		attr = syn_id2attr(id);
+	}
+	msg_split((char_u *)text, attr);
+    }
+
+void
+SetOption(line)
+    char *line;
+
+    PPCODE:
+    if (line != NULL)
+	do_set((char_u *)line, 0);
+    update_screen(NOT_VALID);
+
+void
+DoCommand(line)
+    char *line;
+
+    PPCODE:
+    if (line != NULL)
+	do_cmdline_cmd((char_u *)line);
+
+void
+Eval(str)
+    char *str;
+
+    PREINIT:
+	char_u *value;
+    PPCODE:
+	value = eval_to_string((char_u *)str, (char_u**)0);
+	if (value == NULL)
+	{
+	    XPUSHs(sv_2mortal(newSViv(0)));
+	    XPUSHs(sv_2mortal(newSVpv("", 0)));
+	}
+	else
+	{
+	    XPUSHs(sv_2mortal(newSViv(1)));
+	    XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
+	    vim_free(value);
+	}
+
+void
+Buffers(...)
+
+    PREINIT:
+    buf_T *vimbuf;
+    int i, b;
+
+    PPCODE:
+    if (items == 0)
+    {
+	if (GIMME == G_SCALAR)
+	{
+	    i = 0;
+	    for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
+		++i;
+
+	    XPUSHs(sv_2mortal(newSViv(i)));
+	}
+	else
+	{
+	    for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
+		XPUSHs(newBUFrv(newSV(0), vimbuf));
+	}
+    }
+    else
+    {
+	for (i = 0; i < items; i++)
+	{
+	    SV *sv = ST(i);
+	    if (SvIOK(sv))
+		b = SvIV(ST(i));
+	    else
+	    {
+		char_u *pat;
+		STRLEN len;
+
+		pat = (char_u *)SvPV(sv, len);
+		++emsg_off;
+		b = buflist_findpat(pat, pat+len, FALSE, FALSE);
+		--emsg_off;
+	    }
+
+	    if (b >= 0)
+	    {
+		vimbuf = buflist_findnr(b);
+		if (vimbuf)
+		    XPUSHs(newBUFrv(newSV(0), vimbuf));
+	    }
+	}
+    }
+
+void
+Windows(...)
+
+    PREINIT:
+    win_T   *vimwin;
+    int	    i, w;
+
+    PPCODE:
+    if (items == 0)
+    {
+	if (GIMME == G_SCALAR)
+	    XPUSHs(sv_2mortal(newSViv(win_count())));
+	else
+	{
+	    for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
+		XPUSHs(newWINrv(newSV(0), vimwin));
+	}
+    }
+    else
+    {
+	for (i = 0; i < items; i++)
+	{
+	    w = SvIV(ST(i));
+	    vimwin = win_find_nr(w);
+	    if (vimwin)
+		XPUSHs(newWINrv(newSV(0), vimwin));
+	}
+    }
+
+MODULE = VIM	    PACKAGE = VIWIN
+
+void
+DESTROY(win)
+    VIWIN win
+
+    CODE:
+    if (win_valid(win))
+	win->perl_private = 0;
+
+SV *
+Buffer(win)
+    VIWIN win
+
+    CODE:
+    if (!win_valid(win))
+	win = curwin;
+    RETVAL = newBUFrv(newSV(0), win->w_buffer);
+    OUTPUT:
+    RETVAL
+
+void
+SetHeight(win, height)
+    VIWIN win
+    int height;
+
+    PREINIT:
+    win_T *savewin;
+
+    PPCODE:
+    if (!win_valid(win))
+	win = curwin;
+    savewin = curwin;
+    curwin = win;
+    win_setheight(height);
+    curwin = savewin;
+
+void
+Cursor(win, ...)
+    VIWIN win
+
+    PPCODE:
+    if(items == 1)
+    {
+      EXTEND(sp, 2);
+      if (!win_valid(win))
+	  win = curwin;
+      PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
+      PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
+    }
+    else if(items == 3)
+    {
+      int lnum, col;
+
+      if (!win_valid(win))
+	  win = curwin;
+      lnum = SvIV(ST(1));
+      col = SvIV(ST(2));
+      win->w_cursor.lnum = lnum;
+      win->w_cursor.col = col;
+      check_cursor();		    /* put cursor on an existing line */
+      update_screen(NOT_VALID);
+    }
+
+MODULE = VIM	    PACKAGE = VIBUF
+
+void
+DESTROY(vimbuf)
+    VIBUF vimbuf;
+
+    CODE:
+    if (buf_valid(vimbuf))
+	vimbuf->perl_private = 0;
+
+void
+Name(vimbuf)
+    VIBUF vimbuf;
+
+    PPCODE:
+    if (!buf_valid(vimbuf))
+	vimbuf = curbuf;
+    /* No file name returns an empty string */
+    if (vimbuf->b_fname == NULL)
+	XPUSHs(sv_2mortal(newSVpv("", 0)));
+    else
+	XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
+
+void
+Number(vimbuf)
+    VIBUF vimbuf;
+
+    PPCODE:
+    if (!buf_valid(vimbuf))
+	vimbuf = curbuf;
+    XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
+
+void
+Count(vimbuf)
+    VIBUF vimbuf;
+
+    PPCODE:
+    if (!buf_valid(vimbuf))
+	vimbuf = curbuf;
+    XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
+
+void
+Get(vimbuf, ...)
+    VIBUF vimbuf;
+
+    PREINIT:
+    char_u *line;
+    int i;
+    long lnum;
+    PPCODE:
+    if (buf_valid(vimbuf))
+    {
+	for (i = 1; i < items; i++)
+	{
+	    lnum = SvIV(ST(i));
+	    if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
+	    {
+		line = ml_get_buf(vimbuf, lnum, FALSE);
+		XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
+	    }
+	}
+    }
+
+void
+Set(vimbuf, ...)
+    VIBUF vimbuf;
+
+    PREINIT:
+    int i;
+    long lnum;
+    char *line;
+    buf_T *savebuf;
+    PPCODE:
+    if (buf_valid(vimbuf))
+    {
+	if (items < 3)
+	    croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
+
+	lnum = SvIV(ST(1));
+	for(i = 2; i < items; i++, lnum++)
+	{
+	    line = SvPV(ST(i),PL_na);
+	    if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
+	    {
+		savebuf = curbuf;
+		curbuf = vimbuf;
+		if (u_savesub(lnum) == OK)
+		{
+		    ml_replace(lnum, (char_u *)line, TRUE);
+		    changed_bytes(lnum, 0);
+		}
+		curbuf = savebuf;
+	    }
+	}
+    }
+
+void
+Delete(vimbuf, ...)
+    VIBUF vimbuf;
+
+    PREINIT:
+    long i, lnum = 0, count = 0;
+    buf_T *savebuf;
+    PPCODE:
+    if (buf_valid(vimbuf))
+    {
+	if (items == 2)
+	{
+	    lnum = SvIV(ST(1));
+	    count = 1;
+	}
+	else if (items == 3)
+	{
+	    lnum = SvIV(ST(1));
+	    count = 1 + SvIV(ST(2)) - lnum;
+	    if(count == 0)
+		count = 1;
+	    if(count < 0)
+	    {
+		lnum -= count;
+		count = -count;
+	    }
+	}
+	if (items >= 2)
+	{
+	    for (i = 0; i < count; i++)
+	    {
+		if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
+		{
+		    savebuf = curbuf;
+		    curbuf = vimbuf;
+		    if (u_savedel(lnum, 1) == OK)
+		    {
+			ml_delete(lnum, 0);
+			deleted_lines_mark(lnum, 1L);
+			if (savebuf == curbuf)
+			    check_cursor();
+		    }
+		    curbuf = savebuf;
+		    update_curbuf(VALID);
+		}
+	    }
+	}
+    }
+
+void
+Append(vimbuf, ...)
+    VIBUF vimbuf;
+
+    PREINIT:
+    int		i;
+    long	lnum;
+    char	*line;
+    buf_T	*savebuf;
+    PPCODE:
+    if (buf_valid(vimbuf))
+    {
+	if (items < 3)
+	    croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
+
+	lnum = SvIV(ST(1));
+	for (i = 2; i < items; i++, lnum++)
+	{
+	    line = SvPV(ST(i),PL_na);
+	    if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
+	    {
+		savebuf = curbuf;
+		curbuf = vimbuf;
+		if (u_inssub(lnum + 1) == OK)
+		{
+		    ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
+		    appended_lines_mark(lnum, 1L);
+		}
+		curbuf = savebuf;
+		update_curbuf(VALID);
+	    }
+	}
+    }
+