view src/if_mzsch.c @ 33581:403d57b06231 v9.0.2035

patch 9.0.2035: [security] use-after-free with wildmenu Commit: https://github.com/vim/vim/commit/8f4fb007e4d472b09ff6bed9ffa485e0c3093699 Author: Yee Cheng Chin <ychin.git@gmail.com> Date: Tue Oct 17 10:06:56 2023 +0200 patch 9.0.2035: [security] use-after-free with wildmenu Problem: [security] use-after-free with wildmenu Solution: properly clean up the wildmenu when exiting Fix wildchar/wildmenu/pum memory corruption with special wildchar's Currently, using `wildchar=<Esc>` or `wildchar=<C-\>` can lead to a memory corruption if using wildmenu+pum, or wrong states if only using wildmenu. This is due to the code only using one single place inside the cmdline process loop to perform wild menu clean up (by checking `end_wildmenu`) but there are other odd situations where the loop could have exited and we need a post-loop clean up just to be sure. If the clean up was not done you would have a stale popup menu referring to invalid memory, or if not using popup menu, incorrect status line (if `laststatus=0`). For example, if you hit `<Esc>` two times when it's wildchar, there's a hard-coded behavior to exit command-line as a failsafe for user, and if you hit `<C-\><C-\><C-N>` it will also exit command-line, but the clean up code would not have hit because of specialized `<C-\>` handling. Fix Ctrl-E / Ctrl-Y to not cancel/accept wildmenu if they are also used for 'wildchar'/'wildcharm'. Currently they don't behave properly, and also have potentially memory unsafe behavior as the logic is currently not accounting for this situation and try to do both. (Previous patch that addressed this: #11677) Also, correctly document Escape key behavior (double-hit it to escape) in wildchar docs as it's previously undocumented. In addition, block known invalid chars to be set in `wildchar` option, such as Ctrl-C and `<CR>`. This is just to make it clear to the user they shouldn't be set, and is not required for this bug fix. closes: #13361 Signed-off-by: Christian Brabandt <cb@256bit.org> Co-authored-by: Yee Cheng Chin <ychin.git@gmail.com>
author Christian Brabandt <cb@256bit.org>
date Tue, 17 Oct 2023 10:15:08 +0200
parents 1a769647d661
children
line wrap: on
line source

/* vi:set ts=8 sts=4 sw=4 noet:
 *
 * MzScheme interface by Sergey Khorev <sergey.khorev@gmail.com>
 * Based on work by Brent Fulgham <bfulgham@debian.org>
 * (Based on lots of help from Matthew Flatt)
 *
 * This consists of six parts:
 * 1. MzScheme interpreter main program
 * 2. Routines that handle the external interface between MzScheme and
 *    Vim.
 * 3. MzScheme input/output handlers: writes output via [e]msg().
 * 4. Implementation of the Vim Features for MzScheme
 * 5. Vim Window-related Manipulation Functions.
 * 6. Vim Buffer-related Manipulation Functions
 *
 * NOTES
 * 1. Memory, allocated with scheme_malloc*, need not to be freed explicitly,
 *    garbage collector will do it self
 * 2. Requires at least NORMAL features. I can't imagine why one may want
 *    to build with TINY features but with MzScheme interface.
 * 3. I don't use K&R-style functions. Anyways, MzScheme headers are ANSI.
 */

#include "vim.h"

#include "if_mzsch.h"

// Only do the following when the feature is enabled.  Needed for "make
// depend".
#if defined(FEAT_MZSCHEME) || defined(PROTO)

#ifdef PROTO
typedef int Scheme_Object;
typedef int Scheme_Closed_Prim;
typedef int Scheme_Env;
typedef int Scheme_Hash_Table;
typedef int Scheme_Type;
typedef int Scheme_Thread;
typedef int Scheme_Closed_Prim;
typedef int mzshort;
typedef int Scheme_Prim;
typedef int HINSTANCE;
#endif

/*
 * scheme_register_tls_space is only available on 32-bit Windows until
 * racket-6.3.  See
 * http://docs.racket-lang.org/inside/im_memoryalloc.html?q=scheme_register_tls_space
 */
#if MZSCHEME_VERSION_MAJOR >= 500 && defined(MSWIN) \
	&& defined(USE_THREAD_LOCAL) \
	&& (!defined(_WIN64) || MZSCHEME_VERSION_MAJOR >= 603)
# define HAVE_TLS_SPACE 1
#endif

/*
 * Since version 4.x precise GC requires trampolined startup.
 * Futures and places in version 5.x need it too.
 */
#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \
    || MZSCHEME_VERSION_MAJOR >= 500 \
	&& (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES))
# define TRAMPOLINED_MZVIM_STARTUP
#endif

// Base data structures
#define SCHEME_VIMBUFFERP(obj)  SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type)
#define SCHEME_VIMWINDOWP(obj)  SAME_TYPE(SCHEME_TYPE(obj), mz_window_type)

typedef struct
{
    Scheme_Object   so;
    buf_T	    *buf;
} vim_mz_buffer;

#define INVALID_BUFFER_VALUE ((buf_T *)(-1))

typedef struct
{
    Scheme_Object   so;
    win_T	    *win;
} vim_mz_window;

#define INVALID_WINDOW_VALUE ((win_T *)(-1))

/*
 * Prims that form MzScheme Vim interface
 */
typedef struct
{
    Scheme_Closed_Prim	*prim;
    char	*name;
    int		mina;	// arity information
    int		maxa;
} Vim_Prim;

typedef struct
{
    char	    *name;
    Scheme_Object   *port;
} Port_Info;

/*
 *========================================================================
 *  Vim-Control Commands
 *========================================================================
 */
/*
 *========================================================================
 *  Utility functions for the vim/mzscheme interface
 *========================================================================
 */
#ifdef HAVE_SANDBOX
static Scheme_Object *sandbox_file_guard(int, Scheme_Object **);
static Scheme_Object *sandbox_network_guard(int, Scheme_Object **);
static void sandbox_check(void);
#endif
//  Buffer-related commands
static Scheme_Object *buffer_new(buf_T *buf);
static Scheme_Object *get_buffer_by_num(void *, int, Scheme_Object **);
static vim_mz_buffer *get_vim_curr_buffer(void);

//  Window-related commands
static Scheme_Object *window_new(win_T *win);
static vim_mz_window *get_vim_curr_window(void);

/*
 *========================================================================
 *  Internal Function Prototypes
 *========================================================================
 */
static int vim_error_check(void);
static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what);
static int startup_mzscheme(void);
static char *string_to_line(Scheme_Object *obj);
#if MZSCHEME_VERSION_MAJOR >= 501
# define OUTPUT_LEN_TYPE intptr_t
#else
# define OUTPUT_LEN_TYPE long
#endif
static void do_output(char *mesg, OUTPUT_LEN_TYPE len);
static void do_printf(char *format, ...) ATTRIBUTE_FORMAT_PRINTF(1, 2);
static void do_flush(void);
static Scheme_Object *_apply_thunk_catch_exceptions(
	Scheme_Object *, Scheme_Object **);
static Scheme_Object *extract_exn_message(Scheme_Object *v);
static Scheme_Object *do_eval(void *, int noargc, Scheme_Object **noargv);
static Scheme_Object *do_load(void *, int noargc, Scheme_Object **noargv);
static void register_vim_exn(void);
static vim_mz_buffer *get_buffer_arg(const char *fname, int argnum,
	int argc, Scheme_Object **argv);
static vim_mz_window *get_window_arg(const char *fname, int argnum,
	int argc, Scheme_Object **argv);
static int line_in_range(linenr_T, buf_T *);
static void check_line_range(linenr_T, buf_T *);
static void mz_fix_cursor(int lo, int hi, int extra);

static int eval_with_exn_handling(void *, Scheme_Closed_Prim *,
	    Scheme_Object **ret);
static void make_modules(void);
static void init_exn_catching_apply(void);
static int mzscheme_env_main(Scheme_Env *env, int argc, char **argv);
static int mzscheme_init(void);
#ifdef FEAT_EVAL
static Scheme_Object *vim_to_mzscheme(typval_T *vim_value);
static Scheme_Object *vim_to_mzscheme_impl(typval_T *vim_value, int depth,
	Scheme_Hash_Table *visited);
static int mzscheme_to_vim(Scheme_Object *obj, typval_T *tv);
static int mzscheme_to_vim_impl(Scheme_Object *obj, typval_T *tv, int depth,
	Scheme_Hash_Table *visited);
static Scheme_Object *vim_funcref(void *data, int argc, Scheme_Object **argv);
#endif

#ifdef MZ_PRECISE_GC
static int buffer_size_proc(void *obj UNUSED)
{
    return gcBYTES_TO_WORDS(sizeof(vim_mz_buffer));
}
static int buffer_mark_proc(void *obj)
{
    return buffer_size_proc(obj);
}
static int buffer_fixup_proc(void *obj)
{
    // apparently not needed as the object will be uncollectable while
    // the buffer is alive
    // vim_mz_buffer* buf = (vim_mz_buffer*) obj;
    // buf->buf->b_mzscheme_ref = GC_fixup_self(obj);

    return buffer_size_proc(obj);
}
static int window_size_proc(void *obj UNUSED)
{
    return gcBYTES_TO_WORDS(sizeof(vim_mz_window));
}
static int window_mark_proc(void *obj)
{
    return window_size_proc(obj);
}
static int window_fixup_proc(void *obj)
{
    // apparently not needed as the object will be uncollectable while
    // the window is alive
    // vim_mz_window* win = (vim_mz_window*) obj;
    // win->win->w_mzscheme_ref = GC_fixup_self(obj);
    //
    return window_size_proc(obj);
}
// with precise GC, w_mzscheme_ref and b_mzscheme_ref are immobile boxes
// containing pointers to a window/buffer
// with conservative GC these are simply pointers
# define WINDOW_REF(win) *(vim_mz_window **)((win)->w_mzscheme_ref)
# define BUFFER_REF(buf) *(vim_mz_buffer **)((buf)->b_mzscheme_ref)
#else
# define WINDOW_REF(win) (vim_mz_window *)((win)->w_mzscheme_ref)
# define BUFFER_REF(buf) (vim_mz_buffer *)((buf)->b_mzscheme_ref)
#endif

#if defined(DYNAMIC_MZSCHEME) || defined(PROTO)
static Scheme_Object *dll_scheme_eof;
static Scheme_Object *dll_scheme_false;
static Scheme_Object *dll_scheme_void;
static Scheme_Object *dll_scheme_null;
static Scheme_Object *dll_scheme_true;

static Scheme_Thread **dll_scheme_current_thread_ptr;

static void (**dll_scheme_console_printf_ptr)(char *str, ...);
static void (**dll_scheme_console_output_ptr)(char *str, OUTPUT_LEN_TYPE len);
static void (**dll_scheme_notify_multithread_ptr)(int on);

static void *(*dll_GC_malloc)(size_t size_in_bytes);
static void *(*dll_GC_malloc_atomic)(size_t size_in_bytes);
static Scheme_Env *(*dll_scheme_basic_env)(void);
static void (*dll_scheme_check_threads)(void);
static void (*dll_scheme_register_static)(void *ptr, long size);
static void (*dll_scheme_set_stack_base)(void *base, int no_auto_statics);
static void (*dll_scheme_add_global)(const char *name, Scheme_Object *val,
	Scheme_Env *env);
static void (*dll_scheme_add_global_symbol)(Scheme_Object *name,
	Scheme_Object *val, Scheme_Env *env);
static Scheme_Object *(*dll_scheme_apply)(Scheme_Object *rator, int num_rands,
	Scheme_Object **rands);
static Scheme_Object *(*dll_scheme_builtin_value)(const char *name);
# if MZSCHEME_VERSION_MAJOR >= 299
static Scheme_Object *(*dll_scheme_byte_string_to_char_string)(Scheme_Object *s);
static Scheme_Object *(*dll_scheme_make_path)(const char *chars);
# endif
static void (*dll_scheme_close_input_port)(Scheme_Object *port);
static void (*dll_scheme_count_lines)(Scheme_Object *port);
#if MZSCHEME_VERSION_MAJOR < 360
static Scheme_Object *(*dll_scheme_current_continuation_marks)(void);
#else
static Scheme_Object *(*dll_scheme_current_continuation_marks)(Scheme_Object *prompt_tag);
#endif
static void (*dll_scheme_display)(Scheme_Object *obj, Scheme_Object *port);
static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, OUTPUT_LEN_TYPE *len);
static int (*dll_scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2);
static Scheme_Object *(*dll_scheme_do_eval)(Scheme_Object *obj,
	int _num_rands, Scheme_Object **rands, int val);
static void (*dll_scheme_dont_gc_ptr)(void *p);
static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env);
static Scheme_Object *(*dll_scheme_eval_string)(const char *str,
	Scheme_Env *env);
static Scheme_Object *(*dll_scheme_eval_string_all)(const char *str,
	Scheme_Env *env, int all);
static void (*dll_scheme_finish_primitive_module)(Scheme_Env *env);
# if MZSCHEME_VERSION_MAJOR < 299
static char *(*dll_scheme_format)(char *format, int flen, int argc,
	Scheme_Object **argv, long *rlen);
# else
static char *(*dll_scheme_format_utf8)(char *format, int flen, int argc,
	Scheme_Object **argv, OUTPUT_LEN_TYPE *rlen);
static Scheme_Object *(*dll_scheme_get_param)(Scheme_Config *c, int pos);
# endif
static void (*dll_scheme_gc_ptr_ok)(void *p);
# if MZSCHEME_VERSION_MAJOR < 299
static char *(*dll_scheme_get_sized_string_output)(Scheme_Object *,
	long *len);
# else
static char *(*dll_scheme_get_sized_byte_string_output)(Scheme_Object *,
	OUTPUT_LEN_TYPE *len);
# endif
static Scheme_Object *(*dll_scheme_intern_symbol)(const char *name);
static Scheme_Object *(*dll_scheme_lookup_global)(Scheme_Object *symbol,
	Scheme_Env *env);
static Scheme_Object *(*dll_scheme_make_closed_prim_w_arity)
    (Scheme_Closed_Prim *prim, void *data, const char *name, mzshort mina,
     mzshort maxa);
static Scheme_Object *(*dll_scheme_make_integer_value)(long i);
static Scheme_Object *(*dll_scheme_make_pair)(Scheme_Object *car,
	Scheme_Object *cdr);
static Scheme_Object *(*dll_scheme_make_prim_w_arity)(Scheme_Prim *prim,
	const char *name, mzshort mina, mzshort maxa);
# if MZSCHEME_VERSION_MAJOR < 299
static Scheme_Object *(*dll_scheme_make_string)(const char *chars);
static Scheme_Object *(*dll_scheme_make_string_output_port)();
# else
static Scheme_Object *(*dll_scheme_make_byte_string)(const char *chars);
static Scheme_Object *(*dll_scheme_make_byte_string_output_port)();
# endif
static Scheme_Object *(*dll_scheme_make_struct_instance)(Scheme_Object *stype,
	int argc, Scheme_Object **argv);
static Scheme_Object **(*dll_scheme_make_struct_names)(Scheme_Object *base,
	Scheme_Object *field_names, int flags, int *count_out);
