Skip to content
This repository was archived by the owner on Sep 13, 2019. It is now read-only.

Commit a4b2b13

Browse files
mflattmflatt
committed
fix namespace used by the default extension load handler
1 parent a1b0366 commit a4b2b13

File tree

7 files changed

+95
-23
lines changed

7 files changed

+95
-23
lines changed

‎pkgs/racket-doc/scribblings/reference/eval.scrbl

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -205,7 +205,12 @@ Like @racket[load], but @racket[load/cd] sets both
205205
handler}.}
206206

207207

208-
@defparam[current-load-extension proc (path? (or/c symbol? #f) . -> . any)]{
208+
@defparam[current-load-extension proc (path? (or/c #f
209+
symbol?
210+
(cons/c (or/c #f symbol?)
211+
(non-empty-listof symbol?)))
212+
. -> .
213+
any)]{
209214

210215
A @tech{parameter} that determines a @deftech{extension-load handler}, which is
211216
called by @racket[load-extension] and the default @tech{compiled-load

‎racket/src/racket/include/schthread.h

Lines changed: 2 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -284,9 +284,7 @@ typedef struct Thread_Local_Variables {
284284
void *file_path_wc_buffer_;
285285
intptr_t scheme_hash_request_count_;
286286
intptr_t scheme_hash_iteration_count_;
287-
struct Scheme_Env *initial_modules_env_;
288-
int num_initial_modules_;
289-
struct Scheme_Object **initial_modules_;
287+
struct Scheme_Bucket_Table *scheme_namespace_to_env_;
290288
int special_is_ok_;
291289
int scheme_force_port_closed_;
292290
int fd_reserved_;
@@ -319,7 +317,6 @@ typedef struct Thread_Local_Variables {
319317
int gensym_counter_;
320318
struct Scheme_Object *dummy_input_port_;
321319
struct Scheme_Object *dummy_output_port_;
322-
struct Scheme_Bucket_Table *place_local_modpath_table_;
323320
struct Scheme_Hash_Table *opened_libs_;
324321
struct mzrt_mutex *jit_lock_;
325322
struct free_list_entry *free_list_;
@@ -340,8 +337,6 @@ typedef struct Thread_Local_Variables {
340337
struct Scheme_Place *all_child_places_;
341338
struct Scheme_Place_Bi_Channel_Link *place_channel_links_;
342339
struct Scheme_Object **reusable_ifs_stack_;
343-
struct Scheme_Object *empty_self_shift_cache_;
344-
struct Scheme_Bucket_Table *scheme_module_code_cache_;
345340
struct Scheme_Object *group_member_cache_;
346341
struct Scheme_Prefix *scheme_prefix_finalize_;
347342
struct Scheme_Prefix *scheme_inc_prefix_finalize_;
@@ -660,9 +655,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
660655
#define file_path_wc_buffer XOA (scheme_get_thread_local_variables()->file_path_wc_buffer_)
661656
#define scheme_hash_request_count XOA (scheme_get_thread_local_variables()->scheme_hash_request_count_)
662657
#define scheme_hash_iteration_count XOA (scheme_get_thread_local_variables()->scheme_hash_iteration_count_)
663-
#define initial_modules_env XOA (scheme_get_thread_local_variables()->initial_modules_env_)
664-
#define num_initial_modules XOA (scheme_get_thread_local_variables()->num_initial_modules_)
665-
#define initial_modules XOA (scheme_get_thread_local_variables()->initial_modules_)
658+
#define scheme_namespace_to_env XOA (scheme_get_thread_local_variables()->scheme_namespace_to_env_)
666659
#define special_is_ok XOA (scheme_get_thread_local_variables()->special_is_ok_)
667660
#define scheme_force_port_closed XOA (scheme_get_thread_local_variables()->scheme_force_port_closed_)
668661
#define fd_reserved XOA (scheme_get_thread_local_variables()->fd_reserved_)
@@ -695,7 +688,6 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
695688
#define gensym_counter XOA (scheme_get_thread_local_variables()->gensym_counter_)
696689
#define dummy_input_port XOA (scheme_get_thread_local_variables()->dummy_input_port_)
697690
#define dummy_output_port XOA (scheme_get_thread_local_variables()->dummy_output_port_)
698-
#define place_local_modpath_table XOA (scheme_get_thread_local_variables()->place_local_modpath_table_)
699691
#define opened_libs XOA (scheme_get_thread_local_variables()->opened_libs_)
700692
#define jit_lock XOA (scheme_get_thread_local_variables()->jit_lock_)
701693
#define free_list XOA (scheme_get_thread_local_variables()->free_list_)
@@ -716,8 +708,6 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
716708
#define all_child_places XOA (scheme_get_thread_local_variables()->all_child_places_)
717709
#define place_channel_links XOA (scheme_get_thread_local_variables()->place_channel_links_)
718710
#define reusable_ifs_stack XOA (scheme_get_thread_local_variables()->reusable_ifs_stack_)
719-
#define empty_self_shift_cache XOA (scheme_get_thread_local_variables()->empty_self_shift_cache_)
720-
#define scheme_module_code_cache XOA (scheme_get_thread_local_variables()->scheme_module_code_cache_)
721711
#define group_member_cache XOA (scheme_get_thread_local_variables()->group_member_cache_)
722712
#define scheme_prefix_finalize XOA (scheme_get_thread_local_variables()->scheme_prefix_finalize_)
723713
#define scheme_inc_prefix_finalize XOA (scheme_get_thread_local_variables()->scheme_inc_prefix_finalize_)

‎racket/src/racket/src/dynext.c

Lines changed: 35 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -494,6 +494,30 @@ void scheme_register_extension_global(void *ptr, intptr_t size)
494494
GC_add_roots((char *)ptr, (char *)(((char *)ptr) + size + 1));
495495
}
496496

497+
static int submodule_spec_p(Scheme_Object *expected_module)
498+
{
499+
Scheme_Object *a;
500+
501+
if (SCHEME_PAIRP(expected_module)) {
502+
a = SCHEME_CAR(expected_module);
503+
if (!SCHEME_FALSEP(a) && !SCHEME_SYMBOLP(a))
504+
return 0;
505+
expected_module = SCHEME_CDR(expected_module);
506+
if (!SCHEME_PAIRP(expected_module))
507+
return 0;
508+
while (SCHEME_PAIRP(expected_module)) {
509+
a = SCHEME_CAR(expected_module);
510+
if (!SCHEME_SYMBOLP(a))
511+
return 0;
512+
expected_module = SCHEME_CDR(expected_module);
513+
}
514+
if (SCHEME_NULLP(expected_module))
515+
return 1;
516+
}
517+
518+
return 0;
519+
}
520+
497521
Scheme_Object *scheme_default_load_extension(int argc, Scheme_Object **argv)
498522
{
499523
char *filename;
@@ -502,8 +526,17 @@ Scheme_Object *scheme_default_load_extension(int argc, Scheme_Object **argv)
502526
if (!SCHEME_PATH_STRINGP(argv[0]))
503527
scheme_wrong_contract("default-load-extension-handler", "path-string?", 0, argc, argv);
504528
expected_module = argv[1];
505-
if (!SCHEME_FALSEP(expected_module) && !SCHEME_SYMBOLP(expected_module))
506-
scheme_wrong_contract("default-load-extension-handler", "(or/c symbol? #f)", 1, argc, argv);
529+
if (!SCHEME_FALSEP(expected_module)
530+
&& !SCHEME_SYMBOLP(expected_module)
531+
&& !submodule_spec_p(expected_module))
532+
scheme_wrong_contract("default-load-extension-handler",
533+
"(or/c symbol? #f (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))",
534+
1, argc, argv);
535+
536+
if (SCHEME_PAIRP(expected_module) && SCHEME_FALSEP(SCHEME_CAR(expected_module))) {
537+
/* caller requests quiet failure for separate loading of submodule */
538+
return scheme_void;
539+
}
507540

508541
filename = scheme_expand_string_filename(argv[0],
509542
"default-load-extension-handler",

‎racket/src/racket/src/env.c

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -137,8 +137,8 @@ Scheme_Env *scheme_restart_instance()
137137
scheme_make_thread(stack_base);
138138
scheme_init_error_escape_proc(NULL);
139139

140+
scheme_namespace_to_env = scheme_make_bucket_table(5, SCHEME_hash_weak_ptr);
140141
env = scheme_make_empty_env();
141-
scheme_set_param(scheme_current_config(), MZCONFIG_ENV, (Scheme_Object *)env);
142142

143143
scheme_init_port_config();
144144
scheme_init_port_fun_config();
@@ -519,8 +519,9 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
519519
scheme_startup_instance = scheme_make_instance(scheme_intern_symbol("startup"), scheme_false);
520520
scheme_init_startup_instance(scheme_startup_instance);
521521

522+
REGISTER_SO(scheme_namespace_to_env);
523+
scheme_namespace_to_env = scheme_make_bucket_table(5, SCHEME_hash_weak_ptr);
522524
env = scheme_make_empty_env();
523-
scheme_set_param(scheme_current_config(), MZCONFIG_ENV, (Scheme_Object *)env);
524525

525526
boot_module_resolver();
526527

‎racket/src/racket/src/eval.c

Lines changed: 38 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -195,6 +195,7 @@ THREAD_LOCAL_DECL(Scheme_Prefix *scheme_prefix_finalize);
195195
THREAD_LOCAL_DECL(Scheme_Prefix *scheme_inc_prefix_finalize);
196196
THREAD_LOCAL_DECL(Scheme_Object *is_syntax_proc);
197197
THREAD_LOCAL_DECL(Scheme_Object *expander_syntax_to_datum_proc);
198+
THREAD_LOCAL_DECL(Scheme_Bucket_Table *scheme_namespace_to_env);
198199
int scheme_get_overflow_count() { return scheme_overflow_count; }
199200

200201
/* read-only globals */
@@ -3452,6 +3453,22 @@ Scheme_Object *scheme_namespace_require(Scheme_Object *mod_path)
34523453
return scheme_apply(proc, 1, a);
34533454
}
34543455

3456+
static Scheme_Env *namespace_to_env(Scheme_Object *ns)
3457+
{
3458+
Scheme_Env *env;
3459+
3460+
env = scheme_lookup_in_table(scheme_namespace_to_env, (char *)ns);
3461+
3462+
if (!env) {
3463+
env = MALLOC_ONE_TAGGED(Scheme_Env);
3464+
env->so.type = scheme_env_type;
3465+
env->namespace = ns;
3466+
scheme_add_to_table(scheme_namespace_to_env, (char *)ns, (void *)env, 0);
3467+
}
3468+
3469+
return env;
3470+
}
3471+
34553472
Scheme_Env *scheme_make_empty_env(void)
34563473
{
34573474
Scheme_Object *proc, *ns, *inst, *a[2];
@@ -3460,9 +3477,7 @@ Scheme_Env *scheme_make_empty_env(void)
34603477
proc = scheme_get_startup_export("current-namespace");
34613478
ns = scheme_apply(proc, 0, NULL);
34623479

3463-
env = MALLOC_ONE_TAGGED(Scheme_Env);
3464-
env->so.type = scheme_env_type;
3465-
env->namespace = ns;
3480+
env = namespace_to_env(ns);
34663481

34673482
proc = scheme_get_startup_export("namespace->instance");
34683483
a[0] = ns;
@@ -3474,6 +3489,26 @@ Scheme_Env *scheme_make_empty_env(void)
34743489
return env;
34753490
}
34763491

3492+
Scheme_Env *scheme_get_current_namespace_as_env()
3493+
{
3494+
Scheme_Object *proc, *ns;
3495+
3496+
proc = scheme_get_startup_export("current-namespace");
3497+
ns = scheme_apply(proc, 0, NULL);
3498+
3499+
return namespace_to_env(ns);
3500+
}
3501+
3502+
void scheme_set_current_namespace_as_env(Scheme_Env *env)
3503+
{
3504+
Scheme_Object *proc, *a[1];
3505+
3506+
proc = scheme_get_startup_export("current-namespace");
3507+
3508+
a[0] = env->namespace;
3509+
(void)scheme_apply(proc, 1, a);
3510+
}
3511+
34773512
Scheme_Object *scheme_compile(Scheme_Object *form, Scheme_Env *env, int writeable)
34783513
{
34793514
Scheme_Object *compile_proc, *a[3];

‎racket/src/racket/src/schpriv.h

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3313,10 +3313,10 @@ void scheme_restore_prim_instance(Scheme_Startup_Env *env);
33133313
} while(0)
33143314

33153315

3316-
THREAD_LOCAL_DECL(extern Scheme_Bucket_Table *scheme_module_code_cache);
3317-
Scheme_Object *scheme_module_execute(Scheme_Object *data, Scheme_Env *genv);
3316+
THREAD_LOCAL_DECL(extern Scheme_Bucket_Table *scheme_namespace_to_env);
3317+
Scheme_Env *scheme_get_current_namespace_as_env();
3318+
void scheme_set_current_namespace_as_env(Scheme_Env *env);
33183319

3319-
void scheme_install_initial_module_set(Scheme_Env *env);
33203320
Scheme_Bucket_Table *scheme_clone_toplevel(Scheme_Bucket_Table *ht, Scheme_Env *home);
33213321

33223322
Scheme_Object *scheme_string_to_symbol_path(char *_s, intptr_t len);

‎racket/src/racket/src/thread.c

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7502,6 +7502,9 @@ Scheme_Object *scheme_get_thread_param(Scheme_Config *c, Scheme_Thread_Cell_Tabl
75027502

75037503
Scheme_Object *scheme_get_param(Scheme_Config *c, int pos)
75047504
{
7505+
if (pos == MZCONFIG_ENV)
7506+
return (Scheme_Object *)scheme_get_current_namespace_as_env();
7507+
75057508
return scheme_get_thread_param(c, scheme_current_thread->cell_values, pos);
75067509
}
75077510

@@ -7512,6 +7515,11 @@ void scheme_set_thread_param(Scheme_Config *c, Scheme_Thread_Cell_Table *cells,
75127515

75137516
void scheme_set_param(Scheme_Config *c, int pos, Scheme_Object *o)
75147517
{
7518+
if (pos == MZCONFIG_ENV) {
7519+
scheme_set_current_namespace_as_env((Scheme_Env *)o);
7520+
return;
7521+
}
7522+
75157523
scheme_thread_cell_set(find_param_cell(c, scheme_make_integer(pos), 1),
75167524
scheme_current_thread->cell_values, o);
75177525
}

0 commit comments

Comments
 (0)