diff src/if_mzsch.c @ 7609:77a14f3bc18b v7.4.1104

commit https://github.com/vim/vim/commit/4e640bd930d133889dbc9f9a77e29bab902e3b7d Author: Bram Moolenaar <Bram@vim.org> Date: Sat Jan 16 16:20:38 2016 +0100 patch 7.4.1104 Problem: Various problems building with MzScheme/Racket. Solution: Make it work with new versions of Racket. (Yukihiro Nakadaira, Ken Takata)
author Christian Brabandt <cb@256bit.org>
date Sat, 16 Jan 2016 16:30:04 +0100
parents 1e621b31948b
children bce3b5ddb393
line wrap: on
line diff
--- a/src/if_mzsch.c
+++ b/src/if_mzsch.c
@@ -29,6 +29,27 @@
  * depend". */
 #if defined(FEAT_MZSCHEME) || defined(PROTO)
 
+/*
+ * scheme_register_tls_space is only available on 32-bit Windows until
+ * racket-6.3.  See
+ * http://docs.racket-lang.org/inside/im_memoryalloc.html?q=scheme_register_tls_space
+ */
+#if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) \
+	&& defined(USE_THREAD_LOCAL) \
+	&& (!defined(_WIN64) || MZSCHEME_VERSION_MAJOR >= 603)
+# define HAVE_TLS_SPACE 1
+#endif
+
+/*
+ * Since version 4.x precise GC requires trampolined startup.
+ * Futures and places in version 5.x need it too.
+ */
+#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \
+    || MZSCHEME_VERSION_MAJOR >= 500 \
+	&& (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES))
+# define TRAMPOLINED_MZVIM_STARTUP
+#endif
+
 /* Base data structures */
 #define SCHEME_VIMBUFFERP(obj)  SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type)
 #define SCHEME_VIMWINDOWP(obj)  SAME_TYPE(SCHEME_TYPE(obj), mz_window_type)
@@ -138,9 +159,9 @@ static Scheme_Object *vim_window_validp(
  */
 static int vim_error_check(void);
 static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what);
-static void startup_mzscheme(void);
+static int startup_mzscheme(void);
 static char *string_to_line(Scheme_Object *obj);
-#if MZSCHEME_VERSION_MAJOR >= 500
+#if MZSCHEME_VERSION_MAJOR >= 501
 # define OUTPUT_LEN_TYPE intptr_t
 #else
 # define OUTPUT_LEN_TYPE long
@@ -237,7 +258,7 @@ static Scheme_Object *dll_scheme_true;
 static Scheme_Thread **dll_scheme_current_thread_ptr;
 
 static void (**dll_scheme_console_printf_ptr)(char *str, ...);
-static void (**dll_scheme_console_output_ptr)(char *str, long len);
+static void (**dll_scheme_console_output_ptr)(char *str, OUTPUT_LEN_TYPE len);
 static void (**dll_scheme_notify_multithread_ptr)(int on);
 
 static void *(*dll_GC_malloc)(size_t size_in_bytes);
@@ -255,6 +276,7 @@ static Scheme_Object *(*dll_scheme_apply
 static Scheme_Object *(*dll_scheme_builtin_value)(const char *name);
 # if MZSCHEME_VERSION_MAJOR >= 299
 static Scheme_Object *(*dll_scheme_byte_string_to_char_string)(Scheme_Object *s);
+static Scheme_Object *(*dll_scheme_make_path)(const char *chars);
 # endif
 static void (*dll_scheme_close_input_port)(Scheme_Object *port);
 static void (*dll_scheme_count_lines)(Scheme_Object *port);
@@ -264,7 +286,7 @@ static Scheme_Object *(*dll_scheme_curre
 static Scheme_Object *(*dll_scheme_current_continuation_marks)(Scheme_Object *prompt_tag);
 #endif
 static void (*dll_scheme_display)(Scheme_Object *obj, Scheme_Object *port);
-static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, long *len);
+static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, OUTPUT_LEN_TYPE *len);
 static int (*dll_scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2);
 static Scheme_Object *(*dll_scheme_do_eval)(Scheme_Object *obj,
 	int _num_rands, Scheme_Object **rands, int val);