static Scheme_Object *(*dll_scheme_make_struct_type)(Scheme_Object *base,
	Scheme_Object *parent, Scheme_Object *inspector, int num_fields,
	int num_uninit_fields, Scheme_Object *uninit_val,
	Scheme_Object *properties
# if MZSCHEME_VERSION_MAJOR >= 299
	, Scheme_Object *guard
# endif
	);
static Scheme_Object **(*dll_scheme_make_struct_values)(
	Scheme_Object *struct_type, Scheme_Object **names, int count,
	int flags);
static Scheme_Type (*dll_scheme_make_type)(const char *name);
static Scheme_Object *(*dll_scheme_make_vector)(int size,
	Scheme_Object *fill);
static void *(*dll_scheme_malloc_fail_ok)(void *(*f)(size_t), size_t);
static Scheme_Object *(*dll_scheme_open_input_file)(const char *name,
	const char *who);
static Scheme_Env *(*dll_scheme_primitive_module)(Scheme_Object *name,
	Scheme_Env *for_env);
static int (*dll_scheme_proper_list_length)(Scheme_Object *list);
static void (*dll_scheme_raise)(Scheme_Object *exn);
static Scheme_Object *(*dll_scheme_read)(Scheme_Object *port);
static void (*dll_scheme_signal_error)(const char *msg, ...);
static void (*dll_scheme_wrong_type)(const char *name, const char *expected,
	int which, int argc, Scheme_Object **argv);
# if MZSCHEME_VERSION_MAJOR >= 299
static void (*dll_scheme_set_param)(Scheme_Config *c, int pos,
	Scheme_Object *o);
static Scheme_Config *(*dll_scheme_current_config)(void);
static Scheme_Object *(*dll_scheme_char_string_to_byte_string)
    (Scheme_Object *s);
static Scheme_Object *(*dll_scheme_char_string_to_path)
    (Scheme_Object *s);
static void *(*dll_scheme_set_collects_path)(Scheme_Object *p);
# endif
static Scheme_Hash_Table *(*dll_scheme_make_hash_table)(int type);
static void (*dll_scheme_hash_set)(Scheme_Hash_Table *table,
	Scheme_Object *key, Scheme_Object *value);
static Scheme_Object *(*dll_scheme_hash_get)(Scheme_Hash_Table *table,
	Scheme_Object *key);
static Scheme_Object *(*dll_scheme_make_double)(double d);
static Scheme_Object *(*dll_scheme_make_sized_byte_string)(char *chars,
	long len, int copy);
static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req);
static Scheme_Object *(*dll_scheme_dynamic_wind)(void (*pre)(void *), Scheme_Object *(* volatile act)(void *), void (* volatile post)(void *), Scheme_Object *(*jmp_handler)(void *), void * volatile data);
# ifdef MZ_PRECISE_GC
static void *(*dll_GC_malloc_one_tagged)(size_t size_in_bytes);
static void (*dll_GC_register_traversers)(short tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup, int is_constant_size, int is_atomic);
# endif
# if MZSCHEME_VERSION_MAJOR >= 400
static void (*dll_scheme_init_collection_paths)(Scheme_Env *global_env, Scheme_Object *extra_dirs);
static void **(*dll_scheme_malloc_immobile_box)(void *p);
static void (*dll_scheme_free_immobile_box)(void **b);
# endif
# if MZSCHEME_VERSION_MAJOR >= 500
#  ifdef TRAMPOLINED_MZVIM_STARTUP
static int (*dll_scheme_main_setup)(int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv);
#   if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
static void (*dll_scheme_register_tls_space)(void *tls_space, int _tls_index);
#   endif
#  endif
#  if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
static Thread_Local_Variables *(*dll_scheme_external_get_thread_local_variables)(void);
#  endif
# endif
# if MZSCHEME_VERSION_MAJOR >= 600
static void (*dll_scheme_embedded_load)(intptr_t len, const char *s, int predefined);
static void (*dll_scheme_register_embedded_load)(intptr_t len, const char *s);
static void (*dll_scheme_set_config_path)(Scheme_Object *p);
# endif

#if defined(DYNAMIC_MZSCHEME) // not when defined(PROTO)

// arrays are imported directly
# define scheme_eof dll_scheme_eof
# define scheme_false dll_scheme_false
# define scheme_void dll_scheme_void
# define scheme_null dll_scheme_null
# define scheme_true dll_scheme_true

// pointers are GetProceAddress'ed as pointers to pointer
#if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
#  define scheme_current_thread (*dll_scheme_current_thread_ptr)
# endif
# define scheme_console_printf (*dll_scheme_console_printf_ptr)
# define scheme_console_output (*dll_scheme_console_output_ptr)
# define scheme_notify_multithread (*dll_scheme_notify_multithread_ptr)

// and functions in a usual way
# define GC_malloc dll_GC_malloc
# define GC_malloc_atomic dll_GC_malloc_atomic

# define scheme_add_global dll_scheme_add_global
# define scheme_add_global_symbol dll_scheme_add_global_symbol
# define scheme_apply dll_scheme_apply
# define scheme_basic_env dll_scheme_basic_env
# define scheme_builtin_value dll_scheme_builtin_value
# if MZSCHEME_VERSION_MAJOR >= 299
#  define scheme_byte_string_to_char_string dll_scheme_byte_string_to_char_string
#  define scheme_make_path dll_scheme_make_path
# endif
# define scheme_check_threads dll_scheme_check_threads
# define scheme_close_input_port dll_scheme_close_input_port
# define scheme_count_lines dll_scheme_count_lines
# define scheme_current_continuation_marks \
    dll_scheme_current_continuation_marks
# define scheme_display dll_scheme_display
# define scheme_display_to_string dll_scheme_display_to_string
# define scheme_do_eval dll_scheme_do_eval
# define scheme_dont_gc_ptr dll_scheme_dont_gc_ptr
# define scheme_eq dll_scheme_eq
# define scheme_eval dll_scheme_eval
# define scheme_eval_string dll_scheme_eval_string
# define scheme_eval_string_all dll_scheme_eval_string_all
# define scheme_finish_primitive_module dll_scheme_finish_primitive_module
# if MZSCHEME_VERSION_MAJOR < 299
#  define scheme_format dll_scheme_format
# else
#  define scheme_format_utf8 dll_scheme_format_utf8
# endif
# define scheme_gc_ptr_ok dll_scheme_gc_ptr_ok
# if MZSCHEME_VERSION_MAJOR < 299
#  define scheme_get_sized_byte_string_output dll_scheme_get_sized_string_output
# else
#  define scheme_get_sized_byte_string_output \
    dll_scheme_get_sized_byte_string_output
#  define scheme_get_param dll_scheme_get_param
# endif
# define scheme_intern_symbol dll_scheme_intern_symbol
# define scheme_lookup_global dll_scheme_lookup_global
# define scheme_make_closed_prim_w_arity dll_scheme_make_closed_prim_w_arity
# define scheme_make_integer_value dll_scheme_make_integer_value
# define scheme_make_pair dll_scheme_make_pair
# define scheme_make_prim_w_arity dll_scheme_make_prim_w_arity
# if MZSCHEME_VERSION_MAJOR < 299
#  define scheme_make_byte_string dll_scheme_make_string
#  define scheme_make_byte_string_output_port dll_scheme_make_string_output_port
# else
#  define scheme_make_byte_string dll_scheme_make_byte_string
#  define scheme_make_byte_string_output_port \
    dll_scheme_make_byte_string_output_port
# endif
# define scheme_make_struct_instance dll_scheme_make_struct_instance
# define scheme_make_struct_names dll_scheme_make_struct_names
# define scheme_make_struct_type dll_scheme_make_struct_type
# define scheme_make_struct_values dll_scheme_make_struct_values
# define scheme_make_type dll_scheme_make_type
# define scheme_make_vector dll_scheme_make_vector
# define scheme_malloc_fail_ok dll_scheme_malloc_fail_ok
# define scheme_open_input_file dll_scheme_open_input_file
# define scheme_primitive_module dll_scheme_primitive_module
# define scheme_proper_list_length dll_scheme_proper_list_length
# define scheme_raise dll_scheme_raise
# define scheme_read dll_scheme_read
# define scheme_register_static dll_scheme_register_static
# define scheme_set_stack_base dll_scheme_set_stack_base
# define scheme_signal_error dll_scheme_signal_error
# define scheme_wrong_type dll_scheme_wrong_type
# if MZSCHEME_VERSION_MAJOR >= 299
#  define scheme_set_param dll_scheme_set_param
#  define scheme_current_config dll_scheme_current_config
#  define scheme_char_string_to_byte_string \
    dll_scheme_char_string_to_byte_string
#  define scheme_char_string_to_path \
    dll_scheme_char_string_to_path
#  define scheme_set_collects_path dll_scheme_set_collects_path
# endif
# define scheme_make_hash_table dll_scheme_make_hash_table
# define scheme_hash_set dll_scheme_hash_set
# define scheme_hash_get dll_scheme_hash_get
# define scheme_make_double dll_scheme_make_double
# define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string
# define scheme_namespace_require dll_scheme_namespace_require
# define scheme_dynamic_wind dll_scheme_dynamic_wind
# ifdef MZ_PRECISE_GC
#  define GC_malloc_one_tagged dll_GC_malloc_one_tagged
#  define GC_register_traversers dll_GC_register_traversers
# endif
# if MZSCHEME_VERSION_MAJOR >= 400
#  ifdef TRAMPOLINED_MZVIM_STARTUP
#   define scheme_main_setup dll_scheme_main_setup
#   if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
#    define scheme_register_tls_space dll_scheme_register_tls_space
#   endif
#  endif
#  define scheme_init_collection_paths dll_scheme_init_collection_paths
#  define scheme_malloc_immobile_box dll_scheme_malloc_immobile_box
#  define scheme_free_immobile_box dll_scheme_free_immobile_box
# endif
# if MZSCHEME_VERSION_MAJOR >= 600
#  define scheme_embedded_load dll_scheme_embedded_load
#  define scheme_register_embedded_load dll_scheme_register_embedded_load
#  define scheme_set_config_path dll_scheme_set_config_path
# endif

# if MZSCHEME_VERSION_MAJOR >= 500
#  if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
// define as function for macro in schthread.h
Thread_Local_Variables *
scheme_external_get_thread_local_variables(void)
{
    return dll_scheme_external_get_thread_local_variables();
}
#  endif
# endif

#endif

typedef struct
{
    char    *name;
    void    **ptr;
} Thunk_Info;

static Thunk_Info mzgc_imports[] = {
    {"GC_malloc", (void **)&dll_GC_malloc},
    {"GC_malloc_atomic", (void **)&dll_GC_malloc_atomic},
    {NULL, NULL}};

static Thunk_Info mzsch_imports[] = {
    {"scheme_eof", (void **)&dll_scheme_eof},
    {"scheme_false", (void **)&dll_scheme_false},
    {"scheme_void", (void **)&dll_scheme_void},
    {"scheme_null", (void **)&dll_scheme_null},
    {"scheme_true", (void **)&dll_scheme_true},
#if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
    {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr},
#endif
    {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr},
    {"scheme_console_output", (void **)&dll_scheme_console_output_ptr},
    {"scheme_notify_multithread",
	(void **)&dll_scheme_notify_multithread_ptr},
    {"scheme_add_global", (void **)&dll_scheme_add_global},
    {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol},
    {"scheme_apply", (void **)&dll_scheme_apply},
    {"scheme_basic_env", (void **)&dll_scheme_basic_env},
# if MZSCHEME_VERSION_MAJOR >= 299
    {"scheme_byte_string_to_char_string", (void **)&dll_scheme_byte_string_to_char_string},
    {"scheme_make_path", (void **)&dll_scheme_make_path},
# endif
    {"scheme_builtin_value", (void **)&dll_scheme_builtin_value},
    {"scheme_check_threads", (void **)&dll_scheme_check_threads},
    {"scheme_close_input_port", (void **)&dll_scheme_close_input_port},
    {"scheme_count_lines", (void **)&dll_scheme_count_lines},
    {"scheme_current_continuation_marks",
	(void **)&dll_scheme_current_continuation_marks},
    {"scheme_display", (void **)&dll_scheme_display},
    {"scheme_display_to_string", (void **)&dll_scheme_display_to_string},
    {"scheme_do_eval", (void **)&dll_scheme_do_eval},
    {"scheme_dont_gc_ptr", (void **)&dll_scheme_dont_gc_ptr},
    {"scheme_eq", (void **)&dll_scheme_eq},
    {"scheme_eval", (void **)&dll_scheme_eval},
    {"scheme_eval_string", (void **)&dll_scheme_eval_string},
    {"scheme_eval_string_all", (void **)&dll_scheme_eval_string_all},
    {"scheme_finish_primitive_module",
	(void **)&dll_scheme_finish_primitive_module},
# if MZSCHEME_VERSION_MAJOR < 299
    {"scheme_format", (void **)&dll_scheme_format},
# else
    {"scheme_format_utf8", (void **)&dll_scheme_format_utf8},
    {"scheme_get_param", (void **)&dll_scheme_get_param},
#endif
    {"scheme_gc_ptr_ok", (void **)&dll_scheme_gc_ptr_ok},
# if MZSCHEME_VERSION_MAJOR < 299
    {"scheme_get_sized_string_output",
	(void **)&dll_scheme_get_sized_string_output},
# else
    {"scheme_get_sized_byte_string_output",
	(void **)&dll_scheme_get_sized_byte_string_output},
#endif
    {"scheme_intern_symbol", (void **)&dll_scheme_intern_symbol},
    {"scheme_lookup_global", (void **)&dll_scheme_lookup_global},
    {"scheme_make_closed_prim_w_arity",
	(void **)&dll_scheme_make_closed_prim_w_arity},
    {"scheme_make_integer_value", (void **)&dll_scheme_make_integer_value},
    {"scheme_make_pair", (void **)&dll_scheme_make_pair},
    {"scheme_make_prim_w_arity", (void **)&dll_scheme_make_prim_w_arity},
# if MZSCHEME_VERSION_MAJOR < 299
    {"scheme_make_string", (void **)&dll_scheme_make_string},
    {"scheme_make_string_output_port",
	(void **)&dll_scheme_make_string_output_port},
# else
    {"scheme_make_byte_string", (void **)&dll_scheme_make_byte_string},
    {"scheme_make_byte_string_output_port",
	(void **)&dll_scheme_make_byte_string_output_port},
# endif
    {"scheme_make_struct_instance",
	(void **)&dll_scheme_make_struct_instance},
    {"scheme_make_struct_names", (void **)&dll_scheme_make_struct_names},
    {"scheme_make_struct_type", (void **)&dll_scheme_make_struct_type},
    {"scheme_make_struct_values", (void **)&dll_scheme_make_struct_values},
    {"scheme_make_type", (void **)&dll_scheme_make_type},
    {"scheme_make_vector", (void **)&dll_scheme_make_vector},
    {"scheme_malloc_fail_ok", (void **)&dll_scheme_malloc_fail_ok},
    {"scheme_open_input_file", (void **)&dll_scheme_open_input_file},
    {"scheme_primitive_module", (void **)&dll_scheme_primitive_module},
    {"scheme_proper_list_length", (void **)&dll_scheme_proper_list_length},
    {"scheme_raise", (void **)&dll_scheme_raise},
    {"scheme_read", (void **)&dll_scheme_read},
    {"scheme_register_static", (void **)&dll_scheme_register_static},
    {"scheme_set_stack_base", (void **)&dll_scheme_set_stack_base},
    {"scheme_signal_error", (void **)&dll_scheme_signal_error},
    {"scheme_wrong_type", (void **)&dll_scheme_wrong_type},
# if MZSCHEME_VERSION_MAJOR >= 299
    {"scheme_set_param", (void **)&dll_scheme_set_param},
    {"scheme_current_config", (void **)&dll_scheme_current_config},
    {"scheme_char_string_to_byte_string",
	(void **)&dll_scheme_char_string_to_byte_string},
    {"scheme_char_string_to_path", (void **)&dll_scheme_char_string_to_path},
    {"scheme_set_collects_path", (void **)&dll_scheme_set_collects_path},
# endif
    {"scheme_make_hash_table", (void **)&dll_scheme_make_hash_table},
    {"scheme_hash_set", (void **)&dll_scheme_hash_set},
    {"scheme_hash_get", (void **)&dll_scheme_hash_get},
    {"scheme_make_double", (void **)&dll_scheme_make_double},
    {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string},
    {"scheme_namespace_require", (void **)&dll_scheme_namespace_require},
    {"scheme_dynamic_wind", (void **)&dll_scheme_dynamic_wind},
# ifdef MZ_PRECISE_GC
    {"GC_malloc_one_tagged", (void **)&dll_GC_malloc_one_tagged},
    {"GC_register_traversers", (void **)&dll_GC_register_traversers},
# endif
# if MZSCHEME_VERSION_MAJOR >= 400
#  ifdef TRAMPOLINED_MZVIM_STARTUP
    {"scheme_main_setup", (void **)&dll_scheme_main_setup},
#   if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
    {"scheme_register_tls_space", (void **)&dll_scheme_register_tls_space},
#   endif
#  endif
    {"scheme_init_collection_paths", (void **)&dll_scheme_init_collection_paths},
    {"scheme_malloc_immobile_box", (void **)&dll_scheme_malloc_immobile_box},
    {"scheme_free_immobile_box", (void **)&dll_scheme_free_immobile_box},
# endif
# if MZSCHEME_VERSION_MAJOR >= 500
#  if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
    {"scheme_external_get_thread_local_variables", (void **)&dll_scheme_external_get_thread_local_variables},
#  endif
# endif
# if MZSCHEME_VERSION_MAJOR >= 600
    {"scheme_embedded_load", (void **)&dll_scheme_embedded_load},
    {"scheme_register_embedded_load", (void **)&dll_scheme_register_embedded_load},
    {"scheme_set_config_path", (void **)&dll_scheme_set_config_path},
# endif
    {NULL, NULL}};

