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