From 3686875440d45790a4c30670e0ddfdf921250ff6 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 30 Jun 2010 15:44:27 -0600 Subject: [PATCH] set configuration in executable before creating the initial environment which is needed for correct allocation with places --- src/racket/cmdline.inc | 116 +++++++++++++++++------------------- src/racket/include/scheme.h | 2 + src/racket/src/env.c | 2 +- src/racket/src/eval.c | 2 - src/racket/src/portfun.c | 14 ++++- src/racket/src/string.c | 18 ++++-- src/racket/src/thread.c | 14 ++++- 7 files changed, 96 insertions(+), 72 deletions(-) diff --git a/src/racket/cmdline.inc b/src/racket/cmdline.inc index 24acdb9ea0..ec2eb4c0ca 100644 --- a/src/racket/cmdline.inc +++ b/src/racket/cmdline.inc @@ -530,7 +530,6 @@ static Scheme_Object *create_cmdline_args_vector(int argc, char *args[]) } if (argc) SCHEME_SET_VECTOR_IMMUTABLE(v); - scheme_set_param(scheme_current_config(), MZCONFIG_CMDLINE_ARGS, v); return v; } @@ -542,9 +541,11 @@ static int run_from_cmd_line(int argc, char *_argv[], GC_CAN_IGNORE char **argv = _argv; Scheme_Env *global_env; char *prog, *sprog = NULL; - Scheme_Object *sch_argv, - *collects_path = NULL, *collects_extra = NULL, - *addon_dir = NULL; + Scheme_Object *sch_argv; + Scheme_Object *collects_path = NULL, *collects_extra = NULL, *addon_dir = NULL; +#ifndef NO_FILE_SYSTEM_UTILS + Scheme_Object *collects_paths_l, *collects_paths_r; +#endif #ifndef DONT_PARSE_COMMAND_LINE char **evals_and_loads, *real_switch = NULL, specific_switch[2]; int *eval_kind, num_enl; @@ -1119,77 +1120,70 @@ static int run_from_cmd_line(int argc, char *_argv[], scheme_set_logging(syslog_level, stderr_level); - { #ifndef NO_FILE_SYSTEM_UTILS /* Setup path for "collects" collection directory: */ - Scheme_Object *l, *r; + if (!collects_path) + collects_path = scheme_make_path(_coldir XFORM_OK_PLUS _coldir_offset); + else + collects_path = scheme_path_to_complete_path(collects_path, NULL); + scheme_set_collects_path(collects_path); - if (!collects_path) - collects_path = scheme_make_path(_coldir XFORM_OK_PLUS _coldir_offset); - else - collects_path = scheme_path_to_complete_path(collects_path, NULL); - scheme_set_collects_path(collects_path); - - /* Make list of additional collection paths: */ - if (collects_extra) - r = reverse_path_list(collects_extra, 1); - else - r = scheme_make_null(); - - { - int len, offset; - l = scheme_make_null(); - offset = _coldir_offset; - while (1) { - len = strlen(_coldir XFORM_OK_PLUS offset); - offset += len + 1; - if (!_coldir[offset]) - break; - l = scheme_make_pair(scheme_make_path(_coldir XFORM_OK_PLUS offset), l); - } - l = reverse_path_list(l, 0); + /* Make list of additional collection paths: */ + if (collects_extra) + collects_paths_r = reverse_path_list(collects_extra, 1); + else + collects_paths_r = scheme_make_null(); + + { + int len, offset; + collects_paths_l = scheme_make_null(); + offset = _coldir_offset; + while (1) { + len = strlen(_coldir XFORM_OK_PLUS offset); + offset += len + 1; + if (!_coldir[offset]) + break; + collects_paths_l = scheme_make_pair(scheme_make_path(_coldir XFORM_OK_PLUS offset), + collects_paths_l); } -#endif - - /* Creates the main kernel environment */ - global_env = mk_basic_env(); - - sch_argv = create_cmdline_args_vector(argc, argv); - - { - Scheme_Object *ps; - scheme_set_exec_cmd(prog); - if (!sprog) - sprog = prog; - - ps = scheme_set_run_cmd(sprog); - } - -#ifndef NO_FILE_SYSTEM_UTILS - scheme_init_collection_paths_post(global_env, l, r); -#endif + collects_paths_l = reverse_path_list(collects_paths_l, 0); } +#endif + sch_argv = create_cmdline_args_vector(argc, argv); + scheme_set_command_line_arguments(sch_argv); + + scheme_set_exec_cmd(prog); + if (!sprog) + sprog = prog; + + (void)scheme_set_run_cmd(sprog); + if (no_compiled) - scheme_set_param(scheme_current_config(), MZCONFIG_USE_COMPILED_KIND, scheme_make_null()); + scheme_set_compiled_file_paths(scheme_make_null()); #ifndef NO_FILE_SYSTEM_UTILS /* Setup path for "addon" directory: */ - { -#ifdef GETENV_FUNCTION - if (!addon_dir) { - char *s; - s = getenv("PLTADDONDIR"); - if (s) { - s = scheme_expand_filename(s, -1, NULL, NULL, 0); - if (s) addon_dir = scheme_make_path(s); - } +# ifdef GETENV_FUNCTION + if (!addon_dir) { + char *s; + s = getenv("PLTADDONDIR"); + if (s) { + s = scheme_expand_filename(s, -1, NULL, NULL, 0); + if (s) addon_dir = scheme_make_path(s); } -#endif - if (addon_dir) scheme_set_addon_dir(addon_dir); } +# endif + if (addon_dir) scheme_set_addon_dir(addon_dir); #endif /* NO_FILE_SYSTEM_UTILS */ + /* Creates the main kernel environment */ + global_env = mk_basic_env(); + +#ifndef NO_FILE_SYSTEM_UTILS + scheme_init_collection_paths_post(global_env, collects_paths_l, collects_paths_r); +#endif + scheme_seal_parameters(); fa_a = (FinishArgsAtoms *)scheme_malloc_atomic(sizeof(FinishArgsAtoms)); diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index e21b84f54c..9c8f812816 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -1759,6 +1759,8 @@ MZ_EXTERN Scheme_Object *scheme_set_run_cmd(char *s); MZ_EXTERN void scheme_set_collects_path(Scheme_Object *p); MZ_EXTERN void scheme_set_original_dir(Scheme_Object *d); MZ_EXTERN void scheme_set_addon_dir(Scheme_Object *p); +MZ_EXTERN void scheme_set_command_line_arguments(Scheme_Object *vec); +MZ_EXTERN void scheme_set_compiled_file_paths(Scheme_Object *list); MZ_EXTERN void scheme_init_collection_paths(Scheme_Env *global_env, Scheme_Object *extra_dirs); MZ_EXTERN void scheme_init_collection_paths_post(Scheme_Env *global_env, Scheme_Object *extra_dirs, Scheme_Object *extra_post_dirs); diff --git a/src/racket/src/env.c b/src/racket/src/env.c index b3686df8b6..8b19992879 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -331,7 +331,7 @@ Scheme_Env *scheme_engine_instance_init() { scheme_init_true_false(); #ifdef MZ_PRECISE_GC - scheme_register_traversers(); + /* scheme_register_traversers(); --- already done in scheme_set_stack_base() */ register_traversers(); scheme_init_hash_key_procs(); #endif diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 72a2b80a6d..f19f3611d1 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -11312,8 +11312,6 @@ void scheme_init_collection_paths_post(Scheme_Env *global_env, Scheme_Object *ex a[0] = _scheme_apply(flcp, 2, a); _scheme_apply(clcp, 1, a); } - - } p->error_buf = save; } diff --git a/src/racket/src/portfun.c b/src/racket/src/portfun.c index 6f03aeca98..11834baf07 100644 --- a/src/racket/src/portfun.c +++ b/src/racket/src/portfun.c @@ -157,6 +157,8 @@ READ_ONLY Scheme_Object *scheme_write_proc; READ_ONLY Scheme_Object *scheme_display_proc; READ_ONLY Scheme_Object *scheme_print_proc; +SHARED_OK Scheme_Object *initial_compiled_file_paths; + THREAD_LOCAL_DECL(static Scheme_Object *dummy_input_port); THREAD_LOCAL_DECL(static Scheme_Object *dummy_output_port); @@ -331,7 +333,10 @@ void scheme_init_port_fun_config(void) { scheme_set_root_param(MZCONFIG_LOAD_DIRECTORY, scheme_false); scheme_set_root_param(MZCONFIG_WRITE_DIRECTORY, scheme_false); - scheme_set_root_param(MZCONFIG_USE_COMPILED_KIND, scheme_make_pair(scheme_make_path("compiled"), scheme_null)); + if (initial_compiled_file_paths) + scheme_set_root_param(MZCONFIG_USE_COMPILED_KIND, initial_compiled_file_paths); + else + scheme_set_root_param(MZCONFIG_USE_COMPILED_KIND, scheme_make_pair(scheme_make_path("compiled"), scheme_null)); scheme_set_root_param(MZCONFIG_USE_USER_PATHS, (scheme_ignore_user_paths ? scheme_false : scheme_true)); { @@ -352,6 +357,13 @@ void scheme_init_port_fun_config(void) dummy_output_port = scheme_make_null_output_port(1); } +void scheme_set_compiled_file_paths(Scheme_Object *list) +{ + if (!initial_compiled_file_paths) + REGISTER_SO(initial_compiled_file_paths); + initial_compiled_file_paths = list; +} + /*========================================================================*/ /* port records */ /*========================================================================*/ diff --git a/src/racket/src/string.c b/src/racket/src/string.c index 5d2a19bd1a..b10f44d3a6 100644 --- a/src/racket/src/string.c +++ b/src/racket/src/string.c @@ -175,7 +175,7 @@ static char *nl_langinfo(int which) reset_locale(); if (!current_locale_name) - current_locale_name_ptr ="\0\0\0\0"; + current_locale_name_ptr = "\0\0\0\0"; if ((current_locale_name[0] == 'C') && !current_locale_name[1]) @@ -3424,17 +3424,23 @@ static void reset_locale(void) Scheme_Object *v; const mzchar *name; - v = scheme_get_param(scheme_current_config(), MZCONFIG_LOCALE); + /* This function needs to work before threads are set up: */ + if (scheme_current_thread) { + v = scheme_get_param(scheme_current_config(), MZCONFIG_LOCALE); + } else { + v = scheme_make_immutable_sized_utf8_string("", 0); + } locale_on = SCHEME_TRUEP(v); if (locale_on) { name = SCHEME_CHAR_STR_VAL(v); #ifndef DONT_USE_LOCALE if ((current_locale_name != name) - && mz_char_strcmp("result-locale", - current_locale_name, scheme_char_strlen(current_locale_name), - name, SCHEME_CHAR_STRLEN_VAL(v), - 0, 1)) { + && (!current_locale_name + || mz_char_strcmp("result-locale", + current_locale_name, scheme_char_strlen(current_locale_name), + name, SCHEME_CHAR_STRLEN_VAL(v), + 0, 1))) { /* We only need CTYPE and COLLATE; two calls seem to be much faster than one call with ALL */ char *n, buf[32]; diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index eeaae7893f..3bc4124c83 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -420,6 +420,8 @@ extern BOOL WINAPI DllMain(HINSTANCE inst, ULONG reason, LPVOID reserved); unsigned long scheme_get_current_thread_stack_start(void); #endif +SHARED_OK Scheme_Object *initial_cmdline_vec; + /*========================================================================*/ /* initialization */ /*========================================================================*/ @@ -6570,6 +6572,13 @@ static Scheme_Object *parameter_procedure_eq(int argc, Scheme_Object **argv) : scheme_false); } +void scheme_set_command_line_arguments(Scheme_Object *vec) +{ + if (!initial_cmdline_vec) + REGISTER_SO(initial_cmdline_vec); + initial_cmdline_vec = vec; +} + int scheme_new_param(void) { return max_configs++; @@ -6746,7 +6755,10 @@ static void make_initial_config(Scheme_Thread *p) { Scheme_Object *zlv; - zlv = scheme_make_vector(0, NULL); + if (initial_cmdline_vec) + zlv = initial_cmdline_vec; + else + zlv = scheme_make_vector(0, NULL); init_param(cells, paramz, MZCONFIG_CMDLINE_ARGS, zlv); }