static HINSTANCE hMzGC = 0;
static HINSTANCE hMzSch = 0;

static void dynamic_mzscheme_end(void);
static int mzscheme_runtime_link_init(char *sch_dll, char *gc_dll,
	int verbose);

    static int
mzscheme_runtime_link_init(char *sch_dll, char *gc_dll, int verbose)
{
    Thunk_Info *thunk = NULL;

    if (hMzGC && hMzSch)
	return OK;
    hMzSch = vimLoadLib(sch_dll);
    hMzGC = vimLoadLib(gc_dll);

    if (!hMzGC)
    {
	if (verbose)
	    semsg(_(e_could_not_load_library_str_str), gc_dll, GetWin32Error());
	return FAIL;
    }

    if (!hMzSch)
    {
	if (verbose)
	    semsg(_(e_could_not_load_library_str_str), sch_dll, GetWin32Error());
	return FAIL;
    }

    for (thunk = mzsch_imports; thunk->name; thunk++)
    {
	if ((*thunk->ptr =
		    (void *)GetProcAddress(hMzSch, thunk->name)) == NULL)
	{
	    FreeLibrary(hMzSch);
	    hMzSch = 0;
	    FreeLibrary(hMzGC);
	    hMzGC = 0;
	    if (verbose)
		semsg(_(e_could_not_load_library_function_str), thunk->name);
	    return FAIL;
	}
    }
    for (thunk = mzgc_imports; thunk->name; thunk++)
    {
	if ((*thunk->ptr =
		    (void *)GetProcAddress(hMzGC, thunk->name)) == NULL)
	{
	    FreeLibrary(hMzSch);
	    hMzSch = 0;
	    FreeLibrary(hMzGC);
	    hMzGC = 0;
	    if (verbose)
		semsg(_(e_could_not_load_library_function_str), thunk->name);
	    return FAIL;
	}
    }
    return OK;
}

    int
mzscheme_enabled(int verbose)
{
    return mzscheme_runtime_link_init(
	    (char *)p_mzschemedll, (char *)p_mzschemegcdll, verbose) == OK;
}

    static void
dynamic_mzscheme_end(void)
{
    if (hMzSch)
    {
	FreeLibrary(hMzSch);
	hMzSch = 0;
    }
    if (hMzGC)
    {
	FreeLibrary(hMzGC);
	hMzGC = 0;
    }
}
#endif // DYNAMIC_MZSCHEME

#if MZSCHEME_VERSION_MAJOR < 299
# define GUARANTEED_STRING_ARG(proc, num) GUARANTEE_STRING(proc, num)
#else
    static Scheme_Object *
guaranteed_byte_string_arg(char *proc, int num, int argc, Scheme_Object **argv)
{
    if (SCHEME_BYTE_STRINGP(argv[num]))
    {
	return argv[num];
    }
    else if (SCHEME_CHAR_STRINGP(argv[num]))
    {
	Scheme_Object *tmp = NULL;
	MZ_GC_DECL_REG(2);
	MZ_GC_VAR_IN_REG(0, argv[num]);
	MZ_GC_VAR_IN_REG(1, tmp);
	MZ_GC_REG();
	tmp = scheme_char_string_to_byte_string(argv[num]);
	MZ_GC_UNREG();
	return tmp;
    }
    else
	scheme_wrong_type(proc, "string", num, argc, argv);
    // unreachable
    return scheme_void;
}
# define GUARANTEED_STRING_ARG(proc, num) guaranteed_byte_string_arg(proc, num, argc, argv)
#endif

// need to put it here for dynamic stuff to work
#if defined(INCLUDE_MZSCHEME_BASE)
# include "mzscheme_base.c"
#endif

/*
 *========================================================================
 *  1. MzScheme interpreter startup
 *========================================================================
 */

static Scheme_Type mz_buffer_type;
static Scheme_Type mz_window_type;

static int initialized = FALSE;
#ifdef DYNAMIC_MZSCHEME
static int disabled = FALSE;
#endif
static int load_base_module_failed = FALSE;

// global environment
static Scheme_Env    *environment = NULL;
// output/error handlers
static Scheme_Object *curout = NULL;
static Scheme_Object *curerr = NULL;
// exn:vim exception
static Scheme_Object *exn_catching_apply = NULL;
static Scheme_Object *exn_p = NULL;
static Scheme_Object *exn_message = NULL;
static Scheme_Object *vim_exn = NULL; // Vim Error exception

#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400
static void *stack_base = NULL;
#endif

static long range_start;
static long range_end;

// MzScheme threads scheduling stuff
static int mz_threads_allow = 0;

#if defined(FEAT_GUI_MSWIN)
static void CALLBACK timer_proc(HWND, UINT, UINT_PTR, DWORD);
static UINT timer_id = 0;
#elif defined(FEAT_GUI_GTK)
static gboolean timer_proc(gpointer);
static guint timer_id = 0;
#elif defined(FEAT_GUI_MOTIF)
static void timer_proc(XtPointer, XtIntervalId *);
static XtIntervalId timer_id = (XtIntervalId)0;
#endif

#if !defined(FEAT_GUI_MSWIN) || defined(VIMDLL) // Win32 console and Unix
    void
mzvim_check_threads(void)
{
    // Last time MzScheme threads were scheduled
    static time_t mz_last_time = 0;

    if (mz_threads_allow && p_mzq > 0)
    {
	time_t now = time(NULL);

	if ((now - mz_last_time) * 1000 > p_mzq)
	{
	    mz_last_time = now;
	    scheme_check_threads();
	}
    }
}
#endif

#if defined(MZSCHEME_GUI_THREADS) || defined(PROTO)
static void setup_timer(void);
static void remove_timer(void);

// timers are presented in GUI only
# if defined(FEAT_GUI_MSWIN)
    static void CALLBACK
timer_proc(HWND hwnd UNUSED, UINT uMsg UNUSED, UINT_PTR idEvent UNUSED, DWORD dwTime UNUSED)
# elif defined(FEAT_GUI_GTK)
    static gboolean
timer_proc(gpointer data UNUSED)
# elif defined(FEAT_GUI_MOTIF)
    static void
timer_proc(XtPointer timed_out UNUSED, XtIntervalId *interval_id UNUSED)
# endif
{
    scheme_check_threads();
# if defined(FEAT_GUI_GTK)
    return TRUE; // continue receiving notifications
# elif defined(FEAT_GUI_MOTIF)
    // renew timeout
    if (mz_threads_allow && p_mzq > 0)
	timer_id = XtAppAddTimeOut(app_context, p_mzq,
		timer_proc, NULL);
# endif
}

    static void
setup_timer(void)
{
# if defined(FEAT_GUI_MSWIN)
    timer_id = SetTimer(NULL, 0, p_mzq, timer_proc);
# elif defined(FEAT_GUI_GTK)
    timer_id = g_timeout_add((guint)p_mzq, (GSourceFunc)timer_proc, NULL);
# elif defined(FEAT_GUI_MOTIF)
    timer_id = XtAppAddTimeOut(app_context, p_mzq, timer_proc, NULL);
# endif
}

    static void
remove_timer(void)
{
# if defined(FEAT_GUI_MSWIN)
    KillTimer(NULL, timer_id);
# elif defined(FEAT_GUI_GTK)
    g_source_remove(timer_id);
# elif defined(FEAT_GUI_MOTIF)
    XtRemoveTimeOut(timer_id);
# endif
    timer_id = 0;
}

#endif // MZSCHEME_GUI_THREADS

    char *
did_set_mzquantum(optset_T *args UNUSED)
{
#if defined(MZSCHEME_GUI_THREADS)
    // reset timer
    if (timer_id != 0)
	remove_timer();
    if (mz_threads_allow && p_mzq > 0 && gui.in_use)
	setup_timer();
#endif
    return NULL;
}

    static void
notify_multithread(int on)
{
    mz_threads_allow = on;
#ifdef MZSCHEME_GUI_THREADS
    if (on && timer_id == 0 && p_mzq > 0 && gui.in_use)
	setup_timer();
    if (!on && timer_id != 0)
	remove_timer();
#endif
}

    void
mzscheme_end(void)
{
    // We can not unload the DLL.  Racket's thread might be still alive.
#if 0
#ifdef DYNAMIC_MZSCHEME
    dynamic_mzscheme_end();
#endif
#endif
}

#if HAVE_TLS_SPACE
# if defined(_MSC_VER)
static __declspec(thread) void *tls_space;
extern intptr_t _tls_index;
# elif defined(__MINGW32__)
static __thread void *tls_space;
extern intptr_t _tls_index;
# else
static THREAD_LOCAL void *tls_space;
static intptr_t _tls_index = 0;
# endif
#endif

/*
 * mzscheme_main() is called early in main().
 * We may call scheme_main_setup() which calls mzscheme_env_main() which then
 * trampolines into vim_main2(), which never returns.
 */
    int
mzscheme_main(void)
{
    int	    argc = 0;
    char    *argv = NULL;

#ifdef DYNAMIC_MZSCHEME
    /*
     * Racket requires trampolined startup.  We can not load it later.
     * If dynamic dll loading is failed, disable it.
     */
    if (!mzscheme_enabled(FALSE))
    {
	disabled = TRUE;
	return vim_main2();
    }
#endif
#ifdef HAVE_TLS_SPACE
    scheme_register_tls_space(&tls_space, _tls_index);
#endif
#ifdef TRAMPOLINED_MZVIM_STARTUP
    return scheme_main_setup(TRUE, mzscheme_env_main, argc, &argv);
#else
    return mzscheme_env_main(NULL, argc, &argv);
#endif
}

    static int
mzscheme_env_main(Scheme_Env *env, int argc UNUSED, char **argv UNUSED)
{
#ifdef TRAMPOLINED_MZVIM_STARTUP
    // Scheme has created the environment for us
    environment = env;
#else
# ifdef MZ_PRECISE_GC
    Scheme_Object   *dummy = NULL;
    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, dummy);

    stack_base = &__gc_var_stack__;
# else
    int dummy = 0;
    stack_base = (void *)&dummy;
# endif
#endif

    vim_main2();
    // not reached, vim_main2() will loop until exit()

    return 0;
}

    static Scheme_Object*
load_base_module(void *data)
{
    scheme_namespace_require(scheme_intern_symbol((char *)data));
    return scheme_null;
}

    static Scheme_Object *
load_base_module_on_error(void *data UNUSED)
{
    load_base_module_failed = TRUE;
    return scheme_null;
}

    static int
startup_mzscheme(void)
{
#ifndef TRAMPOLINED_MZVIM_STARTUP
    scheme_set_stack_base(stack_base, 1);
#endif

#ifndef TRAMPOLINED_MZVIM_STARTUP
    // in newer versions of precise GC the initial env has been created
    environment = scheme_basic_env();
#endif

    MZ_REGISTER_STATIC(environment);
    MZ_REGISTER_STATIC(curout);
    MZ_REGISTER_STATIC(curerr);
    MZ_REGISTER_STATIC(exn_catching_apply);
    MZ_REGISTER_STATIC(exn_p);
    MZ_REGISTER_STATIC(exn_message);
    MZ_REGISTER_STATIC(vim_exn);

    MZ_GC_CHECK();

#ifdef INCLUDE_MZSCHEME_BASE
    // invoke function from generated and included mzscheme_base.c
    declare_modules(environment);
#endif

    // setup 'current-library-collection-paths' parameter
# if MZSCHEME_VERSION_MAJOR >= 299
    {
	Scheme_Object *coll_path = NULL;
	int mustfree = FALSE;
	char_u *s;

	MZ_GC_DECL_REG(1);
	MZ_GC_VAR_IN_REG(0, coll_path);
	MZ_GC_REG();
	// workaround for dynamic loading on windows
	s = vim_getenv((char_u *)"PLTCOLLECTS", &mustfree);
	if (s != NULL)
	{
	    coll_path = scheme_make_path((char *)s);
	    MZ_GC_CHECK();
	    if (mustfree)
		vim_free(s);
	}
#  ifdef MZSCHEME_COLLECTS
	if (coll_path == NULL)
	{
	    coll_path = scheme_make_path(MZSCHEME_COLLECTS);
	    MZ_GC_CHECK();
	}
#  endif
	if (coll_path != NULL)
	{
	    scheme_set_collects_path(coll_path);
	    MZ_GC_CHECK();
	}
	MZ_GC_UNREG();
    }
# else
#  ifdef MZSCHEME_COLLECTS
    {
	Scheme_Object	*coll_string = NULL;
	Scheme_Object	*coll_pair = NULL;
	Scheme_Config	*config = NULL;

	MZ_GC_DECL_REG(3);
	MZ_GC_VAR_IN_REG(0, coll_string);
	MZ_GC_VAR_IN_REG(1, coll_pair);
	MZ_GC_VAR_IN_REG(2, config);
	MZ_GC_REG();
	coll_string = scheme_make_byte_string(MZSCHEME_COLLECTS);
	MZ_GC_CHECK();
	coll_pair = scheme_make_pair(coll_string, scheme_null);
	MZ_GC_CHECK();
	config = scheme_current_config();
	MZ_GC_CHECK();
	scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair);
	MZ_GC_CHECK();
	MZ_GC_UNREG();
    }
