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 # ifndef MAKE_TEST  /* avoid a warning for unreachable code */
 724         if ((safe = perl_get_sv( "VIM::safe", FALSE )) == NULL || !SvTRUE(safe))
 725             EMSG(_("E299: Perl evaluation forbidden in sandbox without the Safe module"));
 726         else
 727 # endif
 728         {
 729             PUSHMARK(SP);
 730             XPUSHs(safe);
 731             XPUSHs(sv);
 732             PUTBACK;
 733             perl_call_method("reval", G_DISCARD);
 734         }
 735     }
 736     else
 737 #endif
 738         perl_eval_sv(sv, G_DISCARD | G_NOARGS);
 739
 740     SvREFCNT_dec(sv);
 741
 742     err = SvPV(GvSV(PL_errgv), length);
 743
 744     FREETMPS;
 745     LEAVE;
 746
 747     if (!length)
 748         return;
 749
 750     msg_split((char_u *)err, highlight_attr[HLF_E]);
 751     return;
 752     }
 753 }
 754
 755     static int
 756 replace_line(line, end)
 757     linenr_T    *line, *end;
 758 {
 759     char *str;
 760
 761     if (SvOK(GvSV(PL_defgv)))
 762     {
 763         str = SvPV(GvSV(PL_defgv), PL_na);
 764         ml_replace(*line, (char_u *)str, 1);
 765         changed_bytes(*line, 0);
 766     }
 767     else
 768     {
 769         ml_delete(*line, FALSE);
 770         deleted_lines_mark(*line, 1L);
 771         --(*end);
 772         --(*line);
 773     }
 774     return OK;
 775 }
 776
 777 /*
 778  * ":perldo".
 779  */
 780     void
 781 ex_perldo(eap)
 782     exarg_T     *eap;
 783 {
 784     STRLEN      length;
 785     SV          *sv;
 786     char        *str;
 787     linenr_T    i;
 788
 789     if (bufempty())
 790         return;
 791
 792     if (perl_interp == NULL)
 793     {
 794 #ifdef DYNAMIC_PERL
 795         if (!perl_enabled(TRUE))
 796         {
 797             EMSG(_(e_noperl));
 798             return;
 799         }
 800 #endif
 801         perl_init();
 802     }
 803     {
 804     dSP;
 805     length = strlen((char *)eap->arg);
 806     sv = newSV(length + sizeof("sub VIM::perldo {") - 1 + 1);
 807     sv_setpvn(sv, "sub VIM::perldo {", sizeof("sub VIM::perldo {") - 1);
 808     sv_catpvn(sv, (char *)eap->arg, length);
 809     sv_catpvn(sv, "}", 1);
 810     perl_eval_sv(sv, G_DISCARD | G_NOARGS);
 811     SvREFCNT_dec(sv);
 812     str = SvPV(GvSV(PL_errgv), length);
 813     if (length)
 814         goto err;
 815
 816     if (u_save(eap->line1 - 1, eap->line2 + 1) != OK)
 817         return;
 818
 819     ENTER;
 820     SAVETMPS;
 821     for (i = eap->line1; i <= eap->line2; i++)
 822     {
 823         sv_setpv(GvSV(PL_defgv), (char *)ml_get(i));
 824         PUSHMARK(sp);
 825         perl_call_pv("VIM::perldo", G_SCALAR | G_EVAL);
 826         str = SvPV(GvSV(PL_errgv), length);
 827         if (length)
 828             break;
 829         SPAGAIN;
 830         if (SvTRUEx(POPs))
 831         {
 832             if (replace_line(&i, &eap->line2) != OK)
 833             {
 834                 PUTBACK;
 835                 break;
 836             }
 837         }
 838         PUTBACK;
 839     }
 840     FREETMPS;
 841     LEAVE;
 842     check_cursor();
 843     update_screen(NOT_VALID);
 844     if (!length)
 845         return;
 846
 847 err:
 848     msg_split((char_u *)str, highlight_attr[HLF_E]);
 849     return;
 850     }
 851 }
 852
 853 #ifndef FEAT_WINDOWS
 854 int win_valid(win_T *w) { return TRUE; }
 855 int win_count() { return 1; }
 856 win_T *win_find_nr(int n) { return curwin; }
 857 #endif
 858
 859 XS(XS_VIM_Msg);
 860 XS(XS_VIM_SetOption);
 861 XS(XS_VIM_DoCommand);
 862 XS(XS_VIM_Eval);
 863 XS(XS_VIM_Buffers);
 864 XS(XS_VIM_Windows);
 865 XS(XS_VIWIN_DESTROY);
 866 XS(XS_VIWIN_Buffer);
 867 XS(XS_VIWIN_SetHeight);
 868 XS(XS_VIWIN_Cursor);
 869 XS(XS_VIBUF_DESTROY);
 870 XS(XS_VIBUF_Name);
 871 XS(XS_VIBUF_Number);
 872 XS(XS_VIBUF_Count);
 873 XS(XS_VIBUF_Get);
 874 XS(XS_VIBUF_Set);
 875 XS(XS_VIBUF_Delete);
 876 XS(XS_VIBUF_Append);
 877 XS(boot_VIM);
 878
 879     static void
 880 xs_init(pTHX)
 881 {
 882     char *file = __FILE__;
 883
 884     /* DynaLoader is a special case */
 885     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 886     newXS("VIM::bootstrap", boot_VIM, file);
 887 }
 888
 889 typedef win_T * VIWIN;
 890 typedef buf_T * VIBUF;
 891
 892 MODULE = VIM        PACKAGE = VIM
 893
 894 void
 895 Msg(text, hl=NULL)
 896     char        *text;
 897     char        *hl;
 898
 899     PREINIT:
 900     int         attr;
 901     int         id;
 902
 903     PPCODE:
 904     if (text != NULL)
 905     {
 906         attr = 0;
 907         if (hl != NULL)
 908         {
 909             id = syn_name2id((char_u *)hl);
 910             if (id != 0)
 911                 attr = syn_id2attr(id);
 912         }
 913         msg_split((char_u *)text, attr);
 914     }
 915
 916 void
 917 SetOption(line)
 918     char *line;
 919
 920     PPCODE:
 921     if (line != NULL)
 922         do_set((char_u *)line, 0);
 923     update_screen(NOT_VALID);
 924
 925 void
 926 DoCommand(line)
 927     char *line;
 928
 929     PPCODE:
 930     if (line != NULL)
 931         do_cmdline_cmd((char_u *)line);
 932
 933 void
 934 Eval(str)
 935     char *str;
 936
 937     PREINIT:
 938         char_u *value;
 939     PPCODE:
 940         value = eval_to_string((char_u *)str, (char_u **)0, TRUE);
 941         if (value == NULL)
 942         {
 943             XPUSHs(sv_2mortal(newSViv(0)));
 944             XPUSHs(sv_2mortal(newSVpv("", 0)));
 945         }
 946         else
 947         {
 948             XPUSHs(sv_2mortal(newSViv(1)));
 949             XPUSHs(sv_2mortal(newSVpv((char *)value, 0)));
 950             vim_free(value);
 951         }
 952
 953 void
 954 Buffers(...)
 955
 956     PREINIT:
 957     buf_T *vimbuf;
 958     int i, b;
 959
 960     PPCODE:
 961     if (items == 0)
 962     {
 963         if (GIMME == G_SCALAR)
 964         {
 965             i = 0;
 966             for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
 967                 ++i;
 968
 969             XPUSHs(sv_2mortal(newSViv(i)));
 970         }
 971         else
 972         {
 973             for (vimbuf = firstbuf; vimbuf; vimbuf = vimbuf->b_next)
 974                 XPUSHs(newBUFrv(newSV(0), vimbuf));
 975         }
 976     }
 977     else
 978     {
 979         for (i = 0; i < items; i++)
 980         {
 981             SV *sv = ST(i);
 982             if (SvIOK(sv))
 983                 b = SvIV(ST(i));
 984             else
 985             {
 986                 char_u *pat;
 987                 STRLEN len;
 988
 989                 pat = (char_u *)SvPV(sv, len);
 990                 ++emsg_off;
 991                 b = buflist_findpat(pat, pat+len, FALSE, FALSE);
 992                 --emsg_off;
 993             }
 994
 995             if (b >= 0)
 996             {
 997                 vimbuf = buflist_findnr(b);
 998                 if (vimbuf)
 999                     XPUSHs(newBUFrv(newSV(0), vimbuf));
1000             }
1001         }
1002     }
1003
1004 void
1005 Windows(...)
1006
1007     PREINIT:
1008     win_T   *vimwin;
1009     int     i, w;
1010
1011     PPCODE:
1012     if (items == 0)
1013     {
1014         if (GIMME == G_SCALAR)
1015             XPUSHs(sv_2mortal(newSViv(win_count())));
1016         else
1017         {
1018             for (vimwin = firstwin; vimwin != NULL; vimwin = W_NEXT(vimwin))
1019                 XPUSHs(newWINrv(newSV(0), vimwin));
1020         }
1021     }
1022     else
1023     {
1024         for (i = 0; i < items; i++)
1025         {
1026             w = SvIV(ST(i));
1027             vimwin = win_find_nr(w);
1028             if (vimwin)
1029                 XPUSHs(newWINrv(newSV(0), vimwin));
1030         }
1031     }
1032
1033 MODULE = VIM        PACKAGE = VIWIN
1034
1035 void
1036 DESTROY(win)
1037     VIWIN win
1038
1039     CODE:
1040     if (win_valid(win))
1041         win->w_perl_private = 0;
1042
1043 SV *
1044 Buffer(win)
1045     VIWIN win
1046
1047     CODE:
1048     if (!win_valid(win))
1049         win = curwin;
1050     RETVAL = newBUFrv(newSV(0), win->w_buffer);
1051     OUTPUT:
1052     RETVAL
1053
1054 void
1055 SetHeight(win, height)
1056     VIWIN win
1057     int height;
1058
1059     PREINIT:
1060     win_T *savewin;
1061
1062     PPCODE:
1063     if (!win_valid(win))
1064         win = curwin;
1065     savewin = curwin;
1066     curwin = win;
1067     win_setheight(height);
1068     curwin = savewin;
1069
1070 void
1071 Cursor(win, ...)
1072     VIWIN win
1073
1074     PPCODE:
1075     if(items == 1)
1076     {
1077       EXTEND(sp, 2);
1078       if (!win_valid(win))
1079           win = curwin;
1080       PUSHs(sv_2mortal(newSViv(win->w_cursor.lnum)));
1081       PUSHs(sv_2mortal(newSViv(win->w_cursor.col)));
1082     }
1083     else if(items == 3)
1084     {
1085       int lnum, col;
1086
1087       if (!win_valid(win))
1088           win = curwin;
1089       lnum = SvIV(ST(1));
1090       col = SvIV(ST(2));
1091       win->w_cursor.lnum = lnum;
1092       win->w_cursor.col = col;
1093       check_cursor();               /* put cursor on an existing line */
1094       update_screen(NOT_VALID);
1095     }
1096
1097 MODULE = VIM        PACKAGE = VIBUF
1098
1099 void
1100 DESTROY(vimbuf)
1101     VIBUF vimbuf;
1102
1103     CODE:
1104     if (buf_valid(vimbuf))
1105         vimbuf->b_perl_private = 0;
1106
1107 void
1108 Name(vimbuf)
1109     VIBUF vimbuf;
1110
1111     PPCODE:
1112     if (!buf_valid(vimbuf))
1113         vimbuf = curbuf;
1114     /* No file name returns an empty string */
1115     if (vimbuf->b_fname == NULL)
1116         XPUSHs(sv_2mortal(newSVpv("", 0)));
1117     else
1118         XPUSHs(sv_2mortal(newSVpv((char *)vimbuf->b_fname, 0)));
1119
1120 void
1121 Number(vimbuf)
1122     VIBUF vimbuf;
1123
1124     PPCODE:
1125     if (!buf_valid(vimbuf))
1126         vimbuf = curbuf;
1127     XPUSHs(sv_2mortal(newSViv(vimbuf->b_fnum)));
1128
1129 void
1130 Count(vimbuf)
1131     VIBUF vimbuf;
1132
1133     PPCODE:
1134     if (!buf_valid(vimbuf))
1135         vimbuf = curbuf;
1136     XPUSHs(sv_2mortal(newSViv(vimbuf->b_ml.ml_line_count)));
1137
1138 void
1139 Get(vimbuf, ...)
1140     VIBUF vimbuf;
1141
1142     PREINIT:
1143     char_u *line;
1144     int i;
1145     long lnum;
1146     PPCODE:
1147     if (buf_valid(vimbuf))
1148     {
1149         for (i = 1; i < items; i++)
1150         {
1151             lnum = SvIV(ST(i));
1152             if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1153             {
1154                 line = ml_get_buf(vimbuf, lnum, FALSE);
1155                 XPUSHs(sv_2mortal(newSVpv((char *)line, 0)));
1156             }
1157         }
1158     }
1159
1160 void
1161 Set(vimbuf, ...)
1162     VIBUF vimbuf;
1163
1164     PREINIT:
1165     int i;
1166     long lnum;
1167     char *line;
1168     PPCODE:
1169     if (buf_valid(vimbuf))
1170     {
1171         if (items < 3)
1172             croak("Usage: VIBUF::Set(vimbuf, lnum, @lines)");
1173
1174         lnum = SvIV(ST(1));
1175         for(i = 2; i < items; i++, lnum++)
1176         {
1177             line = SvPV(ST(i),PL_na);
1178             if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1179             {
1180                 aco_save_T      aco;
1181
1182                 /* set curwin/curbuf for "vimbuf" and save some things */
1183                 aucmd_prepbuf(&aco, vimbuf);
1184
1185                 if (u_savesub(lnum) == OK)
1186                 {
1187                     ml_replace(lnum, (char_u *)line, TRUE);
1188                     changed_bytes(lnum, 0);
1189                 }
1190
1191                 /* restore curwin/curbuf and a few other things */
1192                 aucmd_restbuf(&aco);
1193                 /* Careful: autocommands may have made "vimbuf" invalid! */
1194             }
1195         }
1196     }
1197
1198 void
1199 Delete(vimbuf, ...)
1200     VIBUF vimbuf;
1201
1202     PREINIT:
1203     long i, lnum = 0, count = 0;
1204     PPCODE:
1205     if (buf_valid(vimbuf))
1206     {
1207         if (items == 2)
1208         {
1209             lnum = SvIV(ST(1));
1210             count = 1;
1211         }
1212         else if (items == 3)
1213         {
1214             lnum = SvIV(ST(1));
1215             count = 1 + SvIV(ST(2)) - lnum;
1216             if(count == 0)
1217                 count = 1;
1218             if(count < 0)
1219             {
1220                 lnum -= count;
1221                 count = -count;
1222             }
1223         }
1224         if (items >= 2)
1225         {
1226             for (i = 0; i < count; i++)
1227             {
1228                 if (lnum > 0 && lnum <= vimbuf->b_ml.ml_line_count)
1229                 {
1230                     aco_save_T  aco;
1231
1232                     /* set curwin/curbuf for "vimbuf" and save some things */
1233                     aucmd_prepbuf(&aco, vimbuf);
1234
1235                     if (u_savedel(lnum, 1) == OK)
1236                     {
1237                         ml_delete(lnum, 0);
1238                         check_cursor();
1239                         deleted_lines_mark(lnum, 1L);
1240                     }
1241
1242                     /* restore curwin/curbuf and a few other things */
1243                     aucmd_restbuf(&aco);
1244                     /* Careful: autocommands may have made "vimbuf" invalid! */
1245
1246                     update_curbuf(VALID);
1247                 }
1248             }
1249         }
1250     }
1251
1252 void
1253 Append(vimbuf, ...)
1254     VIBUF vimbuf;
1255
1256     PREINIT:
1257     int         i;
1258     long        lnum;
1259     char        *line;
1260     PPCODE:
1261     if (buf_valid(vimbuf))
1262     {
1263         if (items < 3)
1264             croak("Usage: VIBUF::Append(vimbuf, lnum, @lines)");
1265
1266         lnum = SvIV(ST(1));
1267         for (i = 2; i < items; i++, lnum++)
1268         {
1269             line = SvPV(ST(i),PL_na);
1270             if (lnum >= 0 && lnum <= vimbuf->b_ml.ml_line_count && line != NULL)
1271             {
1272                 aco_save_T      aco;
1273
1274                 /* set curwin/curbuf for "vimbuf" and save some things */
1275                 aucmd_prepbuf(&aco, vimbuf);
1276
1277                 if (u_inssub(lnum + 1) == OK)
1278                 {
1279                     ml_append(lnum, (char_u *)line, (colnr_T)0, FALSE);
1280                     appended_lines_mark(lnum, 1L);
1281                 }
1282
1283                 /* restore curwin/curbuf and a few other things */
1284                 aucmd_restbuf(&aco);
1285                 /* Careful: autocommands may have made "vimbuf" invalid! */
1286
1287                 update_curbuf(VALID);
1288             }
1289         }
1290     }
1291