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

include `#%futures' in the set of primitive modules with inlining

Browse Source
This commit is contained in:
Matthew Flatt 2010-08-18 19:59:56 -06:00
parent 3885223cee
commit e5c2aea998
9 changed files with 934 additions and 737 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1407
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

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

@ -53,6 +53,7 @@ READ_ONLY static Scheme_Object *unshadowable_symbol;
READ_ONLY static Scheme_Env *kernel_env;
READ_ONLY static Scheme_Env *unsafe_env;
READ_ONLY static Scheme_Env *flfxnum_env;
READ_ONLY static Scheme_Env *futures_env;
#define MAX_CONST_LOCAL_POS 64
#define MAX_CONST_LOCAL_TYPES 2
@ -423,6 +424,29 @@ static void init_flfxnum(Scheme_Env *env)
#endif
}
static void init_futures(Scheme_Env *env)
{
Scheme_Module_Phase_Exports *pt;
REGISTER_SO(futures_env);
futures_env = scheme_primitive_module(scheme_intern_symbol("#%futures"), env);
scheme_init_futures(futures_env);
scheme_finish_primitive_module(futures_env);
pt = futures_env->module->me->rt;
scheme_populate_pt_ht(pt);
scheme_protect_primitive_provide(futures_env, NULL);
#if USE_COMPILED_STARTUP
if (builtin_ref_counter != (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT + EXPECTED_FLFXNUM_COUNT + EXPECTED_FUTURES_COUNT)) {
printf("Futures count %d doesn't match expected count %d\n",
builtin_ref_counter - EXPECTED_PRIM_COUNT - EXPECTED_UNSAFE_COUNT - EXPECTED_FLFXNUM_COUNT, EXPECTED_FUTURES_COUNT);
abort();
}
#endif
}
Scheme_Env *scheme_get_unsafe_env() {
return unsafe_env;
}
@ -431,6 +455,10 @@ Scheme_Env *scheme_get_flfxnum_env() {
return flfxnum_env;
}
Scheme_Env *scheme_get_futures_env() {
return futures_env;
}
static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thread) {
Scheme_Env *env;
@ -519,7 +547,7 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
#if defined(MZ_USE_PLACES)
scheme_jit_fill_threadlocal_table();
#endif
scheme_init_futures(env);
scheme_init_futures_per_place();
scheme_init_foreign(env);
@ -728,6 +756,7 @@ static void make_kernel_env(void)
init_unsafe(env);
init_flfxnum(env);
init_futures(env);
scheme_init_print_global_constants();
scheme_init_variable_references_constants();
@ -1379,13 +1408,15 @@ Scheme_Object **scheme_make_builtin_references_table(void)
scheme_misc_count += sizeof(Scheme_Object *) * (builtin_ref_counter + 1);
#endif
for (j = 0; j < 3; j++) {
for (j = 0; j < 4; j++) {
if (!j)
kenv = kernel_env;
else if (j == 1)
kenv = unsafe_env;
else
else if (j == 2)
kenv = flfxnum_env;
else
kenv = futures_env;
ht = kenv->toplevel;
@ -1412,13 +1443,15 @@ Scheme_Hash_Table *scheme_map_constants_to_globals(void)
result = scheme_make_hash_table(SCHEME_hash_ptr);
for (j = 0; j < 3; j++) {
for (j = 0; j < 4; j++) {
if (!j)
kenv = kernel_env;
else if (j == 1)
kenv = unsafe_env;
else
else if (j == 2)
kenv = flfxnum_env;
else
kenv = futures_env;
ht = kenv->toplevel;
bs = ht->buckets;
@ -1442,13 +1475,15 @@ const char *scheme_look_for_primitive(void *code)
long i;
int j;
for (j = 0; j < 3; j++) {
for (j = 0; j < 4; j++) {
if (!j)
kenv = kernel_env;
else if (j == 1)
kenv = unsafe_env;
else
else if (j == 2)
kenv = flfxnum_env;
else
kenv = futures_env;
ht = kenv->toplevel;
bs = ht->buckets;
@ -3067,7 +3102,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
if (modname && !(flags & SCHEME_RESOLVE_MODIDS)
&& (!(scheme_is_kernel_modname(modname)
|| scheme_is_unsafe_modname(modname)
|| scheme_is_flfxnum_modname(modname))
|| scheme_is_flfxnum_modname(modname)
|| scheme_is_futures_modname(modname))
|| (flags & SCHEME_REFERENCING))) {
/* Create a module variable reference, so that idx is preserved: */
return scheme_hash_module_variable(env->genv, modidx, find_id,
@ -3133,6 +3169,15 @@ Scheme_Object *scheme_extract_flfxnum(Scheme_Object *o)
return NULL;
}
Scheme_Object *scheme_extract_futures(Scheme_Object *o)
{
Scheme_Env *home = ((Scheme_Bucket_With_Home *)o)->home;
if (home && home->module && scheme_is_futures_modname(home->module->modname))
return (Scheme_Object *)((Scheme_Bucket *)o)->val;
else
return NULL;
}
int scheme_env_check_reset_any_use(Scheme_Comp_Env *frame)
{
int any_use;

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

@ -6827,6 +6827,9 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)
&& scheme_extract_flfxnum(var)) {
return scheme_extract_flfxnum(var);
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)
&& scheme_extract_futures(var)) {
return scheme_extract_futures(var);
} else if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type))
return scheme_register_toplevel_in_prefix(var, env, rec, drec,

44
src/racket/src/future.c
View File

@ -124,19 +124,20 @@ static Scheme_Object *processor_count(int argc, Scheme_Object *argv[])
return scheme_make_integer(1);
}
static Scheme_Object *current_future(int argc, Scheme_Object *argv[])
{
return scheme_false;
}
# define FUTURE_PRIM_W_ARITY(name, func, a1, a2, env) GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env)
void scheme_init_futures(Scheme_Env *env)
void scheme_init_futures(Scheme_Env *newenv)
{
Scheme_Env *newenv;
newenv = scheme_primitive_module(scheme_intern_symbol("#%futures"),
env);
FUTURE_PRIM_W_ARITY("future?", future_p, 1, 1, newenv);
FUTURE_PRIM_W_ARITY("future", future, 1, 1, newenv);
FUTURE_PRIM_W_ARITY("touch", touch, 1, 1, newenv);
FUTURE_PRIM_W_ARITY("processor-count", processor_count, 0, 0, newenv);
FUTURE_PRIM_W_ARITY("touch", touch, 1, 1, newenv);
FUTURE_PRIM_W_ARITY("current-future", current_future, 0, 0, newenv);
scheme_finish_primitive_module(newenv);
scheme_protect_primitive_provide(newenv, NULL);
@ -196,6 +197,7 @@ void scheme_init_futures_once()
static Scheme_Object *future(int argc, Scheme_Object *argv[]);
static Scheme_Object *touch(int argc, Scheme_Object *argv[]);
static Scheme_Object *processor_count(int argc, Scheme_Object *argv[]);
static Scheme_Object *current_future(int argc, Scheme_Object *argv[]);
static void futures_init(void);
static void init_future_thread(struct Scheme_Future_State *fs, int i);
@ -294,15 +296,9 @@ typedef struct future_thread_params_t {
/**********************************************************************/
/* Invoked by the runtime on startup to make primitives known */
void scheme_init_futures(Scheme_Env *env)
void scheme_init_futures(Scheme_Env *newenv)
{
Scheme_Object *v;
Scheme_Env *newenv;
futures_init();
v = scheme_intern_symbol("#%futures");
newenv = scheme_primitive_module(v, env);
scheme_add_global_constant(
"future?",
@ -341,6 +337,15 @@ void scheme_init_futures(Scheme_Env *env)
1),
newenv);
scheme_add_global_constant(
"current-future",
scheme_make_prim_w_arity(
current_future,
"current-future",
0,
0),
newenv);
scheme_finish_primitive_module(newenv);
scheme_protect_primitive_provide(newenv, NULL);
}
@ -350,6 +355,11 @@ void scheme_init_futures_once()
init_cpucount();
}
void scheme_init_futures_per_place()
{
futures_init();
}
void futures_init(void)
{
Scheme_Future_State *fs;
@ -779,6 +789,12 @@ Scheme_Object *processor_count(int argc, Scheme_Object *argv[])
return scheme_make_integer(cpucount);
}
Scheme_Object *current_future(int argc, Scheme_Object *argv[])
/* Called in runtime thread */
{
return scheme_false;
}
/* Entry point for a worker thread allocated for
executing futures. This function will never terminate
(until the process dies). */

142
src/racket/src/module.c
View File

@ -141,6 +141,7 @@ READ_ONLY static Scheme_Object *kernel_symbol;
READ_ONLY static Scheme_Object *kernel_modidx;
READ_ONLY static Scheme_Module *kernel;
READ_ONLY static Scheme_Object *flfxnum_modname;
READ_ONLY static Scheme_Object *futures_modname;
READ_ONLY static Scheme_Object *unsafe_modname;
/* global read-only phase wraps */
@ -362,6 +363,7 @@ void scheme_init_module(Scheme_Env *env)
REGISTER_SO(kernel_modidx);
REGISTER_SO(unsafe_modname);
REGISTER_SO(flfxnum_modname);
REGISTER_SO(futures_modname);
kernel_symbol = scheme_intern_symbol("#%kernel");
kernel_modname = scheme_intern_resolved_module_path(kernel_symbol);
kernel_modidx = scheme_make_modidx(scheme_make_pair(quote_symbol,
@ -371,7 +373,8 @@ void scheme_init_module(Scheme_Env *env)
(void)scheme_hash_key(kernel_modidx);
unsafe_modname = scheme_intern_resolved_module_path(scheme_intern_symbol("#%unsafe"));
flfxnum_modname = scheme_intern_resolved_module_path(scheme_intern_symbol("#%flfxnum"));
futures_modname = scheme_intern_resolved_module_path(scheme_intern_symbol("#%futures"));
REGISTER_SO(module_symbol);
REGISTER_SO(module_begin_symbol);
module_symbol = scheme_intern_symbol("module");
@ -651,6 +654,39 @@ int scheme_is_flfxnum_modname(Scheme_Object *modname)
return SAME_OBJ(modname, flfxnum_modname);
}
int scheme_is_futures_modname(Scheme_Object *modname)
{
return SAME_OBJ(modname, futures_modname);
}
Scheme_Module *get_special_module(Scheme_Object *name)
{
if (SAME_OBJ(name, kernel_modname))
return kernel;
else if (SAME_OBJ(name, unsafe_modname))
return scheme_get_unsafe_env()->module;
else if (SAME_OBJ(name, flfxnum_modname))
return scheme_get_flfxnum_env()->module;
else if (SAME_OBJ(name, futures_modname))
return scheme_get_futures_env()->module;
else
return NULL;
}
Scheme_Env *get_special_modenv(Scheme_Object *name)
{
if (SAME_OBJ(name, kernel_modname))
return scheme_get_kernel_env();
else if (SAME_OBJ(name, flfxnum_modname))
return scheme_get_flfxnum_env();
else if (SAME_OBJ(name, futures_modname))
return scheme_get_futures_env();
else if (SAME_OBJ(name, unsafe_modname))
return scheme_get_unsafe_env();
else
return NULL;
}
static int is_builtin_modname(Scheme_Object *modname)
{
return (SAME_OBJ(modname, kernel_modname)
@ -1880,7 +1916,8 @@ 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)
&& !SAME_OBJ(name, flfxnum_modname)) {
&& !SAME_OBJ(name, flfxnum_modname)
&& !SAME_OBJ(name, futures_modname)) {
if (SAME_OBJ(name, unsafe_modname))
menv2 = scheme_get_unsafe_env();
else
@ -2538,13 +2575,8 @@ void scheme_prep_namespace_rename(Scheme_Env *menv)
idx = SCHEME_CAR(l);
name = scheme_module_resolve(idx, 0);
if (SAME_OBJ(name, kernel_modname))
im = kernel;
else if (SAME_OBJ(name, unsafe_modname))
im = scheme_get_unsafe_env()->module;
else if (SAME_OBJ(name, flfxnum_modname))
im = scheme_get_flfxnum_env()->module;
else
im = get_special_module(name);
if (!im)
im = (Scheme_Module *)scheme_hash_get(menv->module_registry->loaded, name);
add_simple_require_renames(NULL, rns, NULL, im, idx, shift, NULL, 0);
@ -2639,13 +2671,8 @@ static Scheme_Module *module_to_(const char *who, int argc, Scheme_Object *argv[
name = scheme_module_resolve(scheme_make_modidx(argv[0], scheme_false, scheme_false),
(argc > 1) ? SCHEME_TRUEP(argv[1]) : 0);
if (SAME_OBJ(name, kernel_modname))
m = kernel;
else if (SAME_OBJ(name, unsafe_modname))
m = scheme_get_unsafe_env()->module;
else if (SAME_OBJ(name, flfxnum_modname))
m = scheme_get_flfxnum_env()->module;
else {
m = get_special_module(name);
if (!m) {
env = scheme_get_env(NULL);
m = (Scheme_Module *)scheme_hash_get(env->module_registry->loaded, name);
}
@ -3033,13 +3060,8 @@ static Scheme_Object *module_export_protected_p(int argc, Scheme_Object **argv)
name = argv[1];
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 if (SAME_OBJ(modname, flfxnum_modname))
mv = (Scheme_Object *)scheme_get_flfxnum_env()->module;
else
mv = (Scheme_Object *)get_special_module(modname);
if (!mv)
mv = scheme_hash_get(env->module_registry->loaded, modname);
if (!mv) {
scheme_arg_mismatch("module-provide-protected?",
@ -3328,15 +3350,10 @@ void scheme_clear_modidx_cache(void)
static Scheme_Module *module_load(Scheme_Object *name, Scheme_Env *env, const char *who)
{
if (name == kernel_modname)
return kernel;
else if (name == unsafe_modname)
return scheme_get_unsafe_env()->module;
else if (name == flfxnum_modname)
return scheme_get_flfxnum_env()->module;
else {
Scheme_Module *m;
Scheme_Module *m;
m = get_special_module(name);
if (!m) {
m = (Scheme_Module *)scheme_hash_get(env->module_registry->loaded, name);
if (!m) {
@ -3354,9 +3371,9 @@ static Scheme_Module *module_load(Scheme_Object *name, Scheme_Env *env, const ch
name, mred_note);
return NULL;
}
return m;
}
return m;
}
static void setup_accessible_table(Scheme_Module *m)
@ -3414,15 +3431,15 @@ static void setup_accessible_table(Scheme_Module *m)
Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, int rev_mod_phase)
{
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 if ((name == flfxnum_modname) && !rev_mod_phase)
return scheme_get_flfxnum_env();
else {
Scheme_Env *menv;
if (!rev_mod_phase)
menv = get_special_modenv(name);
else
menv = NULL;
if (!menv) {
Scheme_Object *chain;
Scheme_Env *menv;
chain = env->modchain;
if (rev_mod_phase && chain) {
@ -3440,9 +3457,9 @@ Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, int rev_m
if (rev_mod_phase && menv)
menv = menv->exp_env;
return menv;
}
return menv;
}
static void check_certified(Scheme_Object *stx, Scheme_Object *certs,
@ -3759,7 +3776,8 @@ int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Schem
if (SAME_OBJ(modname, kernel_modname)
|| SAME_OBJ(modname, unsafe_modname)
|| SAME_OBJ(modname, flfxnum_modname))
|| SAME_OBJ(modname, flfxnum_modname)
|| SAME_OBJ(modname, futures_modname))
return -1;
m = module_load(modname, env, NULL);
@ -3784,8 +3802,9 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Sch
name = SCHEME_STX_SYM(name);
return scheme_lookup_in_table(kenv->syntax, (char *)name);
} else if (SAME_OBJ(modname, unsafe_modname)
|| SAME_OBJ(modname, flfxnum_modname)) {
/* no unsafe or flfxnum syntax */
|| SAME_OBJ(modname, flfxnum_modname)
|| SAME_OBJ(modname, futures_modname)) {
/* no unsafe, flfxnum, or futures syntax */
return NULL;
} else {
Scheme_Env *menv;
@ -5177,13 +5196,8 @@ module_execute(Scheme_Object *data)
env = scheme_environment_from_dummy(m->dummy);
if (SAME_OBJ(m->modname, kernel_modname))
old_menv = scheme_get_kernel_env();
else if (SAME_OBJ(m->modname, flfxnum_modname))
old_menv = scheme_get_flfxnum_env();
else if (SAME_OBJ(m->modname, unsafe_modname))
old_menv = scheme_get_unsafe_env();
else
old_menv = get_special_modenv(m->modname);
if (!old_menv)
old_menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(env->modchain), m->modname);
insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
@ -5916,7 +5930,8 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
if (SAME_OBJ(m->modname, kernel_modname)
|| SAME_OBJ(m->modname, unsafe_modname)
|| SAME_OBJ(m->modname, flfxnum_modname)) {
|| SAME_OBJ(m->modname, flfxnum_modname)
|| SAME_OBJ(m->modname, futures_modname)) {
/* Too confusing. Give it a different name while compiling. */
Scheme_Object *k2;
const char *kname;
@ -5924,6 +5939,8 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
kname = "#%kernel";
else if (SAME_OBJ(m->modname, flfxnum_modname))
kname = "#%flfxnum";
else if (SAME_OBJ(m->modname, futures_modname))
kname = "#%futures";
else
kname = "#%unsafe";
k2 = scheme_intern_resolved_module_path(scheme_make_symbol(kname)); /* uninterned! */
@ -9248,13 +9265,16 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
name = scheme_module_resolve(idx, 0);
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 (SAME_OBJ(flfxnum_modname, name)) {
me = scheme_get_flfxnum_env()->module->me;
} else {
{
Scheme_Module *mod;
mod = get_special_module(name);
if (mod)
me = mod->me;
else
me = NULL;
}
if (!me) {
if (!export_registry) {
env = scheme_get_env(scheme_current_config());
export_registry = env->module_registry->exports;

5
src/racket/src/read.c
View File

@ -4828,7 +4828,10 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
break;
case CPT_REFERENCE:
l = read_compact_number(port);
RANGE_CHECK(l, < (EXPECTED_PRIM_COUNT + EXPECTED_UNSAFE_COUNT + EXPECTED_FLFXNUM_COUNT));
RANGE_CHECK(l, < (EXPECTED_PRIM_COUNT
+ EXPECTED_UNSAFE_COUNT
+ EXPECTED_FLFXNUM_COUNT
+ EXPECTED_FUTURES_COUNT));
return variable_references[l];
break;
case CPT_LOCAL:

1
src/racket/src/schminc.h
View File

@ -16,6 +16,7 @@
#define EXPECTED_PRIM_COUNT 1000
#define EXPECTED_UNSAFE_COUNT 69
#define EXPECTED_FLFXNUM_COUNT 58
#define EXPECTED_FUTURES_COUNT 5
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

4
src/racket/src/schpriv.h
View File

@ -248,6 +248,7 @@ void scheme_init_place(Scheme_Env *env);
void scheme_init_places_once();
void scheme_init_futures(Scheme_Env *env);
void scheme_init_futures_once();
void scheme_init_futures_per_place();
void scheme_init_print_buffers_places(void);
void scheme_init_string_places(void);
@ -2284,6 +2285,7 @@ int scheme_is_imported(Scheme_Object *var, Scheme_Comp_Env *env);
Scheme_Object *scheme_extract_unsafe(Scheme_Object *o);
Scheme_Object *scheme_extract_flfxnum(Scheme_Object *o);
Scheme_Object *scheme_extract_futures(Scheme_Object *o);
Scheme_Object *scheme_add_env_renames(Scheme_Object *stx, Scheme_Comp_Env *env,
Scheme_Comp_Env *upto);
@ -3055,6 +3057,7 @@ Scheme_Env *scheme_get_kernel_env();
int scheme_is_kernel_env();
Scheme_Env *scheme_get_unsafe_env();
Scheme_Env *scheme_get_flfxnum_env();
Scheme_Env *scheme_get_futures_env();
void scheme_install_initial_module_set(Scheme_Env *env);
Scheme_Bucket_Table *scheme_clone_toplevel(Scheme_Bucket_Table *ht, Scheme_Env *home);
@ -3068,6 +3071,7 @@ Scheme_Module *scheme_extract_compiled_module(Scheme_Object *o);
int scheme_is_kernel_modname(Scheme_Object *modname);
int scheme_is_unsafe_modname(Scheme_Object *modname);
int scheme_is_flfxnum_modname(Scheme_Object *modname);
int scheme_is_futures_modname(Scheme_Object *modname);
void scheme_clear_modidx_cache(void);
void scheme_clear_shift_cache(void);

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.0.1.2"
#define MZSCHEME_VERSION "5.0.1.3"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)