# endif
#endif

# if MZSCHEME_VERSION_MAJOR >= 600
    {
	Scheme_Object *config_path = NULL;
	int mustfree = FALSE;
	char_u *s;

	MZ_GC_DECL_REG(1);
	MZ_GC_VAR_IN_REG(0, config_path);
	MZ_GC_REG();
	// workaround for dynamic loading on windows
	s = vim_getenv((char_u *)"PLTCONFIGDIR", &mustfree);
	if (s != NULL)
	{
	    config_path = scheme_make_path((char *)s);
	    MZ_GC_CHECK();
	    if (mustfree)
		vim_free(s);
	}
#ifdef MZSCHEME_CONFIGDIR
	if (config_path == NULL)
	{
	    config_path = scheme_make_path(MZSCHEME_CONFIGDIR);
	    MZ_GC_CHECK();
	}
#endif
	if (config_path != NULL)
	{
	    scheme_set_config_path(config_path);
	    MZ_GC_CHECK();
	}
	MZ_GC_UNREG();
    }
# endif

#if MZSCHEME_VERSION_MAJOR >= 400
    scheme_init_collection_paths(environment, scheme_null);
#endif

    /*
     * versions 4.x do not provide Scheme bindings by default
     * we need to add them explicitly
     */
    {
	// use error handler to avoid abort
	scheme_dynamic_wind(NULL, load_base_module, NULL,
				    load_base_module_on_error, "racket/base");
	if (load_base_module_failed)
	{
	    load_base_module_failed = FALSE;
	    scheme_dynamic_wind(NULL, load_base_module, NULL,
				    load_base_module_on_error, "scheme/base");
	    if (load_base_module_failed)
		return -1;
	}
    }

    register_vim_exn();
    // use new environment to initialise exception handling
    init_exn_catching_apply();

    // redirect output
    scheme_console_output = do_output;
    scheme_console_printf = do_printf;

#ifdef HAVE_SANDBOX
    {
	Scheme_Object	*make_security_guard = NULL;
	MZ_GC_DECL_REG(1);
	MZ_GC_VAR_IN_REG(0, make_security_guard);
	MZ_GC_REG();

#if MZSCHEME_VERSION_MAJOR < 400
	{
	    Scheme_Object	*make_security_guard_symbol = NULL;
	    MZ_GC_DECL_REG(1);
	    MZ_GC_VAR_IN_REG(0, make_security_guard_symbol);
	    MZ_GC_REG();
	    make_security_guard_symbol = scheme_intern_symbol("make-security-guard");
	    MZ_GC_CHECK();
	    make_security_guard = scheme_lookup_global(
		    make_security_guard_symbol, environment);
	    MZ_GC_UNREG();
	}
#else
	make_security_guard = scheme_builtin_value("make-security-guard");
	MZ_GC_CHECK();
#endif

	// setup sandbox guards
	if (make_security_guard != NULL)
	{
	    Scheme_Object   *args[3] = {NULL, NULL, NULL};
	    Scheme_Object   *guard = NULL;
	    Scheme_Config   *config = NULL;
	    MZ_GC_DECL_REG(5);
	    MZ_GC_ARRAY_VAR_IN_REG(0, args, 3);
	    MZ_GC_VAR_IN_REG(3, guard);
	    MZ_GC_VAR_IN_REG(4, config);
	    MZ_GC_REG();
	    config = scheme_current_config();
	    MZ_GC_CHECK();
	    args[0] = scheme_get_param(config, MZCONFIG_SECURITY_GUARD);
	    MZ_GC_CHECK();
	    args[1] = scheme_make_prim_w_arity(sandbox_file_guard,
		    "sandbox-file-guard", 3, 3);
	    args[2] = scheme_make_prim_w_arity(sandbox_network_guard,
		    "sandbox-network-guard", 4, 4);
	    guard = scheme_apply(make_security_guard, 3, args);
	    MZ_GC_CHECK();
	    scheme_set_param(config, MZCONFIG_SECURITY_GUARD, guard);
	    MZ_GC_CHECK();
	    MZ_GC_UNREG();
	}
	MZ_GC_UNREG();
    }
#endif
    // Create buffer and window types for use in Scheme code
    mz_buffer_type = scheme_make_type("<vim-buffer>");
    MZ_GC_CHECK();
    mz_window_type = scheme_make_type("<vim-window>");
    MZ_GC_CHECK();
#ifdef MZ_PRECISE_GC
    GC_register_traversers(mz_buffer_type,
	    buffer_size_proc, buffer_mark_proc, buffer_fixup_proc,
	    TRUE, TRUE);
    GC_register_traversers(mz_window_type,
	    window_size_proc, window_mark_proc, window_fixup_proc,
	    TRUE, TRUE);
#endif

    make_modules();

    /*
     * setup callback to receive notifications
     * whether thread scheduling is (or not) required
     */
    scheme_notify_multithread = notify_multithread;

    return 0;
}

/*
 * This routine is called for each new invocation of MzScheme
 * to make sure things are properly initialized.
 */
    static int
mzscheme_init(void)
{
    if (!initialized)
    {
#ifdef DYNAMIC_MZSCHEME
	if (disabled || !mzscheme_enabled(TRUE))
	{
	    emsg(_(e_sorry_this_command_is_disabled_the_mzscheme_libraries_could_not_be_loaded));
	    return -1;
	}
#endif
	if (load_base_module_failed || startup_mzscheme())
	{
	    emsg(_(e_sorry_this_command_is_disabled_the_mzscheme_racket_base_module_could_not_be_loaded));
	    return -1;
	}
	initialized = TRUE;
    }
    {
	Scheme_Config	*config = NULL;
	MZ_GC_DECL_REG(1);
	MZ_GC_VAR_IN_REG(0, config);
	MZ_GC_REG();
	config = scheme_current_config();
	MZ_GC_CHECK();
	// recreate ports each call effectively clearing these ones
	curout = scheme_make_byte_string_output_port();
	MZ_GC_CHECK();
	curerr = scheme_make_byte_string_output_port();
	MZ_GC_CHECK();
	scheme_set_param(config, MZCONFIG_OUTPUT_PORT, curout);
	MZ_GC_CHECK();
	scheme_set_param(config, MZCONFIG_ERROR_PORT, curerr);
	MZ_GC_CHECK();
	MZ_GC_UNREG();
    }

    return 0;
}

/*
 *========================================================================
 *  2.  External Interface
 *========================================================================
 */

/*
 * Evaluate command with exception handling
 */
    static int
eval_with_exn_handling(void *data, Scheme_Closed_Prim *what, Scheme_Object **ret)
{
    Scheme_Object   *value = NULL;
    Scheme_Object   *exn = NULL;
    Scheme_Object   *prim = NULL;

    MZ_GC_DECL_REG(3);
    MZ_GC_VAR_IN_REG(0, value);
    MZ_GC_VAR_IN_REG(1, exn);
    MZ_GC_VAR_IN_REG(2, prim);
    MZ_GC_REG();

    prim = scheme_make_closed_prim_w_arity(what, data, "mzvim", 0, 0);
    MZ_GC_CHECK();
    value = _apply_thunk_catch_exceptions(prim, &exn);
    MZ_GC_CHECK();

    if (!value)
    {
	value = extract_exn_message(exn);
	// Got an exn?
	if (value)
	{
	    scheme_display(value, curerr);   //  Send to stderr-vim
	    MZ_GC_CHECK();
	    do_flush();
	}
	MZ_GC_UNREG();
	// `raise' was called on some arbitrary value
	return FAIL;
    }

    if (ret != NULL)	// if pointer to retval supported give it up
	*ret = value;
    // Print any result, as long as it's not a void
    else if (!SCHEME_VOIDP(value))
    {
	scheme_display(value, curout);  // Send to stdout-vim
	MZ_GC_CHECK();
    }

    do_flush();
    MZ_GC_UNREG();
    return OK;
}

/*
 * :mzscheme
 */
    static int
do_mzscheme_command(exarg_T *eap, void *data, Scheme_Closed_Prim *what)
{
    if (mzscheme_init())
	return FAIL;

    range_start = eap->line1;
    range_end = eap->line2;

    return eval_with_exn_handling(data, what, NULL);
}

/*
 * Routine called by VIM when deleting a buffer
 */
    void
mzscheme_buffer_free(buf_T *buf)
{
    if (buf->b_mzscheme_ref == NULL)
	return;

    vim_mz_buffer *bp = NULL;
    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, bp);
    MZ_GC_REG();

    bp = BUFFER_REF(buf);
    bp->buf = INVALID_BUFFER_VALUE;
#ifdef MZ_PRECISE_GC
    scheme_free_immobile_box(buf->b_mzscheme_ref);
#else
    scheme_gc_ptr_ok(bp);
#endif
    buf->b_mzscheme_ref = NULL;
    MZ_GC_CHECK();
    MZ_GC_UNREG();
}

/*
 * Routine called by VIM when deleting a Window
 */
    void
mzscheme_window_free(win_T *win)
{
    if (win->w_mzscheme_ref == NULL)
	return;

    vim_mz_window *wp = NULL;
    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, wp);
    MZ_GC_REG();
    wp = WINDOW_REF(win);
    wp->win = INVALID_WINDOW_VALUE;
#ifdef MZ_PRECISE_GC
    scheme_free_immobile_box(win->w_mzscheme_ref);
#else
    scheme_gc_ptr_ok(wp);
#endif
    win->w_mzscheme_ref = NULL;
    MZ_GC_CHECK();
    MZ_GC_UNREG();
}

/*
 * ":mzscheme" (or ":mz")
 */
    void
ex_mzscheme(exarg_T *eap)
{
    char_u	*script;

    script = script_get(eap, eap->arg);
    if (eap->skip)
	return;

    if (script == NULL)
	do_mzscheme_command(eap, eap->arg, do_eval);
    else
    {
	do_mzscheme_command(eap, script, do_eval);
	vim_free(script);
    }
}

    static Scheme_Object *
do_load(void *data, int noargc UNUSED, Scheme_Object **noargv UNUSED)
{
    Scheme_Object   *expr = NULL;
    Scheme_Object   *result = NULL;
    char	    *file = NULL;
    Port_Info	    *pinfo = (Port_Info *)data;

    MZ_GC_DECL_REG(3);
    MZ_GC_VAR_IN_REG(0, expr);
    MZ_GC_VAR_IN_REG(1, result);
    MZ_GC_VAR_IN_REG(2, file);
    MZ_GC_REG();

    file = (char *)scheme_malloc_fail_ok(scheme_malloc_atomic, MAXPATHL + 1);
    MZ_GC_CHECK();

    // make Vim expansion
    expand_env((char_u *)pinfo->name, (char_u *)file, MAXPATHL);
    pinfo->port = scheme_open_input_file(file, "mzfile");
    MZ_GC_CHECK();
    scheme_count_lines(pinfo->port);  // to get accurate read error location
    MZ_GC_CHECK();

    // Like REPL but print only last result
    while (!SCHEME_EOFP(expr = scheme_read(pinfo->port)))
    {
	result = scheme_eval(expr, environment);
	MZ_GC_CHECK();
    }

    // errors will be caught in do_mzscheme_command and ex_mzfile
    scheme_close_input_port(pinfo->port);
    MZ_GC_CHECK();
    pinfo->port = NULL;
    MZ_GC_UNREG();
    return result;
}

/*
 * :mzfile
 */
    void
ex_mzfile(exarg_T *eap)
{
    Port_Info	pinfo = {NULL, NULL};

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, pinfo.port);
    MZ_GC_REG();

    pinfo.name = (char *)eap->arg;
    if (do_mzscheme_command(eap, &pinfo, do_load) != OK
	    && pinfo.port != NULL)	// looks like port was not closed
    {
	scheme_close_input_port(pinfo.port);
	MZ_GC_CHECK();
    }
    MZ_GC_UNREG();
}


/*
 *========================================================================
 * Exception handling code -- cribbed form the MzScheme sources and
 * Matthew Flatt's "Inside PLT MzScheme" document.
 *========================================================================
 */
    static void
init_exn_catching_apply(void)
{
    if (exn_catching_apply)
	return;

    char *e =
	"(lambda (thunk) "
	"(with-handlers ([void (lambda (exn) (cons #f exn))]) "
	"(cons #t (thunk))))";

    exn_catching_apply = scheme_eval_string(e, environment);
    MZ_GC_CHECK();
    exn_p = scheme_builtin_value("exn?");
    MZ_GC_CHECK();
    exn_message = scheme_builtin_value("exn-message");
    MZ_GC_CHECK();
}

/*
 * This function applies a thunk, returning the Scheme value if there's
 * no exception, otherwise returning NULL and setting *exn to the raised
 * value (usually an exn structure).
 */
    static Scheme_Object *
_apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn)
{
    Scheme_Object *v;

    v = _scheme_apply(exn_catching_apply, 1, &f);
    // v is a pair: (cons #t value) or (cons #f exn)

    if (SCHEME_TRUEP(SCHEME_CAR(v)))
	return SCHEME_CDR(v);
    else
    {
	*exn = SCHEME_CDR(v);
	return NULL;
    }
}

    static Scheme_Object *
extract_exn_message(Scheme_Object *v)
{
    if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v)))
	return _scheme_apply(exn_message, 1, &v);
    else
	return NULL; // Not an exn structure
}

    static Scheme_Object *
do_eval(void *s, int noargc UNUSED, Scheme_Object **noargv UNUSED)
{
    return scheme_eval_string_all((char *)s, environment, TRUE);
}

/*
 *========================================================================
 *  3.  MzScheme I/O Handlers
 *========================================================================
 */
    static void
do_intrnl_output(char *mesg, int error)
{
    char *p, *prev;

    prev = mesg;
    p = strchr(prev, '\n');
    while (p)
    {
	*p = '\0';
	if (error)
	    emsg(prev);
	else
	    msg(prev);
	prev = p + 1;
	p = strchr(prev, '\n');
    }

    if (error)
	emsg(prev);
    else
	msg(prev);
}

    static void
do_output(char *mesg, OUTPUT_LEN_TYPE len UNUSED)
{
    // TODO: use len, the string may not be NUL terminated
    do_intrnl_output(mesg, 0);
}

    static void
do_err_output(char *mesg)
{
    do_intrnl_output(mesg, 1);
}

    static void
do_printf(char *format, ...)
{
    do_intrnl_output(format, 1);
}

    static void
do_flush(void)
{
    char *buff;
    OUTPUT_LEN_TYPE length;

    buff = scheme_get_sized_byte_string_output(curerr, &length);
    MZ_GC_CHECK();
    if (length)
    {
	do_err_output(buff);
	return;
    }

    buff = scheme_get_sized_byte_string_output(curout, &length);
    MZ_GC_CHECK();
    if (length)
	do_output(buff, length);
}

/*
 *========================================================================
 *  4. Implementation of the Vim Features for MzScheme
 *========================================================================
 */

/*
 * (command {command-string})
 */
    static Scheme_Object *
