diff options
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 7f43cab6ed..017f8041ed 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); / |