From bc5d1c201171864f02efa48bb8ad7af53a346976 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Thu, 26 Aug 2010 09:06:43 -0600 Subject: [PATCH] Places: added shared-flvector and shared-byte string --- collects/racket/flonum.rkt | 2 +- collects/scribblings/places/info.rkt | 3 - collects/scribblings/reference/bytes.scrbl | 17 + .../scribblings/reference/concurrency.scrbl | 1 + collects/scribblings/reference/numbers.scrbl | 27 +- .../{places => reference}/places.scrbl | 38 +- collects/tests/racket/place-channel.rktl | 35 +- src/racket/include/scheme.h | 8 +- src/racket/src/cstartup.inc | 764 +++++++++--------- src/racket/src/number.c | 101 ++- src/racket/src/places.c | 32 +- src/racket/src/schminc.h | 4 +- src/racket/src/schpriv.h | 1 + src/racket/src/schvers.h | 4 +- src/racket/src/string.c | 16 + src/racket/src/strops.inc | 81 ++ 16 files changed, 723 insertions(+), 411 deletions(-) delete mode 100644 collects/scribblings/places/info.rkt rename collects/scribblings/{places => reference}/places.scrbl (74%) diff --git a/collects/racket/flonum.rkt b/collects/racket/flonum.rkt index cb2ad543b1..9ed879be6c 100644 --- a/collects/racket/flonum.rkt +++ b/collects/racket/flonum.rkt @@ -10,7 +10,7 @@ flvector? flvector make-flvector flvector-length flvector-ref flvector-set! flreal-part flimag-part make-flrectangular - in-flvector for/flvector for*/flvector) + in-flvector for/flvector for*/flvector shared-flvector make-shared-flvector) (define (in-flvector* flv) (let ((n (flvector-length flv))) diff --git a/collects/scribblings/places/info.rkt b/collects/scribblings/places/info.rkt deleted file mode 100644 index 62a79f4cb6..0000000000 --- a/collects/scribblings/places/info.rkt +++ /dev/null @@ -1,3 +0,0 @@ -#lang setup/infotab - -(define scribblings '(("places.scrbl" (user-doc)))) diff --git a/collects/scribblings/reference/bytes.scrbl b/collects/scribblings/reference/bytes.scrbl index 3bd8f43857..1e39b34bcf 100644 --- a/collects/scribblings/reference/bytes.scrbl +++ b/collects/scribblings/reference/bytes.scrbl @@ -171,6 +171,23 @@ string. @mz-examples[(list->bytes (list 65 112 112 108 101))]} +@defproc[(make-shared-bytes [k exact-nonnegative-integer?] [b byte? 0]) +bytes?]{ Returns a new mutable byte string of length @scheme[k] where each +position in the byte string is initialized with the byte @scheme[b]. +When @secref["places"] are enabled, the new byte string is allocated in the +@tech{shared memory space}. + +@mz-examples[(make-shared-bytes 5 65)]} + + +@defproc[(shared-bytes [b byte?] ...) bytes?]{ Returns a new mutable byte +string whose length is the number of provided @scheme[b]s, and whose +positions are initialized with the given @scheme[b]s. +When @secref["places"] are enabled, the new byte string is allocated in the +@tech{shared memory space}. + +@mz-examples[(shared-bytes 65 112 112 108 101)]} + @; ---------------------------------------- @section{Byte String Comparisons} diff --git a/collects/scribblings/reference/concurrency.scrbl b/collects/scribblings/reference/concurrency.scrbl index 52db2de0b6..e7217e6779 100644 --- a/collects/scribblings/reference/concurrency.scrbl +++ b/collects/scribblings/reference/concurrency.scrbl @@ -17,3 +17,4 @@ to improve performance. @include-section["sync.scrbl"] @include-section["thread-local.scrbl"] @include-section["futures.scrbl"] +@include-section["places.scrbl"] diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index 6509be73f3..bbeb47847d 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/collects/scribblings/reference/numbers.scrbl @@ -1062,14 +1062,18 @@ Returns @racket[#t] if @racket[v] is a @tech{flvector}, @racket[#f] otherwise.} @defproc[(flvector [x inexact-real?] ...) flvector?]{ -Creates a @tech{flvector} containing the given inexact real numbers.} +Creates a @tech{flvector} containing the given inexact real numbers. + +@mz-examples[(flvector 2.0 3.0 4.0 5.0)]} @defproc[(make-flvector [size exact-nonnegative-integer?] [x inexact-real? 0.0]) flvector?]{ Creates a @tech{flvector} with @racket[size] elements, where every -slot in the @tech{flvector} is filled with @racket[x].} +slot in the @tech{flvector} is filled with @racket[x]. + +@mz-examples[(make-flvector 4 3.0)]} @defproc[(flvector-length [vec flvector?]) exact-nonnegative-integer?]{ @@ -1108,6 +1112,25 @@ elements of @scheme[v] efficiently as in @scheme[in-list], Like @scheme[for/vector] or @scheme[for*/vector], but for @tech{flvector}s.} +@defproc[(shared-flvector [x inexact-real?] ...) flvector?]{ + +Creates a @tech{flvector} containing the given inexact real numbers. +When @secref["places"] are enabled, the new @tech{flvector} is +allocated in the @tech{shared memory space}. + +@mz-examples[(shared-flvector 2.0 3.0 4.0 5.0)]} + + +@defproc[(make-shared-flvector [size exact-nonnegative-integer?] + [x inexact-real? 0.0]) + flvector?]{ + +Creates a @tech{flvector} with @racket[size] elements, where every +slot in the @tech{flvector} is filled with @racket[x]. +When @secref["places"] are enabled, the new @tech{flvector} is +allocated in the @tech{shared memory space}. + +@mz-examples[(make-shared-flvector 4 3.0)]} @section{Fixnum Operations} diff --git a/collects/scribblings/places/places.scrbl b/collects/scribblings/reference/places.scrbl similarity index 74% rename from collects/scribblings/places/places.scrbl rename to collects/scribblings/reference/places.scrbl index c8fb1496be..0a41cc51cb 100644 --- a/collects/scribblings/places/places.scrbl +++ b/collects/scribblings/reference/places.scrbl @@ -1,6 +1,5 @@ #lang scribble/doc - -@title{@bold{Places}: Coarse-grained Parallelism} +@title[#:tag "places"]{@bold{places}: Coarse-grained Parallelism} @; ---------------------------------------------------------------------- @@ -10,7 +9,8 @@ (for-label racket racket/base racket/contract - racket/place)) + racket/place + racket/flonum)) @; ---------------------------------------------------------------------- @@ -64,7 +64,7 @@ hardware threads. Returns an immutable message received on channel @racket[ch]. } -@section[#:tag "example"]{Basic Example?} +@section[#:tag "example"]{Basic Example} This code launches two places, echos a message to them and then waits for the places to complete and return. @@ -97,15 +97,33 @@ 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. +Places communicate by passing messages on place-channels. +Only atomic values, immutable pairs, vectors, and structs can be +communicated across places channels. @section[#:tag "places-architecture"]{Architecture and Garbage Collection} -Immutable messages communicated on place-channels are first copied to a shared -garbage collector called the master. Places are allowed to garbage collect -independently of one another. The master collector, however, has to pause all -mutators before it can collect garbage. +Places enables a @deftech{shared memory space} between all places. +References from the @tech{shared memory space} back into a places memory space. +The invariant of allowing no backpointers is enforced by only allowing immutable +datastructures to be deep copied into the @tech{shared memory space}. + +However, mutation of atomic values in +the @tech{shared memory space} is permitted to improve performace of +shared-memory parallel programs. + +Special functions such as @racket[shared-flvector] and @racket[shared-bytes] allocate +vectors of mutable atomic values into the @tech{shared memory space}. + +Parallel mutation of these atomic values +can possibly lead to data races, but will not cause @exec{racket} to +crash. In practice however, parallel tasks usually write to disjoint +partitions of a shared vector. +} + +Places are allowed to garbage collect independently of one another. +The shared-memory collector, however, has to pause all +places before it can collect garbage. @section[#:tag "enabling-places"]{Enabling Places in Racket Builds} diff --git a/collects/tests/racket/place-channel.rktl b/collects/tests/racket/place-channel.rktl index 92d375ec59..0cbf86a750 100644 --- a/collects/tests/racket/place-channel.rktl +++ b/collects/tests/racket/place-channel.rktl @@ -1,5 +1,6 @@ (load-relative "loadtest.rktl") (Section 'place-channel) +(require racket/flonum) (define (splat txt fn) (call-with-output-file fn #:exists 'replace @@ -10,7 +11,7 @@ #<so.type = scheme_flvector_type; + vec->iso.so.type = scheme_flvector_type; vec->size = size; return vec; } +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) +static Scheme_Double_Vector *alloc_shared_flvector(long size) +{ + Scheme_Double_Vector *vec; + void *original_gc; + + original_gc = GC_switch_to_master_gc(); + vec = (Scheme_Double_Vector *)scheme_malloc_fail_ok(scheme_malloc_atomic_tagged, + sizeof(Scheme_Double_Vector) + + ((size - 1) * sizeof(double))); + GC_switch_back_from_master(original_gc); + + vec->iso.so.type = scheme_flvector_type; + SHARED_ALLOCATED_SET(vec); + vec->size = size; + + return vec; +} +#endif + static Scheme_Object *flvector (int argc, Scheme_Object *argv[]) { int i; @@ -3164,7 +3196,7 @@ static Scheme_Object *flvector (int argc, Scheme_Object *argv[]) } } - vec = alloc_flvector(argc); + vec = scheme_alloc_flvector(argc); for (i = 0; i < argc; i++) { vec->els[i] = SCHEME_FLOAT_VAL(argv[i]); @@ -3173,6 +3205,28 @@ static Scheme_Object *flvector (int argc, Scheme_Object *argv[]) return (Scheme_Object *)vec; } +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) +static Scheme_Object *shared_flvector (int argc, Scheme_Object *argv[]) +{ + int i; + Scheme_Double_Vector *vec; + + for (i = 0; i < argc; i++) { + if (!SCHEME_FLOATP(argv[i])) { + scheme_wrong_type("flvector", "inexact real", i, argc, argv); + return NULL; + } + } + + vec = alloc_shared_flvector(argc); + + for (i = 0; i < argc; i++) { + vec->els[i] = SCHEME_FLOAT_VAL(argv[i]); + } + + return (Scheme_Object *)vec; +} +#endif static Scheme_Object *flvector_p (int argc, Scheme_Object *argv[]) { @@ -3206,7 +3260,7 @@ static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[]) scheme_wrong_type("make-flvector", "inexact real", 1, argc, argv); } - vec = alloc_flvector(size); + vec = scheme_alloc_flvector(size); if (argc > 1) { int i; @@ -3219,6 +3273,45 @@ static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[]) return (Scheme_Object *)vec; } +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) +static Scheme_Object *make_shared_flvector (int argc, Scheme_Object *argv[]) +{ + Scheme_Double_Vector *vec; + long size; + + if (SCHEME_INTP(argv[0])) + size = SCHEME_INT_VAL(argv[0]); + else if (SCHEME_BIGNUMP(argv[0])) { + if (SCHEME_BIGPOS(argv[0])) { + scheme_raise_out_of_memory("make-flvector", NULL); + return NULL; + } else + size = -1; + } else + size = -1; + + if (size < 0) + scheme_wrong_type("make-flvector", "exact non-negative integer", 0, argc, argv); + + if (argc > 1) { + if (!SCHEME_FLOATP(argv[1])) + scheme_wrong_type("make-flvector", "inexact real", 1, argc, argv); + } + + vec = alloc_shared_flvector(size); + + if (argc > 1) { + int i; + double d = SCHEME_FLOAT_VAL(argv[1]); + for (i = 0; i < size; i++) { + vec->els[i] = d; + } + } + + return (Scheme_Object *)vec; +} +#endif + Scheme_Object *scheme_flvector_length(Scheme_Object *vec) { if (!SCHEME_FLVECTORP(vec)) diff --git a/src/racket/src/places.c b/src/racket/src/places.c index 78ad8b9366..b3ddd54280 100644 --- a/src/racket/src/places.c +++ b/src/racket/src/places.c @@ -33,7 +33,10 @@ static int scheme_place_channel_ready(Scheme_Object *so); static void scheme_place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *o); static Scheme_Object *scheme_place_async_recv(Scheme_Place_Async_Channel *ch); + +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) static Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht); +#endif # ifdef MZ_PRECISE_GC static void register_traversers(void); @@ -661,6 +664,7 @@ static Scheme_Object *scheme_place_p(int argc, Scheme_Object *args[]) } Scheme_Object *scheme_places_deep_copy(Scheme_Object *so) { +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) Scheme_Object *new_so = so; if (SCHEME_INTP(so)) { return so; @@ -682,8 +686,12 @@ Scheme_Object *scheme_places_deep_copy(Scheme_Object *so) { break; } return new_so; +#else + return so; +#endif } +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht) { Scheme_Object *new_so = so; @@ -740,7 +748,12 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1); break; case scheme_byte_string_type: - new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1); + if (SHARED_ALLOCATEDP(so)) { + new_so = so; + } + else { + new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1); + } break; case scheme_unix_path_type: new_so = scheme_make_sized_offset_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1); @@ -783,7 +796,22 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab new_so = vec; } break; + case scheme_flvector_type: + if (SHARED_ALLOCATEDP(so)) { + new_so = so; + } + else { + Scheme_Double_Vector *vec; + long i; + long size = SCHEME_FLVEC_SIZE(so); + vec = scheme_alloc_flvector(size); + for (i = 0; i < size; i++) { + SCHEME_FLVEC_ELS(vec)[i] = SCHEME_FLVEC_ELS(so)[i]; + } + new_so = (Scheme_Object *) vec; + } + break; case scheme_structure_type: { Scheme_Structure *st = (Scheme_Structure*)so; @@ -849,6 +877,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab } return new_so; } +#endif Scheme_Struct_Type *scheme_make_prefab_struct_type_in_master(Scheme_Object *base, Scheme_Object *parent, @@ -1085,6 +1114,7 @@ void force_hash_worker(Scheme_Object *so, Scheme_Hash_Table *ht) case scheme_unix_path_type: case scheme_symbol_type: case scheme_place_bi_channel_type: + case scheme_flvector_type: break; case scheme_pair_type: { diff --git a/src/racket/src/schminc.h b/src/racket/src/schminc.h index 0967b5337b..4ec80fe4bd 100644 --- a/src/racket/src/schminc.h +++ b/src/racket/src/schminc.h @@ -13,9 +13,9 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1000 +#define EXPECTED_PRIM_COUNT 1002 #define EXPECTED_UNSAFE_COUNT 69 -#define EXPECTED_FLFXNUM_COUNT 58 +#define EXPECTED_FLFXNUM_COUNT 60 #define EXPECTED_FUTURES_COUNT 5 #ifdef MZSCHEME_SOMETHING_OMITTED diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index a33281030d..3b71f0f25e 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -3441,6 +3441,7 @@ Scheme_Object *scheme_checked_byte_string_ref(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_byte_string_set(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_syntax_e(int argc, Scheme_Object **argv); Scheme_Object *scheme_vector_length(Scheme_Object *v); +Scheme_Double_Vector *scheme_alloc_flvector(long size); Scheme_Object *scheme_checked_flvector_ref(int argc, Scheme_Object **argv); Scheme_Object *scheme_checked_flvector_set(int argc, Scheme_Object **argv); Scheme_Object *scheme_flvector_length(Scheme_Object *v); diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index 93bbea30ef..7907312f44 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.0.1.3" +#define MZSCHEME_VERSION "5.0.1.4" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 1 -#define MZSCHEME_VERSION_W 3 +#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/racket/src/string.c b/src/racket/src/string.c index 8fcc72e862..b321ad7299 100644 --- a/src/racket/src/string.c +++ b/src/racket/src/string.c @@ -262,6 +262,11 @@ static Scheme_Object *string_normalize_kc (int argc, Scheme_Object *argv[]); static Scheme_Object *string_normalize_d (int argc, Scheme_Object *argv[]); static Scheme_Object *string_normalize_kd (int argc, Scheme_Object *argv[]); +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) +static Scheme_Object *make_shared_byte_string (int argc, Scheme_Object *argv[]); +static Scheme_Object *shared_byte_string (int argc, Scheme_Object *argv[]); +#endif + static Scheme_Object *make_byte_string (int argc, Scheme_Object *argv[]); static Scheme_Object *byte_string (int argc, Scheme_Object *argv[]); static Scheme_Object *byte_p (int argc, Scheme_Object *argv[]); @@ -685,6 +690,15 @@ scheme_init_string (Scheme_Env *env) "bytes", 0, -1), env); + +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + GLOBAL_PRIM_W_ARITY("make-shared-bytes", make_shared_byte_string, 1, 2, env); + GLOBAL_PRIM_W_ARITY("shared-bytes", shared_byte_string, 0, -1, env); +#else + GLOBAL_PRIM_W_ARITY("make-shared-bytes", make_byte_string, 1, 2, env); + GLOBAL_PRIM_W_ARITY("shared-bytes", byte_string, 0, -1, env); +#endif + scheme_add_global_constant("bytes-length", scheme_make_folding_prim(byte_string_length, "bytes-length", @@ -1140,7 +1154,9 @@ byte_p(int argc, Scheme_Object *argv[]) #define CHAR_STR BYTE_STR #define MAKE_CHAR(x) scheme_make_integer_value(x) #define xstrlen strlen +#define GENERATING_BYTE #include "strops.inc" +#undef GENERATING_BYTE /* comparisons */ diff --git a/src/racket/src/strops.inc b/src/racket/src/strops.inc index 1a252ae5f5..91f2700534 100644 --- a/src/racket/src/strops.inc +++ b/src/racket/src/strops.inc @@ -87,6 +87,43 @@ X(scheme_alloc, _string)(long size, Xchar fill) return str; } +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) && defined(GENERATING_BYTE) +Scheme_Object * +X(scheme_alloc_shared, _string)(long size, Xchar fill) +{ + Scheme_Object *str; + Xchar *s; + long i; + void *original_gc; + + if (size < 0) { + str = scheme_make_integer(size); + scheme_wrong_type("make-" XSTRINGSTR, "non-negative exact integer", + -1, 0, &str); + } + + original_gc = GC_switch_to_master_gc(); + str = scheme_alloc_object(); + str->type = scheme_x_string_type; + SHARED_ALLOCATED_SET(str); + + if (size < 100) + s = (Xchar *)scheme_malloc_atomic(sizeof(Xchar)*(size + 1)); + else + s = (Xchar *)scheme_malloc_fail_ok(scheme_malloc_atomic, sizeof(Xchar)*(size + 1)); + GC_switch_back_from_master(original_gc); + + for (i = size; i--; ) { + s[i] = fill; + } + s[size] = 0; + SCHEME_X_STR_VAL(str) = s; + SCHEME_X_STRTAG_VAL(str) = size; + + return str; +} +#endif + /**********************************************************************/ /* string procs */ /**********************************************************************/ @@ -139,6 +176,50 @@ X__(string) (int argc, Scheme_Object *argv[]) return str; } +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) && defined(GENERATING_BYTE) +static Scheme_Object * +X_(make_shared, string) (int argc, Scheme_Object *argv[]) +{ + long len; + Xchar fill; + Scheme_Object *str; + + len = scheme_extract_index("make-" XSTRINGSTR, 0, argc, argv, -1, 0); + + if (argc == 2) { + if (!CHARP(argv[1])) + scheme_wrong_type("make-" XSTRINGSTR, CHAR_STR, 1, argc, argv); + fill = (Xchar)CHAR_VAL(argv[1]); + } else + fill = 0; + + if (len == -1) { + scheme_raise_out_of_memory("make-" XSTRINGSTR, "making " XSTR "string of length %s", + scheme_make_provided_string(argv[0], 0, NULL)); + } + + str = X(scheme_alloc_shared, _string)(len, fill); + return str; +} + +static Scheme_Object * +X_(shared, string) (int argc, Scheme_Object *argv[]) +{ + Scheme_Object *str; + int i; + + str = X(scheme_alloc_shared, _string)(argc, 0); + + for ( i=0 ; i