Mercurial > vim
comparison src/if_mzsch.c @ 3348:af4ed13ca541 v7.3.441
updated for version 7.3.441
Problem: Newer versions of MzScheme (Racket) require earlier (trampolined)
initialisation.
Solution: Call mzscheme_main() early in main(). (Sergey Khorev)
author | Bram Moolenaar <bram@vim.org> |
---|---|
date | Sun, 12 Feb 2012 01:55:55 +0100 |
parents | 5c4b2fc4f067 |
children | 3c072c1cb873 |
comparison
equal
deleted
inserted
replaced
3347:170c1352de01 | 3348:af4ed13ca541 |
---|---|
28 #include "if_mzsch.h" | 28 #include "if_mzsch.h" |
29 | 29 |
30 /* Only do the following when the feature is enabled. Needed for "make | 30 /* Only do the following when the feature is enabled. Needed for "make |
31 * depend". */ | 31 * depend". */ |
32 #if defined(FEAT_MZSCHEME) || defined(PROTO) | 32 #if defined(FEAT_MZSCHEME) || defined(PROTO) |
33 | |
34 #include <assert.h> | |
35 | 33 |
36 /* Base data structures */ | 34 /* Base data structures */ |
37 #define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type) | 35 #define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type) |
38 #define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type) | 36 #define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type) |
39 | 37 |
557 if (hMzGC && hMzSch) | 555 if (hMzGC && hMzSch) |
558 return OK; | 556 return OK; |
559 hMzSch = vimLoadLib(sch_dll); | 557 hMzSch = vimLoadLib(sch_dll); |
560 hMzGC = vimLoadLib(gc_dll); | 558 hMzGC = vimLoadLib(gc_dll); |
561 | 559 |
560 if (!hMzGC) | |
561 { | |
562 if (verbose) | |
563 EMSG2(_(e_loadlib), gc_dll); | |
564 return FAIL; | |
565 } | |
566 | |
562 if (!hMzSch) | 567 if (!hMzSch) |
563 { | 568 { |
564 if (verbose) | 569 if (verbose) |
565 EMSG2(_(e_loadlib), sch_dll); | 570 EMSG2(_(e_loadlib), sch_dll); |
566 return FAIL; | |
567 } | |
568 | |
569 if (!hMzGC) | |
570 { | |
571 if (verbose) | |
572 EMSG2(_(e_loadlib), gc_dll); | |
573 return FAIL; | 571 return FAIL; |
574 } | 572 } |
575 | 573 |
576 for (thunk = mzsch_imports; thunk->name; thunk++) | 574 for (thunk = mzsch_imports; thunk->name; thunk++) |
577 { | 575 { |
796 | 794 |
797 #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL) | 795 #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL) |
798 static __declspec(thread) void *tls_space; | 796 static __declspec(thread) void *tls_space; |
799 #endif | 797 #endif |
800 | 798 |
801 void | 799 /* |
802 mzscheme_main(void) | 800 * Since version 4.x precise GC requires trampolined startup. |
801 * Futures and places in version 5.x need it too. | |
802 */ | |
803 #if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 \ | |
804 || MZSCHEME_VERSION_MAJOR >= 500 && (defined(MZ_USE_FUTURES) || defined(MZ_USE_PLACES)) | |
805 # ifdef DYNAMIC_MZSCHEME | |
806 # error Precise GC v.4+ or Racket with futures/places do not support dynamic MzScheme | |
807 # endif | |
808 # define TRAMPOLINED_MZVIM_STARTUP | |
809 #endif | |
810 | |
811 int | |
812 mzscheme_main(int argc, char** argv) | |
803 { | 813 { |
804 #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL) | 814 #if MZSCHEME_VERSION_MAJOR >= 500 && defined(WIN32) && defined(USE_THREAD_LOCAL) |
805 scheme_register_tls_space(&tls_space, 0); | 815 scheme_register_tls_space(&tls_space, 0); |
806 #endif | 816 #endif |
807 #if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 | 817 #ifdef TRAMPOLINED_MZVIM_STARTUP |
808 /* use trampoline for precise GC in MzScheme >= 4.x */ | 818 return scheme_main_setup(TRUE, mzscheme_env_main, argc, argv); |
809 scheme_main_setup(TRUE, mzscheme_env_main, 0, NULL); | |
810 #else | 819 #else |
811 mzscheme_env_main(NULL, 0, NULL); | 820 return mzscheme_env_main(NULL, argc, argv); |
812 #endif | 821 #endif |
813 } | 822 } |
814 | 823 |
815 static int | 824 static int |
816 mzscheme_env_main(Scheme_Env *env, int argc UNUSED, char **argv UNUSED) | 825 mzscheme_env_main(Scheme_Env *env, int argc, char **argv) |
817 { | 826 { |
818 /* neither argument nor return values are used */ | 827 int vim_main_result; |
819 #ifdef MZ_PRECISE_GC | 828 #ifdef TRAMPOLINED_MZVIM_STARTUP |
820 # if MZSCHEME_VERSION_MAJOR < 400 | 829 /* Scheme has created the environment for us */ |
821 /* | 830 environment = env; |
822 * Starting from version 4.x, embedding applications must use | 831 #else |
823 * scheme_main_setup/scheme_main_stack_setup trampolines | 832 # ifdef MZ_PRECISE_GC |
824 * rather than setting stack base directly with scheme_set_stack_base | |
825 */ | |
826 Scheme_Object *dummy = NULL; | 833 Scheme_Object *dummy = NULL; |
827 MZ_GC_DECL_REG(1); | 834 MZ_GC_DECL_REG(1); |
828 MZ_GC_VAR_IN_REG(0, dummy); | 835 MZ_GC_VAR_IN_REG(0, dummy); |
829 | 836 |
830 stack_base = &__gc_var_stack__; | 837 stack_base = &__gc_var_stack__; |
831 # else | 838 # else |
832 /* environment has been created by us by Scheme */ | |
833 environment = env; | |
834 # endif | |
835 /* | |
836 * In 4.x, all activities must be performed inside trampoline | |
837 * so we are forced to initialise GC immediately | |
838 * This can be postponed in 3.x but I see no point in implementing | |
839 * a feature which will work in older versions only. | |
840 * One would better use conservative GC if he needs dynamic MzScheme | |
841 */ | |
842 mzscheme_init(); | |
843 #else | |
844 int dummy = 0; | 839 int dummy = 0; |
845 stack_base = (void *)&dummy; | 840 stack_base = (void *)&dummy; |
846 #endif | 841 # endif |
847 main_loop(FALSE, FALSE); | 842 #endif |
848 #if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR < 400 | 843 |
844 /* mzscheme_main is called as a trampoline from main. | |
845 * We trampoline into vim_main2 | |
846 * Passing argc, argv through from mzscheme_main | |
847 */ | |
848 vim_main_result = vim_main2(argc, argv); | |
849 #if !defined(TRAMPOLINED_MZVIM_STARTUP) && defined(MZ_PRECISE_GC) | |
849 /* releasing dummy */ | 850 /* releasing dummy */ |
850 MZ_GC_REG(); | 851 MZ_GC_REG(); |
851 MZ_GC_UNREG(); | 852 MZ_GC_UNREG(); |
852 #endif | 853 #endif |
853 return 0; | 854 return vim_main_result; |
854 } | 855 } |
855 | 856 |
856 static void | 857 static void |
857 startup_mzscheme(void) | 858 startup_mzscheme(void) |
858 { | 859 { |
859 #if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 | 860 #ifndef TRAMPOLINED_MZVIM_STARTUP |
860 scheme_set_stack_base(stack_base, 1); | 861 scheme_set_stack_base(stack_base, 1); |
861 #endif | 862 #endif |
862 | 863 |
863 MZ_REGISTER_STATIC(environment); | 864 MZ_REGISTER_STATIC(environment); |
864 MZ_REGISTER_STATIC(curout); | 865 MZ_REGISTER_STATIC(curout); |
866 MZ_REGISTER_STATIC(exn_catching_apply); | 867 MZ_REGISTER_STATIC(exn_catching_apply); |
867 MZ_REGISTER_STATIC(exn_p); | 868 MZ_REGISTER_STATIC(exn_p); |
868 MZ_REGISTER_STATIC(exn_message); | 869 MZ_REGISTER_STATIC(exn_message); |
869 MZ_REGISTER_STATIC(vim_exn); | 870 MZ_REGISTER_STATIC(vim_exn); |
870 | 871 |
871 #if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 | 872 #ifndef TRAMPOLINED_MZVIM_STARTUP |
872 /* in newer versions of precise GC the initial env has been created */ | 873 /* in newer versions of precise GC the initial env has been created */ |
873 environment = scheme_basic_env(); | 874 environment = scheme_basic_env(); |
874 #endif | 875 #endif |
875 MZ_GC_CHECK(); | 876 MZ_GC_CHECK(); |
876 | 877 |
3011 MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5); | 3012 MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5); |
3012 MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5); | 3013 MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5); |
3013 MZ_GC_REG(); | 3014 MZ_GC_REG(); |
3014 | 3015 |
3015 tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc); | 3016 tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc); |
3016 assert(nc <= 5); | |
3017 mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *)); | 3017 mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *)); |
3018 MZ_GC_CHECK(); | 3018 MZ_GC_CHECK(); |
3019 | 3019 |
3020 tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0); | 3020 tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0); |
3021 mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *)); | 3021 mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *)); |