vim_command(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	*prim = (Vim_Prim *)data;
    Scheme_Object *cmd = NULL;
    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, cmd);
    MZ_GC_REG();
    cmd = GUARANTEED_STRING_ARG(prim->name, 0);

    // may be use do_cmdline_cmd?
    do_cmdline(BYTE_STRING_VALUE(cmd), NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE);
    update_screen(UPD_VALID);

    MZ_GC_UNREG();
    raise_if_error();
    return scheme_void;
}

/*
 * (eval {expr-string})
 */
    static Scheme_Object *
vim_eval(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
#ifdef FEAT_EVAL
    Vim_Prim		*prim = (Vim_Prim *)data;
    Scheme_Object	*result = NULL;
    typval_T		*vim_result;
    Scheme_Object *expr = NULL;
    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, result);
    MZ_GC_VAR_IN_REG(1, expr);
    MZ_GC_REG();
    expr = GUARANTEED_STRING_ARG(prim->name, 0);

    vim_result = eval_expr(BYTE_STRING_VALUE(expr), NULL);

    if (vim_result == NULL)
	raise_vim_exn(_("invalid expression"));

    result = vim_to_mzscheme(vim_result);
    MZ_GC_CHECK();
    free_tv(vim_result);

    MZ_GC_UNREG();
    return result;
#else
    raise_vim_exn(_("expressions disabled at compile time"));
    // unreachable
    return scheme_false;
#endif
}

/*
 * (range-start)
 */
    static Scheme_Object *
get_range_start(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    return scheme_make_integer(range_start);
}

/*
 * (range-end)
 */
    static Scheme_Object *
get_range_end(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    return scheme_make_integer(range_end);
}

/*
 * (beep)
 */
    static Scheme_Object *
mzscheme_beep(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    vim_beep(BO_LANG);
    return scheme_void;
}

static Scheme_Object *M_global = NULL;

/*
 * (get-option {option-name}) [buffer/window]
 */
    static Scheme_Object *
get_option(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    long	    value;
    char	    *strval;
    getoption_T	    rc;
    Scheme_Object   *rval = NULL;
    Scheme_Object   *name = NULL;
    int		    scope = 0;
    buf_T	    *save_curb = curbuf;
    win_T	    *save_curw = curwin;

    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, rval);
    MZ_GC_VAR_IN_REG(1, name);
    MZ_GC_REG();

    name = GUARANTEED_STRING_ARG(prim->name, 0);

    if (argc > 1)
    {
	if (M_global == NULL)
	{
	    MZ_REGISTER_STATIC(M_global);
	    M_global = scheme_intern_symbol("global");
	    MZ_GC_CHECK();
	}

	if (argv[1] == M_global)
	    scope = OPT_GLOBAL;
	else if (SCHEME_VIMBUFFERP(argv[1]))
	{
	    curbuf = get_valid_buffer(argv[1]);
	    scope = OPT_LOCAL;
	}
	else if (SCHEME_VIMWINDOWP(argv[1]))
	{
	    win_T *win = get_valid_window(argv[1]);

	    curwin = win;
	    curbuf = win->w_buffer;
	    scope = OPT_LOCAL;
	}
	else
	    scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
    }

    rc = get_option_value(BYTE_STRING_VALUE(name), &value, (char_u **)&strval,
								  NULL, scope);
    curbuf = save_curb;
    curwin = save_curw;

    switch (rc)
    {
    case gov_bool:
    case gov_number:
	MZ_GC_UNREG();
	return scheme_make_integer_value(value);
    case gov_string:
	rval = scheme_make_byte_string(strval);
	MZ_GC_CHECK();
	vim_free(strval);
	MZ_GC_UNREG();
	return rval;
    case gov_hidden_bool:
    case gov_hidden_number:
    case gov_hidden_string:
	MZ_GC_UNREG();
	raise_vim_exn(_("hidden option"));
	//NOTREACHED
    case gov_unknown:
	MZ_GC_UNREG();
	raise_vim_exn(_("unknown option"));
	//NOTREACHED
    }
    // unreachable
    return scheme_void;
}

/*
 * (set-option {option-changing-string} [buffer/window])
 */
    static Scheme_Object *
set_option(void *data, int argc, Scheme_Object **argv)
{
    char_u	*command = NULL;
    int		scope = 0;
    buf_T	*save_curb = curbuf;
    win_T	*save_curw = curwin;
    Vim_Prim	*prim = (Vim_Prim *)data;
    Scheme_Object *cmd = NULL;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, cmd);
    MZ_GC_REG();
    cmd = GUARANTEED_STRING_ARG(prim->name, 0);

    if (argc > 1)
    {
	if (M_global == NULL)
	{
	    MZ_REGISTER_STATIC(M_global);
	    M_global = scheme_intern_symbol("global");
	    MZ_GC_CHECK();
	}

	if (argv[1] == M_global)
	    scope = OPT_GLOBAL;
	else if (SCHEME_VIMBUFFERP(argv[1]))
	{
	    curbuf = get_valid_buffer(argv[1]);
	    scope = OPT_LOCAL;
	}
	else if (SCHEME_VIMWINDOWP(argv[1]))
	{
	    win_T *win = get_valid_window(argv[1]);
	    curwin = win;
	    curbuf = win->w_buffer;
	    scope = OPT_LOCAL;
	}
	else
	    scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv);
    }

    // do_set can modify cmd, make copy
    command = vim_strsave(BYTE_STRING_VALUE(cmd));
    MZ_GC_UNREG();
    do_set(command, scope);
    vim_free(command);
    update_screen(UPD_NOT_VALID);
    curbuf = save_curb;
    curwin = save_curw;
    raise_if_error();
    return scheme_void;
}

/*
 *===========================================================================
 *  5. Vim Window-related Manipulation Functions
 *===========================================================================
 */

/*
 * (curr-win)
 */
    static Scheme_Object *
get_curr_win(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    return (Scheme_Object *)get_vim_curr_window();
}

/*
 * (win-count)
 */
    static Scheme_Object *
get_window_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    int	    n = 0;
    win_T   *w;

    FOR_ALL_WINDOWS(w)
	++n;
    return scheme_make_integer(n);
}

/*
 * (get-win-list [buffer])
 */
    static Scheme_Object *
get_window_list(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf;
    Scheme_Object   *list;
    win_T	    *w = firstwin;

    buf = get_buffer_arg(prim->name, 0, argc, argv);
    list = scheme_null;

    for ( ; w != NULL; w = w->w_next)
	if (w->w_buffer == buf->buf)
	{
	    list = scheme_make_pair(window_new(w), list);
	    MZ_GC_CHECK();
	}

    return list;
}

    static Scheme_Object *
window_new(win_T *win)
{
    vim_mz_window *self = NULL;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, self);

    // We need to handle deletion of windows underneath us.
    // If we add a "w_mzscheme_ref" field to the win_T structure,
    // then we can get at it in win_free() in vim.
    //
    // On a win_free() we set the Scheme object's win_T *field
    // to an invalid value. We trap all uses of a window
    // object, and reject them if the win_T *field is invalid.
    if (win->w_mzscheme_ref != NULL)
	return (Scheme_Object *)WINDOW_REF(win);

    MZ_GC_REG();
    self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_window));
    CLEAR_POINTER(self);
#ifdef MZ_PRECISE_GC
    win->w_mzscheme_ref = scheme_malloc_immobile_box(NULL);
#else
    scheme_dont_gc_ptr(self);	// because win isn't visible to GC
#endif
    MZ_GC_CHECK();
    WINDOW_REF(win) = self;
    MZ_GC_CHECK();
    self->win = win;
    self->so.type = mz_window_type;

    MZ_GC_UNREG();
    return (Scheme_Object *)self;
}

/*
 * (get-win-num [window])
 */
    static Scheme_Object *
get_window_num(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    int		nr = 1;
    Vim_Prim	*prim = (Vim_Prim *)data;
    win_T	*win = get_window_arg(prim->name, 0, argc, argv)->win;
    win_T	*wp;

    for (wp = firstwin; wp != win; wp = wp->w_next)
	++nr;

    return scheme_make_integer(nr);
}

/*
 * (get-win-by-num {windownum})
 */
    static Scheme_Object *
get_window_by_num(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	*prim = (Vim_Prim *)data;
    win_T	*win = firstwin;
    int		fnum;

    fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
    if (fnum < 1)
	scheme_signal_error(_("window index is out of range"));

    for ( ; win != NULL; win = win->w_next, --fnum)
	if (fnum == 1)	    // to be 1-based
	    return window_new(win);

    return scheme_false;
}

/*
 * (get-win-buffer [window])
 */
    static Scheme_Object *
get_window_buffer(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_window   *win = get_window_arg(prim->name, 0, argc, argv);

    return buffer_new(win->win->w_buffer);
}

/*
 * (get-win-height [window])
 */
    static Scheme_Object *
get_window_height(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_window   *win = get_window_arg(prim->name, 0, argc, argv);

    return scheme_make_integer(win->win->w_height);
}

/*
 * (set-win-height {height} [window])
 */
    static Scheme_Object *
set_window_height(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_window   *win;
    win_T	    *savewin;
    int		    height;

    win = get_window_arg(prim->name, 1, argc, argv);
    height = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));

#ifdef FEAT_GUI
    need_mouse_correct = TRUE;
#endif

    savewin = curwin;
    curwin = win->win;
    win_setheight(height);
    curwin = savewin;

    raise_if_error();
    return scheme_void;
}

/*
 * (get-win-width [window])
 */
    static Scheme_Object *
get_window_width(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_window   *win = get_window_arg(prim->name, 0, argc, argv);

    return scheme_make_integer(win->win->w_width);
}

/*
 * (set-win-width {width} [window])
 */
    static Scheme_Object *
set_window_width(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_window   *win;
    win_T	    *savewin;
    int		    width = 0;

    win = get_window_arg(prim->name, 1, argc, argv);
    width = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));

# ifdef FEAT_GUI
    need_mouse_correct = TRUE;
# endif

    savewin = curwin;
    curwin = win->win;
    win_setwidth(width);
    curwin = savewin;

    raise_if_error();
    return scheme_void;
}

/*
 * (get-cursor [window]) -> (line . col)
 */
    static Scheme_Object *
get_cursor(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_window   *win;
    pos_T	    pos;

    win = get_window_arg(prim->name, 0, argc, argv);
    pos = win->win->w_cursor;
    return scheme_make_pair(scheme_make_integer_value((long)pos.lnum),
		    scheme_make_integer_value((long)pos.col + 1));
}

/*
 * (set-cursor (line . col) [window])
 */
    static Scheme_Object *
set_cursor(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_window   *win;
    long	    lnum = 0;
    long	    col = 0;

#ifdef HAVE_SANDBOX
    sandbox_check();
#endif
    win = get_window_arg(prim->name, 1, argc, argv);
    GUARANTEE_PAIR(prim->name, 0);

    if (!SCHEME_INTP(SCHEME_CAR(argv[0]))
	    || !SCHEME_INTP(SCHEME_CDR(argv[0])))
	scheme_wrong_type(prim->name, "integer pair", 0, argc, argv);

    lnum = SCHEME_INT_VAL(SCHEME_CAR(argv[0]));
    col = SCHEME_INT_VAL(SCHEME_CDR(argv[0])) - 1;

    check_line_range(lnum, win->win->w_buffer);
    // don't know how to catch invalid column value

    win->win->w_cursor.lnum = lnum;
    win->win->w_cursor.col = col;
    win->win->w_set_curswant = TRUE;
    update_screen(UPD_VALID);

    raise_if_error();
    return scheme_void;
}
/*
 *===========================================================================
 *  6. Vim Buffer-related Manipulation Functions
 *===========================================================================
 */

/*
 * (open-buff {filename})
 */
    static Scheme_Object *
mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    int		    num = 0;
    Scheme_Object   *onum = NULL;
    Scheme_Object   *buf = NULL;
    Scheme_Object   *fname;

    MZ_GC_DECL_REG(3);
    MZ_GC_VAR_IN_REG(0, onum);
    MZ_GC_VAR_IN_REG(1, buf);
    MZ_GC_VAR_IN_REG(2, fname);
    MZ_GC_REG();
    fname = GUARANTEED_STRING_ARG(prim->name, 0);

#ifdef HAVE_SANDBOX
    sandbox_check();
#endif
    // TODO make open existing file
    num = buflist_add(BYTE_STRING_VALUE(fname), BLN_LISTED | BLN_CURBUF);

    if (num == 0)
	raise_vim_exn(_("couldn't open buffer"));

    onum = scheme_make_integer(num);
    buf = get_buffer_by_num(data, 1, &onum);
    MZ_GC_UNREG();
    return buf;
}

/*
 * (get-buff-by-num {buffernum})
 */
    static Scheme_Object *
get_buffer_by_num(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	*prim = (Vim_Prim *)data;
    buf_T	*buf;
    int		fnum;

    fnum = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));

    FOR_ALL_BUFFERS(buf)
	if (buf->b_fnum == fnum)
	    return buffer_new(buf);

    return scheme_false;
}

/*
 * (get-buff-by-name {buffername})
 */
    static Scheme_Object *
get_buffer_by_name(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	*prim = (Vim_Prim *)data;
    buf_T	*buf;
    Scheme_Object *buffer = NULL;
    Scheme_Object *fname = NULL;

    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, buffer);
    MZ_GC_VAR_IN_REG(1, fname);
    MZ_GC_REG();
    fname = GUARANTEED_STRING_ARG(prim->name, 0);
    buffer = scheme_false;

    FOR_ALL_BUFFERS(buf)
    {
	if (buf->b_ffname == NULL || buf->b_sfname == NULL)
	    // empty string
	{
	    if (BYTE_STRING_VALUE(fname)[0] == NUL)
		buffer = buffer_new(buf);
	}
	else if (!fnamecmp(buf->b_ffname, BYTE_STRING_VALUE(fname))
		|| !fnamecmp(buf->b_sfname, BYTE_STRING_VALUE(fname)))
	{
	    // either short or long filename matches
	    buffer = buffer_new(buf);
	}
    }

    MZ_GC_UNREG();
    return buffer;
}

/*
 * (get-next-buff [buffer])
 */
    static Scheme_Object *
get_next_buffer(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	*prim = (Vim_Prim *)data;
    buf_T	*buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;

    if (buf->b_next == NULL)
	return scheme_false;
    else
	return buffer_new(buf->b_next);
}

/*
 * (get-prev-buff [buffer])
 */
    static Scheme_Object *
get_prev_buffer(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	*prim = (Vim_Prim *)data;
    buf_T	*buf = get_buffer_arg(prim->name, 0, argc, argv)->buf;

    if (buf->b_prev == NULL)
	return scheme_false;
    else
	return buffer_new(buf->b_prev);
}

/*
 * (get-buff-num [buffer])
 */
    static Scheme_Object *
get_buffer_num(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf = get_buffer_arg(prim->name, 0, argc, argv);

    return scheme_make_integer(buf->buf->b_fnum);
}

/*
 * (buff-count)
 */
    static Scheme_Object *
get_buffer_count(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    buf_T   *b;
    int	    n = 0;

    FOR_ALL_BUFFERS(b) ++n;
    return scheme_make_integer(n);
}

/*
 * (get-buff-name [buffer])
 */
    static Scheme_Object *
get_buffer_name(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf = get_buffer_arg(prim->name, 0, argc, argv);

    return scheme_make_byte_string((char *)buf->buf->b_ffname);
}

