diff options
author | Bram Moolenaar <Bram@vim.org> | 2013-01-30 14:55:42 +0100 |
---|---|---|
committer | Bram Moolenaar <Bram@vim.org> | 2013-01-30 14:55:42 +0100 |
commit | 7567646f13beb8c7aad79340f30ad2b5d5c8225f (patch) | |
tree | bfb2579864761ea87c16ffbf8ddc97d079ea1543 /src | |
parent | a3e6bc93d1a76e0619c27e462b75d8f94969f47d (diff) |
updated for version 7.3.791v7.3.791
Problem: MzScheme interface doesn't work propely.
Solution: Make it work better. (Sergey Khorev)
Diffstat (limited to 'src')
-rw-r--r-- | src/Make_ming.mak | 3 | ||||
-rw-r--r-- | src/Make_mvc.mak | 2 | ||||
-rwxr-xr-x | src/auto/configure | 7 | ||||
-rw-r--r-- | src/configure.in | 7 | ||||
-rw-r--r-- | src/eval.c | 16 | ||||
-rw-r--r-- | src/if_mzsch.c | 531 | ||||
-rw-r--r-- | src/if_mzsch.h | 34 | ||||
-rw-r--r-- | src/os_unix.c | 7 | ||||
-rw-r--r-- | src/proto/eval.pro | 1 | ||||
-rw-r--r-- | src/testdir/test70.in | 15 | ||||
-rw-r--r-- | src/testdir/test70.ok | 1 | ||||
-rw-r--r-- | src/version.c | 2 |
12 files changed, 455 insertions, 171 deletions
diff --git a/src/Make_ming.mak b/src/Make_ming.mak index b11db8b93a..80a0c6670e 100644 --- a/src/Make_ming.mak +++ b/src/Make_ming.mak @@ -384,6 +384,9 @@ CFLAGS += -I$(MZSCHEME)/include -DFEAT_MZSCHEME -DMZSCHEME_COLLECTS=\"$(MZSCHEME ifeq (yes, $(DYNAMIC_MZSCHEME)) CFLAGS += -DDYNAMIC_MZSCHEME -DDYNAMIC_MZSCH_DLL=\"lib$(MZSCHEME_MAIN_LIB)$(MZSCHEME_VER).dll\" -DDYNAMIC_MZGC_DLL=\"libmzgc$(MZSCHEME_VER).dll\" endif +ifeq (yes, "$(MZSCHEME_DEBUG)") +CFLAGS += -DMZSCHEME_FORCE_GC +endif endif ifdef RUBY diff --git a/src/Make_mvc.mak b/src/Make_mvc.mak index 4d8b6691bb..769aebf697 100644 --- a/src/Make_mvc.mak +++ b/src/Make_mvc.mak @@ -1096,7 +1096,7 @@ $(OUTDIR)/if_perl.obj: $(OUTDIR) if_perl.c $(INCL) $(OUTDIR)/if_perlsfio.obj: $(OUTDIR) if_perlsfio.c $(INCL) $(CC) $(CFLAGS) $(PERL_INC) if_perlsfio.c -$(OUTDIR)/if_mzsch.obj: $(OUTDIR) if_mzsch.c $(INCL) $(MZSCHEME_EXTRA_DEP) +$(OUTDIR)/if_mzsch.obj: $(OUTDIR) if_mzsch.c if_mzsch.h $(INCL) $(MZSCHEME_EXTRA_DEP) $(CC) $(CFLAGS) if_mzsch.c \ -DMZSCHEME_COLLECTS=\"$(MZSCHEME:\=\\)\\collects\" mzscheme_base.c: diff --git a/src/auto/configure b/src/auto/configure index e73867f9a6..3ef90c87ff 100755 --- a/src/auto/configure +++ b/src/auto/configure @@ -4927,7 +4927,8 @@ $as_echo "no" >&6; } if test "X$vi_cv_path_mzscheme_pfx" != "X"; then if test "x$MACOSX" = "xyes"; then - MZSCHEME_LIBS="-framework PLT_MzScheme" + MZSCHEME_LIBS="-framework Racket" + MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" elif test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a"; then MZSCHEME_LIBS="${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a" MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" @@ -4968,6 +4969,10 @@ $as_echo_n "checking for racket collects directory... " >&6; } else if test -d $vi_cv_path_mzscheme_pfx/share/racket/collects; then SCHEME_COLLECTS=$vi_cv_path_mzscheme_pfx/share/racket/ + else + if test -d $vi_cv_path_mzscheme_pfx/collects; then + SCHEME_COLLECTS=$vi_cv_path_mzscheme_pfx/ + fi fi fi fi diff --git a/src/configure.in b/src/configure.in index 2dae429613..431bc2cbdf 100644 --- a/src/configure.in +++ b/src/configure.in @@ -617,7 +617,8 @@ if test "$enable_mzschemeinterp" = "yes"; then if test "X$vi_cv_path_mzscheme_pfx" != "X"; then if test "x$MACOSX" = "xyes"; then - MZSCHEME_LIBS="-framework PLT_MzScheme" + MZSCHEME_LIBS="-framework Racket" + MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" elif test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a"; then MZSCHEME_LIBS="${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a" MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" @@ -660,6 +661,10 @@ if test "$enable_mzschemeinterp" = "yes"; then else if test -d $vi_cv_path_mzscheme_pfx/share/racket/collects; then SCHEME_COLLECTS=$vi_cv_path_mzscheme_pfx/share/racket/ + else + if test -d $vi_cv_path_mzscheme_pfx/collects; then + SCHEME_COLLECTS=$vi_cv_path_mzscheme_pfx/ + fi fi fi fi diff --git a/src/eval.c b/src/eval.c index 46a1963de9..dc7c2409f1 100644 --- a/src/eval.c +++ b/src/eval.c @@ -14333,6 +14333,22 @@ f_mzeval(argvars, rettv) str = get_tv_string_buf(&argvars[0], buf); do_mzeval(str, rettv); } + + void +mzscheme_call_vim(name, args, rettv) + char_u *name; + typval_T *args; + typval_T *rettv; +{ + typval_T argvars[3]; + + argvars[0].v_type = VAR_STRING; + argvars[0].vval.v_string = name; + copy_tv(args, &argvars[1]); + argvars[2].v_type = VAR_UNKNOWN; + f_call(argvars, rettv); + clear_tv(&argvars[1]); +} #endif /* diff --git a/src/if_mzsch.c b/src/if_mzsch.c index 9a92fee87a..8b8c8016f0 100644 --- a/src/if_mzsch.c +++ b/src/if_mzsch.c @@ -1,11 +1,9 @@ /* vi:set ts=8 sts=4 sw=4: * * MzScheme interface by Sergey Khorev <sergey.khorev@gmail.com> - * Original work by Brent Fulgham <bfulgham@debian.org> + * Based on 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 @@ -142,7 +140,12 @@ 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 void do_output(char *mesg, intptr_t len); +#if MZSCHEME_VERSION_MAJOR >= 500 +# 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, ...); static void do_flush(void); static Scheme_Object *_apply_thunk_catch_exceptions( @@ -166,10 +169,13 @@ 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, +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, int depth, +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 @@ -183,6 +189,13 @@ static int buffer_mark_proc(void *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) @@ -195,12 +208,26 @@ static int window_mark_proc(void *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 #ifdef DYNAMIC_MZSCHEME - static Scheme_Object *dll_scheme_eof; static Scheme_Object *dll_scheme_false; static Scheme_Object *dll_scheme_void; @@ -319,6 +346,7 @@ 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, @@ -378,11 +406,11 @@ static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req); # endif # define scheme_gc_ptr_ok dll_scheme_gc_ptr_ok # if MZSCHEME_VERSION_MAJOR < 299 -# define scheme_get_sized_string_output dll_scheme_get_sized_string_output +# 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 +# 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 @@ -391,8 +419,8 @@ static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req); # 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_string dll_scheme_make_string -# define scheme_make_string_output_port dll_scheme_make_string_output_port +# 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 \ @@ -421,6 +449,7 @@ static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req); 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 @@ -529,6 +558,7 @@ static Thunk_Info mzsch_imports[] = { {"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}, @@ -625,11 +655,40 @@ dynamic_mzscheme_end(void) } #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" #elif MZSCHEME_VERSION_MAJOR >= 400 -# error MzScheme 4.x must include mzscheme_base.c, for MinGW32 you need to define MZSCHEME_GENERATE_BASE=yes +# error MzScheme >=4 must include mzscheme_base.c, for MinGW32 you need to define MZSCHEME_GENERATE_BASE=yes #endif /* @@ -861,6 +920,11 @@ startup_mzscheme(void) 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); @@ -869,10 +933,6 @@ startup_mzscheme(void) MZ_REGISTER_STATIC(exn_message); MZ_REGISTER_STATIC(vim_exn); -#ifndef TRAMPOLINED_MZVIM_STARTUP - /* in newer versions of precise GC the initial env has been created */ - environment = scheme_basic_env(); -#endif MZ_GC_CHECK(); #ifdef INCLUDE_MZSCHEME_BASE @@ -909,15 +969,11 @@ startup_mzscheme(void) 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_DECL_REG(3); 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(); @@ -925,11 +981,7 @@ startup_mzscheme(void) 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); + scheme_set_collects_path(coll_path); MZ_GC_CHECK(); MZ_GC_UNREG(); } @@ -944,11 +996,11 @@ startup_mzscheme(void) 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); + 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_config; + config = scheme_current_config(); MZ_GC_CHECK(); scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair); MZ_GC_CHECK(); @@ -991,7 +1043,7 @@ startup_mzscheme(void) MZ_GC_VAR_IN_REG(3, guard); MZ_GC_VAR_IN_REG(4, config); MZ_GC_REG(); - config = scheme_config; + config = scheme_current_config(); MZ_GC_CHECK(); args[0] = scheme_get_param(config, MZCONFIG_SECURITY_GUARD); MZ_GC_CHECK(); @@ -1055,12 +1107,12 @@ mzscheme_init(void) MZ_GC_DECL_REG(1); MZ_GC_VAR_IN_REG(0, config); MZ_GC_REG(); - config = scheme_config; + config = scheme_current_config(); MZ_GC_CHECK(); /* recreate ports each call effectively clearing these ones */ - curout = scheme_make_string_output_port(); + curout = scheme_make_byte_string_output_port(); MZ_GC_CHECK(); - curerr = scheme_make_string_output_port(); + curerr = scheme_make_byte_string_output_port(); MZ_GC_CHECK(); scheme_set_param(config, MZCONFIG_OUTPUT_PORT, curout); MZ_GC_CHECK(); @@ -1149,13 +1201,21 @@ mzscheme_buffer_free(buf_T *buf) { if (buf->b_mzscheme_ref) { - vim_mz_buffer *bp; + vim_mz_buffer *bp = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, bp); + MZ_GC_REG(); - bp = buf->b_mzscheme_ref; + bp = BUFFER_REF(buf); bp->buf = INVALID_BUFFER_VALUE; - buf->b_mzscheme_ref = NULL; +#ifndef MZ_PRECISE_GC scheme_gc_ptr_ok(bp); +#else + scheme_free_immobile_box(buf->b_mzscheme_ref); +#endif + buf->b_mzscheme_ref = NULL; MZ_GC_CHECK(); + MZ_GC_UNREG(); } } @@ -1167,12 +1227,20 @@ mzscheme_window_free(win_T *win) { if (win->w_mzscheme_ref) { - vim_mz_window *wp; - wp = win->w_mzscheme_ref; + 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; - win->w_mzscheme_ref = NULL; +#ifndef MZ_PRECISE_GC scheme_gc_ptr_ok(wp); +#else + scheme_free_immobile_box(win->w_mzscheme_ref); +#endif + win->w_mzscheme_ref = NULL; MZ_GC_CHECK(); + MZ_GC_UNREG(); } } @@ -1349,7 +1417,7 @@ do_intrnl_output(char *mesg, int error) } static void -do_output(char *mesg, intptr_t len UNUSED) +do_output(char *mesg, OUTPUT_LEN_TYPE len UNUSED) { /* TODO: use len, the string may not be NUL terminated */ do_intrnl_output(mesg, 0); @@ -1371,9 +1439,9 @@ do_printf(char *format, ...) do_flush(void) { char *buff; - intptr_t length; + OUTPUT_LEN_TYPE length; - buff = scheme_get_sized_string_output(curerr, &length); + buff = scheme_get_sized_byte_string_output(curerr, &length); MZ_GC_CHECK(); if (length) { @@ -1381,7 +1449,7 @@ do_flush(void) return; } - buff = scheme_get_sized_string_output(curout, &length); + buff = scheme_get_sized_byte_string_output(curout, &length); MZ_GC_CHECK(); if (length) do_output(buff, length); @@ -1398,12 +1466,17 @@ do_flush(void) vim_command(void *data, int argc, Scheme_Object **argv) { Vim_Prim *prim = (Vim_Prim *)data; - char *cmd = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + 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((char_u *)cmd, NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE); + do_cmdline(BYTE_STRING_VALUE(cmd), NULL, NULL, DOCMD_NOWAIT|DOCMD_VERBOSE); update_screen(VALID); + MZ_GC_UNREG(); raise_if_error(); return scheme_void; } @@ -1414,26 +1487,22 @@ vim_eval(void *data, int argc, Scheme_Object **argv) { #ifdef FEAT_EVAL 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; + Scheme_Object *result = NULL; typval_T *vim_result; - - MZ_GC_DECL_REG(1); - MZ_GC_VAR_IN_REG(0, visited); + 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); - visited = scheme_make_hash_table(SCHEME_hash_ptr); - MZ_GC_CHECK(); - - expr = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); - vim_result = eval_expr((char_u *)expr, NULL); + vim_result = eval_expr(BYTE_STRING_VALUE(expr), NULL); if (vim_result == NULL) raise_vim_exn(_("invalid expression")); - result = vim_to_mzscheme(vim_result, 1, visited); + result = vim_to_mzscheme(vim_result); + MZ_GC_CHECK(); free_tv(vim_result); MZ_GC_UNREG(); @@ -1474,16 +1543,21 @@ static Scheme_Object *M_global = NULL; get_option(void *data, int argc, Scheme_Object **argv) { Vim_Prim *prim = (Vim_Prim *)data; - char_u *name; long value; char *strval; int rc; - Scheme_Object *rval; + Scheme_Object *rval = NULL; + Scheme_Object *name = NULL; int opt_flags = 0; buf_T *save_curb = curbuf; win_T *save_curw = curwin; - name = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + 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) { @@ -1513,23 +1587,27 @@ 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, (char_u **)&strval, opt_flags); + rc = get_option_value(BYTE_STRING_VALUE(name), &value, (char_u **)&strval, opt_flags); curbuf = save_curb; curwin = save_curw; switch (rc) { case 1: + MZ_GC_UNREG(); return scheme_make_integer_value(value); case 0: - rval = scheme_make_string(strval); + rval = scheme_make_byte_string(strval); MZ_GC_CHECK(); vim_free(strval); + MZ_GC_UNREG(); return rval; case -1: case -2: + MZ_GC_UNREG(); raise_vim_exn(_("hidden option")); case -3: + MZ_GC_UNREG(); raise_vim_exn(_("unknown option")); } /* unreachable */ @@ -1540,13 +1618,18 @@ get_option(void *data, int argc, Scheme_Object **argv) static Scheme_Object * set_option(void *data, int argc, Scheme_Object **argv) { - char_u *cmd; + char_u *command = NULL; int opt_flags = 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); - GUARANTEE_STRING(prim->name, 0); if (argc > 1) { if (M_global == NULL) @@ -1575,9 +1658,10 @@ set_option(void *data, int argc, Scheme_Object **argv) } /* do_set can modify cmd, make copy */ - cmd = vim_strsave((char_u *)SCHEME_STR_VAL(argv[0])); - do_set(cmd, opt_flags); - vim_free(cmd); + command = vim_strsave(BYTE_STRING_VALUE(cmd)); + MZ_GC_UNREG(); + do_set(command, opt_flags); + vim_free(command); update_screen(NOT_VALID); curbuf = save_curb; curwin = save_curw; @@ -1639,7 +1723,6 @@ window_new(win_T *win) 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, @@ -1650,18 +1733,24 @@ window_new(win_T *win) * object, and reject them if the win_T *field is invalid. */ if (win->w_mzscheme_ref != NULL) - return win->w_mzscheme_ref; + return (Scheme_Object *)WINDOW_REF(win); - self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_window)); + MZ_GC_REG(); + self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_window)); vim_memset(self, 0, sizeof(vim_mz_window)); +#ifndef MZ_PRECISE_GC scheme_dont_gc_ptr(self); /* because win isn't visible to GC */ +#else + win->w_mzscheme_ref = scheme_malloc_immobile_box(NULL); +#endif + MZ_GC_CHECK(); + WINDOW_REF(win) = self; MZ_GC_CHECK(); - win->w_mzscheme_ref = self; self->win = win; self->so.type = mz_window_type; MZ_GC_UNREG(); - return (Scheme_Object *)(self); + return (Scheme_Object *)self; } /* (get-win-num [window]) */ @@ -1837,22 +1926,31 @@ 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_u *fname; int num = 0; - Scheme_Object *onum; + 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 - fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); /* TODO make open existing file */ - num = buflist_add(fname, BLN_LISTED | BLN_CURBUF); + 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); - return get_buffer_by_num(data, 1, &onum); + buf = get_buffer_by_num(data, 1, &onum); + MZ_GC_UNREG(); + return buf; } /* (get-buff-by-num {buffernum}) */ @@ -1878,23 +1976,34 @@ get_buffer_by_name(void *data, int argc, Scheme_Object **argv) { Vim_Prim *prim = (Vim_Prim *)data; buf_T *buf; - char_u *fname; + Scheme_Object *buffer = NULL; + Scheme_Object *fname = NULL; - fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + 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 (buf = firstbuf; buf; buf = buf->b_next) + { if (buf->b_ffname == NULL || buf->b_sfname == NULL) /* empty string */ { - if (fname[0] == NUL) - return buffer_new(buf); + if (BYTE_STRING_VALUE(fname)[0] == NUL) + buffer = buffer_new(buf); } - else if (!fnamecmp(buf->b_ffname, fname) - || !fnamecmp(buf->b_sfname, fname)) + else if (!fnamecmp(buf->b_ffname, BYTE_STRING_VALUE(fname)) + || !fnamecmp(buf->b_sfname, BYTE_STRING_VALUE(fname))) + { /* either short or long filename matches */ - return buffer_new(buf); + buffer = buffer_new(buf); + } + } - return scheme_false; + MZ_GC_UNREG(); + return buffer; } /* (get-next-buff [buffer]) */ @@ -1951,7 +2060,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((char *)buf->buf->b_ffname); + return scheme_make_byte_string((char *)buf->buf->b_ffname); } /* (curr-buff) */ @@ -1968,25 +2077,30 @@ buffer_new(buf_T *buf) 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, * then we can get at it in buf_freeall() in vim. */ if (buf->b_mzscheme_ref) - return buf->b_mzscheme_ref; + return (Scheme_Object *)BUFFER_REF(buf); - self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_buffer)); + MZ_GC_REG(); + self = scheme_malloc_fail_ok(scheme_malloc_tagged, sizeof(vim_mz_buffer)); vim_memset(self, 0, sizeof(vim_mz_buffer)); - scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */ +#ifndef MZ_PRECISE_GC + scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */ +#else + buf->b_mzscheme_ref = scheme_malloc_immobile_box(NULL); +#endif + MZ_GC_CHECK(); + BUFFER_REF(buf) = self; MZ_GC_CHECK(); - buf->b_mzscheme_ref = self; self->buf = buf; self->so.type = mz_buffer_type; MZ_GC_UNREG(); - return (Scheme_Object *)(self); + return (Scheme_Object *)self; } /* @@ -2023,7 +2137,7 @@ get_buffer_line(void *data, int argc, Scheme_Object **argv) line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE); raise_if_error(); - return scheme_make_string((char *)line); + return scheme_make_byte_string((char *)line); } @@ -2066,7 +2180,7 @@ get_buffer_line_list(void *data, int argc, Scheme_Object **argv) for (i = n; i >= 0; --i) { - Scheme_Object *str = scheme_make_string( + Scheme_Object *str = scheme_make_byte_string( (char *)ml_get_buf(buf->buf, (linenr_T)(lo+i), FALSE)); raise_if_error(); @@ -2298,8 +2412,8 @@ set_buffer_line_list(void *data, int argc, Scheme_Object **argv) MZ_GC_VAR_IN_REG(1, rest); MZ_GC_REG(); - array = (char **)alloc(new_len * sizeof(char *)); - vim_memset(array, 0, new_len * sizeof(char *)); + array = (char **)alloc((new_len+1)* sizeof(char *)); + vim_memset(array, 0, (new_len+1) * sizeof(char *)); rest = line_list; for (i = 0; i < new_len; ++i) @@ -2481,8 +2595,8 @@ insert_buffer_line_list(void *data, int argc, Scheme_Object **argv) MZ_GC_VAR_IN_REG(1, rest); MZ_GC_REG(); - array = (char **)alloc(size * sizeof(char *)); - vim_memset(array, 0, size * sizeof(char *)); + array = (char **)alloc((size+1) * sizeof(char *)); + vim_memset(array, 0, (size+1) * sizeof(char *)); rest = list; for (i = 0; i < size; ++i) @@ -2589,7 +2703,7 @@ string_to_line(Scheme_Object *obj) { char *scheme_str = NULL; char *vim_str = NULL; - intptr_t len; + OUTPUT_LEN_TYPE len; int i; scheme_str = scheme_display_to_string(obj, &len); @@ -2598,10 +2712,10 @@ string_to_line(Scheme_Object *obj) * are replacing a single line, and we must replace it with * a single line. */ - if (memchr(scheme_str, '\n', (size_t)len)) + if (memchr(scheme_str, '\n', len)) scheme_signal_error(_("string cannot contain newlines")); - vim_str = (char *)alloc((int)(len + 1)); + vim_str = (char *)alloc(len + 1); /* Create a copy of the string, with internal nulls replaced by * newline characters, as is the vim convention. @@ -2625,13 +2739,35 @@ string_to_line(Scheme_Object *obj) * 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) +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(1); + 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 */ @@ -2650,8 +2786,7 @@ vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited) new_value = FALSE; else if (vim_value->v_type == VAR_STRING) { - result = scheme_make_string(vim_value->vval.v_string == NULL - ? "" : (char *)vim_value->vval.v_string); + result = scheme_make_byte_string((char *)vim_value->vval.v_string); MZ_GC_CHECK(); } else if (vim_value->v_type == VAR_NUMBER) @@ -2682,14 +2817,14 @@ vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited) MZ_GC_REG(); curr = list->lv_last; - obj = vim_to_mzscheme(&curr->li_tv, depth + 1, visited); + 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(&curr->li_tv, depth + 1, visited); + obj = vim_to_mzscheme_impl(&curr->li_tv, depth + 1, visited); result = scheme_make_pair(obj, result); MZ_GC_CHECK(); } @@ -2722,8 +2857,8 @@ vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited) --todo; di = dict_lookup(hi); - obj = vim_to_mzscheme(&di->di_tv, depth + 1, visited); - key = scheme_make_string((char *)hi->hi_key); + 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(); @@ -2732,6 +2867,22 @@ vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited) } 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(); + + 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 { result = scheme_void; @@ -2747,11 +2898,42 @@ vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited) } static int -mzscheme_to_vim(Scheme_Object *obj, typval_T *tv, int depth, +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 */ { @@ -2785,11 +2967,25 @@ mzscheme_to_vim(Scheme_Object *obj, typval_T *tv, int depth, tv->vval.v_float = SCHEME_DBL_VAL(obj); } # endif - else if (SCHEME_STRINGP(obj)) + else if (SCHEME_BYTE_STRINGP(obj)) { tv->v_type = VAR_STRING; - tv->vval.v_string = vim_strsave((char_u *)SCHEME_STR_VAL(obj)); + 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 |