diff --git a/collects/scribblings/inside/memory.scrbl b/collects/scribblings/inside/memory.scrbl index d96e0c89df..f224b76f83 100644 --- a/collects/scribblings/inside/memory.scrbl +++ b/collects/scribblings/inside/memory.scrbl @@ -85,7 +85,9 @@ variable must be registered with visible to the garbage collector. Registered variables need not contain a collectable pointer at all times (even with 3m, but the variable must contain some pointer, possibly uncollectable, at all -times). +times). Beware that static or global variables that are not +thread-specific (in the OS sense of ``thread'') generally do not +work with multiple @|tech-place|s. With conservative collection, no registration is needed for the global or static variables of an embedding program, unless it calls @@ -162,12 +164,14 @@ retaining such a pointer can lead to a crash. As explained in @secref["im:values+types"], the @cpp{scheme_make_type} function can be used to obtain a new tag for a new type of object. These new types are in relatively short supply for 3m; the maximum tag -is 255, and Racket itself uses nearly 200. +is 512, and Racket itself uses nearly 300. After allocating a new tag in 3m (and before creating instances of the tag), a @defterm{size procedure}, a @defterm{mark procedure}, and a @defterm{fixup procedure} must be installed for the tag using -@cppi{GC_register_traversers}. +@cppi{GC_register_traversers}. A type tag and its associated GC +procedures apply to all @|tech-place|s, even though specific allocated +objects are confined to a particular @|tech-place|. A size procedure simply takes a pointer to an object with the tag and returns its size in words (not bytes). The @cppi{gcBYTES_TO_WORDS} @@ -727,8 +731,11 @@ Frees memory allocated with @cpp{scheme_malloc_code}.} [intptr_t size])]{ Registers an extension's global variable that can contain Racket - pointers. The address of the global is given in @var{ptr}, and its - size in bytes in @var{size}.In addition to global variables, this + pointers (for the current @|tech-place|). The address of the global + is given in @var{ptr}, and its + size in bytes in @var{size}. + +In addition to global variables, this function can be used to register any permanent memory that the collector would otherwise treat as atomic. A garbage collection can occur during the registration.} diff --git a/collects/scribblings/inside/misc.scrbl b/collects/scribblings/inside/misc.scrbl index fd72bb3d86..79a9b49c79 100644 --- a/collects/scribblings/inside/misc.scrbl +++ b/collects/scribblings/inside/misc.scrbl @@ -343,7 +343,21 @@ Returns a string for the executing version of Racket.} @function[(Scheme_Object* scheme_get_place_table)]{ Returns an @racket[eq?]-based hash table that is global to the current -place.} +@|tech-place|. + +A key generated by @cpp{scheme_malloc_key} can be useful as a common +key across multiple @|tech-place|s.} + +@function[(Scheme_Object* scheme_malloc_key)]{ + +Generates an uncollectable Racket value that can be used across +places. Free the value with @cpp{scheme_free_key}.} + +@function[(void scheme_free_key [Scheme_Object* key])]{ + +Frees a key allocated with @cpp{scheme_malloc_key}. When a key is +freed, it must not be accessible from any GC-travsered reference in +any place.} @function[(void* scheme_register_process_global [const-char* key] diff --git a/collects/scribblings/inside/overview.scrbl b/collects/scribblings/inside/overview.scrbl index 934a8f7555..91f6559f7a 100644 --- a/collects/scribblings/inside/overview.scrbl +++ b/collects/scribblings/inside/overview.scrbl @@ -71,10 +71,10 @@ steps: This initialization function can install new global primitive procedures or other values into the namespace, or it can simply return a Racket value. The initialization function is called when the - extension is loaded with @racket[load-extension] (the first time); - the return value from @cpp{scheme_initialize} is used as the return - value for @racket[load-extension]. The namespace provided to - @cpp{scheme_initialize} is the current namespace when + extension is loaded with @racket[load-extension] the first time in a + given @|tech-place|; the return value from @cpp{scheme_initialize} is used + as the return value for @racket[load-extension]. The namespace + provided to @cpp{scheme_initialize} is the current namespace when @racket[load-extension] is called.} @@ -82,9 +82,9 @@ steps: arguments and return type as @cpp{scheme_initialize}. This function is called if @racket[load-extension] is called a second - time (or more times) for an extension. Like @cpp{scheme_initialize}, - the return value from this function is the return value for - @racket[load-extension].} + time (or more times) for an extension in a given @|tech-place|. Like + @cpp{scheme_initialize}, the return value from this function is the + return value for @racket[load-extension].} @item{Define the C function @cppi{scheme_module_name}, which takes @@ -165,7 +165,9 @@ so pointers to Racket objects can be kept in registers, stack variables, or structures allocated with @cppi{scheme_malloc}. However, static variables that contain pointers to collectable memory must be registered using @cppi{scheme_register_extension_global} (see -@secref["im:memoryalloc"]). +@secref["im:memoryalloc"]); even then, such static variables must be +thread-local (in the OS-thread sense) to work with multiple +@|tech-place|s (see @secref["places"]). As an example, the following C code defines an extension that returns @racket["hello world"] when it is loaded: @@ -225,7 +227,7 @@ compiled under Unix for 3m with the following three commands: @commandline{raco ctool --xform hw.c} @commandline{raco ctool --3m --cc hw.3m.c} -@commandline{raco ctool --3m --ld hw.so hw.o} +@commandline{raco ctool --3m --ld hw.so hw_3m.o} Some examples in @filepath{collects/mzscheme/examples} work with Racket 3m in this way. A few examples are manually instrumented, in @@ -612,6 +614,30 @@ and when all temporary values are put into variables. @; ---------------------------------------------------------------------- +@section[#:tag "places"]{Racket and Places} + +Each Racket @|tech-place| corresponds to a separate OS-implemented +thread. Each place has its own memory manager. Pointers to GC-managed +memory cannot be communicated from one place to another, because such +pointers in one place are invisible to the memory manager of another +place. + +When @|tech-place| support is enabled, static variables in an +extension or an embedding generally cannot hold pointers to GC-managed +memory, since the static variable may be used from multiple places. +For some OSes, a static variable can be made thread-local, in which +case it has a different address in each OS thread, and each different +address can be registered with the GC for a given place. + +The OS thread that originally calls @cpp{scheme_basic_env} is the OS +thread of the original place. When @cpp{scheme_basic_env} is called a +second time to reset the interpreter, it can be called in an OS thread +that is different from the original call to +@cpp{scheme_basic_env}. Thereafter, the new thread is the OS thread +for the original place. + +@; ---------------------------------------------------------------------- + @section{Racket and Threads} Racket implements threads for Racket programs without aid from the @@ -624,15 +650,15 @@ Racket API. In an embedding application, Racket can co-exist with additional OS-implemented threads, but the additional OS threads must not call -any @cpp{scheme_} function. Only the OS thread that originally calls -@cpp{scheme_basic_env} can call @cpp{scheme_} functions. (This -restriction is stronger than saying all calls must be serialized -across threads. Racket relies on properties of specific threads to -avoid stack overflow and garbage collection.) When -@cpp{scheme_basic_env} is called a second time to reset the -interpreter, it can be called in an OS thread that is different from -the original call to @cpp{scheme_basic_env}. Thereafter, all calls to -@cpp{scheme_} functions must originate from the new thread. +any @cpp{scheme_} function. Only the OS thread representing a +particular @|tech-place| can call @cpp{scheme_} functions. (This +restriction is stronger than saying all calls for a given place must +be serialized across threads. Racket relies on properties of specific +threads to avoid stack overflow and garbage collection.) For the +original place, only the OS thread used to call @cpp{scheme_basic_env} +can call @cpp{scheme_} functions. For any other place, only the OS +thread that is created by Racket for the place can be used to call +@cpp{scheme_} functions. See @secref["threads"] for more information about threads, including the possible effects of Racket's thread implementation on extension diff --git a/collects/scribblings/inside/utils.rkt b/collects/scribblings/inside/utils.rkt index 74cb5fd17f..d63eb7590d 100644 --- a/collects/scribblings/inside/utils.rkt +++ b/collects/scribblings/inside/utils.rkt @@ -11,6 +11,7 @@ mzc cpp cppi cppdef (rename-out [*var var]) function subfunction FormatD + tech-place (except-out (all-from-out scribble/manual) var) (for-label (all-from-out scheme/base))) @@ -160,5 +161,8 @@ (define Racket (other-manual '(lib "scribblings/reference/reference.scrbl"))) +(define tech-place + (tech #:doc '(lib "scribblings/reference/reference.scrbl") "place")) + (define (FormatD s) (litchar (string-append "%" s))) diff --git a/collects/scribblings/inside/values.scrbl b/collects/scribblings/inside/values.scrbl index a00b37d419..43f7a1f5ef 100644 --- a/collects/scribblings/inside/values.scrbl +++ b/collects/scribblings/inside/values.scrbl @@ -654,7 +654,8 @@ Creates a new weak box containing the value @var{v}.} @function[(Scheme_Type scheme_make_type [char* name])]{ -Creates a new type (not a Racket value).} +Creates a new type (not a Racket value). The type tag is valid across +all @|tech-place|s.} @function[(Scheme_Object* scheme_make_cptr [void* ptr] diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index bf2c565b9d..84b8bc0a01 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -2725,7 +2725,6 @@ void GC_gcollect(void) garbage_collect(gc, 1, 0, NULL); } -static inline int atomic_mark(void *p) { return 0; } void GC_register_traversers2(short tag, Size2_Proc size, Mark2_Proc mark, Fixup2_Proc fixup, int constant_Size, int atomic) { diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 007b1aadb5..8711025f0d 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -596,3 +596,5 @@ EXPORTS scheme_stx_extract_marks scheme_get_place_table scheme_register_process_global + scheme_malloc_key + scheme_free_key diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index eba516240e..e0128e53b8 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -612,3 +612,5 @@ EXPORTS scheme_stx_extract_marks scheme_get_place_table scheme_register_process_global + scheme_malloc_key + scheme_free_key diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 07ca3c6666..07ade7f643 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -613,3 +613,5 @@ scheme_char_strlen scheme_stx_extract_marks scheme_get_place_table scheme_register_process_global +scheme_malloc_key +scheme_free_key diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index fe920d3ce1..e3068bc7f4 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -620,3 +620,5 @@ scheme_char_strlen scheme_stx_extract_marks scheme_get_place_table scheme_register_process_global +scheme_malloc_key +scheme_free_key diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h index ab5a95909f..3ff0e48b15 100644 --- a/src/racket/include/schthread.h +++ b/src/racket/include/schthread.h @@ -321,6 +321,8 @@ typedef struct Thread_Local_Variables { struct Scheme_Bucket_Table *scheme_module_code_cache_; struct Scheme_Object *group_member_cache_; struct Scheme_Prefix *scheme_prefix_finalize_; + struct Scheme_Hash_Table *loaded_extensions_; + struct Scheme_Hash_Table *fullpath_loaded_extensions_; } Thread_Local_Variables; #if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS) @@ -647,6 +649,8 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL; #define scheme_module_code_cache XOA (scheme_get_thread_local_variables()->scheme_module_code_cache_) #define group_member_cache XOA (scheme_get_thread_local_variables()->group_member_cache_) #define scheme_prefix_finalize XOA (scheme_get_thread_local_variables()->scheme_prefix_finalize_) +#define loaded_extensions XOA (scheme_get_thread_local_variables()->loaded_extensions_) +#define fullpath_loaded_extensions XOA (scheme_get_thread_local_variables()->fullpath_loaded_extensions_) /* **************************************** */ diff --git a/src/racket/src/dynext.c b/src/racket/src/dynext.c index ac96871a15..8d4eddfb5c 100644 --- a/src/racket/src/dynext.c +++ b/src/racket/src/dynext.c @@ -105,8 +105,8 @@ Scheme_Extension_Table *scheme_extension_table; #endif #ifndef NO_DYNAMIC_LOAD -SHARED_OK static Scheme_Hash_Table *loaded_extensions; /* hash on scheme_initialize pointer */ -SHARED_OK static Scheme_Hash_Table *fullpath_loaded_extensions; /* hash on full path name */ +THREAD_LOCAL_DECL(static Scheme_Hash_Table *loaded_extensions;) /* hash on scheme_initialize pointer */ +THREAD_LOCAL_DECL(static Scheme_Hash_Table *fullpath_loaded_extensions;) /* hash on full path name */ #endif #ifdef MZ_PRECISE_GC @@ -121,13 +121,6 @@ SHARED_OK static Scheme_Hash_Table *fullpath_loaded_extensions; /* hash on full void scheme_init_dynamic_extension(Scheme_Env *env) { if (scheme_starting_up) { -#ifndef NO_DYNAMIC_LOAD - REGISTER_SO(loaded_extensions); - REGISTER_SO(fullpath_loaded_extensions); - loaded_extensions = scheme_make_hash_table(SCHEME_hash_ptr); - fullpath_loaded_extensions = scheme_make_hash_table(SCHEME_hash_string); -#endif - #ifdef LINK_EXTENSIONS_BY_TABLE REGISTER_SO(scheme_extension_table); @@ -189,9 +182,15 @@ static Scheme_Object *do_load_extension(const char *filename, ExtensionData *ed; void *handle; int comppath; -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - void *original_gc; -# endif + +#ifndef NO_DYNAMIC_LOAD + if (!loaded_extensions) { + REGISTER_SO(loaded_extensions); + REGISTER_SO(fullpath_loaded_extensions); + loaded_extensions = scheme_make_hash_table(SCHEME_hash_ptr); + fullpath_loaded_extensions = scheme_make_hash_table(SCHEME_hash_string); + } +#endif comppath = scheme_is_complete_path(filename, strlen(filename), SCHEME_PLATFORM_PATH_KIND); @@ -199,21 +198,11 @@ static Scheme_Object *do_load_extension(const char *filename, modname_f = NULL; handle = NULL; -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - original_gc = GC_switch_to_master_gc(); - scheme_start_atomic(); -# endif - if (comppath) init_f = (Init_Procedure)scheme_hash_get(fullpath_loaded_extensions, (Scheme_Object *)filename); else init_f = NULL; -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - scheme_end_atomic_no_swap(); - GC_switch_back_from_master(original_gc); -# endif - if (!init_f) { #endif @@ -354,9 +343,6 @@ static Scheme_Object *do_load_extension(const char *filename, Setup_Procedure f; char *vers; CFragConnectionID connID; -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - void *original_gc; -# endif if (get_ext_file_spec( &spec, filename ) && load_ext_file_spec( &spec, &connID ) ) { @@ -413,20 +399,8 @@ static Scheme_Object *do_load_extension(const char *filename, return NULL; #else - if (comppath) { -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - original_gc = GC_switch_to_master_gc(); - scheme_start_atomic(); - filename = scheme_strdup(filename); -# endif - - scheme_hash_set(fullpath_loaded_extensions, (Scheme_Object *)filename, mzPROC_TO_HASH_OBJ(init_f)); - -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - scheme_end_atomic_no_swap(); - GC_switch_back_from_master(original_gc); -# endif - } + if (comppath) + scheme_hash_set(fullpath_loaded_extensions, (Scheme_Object *)filename, mzPROC_TO_HASH_OBJ(init_f)); } #endif @@ -437,23 +411,12 @@ static Scheme_Object *do_load_extension(const char *filename, init_f = ed->reload_f; modname_f = ed->modname_f; } else { -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - original_gc = GC_switch_to_master_gc(); - scheme_start_atomic(); -# endif - ed = MALLOC_ONE_ATOMIC(ExtensionData); ed->handle = handle; ed->init_f = init_f; ed->reload_f = reload_f; ed->modname_f = modname_f; scheme_hash_set(loaded_extensions, mzPROC_TO_HASH_OBJ(init_f), (Scheme_Object *)ed); - -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - scheme_end_atomic_no_swap(); - GC_switch_back_from_master(original_gc); -# endif - } if (SCHEME_SYMBOLP(expected_module)) { diff --git a/src/racket/src/place.c b/src/racket/src/place.c index 118ae2d498..a6aba57061 100644 --- a/src/racket/src/place.c +++ b/src/racket/src/place.c @@ -117,8 +117,6 @@ static Scheme_Object* scheme_place_shared(int argc, Scheme_Object *args[]) { return SHARED_ALLOCATEDP(args[0]) ? scheme_true : scheme_false; } - - 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); diff --git a/src/racket/src/salloc.c b/src/racket/src/salloc.c index a94019dfdf..9f420397ed 100644 --- a/src/racket/src/salloc.c +++ b/src/racket/src/salloc.c @@ -1647,6 +1647,24 @@ uintptr_t scheme_get_deeper_address(void) return (uintptr_t)vp; } +Scheme_Object *scheme_malloc_key() +/* allocates a Scheme object that is useful as an `eq?'-based key, + that can be used from any place, and that is not GCed */ +{ + Scheme_Object *k; + + k = (Scheme_Object *)malloc(sizeof(Scheme_Small_Object)); + k->type = scheme_box_type; + SCHEME_BOX_VAL(k) = scheme_false; + + return k; +} + +void scheme_free_key(Scheme_Object *k) +{ + free(k); +} + /************************************************************************/ /* GC_dump */ /************************************************************************/ diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index fe05e3bff0..dd07709ee0 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -1152,3 +1152,6 @@ MZ_EXTERN Scheme_Object *scheme_stx_extract_marks(Scheme_Object *stx); MZ_EXTERN Scheme_Object *scheme_get_place_table(void); MZ_EXTERN void *scheme_register_process_global(const char *key, void *val); + +MZ_EXTERN Scheme_Object *scheme_malloc_key(void); +MZ_EXTERN void scheme_free_key(Scheme_Object *k); diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index 45031faf8c..6d808dcb9f 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -934,6 +934,8 @@ intptr_t (*scheme_char_strlen)(const mzchar *s); Scheme_Object *(*scheme_stx_extract_marks)(Scheme_Object *stx); Scheme_Object *(*scheme_get_place_table)(void); void *(*scheme_register_process_global)(const char *key, void *val); +Scheme_Object *(*scheme_malloc_key)(void); +void (*scheme_free_key)(Scheme_Object *k); #ifndef SCHEME_EX_INLINE } Scheme_Extension_Table; #endif diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index 3d669fbe97..bed31c6aaf 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -668,3 +668,5 @@ scheme_extension_table->scheme_stx_extract_marks = scheme_stx_extract_marks; scheme_extension_table->scheme_get_place_table = scheme_get_place_table; scheme_extension_table->scheme_register_process_global = scheme_register_process_global; + scheme_extension_table->scheme_malloc_key = scheme_malloc_key; + scheme_extension_table->scheme_free_key = scheme_free_key; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 40feea2bfb..5cb3f87440 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -668,6 +668,8 @@ #define scheme_stx_extract_marks (scheme_extension_table->scheme_stx_extract_marks) #define scheme_get_place_table (scheme_extension_table->scheme_get_place_table) #define scheme_register_process_global (scheme_extension_table->scheme_register_process_global) +#define scheme_malloc_key (scheme_extension_table->scheme_malloc_key) +#define scheme_free_key (scheme_extension_table->scheme_free_key) #ifdef MZ_PRECISE_GC #pragma GC_VARIABLE_STACK_THOUGH_TABLE #endif diff --git a/src/racket/src/type.c b/src/racket/src/type.c index 47bbfae3a0..026803da62 100644 --- a/src/racket/src/type.c +++ b/src/racket/src/type.c @@ -41,10 +41,20 @@ SHARED_OK static Scheme_Type maxtype, allocmax; SHARED_OK intptr_t scheme_type_table_count; #endif +#ifdef MZ_USE_PLACES +static mzrt_mutex *type_array_mutex; +#endif + +#define RAW_MALLOC_N(t, n) (t*)malloc(n * sizeof(t)) + static void init_type_arrays() { intptr_t n; +#ifdef MZ_USE_PLACES + mzrt_mutex_create(&type_array_mutex); +#endif + REGISTER_SO(type_names); REGISTER_SO(scheme_type_readers); REGISTER_SO(scheme_type_writers); @@ -55,8 +65,8 @@ static void init_type_arrays() maxtype = _scheme_last_type_; allocmax = maxtype + 100; - type_names = MALLOC_N(char *, allocmax); - scheme_type_readers = MALLOC_N_ATOMIC(Scheme_Type_Reader2, allocmax); + type_names = RAW_MALLOC_N(char *, allocmax); + scheme_type_readers = RAW_MALLOC_N(Scheme_Type_Reader2, allocmax); n = allocmax * sizeof(Scheme_Type_Reader); memset((char *)scheme_type_readers, 0, n); @@ -65,7 +75,7 @@ static void init_type_arrays() scheme_misc_count += (allocmax * sizeof(char *)); #endif - scheme_type_writers = MALLOC_N_ATOMIC(Scheme_Type_Writer, allocmax); + scheme_type_writers = RAW_MALLOC_N(Scheme_Type_Writer, allocmax); n = allocmax * sizeof(Scheme_Type_Writer); memset((char *)scheme_type_writers, 0, n); @@ -73,15 +83,15 @@ static void init_type_arrays() scheme_type_table_count += n; #endif - scheme_type_equals = MALLOC_N_ATOMIC(Scheme_Equal_Proc, allocmax); + scheme_type_equals = RAW_MALLOC_N(Scheme_Equal_Proc, allocmax); n = allocmax * sizeof(Scheme_Equal_Proc); memset((char *)scheme_type_equals, 0, n); - scheme_type_hash1s = MALLOC_N_ATOMIC(Scheme_Primary_Hash_Proc, allocmax); + scheme_type_hash1s = RAW_MALLOC_N(Scheme_Primary_Hash_Proc, allocmax); n = allocmax * sizeof(Scheme_Primary_Hash_Proc); memset((char *)scheme_type_hash1s, 0, n); - scheme_type_hash2s = MALLOC_N_ATOMIC(Scheme_Secondary_Hash_Proc, allocmax); + scheme_type_hash2s = RAW_MALLOC_N(Scheme_Secondary_Hash_Proc, allocmax); n = allocmax * sizeof(Scheme_Secondary_Hash_Proc); memset((char *)scheme_type_hash2s, 0, n); } @@ -298,14 +308,14 @@ scheme_init_type () Scheme_Type scheme_make_type(const char *name) { Scheme_Type newtype; -#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - void *saved_gc; - saved_gc = GC_switch_to_master_gc(); -#endif if (!type_names) init_type_arrays(); +#ifdef MZ_USE_PLACES + mzrt_mutex_lock(type_array_mutex); +#endif + if (maxtype == allocmax) { /* Expand arrays */ void *naya; @@ -313,33 +323,39 @@ Scheme_Type scheme_make_type(const char *name) allocmax += 20; - naya = scheme_malloc(allocmax * sizeof(char *)); + naya = malloc(allocmax * sizeof(char *)); memcpy(naya, type_names, maxtype * sizeof(char *)); + free(type_names); type_names = (char **)naya; - naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Type_Reader2)); + naya = malloc(n = allocmax * sizeof(Scheme_Type_Reader2)); memset((char *)naya, 0, n); memcpy(naya, scheme_type_readers, maxtype * sizeof(Scheme_Type_Reader2)); + free(scheme_type_readers); scheme_type_readers = (Scheme_Type_Reader2 *)naya; - naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Type_Writer)); + naya = malloc(n = allocmax * sizeof(Scheme_Type_Writer)); memset((char *)naya, 0, n); memcpy(naya, scheme_type_writers, maxtype * sizeof(Scheme_Type_Writer)); + free(scheme_type_writers); scheme_type_writers = (Scheme_Type_Writer *)naya; - naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Equal_Proc)); + naya = malloc(n = allocmax * sizeof(Scheme_Equal_Proc)); memset((char *)naya, 0, n); memcpy(naya, scheme_type_equals, maxtype * sizeof(Scheme_Equal_Proc)); + free(scheme_type_equals); scheme_type_equals = (Scheme_Equal_Proc *)naya; - naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Primary_Hash_Proc)); + naya = malloc(n = allocmax * sizeof(Scheme_Primary_Hash_Proc)); memset((char *)naya, 0, n); memcpy(naya, scheme_type_hash1s, maxtype * sizeof(Scheme_Primary_Hash_Proc)); + free(scheme_type_hash1s); scheme_type_hash1s = (Scheme_Primary_Hash_Proc *)naya; - naya = scheme_malloc_atomic(n = allocmax * sizeof(Scheme_Secondary_Hash_Proc)); + naya = malloc(n = allocmax * sizeof(Scheme_Secondary_Hash_Proc)); memset((char *)naya, 0, n); memcpy(naya, scheme_type_hash2s, maxtype * sizeof(Scheme_Secondary_Hash_Proc)); + free(scheme_type_hash2s); scheme_type_hash2s = (Scheme_Secondary_Hash_Proc *)naya; #ifdef MEMORY_COUNTING_ON @@ -351,15 +367,20 @@ Scheme_Type scheme_make_type(const char *name) { char *tn; - tn = scheme_strdup(name); + int len; + len = strlen(name) + 1; + tn = (char *)malloc(len); + memcpy(tn, name, len); type_names[maxtype] = tn; } newtype = maxtype; maxtype++; -#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - GC_switch_back_from_master(saved_gc); + +#ifdef MZ_USE_PLACES + mzrt_mutex_unlock(type_array_mutex); #endif + return newtype; }