/*
 * (curr-buff)
 */
    static Scheme_Object *
get_curr_buffer(void *data UNUSED, int argc UNUSED, Scheme_Object **argv UNUSED)
{
    return (Scheme_Object *)get_vim_curr_buffer();
}

    static Scheme_Object *
buffer_new(buf_T *buf)
{
    vim_mz_buffer *self = NULL;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, self);

    // We need to handle deletion of buffers underneath us.
    // If we add a "b_mzscheme_ref" field to the buf_T structure,
    // then we can get at it in buf_freeall() in vim.
    if (buf->b_mzscheme_ref)
	return (Scheme_Object *)BUFFER_REF(buf);

    MZ_GC_REG();
    self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_buffer));
    CLEAR_POINTER(self);
#ifdef MZ_PRECISE_GC
    buf->b_mzscheme_ref = scheme_malloc_immobile_box(NULL);
#else
    scheme_dont_gc_ptr(self);	// because buf isn't visible to GC
#endif
    MZ_GC_CHECK();
    BUFFER_REF(buf) = self;
    MZ_GC_CHECK();
    self->buf = buf;
    self->so.type = mz_buffer_type;

    MZ_GC_UNREG();
    return (Scheme_Object *)self;
}

/*
 * (get-buff-size [buffer])
 *
 * Get the size (number of lines) in the current buffer.
 */
    static Scheme_Object *
get_buffer_size(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf = get_buffer_arg(prim->name, 0, argc, argv);

    return scheme_make_integer(buf->buf->b_ml.ml_line_count);
}

/*
 * (get-buff-line {linenr} [buffer])
 *
 * Get a line from the specified buffer. The line number is
 * in Vim format (1-based). The line is returned as a MzScheme
 * string object.
 */
    static Scheme_Object *
get_buffer_line(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf;
    int		    linenr;
    char_u	    *line;

    buf = get_buffer_arg(prim->name, 1, argc, argv);
    linenr = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
    line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE);

    raise_if_error();
    return scheme_make_byte_string((char *)line);
}


/*
 * (get-buff-line-list {start} {end} [buffer])
 *
 * Get a list of lines from the specified buffer. The line numbers
 * are in Vim format (1-based). The range is from lo up to, but not
 * including, hi. The list is returned as a list of string objects.
 */
    static Scheme_Object *
get_buffer_line_list(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf;
    int		    i, hi, lo, n;
    Scheme_Object   *list = NULL;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, list);
    MZ_GC_REG();

    buf = get_buffer_arg(prim->name, 2, argc, argv);
    list = scheme_null;
    hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
    lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));

    /*
     * Handle some error conditions
     */
    if (lo < 0)
	lo = 0;

    if (hi < 0)
	hi = 0;
    if (hi < lo)
	hi = lo;

    n = hi - lo;

    for (i = n; i >= 0; --i)
    {
	Scheme_Object *str = scheme_make_byte_string(
		       (char *)ml_get_buf(buf->buf, (linenr_T)(lo+i), FALSE));
	raise_if_error();

	// Set the list item
	list = scheme_make_pair(str, list);
	MZ_GC_CHECK();
    }
    MZ_GC_UNREG();
    return list;
}

/*
 * (set-buff-line {linenr} {string/#f} [buffer])
 *
 * Replace a line in the specified buffer. The line number is
 * in Vim format (1-based). The replacement line is given as
 * an MzScheme string object. The object is checked for validity
 * and correct format. An exception is thrown if the values are not
 * the correct format.
 *
 * It returns a Scheme Object that indicates the length of the
 * string changed.
 */
    static Scheme_Object *
set_buffer_line(void *data, int argc, Scheme_Object **argv)
{
    // First of all, we check the value of the supplied MzScheme object.
    // There are three cases:
    //	  1. #f - this is a deletion.
    //	  2. A string	   - this is a replacement.
    //	  3. Anything else - this is an error.
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf;
    Scheme_Object   *line = NULL;
    char	    *save;
    int		    n;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, line);
    MZ_GC_REG();

#ifdef HAVE_SANDBOX
    sandbox_check();
#endif
    n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
    if (!SCHEME_STRINGP(argv[1]) && !SCHEME_FALSEP(argv[1]))
	scheme_wrong_type(prim->name, "string or #f", 1, argc, argv);
    line = argv[1];
    buf = get_buffer_arg(prim->name, 2, argc, argv);

    check_line_range(n, buf->buf);

    if (SCHEME_FALSEP(line))
    {
	buf_T	    *savebuf = curbuf;

	curbuf = buf->buf;

	if (u_savedel((linenr_T)n, 1L) == FAIL)
	{
	    curbuf = savebuf;
	    raise_vim_exn(_("cannot save undo information"));
	}
	else if (ml_delete((linenr_T)n) == FAIL)
	{
	    curbuf = savebuf;
	    raise_vim_exn(_("cannot delete line"));
	}
	if (buf->buf == curwin->w_buffer)
	    mz_fix_cursor(n, n + 1, -1);
	deleted_lines_mark((linenr_T)n, 1L);

	curbuf = savebuf;

	MZ_GC_UNREG();
	raise_if_error();
	return scheme_void;
    }
    else
    {
	// Otherwise it's a line
	buf_T	    *savebuf = curbuf;

	save = string_to_line(line);

	curbuf = buf->buf;

	if (u_savesub((linenr_T)n) == FAIL)
	{
	    curbuf = savebuf;
	    vim_free(save);
	    raise_vim_exn(_("cannot save undo information"));
	}
	else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL)
	{
	    curbuf = savebuf;
	    vim_free(save);
	    raise_vim_exn(_("cannot replace line"));
	}
	else
	{
	    vim_free(save);
	    changed_bytes((linenr_T)n, 0);
	}

	curbuf = savebuf;

	// Check that the cursor is not beyond the end of the line now.
	if (buf->buf == curwin->w_buffer)
	    check_cursor_col();

	MZ_GC_UNREG();
	raise_if_error();
	return scheme_void;
    }
}

    static void
free_array(char **array)
{
    char **curr = array;
    while (*curr != NULL)
	vim_free(*curr++);
    vim_free(array);
}

/*
 * (set-buff-line-list {start} {end} {string-list/#f/null} [buffer])
 *
 * Replace a range of lines in the specified buffer. The line numbers are in
 * Vim format (1-based). The range is from lo up to, but not including, hi.
 * The replacement lines are given as a Scheme list of string objects. The
 * list is checked for validity and correct format.
 *
 * Errors are returned as a value of FAIL. The return value is OK on success.
 * If OK is returned and len_change is not NULL, *len_change is set to the
 * change in the buffer length.
 */
    static Scheme_Object *
set_buffer_line_list(void *data, int argc, Scheme_Object **argv)
{
    // First of all, we check the type of the supplied MzScheme object.
    // There are three cases:
    //	  1. #f - this is a deletion.
    //	  2. A list	   - this is a replacement.
    //	  3. Anything else - this is an error.
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf = NULL;
    Scheme_Object   *line_list = NULL;
    int		    i, old_len, new_len, hi, lo;
    long	    extra;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, line_list);
    MZ_GC_REG();

#ifdef HAVE_SANDBOX
    sandbox_check();
#endif
    lo = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
    hi = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 1));
    if (!SCHEME_PAIRP(argv[2])
	    && !SCHEME_FALSEP(argv[2]) && !SCHEME_NULLP(argv[2]))
	scheme_wrong_type(prim->name, "list or #f", 2, argc, argv);
    line_list = argv[2];
    buf = get_buffer_arg(prim->name, 3, argc, argv);
    old_len = hi - lo;
    if (old_len < 0) // process inverse values wisely
    {
	i = lo;
	lo = hi;
	hi = i;
	old_len = -old_len;
    }
    extra = 0;

    check_line_range(lo, buf->buf);	    // inclusive
    check_line_range(hi - 1, buf->buf);	    // exclusive

    if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list))
    {
	buf_T	*savebuf = curbuf;
	curbuf = buf->buf;

	if (u_savedel((linenr_T)lo, (long)old_len) == FAIL)
	{
	    curbuf = savebuf;
	    raise_vim_exn(_("cannot save undo information"));
	}
	else
	{
	    for (i = 0; i < old_len; i++)
		if (ml_delete((linenr_T)lo) == FAIL)
		{
		    curbuf = savebuf;
		    raise_vim_exn(_("cannot delete line"));
		}
	    if (buf->buf == curwin->w_buffer)
		mz_fix_cursor(lo, hi, -old_len);
	    deleted_lines_mark((linenr_T)lo, (long)old_len);
	}

	curbuf = savebuf;

	MZ_GC_UNREG();
	raise_if_error();
	return scheme_void;
    }
    else
    {
	buf_T	*savebuf = curbuf;

	// List
	new_len = scheme_proper_list_length(line_list);
	MZ_GC_CHECK();
	if (new_len < 0)	// improper or cyclic list
	    scheme_wrong_type(prim->name, "proper list",
		    2, argc, argv);
	else
	{
	    char		**array = NULL;
	    Scheme_Object   *line = NULL;
	    Scheme_Object   *rest = NULL;

	    MZ_GC_DECL_REG(2);
	    MZ_GC_VAR_IN_REG(0, line);
	    MZ_GC_VAR_IN_REG(1, rest);
	    MZ_GC_REG();

	    array = ALLOC_CLEAR_MULT(char *, new_len + 1);

	    rest = line_list;
	    for (i = 0; i < new_len; ++i)
	    {
		line = SCHEME_CAR(rest);
		rest = SCHEME_CDR(rest);
		if (!SCHEME_STRINGP(line))
		{
		    free_array(array);
		    scheme_wrong_type(prim->name, "string-list", 2, argc, argv);
		}
		array[i] = string_to_line(line);
	    }

	    curbuf = buf->buf;

	    if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL)
	    {
		curbuf = savebuf;
		free_array(array);
		raise_vim_exn(_("cannot save undo information"));
	    }

	    /*
	     * If the size of the range is reducing (ie, new_len < old_len) we
	     * need to delete some old_len. We do this at the start, by
	     * repeatedly deleting line "lo".
	     */
	    for (i = 0; i < old_len - new_len; ++i)
	    {
		if (ml_delete((linenr_T)lo) == FAIL)
		{
		    curbuf = savebuf;
		    free_array(array);
		    raise_vim_exn(_("cannot delete line"));
		}
		extra--;
	    }

	    /*
	     * For as long as possible, replace the existing old_len with the
	     * new old_len. This is a more efficient operation, as it requires
	     * less memory allocation and freeing.
	     */
	    for (i = 0; i < old_len && i < new_len; i++)
		if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL)
		{
		    curbuf = savebuf;
		    free_array(array);
		    raise_vim_exn(_("cannot replace line"));
		}

	    /*
	     * Now we may need to insert the remaining new_len.  We don't need to
	     * free the string passed back because MzScheme has control of that
	     * memory.
	     */
	    while (i < new_len)
	    {
		if (ml_append((linenr_T)(lo + i - 1),
			    (char_u *)array[i], 0, FALSE) == FAIL)
		{
		    curbuf = savebuf;
		    free_array(array);
		    raise_vim_exn(_("cannot insert line"));
		}
		++i;
		++extra;
	    }
	    MZ_GC_UNREG();
	    free_array(array);
	}

	/*
	 * Adjust marks. Invalidate any which lie in the
	 * changed range, and move any in the remainder of the buffer.
	 */
	mark_adjust((linenr_T)lo, (linenr_T)(hi - 1),
						  (long)MAXLNUM, (long)extra);
	changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra);

	if (buf->buf == curwin->w_buffer)
	    mz_fix_cursor(lo, hi, extra);
	curbuf = savebuf;

	MZ_GC_UNREG();
	raise_if_error();
	return scheme_void;
    }
}

/*
 * (insert-buff-line-list {linenr} {string/string-list} [buffer])
 *
 * Insert a number of lines into the specified buffer after the specified line.
 * The line number is in Vim format (1-based). The lines to be inserted are
 * given as an MzScheme list of string objects or as a single string. The lines
 * to be added are checked for validity and correct format. Errors are
 * returned as a value of FAIL.  The return value is OK on success.
 * If OK is returned and len_change is not NULL, *len_change
 * is set to the change in the buffer length.
 */
    static Scheme_Object *
insert_buffer_line_list(void *data, int argc, Scheme_Object **argv)
{
    Vim_Prim	    *prim = (Vim_Prim *)data;
    vim_mz_buffer   *buf = NULL;
    Scheme_Object   *list = NULL;
    char	    *str = NULL;
    int		    i, n, size;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, list);
    MZ_GC_REG();

#ifdef HAVE_SANDBOX
    sandbox_check();
#endif
    /*
     * First of all, we check the type of the supplied MzScheme object.
     * It must be a string or a list, or the call is in error.
     */
    n = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0));
    list = argv[1];

    if (!SCHEME_STRINGP(list) && !SCHEME_PAIRP(list))
	scheme_wrong_type(prim->name, "string or list", 1, argc, argv);
    buf = get_buffer_arg(prim->name, 2, argc, argv);

    if (n != 0)	    // 0 can be used in insert
	check_line_range(n, buf->buf);
    if (SCHEME_STRINGP(list))
    {
	buf_T	    *savebuf = curbuf;

	str = string_to_line(list);
	curbuf = buf->buf;

	if (u_save((linenr_T)n, (linenr_T)(n+1)) == FAIL)
	{
	    curbuf = savebuf;
	    vim_free(str);
	    raise_vim_exn(_("cannot save undo information"));
	}
	else if (ml_append((linenr_T)n, (char_u *)str, 0, FALSE) == FAIL)
	{
	    curbuf = savebuf;
	    vim_free(str);
	    raise_vim_exn(_("cannot insert line"));
	}
	else
	{
	    vim_free(str);
	    appended_lines_mark((linenr_T)n, 1L);
	}

	curbuf = savebuf;
	update_screen(UPD_VALID);

	MZ_GC_UNREG();
	raise_if_error();
	return scheme_void;
    }

    // List
    size = scheme_proper_list_length(list);
    MZ_GC_CHECK();
    if (size < 0)	// improper or cyclic list
	scheme_wrong_type(prim->name, "proper list",
		2, argc, argv);
    else
    {
	Scheme_Object   *line = NULL;
	Scheme_Object   *rest = NULL;
	char		**array;
	buf_T		*savebuf = curbuf;

	MZ_GC_DECL_REG(2);
	MZ_GC_VAR_IN_REG(0, line);
	MZ_GC_VAR_IN_REG(1, rest);
	MZ_GC_REG();

	array = ALLOC_CLEAR_MULT(char *, size + 1);

	rest = list;
	for (i = 0; i < size; ++i)
	{
	    line = SCHEME_CAR(rest);
	    rest = SCHEME_CDR(rest);
	    array[i] = string_to_line(line);
	}

	curbuf = buf->buf;

	if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL)
	{
	    curbuf = savebuf;
	    free_array(array);
	    raise_vim_exn(_("cannot save undo information"));
	}
	else
	{
	    for (i = 0; i < size; ++i)
		if (ml_append((linenr_T)(n + i), (char_u *)array[i],
			    0, FALSE) == FAIL)
		{
		    curbuf = savebuf;
		    free_array(array);
		    raise_vim_exn(_("cannot insert line"));
		}

	    if (i > 0)
		appended_lines_mark((linenr_T)n, (long)i);
	}
	free_array(array);
	MZ_GC_UNREG();
	curbuf = savebuf;
	update_screen(UPD_VALID);
    }

    MZ_GC_UNREG();
    raise_if_error();
    return scheme_void;
}

