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 *));