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

Add support for creating a place with a module and a channel

Browse Source 
svn: r12794
This commit is contained in:
Kevin Tew 2008-12-12 19:34:22 +00:00
parent 1f836aea24
commit 51399481c4
1 changed files with 46 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/mzscheme/src/places.c
View File

@ -1,10 +1,17 @@
#include "schpriv.h"
/* READ ONLY SHARABLE GLOBALS */
static Scheme_Object *place_main_symbol;
#ifdef MZ_USE_PLACES
#include "mzrt.h"
mz_proc_thread *scheme_master_proc_thread;
THREAD_LOCAL mz_proc_thread *proc_thread_self;
Scheme_Object *scheme_place(int argc, Scheme_Object *args[]);
static Scheme_Object *scheme_place_wait(int argc, Scheme_Object *args[]);
static Scheme_Object *scheme_place_sleep(int argc, Scheme_Object *args[]);
@ -47,9 +54,10 @@ void scheme_init_place(Scheme_Env *env)
register_traversers();
#endif
place_main_symbol = scheme_intern_symbol("place-main");
plenv = scheme_primitive_module(scheme_intern_symbol("#%place"), env);
PLACE_PRIM_W_ARITY("place", scheme_place, 1, 1, plenv);
PLACE_PRIM_W_ARITY("place", scheme_place, 1, 2, plenv);
PLACE_PRIM_W_ARITY("place-sleep", scheme_place_sleep, 1, 1, plenv);
PLACE_PRIM_W_ARITY("place-wait", scheme_place_wait, 1, 1, plenv);
PLACE_PRIM_W_ARITY("place?", scheme_place_p, 1, 1, plenv);
@ -66,7 +74,10 @@ void scheme_init_place(Scheme_Env *env)
/* FIXME this struct probably will need to be garbage collected as stuff
* is added to it */
typedef struct Place_Start_Data {
int argc;
Scheme_Object *thunk;
Scheme_Object *module;
Scheme_Object *channel;
Scheme_Object *current_library_collection_paths;
} Place_Start_Data;
@ -98,7 +109,17 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
/* pass critical info to new place */
place_data = MALLOC_ONE(Place_Start_Data);
place_data->thunk = args[0];
place_data->argc = argc;
if (argc == 1) {
place_data->thunk = args[0];
}
else if (argc == 2 ) {
place_data->module = args[0];
place_data->channel = args[1];
}
else {
scheme_wrong_count_m("place", 1, 2, argc, args, 0);
}
collection_paths = scheme_current_library_collection_paths(0, NULL);
place_data->current_library_collection_paths = collection_paths;
@ -147,11 +168,16 @@ static void load_namespace_utf8(Scheme_Object *namespace_name) {
p->error_buf = saved_error_buf;
}
static Scheme_Object *places_deep_copy(Scheme_Object *so)
{
return so;
}
static void *place_start_proc(void *data_arg) {
void *stack_base;
Scheme_Object *thunk;
Place_Start_Data *place_data;
Scheme_Object *a[1];
Scheme_Object *a[2];
int ptid;
ptid = mz_proc_thread_self();
@ -165,17 +191,29 @@ static void *place_start_proc(void *data_arg) {
null_out_runtime_globals();
/* scheme_make_thread behaves differently if the above global vars are not null */
#ifdef MZ_PRECISE_GC
GC_construct_child_gc();
#endif
scheme_place_instance_init(stack_base);
a[0] = place_data->current_library_collection_paths;
scheme_current_library_collection_paths(1, a);
load_namespace("scheme/init");
thunk = place_data->thunk;
if (place_data->argc == 1)
{
load_namespace("scheme/init");
thunk = place_data->thunk;
scheme_apply(thunk, 0, NULL);
stack_base = NULL;
} else {
Scheme_Object *place_main;
a[0] = places_deep_copy(place_data->module);
a[1] = place_main_symbol;
place_main = scheme_dynamic_require(2, a);
scheme_apply(thunk, 0, NULL);
stack_base = NULL;
a[0] = places_deep_copy(place_data->channel);
scheme_apply(place_main, 1, a);
}
return scheme_true;
}