/*
 * Predicates
 */
/*
 * (buff? obj)
 */
    static Scheme_Object *
vim_bufferp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
{
    if (SCHEME_VIMBUFFERP(argv[0]))
	return scheme_true;
    else
	return scheme_false;
}

/*
 * (win? obj)
 */
    static Scheme_Object *
vim_windowp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
{
    if (SCHEME_VIMWINDOWP(argv[0]))
	return scheme_true;
    else
	return scheme_false;
}

/*
 * (buff-valid? obj)
 */
    static Scheme_Object *
vim_buffer_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
{
    if (SCHEME_VIMBUFFERP(argv[0])
	    && ((vim_mz_buffer *)argv[0])->buf != INVALID_BUFFER_VALUE)
	return scheme_true;
    else
	return scheme_false;
}

/*
 * (win-valid? obj)
 */
    static Scheme_Object *
vim_window_validp(void *data UNUSED, int argc UNUSED, Scheme_Object **argv)
{
    if (SCHEME_VIMWINDOWP(argv[0])
	    && ((vim_mz_window *)argv[0])->win != INVALID_WINDOW_VALUE)
	return scheme_true;
    else
	return scheme_false;
}

/*
 *===========================================================================
 * Utilities
 *===========================================================================
 */

/*
 * Convert an MzScheme string into a Vim line.
 *
 * All internal nulls are replaced by newline characters.
 * It is an error for the string to contain newline characters.
 *
 * Returns pointer to Vim allocated memory
 */
    static char *
string_to_line(Scheme_Object *obj)
{
    char	*scheme_str = NULL;
    char	*vim_str = NULL;
    OUTPUT_LEN_TYPE	len;
    int		i;

    scheme_str = scheme_display_to_string(obj, &len);

    // Error checking: String must not contain newlines, as we
    // are replacing a single line, and we must replace it with
    // a single line.
    if (memchr(scheme_str, '\n', len))
	scheme_signal_error(_("string cannot contain newlines"));

    vim_str = alloc(len + 1);

    // Create a copy of the string, with internal nulls replaced by
    // newline characters, as is the vim convention.
    for (i = 0; i < len; ++i)
    {
	if (scheme_str[i] == '\0')
	    vim_str[i] = '\n';
	else
	    vim_str[i] = scheme_str[i];
    }

    vim_str[i] = '\0';

    MZ_GC_CHECK();
    return vim_str;
}

#ifdef FEAT_EVAL
/*
 * Convert Vim value into MzScheme, adopted from if_python.c
 */
    static Scheme_Object *
vim_to_mzscheme(typval_T *vim_value)
{
    Scheme_Object	*result = NULL;
    // hash table to store visited values to avoid infinite loops
    Scheme_Hash_Table	*visited = NULL;

    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, result);
    MZ_GC_VAR_IN_REG(1, visited);
    MZ_GC_REG();

    visited = scheme_make_hash_table(SCHEME_hash_ptr);
    MZ_GC_CHECK();

    result = vim_to_mzscheme_impl(vim_value, 1, visited);

    MZ_GC_UNREG();
    return result;
}

    static Scheme_Object *
vim_to_mzscheme_impl(typval_T *vim_value, int depth, Scheme_Hash_Table *visited)
{
    Scheme_Object   *result = NULL;
    int		    new_value = TRUE;

    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, result);
    MZ_GC_VAR_IN_REG(1, visited);
    MZ_GC_REG();

    // Avoid infinite recursion
    if (depth > 100)
    {
	MZ_GC_UNREG();
	return scheme_void;
    }

    // Check if we run into a recursive loop.  The item must be in visited
    // then and we can use it again.
    result = scheme_hash_get(visited, (Scheme_Object *)vim_value);
    MZ_GC_CHECK();
    if (result != NULL) // found, do nothing
	new_value = FALSE;
    else if (vim_value->v_type == VAR_STRING)
    {
	result = scheme_make_byte_string((char *)vim_value->vval.v_string);
	MZ_GC_CHECK();
    }
    else if (vim_value->v_type == VAR_NUMBER)
    {
	result = scheme_make_integer((long)vim_value->vval.v_number);
	MZ_GC_CHECK();
    }
    else if (vim_value->v_type == VAR_FLOAT)
    {
	result = scheme_make_double((double)vim_value->vval.v_float);
	MZ_GC_CHECK();
    }
    else if (vim_value->v_type == VAR_LIST)
    {
	list_T		*list = vim_value->vval.v_list;
	listitem_T	*curr;

	if (list == NULL || list->lv_first == NULL)
	    result = scheme_null;
	else
	{
	    Scheme_Object   *obj = NULL;

	    MZ_GC_DECL_REG(1);
	    MZ_GC_VAR_IN_REG(0, obj);
	    MZ_GC_REG();

	    curr = list->lv_u.mat.lv_last;
	    obj = vim_to_mzscheme_impl(&curr->li_tv, depth + 1, visited);
	    result = scheme_make_pair(obj, scheme_null);
	    MZ_GC_CHECK();

	    while (curr != list->lv_first)
	    {
		curr = curr->li_prev;
		obj = vim_to_mzscheme_impl(&curr->li_tv, depth + 1, visited);
		result = scheme_make_pair(obj, result);
		MZ_GC_CHECK();
	    }
	}
	MZ_GC_UNREG();
    }
    else if (vim_value->v_type == VAR_DICT)
    {
	Scheme_Object	  *key = NULL;
	Scheme_Object	  *obj = NULL;

	MZ_GC_DECL_REG(2);
	MZ_GC_VAR_IN_REG(0, key);
	MZ_GC_VAR_IN_REG(1, obj);
	MZ_GC_REG();

	result = (Scheme_Object *)scheme_make_hash_table(SCHEME_hash_ptr);
	MZ_GC_CHECK();
	if (vim_value->vval.v_dict != NULL)
	{
	    hashtab_T	*ht = &vim_value->vval.v_dict->dv_hashtab;
	    long_u	todo = ht->ht_used;
	    hashitem_T	*hi;
	    dictitem_T	*di;

	    FOR_ALL_HASHTAB_ITEMS(ht, hi, todo)
	    {
		if (!HASHITEM_EMPTY(hi))
		{
		    --todo;

		    di = dict_lookup(hi);
		    obj = vim_to_mzscheme_impl(&di->di_tv, depth + 1, visited);
		    key = scheme_make_byte_string((char *)hi->hi_key);
		    MZ_GC_CHECK();
		    scheme_hash_set((Scheme_Hash_Table *)result, key, obj);
		    MZ_GC_CHECK();
		}
	    }
	}
	MZ_GC_UNREG();
    }
    else if (vim_value->v_type == VAR_FUNC)
    {
	Scheme_Object *funcname = NULL;

	MZ_GC_DECL_REG(1);
	MZ_GC_VAR_IN_REG(0, funcname);
	MZ_GC_REG();

	// FIXME: func_ref() and func_unref() are needed.
	funcname = scheme_make_byte_string((char *)vim_value->vval.v_string);
	MZ_GC_CHECK();
	result = scheme_make_closed_prim_w_arity(vim_funcref, funcname,
		(const char *)BYTE_STRING_VALUE(funcname), 0, -1);
	MZ_GC_CHECK();

	MZ_GC_UNREG();
    }
    else if (vim_value->v_type == VAR_PARTIAL)
    {
	if (vim_value->vval.v_partial == NULL)
	    result = scheme_null;
	else
	{
	    Scheme_Object *funcname = NULL;

	    MZ_GC_DECL_REG(1);
	    MZ_GC_VAR_IN_REG(0, funcname);
	    MZ_GC_REG();

	    // FIXME: func_ref() and func_unref() are needed.
	    // TODO: Support pt_dict and pt_argv.
	    funcname = scheme_make_byte_string(
			      (char *)partial_name(vim_value->vval.v_partial));
	    MZ_GC_CHECK();
	    result = scheme_make_closed_prim_w_arity(vim_funcref, funcname,
		    (const char *)BYTE_STRING_VALUE(funcname), 0, -1);
	    MZ_GC_CHECK();

	    MZ_GC_UNREG();
	}
    }
    else if (vim_value->v_type == VAR_BOOL || vim_value->v_type == VAR_SPECIAL)
    {
	if (vim_value->vval.v_number <= VVAL_TRUE)
	    result = scheme_make_integer((long)vim_value->vval.v_number);
	else
	    result = scheme_null;
	MZ_GC_CHECK();
    }
    else
    {
	result = scheme_void;
	new_value = FALSE;
    }
    if (new_value)
    {
	scheme_hash_set(visited, (Scheme_Object *)vim_value, result);
	MZ_GC_CHECK();
    }
    MZ_GC_UNREG();
    return result;
}

    static int
mzscheme_to_vim(Scheme_Object *obj, typval_T *tv)
{
    int i, status;
    Scheme_Hash_Table	*visited = NULL;

    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, obj);
    MZ_GC_VAR_IN_REG(1, visited);
    MZ_GC_REG();

    visited = scheme_make_hash_table(SCHEME_hash_ptr);
    MZ_GC_CHECK();

    status = mzscheme_to_vim_impl(obj, tv, 1, visited);
    for (i = 0; i < visited->size; ++i)
    {
	// free up remembered objects
	if (visited->vals[i] != NULL)
	    free_tv((typval_T *)visited->vals[i]);
    }

    MZ_GC_UNREG();
    return status;
}
    static int
mzscheme_to_vim_impl(Scheme_Object *obj, typval_T *tv, int depth,
	Scheme_Hash_Table *visited)
{
    int		status = OK;
    typval_T	*found;

    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, obj);
    MZ_GC_VAR_IN_REG(1, visited);
    MZ_GC_REG();

    MZ_GC_CHECK();
    if (depth > 100) // limit the deepest recursion level
    {
	tv->v_type = VAR_NUMBER;
	tv->vval.v_number = 0;
	return FAIL;
    }

    found = (typval_T *)scheme_hash_get(visited, obj);
    if (found != NULL)
	copy_tv(found, tv);
    else if (SCHEME_VOIDP(obj))
    {
	tv->v_type = VAR_SPECIAL;
	tv->vval.v_number = VVAL_NULL;
    }
    else if (SCHEME_INTP(obj))
    {
	tv->v_type = VAR_NUMBER;
	tv->vval.v_number = SCHEME_INT_VAL(obj);
    }
    else if (SCHEME_BOOLP(obj))
    {
	tv->v_type = VAR_BOOL;
	tv->vval.v_number = SCHEME_TRUEP(obj);
    }
    else if (SCHEME_DBLP(obj))
    {
	tv->v_type = VAR_FLOAT;
	tv->vval.v_float = SCHEME_DBL_VAL(obj);
    }
    else if (SCHEME_BYTE_STRINGP(obj))
    {
	tv->v_type = VAR_STRING;
	tv->vval.v_string = vim_strsave(BYTE_STRING_VALUE(obj));
    }
# if MZSCHEME_VERSION_MAJOR >= 299
    else if (SCHEME_CHAR_STRINGP(obj))
    {
	Scheme_Object *tmp = NULL;
	MZ_GC_DECL_REG(1);
	MZ_GC_VAR_IN_REG(0, tmp);
	MZ_GC_REG();

	tmp = scheme_char_string_to_byte_string(obj);
	tv->v_type = VAR_STRING;
	tv->vval.v_string = vim_strsave(BYTE_STRING_VALUE(tmp));
	MZ_GC_UNREG();
    }
#endif
    else if (SCHEME_VECTORP(obj) || SCHEME_NULLP(obj)
	    || SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
    {
	list_T  *list = list_alloc();
	if (list == NULL)
	    status = FAIL;
	else
	{
	    int		    i;
	    Scheme_Object   *curr = NULL;
	    Scheme_Object   *cval = NULL;
	    // temporary var to hold current element of vectors and pairs
	    typval_T	    *v;

	    MZ_GC_DECL_REG(2);
	    MZ_GC_VAR_IN_REG(0, curr);
	    MZ_GC_VAR_IN_REG(1, cval);
	    MZ_GC_REG();

	    tv->v_type = VAR_LIST;
	    tv->vval.v_list = list;
	    ++list->lv_refcount;

	    v = ALLOC_ONE(typval_T);
	    if (v == NULL)
		status = FAIL;
	    else
	    {
		// add the value in advance to allow handling of self-referential
		// data structures
		typval_T    *visited_tv = ALLOC_ONE(typval_T);
		copy_tv(tv, visited_tv);
		scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);

		if (SCHEME_VECTORP(obj))
		{
		    for (i = 0; i < SCHEME_VEC_SIZE(obj); ++i)
		    {
			cval = SCHEME_VEC_ELS(obj)[i];
			status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
			if (status == FAIL)
			    break;
			status = list_append_tv(list, v);
			clear_tv(v);
			if (status == FAIL)
			    break;
		    }
		}
		else if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj))
		{
		    for (curr = obj;
			    SCHEME_PAIRP(curr) || SCHEME_MUTABLE_PAIRP(curr);
			    curr = SCHEME_CDR(curr))
		    {
			cval = SCHEME_CAR(curr);
			status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
			if (status == FAIL)
			    break;
			status = list_append_tv(list, v);
			clear_tv(v);
			if (status == FAIL)
			    break;
		    }
		    // improper list not terminated with null
		    // need to handle the last element
		    if (status == OK && !SCHEME_NULLP(curr))
		    {
			status = mzscheme_to_vim_impl(cval, v, depth + 1, visited);
			if (status == OK)
			{
			    status = list_append_tv(list, v);
			    clear_tv(v);
			}
		    }
		}
		// nothing to do for scheme_null
		vim_free(v);
	    }
	    MZ_GC_UNREG();
	}
    }
    else if (SCHEME_HASHTP(obj))
    {
	int		i;
	dict_T		*dict;
	Scheme_Object   *key = NULL;
	Scheme_Object   *val = NULL;

	MZ_GC_DECL_REG(2);
	MZ_GC_VAR_IN_REG(0, key);
	MZ_GC_VAR_IN_REG(1, val);
	MZ_GC_REG();

	dict = dict_alloc();
	if (dict == NULL)
	    status = FAIL;
	else
	{
	    typval_T    *visited_tv = ALLOC_ONE(typval_T);

	    tv->v_type = VAR_DICT;
	    tv->vval.v_dict = dict;
	    ++dict->dv_refcount;

	    copy_tv(tv, visited_tv);
	    scheme_hash_set(visited, obj, (Scheme_Object *)visited_tv);

	    for (i = 0; i < ((Scheme_Hash_Table *)obj)->size; ++i)
	    {
		if (((Scheme_Hash_Table *) obj)->vals[i] != NULL)
		{
		    // generate item for `display'ed Scheme key
		    dictitem_T  *item = dictitem_alloc((char_u *)string_to_line(
				((Scheme_Hash_Table *) obj)->keys[i]));
		    // convert Scheme val to Vim and add it to the dict
		    if (mzscheme_to_vim_impl(((Scheme_Hash_Table *) obj)->vals[i],
				    &item->di_tv, depth + 1, visited) == FAIL
			    || dict_add(dict, item) == FAIL)
		    {
			dictitem_free(item);
			status = FAIL;
			break;
		    }
		}

	    }
	}
	MZ_GC_UNREG();
    }
    else
    {
	// `display' any other value to string
	tv->v_type = VAR_STRING;
	tv->vval.v_string = (char_u *)string_to_line(obj);
    }
    MZ_GC_UNREG();
    return status;
}

