diff options
author | Bram Moolenaar <Bram@vim.org> | 2009-05-26 20:59:55 +0000 |
---|---|---|
committer | Bram Moolenaar <Bram@vim.org> | 2009-05-26 20:59:55 +0000 |
commit | 9e70cf192e0957e7e8e1e83f3f9f64822a7a96ee (patch) | |
tree | 0f3719130b48bcb33d4f012f6389215bdcf9006c /src/if_mzsch.c | |
parent | 42b9436cf88929bf176d3a812b2840d530c5d522 (diff) | |
download | vim-git-9e70cf192e0957e7e8e1e83f3f9f64822a7a96ee.tar.gz |
updated for version 7.2-191v7.2.191
Diffstat (limited to 'src/if_mzsch.c')
-rw-r--r-- | src/if_mzsch.c | 1341 |
1 files changed, 898 insertions, 443 deletions
diff --git a/src/if_mzsch.c b/src/if_mzsch.c index 7f43cab6e..017f8041e 100644 --- a/src/if_mzsch.c +++ b/src/if_mzsch.c @@ -4,6 +4,8 @@ * Original work by Brent Fulgham <bfulgham@debian.org> * (Based on lots of help from Matthew Flatt) * + * TODO Convert byte-strings to char strings? + * * This consists of six parts: * 1. MzScheme interpreter main program * 2. Routines that handle the external interface between MzScheme and @@ -18,7 +20,7 @@ * garbage collector will do it self * 2. Requires at least NORMAL features. I can't imagine why one may want * to build with SMALL or TINY features but with MzScheme interface. - * 3. I don't use K&R-style functions. Anyway, MzScheme headers are ANSI. + * 3. I don't use K&R-style functions. Anyways, MzScheme headers are ANSI. */ #include "vim.h" @@ -29,14 +31,15 @@ * depend". */ #if defined(FEAT_MZSCHEME) || defined(PROTO) +#include <assert.h> + /* 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_Type tag; - Scheme_Env *env; + Scheme_Object so; buf_T *buf; } vim_mz_buffer; @@ -44,7 +47,7 @@ typedef struct typedef struct { - Scheme_Type tag; + Scheme_Object so; win_T *win; } vim_mz_window; @@ -67,19 +70,6 @@ typedef struct Scheme_Object *port; } Port_Info; -/* info for closed prim */ -/* - * data have different means: - * for do_eval it is char* - * for do_apply is Apply_Onfo* - * for do_load is Port_Info* - */ -typedef struct -{ - void *data; - Scheme_Env *env; -} Cmd_Info; - /* info for do_apply */ typedef struct { @@ -122,7 +112,6 @@ static Scheme_Object *set_buffer_line_list(void *, int, Scheme_Object **); static Scheme_Object *insert_buffer_line_list(void *, int, Scheme_Object **); static Scheme_Object *get_range_start(void *, int, Scheme_Object **); static Scheme_Object *get_range_end(void *, int, Scheme_Object **); -static Scheme_Object *get_buffer_namespace(void *, int, Scheme_Object **); static vim_mz_buffer *get_vim_curr_buffer(void); /* Window-related commands */ @@ -163,8 +152,6 @@ static int vim_error_check(void); static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what); static void startup_mzscheme(void); static char *string_to_line(Scheme_Object *obj); -static int mzscheme_io_init(void); -static void mzscheme_interface_init(vim_mz_buffer *self); static void do_output(char *mesg, long len); static void do_printf(char *format, ...); static void do_flush(void); @@ -174,19 +161,52 @@ 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 Scheme_Object *do_apply(void *, int noargc, Scheme_Object **noargv); -static void register_vim_exn(Scheme_Env *env); +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 void add_vim_exn(Scheme_Env *env); 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_in_namespace(void *, Scheme_Closed_Prim *, Scheme_Env *, - Scheme_Object **ret); -static void make_modules(Scheme_Env *); +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, int depth, + Scheme_Hash_Table *visited); +#endif + +#ifdef MZ_PRECISE_GC +static int buffer_size_proc(void *obj) +{ + 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) +{ + return buffer_size_proc(obj); +} +static int window_size_proc(void *obj) +{ + 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) +{ + return window_size_proc(obj); +} +#endif #ifdef DYNAMIC_MZSCHEME @@ -260,8 +280,6 @@ 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_namespace)(int argc, - Scheme_Object *argv[]); 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, @@ -311,6 +329,17 @@ static Scheme_Object *(*dll_scheme_char_string_to_byte_string) static Scheme_Object *(*dll_scheme_char_string_to_path) (Scheme_Object *s); # 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); +# ifdef INCLUDE_MZSCHEME_BASE +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); +# endif /* arrays are imported directly */ # define scheme_eof dll_scheme_eof @@ -368,7 +397,6 @@ static Scheme_Object *(*dll_scheme_char_string_to_path) # 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_namespace dll_scheme_make_namespace # 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 @@ -403,6 +431,14 @@ static Scheme_Object *(*dll_scheme_char_string_to_path) # define scheme_char_string_to_path \ dll_scheme_char_string_to_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 +# ifdef INCLUDE_MZSCHEME_BASE +# define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string +# define scheme_namespace_require dll_scheme_namespace_require +# endif typedef struct { @@ -468,7 +504,6 @@ static Thunk_Info mzsch_imports[] = { {"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_namespace", (void **)&dll_scheme_make_namespace}, {"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 @@ -502,9 +537,16 @@ static Thunk_Info mzsch_imports[] = { {"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_char_string_to_path", (void **)&dll_scheme_char_string_to_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}, +# ifdef INCLUDE_MZSCHEME_BASE + {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string}, + {"scheme_namespace_require", (void **)&dll_scheme_namespace_require}, +#endif {NULL, NULL}}; static HINSTANCE hMzGC = 0; @@ -592,6 +634,11 @@ dynamic_mzscheme_end(void) } #endif /* DYNAMIC_MZSCHEME */ +/* need to put it here for dynamic stuff to work */ +#ifdef INCLUDE_MZSCHEME_BASE +# include "mzscheme_base.c" +#endif + /* *======================================================================== * 1. MzScheme interpreter startup @@ -601,21 +648,22 @@ dynamic_mzscheme_end(void) static Scheme_Type mz_buffer_type; static Scheme_Type mz_window_type; -static int initialized = 0; +static int initialized = FALSE; /* global environment */ static Scheme_Env *environment = NULL; /* output/error handlers */ static Scheme_Object *curout = NULL; static Scheme_Object *curerr = NULL; -/* vim:exn exception */ +/* 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 */ - /* values for exn:vim - constructor, predicate, accessors etc */ -static Scheme_Object *vim_exn_names = NULL; -static Scheme_Object *vim_exn_values = NULL; + +#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 +static void *stack_base = NULL; +#endif static long range_start; static long range_end; @@ -668,10 +716,10 @@ static void remove_timer(void); timer_proc(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime) # elif defined(FEAT_GUI_GTK) static gint -timer_proc(gpointer data UNUSED) +timer_proc(gpointer data) # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA) static void -timer_proc(XtPointer timed_out UNUSED, XtIntervalId *interval_id UNUSED) +timer_proc(XtPointer timed_out, XtIntervalId *interval_id) # elif defined(FEAT_GUI_MAC) pascal void timer_proc(EventLoopTimerRef theTimer, void *userData) @@ -751,12 +799,64 @@ mzscheme_end(void) #endif } + void +mzscheme_main(void) +{ +#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 + /* use trampoline for precise GC in MzScheme >= 4.x */ + scheme_main_setup(TRUE, mzscheme_env_main, 0, NULL); +#else + mzscheme_env_main(NULL, 0, NULL); +#endif +} + + static int +mzscheme_env_main(Scheme_Env *env, int argc, char **argv) +{ + /* neither argument nor return values are used */ +#ifdef MZ_PRECISE_GC +# if MZSCHEME_VERSION_MAJOR < 400 + /* + * Starting from version 4.x, embedding applications must use + * scheme_main_setup/scheme_main_stack_setup trampolines + * rather than setting stack base directly with scheme_set_stack_base + */ + Scheme_Object *dummy = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, dummy); + + stack_base = &__gc_var_stack__; +# else + /* environment has been created by us by Scheme */ + environment = env; +# endif + /* + * In 4.x, all activities must be performed inside trampoline + * so we are forced to initialise GC immediately + * This can be postponed in 3.x but I see no point in implementing + * a feature which will work in older versions only. + * One would better use conservative GC if he needs dynamic MzScheme + */ + mzscheme_init(); +#else + int dummy = 0; + stack_base = (void *)&dummy; +#endif + main_loop(FALSE, FALSE); +#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR < 400 + /* releasing dummy */ + MZ_GC_REG(); + MZ_GC_UNREG(); +#endif + return 0; +} + static void startup_mzscheme(void) { - Scheme_Object *proc_make_security_guard; - - scheme_set_stack_base(NULL, 1); +#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 + scheme_set_stack_base(stack_base, 1); +#endif MZ_REGISTER_STATIC(environment); MZ_REGISTER_STATIC(curout); @@ -765,10 +865,35 @@ startup_mzscheme(void) MZ_REGISTER_STATIC(exn_p); MZ_REGISTER_STATIC(exn_message); MZ_REGISTER_STATIC(vim_exn); - MZ_REGISTER_STATIC(vim_exn_names); - MZ_REGISTER_STATIC(vim_exn_values); +#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 + /* in newer versions of precise GC the initial env has been created */ environment = scheme_basic_env(); +#endif + MZ_GC_CHECK(); + +#ifdef INCLUDE_MZSCHEME_BASE + { + /* + * versions 4.x do not provide Scheme bindings by defaults + * we need to add them explicitly + */ + Scheme_Object *scheme_base_symbol = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, scheme_base_symbol); + MZ_GC_REG(); + /* invoke function from generated and included base.c */ + declare_modules(environment); + scheme_base_symbol = scheme_intern_symbol("scheme/base"); + MZ_GC_CHECK(); + scheme_namespace_require(scheme_base_symbol); + MZ_GC_CHECK(); + MZ_GC_UNREG(); + } +#endif + register_vim_exn(); + /* use new environment to initialise exception handling */ + init_exn_catching_apply(); /* redirect output */ scheme_console_output = do_output; @@ -776,48 +901,131 @@ startup_mzscheme(void) #ifdef MZSCHEME_COLLECTS /* setup 'current-library-collection-paths' parameter */ - scheme_set_param(scheme_config, MZCONFIG_COLLECTION_PATHS, - scheme_make_pair( # if MZSCHEME_VERSION_MAJOR >= 299 - scheme_char_string_to_path( - scheme_byte_string_to_char_string( - scheme_make_byte_string(MZSCHEME_COLLECTS))), + { + Scheme_Object *coll_byte_string = NULL; + Scheme_Object *coll_char_string = NULL; + Scheme_Object *coll_path = NULL; + Scheme_Object *coll_pair = NULL; + Scheme_Config *config = NULL; + + MZ_GC_DECL_REG(5); + MZ_GC_VAR_IN_REG(0, coll_byte_string); + MZ_GC_VAR_IN_REG(1, coll_char_string); + MZ_GC_VAR_IN_REG(2, coll_path); + MZ_GC_VAR_IN_REG(3, coll_pair); + MZ_GC_VAR_IN_REG(4, config); + MZ_GC_REG(); + coll_byte_string = scheme_make_byte_string(MZSCHEME_COLLECTS); + MZ_GC_CHECK(); + coll_char_string = scheme_byte_string_to_char_string(coll_byte_string); + MZ_GC_CHECK(); + coll_path = scheme_char_string_to_path(coll_char_string); + MZ_GC_CHECK(); + coll_pair = scheme_make_pair(coll_path, scheme_null); + MZ_GC_CHECK(); + config = scheme_config; + MZ_GC_CHECK(); + scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair); + MZ_GC_CHECK(); + MZ_GC_UNREG(); + } # else - scheme_make_string(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_string(MZSCHEME_COLLECTS); + MZ_GC_CHECK(); + coll_pair = scheme_make_pair(coll_string, scheme_null); + MZ_GC_CHECK(); + config = scheme_config; + MZ_GC_CHECK(); + scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair); + MZ_GC_CHECK(); + MZ_GC_UNREG(); + } # endif - scheme_null)); #endif #ifdef HAVE_SANDBOX - /* setup sandbox guards */ - proc_make_security_guard = scheme_lookup_global( - scheme_intern_symbol("make-security-guard"), - environment); - if (proc_make_security_guard != NULL) { - Scheme_Object *args[3]; - Scheme_Object *guard; - args[0] = scheme_get_param(scheme_config, MZCONFIG_SECURITY_GUARD); - 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(proc_make_security_guard, 3, args); - scheme_set_param(scheme_config, MZCONFIG_SECURITY_GUARD, guard); + 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_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 - register_vim_exn(environment); - make_modules(environment); + make_modules(); /* * setup callback to receive notifications * whether thread scheduling is (or not) required */ scheme_notify_multithread = notify_multithread; - initialized = 1; } /* @@ -827,102 +1035,66 @@ startup_mzscheme(void) static int mzscheme_init(void) { - int do_require = FALSE; - if (!initialized) { - do_require = TRUE; #ifdef DYNAMIC_MZSCHEME if (!mzscheme_enabled(TRUE)) { - EMSG(_("???: Sorry, this command is disabled, the MzScheme library could not be loaded.")); + EMSG(_("E812: Sorry, this command is disabled, the MzScheme libraries could not be loaded.")); return -1; } #endif startup_mzscheme(); - - if (mzscheme_io_init()) - return -1; - + initialized = TRUE; } - /* recreate ports each call effectivelly clearing these ones */ - curout = scheme_make_string_output_port(); - curerr = scheme_make_string_output_port(); - scheme_set_param(scheme_config, MZCONFIG_OUTPUT_PORT, curout); - scheme_set_param(scheme_config, MZCONFIG_ERROR_PORT, curerr); - - if (do_require) { - /* auto-instantiate in basic env */ - eval_in_namespace("(require (prefix vimext: vimext))", do_eval, - environment, NULL); + Scheme_Config *config = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, config); + MZ_GC_REG(); + config = scheme_config; + MZ_GC_CHECK(); + /* recreate ports each call effectivelly clearing these ones */ + curout = scheme_make_string_output_port(); + MZ_GC_CHECK(); + curerr = scheme_make_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; } /* - * This routine fills the namespace with various important routines that can - * be used within MzScheme. - */ - static void -mzscheme_interface_init(vim_mz_buffer *mzbuff) -{ - Scheme_Object *attach; - - mzbuff->env = (Scheme_Env *)scheme_make_namespace(0, NULL); - - /* - * attach instantiated modules from global namespace - * so they can be easily instantiated in the buffer namespace - */ - attach = scheme_lookup_global( - scheme_intern_symbol("namespace-attach-module"), - environment); - - if (attach != NULL) - { - Scheme_Object *ret; - Scheme_Object *args[2]; - - args[0] = (Scheme_Object *)environment; - args[1] = scheme_intern_symbol("vimext"); - - ret = (Scheme_Object *)mzvim_apply(attach, 2, args); - } - - add_vim_exn(mzbuff->env); -} - -/* *======================================================================== * 2. External Interface *======================================================================== */ /* - * Evaluate command in namespace with exception handling + * Evaluate command with exception handling */ static int -eval_in_namespace(void *data, Scheme_Closed_Prim *what, Scheme_Env *env, - Scheme_Object **ret) +eval_with_exn_handling(void *data, Scheme_Closed_Prim *what, Scheme_Object **ret) { - Scheme_Object *value; - Scheme_Object *exn; - Cmd_Info info; /* closure info */ + Scheme_Object *value = NULL; + Scheme_Object *exn = NULL; + Scheme_Object *prim = NULL; - info.data = data; - info.env = env; + 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(); - scheme_set_param(scheme_config, MZCONFIG_ENV, - (Scheme_Object *) env); - /* - * ensure all evaluations will be in current buffer namespace, - * the second argument to scheme_eval_string isn't enough! - */ - value = _apply_thunk_catch_exceptions( - scheme_make_closed_prim_w_arity(what, &info, "mzvim", 0, 0), - &exn); + 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) { @@ -930,9 +1102,11 @@ eval_in_namespace(void *data, Scheme_Closed_Prim *what, Scheme_Env *env, /* Got an exn? */ if (value) { - scheme_display(value, curerr); /* Send to stderr-vim */ + 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; } @@ -941,9 +1115,13 @@ eval_in_namespace(void *data, Scheme_Closed_Prim *what, Scheme_Env *env, *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; } @@ -957,7 +1135,7 @@ do_mzscheme_command(exarg_T *eap, void *data, Scheme_Closed_Prim *what) range_start = eap->line1; range_end = eap->line2; - return eval_in_namespace(data, what, get_vim_curr_buffer()->env, NULL); + return eval_with_exn_handling(data, what, NULL); } /* @@ -974,6 +1152,7 @@ mzscheme_buffer_free(buf_T *buf) bp->buf = INVALID_BUFFER_VALUE; buf->b_mzscheme_ref = NULL; scheme_gc_ptr_ok(bp); + MZ_GC_CHECK(); } } @@ -990,6 +1169,7 @@ mzscheme_window_free(win_T *win) wp->win = INVALID_WINDOW_VALUE; win->w_mzscheme_ref = NULL; scheme_gc_ptr_ok(wp); + MZ_GC_CHECK(); } } @@ -1014,18 +1194,6 @@ ex_mzscheme(exarg_T *eap) } } -/* eval MzScheme string */ - void * -mzvim_eval_string(char_u *str) -{ - Scheme_Object *ret = NULL; - if (mzscheme_init()) - return FAIL; - - eval_in_namespace(str, do_eval, get_vim_curr_buffer()->env, &ret); - return ret; -} - /* * apply MzScheme procedure with arguments, * handling errors @@ -1033,43 +1201,65 @@ mzvim_eval_string(char_u *str) Scheme_Object * mzvim_apply(Scheme_Object *proc, int argc, Scheme_Object **argv) { - Apply_Info data; - Scheme_Object *ret = NULL; - if (mzscheme_init()) return FAIL; - - data.proc = proc; - data.argc = argc; - data.argv = argv; - - eval_in_namespace(&data, do_apply, get_vim_curr_buffer()->env, &ret); - return ret; + else + { + Apply_Info data = {NULL, 0, NULL}; + Scheme_Object *ret = NULL; + + MZ_GC_DECL_REG(5); + MZ_GC_VAR_IN_REG(0, ret); + MZ_GC_VAR_IN_REG(1, data.proc); + MZ_GC_ARRAY_VAR_IN_REG(2, data.argv, argc); + MZ_GC_REG(); + + data.proc = proc; + data.argc = argc; + data.argv = argv; + + eval_with_exn_handling(&data, do_apply, &ret); + MZ_GC_UNREG(); + return ret; + } } static Scheme_Object * do_load(void *data, int noargc, Scheme_Object **noargv) { - Cmd_Info *info = (Cmd_Info *)data; - Scheme_Object *result = scheme_void; - Scheme_Object *expr; - char_u *file = scheme_malloc_fail_ok( - scheme_malloc_atomic, MAXPATHL + 1); - Port_Info *pinfo = (Port_Info *)(info->data); + 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, file, MAXPATHL); - /* scheme_load looks strange working with namespaces and error handling*/ + expand_env((char_u *)pinfo->name, (char_u *)file, MAXPATHL); pinfo->port = scheme_open_input_file(file, "mzfile"); - scheme_count_lines(pinfo->port); /* to get accurate read error location*/ + 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, info->env); + { + result = scheme_eval(expr, environment); + MZ_GC_CHECK(); + } /* errors will be caught in do_mzscheme_comamnd and ex_mzfile */ scheme_close_input_port(pinfo->port); + MZ_GC_CHECK(); pinfo->port = NULL; + MZ_GC_UNREG(); return result; } @@ -1077,13 +1267,20 @@ do_load(void *data, int noargc, Scheme_Object **noargv) void ex_mzfile(exarg_T *eap) { - Port_Info pinfo; + 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; - pinfo.port = NULL; 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(); } @@ -1103,14 +1300,12 @@ init_exn_catching_apply(void) "(with-handlers ([void (lambda (exn) (cons #f exn))]) " "(cons #t (thunk))))"; - /* make sure we have a namespace with the standard syntax: */ - Scheme_Env *env = (Scheme_Env *)scheme_make_namespace(0, NULL); - add_vim_exn(env); - - exn_catching_apply = scheme_eval_string(e, env); - exn_p = scheme_lookup_global(scheme_intern_symbol("exn?"), env); - exn_message = scheme_lookup_global( - scheme_intern_symbol("exn-message"), env); + 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(); } } @@ -1124,8 +1319,6 @@ _apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn) { Scheme_Object *v; - init_exn_catching_apply(); - v = _scheme_apply(exn_catching_apply, 1, &f); /* v is a pair: (cons #t value) or (cons #f exn) */ @@ -1141,8 +1334,6 @@ _apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn) static Scheme_Object * extract_exn_message(Scheme_Object *v) { - init_exn_catching_apply(); - if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v))) return _scheme_apply(exn_message, 1, &v); else @@ -1152,16 +1343,13 @@ extract_exn_message(Scheme_Object *v) static Scheme_Object * do_eval(void *s, int noargc, Scheme_Object **noargv) { - Cmd_Info *info = (Cmd_Info *)s; - - return scheme_eval_string_all((char *)(info->data), info->env, TRUE); + return scheme_eval_string_all((char *)s, environment, TRUE); } static Scheme_Object * do_apply(void *a, int noargc, Scheme_Object **noargv) { - Apply_Info *info = (Apply_Info *)(((Cmd_Info *)a)->data); - + Apply_Info *info = (Apply_Info *)a; return scheme_apply(info->proc, info->argc, info->argv); } @@ -1219,6 +1407,7 @@ do_flush(void) long length; buff = scheme_get_sized_string_output(curerr, &length); + MZ_GC_CHECK(); if (length) { do_err_output(buff, length); @@ -1226,17 +1415,11 @@ do_flush(void) } buff = scheme_get_sized_string_output(curout, &length); + MZ_GC_CHECK(); if (length) do_output(buff, length); } - static int -mzscheme_io_init(void) -{ - /* Nothing needed so far... */ - return 0; -} - /* *======================================================================== * 4. Implementation of the Vim Features for MzScheme @@ -1263,22 +1446,30 @@ vim_command(void *data, int argc, Scheme_Object **argv) vim_eval(void *data, int argc, Scheme_Object **argv) { #ifdef FEAT_EVAL - Vim_Prim *prim = (Vim_Prim *)data; - char *expr; - char *str; - Scheme_Object *result; + Vim_Prim *prim = (Vim_Prim *)data; + char *expr; + Scheme_Object *result; + /* hash table to store visited values to avoid infinite loops */ + Scheme_Hash_Table *visited = NULL; + typval_T *vim_result; - expr = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, visited); + MZ_GC_REG(); - str = (char *)eval_to_string((char_u *)expr, NULL, TRUE); + visited = scheme_make_hash_table(SCHEME_hash_ptr); + MZ_GC_CHECK(); - if (str == NULL) - raise_vim_exn(_("invalid expression")); + expr = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + vim_result = eval_expr((char_u *)expr, NULL); - result = scheme_make_string(str); + if (vim_result == NULL) + raise_vim_exn(_("invalid expression")); - vim_free(str); + result = vim_to_mzscheme(vim_result, 1, visited); + free_tv(vim_result); + MZ_GC_UNREG(); return result; #else raise_vim_exn(_("expressions disabled at compile time")); @@ -1318,7 +1509,7 @@ get_option(void *data, int argc, Scheme_Object **argv) Vim_Prim *prim = (Vim_Prim *)data; char_u *name; long value; - char_u *strval; + char *strval; int rc; Scheme_Object *rval; int opt_flags = 0; @@ -1333,6 +1524,7 @@ get_option(void *data, int argc, Scheme_Object **argv) { MZ_REGISTER_STATIC(M_global); M_global = scheme_intern_symbol("global"); + MZ_GC_CHECK(); } if (argv[1] == M_global) @@ -1354,7 +1546,7 @@ get_option(void *data, int argc, Scheme_Object **argv) scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv); } - rc = get_option_value(name, &value, &strval, opt_flags); + rc = get_option_value(name, &value, (char_u **)&strval, opt_flags); curbuf = save_curb; curwin = save_curw; @@ -1364,6 +1556,7 @@ get_option(void *data, int argc, Scheme_Object **argv) return scheme_make_integer_value(value); case 0: rval = scheme_make_string(strval); + MZ_GC_CHECK(); vim_free(strval); return rval; case -1: @@ -1393,6 +1586,7 @@ set_option(void *data, int argc, Scheme_Object **argv) { MZ_REGISTER_STATIC(M_global); M_global = scheme_intern_symbol("global"); + MZ_GC_CHECK(); } if (argv[1] == M_global) @@ -1463,7 +1657,10 @@ get_window_list(void *data, int argc, Scheme_Object **argv) for (w = firstwin; 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; } @@ -1471,7 +1668,11 @@ get_window_list(void *data, int argc, Scheme_Object **argv) static Scheme_Object * window_new(win_T *win) { - vim_mz_window *self; + vim_mz_window *self = NULL; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, self); + MZ_GC_REG(); /* We need to handle deletion of windows underneath us. * If we add a "w_mzscheme_ref" field to the win_T structure, @@ -1485,13 +1686,14 @@ window_new(win_T *win) return win->w_mzscheme_ref; self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_window)); - vim_memset(self, 0, sizeof(vim_mz_window)); scheme_dont_gc_ptr(self); /* because win isn't visible to GC */ + MZ_GC_CHECK(); win->w_mzscheme_ref = self; self->win = win; - self->tag = mz_window_type; + self->so.type = mz_window_type; + MZ_GC_UNREG(); return (Scheme_Object *)(self); } @@ -1660,7 +1862,6 @@ set_cursor(void *data, int argc, Scheme_Object **argv) /* *=========================================================================== * 6. Vim Buffer-related Manipulation Functions - * Note that each buffer should have its own private namespace. *=========================================================================== */ @@ -1669,14 +1870,14 @@ set_cursor(void *data, int argc, Scheme_Object **argv) mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv) { Vim_Prim *prim = (Vim_Prim *)data; - char *fname; + char_u *fname; int num = 0; Scheme_Object *onum; #ifdef HAVE_SANDBOX sandbox_check(); #endif - fname = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); /* TODO make open existing file */ num = buflist_add(fname, BLN_LISTED | BLN_CURBUF); @@ -1712,7 +1913,7 @@ get_buffer_by_name(void *data, int argc, Scheme_Object **argv) buf_T *buf; char_u *fname; - fname = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); for (buf = firstbuf; buf; buf = buf->b_next) if (buf->b_ffname == NULL || buf->b_sfname == NULL) @@ -1783,7 +1984,7 @@ 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_string(buf->buf->b_ffname); + return scheme_make_string((char *)buf->buf->b_ffname); } /* (curr-buff) */ @@ -1796,7 +1997,11 @@ get_curr_buffer(void *data, int argc, Scheme_Object **argv) static Scheme_Object * buffer_new(buf_T *buf) { - vim_mz_buffer *self; + vim_mz_buffer *self = NULL; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, self); + MZ_GC_REG(); /* We need to handle deletion of buffers underneath us. * If we add a "b_mzscheme_ref" field to the buf_T structure, @@ -1806,15 +2011,14 @@ buffer_new(buf_T *buf) return buf->b_mzscheme_ref; self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_buffer)); - vim_memset(self, 0, sizeof(vim_mz_buffer)); - scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */ + scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */ + MZ_GC_CHECK(); buf->b_mzscheme_ref = self; self->buf = buf; - self->tag = mz_buffer_type; - - mzscheme_interface_init(self); /* Set up namespace */ + self->so.type = mz_buffer_type; + MZ_GC_UNREG(); return (Scheme_Object *)(self); } @@ -1845,14 +2049,14 @@ get_buffer_line(void *data, int argc, Scheme_Object **argv) Vim_Prim *prim = (Vim_Prim *)data; vim_mz_buffer *buf; int linenr; - char *line; + 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_string(line); + return scheme_make_string((char *)line); } @@ -1869,7 +2073,11 @@ 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; + 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; @@ -1897,8 +2105,9 @@ get_buffer_line_list(void *data, int argc, Scheme_Object **argv) /* Set the list item */ list = scheme_make_pair(str, list); + MZ_GC_CHECK(); } - + MZ_GC_UNREG(); return list; } @@ -1925,11 +2134,14 @@ set_buffer_line(void *data, int argc, Scheme_Object **argv) */ Vim_Prim *prim = (Vim_Prim *)data; vim_mz_buffer *buf; - Scheme_Object *line; + Scheme_Object *line = NULL; char *save; - buf_T *savebuf; int n; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, line); + MZ_GC_REG(); + #ifdef HAVE_SANDBOX sandbox_check(); #endif @@ -1943,7 +2155,8 @@ set_buffer_line(void *data, int argc, Scheme_Object **argv) if (SCHEME_FALSEP(line)) { - savebuf = curbuf; + buf_T *savebuf = curbuf; + curbuf = buf->buf; if (u_savedel((linenr_T)n, 1L) == FAIL) @@ -1962,33 +2175,56 @@ set_buffer_line(void *data, int argc, Scheme_Object **argv) curbuf = savebuf; + MZ_GC_UNREG(); raise_if_error(); return scheme_void; } + else + { + /* Otherwise it's a line */ + buf_T *savebuf = curbuf; - /* Otherwise it's a line */ - save = string_to_line(line); - savebuf = curbuf; + save = string_to_line(line); - curbuf = buf->buf; + 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); + } - if (u_savesub((linenr_T)n) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot save undo information")); - } - else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL) - { curbuf = savebuf; - raise_vim_exn(_("cannot replace line")); - } - else - 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(); - raise_if_error(); - return scheme_void; + 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); } /* @@ -2013,15 +2249,15 @@ set_buffer_line_list(void *data, int argc, Scheme_Object **argv) * 3. Anything else - this is an error. */ Vim_Prim *prim = (Vim_Prim *)data; - vim_mz_buffer *buf; - Scheme_Object *line_list; - Scheme_Object *line; - Scheme_Object *rest; - char **array; - buf_T *savebuf; + 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 @@ -2047,7 +2283,7 @@ set_buffer_line_list(void *data, int argc, Scheme_Object **argv) if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list)) { - savebuf = curbuf; + buf_T *savebuf = curbuf; curbuf = buf->buf; if (u_savedel((linenr_T)lo, (long)old_len) == FAIL) @@ -2070,98 +2306,121 @@ set_buffer_line_list(void *data, int argc, Scheme_Object **argv) 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; - /* List */ - new_len = scheme_proper_list_length(line_list); - if (new_len < 0) /* improper or cyclic list */ - scheme_wrong_type(prim->name, "proper list", - 2, argc, argv); + MZ_GC_DECL_REG(2); + MZ_GC_VAR_IN_REG(0, line); + MZ_GC_VAR_IN_REG(1, rest); + MZ_GC_REG(); - /* Using MzScheme allocator, so we don't need to free this and - * can safely keep pointers to GC collected strings - */ - array = (char **)scheme_malloc_fail_ok(scheme_malloc, - (unsigned)(new_len * sizeof(char *))); + array = (char **)alloc(new_len * sizeof(char *)); + vim_memset(array, 0, new_len * sizeof(char *)); - rest = line_list; - for (i = 0; i < new_len; ++i) - { - line = SCHEME_CAR(rest); - rest = SCHEME_CDR(rest); - if (!SCHEME_STRINGP(line)) - scheme_wrong_type(prim->name, "string-list", 2, argc, argv); - array[i] = string_to_line(line); - } + 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); + } - savebuf = curbuf; - curbuf = buf->buf; + curbuf = buf->buf; - if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot save undo information")); - } + 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, FALSE) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot delete line")); - } - extra--; - } + /* + * 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, FALSE) == 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; - raise_vim_exn(_("cannot replace line")); - } + /* + * 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; - raise_vim_exn(_("cannot insert 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); } - ++i; - ++extra; - } - /* - * 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); + /* + * 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; + if (buf->buf == curwin->w_buffer) + mz_fix_cursor(lo, hi, extra); + curbuf = savebuf; - raise_if_error(); - return scheme_void; + MZ_GC_UNREG(); + raise_if_error(); + return scheme_void; + } } /* @@ -2179,15 +2438,15 @@ set_buffer_line_list(void *data, int argc, Scheme_Object **argv) insert_buffer_line_list(void *data, int argc, Scheme_Object **argv) { Vim_Prim *prim = (Vim_Prim *)data; - vim_mz_buffer *buf; - Scheme_Object *list; - Scheme_Object *line; - Scheme_Object *rest; - char **array; - char *str; - buf_T *savebuf; + 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 @@ -2206,89 +2465,99 @@ insert_buffer_line_list(void *data, int argc, Scheme_Object **argv) check_line_range(n, buf->buf); if (SCHEME_STRINGP(list)) { - str = string_to_line(list); + buf_T *savebuf = curbuf; - 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(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); - - /* Using MzScheme allocator, so we don't need to free this and - * can safely keep pointers to GC collected strings - */ - array = (char **)scheme_malloc_fail_ok( - scheme_malloc, (unsigned)(size * sizeof(char *))); - - rest = list; - for (i = 0; i < size; ++i) + else { - line = SCHEME_CAR(rest); - rest = SCHEME_CDR(rest); - array[i] = string_to_line(line); - } + Scheme_Object *line = NULL; + Scheme_Object *rest = NULL; + char **array; + buf_T *savebuf = curbuf; - savebuf = curbuf; - curbuf = buf->buf; + MZ_GC_DECL_REG(2); + MZ_GC_VAR_IN_REG(0, line); + MZ_GC_VAR_IN_REG(1, rest); + MZ_GC_REG(); - if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot save undo information")); - } - else - { + array = (char **)alloc(size * sizeof(char *)); + vim_memset(array, 0, size * sizeof(char *)); + + rest = list; for (i = 0; i < size; ++i) - if (ml_append((linenr_T)(n + i), (char_u *)array[i], - 0, FALSE) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot insert line")); - } + { + line = SCHEME_CAR(rest); + rest = SCHEME_CDR(rest); + array[i] = string_to_line(line); + } - if (i > 0) - appended_lines_mark((linenr_T)n, (long)i); - } + curbuf = buf->buf; - curbuf = savebuf; - update_screen(VALID); + 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(VALID); + } + + MZ_GC_UNREG(); raise_if_error(); return scheme_void; } -/* (get-buff-namespace [buffer]) */ - static Scheme_Object * -get_buffer_namespace(void *data, int argc, Scheme_Object **argv) -{ - Vim_Prim *prim = (Vim_Prim *)data; - - return (Scheme_Object *)get_buffer_arg(prim->name, 0, argc, argv)->env; -} - /* * Predicates */ @@ -2343,40 +2612,172 @@ vim_window_validp(void *data, int argc, Scheme_Object **argv) /* * Convert an MzScheme string into a Vim line. * - * The result is in allocated memory. All internal nulls are replaced by - * newline characters. It is an error for the string to contain newline - * characters. + * 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 *str; + char *scheme_str = NULL; + char *vim_str = NULL; long len; int i; - str = scheme_display_to_string(obj, &len); + 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(str, '\n', len)) + if (memchr(scheme_str, '\n', len)) scheme_signal_error(_("string cannot contain newlines")); + vim_str = (char *)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 (str[i] == '\0') - str[i] = '\n'; + 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, int depth, Scheme_Hash_Table *visited) +{ + Scheme_Object *result = NULL; + int new_value = TRUE; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, result); + 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_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(); + } +# ifdef FEAT_FLOAT + else if (vim_value->v_type == VAR_FLOAT) + { + result = scheme_make_double((double)vim_value->vval.v_float); + MZ_GC_CHECK(); + } +# endif + 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_last; + obj = vim_to_mzscheme(&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(&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; - str[i] = '\0'; + MZ_GC_DECL_REG(2); + MZ_GC_VAR_IN_REG(0, key); + MZ_GC_VAR_IN_REG(1, obj); + MZ_GC_REG(); - return str; + 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 (hi = ht->ht_array; todo > 0; ++hi) + { + if (!HASHITEM_EMPTY(hi)) + { + --todo; + + di = dict_lookup(hi); + obj = vim_to_mzscheme(&di->di_tv, depth + 1, visited); + key = scheme_make_string((char *)hi->hi_key); + MZ_GC_CHECK(); + scheme_hash_set((Scheme_Hash_Table *)result, key, obj); + MZ_GC_CHECK(); + } + } + } + MZ_GC_UNREG(); + } + 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; } +#endif /* * Check to see whether a Vim error has been reported, or a keyboard @@ -2392,50 +2793,59 @@ vim_error_check(void) * register Scheme exn:vim */ static void -register_vim_exn(Scheme_Env *env) +register_vim_exn(void) { - Scheme_Object *exn_name = scheme_intern_symbol("exn:vim"); + 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, - scheme_builtin_value("struct:exn"), NULL, 0, 0, NULL, NULL + struct_exn, NULL, 0, 0, NULL, NULL #if MZSCHEME_VERSION_MAJOR >= 299 , NULL #endif ); - if (vim_exn_values == NULL) + { - int nc = 0; - - Scheme_Object **exn_names = scheme_make_struct_names( - exn_name, scheme_null, 0, &nc); - Scheme_Object **exn_values = scheme_make_struct_values( - vim_exn, exn_names, nc, 0); - - vim_exn_names = scheme_make_vector(nc, scheme_false); - vim_exn_values = scheme_make_vector(nc, scheme_false); - /* remember names and values */ - mch_memmove(SCHEME_VEC_ELS(vim_exn_names), exn_names, - nc * sizeof(Scheme_Object *)); - mch_memmove(SCHEME_VEC_ELS(vim_exn_values), exn_values, - nc * sizeof(Scheme_Object *)); + 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); + assert(nc <= 5); + 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(); } - - add_vim_exn(env); -} - -/* - * Add stuff of exn:vim to env - */ - static void -add_vim_exn(Scheme_Env *env) -{ - int i; - - for (i = 0; i < SCHEME_VEC_SIZE(vim_exn_values); i++) - scheme_add_global_symbol(SCHEME_VEC_ELS(vim_exn_names)[i], - SCHEME_VEC_ELS(vim_exn_values)[i], env); + MZ_GC_UNREG(); } /* @@ -2444,26 +2854,54 @@ add_vim_exn(Scheme_Env *env) void raise_vim_exn(const char *add_info) { - Scheme_Object *argv[2]; - char_u *fmt = _("Vim error: ~a"); + char *fmt = _("Vim error: ~a"); + Scheme_Object *argv[2] = {NULL, NULL}; + Scheme_Object *exn = NULL; + + MZ_GC_DECL_REG(4); + MZ_GC_ARRAY_VAR_IN_REG(0, argv, 2); + MZ_GC_VAR_IN_REG(3, exn); + MZ_GC_REG(); if (add_info != NULL) { - Scheme_Object *info = scheme_make_string(add_info); - argv[0] = scheme_byte_string_to_char_string(scheme_make_string( - scheme_format(fmt, strlen(fmt), 1, &info, NULL))); + char *c_string = NULL; + Scheme_Object *byte_string = NULL; + Scheme_Object *info = NULL; + + MZ_GC_DECL_REG(3); + MZ_GC_VAR_IN_REG(0, c_string); + MZ_GC_VAR_IN_REG(1, byte_string); + MZ_GC_VAR_IN_REG(2, info); + MZ_GC_REG(); + + info = scheme_make_string(add_info); + MZ_GC_CHECK(); + c_string = scheme_format(fmt, STRLEN(fmt), 1, &info, NULL); + MZ_GC_CHECK(); + byte_string = scheme_make_string(c_string); + MZ_GC_CHECK(); + argv[0] = scheme_byte_string_to_char_string(byte_string); + MZ_GC_CHECK(); SCHEME_SET_IMMUTABLE(argv[0]); + MZ_GC_UNREG(); } else argv[0] = scheme_make_string(_("Vim error")); + 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 - scheme_raise(scheme_make_struct_instance(vim_exn, 2, argv)); + exn = scheme_make_struct_instance(vim_exn, 2, argv); + MZ_GC_CHECK(); + scheme_raise(exn); + MZ_GC_UNREG(); } void @@ -2570,6 +3008,8 @@ mz_fix_cursor(int lo, int hi, int extra) curwin->w_cursor.lnum = lo; check_cursor(); } + else + check_cursor_col(); changed_cline_bef_curs(); } invalidate_botline(); @@ -2595,7 +3035,6 @@ static Vim_Prim prims[]= {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}, - {get_buffer_namespace, "get-buff-namespace", 0, 1}, /* * Window-related commands */ @@ -2653,23 +3092,35 @@ get_vim_curr_window(void) } static void -make_modules(Scheme_Env *env) -{ - int i; - Scheme_Env *mod; - - mod = scheme_primitive_module(scheme_intern_symbol("vimext"), env); +make_modules() +{ + 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 < sizeof(prims)/sizeof(prims[0]); i++) + for (i = 0; i < (int)(sizeof(prims)/sizeof(prims[0])); i++) { Vim_Prim *prim = prims + i; - scheme_add_global(prim->name, - scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name, - prim->mina, prim->maxa), - mod); + 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_add_global("global-namespace", (Scheme_Object *)environment, mod); scheme_finish_primitive_module(mod); + MZ_GC_CHECK(); + MZ_GC_UNREG(); } #ifdef HAVE_SANDBOX @@ -2697,21 +3148,25 @@ sandbox_file_guard(int argc, Scheme_Object **argv) { 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)) |