add partial #%linklet primitive module

The `#%linklet` module is intended to eventually provide
a simplified compiler for the core Racket language. For
now, it provides minimal hooks for bootstrapping an
expander implementation.

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]))

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};
+11,29,94,2,3,71,35,37,108,105,110,107,108,101,116,11,9,9,9,39,9,
-    EVAL_ONE_SIZED_STR((char *)expr, 531);
+0};
+    EVAL_ONE_SIZED_STR((char *)expr, 546);
   }

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

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

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

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)

racket/src/racket/src/startup.inc

@@ -1485,5 +1485,6 @@
 " '#%network"
 " '#%utils"
 "(only '#%place)"
-"(only '#%futures)))"
+"(only '#%futures)"
+"(only '#%linklet)))"
 );

racket/src/racket/src/startup.rktl

@@ -1683,5 +1683,5 @@
              '#%network
              '#%utils
              (only '#%place)
-             (only '#%futures)))
+             (only '#%futures)
-
+             (only '#%linklet)))