/*
 * Scheme prim procedure wrapping Vim funcref
 */
    static Scheme_Object *
vim_funcref(void *name, int argc, Scheme_Object **argv)
{
    int i;
    typval_T args;
    int status = OK;
    Scheme_Object *result = NULL;
    list_T *list = list_alloc();

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, result);
    MZ_GC_REG();

    result = scheme_void;
    if (list == NULL)
	status = FAIL;
    else
    {
	args.v_type = VAR_LIST;
	args.vval.v_list = list;
	++list->lv_refcount;
	for (i = 0; status == OK && i < argc; ++i)
	{
	    typval_T *v = ALLOC_ONE(typval_T);
	    if (v == NULL)
		status = FAIL;
	    else
	    {
		status = mzscheme_to_vim(argv[i], v);
		if (status == OK)
		{
		    status = list_append_tv(list, v);
		    clear_tv(v);
		}
		vim_free(v);
	    }
	}
	if (status == OK)
	{
	    typval_T ret;
	    ret.v_type = VAR_UNKNOWN;

	    mzscheme_call_vim(BYTE_STRING_VALUE((Scheme_Object *)name), &args, &ret);
	    MZ_GC_CHECK();
	    result = vim_to_mzscheme(&ret);
	    clear_tv(&ret);
	    MZ_GC_CHECK();
	}
    }
    clear_tv(&args);
    MZ_GC_UNREG();
    if (status != OK)
	raise_vim_exn(_("error converting Scheme values to Vim"));
    else
	raise_if_error();
    return result;
}

    void
do_mzeval(char_u *str, typval_T *rettv)
{
    Scheme_Object	*ret = NULL;

    MZ_GC_DECL_REG(1);
    MZ_GC_VAR_IN_REG(0, ret);
    MZ_GC_REG();

    if (mzscheme_init())
    {
	MZ_GC_UNREG();
	return;
    }

    MZ_GC_CHECK();
    if (eval_with_exn_handling(str, do_eval, &ret) == OK)
	mzscheme_to_vim(ret, rettv);

    MZ_GC_UNREG();
}
#endif

/*
 * Check to see whether a Vim error has been reported, or a keyboard
 * interrupt (from vim --> got_int) has been detected.
 */
    static int
vim_error_check(void)
{
    return (got_int || did_emsg);
}

/*
 * register Scheme exn:vim
 */
    static void
register_vim_exn(void)
{
    int	nc = 0;
    int i;
    Scheme_Object   *struct_exn = NULL;
    Scheme_Object   *exn_name = NULL;

    MZ_GC_DECL_REG(2);
    MZ_GC_VAR_IN_REG(0, struct_exn);
    MZ_GC_VAR_IN_REG(1, exn_name);
    MZ_GC_REG();

    exn_name = scheme_intern_symbol("exn:vim");
    MZ_GC_CHECK();
    struct_exn = scheme_builtin_value("struct:exn");
    MZ_GC_CHECK();

    if (vim_exn == NULL)
	vim_exn = scheme_make_struct_type(exn_name,
		struct_exn, NULL, 0, 0, NULL, NULL
#if MZSCHEME_VERSION_MAJOR >= 299
		, NULL
#endif
		);


    {
	Scheme_Object   **tmp = NULL;
	Scheme_Object   *exn_names[5] = {NULL, NULL, NULL, NULL, NULL};
	Scheme_Object   *exn_values[5] = {NULL, NULL, NULL, NULL, NULL};
	MZ_GC_DECL_REG(6);
	MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5);
	MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5);
	MZ_GC_REG();

	tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc);
	mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *));
	MZ_GC_CHECK();

	tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0);
	mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *));
	MZ_GC_CHECK();

	for (i = 0; i < nc; i++)
	{
	    scheme_add_global_symbol(exn_names[i],
		    exn_values[i], environment);
	    MZ_GC_CHECK();
	}
	MZ_GC_UNREG();
    }
    MZ_GC_UNREG();
}

/*
 * raise exn:vim, may be with additional info string
 */
    void
raise_vim_exn(const char *add_info)
{
    char	    *fmt = _("Vim error: ~a");
    Scheme_Object   *argv[2] = {NULL, NULL};
    Scheme_Object   *exn = NULL;
    Scheme_Object   *byte_string = NULL;

    MZ_GC_DECL_REG(5);
    MZ_GC_ARRAY_VAR_IN_REG(0, argv, 2);
    MZ_GC_VAR_IN_REG(3, exn);
    MZ_GC_VAR_IN_REG(4, byte_string);
    MZ_GC_REG();

    if (add_info != NULL)
    {
	char		*c_string = NULL;
	Scheme_Object   *info = NULL;

	MZ_GC_DECL_REG(3);
	MZ_GC_VAR_IN_REG(0, c_string);
	MZ_GC_VAR_IN_REG(2, info);
	MZ_GC_REG();

	info = scheme_make_byte_string(add_info);
	MZ_GC_CHECK();
	c_string = scheme_format_utf8(fmt, (int)STRLEN(fmt), 1, &info, NULL);
	MZ_GC_CHECK();
	byte_string = scheme_make_byte_string(c_string);
	MZ_GC_CHECK();
	argv[0] = scheme_byte_string_to_char_string(byte_string);
	SCHEME_SET_IMMUTABLE(argv[0]);
	MZ_GC_UNREG();
    }
    else
    {
	byte_string = scheme_make_byte_string(_("Vim error"));
	MZ_GC_CHECK();
	argv[0] = scheme_byte_string_to_char_string(byte_string);
	MZ_GC_CHECK();
    }
    MZ_GC_CHECK();

#if MZSCHEME_VERSION_MAJOR < 360
    argv[1] = scheme_current_continuation_marks();
    MZ_GC_CHECK();
#else
    argv[1] = scheme_current_continuation_marks(NULL);
    MZ_GC_CHECK();
#endif

    exn = scheme_make_struct_instance(vim_exn, 2, argv);
    MZ_GC_CHECK();
    scheme_raise(exn);
    MZ_GC_UNREG();
}

    void
raise_if_error(void)
{
    if (vim_error_check())
	raise_vim_exn(NULL);
}

/*
 * get buffer:
 * either current
 * or passed as argv[argnum] with checks
 */
    static vim_mz_buffer *
get_buffer_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
{
    vim_mz_buffer *b;

    if (argc < argnum + 1)
	return get_vim_curr_buffer();
    if (!SCHEME_VIMBUFFERP(argv[argnum]))
	scheme_wrong_type(fname, "vim-buffer", argnum, argc, argv);
    b = (vim_mz_buffer *)argv[argnum];
    (void)get_valid_buffer(argv[argnum]);
    return b;
}

/*
 * get window:
 * either current
 * or passed as argv[argnum] with checks
 */
    static vim_mz_window *
get_window_arg(const char *fname, int argnum, int argc, Scheme_Object **argv)
{
    vim_mz_window *w;

    if (argc < argnum + 1)
	return get_vim_curr_window();
    w = (vim_mz_window *)argv[argnum];
    if (!SCHEME_VIMWINDOWP(argv[argnum]))
	scheme_wrong_type(fname, "vim-window", argnum, argc, argv);
    (void)get_valid_window(argv[argnum]);
    return w;
}

/*
 * get valid Vim buffer from Scheme_Object*
 */
buf_T *get_valid_buffer(void *obj)
{
    buf_T *buf = ((vim_mz_buffer *)obj)->buf;

    if (buf == INVALID_BUFFER_VALUE)
	scheme_signal_error(_("buffer is invalid"));
    return buf;
}

/*
 * get valid Vim window from Scheme_Object*
 */
win_T *get_valid_window(void *obj)
{
    win_T *win = ((vim_mz_window *)obj)->win;
    if (win == INVALID_WINDOW_VALUE)
	scheme_signal_error(_("window is invalid"));
    return win;
}

    int
mzthreads_allowed(void)
{
    return mz_threads_allow;
}

    static int
line_in_range(linenr_T lnum, buf_T *buf)
{
    return (lnum > 0 && lnum <= buf->b_ml.ml_line_count);
}

    static void
check_line_range(linenr_T lnum, buf_T *buf)
{
    if (!line_in_range(lnum, buf))
	scheme_signal_error(_("linenr out of range"));
}

/*
 * Check if deleting lines made the cursor position invalid
 * (or you'll get msg from Vim about invalid linenr).
 * Changed the lines from "lo" to "hi" and added "extra" lines (negative if
 * deleted). Got from if_python.c
 */
    static void
mz_fix_cursor(int lo, int hi, int extra)
{
    if (curwin->w_cursor.lnum >= lo)
    {
	// Adjust the cursor position if it's in/after the changed
	// lines.
	if (curwin->w_cursor.lnum >= hi)
	{
	    curwin->w_cursor.lnum += extra;
	    check_cursor_col();
	}
	else if (extra < 0)
	{
	    curwin->w_cursor.lnum = lo;
	    check_cursor();
	}
	else
	    check_cursor_col();
	changed_cline_bef_curs();
    }
    invalidate_botline();
}

static Vim_Prim prims[]=
{
    /*
     * Buffer-related commands
     */
    {get_buffer_line, "get-buff-line", 1, 2},
    {set_buffer_line, "set-buff-line", 2, 3},
    {get_buffer_line_list, "get-buff-line-list", 2, 3},
    {get_buffer_name, "get-buff-name", 0, 1},
    {get_buffer_num, "get-buff-num", 0, 1},
    {get_buffer_size, "get-buff-size", 0, 1},
    {set_buffer_line_list, "set-buff-line-list", 3, 4},
    {insert_buffer_line_list, "insert-buff-line-list", 2, 3},
    {get_curr_buffer, "curr-buff", 0, 0},
    {get_buffer_count, "buff-count", 0, 0},
    {get_next_buffer, "get-next-buff", 0, 1},
    {get_prev_buffer, "get-prev-buff", 0, 1},
    {mzscheme_open_buffer, "open-buff", 1, 1},
    {get_buffer_by_name, "get-buff-by-name", 1, 1},
    {get_buffer_by_num, "get-buff-by-num", 1, 1},
    /*
     * Window-related commands
     */
    {get_curr_win, "curr-win", 0, 0},
    {get_window_count, "win-count", 0, 0},
    {get_window_by_num, "get-win-by-num", 1, 1},
    {get_window_num, "get-win-num", 0, 1},
    {get_window_buffer, "get-win-buffer", 0, 1},
    {get_window_height, "get-win-height", 0, 1},
    {set_window_height, "set-win-height", 1, 2},
    {get_window_width, "get-win-width", 0, 1},
    {set_window_width, "set-win-width", 1, 2},
    {get_cursor, "get-cursor", 0, 1},
    {set_cursor, "set-cursor", 1, 2},
    {get_window_list, "get-win-list", 0, 1},
    /*
     * Vim-related commands
     */
    {vim_command, "command", 1, 1},
    {vim_eval, "eval", 1, 1},
    {get_range_start, "range-start", 0, 0},
    {get_range_end, "range-end", 0, 0},
    {mzscheme_beep, "beep", 0, 0},
    {get_option, "get-option", 1, 2},
    {set_option, "set-option", 1, 2},
    /*
     * small utilities
     */
    {vim_bufferp, "buff?", 1, 1},
    {vim_windowp, "win?", 1, 1},
    {vim_buffer_validp, "buff-valid?", 1, 1},
    {vim_window_validp, "win-valid?", 1, 1}
};

/*
 * return MzScheme wrapper for curbuf
 */
    static vim_mz_buffer *
get_vim_curr_buffer(void)
{
    if (curbuf->b_mzscheme_ref == NULL)
	return (vim_mz_buffer *)buffer_new(curbuf);
    else
	return BUFFER_REF(curbuf);
}

/*
 * return MzScheme wrapper for curwin
 */
    static vim_mz_window *
get_vim_curr_window(void)
{
    if (curwin->w_mzscheme_ref == NULL)
	return (vim_mz_window *)window_new(curwin);
    else
	return WINDOW_REF(curwin);
}

    static void
make_modules(void)
{
    int		    i;
    Scheme_Env	    *mod = NULL;
    Scheme_Object   *vimext_symbol = NULL;
    Scheme_Object   *closed_prim = NULL;

    MZ_GC_DECL_REG(3);
    MZ_GC_VAR_IN_REG(0, mod);
    MZ_GC_VAR_IN_REG(1, vimext_symbol);
    MZ_GC_VAR_IN_REG(2, closed_prim);
    MZ_GC_REG();

    vimext_symbol = scheme_intern_symbol("vimext");
    MZ_GC_CHECK();
    mod = scheme_primitive_module(vimext_symbol, environment);
    MZ_GC_CHECK();
    // all prims made closed so they can access their own names
    for (i = 0; i < (int)ARRAY_LENGTH(prims); i++)
    {
	Vim_Prim *prim = prims + i;
	closed_prim = scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name,
			    prim->mina, prim->maxa);
	scheme_add_global(prim->name, closed_prim, mod);
	MZ_GC_CHECK();
    }
    scheme_finish_primitive_module(mod);
    MZ_GC_CHECK();
    MZ_GC_UNREG();
}

#ifdef HAVE_SANDBOX
static Scheme_Object *M_write = NULL;
static Scheme_Object *M_read = NULL;
static Scheme_Object *M_execute = NULL;
static Scheme_Object *M_delete = NULL;

    static void
sandbox_check(void)
{
    if (sandbox)
	raise_vim_exn(_("not allowed in the Vim sandbox"));
}

/*
 * security guards to force Vim's sandbox restrictions on MzScheme level
 */
    static Scheme_Object *
sandbox_file_guard(int argc UNUSED, Scheme_Object **argv)
{
    if (!sandbox)
	return scheme_void;

    Scheme_Object *requested_access = argv[2];

    if (M_write == NULL)
    {
	MZ_REGISTER_STATIC(M_write);
	M_write = scheme_intern_symbol("write");
	MZ_GC_CHECK();
    }
    if (M_read == NULL)
    {
	MZ_REGISTER_STATIC(M_read);
	M_read = scheme_intern_symbol("read");
	MZ_GC_CHECK();
    }
    if (M_execute == NULL)
    {
	MZ_REGISTER_STATIC(M_execute);
	M_execute = scheme_intern_symbol("execute");
	MZ_GC_CHECK();
    }
    if (M_delete == NULL)
    {
	MZ_REGISTER_STATIC(M_delete);
	M_delete = scheme_intern_symbol("delete");
	MZ_GC_CHECK();
    }

    while (!SCHEME_NULLP(requested_access))
    {
	Scheme_Object *item = SCHEME_CAR(requested_access);
	if (scheme_eq(item, M_write) || scheme_eq(item, M_read)
		|| scheme_eq(item, M_execute) || scheme_eq(item, M_delete))
	    raise_vim_exn(_("not allowed in the Vim sandbox"));
	requested_access = SCHEME_CDR(requested_access);
    }

    return scheme_void;
}

    static Scheme_Object *
sandbox_network_guard(int argc UNUSED, Scheme_Object **argv UNUSED)
{
    return scheme_void;
}
#endif

#endif