diff --git a/src/configure b/src/configure index 80c7ee1e7c..6e69ace383 100755 --- a/src/configure +++ b/src/configure @@ -5788,6 +5788,7 @@ EXTRA_GMP_OBJ= # For MzScheme targets: OSX=".osx" NOT_OSX="" +CGC_X86_64="" case $OS in SunOS) @@ -5833,6 +5834,7 @@ case $OS in case `$UNAME -m` in #Required for CentOS 4.6 x86_64) + CGC_X86_64="1" if test -d /usr/X11R6/lib64 ; then X_LIBS="$X_LIBS -L/usr/X11R6/lib64" fi @@ -5933,24 +5935,26 @@ case $OS in fi # Force 32-bit build, for now - if test "${ORIG_CC}" = "" ; then - CC="${CC} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' - fi - if test "${ORIG_CPP}" = "" ; then - CPP="${CPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' - fi - if test "${ORIG_CXX}" = "" ; then - CXX="${CXX} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' - fi - if test "${ORIG_CXXCPP}" = "" ; then - CXXCPP="${CXXCPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' - fi - if test "${ORIG_CC_FOR_BUILD}" = "" ; then - CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + if test `${UNAME} -m` = "i386" ; then + if test "${ORIG_CC}" = "" ; then + CC="${CC} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' + fi + if test "${ORIG_CPP}" = "" ; then + CPP="${CPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' + fi + if test "${ORIG_CXX}" = "" ; then + CXX="${CXX} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' + fi + if test "${ORIG_CXXCPP}" = "" ; then + CXXCPP="${CXXCPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' + fi + if test "${ORIG_CC_FOR_BUILD}" = "" ; then + CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + fi fi if test "${enable_quartz}" = "yes" ; then @@ -10670,7 +10674,11 @@ fi if test "${enable_places}" = "yes" ; then PREFLAGS="$PREFLAGS -DMZ_USE_PLACES" - PLACE_CGC_FLAGS="$GC_THREADS_FLAG -DPARALLEL_MARK -DTHREAD_LOCAL_ALLOC" + if test "${CGC_X86_64}" = "1" ; then + PLACE_CGC_FLAGS="$GC_THREADS_FLAG -DTHREAD_LOCAL_ALLOC" + else + PLACE_CGC_FLAGS="$GC_THREADS_FLAG -DPARALLEL_MARK -DTHREAD_LOCAL_ALLOC" + fi LDFLAGS="$LDFLAGS -pthread" fi diff --git a/src/mzscheme/configure.ac b/src/mzscheme/configure.ac index f317d287e2..d470b122e7 100644 --- a/src/mzscheme/configure.ac +++ b/src/mzscheme/configure.ac @@ -664,24 +664,26 @@ case $OS in fi # Force 32-bit build, for now - if test "${ORIG_CC}" = "" ; then - CC="${CC} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' - fi - if test "${ORIG_CPP}" = "" ; then - CPP="${CPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' - fi - if test "${ORIG_CXX}" = "" ; then - CXX="${CXX} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' - fi - if test "${ORIG_CXXCPP}" = "" ; then - CXXCPP="${CXXCPP} -m32" - SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' - fi - if test "${ORIG_CC_FOR_BUILD}" = "" ; then - CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + if test `${UNAME} -m` = "i386" ; then + if test "${ORIG_CC}" = "" ; then + CC="${CC} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CC="'"'"${CC}"'"' + fi + if test "${ORIG_CPP}" = "" ; then + CPP="${CPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPP="'"'"${CPP}"'"' + fi + if test "${ORIG_CXX}" = "" ; then + CXX="${CXX} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CXX="'"'"${CXX}"'"' + fi + if test "${ORIG_CXXCPP}" = "" ; then + CXXCPP="${CXXCPP} -m32" + SUB_CONFIGURE_EXTRAS="${SUB_CONFIGURE_EXTRAS} CPPCXX="'"'"${CPPCXX}"'"' + fi + if test "${ORIG_CC_FOR_BUILD}" = "" ; then + CC_FOR_BUILD="${CC_FOR_BUILD} -m32" + fi fi if test "${enable_quartz}" = "yes" ; then diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index acfa08a48e..fb01fc6e83 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -397,8 +397,6 @@ static void place_instance_init_pre_kernel(void *stack_base) { static void init_unsafe(Scheme_Env *env) { - scheme_defining_primitives = 1; - REGISTER_SO(unsafe_env); unsafe_env = scheme_primitive_module(scheme_intern_symbol("#%unsafe"), env); @@ -412,8 +410,6 @@ static void init_unsafe(Scheme_Env *env) scheme_finish_primitive_module(unsafe_env); scheme_protect_primitive_provide(unsafe_env, NULL); - scheme_defining_primitives = 0; - #if USE_COMPILED_STARTUP if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT)) { printf("Unsafe count %d doesn't match expected count %d\n", @@ -466,8 +462,6 @@ static Scheme_Env *place_instance_init_post_kernel() { init_dummy_foreign(env); #endif - init_unsafe(env); - scheme_add_embedded_builtins(env); boot_module_resolver(); @@ -647,7 +641,9 @@ static void make_kernel_env(void) abort(); } #endif - + + init_unsafe(env); + scheme_defining_primitives = 0; } @@ -1293,7 +1289,7 @@ Scheme_Object **scheme_make_builtin_references_table(void) for (j = 0; j < 2; j++) { if (!j) - kenv = scheme_get_kernel_env(); + kenv = kernel_env; else kenv = unsafe_env; @@ -1324,7 +1320,7 @@ Scheme_Hash_Table *scheme_map_constants_to_globals(void) for (j = 0; j < 2; j++) { if (!j) - kenv = scheme_get_kernel_env(); + kenv = kernel_env; else kenv = unsafe_env; diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index f1c1d8e5f4..a75aabd97f 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -588,6 +588,12 @@ int scheme_is_unsafe_modname(Scheme_Object *modname) return SAME_OBJ(modname, unsafe_modname); } +static int is_builtin_modname(Scheme_Object *modname) +{ + return (SAME_OBJ(modname, kernel_modname) + || SAME_OBJ(modname, unsafe_modname)); +} + Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env) { long phase; @@ -1292,7 +1298,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[]) scheme_signal_error("internal error: module not in `checked' table"); } - if (!SAME_OBJ(name, kernel_modname)) { + if (!is_builtin_modname(name)) { LOG_ATTACH(printf("Check %d %s\n", phase, scheme_write_to_string(name, 0))); menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(from_modchain), name); @@ -1538,7 +1544,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[]) name = SCHEME_CAR(nophase_todo); nophase_todo = SCHEME_CDR(nophase_todo); - if (!SAME_OBJ(name, kernel_modname)) { + if (!is_builtin_modname(name)) { int i; menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(from_env->label_env->modchain), name); @@ -1621,7 +1627,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[]) if (ht->vals[i]) { name = ht->keys[i]; - if (!SAME_OBJ(name, kernel_modname)) { + if (!is_builtin_modname(name)) { LOG_ATTACH(printf("Copying no-phase %s\n", scheme_write_to_string(name, NULL))); @@ -1677,7 +1683,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[]) name = checked->keys[i]; just_declare = SCHEME_FALSEP(checked->vals[i]); - if (!SAME_OBJ(name, kernel_modname)) { + if (!is_builtin_modname(name)) { menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(from_modchain), name); LOG_ATTACH(printf("Copy %d %s\n", phase, scheme_write_to_string(name, 0))); @@ -1765,7 +1771,10 @@ static Scheme_Object *namespace_unprotect_module(int argc, Scheme_Object *argv[] code_insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); if (!SAME_OBJ(name, kernel_modname)) { - menv2 = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(to_modchain), name); + if (SAME_OBJ(name, unsafe_modname)) + menv2 = scheme_get_unsafe_env(); + else + menv2 = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(to_modchain), name); if (!menv2) { scheme_arg_mismatch("namespace-unprotect-module", @@ -2421,6 +2430,8 @@ void scheme_prep_namespace_rename(Scheme_Env *menv) if (SAME_OBJ(name, kernel_modname)) im = kernel; + else if (SAME_OBJ(name, unsafe_modname)) + im = scheme_get_unsafe_env()->module; else im = (Scheme_Module *)scheme_hash_get(menv->module_registry, name); @@ -2813,6 +2824,8 @@ static Scheme_Object *module_export_protected_p(int argc, Scheme_Object **argv) env = scheme_get_env(NULL); if (SAME_OBJ(modname, kernel_modname)) mv = (Scheme_Object *)kernel; + else if (SAME_OBJ(modname, unsafe_modname)) + mv = (Scheme_Object *)scheme_get_unsafe_env()->module; else mv = scheme_hash_get(env->module_registry, modname); if (!mv) { @@ -3104,6 +3117,8 @@ static Scheme_Module *module_load(Scheme_Object *name, Scheme_Env *env, const ch { if (name == kernel_modname) return kernel; + else if (name == unsafe_modname) + return scheme_get_unsafe_env()->module; else { Scheme_Module *m; @@ -3186,6 +3201,8 @@ Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, int rev_m { if ((name == kernel_modname) && !rev_mod_phase) return scheme_get_kernel_env(); + else if ((name == unsafe_modname) && !rev_mod_phase) + return scheme_get_unsafe_env(); else { Scheme_Object *chain; Scheme_Env *menv; @@ -3523,7 +3540,8 @@ int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Schem Scheme_Module *m; Scheme_Object *pos; - if (modname == kernel_modname) + if (SAME_OBJ(modname, kernel_modname) + || SAME_OBJ(modname, unsafe_modname)) return -1; m = module_load(modname, env, NULL); @@ -3542,11 +3560,14 @@ int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Schem Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name) { - if (modname == kernel_modname) { + if (SAME_OBJ(modname, kernel_modname)) { Scheme_Env *kenv; kenv = scheme_get_kernel_env(); name = SCHEME_STX_SYM(name); return scheme_lookup_in_table(kenv->syntax, (char *)name); + } else if (SAME_OBJ(modname, unsafe_modname)) { + /* no unsafe syntax */ + return NULL; } else { Scheme_Env *menv; Scheme_Object *val; @@ -4442,6 +4463,12 @@ Scheme_Object *scheme_builtin_value(const char *name) if (v) return v; + /* Try unsafe next: */ + a[0] = unsafe_modname; + v = _dynamic_require(2, a, scheme_get_env(NULL), 0, 0, 0, 0, 0, -1); + if (v) + return v; + /* Also try #%utils... */ a[0] = scheme_make_pair(quote_symbol, scheme_make_pair(scheme_intern_symbol("#%utils"), @@ -4744,6 +4771,8 @@ module_execute(Scheme_Object *data) if (SAME_OBJ(m->modname, kernel_modname)) old_menv = scheme_get_kernel_env(); + else if (SAME_OBJ(m->modname, unsafe_modname)) + old_menv = scheme_get_unsafe_env(); else old_menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(env->modchain), m->modname); @@ -5334,7 +5363,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Module *m; Scheme_Object *mbval, *orig_ii; int saw_mb, check_mb = 0; - int restore_confusing_name = 0; + Scheme_Object *restore_confusing_name = NULL; LOG_EXPAND_DECLS; if (!scheme_is_toplevel(env)) @@ -5362,12 +5391,18 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, LOG_START_EXPAND(m); - if (SAME_OBJ(m->modname, kernel_modname)) { + if (SAME_OBJ(m->modname, kernel_modname) + || SAME_OBJ(m->modname, unsafe_modname)) { /* Too confusing. Give it a different name while compiling. */ Scheme_Object *k2; - k2 = scheme_intern_resolved_module_path(scheme_make_symbol("#%kernel")); /* uninterned! */ + const char *kname; + if (SAME_OBJ(m->modname, kernel_modname)) + kname = "#%kernel"; + else + kname = "#%unsafe"; + k2 = scheme_intern_resolved_module_path(scheme_make_symbol(kname)); /* uninterned! */ + restore_confusing_name = m->modname; m->modname = k2; - restore_confusing_name = 1; } { @@ -5519,7 +5554,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, } if (restore_confusing_name) - m->modname = kernel_modname; + m->modname = restore_confusing_name; m->ii_src = NULL; @@ -8697,6 +8732,8 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info, if (SAME_OBJ(kernel_modname, name)) { me = kernel->me; + } else if (SAME_OBJ(unsafe_modname, name)) { + me = scheme_get_unsafe_env()->module->me; } else { if (!export_registry) { env = scheme_get_env(scheme_current_config());