suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

set configuration in executable before creating the initial environment

Browse Source 
which is needed for correct allocation with places
This commit is contained in:
Matthew Flatt 2010-06-30 15:44:27 -06:00
parent f14cfebddc
commit 3686875440
7 changed files with 96 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
src/racket/cmdline.inc
View File

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

2
src/racket/include/scheme.h
View File

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

2
src/racket/src/env.c
View File

@ -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

2
src/racket/src/eval.c
View File

@ -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;
}

14
src/racket/src/portfun.c
View File

@ -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 */
/*========================================================================*/

18
src/racket/src/string.c
View File

@ -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];

14
src/racket/src/thread.c
View File

@ -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);
}