src/if_perl.xs

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