diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index bd12b3a0fd..3fdb8049d4 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.5.0.6") +(define version "6.5.0.7") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/racket/src/cstartup.inc b/racket/src/racket/src/cstartup.inc index 0db314ad6c..0650712d1f 100644 --- a/racket/src/racket/src/cstartup.inc +++ b/racket/src/racket/src/cstartup.inc @@ -1522,7 +1522,7 @@ SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,53,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,17,0,0,0,1,0,0,8,0,18,0, 24,0,38,0,52,0,64,0,84,0,98,0,113,0,126,0,131,0,135,0,147, -0,231,0,238,0,8,1,0,0,199,1,0,0,3,1,5,105,110,115,112,48, +0,231,0,238,0,8,1,0,0,214,1,0,0,3,1,5,105,110,115,112,48, 71,35,37,98,117,105,108,116,105,110,67,113,117,111,116,101,29,94,2,3,70, 35,37,107,101,114,110,101,108,11,29,94,2,3,70,35,37,101,120,112,111,98, 115,11,29,94,2,3,68,35,37,98,111,111,116,11,29,94,2,3,76,35,37, @@ -1539,11 +1539,12 @@ 56,9,2,2,2,2,29,11,11,11,11,11,11,11,9,9,11,11,11,33,16, 40,80,143,39,39,20,122,145,2,1,39,16,0,16,0,40,42,39,16,0,39, 16,0,39,11,11,11,16,0,16,0,16,0,39,39,40,12,11,11,16,0,16, -0,16,0,39,39,11,12,11,11,16,0,16,0,16,0,39,39,16,0,104,2, +0,16,0,39,39,11,12,11,11,16,0,16,0,16,0,39,39,16,0,105,2, 4,2,5,29,94,2,3,71,35,37,102,111,114,101,105,103,110,11,29,94,2, 3,70,35,37,117,110,115,97,102,101,11,29,94,2,3,71,35,37,102,108,102, 120,110,117,109,11,2,6,2,7,2,8,2,9,2,10,29,94,2,3,69,35, 37,112,108,97,99,101,11,29,94,2,3,71,35,37,102,117,116,117,114,101,115, -11,9,9,9,39,9,0}; - EVAL_ONE_SIZED_STR((char *)expr, 531); +11,29,94,2,3,71,35,37,108,105,110,107,108,101,116,11,9,9,9,39,9, +0}; + EVAL_ONE_SIZED_STR((char *)expr, 546); } diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index 2e0d717572..961ed4c1e5 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -571,6 +571,7 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr scheme_init_error_config(); /* BEGIN PRIMITIVE MODULES */ + scheme_init_linklet(env); #ifndef NO_TCP_SUPPORT scheme_init_network(env); #endif diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 52bc579e03..e3f5c7b663 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -944,6 +944,85 @@ static Scheme_Module *registry_get_loaded(Scheme_Env *env, Scheme_Object *name) return (Scheme_Module *)scheme_hash_get(env->module_registry->loaded, name); } +/**********************************************************************/ +/* linklets and instances */ +/**********************************************************************/ + +/* A minimal linklet API to support bootstrapping. */ + +static Scheme_Object *get_primitive_instance(int argc, Scheme_Object *argv[]); +static Scheme_Object *instance_variable_value(int argc, Scheme_Object *argv[]); +static Scheme_Object *instance_set_variable_value(int argc, Scheme_Object *argv[]); + +void scheme_init_linklet(Scheme_Env *env) +{ + Scheme_Env *newenv; + Scheme_Object *modname; + + modname = scheme_intern_symbol("#%linklet"); + newenv = scheme_primitive_module(modname, env); + + GLOBAL_PRIM_W_ARITY("get-primitive-instance", get_primitive_instance, 1, 2, newenv); + GLOBAL_PRIM_W_ARITY("instance-variable-value", instance_variable_value, 2, 2, newenv); + GLOBAL_PRIM_W_ARITY("instance-set-variable-value!", instance_set_variable_value, 3, 3, newenv); + + scheme_finish_primitive_module(newenv); + scheme_protect_primitive_provide(newenv, NULL); +} + +static Scheme_Object *get_primitive_instance(int argc, Scheme_Object *argv[]) +{ + Scheme_Env *env, *menv; + Scheme_Object *name; + + if (!SCHEME_SYMBOLP(argv[0])) + scheme_wrong_contract("get-primitive-instance", "symbol?", 0, argc, argv); + + name = scheme_intern_resolved_module_path(argv[0]); + + env = scheme_get_env(NULL); + menv = get_special_modenv(name); + if (!menv) + menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(env->modchain), name); + if (!menv && (argc > 1) && SCHEME_TRUEP(argv[1])) { + menv = scheme_primitive_module(argv[0], env); + scheme_finish_primitive_module(menv); + + start_module(menv->module, env, 0, name, 0, 1, 0, scheme_null, 0); + } + + return (menv ? (Scheme_Object *)menv : scheme_false); +} + +static Scheme_Object *instance_variable_value(int argc, Scheme_Object *argv[]) +{ + Scheme_Object *v; + + if (!SCHEME_NAMESPACEP(argv[0])) + scheme_wrong_contract("instance-variable-value", "namespace?", 0, argc, argv); + if (!SCHEME_SYMBOLP(argv[1])) + scheme_wrong_contract("instance-variable-value", "symbol?", 1, argc, argv); + + v = scheme_lookup_global(argv[1], (Scheme_Env *)argv[0]); + + return (v ? v : scheme_false); +} + +static Scheme_Object *instance_set_variable_value(int argc, Scheme_Object *argv[]) +{ + Scheme_Bucket *bucket; + + if (!SCHEME_NAMESPACEP(argv[0])) + scheme_wrong_contract("instance-set-variable-value!", "namespace?", 0, argc, argv); + if (!SCHEME_SYMBOLP(argv[1])) + scheme_wrong_contract("instance-set-variable-value!", "symbol?", 1, argc, argv); + + bucket = scheme_global_bucket(argv[1], (Scheme_Env *)argv[0]); + scheme_set_global_bucket("instance-set-variable-value!", bucket, argv[2], 1); + + return scheme_void; +} + /**********************************************************************/ /* parameters */ /**********************************************************************/ diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 91ee6122f5..a0a873023a 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -399,7 +399,8 @@ void scheme_init_futures(Scheme_Env *env); void scheme_init_futures_once(); void scheme_init_futures_per_place(); void scheme_end_futures_per_place(); - +void scheme_init_linklet(Scheme_Env *env); + void scheme_init_print_buffers_places(void); void scheme_init_string_places(void); void scheme_init_thread_places(void); diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 0442c3ce88..e779d4d29c 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.5.0.6" +#define MZSCHEME_VERSION "6.5.0.7" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 5 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 6 +#define MZSCHEME_VERSION_W 7 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 1443cf9201..3c3887de4a 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -1485,5 +1485,6 @@ " '#%network" " '#%utils" "(only '#%place)" -"(only '#%futures)))" +"(only '#%futures)" +"(only '#%linklet)))" ); diff --git a/racket/src/racket/src/startup.rktl b/racket/src/racket/src/startup.rktl index 06165a0dde..0bef72a20b 100644 --- a/racket/src/racket/src/startup.rktl +++ b/racket/src/racket/src/startup.rktl @@ -1683,5 +1683,5 @@ '#%network '#%utils (only '#%place) - (only '#%futures))) - + (only '#%futures) + (only '#%linklet)))