Mercurial > vim

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
7608:161471eae904 7609:77a14f3bc18b
27 27
28 /* Only do the following when the feature is enabled. Needed for "make 28 /* Only do the following when the feature is enabled. Needed for "make
29 * depend". */ 29 * depend". */
30 #if defined(FEAT_MZSCHEME) || defined(PROTO) 30 #if defined(FEAT_MZSCHEME) || defined(PROTO)
31 31
32 /*
33 * scheme_register_tls_space is only available on 32-bit Windows until
34 * racket-6.3. See
35 * http://docs.racket-lang.org/inside/im_memoryalloc.html?q=scheme_register_tls_space
36 */
37 #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) \
38 && defined(USE_THREAD_LOCAL) \
39 && (!defined(_WIN64) || MZSCHEME_VERSION_MAJOR >= 603)
40 # define HAVE_TLS_SPACE 1
41 #endif
42
43 /*
44 * Since version 4.x precise GC requires trampolined startup.
45 * Futures and places in version 5.x need it too.
46 */
47 #if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \
48 || MZSCHEME_VERSION_MAJOR >= 500 \
49 && (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES))
50 # define TRAMPOLINED_MZVIM_STARTUP
51 #endif
52
32 /* Base data structures */ 53 /* Base data structures */
33 #define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type) 54 #define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type)
34 #define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type) 55 #define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type)
35 56
36 typedef struct 57 typedef struct
136 * Internal Function Prototypes 157 * Internal Function Prototypes
137 *======================================================================== 158 *========================================================================
138 */ 159 */
139 static int vim_error_check(void); 160 static int vim_error_check(void);
140 static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what); 161 static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what);
141 static void startup_mzscheme(void); 162 static int startup_mzscheme(void);
142 static char *string_to_line(Scheme_Object *obj); 163 static char *string_to_line(Scheme_Object *obj);
143 #if MZSCHEME_VERSION_MAJOR >= 500 164 #if MZSCHEME_VERSION_MAJOR >= 501
144 # define OUTPUT_LEN_TYPE intptr_t 165 # define OUTPUT_LEN_TYPE intptr_t
145 #else 166 #else
146 # define OUTPUT_LEN_TYPE long 167 # define OUTPUT_LEN_TYPE long
147 #endif 168 #endif
148 static void do_output(char *mesg, OUTPUT_LEN_TYPE len); 169 static void do_output(char *mesg, OUTPUT_LEN_TYPE len);
235 static Scheme_Object *dll_scheme_true; 256 static Scheme_Object *dll_scheme_true;
236 257
237 static Scheme_Thread **dll_scheme_current_thread_ptr; 258 static Scheme_Thread **dll_scheme_current_thread_ptr;
238 259
239 static void (**dll_scheme_console_printf_ptr)(char *str, ...); 260 static void (**dll_scheme_console_printf_ptr)(char *str, ...);
240 static void (**dll_scheme_console_output_ptr)(char *str, long len); 261 static void (**dll_scheme_console_output_ptr)(char *str, OUTPUT_LEN_TYPE len);
241 static void (**dll_scheme_notify_multithread_ptr)(int on); 262 static void (**dll_scheme_notify_multithread_ptr)(int on);
242 263
243 static void *(*dll_GC_malloc)(size_t size_in_bytes); 264 static void *(*dll_GC_malloc)(size_t size_in_bytes);
244 static void *(*dll_GC_malloc_atomic)(size_t size_in_bytes); 265 static void *(*dll_GC_malloc_atomic)(size_t size_in_bytes);
245 static Scheme_Env *(*dll_scheme_basic_env)(void); 266 static Scheme_Env *(*dll_scheme_basic_env)(void);
253 static Scheme_Object *(*dll_scheme_apply)(Scheme_Object *rator, int num_rands, 274 static Scheme_Object *(*dll_scheme_apply)(Scheme_Object *rator, int num_rands,
254 Scheme_Object **rands); 275 Scheme_Object **rands);
255 static Scheme_Object *(*dll_scheme_builtin_value)(const char *name); 276 static Scheme_Object *(*dll_scheme_builtin_value)(const char *name);
256 # if MZSCHEME_VERSION_MAJOR >= 299 277 # if MZSCHEME_VERSION_MAJOR >= 299
257 static Scheme_Object *(*dll_scheme_byte_string_to_char_string)(Scheme_Object *s); 278 static Scheme_Object *(*dll_scheme_byte_string_to_char_string)(Scheme_Object *s);
279 static Scheme_Object *(*dll_scheme_make_path)(const char *chars);
258 # endif 280 # endif
259 static void (*dll_scheme_close_input_port)(Scheme_Object *port); 281 static void (*dll_scheme_close_input_port)(Scheme_Object *port);
260 static void (*dll_scheme_count_lines)(Scheme_Object *port); 282 static void (*dll_scheme_count_lines)(Scheme_Object *port);
261 #if MZSCHEME_VERSION_MAJOR < 360 283 #if MZSCHEME_VERSION_MAJOR < 360
262 static Scheme_Object *(*dll_scheme_current_continuation_marks)(void); 284 static Scheme_Object *(*dll_scheme_current_continuation_marks)(void);
263 #else 285 #else
264 static Scheme_Object *(*dll_scheme_current_continuation_marks)(Scheme_Object *prompt_tag); 286 static Scheme_Object *(*dll_scheme_current_continuation_marks)(Scheme_Object *prompt_tag);
265 #endif 287 #endif
266 static void (*dll_scheme_display)(Scheme_Object *obj, Scheme_Object *port); 288 static void (*dll_scheme_display)(Scheme_Object *obj, Scheme_Object *port);
267 static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, long *len); 289 static char *(*dll_scheme_display_to_string)(Scheme_Object *obj, OUTPUT_LEN_TYPE *len);
268 static int (*dll_scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2); 290 static int (*dll_scheme_eq)(Scheme_Object *obj1, Scheme_Object *obj2);
269 static Scheme_Object *(*dll_scheme_do_eval)(Scheme_Object *obj, 291 static Scheme_Object *(*dll_scheme_do_eval)(Scheme_Object *obj,
270 int _num_rands, Scheme_Object **rands, int val); 292 int _num_rands, Scheme_Object **rands, int val);
271 static void (*dll_scheme_dont_gc_ptr)(void *p); 293 static void (*dll_scheme_dont_gc_ptr)(void *p);
272 static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env); 294 static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env);
278 # if MZSCHEME_VERSION_MAJOR < 299 300 # if MZSCHEME_VERSION_MAJOR < 299
279 static char *(*dll_scheme_format)(char *format, int flen, int argc, 301 static char *(*dll_scheme_format)(char *format, int flen, int argc,
280 Scheme_Object **argv, long *rlen); 302 Scheme_Object **argv, long *rlen);
281 # else 303 # else
282 static char *(*dll_scheme_format_utf8)(char *format, int flen, int argc, 304 static char *(*dll_scheme_format_utf8)(char *format, int flen, int argc,
283 Scheme_Object **argv, long *rlen); 305 Scheme_Object **argv, OUTPUT_LEN_TYPE *rlen);
284 static Scheme_Object *(*dll_scheme_get_param)(Scheme_Config *c, int pos); 306 static Scheme_Object *(*dll_scheme_get_param)(Scheme_Config *c, int pos);
285 # endif 307 # endif
286 static void (*dll_scheme_gc_ptr_ok)(void *p); 308 static void (*dll_scheme_gc_ptr_ok)(void *p);
287 # if MZSCHEME_VERSION_MAJOR < 299 309 # if MZSCHEME_VERSION_MAJOR < 299
288 static char *(*dll_scheme_get_sized_string_output)(Scheme_Object *, 310 static char *(*dll_scheme_get_sized_string_output)(Scheme_Object *,
289 long *len); 311 long *len);
290 # else 312 # else
291 static char *(*dll_scheme_get_sized_byte_string_output)(Scheme_Object *, 313 static char *(*dll_scheme_get_sized_byte_string_output)(Scheme_Object *,
292 long *len); 314 OUTPUT_LEN_TYPE *len);
293 # endif 315 # endif
294 static Scheme_Object *(*dll_scheme_intern_symbol)(const char *name); 316 static Scheme_Object *(*dll_scheme_intern_symbol)(const char *name);
295 static Scheme_Object *(*dll_scheme_lookup_global)(Scheme_Object *symbol, 317 static Scheme_Object *(*dll_scheme_lookup_global)(Scheme_Object *symbol,
296 Scheme_Env *env); 318 Scheme_Env *env);
297 static Scheme_Object *(*dll_scheme_make_closed_prim_w_arity) 319 static Scheme_Object *(*dll_scheme_make_closed_prim_w_arity)
352 static void (*dll_scheme_hash_set)(Scheme_Hash_Table *table, 374 static void (*dll_scheme_hash_set)(Scheme_Hash_Table *table,
353 Scheme_Object *key, Scheme_Object *value); 375 Scheme_Object *key, Scheme_Object *value);
354 static Scheme_Object *(*dll_scheme_hash_get)(Scheme_Hash_Table *table, 376 static Scheme_Object *(*dll_scheme_hash_get)(Scheme_Hash_Table *table,
355 Scheme_Object *key); 377 Scheme_Object *key);
356 static Scheme_Object *(*dll_scheme_make_double)(double d); 378 static Scheme_Object *(*dll_scheme_make_double)(double d);
357 # ifdef INCLUDE_MZSCHEME_BASE
358 static Scheme_Object *(*dll_scheme_make_sized_byte_string)(char *chars, 379 static Scheme_Object *(*dll_scheme_make_sized_byte_string)(char *chars,
359 long len, int copy); 380 long len, int copy);
360 static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req); 381 static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req);
382 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);
383 # ifdef MZ_PRECISE_GC
384 static void *(*dll_GC_malloc_one_tagged)(size_t size_in_bytes);
385 static void (*dll_GC_register_traversers)(short tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup, int is_constant_size, int is_atomic);
386 # endif
387 # if MZSCHEME_VERSION_MAJOR >= 400
388 static void (*dll_scheme_init_collection_paths)(Scheme_Env *global_env, Scheme_Object *extra_dirs);
389 static void **(*dll_scheme_malloc_immobile_box)(void *p);
390 static void (*dll_scheme_free_immobile_box)(void **b);
391 # endif
392 # if MZSCHEME_VERSION_MAJOR >= 500
393 # ifdef TRAMPOLINED_MZVIM_STARTUP
394 static int (*dll_scheme_main_setup)(int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv);
395 # if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
396 static void (*dll_scheme_register_tls_space)(void *tls_space, int _tls_index);
397 # endif
398 # endif
399 # if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
400 static Thread_Local_Variables *(*dll_scheme_external_get_thread_local_variables)(void);
401 # endif
402 # endif
403 # if MZSCHEME_VERSION_MAJOR >= 600
404 static void (*dll_scheme_embedded_load)(intptr_t len, const char *s, int predefined);
405 static void (*dll_scheme_register_embedded_load)(intptr_t len, const char *s);
406 static void (*dll_scheme_set_config_path)(Scheme_Object *p);
361 # endif 407 # endif
362 408
363 /* arrays are imported directly */ 409 /* arrays are imported directly */
364 # define scheme_eof dll_scheme_eof 410 # define scheme_eof dll_scheme_eof
365 # define scheme_false dll_scheme_false 411 # define scheme_false dll_scheme_false
366 # define scheme_void dll_scheme_void 412 # define scheme_void dll_scheme_void
367 # define scheme_null dll_scheme_null 413 # define scheme_null dll_scheme_null
368 # define scheme_true dll_scheme_true 414 # define scheme_true dll_scheme_true
369 415
370 /* pointers are GetProceAddress'ed as pointers to pointer */ 416 /* pointers are GetProceAddress'ed as pointers to pointer */
371 # define scheme_current_thread (*dll_scheme_current_thread_ptr) 417 #if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
418 # define scheme_current_thread (*dll_scheme_current_thread_ptr)
419 # endif
372 # define scheme_console_printf (*dll_scheme_console_printf_ptr) 420 # define scheme_console_printf (*dll_scheme_console_printf_ptr)
373 # define scheme_console_output (*dll_scheme_console_output_ptr) 421 # define scheme_console_output (*dll_scheme_console_output_ptr)
374 # define scheme_notify_multithread (*dll_scheme_notify_multithread_ptr) 422 # define scheme_notify_multithread (*dll_scheme_notify_multithread_ptr)
375 423
376 /* and functions in a usual way */ 424 /* and functions in a usual way */
382 # define scheme_apply dll_scheme_apply 430 # define scheme_apply dll_scheme_apply
383 # define scheme_basic_env dll_scheme_basic_env 431 # define scheme_basic_env dll_scheme_basic_env
384 # define scheme_builtin_value dll_scheme_builtin_value 432 # define scheme_builtin_value dll_scheme_builtin_value
385 # if MZSCHEME_VERSION_MAJOR >= 299 433 # if MZSCHEME_VERSION_MAJOR >= 299
386 # define scheme_byte_string_to_char_string dll_scheme_byte_string_to_char_string 434 # define scheme_byte_string_to_char_string dll_scheme_byte_string_to_char_string
435 # define scheme_make_path dll_scheme_make_path
387 # endif 436 # endif
388 # define scheme_check_threads dll_scheme_check_threads 437 # define scheme_check_threads dll_scheme_check_threads
389 # define scheme_close_input_port dll_scheme_close_input_port 438 # define scheme_close_input_port dll_scheme_close_input_port
390 # define scheme_count_lines dll_scheme_count_lines 439 # define scheme_count_lines dll_scheme_count_lines
391 # define scheme_current_continuation_marks \ 440 # define scheme_current_continuation_marks \
453 # endif 502 # endif
454 # define scheme_make_hash_table dll_scheme_make_hash_table 503 # define scheme_make_hash_table dll_scheme_make_hash_table
455 # define scheme_hash_set dll_scheme_hash_set 504 # define scheme_hash_set dll_scheme_hash_set
456 # define scheme_hash_get dll_scheme_hash_get 505 # define scheme_hash_get dll_scheme_hash_get
457 # define scheme_make_double dll_scheme_make_double 506 # define scheme_make_double dll_scheme_make_double
458 # ifdef INCLUDE_MZSCHEME_BASE 507 # define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string
459 # define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string 508 # define scheme_namespace_require dll_scheme_namespace_require
460 # define scheme_namespace_require dll_scheme_namespace_require 509 # define scheme_dynamic_wind dll_scheme_dynamic_wind
510 # ifdef MZ_PRECISE_GC
511 # define GC_malloc_one_tagged dll_GC_malloc_one_tagged
512 # define GC_register_traversers dll_GC_register_traversers
513 # endif
514 # if MZSCHEME_VERSION_MAJOR >= 400
515 # ifdef TRAMPOLINED_MZVIM_STARTUP
516 # define scheme_main_setup dll_scheme_main_setup
517 # if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
518 # define scheme_register_tls_space dll_scheme_register_tls_space
519 # endif
520 # endif
521 # define scheme_init_collection_paths dll_scheme_init_collection_paths
522 # define scheme_malloc_immobile_box dll_scheme_malloc_immobile_box
523 # define scheme_free_immobile_box dll_scheme_free_immobile_box
524 # endif
525 # if MZSCHEME_VERSION_MAJOR >= 600
526 # define scheme_embedded_load dll_scheme_embedded_load
527 # define scheme_register_embedded_load dll_scheme_register_embedded_load
528 # define scheme_set_config_path dll_scheme_set_config_path
529 # endif
530
531 # if MZSCHEME_VERSION_MAJOR >= 500
532 # if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
533 /* define as function for macro in schshread.h */
534 Thread_Local_Variables *
535 scheme_external_get_thread_local_variables(void)
536 {
537 return dll_scheme_external_get_thread_local_variables();
538 }
539 # endif
461 # endif 540 # endif
462 541
463 typedef struct 542 typedef struct
464 { 543 {
465 char *name; 544 char *name;
475 {"scheme_eof", (void **)&dll_scheme_eof}, 554 {"scheme_eof", (void **)&dll_scheme_eof},
476 {"scheme_false", (void **)&dll_scheme_false}, 555 {"scheme_false", (void **)&dll_scheme_false},
477 {"scheme_void", (void **)&dll_scheme_void}, 556 {"scheme_void", (void **)&dll_scheme_void},
478 {"scheme_null", (void **)&dll_scheme_null}, 557 {"scheme_null", (void **)&dll_scheme_null},
479 {"scheme_true", (void **)&dll_scheme_true}, 558 {"scheme_true", (void **)&dll_scheme_true},
559 #if !defined(USE_THREAD_LOCAL) && !defined(LINK_EXTENSIONS_BY_TABLE)
480 {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr}, 560 {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr},
561 #endif
481 {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr}, 562 {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr},
482 {"scheme_console_output", (void **)&dll_scheme_console_output_ptr}, 563 {"scheme_console_output", (void **)&dll_scheme_console_output_ptr},
483 {"scheme_notify_multithread", 564 {"scheme_notify_multithread",
484 (void **)&dll_scheme_notify_multithread_ptr}, 565 (void **)&dll_scheme_notify_multithread_ptr},
485 {"scheme_add_global", (void **)&dll_scheme_add_global}, 566 {"scheme_add_global", (void **)&dll_scheme_add_global},
486 {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol}, 567 {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol},
487 {"scheme_apply", (void **)&dll_scheme_apply}, 568 {"scheme_apply", (void **)&dll_scheme_apply},
488 {"scheme_basic_env", (void **)&dll_scheme_basic_env}, 569 {"scheme_basic_env", (void **)&dll_scheme_basic_env},
489 # if MZSCHEME_VERSION_MAJOR >= 299 570 # if MZSCHEME_VERSION_MAJOR >= 299
490 {"scheme_byte_string_to_char_string", (void **)&dll_scheme_byte_string_to_char_string}, 571 {"scheme_byte_string_to_char_string", (void **)&dll_scheme_byte_string_to_char_string},
572 {"scheme_make_path", (void **)&dll_scheme_make_path},
491 # endif 573 # endif
492 {"scheme_builtin_value", (void **)&dll_scheme_builtin_value}, 574 {"scheme_builtin_value", (void **)&dll_scheme_builtin_value},
493 {"scheme_check_threads", (void **)&dll_scheme_check_threads}, 575 {"scheme_check_threads", (void **)&dll_scheme_check_threads},
494 {"scheme_close_input_port", (void **)&dll_scheme_close_input_port}, 576 {"scheme_close_input_port", (void **)&dll_scheme_close_input_port},
495 {"scheme_count_lines", (void **)&dll_scheme_count_lines}, 577 {"scheme_count_lines", (void **)&dll_scheme_count_lines},
562 # endif 644 # endif
563 {"scheme_make_hash_table", (void **)&dll_scheme_make_hash_table}, 645 {"scheme_make_hash_table", (void **)&dll_scheme_make_hash_table},
564 {"scheme_hash_set", (void **)&dll_scheme_hash_set}, 646 {"scheme_hash_set", (void **)&dll_scheme_hash_set},
565 {"scheme_hash_get", (void **)&dll_scheme_hash_get}, 647 {"scheme_hash_get", (void **)&dll_scheme_hash_get},
566 {"scheme_make_double", (void **)&dll_scheme_make_double}, 648 {"scheme_make_double", (void **)&dll_scheme_make_double},
567 # ifdef INCLUDE_MZSCHEME_BASE
568 {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string}, 649 {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string},
569 {"scheme_namespace_require", (void **)&dll_scheme_namespace_require}, 650 {"scheme_namespace_require", (void **)&dll_scheme_namespace_require},
570 #endif 651 {"scheme_dynamic_wind", (void **)&dll_scheme_dynamic_wind},
652 # ifdef MZ_PRECISE_GC
653 {"GC_malloc_one_tagged", (void **)&dll_GC_malloc_one_tagged},
654 {"GC_register_traversers", (void **)&dll_GC_register_traversers},
655 # endif
656 # if MZSCHEME_VERSION_MAJOR >= 400
657 # ifdef TRAMPOLINED_MZVIM_STARTUP
658 {"scheme_main_setup", (void **)&dll_scheme_main_setup},
659 # if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || MZSCHEME_VERSION_MAJOR >= 603
660 {"scheme_register_tls_space", (void **)&dll_scheme_register_tls_space},
661 # endif
662 # endif
663 {"scheme_init_collection_paths", (void **)&dll_scheme_init_collection_paths},
664 {"scheme_malloc_immobile_box", (void **)&dll_scheme_malloc_immobile_box},
665 {"scheme_free_immobile_box", (void **)&dll_scheme_free_immobile_box},
666 # endif
667 # if MZSCHEME_VERSION_MAJOR >= 500
668 # if defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS) || defined(IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC)
669 {"scheme_external_get_thread_local_variables", (void **)&dll_scheme_external_get_thread_local_variables},
670 # endif
671 # endif
672 # if MZSCHEME_VERSION_MAJOR >= 600
673 {"scheme_embedded_load", (void **)&dll_scheme_embedded_load},
674 {"scheme_register_embedded_load", (void **)&dll_scheme_register_embedded_load},
675 {"scheme_set_config_path", (void **)&dll_scheme_set_config_path},
676 # endif
571 {NULL, NULL}}; 677 {NULL, NULL}};
572 678
573 static HINSTANCE hMzGC = 0; 679 static HINSTANCE hMzGC = 0;
574 static HINSTANCE hMzSch = 0; 680 static HINSTANCE hMzSch = 0;
575 681
685 #endif 791 #endif
686 792
687 /* need to put it here for dynamic stuff to work */ 793 /* need to put it here for dynamic stuff to work */
688 #if defined(INCLUDE_MZSCHEME_BASE) 794 #if defined(INCLUDE_MZSCHEME_BASE)
689 # include "mzscheme_base.c" 795 # include "mzscheme_base.c"
690 #elif MZSCHEME_VERSION_MAJOR >= 400
691 # error MzScheme >=4 must include mzscheme_base.c, for MinGW32 you need to define MZSCHEME_GENERATE_BASE=yes
692 #endif 796 #endif
693 797
694 /* 798 /*
695 *======================================================================== 799 *========================================================================
696 * 1. MzScheme interpreter startup 800 * 1. MzScheme interpreter startup
699 803
700 static Scheme_Type mz_buffer_type; 804 static Scheme_Type mz_buffer_type;
701 static Scheme_Type mz_window_type; 805 static Scheme_Type mz_window_type;
702 806
703 static int initialized = FALSE; 807 static int initialized = FALSE;
808 #ifdef DYNAMIC_MZSCHEME
809 static int disabled = FALSE;
810 #endif
811 static int load_base_module_failed = FALSE;
704 812
705 /* global environment */ 813 /* global environment */
706 static Scheme_Env *environment = NULL; 814 static Scheme_Env *environment = NULL;
707 /* output/error handlers */ 815 /* output/error handlers */
708 static Scheme_Object *curout = NULL; 816 static Scheme_Object *curout = NULL;
844 } 952 }
845 953
846 void 954 void
847 mzscheme_end(void) 955 mzscheme_end(void)
848 { 956 {
957 /* We can not unload the DLL. Racket's thread might be still alive. */
958 #if 0
849 #ifdef DYNAMIC_MZSCHEME 959 #ifdef DYNAMIC_MZSCHEME
850 dynamic_mzscheme_end(); 960 dynamic_mzscheme_end();
851 #endif 961 #endif
852 } 962 #endif
853 963 }
854 /* 964
855 * scheme_register_tls_space is only available on 32-bit Windows. 965 #if HAVE_TLS_SPACE
856 * See http://docs.racket-lang.org/inside/im_memoryalloc.html?q=scheme_register_tls_space 966 # if defined(_MSC_VER)
857 */
858 #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) \
859 && defined(USE_THREAD_LOCAL) && !defined(_WIN64)
860 # define HAVE_TLS_SPACE 1
861 static __declspec(thread) void *tls_space; 967 static __declspec(thread) void *tls_space;
862 #endif 968 extern intptr_t _tls_index;
863 969 # elif defined(__MINGW32__)
864 /* 970 static __thread void *tls_space;
865 * Since version 4.x precise GC requires trampolined startup. 971 extern intptr_t _tls_index;
866 * Futures and places in version 5.x need it too. 972 # else
867 */ 973 static THREAD_LOCAL void *tls_space;
868 #if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \ 974 static intptr_t _tls_index = 0;
869 || MZSCHEME_VERSION_MAJOR >= 500 && (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES))
870 # ifdef DYNAMIC_MZSCHEME
871 # error Precise GC v.4+ or Racket with futures/places do not support dynamic MzScheme
872 # endif 975 # endif
873 # define TRAMPOLINED_MZVIM_STARTUP
874 #endif 976 #endif
875 977
876 int 978 int
877 mzscheme_main(int argc, char** argv) 979 mzscheme_main(int argc, char** argv)
878 { 980 {
981 #ifdef DYNAMIC_MZSCHEME
982 /*
983 * Racket requires trampolined startup. We can not load it later.
984 * If dynamic dll loading is failed, disable it.
985 */
986 if (!mzscheme_enabled(FALSE))
987 {
988 disabled = TRUE;
989 return vim_main2(argc, argv);
990 }
991 #endif
879 #ifdef HAVE_TLS_SPACE 992 #ifdef HAVE_TLS_SPACE
880 scheme_register_tls_space(&tls_space, 0); 993 scheme_register_tls_space(&tls_space, _tls_index);
881 #endif 994 #endif
882 #ifdef TRAMPOLINED_MZVIM_STARTUP 995 #ifdef TRAMPOLINED_MZVIM_STARTUP
883 return scheme_main_setup(TRUE, mzscheme_env_main, argc, argv); 996 return scheme_main_setup(TRUE, mzscheme_env_main, argc, argv);
884 #else 997 #else
885 return mzscheme_env_main(NULL, argc, argv); 998 return mzscheme_env_main(NULL, argc, argv);
917 MZ_GC_UNREG(); 1030 MZ_GC_UNREG();
918 #endif 1031 #endif
919 return vim_main_result; 1032 return vim_main_result;
920 } 1033 }
921 1034
922 static void 1035 static Scheme_Object*
1036 load_base_module(void *data)
1037 {
1038 scheme_namespace_require(scheme_intern_symbol((char *)data));
1039 return scheme_null;
1040 }
1041
1042 static Scheme_Object *
1043 load_base_module_on_error(void *data)
1044 {
1045 load_base_module_failed = TRUE;
1046 return scheme_null;
1047 }
1048
1049 static int
923 startup_mzscheme(void) 1050 startup_mzscheme(void)
924 { 1051 {
925 #ifndef TRAMPOLINED_MZVIM_STARTUP 1052 #ifndef TRAMPOLINED_MZVIM_STARTUP
926 scheme_set_stack_base(stack_base, 1); 1053 scheme_set_stack_base(stack_base, 1);
927 #endif 1054 #endif
940 MZ_REGISTER_STATIC(vim_exn); 1067 MZ_REGISTER_STATIC(vim_exn);
941 1068
942 MZ_GC_CHECK(); 1069 MZ_GC_CHECK();
943 1070
944 #ifdef INCLUDE_MZSCHEME_BASE 1071 #ifdef INCLUDE_MZSCHEME_BASE
945 { 1072 /* invoke function from generated and included mzscheme_base.c */
946 /* 1073 declare_modules(environment);
947 * versions 4.x do not provide Scheme bindings by default 1074 #endif
948 * we need to add them explicitly 1075
949 */
950 Scheme_Object *scheme_base_symbol = NULL;
951 MZ_GC_DECL_REG(1);
952 MZ_GC_VAR_IN_REG(0, scheme_base_symbol);
953 MZ_GC_REG();
954 /* invoke function from generated and included mzscheme_base.c */
955 declare_modules(environment);
956 scheme_base_symbol = scheme_intern_symbol("scheme/base");
957 MZ_GC_CHECK();
958 scheme_namespace_require(scheme_base_symbol);
959 MZ_GC_CHECK();
960 MZ_GC_UNREG();
961 }
962 #endif
963 register_vim_exn();
964 /* use new environment to initialise exception handling */
965 init_exn_catching_apply();
966
967 /* redirect output */
968 scheme_console_output = do_output;
969 scheme_console_printf = do_printf;
970
971 #ifdef MZSCHEME_COLLECTS
972 /* setup 'current-library-collection-paths' parameter */ 1076 /* setup 'current-library-collection-paths' parameter */
973 # if MZSCHEME_VERSION_MAJOR >= 299 1077 # if MZSCHEME_VERSION_MAJOR >= 299
974 # ifdef MACOS 1078 {
975 { 1079 Scheme_Object *coll_path = NULL;
976 Scheme_Object *coll_byte_string = NULL; 1080 int mustfree = FALSE;
977 Scheme_Object *coll_char_string = NULL; 1081 char_u *s;
978 Scheme_Object *coll_path = NULL; 1082
979 1083 MZ_GC_DECL_REG(1);
980 MZ_GC_DECL_REG(3); 1084 MZ_GC_VAR_IN_REG(0, coll_path);
981 MZ_GC_VAR_IN_REG(0, coll_byte_string);
982 MZ_GC_VAR_IN_REG(1, coll_char_string);
983 MZ_GC_VAR_IN_REG(2, coll_path);
984 MZ_GC_REG(); 1085 MZ_GC_REG();
985 coll_byte_string = scheme_make_byte_string(MZSCHEME_COLLECTS); 1086 /* workaround for dynamic loading on windows */
986 MZ_GC_CHECK(); 1087 s = vim_getenv("PLTCOLLECTS", &mustfree);
987 coll_char_string = scheme_byte_string_to_char_string(coll_byte_string); 1088 if (s != NULL)
988 MZ_GC_CHECK(); 1089 {
989 coll_path = scheme_char_string_to_path(coll_char_string); 1090 coll_path = scheme_make_path(s);
990 MZ_GC_CHECK(); 1091 MZ_GC_CHECK();
991 scheme_set_collects_path(coll_path); 1092 if (mustfree)
992 MZ_GC_CHECK(); 1093 vim_free(s);
1094 }
1095 # ifdef MZSCHEME_COLLECTS
1096 if (coll_path == NULL)
1097 {
1098 coll_path = scheme_make_path(MZSCHEME_COLLECTS);
1099 MZ_GC_CHECK();
1100 }
1101 # endif
1102 if (coll_path != NULL)
1103 {
1104 scheme_set_collects_path(coll_path);
1105 MZ_GC_CHECK();
1106 }
993 MZ_GC_UNREG(); 1107 MZ_GC_UNREG();
994 } 1108 }
995 # else
996 {
997 Scheme_Object *coll_byte_string = NULL;
998 Scheme_Object *coll_char_string = NULL;
999 Scheme_Object *coll_path = NULL;
1000 Scheme_Object *coll_pair = NULL;
1001 Scheme_Config *config = NULL;
1002
1003 MZ_GC_DECL_REG(5);
1004 MZ_GC_VAR_IN_REG(0, coll_byte_string);
1005 MZ_GC_VAR_IN_REG(1, coll_char_string);
1006 MZ_GC_VAR_IN_REG(2, coll_path);
1007 MZ_GC_VAR_IN_REG(3, coll_pair);
1008 MZ_GC_VAR_IN_REG(4, config);
1009 MZ_GC_REG();
1010 coll_byte_string = scheme_make_byte_string(MZSCHEME_COLLECTS);
1011 MZ_GC_CHECK();
1012 coll_char_string = scheme_byte_string_to_char_string(coll_byte_string);
1013 MZ_GC_CHECK();
1014 coll_path = scheme_char_string_to_path(coll_char_string);
1015 MZ_GC_CHECK();
1016 coll_pair = scheme_make_pair(coll_path, scheme_null);
1017 MZ_GC_CHECK();
1018 config = scheme_current_config();
1019 MZ_GC_CHECK();
1020 scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair);
1021 MZ_GC_CHECK();
1022 MZ_GC_UNREG();
1023 }
1024 # endif
1025 # else 1109 # else
1110 # ifdef MZSCHEME_COLLECTS
1026 { 1111 {
1027 Scheme_Object *coll_string = NULL; 1112 Scheme_Object *coll_string = NULL;
1028 Scheme_Object *coll_pair = NULL; 1113 Scheme_Object *coll_pair = NULL;
1029 Scheme_Config *config = NULL; 1114 Scheme_Config *config = NULL;
1030 1115
1043 MZ_GC_CHECK(); 1128 MZ_GC_CHECK();
1044 MZ_GC_UNREG(); 1129 MZ_GC_UNREG();
1045 } 1130 }
1046 # endif 1131 # endif
1047 #endif 1132 #endif
1133
1134 # if MZSCHEME_VERSION_MAJOR >= 600
1135 {
1136 Scheme_Object *config_path = NULL;
1137 int mustfree = FALSE;
1138 char_u *s;
1139
1140 MZ_GC_DECL_REG(1);
1141 MZ_GC_VAR_IN_REG(0, config_path);
1142 MZ_GC_REG();
1143 /* workaround for dynamic loading on windows */
1144 s = vim_getenv("PLTCONFIGDIR", &mustfree);
1145 if (s != NULL)
1146 {
1147 config_path = scheme_make_path(s);
1148 MZ_GC_CHECK();
1149 if (mustfree)
1150 vim_free(s);
1151 }
1152 #ifdef MZSCHEME_CONFIGDIR
1153 if (config_path == NULL)
1154 {
1155 config_path = scheme_make_path(MZSCHEME_CONFIGDIR);
1156 MZ_GC_CHECK();
1157 }
1158 #endif
1159 if (config_path != NULL)
1160 {
1161 scheme_set_config_path(config_path);
1162 MZ_GC_CHECK();
1163 }
1164 MZ_GC_UNREG();
1165 }
1166 # endif
1167
1168 #if MZSCHEME_VERSION_MAJOR >= 400
1169 scheme_init_collection_paths(environment, scheme_null);
1170 #endif
1171
1172 /*
1173 * versions 4.x do not provide Scheme bindings by default
1174 * we need to add them explicitly
1175 */
1176 {
1177 /* use error handler to avoid abort */
1178 scheme_dynamic_wind(NULL, load_base_module, NULL,
1179 load_base_module_on_error, "racket/base");
1180 if (load_base_module_failed)
1181 {
1182 load_base_module_failed = FALSE;
1183 scheme_dynamic_wind(NULL, load_base_module, NULL,
1184 load_base_module_on_error, "scheme/base");
1185 if (load_base_module_failed)
1186 return -1;
1187 }
1188 }
1189
1190 register_vim_exn();
1191 /* use new environment to initialise exception handling */
1192 init_exn_catching_apply();
1193
1194 /* redirect output */
1195 scheme_console_output = do_output;
1196 scheme_console_printf = do_printf;
1197
1048 #ifdef HAVE_SANDBOX 1198 #ifdef HAVE_SANDBOX
1049 { 1199 {
1050 Scheme_Object *make_security_guard = NULL; 1200 Scheme_Object *make_security_guard = NULL;
1051 MZ_GC_DECL_REG(1); 1201 MZ_GC_DECL_REG(1);
1052 MZ_GC_VAR_IN_REG(0, make_security_guard); 1202 MZ_GC_VAR_IN_REG(0, make_security_guard);
1116 /* 1266 /*
1117 * setup callback to receive notifications 1267 * setup callback to receive notifications
1118 * whether thread scheduling is (or not) required 1268 * whether thread scheduling is (or not) required
1119 */ 1269 */
1120 scheme_notify_multithread = notify_multithread; 1270 scheme_notify_multithread = notify_multithread;
1271
1272 return 0;
1121 } 1273 }
1122 1274
1123 /* 1275 /*
1124 * This routine is called for each new invocation of MzScheme 1276 * This routine is called for each new invocation of MzScheme
1125 * to make sure things are properly initialized. 1277 * to make sure things are properly initialized.
1128 mzscheme_init(void) 1280 mzscheme_init(void)
1129 { 1281 {
1130 if (!initialized) 1282 if (!initialized)
1131 { 1283 {
1132 #ifdef DYNAMIC_MZSCHEME 1284 #ifdef DYNAMIC_MZSCHEME
1133 if (!mzscheme_enabled(TRUE)) 1285 if (disabled || !mzscheme_enabled(TRUE))
1134 { 1286 {
1135 EMSG(_("E815: Sorry, this command is disabled, the MzScheme libraries could not be loaded.")); 1287 EMSG(_("E815: Sorry, this command is disabled, the MzScheme libraries could not be loaded."));
1136 return -1; 1288 return -1;
1137 } 1289 }
1138 #endif 1290 #endif
1139 startup_mzscheme(); 1291 if (load_base_module_failed || startup_mzscheme())
1292 {
1293 EMSG(_("Exxx: Sorry, this command is disabled, the MzScheme's racket/base module could not be loaded."));
1294 return -1;
1295 }
1140 initialized = TRUE; 1296 initialized = TRUE;
1141 } 1297 }
1142 { 1298 {
1143 Scheme_Config *config = NULL; 1299 Scheme_Config *config = NULL;
1144 MZ_GC_DECL_REG(1); 1300 MZ_GC_DECL_REG(1);