@@ -280,7 +302,7 @@ static char *(*dll_scheme_format)(char *
 	Scheme_Object **argv, long *rlen);
 # else
 static char *(*dll_scheme_format_utf8)(char *format, int flen, int argc,
-	Scheme_Object **argv, long *rlen);
+	Scheme_Object **argv, OUTPUT_LEN_TYPE *rlen);
 static Scheme_Object *(*dll_scheme_get_param)(Scheme_Config *c, int pos);
 # endif
 static void (*dll_scheme_gc_ptr_ok)(void *p);
@@ -289,7 +311,7 @@ static char *(*dll_scheme_get_sized_stri
 	long *len);
 # else
 static char *(*dll_scheme_get_sized_byte_string_output)(Scheme_Object *,
-	long *len);
+	OUTPUT_LEN_TYPE *len);
 # endif
 static Scheme_Object *(*dll_scheme_intern_symbol)(const char *name);
 static Scheme_Object *(*dll_scheme_lookup_global)(Scheme_Object *symbol,
@@ -354,10 +376,34 @@ static void (*dll_scheme_hash_set)(Schem
 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);
+static Scheme_Object *(*dll_scheme_dynamic_wind)(void (*pre)(void *), Scheme_Object *(* volatile act)(void *), void (* volatile post)(void *), Scheme_Object *(*jmp_handler)(void *), void * volatile data);
+# ifdef MZ_PRECISE_GC
+static void *(*dll_GC_malloc_one_tagged)(size_t size_in_bytes);
+static void (*dll_GC_register_traversers)(short tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup, int is_constant_size, int is_atomic);
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 400
+static void (*dll_scheme_init_collection_paths)(Scheme_Env *global_env, Scheme_Object *extra_dirs);
+static void **(*dll_scheme_malloc_immobile_box)(void *p);
+static void (*dll_scheme_free_immobile_box)(void **b);
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 500
+#  ifdef TRAMPOLINED_MZVIM_STARTUP
+static int (*dll_scheme_main_setup)(int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv);
+#   if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
+static void (*dll_scheme_register_tls_space)(void *tls_space, int _tls_index);
+#   endif
+#  endif
+#  if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
+static Thread_Local_Variables *(*dll_scheme_external_get_thread_local_variables)(void);
+#  endif
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 600
+static void (*dll_scheme_embedded_load)(intptr_t len, const char *s, int predefined);
+static void (*dll_scheme_register_embedded_load)(intptr_t len, const char *s);
+static void (*dll_scheme_set_config_path)(Scheme_Object *p);
 # endif
 
 /* arrays are imported directly */
@@ -368,7 +414,9 @@ static Scheme_Object *(*dll_scheme_names
 # define scheme_true dll_scheme_true
 
 /* pointers are GetProceAddress'ed as pointers to pointer */
-# define scheme_current_thread (*dll_scheme_current_thread_ptr)
+#if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
+#  define scheme_current_thread (*dll_scheme_current_thread_ptr)
+# endif
 # define scheme_console_printf (*dll_scheme_console_printf_ptr)
 # define scheme_console_output (*dll_scheme_console_output_ptr)
 # define scheme_notify_multithread (*dll_scheme_notify_multithread_ptr)
@@ -384,6 +432,7 @@ static Scheme_Object *(*dll_scheme_names
 # define scheme_builtin_value dll_scheme_builtin_value
 # if MZSCHEME_VERSION_MAJOR >= 299
 #  define scheme_byte_string_to_char_string dll_scheme_byte_string_to_char_string
+#  define scheme_make_path dll_scheme_make_path
 # endif
 # define scheme_check_threads dll_scheme_check_threads
 # define scheme_close_input_port dll_scheme_close_input_port
@@ -455,9 +504,39 @@ static Scheme_Object *(*dll_scheme_names
 # 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
+# define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string
+# define scheme_namespace_require dll_scheme_namespace_require
+# define scheme_dynamic_wind dll_scheme_dynamic_wind
+# ifdef MZ_PRECISE_GC
+#  define GC_malloc_one_tagged dll_GC_malloc_one_tagged
+#  define GC_register_traversers dll_GC_register_traversers
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 400
+#  ifdef TRAMPOLINED_MZVIM_STARTUP
+#   define scheme_main_setup dll_scheme_main_setup
+#   if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
+#    define scheme_register_tls_space dll_scheme_register_tls_space
+#   endif
+#  endif
+#  define scheme_init_collection_paths dll_scheme_init_collection_paths
+#  define scheme_malloc_immobile_box dll_scheme_malloc_immobile_box
+#  define scheme_free_immobile_box dll_scheme_free_immobile_box
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 600
+#  define scheme_embedded_load dll_scheme_embedded_load
+#  define scheme_register_embedded_load dll_scheme_register_embedded_load
+#  define scheme_set_config_path dll_scheme_set_config_path
+# endif
+
+# if MZSCHEME_VERSION_MAJOR >= 500
+#  if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
+/* define as function for macro in schshread.h */
+Thread_Local_Variables *
+scheme_external_get_thread_local_variables(void)
+{
+    return dll_scheme_external_get_thread_local_variables();
+}
+#  endif
 # endif
 
 typedef struct
@@ -477,7 +556,9 @@ static Thunk_Info mzsch_imports[] = {
     {"scheme_void", (void **)&dll_scheme_void},
     {"scheme_null", (void **)&dll_scheme_null},
     {"scheme_true", (void **)&dll_scheme_true},
+#if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
     {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr},
+#endif
     {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr},
     {"scheme_console_output", (void **)&dll_scheme_console_output_ptr},
     {"scheme_notify_multithread",
@@ -488,6 +569,7 @@ static Thunk_Info mzsch_imports[] = {
     {"scheme_basic_env", (void **)&dll_scheme_basic_env},
 # if MZSCHEME_VERSION_MAJOR >= 299
     {"scheme_byte_string_to_char_string", (void **)&dll_scheme_byte_string_to_char_string},
+    {"scheme_make_path", (void **)&dll_scheme_make_path},
 # endif
     {"scheme_builtin_value", (void **)&dll_scheme_builtin_value},
     {"scheme_check_threads", (void **)&dll_scheme_check_threads},
@@ -564,10 +646,34 @@ static Thunk_Info mzsch_imports[] = {
     {"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
+    {"scheme_dynamic_wind", (void **)&dll_scheme_dynamic_wind},
+# ifdef MZ_PRECISE_GC
+    {"GC_malloc_one_tagged", (void **)&dll_GC_malloc_one_tagged},
+    {"GC_register_traversers", (void **)&dll_GC_register_traversers},
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 400
+#  ifdef TRAMPOLINED_MZVIM_STARTUP
+    {"scheme_main_setup", (void **)&dll_scheme_main_setup},
+#   if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
+    {"scheme_register_tls_space", (void **)&dll_scheme_register_tls_space},
+#   endif
+#  endif
+    {"scheme_init_collection_paths", (void **)&dll_scheme_init_collection_paths},
+    {"scheme_malloc_immobile_box", (void **)&dll_scheme_malloc_immobile_box},
+    {"scheme_free_immobile_box", (void **)&dll_scheme_free_immobile_box},
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 500
+#  if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
+    {"scheme_external_get_thread_local_variables", (void **)&dll_scheme_external_get_thread_local_variables},
+#  endif
+# endif
+# if MZSCHEME_VERSION_MAJOR >= 600
+    {"scheme_embedded_load", (void **)&dll_scheme_embedded_load},
+    {"scheme_register_embedded_load", (void **)&dll_scheme_register_embedded_load},
+    {"scheme_set_config_path", (void **)&dll_scheme_set_config_path},
+# endif
     {NULL, NULL}};
 
 static HINSTANCE hMzGC = 0;
@@ -687,8 +793,6 @@ guaranteed_byte_string_arg(char *proc, i
 /* 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 must include mzscheme_base.c, for MinGW32 you need to define MZSCHEME_GENERATE_BASE=yes
 #endif
 
 /*
@@ -701,6 +805,10 @@ static Scheme_Type mz_buffer_type;
 static Scheme_Type mz_window_type;
 
 static int initialized = FALSE;
+#ifdef DYNAMIC_MZSCHEME
+static int disabled = FALSE;
+#endif
+static int load_base_module_failed = FALSE;
 
 /* global environment */
 static Scheme_Env    *environment = NULL;
@@ -846,38 +954,43 @@ notify_multithread(int on)
     void
 mzscheme_end(void)
 {
+    /* We can not unload the DLL.  Racket's thread might be still alive. */
+#if 0
 #ifdef DYNAMIC_MZSCHEME
     dynamic_mzscheme_end();
 #endif
+#endif
 }
 
-/*
- * scheme_register_tls_space is only available on 32-bit Windows.
- * See http://docs.racket-lang.org/inside/im_memoryalloc.html?q=scheme_register_tls_space
- */
-#if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) \
-	&& defined(USE_THREAD_LOCAL) && !defined(_WIN64)
-# define HAVE_TLS_SPACE 1
+#if HAVE_TLS_SPACE
+# if defined(_MSC_VER)
 static __declspec(thread) void *tls_space;
-#endif
-
-/*
- * Since version 4.x precise GC requires trampolined startup.
- * Futures and places in version 5.x need it too.
- */
-#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \
-    || MZSCHEME_VERSION_MAJOR >= 500 && (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES))
-# ifdef DYNAMIC_MZSCHEME
-#  error Precise GC v.4+ or Racket with futures/places do not support dynamic MzScheme
+extern intptr_t _tls_index;
+# elif defined(__MINGW32__)
+static __thread void *tls_space;
+extern intptr_t _tls_index;
+# else
+static THREAD_LOCAL void *tls_space;
+static intptr_t _tls_index = 0;
 # endif
-# define TRAMPOLINED_MZVIM_STARTUP
 #endif
 
     int
 mzscheme_main(int argc, char** argv)
 {
+#ifdef DYNAMIC_MZSCHEME
+    /*
+     * Racket requires trampolined startup.  We can not load it later.
+     * If dynamic dll loading is failed, disable it.
+     */
+    if (!mzscheme_enabled(FALSE))
+    {
+	disabled = TRUE;
+	return vim_main2(argc, argv);
+    }
+#endif
 #ifdef HAVE_TLS_SPACE
-    scheme_register_tls_space(&tls_space, 0);
+    scheme_register_tls_space(&tls_space, _tls_index);
 #endif
 #ifdef TRAMPOLINED_MZVIM_STARTUP
     return scheme_main_setup(TRUE, mzscheme_env_main, argc, argv);
@@ -919,7 +1032,21 @@ mzscheme_env_main(Scheme_Env *env, int a
     return vim_main_result;
 }
 
-    static void
+    static Scheme_Object*
+load_base_module(void *data)
+{
+    scheme_namespace_require(scheme_intern_symbol((char *)data));
+    return scheme_null;
+}
+
+    static Scheme_Object *
+load_base_module_on_error(void *data)
+{
+    load_base_module_failed = TRUE;
+    return scheme_null;
+}
+
+    static int
 startup_mzscheme(void)
 {
 #ifndef TRAMPOLINED_MZVIM_STARTUP
@@ -942,87 +1069,45 @@ startup_mzscheme(void)
     MZ_GC_CHECK();
 
 #ifdef INCLUDE_MZSCHEME_BASE
-    {
-	/*
-	 * versions 4.x do not provide Scheme bindings by default
-	 * 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 mzscheme_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();
-    }
+    /* invoke function from generated and included mzscheme_base.c */
+    declare_modules(environment);
 #endif
-    register_vim_exn();
-    /* use new environment to initialise exception handling */
-    init_exn_catching_apply();
-
-    /* redirect output */
-    scheme_console_output = do_output;
-    scheme_console_printf = do_printf;
-
-#ifdef MZSCHEME_COLLECTS
+
     /* setup 'current-library-collection-paths' parameter */
 # if MZSCHEME_VERSION_MAJOR >= 299
-#  ifdef MACOS
     {
-	Scheme_Object	*coll_byte_string = NULL;
-	Scheme_Object	*coll_char_string = NULL;
-	Scheme_Object	*coll_path = NULL;
-
-	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);
+	Scheme_Object *coll_path = NULL;
+	int mustfree = FALSE;
+	char_u *s;
+
+	MZ_GC_DECL_REG(1);
+	MZ_GC_VAR_IN_REG(0, coll_path);
 	MZ_GC_REG();
-	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();
-	scheme_set_collects_path(coll_path);
-	MZ_GC_CHECK();
+	/* workaround for dynamic loading on windows */
+	s = vim_getenv("PLTCOLLECTS", &mustfree);
+	if (s != NULL)
+	{
+	    coll_path = scheme_make_path(s);
+	    MZ_GC_CHECK();
+	    if (mustfree)
+		vim_free(s);
+	}
+#  ifdef MZSCHEME_COLLECTS
+	if (coll_path == NULL)
+	{
+	    coll_path = scheme_make_path(MZSCHEME_COLLECTS);
+	    MZ_GC_CHECK();
+	}
+#  endif
+	if (coll_path != NULL)
+	{
+	    scheme_set_collects_path(coll_path);
+	    MZ_GC_CHECK();
+	}
 	MZ_GC_UNREG();
     }
-#  else
-   {
-	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_current_config();
-	MZ_GC_CHECK();
-	scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair);
-	MZ_GC_CHECK();
-	MZ_GC_UNREG();
-    }
-#  endif
 # else
+#  ifdef MZSCHEME_COLLECTS
     {
 	Scheme_Object	*coll_string = NULL;
 	Scheme_Object	*coll_pair = NULL;
@@ -1045,6 +1130,71 @@ startup_mzscheme(void)
     }
 # endif
 #endif
+
+# if MZSCHEME_VERSION_MAJOR >= 600
+    {
+	Scheme_Object *config_path = NULL;
+	int mustfree = FALSE;
+	char_u *s;
+
+	MZ_GC_DECL_REG(1);
+	MZ_GC_VAR_IN_REG(0, config_path);
+	MZ_GC_REG();
+	/* workaround for dynamic loading on windows */
+	s = vim_getenv("PLTCONFIGDIR", &mustfree);
+	if (s != NULL)
+	{
+	    config_path = scheme_make_path(s);
+	    MZ_GC_CHECK();
+	    if (mustfree)
+		vim_free(s);
+	}
+#ifdef MZSCHEME_CONFIGDIR
+	if (config_path == NULL)
+	{
+	    config_path = scheme_make_path(MZSCHEME_CONFIGDIR);
+	    MZ_GC_CHECK();
+	}
+#endif
+	if (config_path != NULL)
+	{
+	    scheme_set_config_path(config_path);
+	    MZ_GC_CHECK();
+	}
+	MZ_GC_UNREG();
+    }
+# endif
+
+#if MZSCHEME_VERSION_MAJOR >= 400
+    scheme_init_collection_paths(environment, scheme_null);
+#endif
+
+    /*
+     * versions 4.x do not provide Scheme bindings by default
+     * we need to add them explicitly
+     */
+    {
+	/* use error handler to avoid abort */
+	scheme_dynamic_wind(NULL, load_base_module, NULL,
+				    load_base_module_on_error, "racket/base");
+	if (load_base_module_failed)
+	{
+	    load_base_module_failed = FALSE;
+	    scheme_dynamic_wind(NULL, load_base_module, NULL,
+				    load_base_module_on_error, "scheme/base");
+	    if (load_base_module_failed)
+		return -1;
+	}
+    }
+
+    register_vim_exn();
+    /* use new environment to initialise exception handling */
+    init_exn_catching_apply();
+
+    /* redirect output */
+    scheme_console_output = do_output;
+    scheme_console_printf = do_printf;
+
 #ifdef HAVE_SANDBOX
     {
 	Scheme_Object	*make_security_guard = NULL;
@@ -1118,6 +1268,8 @@ startup_mzscheme(void)
      * whether thread scheduling is (or not) required
      */
     scheme_notify_multithread = notify_multithread;
+
+    return 0;
 }
 
 /*
@@ -1130,13 +1282,17 @@ mzscheme_init(void)
     if (!initialized)
     {
 #ifdef DYNAMIC_MZSCHEME
-	if (!mzscheme_enabled(TRUE))
+	if (disabled || !mzscheme_enabled(TRUE))
 	{
 	    EMSG(_("E815: Sorry, this command is disabled, the MzScheme libraries could not be loaded."));
 	    return -1;
 	}
 #endif
-	startup_mzscheme();
+	if (load_base_module_failed || startup_mzscheme())
+	{
+	    EMSG(_("Exxx: Sorry, this command is disabled, the MzScheme's racket/base module could not be loaded."));
+	    return -1;
+	}
 	initialized = TRUE;
     }
     {