diff --git a/collects/scheme/place.ss b/collects/scheme/place.ss index 4a578d48ad..10180369be 100644 --- a/collects/scheme/place.ss +++ b/collects/scheme/place.ss @@ -1,10 +1,15 @@ -(module place '#%kernel - (#%require '#%place) +#lang scheme/base +(require '#%place) - (#%provide place - place-sleep - place-wait - place-channel-send - place-channel-recv - place-channel? - place?)) +(define (place-channel-send/recv ch msg) + (place-channel-send ch msg) + (place-channel-recv ch)) + +(provide place + place-sleep + place-wait + place-channel-send + place-channel-recv + place-channel? + place? + place-channel-send/recv) diff --git a/collects/scribblings/places/places.scrbl b/collects/scribblings/places/places.scrbl index e94ca7c600..9b7d49ca75 100644 --- a/collects/scribblings/places/places.scrbl +++ b/collects/scribblings/places/places.scrbl @@ -49,6 +49,12 @@ hardware threads. Returns @scheme[#t] if @scheme[x] is a place-channel object. } +@defproc[(place-channel-send/recv [ch place-channel?] [x any/c]) void]{ + Sends an immutable message @scheme[x] on channel @scheme[ch] and then + waits for a repy message. + Returns an immutable message received on channel @scheme[ch]. +} + @section[#:tag "example"]{How Do I Keep Those Cores Busy?} This code launches two places passing 1 and 2 as the initial channels @@ -70,10 +76,19 @@ This is the code for the place-worker.ss module that each place will execute. (printf "IN PLACE ~a~n" x))) ] +@section[#:tag "place-channels"]{Place Channels} +@;@defproc[(make-place-channel) channel?]{ +@;Creates and returns a new channel. + +Place channels can be used with @scheme[place-channel-recv], or as a +@tech{synchronizable event} (see @secref["sync"]) to receive a value +through the channel. The channel can be used with @scheme[place-channel-send] +to send a value through the channel. @section[#:tag "messagepassingparallelism"]{Message Passing Parallelism} Places can only communicate by passing immutable messages on place-channels. +Only immutable pairs, vectors, and structs can be communicated across places channels. @section[#:tag "logging"]{Architecture and Garbage Collection} diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 7a42cea8d0..9d15f93356 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -634,7 +634,8 @@ static void make_kernel_env(void) #ifndef NO_REGEXP_UTILS MZTIMEIT(regexp, scheme_regexp_initialize(env)); #endif - scheme_init_parameterization(); + MZTIMEIT(params, scheme_init_parameterization()); + MZTIMEIT(places, scheme_init_places_once()); MARK_START_TIME(); diff --git a/src/mzscheme/src/places.c b/src/mzscheme/src/places.c index 0c68cc86e7..63bee669c7 100644 --- a/src/mzscheme/src/places.c +++ b/src/mzscheme/src/places.c @@ -25,6 +25,7 @@ Scheme_Object *scheme_place_async_channel_create(); Scheme_Object *scheme_place_bi_channel_create(); Scheme_Object *scheme_place_bi_peer_channel_create(Scheme_Object *orig); static void scheme_place_bi_channel_set_signal(Scheme_Object *cho); +static int scheme_place_channel_ready(Scheme_Object *so); void scheme_place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *o); Scheme_Object *scheme_place_async_recv(Scheme_Place_Async_Channel *ch); @@ -82,6 +83,13 @@ void scheme_init_place(Scheme_Env *env) } +void scheme_init_places_once() { +#ifdef MZ_USE_PLACES + scheme_add_evt(scheme_place_type, (Scheme_Ready_Fun)scheme_place_channel_ready, NULL, NULL, 1); + scheme_add_evt(scheme_place_bi_channel_type, (Scheme_Ready_Fun)scheme_place_channel_ready, NULL, NULL, 1); +#endif +} + #ifdef MZ_USE_PLACES /************************************************************************/ @@ -407,6 +415,11 @@ Scheme_Object *scheme_places_deep_copy(Scheme_Object *so) } switch (so->type) { + case scheme_true_type: + case scheme_false_type: + case scheme_null_type: + new_so = so; + break; case scheme_char_string_type: /*43*/ new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1); break; @@ -434,9 +447,6 @@ Scheme_Object *scheme_places_deep_copy(Scheme_Object *so) return pair; } break; - case scheme_null_type: - new_so = so; - break; case scheme_vector_type: { Scheme_Object *vec; @@ -754,6 +764,18 @@ static int scheme_place_async_ch_ready(Scheme_Place_Async_Channel *ch) { return ready; } +static int scheme_place_channel_ready(Scheme_Object *so) { + Scheme_Place_Bi_Channel *ch; + if (SAME_TYPE(SCHEME_TYPE(so), scheme_place_type)) { + ch = (Scheme_Place_Bi_Channel *) ((Scheme_Place *) so)->channel; + } + else { + ch = (Scheme_Place_Bi_Channel *)so; + } + + return scheme_place_async_ch_ready((Scheme_Place_Async_Channel *) ch->recvch); +} + Scheme_Object *scheme_place_async_recv(Scheme_Place_Async_Channel *ch) { Scheme_Object *msg = NULL; while(1) { diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 77b2f31336..58a7598f5d 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -248,6 +248,7 @@ void scheme_init_foreign_globals(); void scheme_init_foreign(Scheme_Env *env); #endif void scheme_init_place(Scheme_Env *env); +void scheme_init_places_once(); void scheme_init_futures(Scheme_Env *env); void scheme_init_print_buffers_places(void);