Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]) {
if (argc == 1) {
Scheme_Object *mso;
Scheme_Place_Bi_Channel *ch;
if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type)) {
ch = (Scheme_Place_Bi_Channel *) ((Scheme_Place *) args[0])->channel;
}
else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_bi_channel_type)) {
ch = (Scheme_Place_Bi_Channel *) args[0];
}
else {
ch = NULL;
scheme_wrong_type("place-channel-recv", "place-channel", 0, argc, args);
}
{
void *msg_memory = NULL;
mso = scheme_place_async_recv((Scheme_Place_Async_Channel *) ch->recvch, &msg_memory);
return scheme_places_deserialize(mso, msg_memory);
}
}
else {
scheme_wrong_count_m("place-channel-recv", 1, 1, argc, args, 0);
}
return scheme_true;
}
static Scheme_Object *scheme_place_channel(int argc, Scheme_Object *args[]) {
if (argc == 0) {
Scheme_Place_Bi_Channel *ch;
Scheme_Object *a[2];
ch = scheme_place_bi_channel_create();
a[0] = (Scheme_Object *) ch;
a[1] = (Scheme_Object *) scheme_place_bi_peer_channel_create(ch);
return scheme_values(2, a);
}
else {
scheme_wrong_count_m("place-channel", 0, 0, argc, args, 0);
}
return scheme_true;
}
static Scheme_Object *scheme_place_wait(int argc, Scheme_Object *args[]) {
Scheme_Place *place;
place = (Scheme_Place *) args[0];
if (argc != 1) {
scheme_wrong_count_m("place-wait", 1, 1, argc, args, 0);
}
if (!SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type)) {
scheme_wrong_type("place-wait", "place", 0, argc, args);
}
# ifdef MZ_PRECISE_GC
{
Scheme_Object *rc;
mz_proc_thread *worker_thread;
Scheme_Place *waiting_place;
int *wake_fd;
proc_thread_wait_data *wd;
wd = (proc_thread_wait_data*) malloc(sizeof(proc_thread_wait_data));
wd->proc_thread = (mz_proc_thread *)place->proc_thread;
wd->waiting_place = waiting_place;
wake_fd = scheme_get_signal_handle();
wd->wake_fd = wake_fd;
wd->ready = 0;
worker_thread = mz_proc_thread_create(mz_proc_thread_wait_worker, wd);
mz_proc_thread_detach(worker_thread);
scheme_block_until(place_wait_ready, NULL, (Scheme_Object *) wd, 0);
rc = scheme_make_integer((intptr_t)wd->rc);
free(wd);
return rc;
}
# else
{
void *rcvoid;
rcvoid = mz_proc_thread_wait((mz_proc_thread *)place->proc_thread);
return scheme_make_integer((intptr_t) rcvoid);
}
# endif
}
Scheme_Object *scheme_place_recv(int argc, Scheme_Object *args[]) {
if (argc == 1) {
Scheme_Place_Bi_Channel *ch;
if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type)) {
ch = (Scheme_Place_Bi_Channel *) ((Scheme_Place *) args[0])->channel;
}
else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_bi_channel_type)) {
ch = (Scheme_Place_Bi_Channel *) args[0];
}
else {
ch = NULL;
scheme_wrong_type("place-channel-recv", "place-channel", 0, argc, args);
}
return scheme_place_async_recv((Scheme_Place_Async_Channel *) ch->recvch);
}
else {
scheme_wrong_count_m("place-channel-recv", 1, 1, argc, args, 0);
}
return scheme_true;
}
Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) {
if (argc == 2) {
Scheme_Place_Bi_Channel *ch;
if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type)) {
ch = (Scheme_Place_Bi_Channel *) ((Scheme_Place *) args[0])->channel;
}
else if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_bi_channel_type)) {
ch = (Scheme_Place_Bi_Channel *) args[0];
}
else {
ch = NULL;
scheme_wrong_type("place-channel-send", "place-channel", 0, argc, args);
}
scheme_place_async_send((Scheme_Place_Async_Channel *) ch->sendch, args[1]);
}
else {
scheme_wrong_count_m("place-channel-send", 2, 2, argc, args, 0);
}
return scheme_true;
}
Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
Scheme_Place *place;
Place_Start_Data *place_data;
mz_proc_thread *proc_thread;
Scheme_Object *collection_paths;
mzrt_sema *ready;
/* create place object */
place = MALLOC_ONE_TAGGED(Scheme_Place);
place->so.type = scheme_place_type;
mzrt_sema_create(&ready, 0);
/* pass critical info to new place */
place_data = MALLOC_ONE(Place_Start_Data);
place_data->ready = ready;
if (argc == 2) {
Scheme_Object *so;
if (!scheme_is_module_path(args[0]) && !SCHEME_PATHP(args[0])) {
scheme_wrong_type("place", "module-path or path", 0, argc, args);
}
if (!SCHEME_SYMBOLP(args[1])) {
scheme_wrong_type("place", "symbol", 1, argc, args);
}
so = scheme_places_deep_copy_to_master(args[0]);
place_data->module = so;
so = scheme_places_deep_copy_to_master(args[1]);
place_data->function = so;
place_data->ready = ready;
/* create channel */
{
Scheme_Place_Bi_Channel *channel;
channel = scheme_place_bi_channel_create();
place->channel = (Scheme_Object *) channel;
channel = scheme_place_bi_peer_channel_create(channel);
place_data->channel = (Scheme_Object *) channel;
}
}
else {
scheme_wrong_count_m("place", 2, 2, argc, args, 0);
}
collection_paths = scheme_current_library_collection_paths(0, NULL);
collection_paths = scheme_places_deep_copy_to_master(collection_paths);
place_data->current_library_collection_paths = collection_paths;
/* create new place */
proc_thread = mz_proc_thread_create(place_start_proc, place_data);
/* wait until the place has started and grabbed the value
from `place_data'; it's important that a GC doesn't happen
here until the other place is far enough. */
mzrt_sema_wait(ready);
mzrt_sema_destroy(ready);
place->proc_thread = proc_thread;
return (Scheme_Object*) place;
}
