change protocol for extensions with places

- extension gets scheme_initialize() per-place
 - simplify allocation and fix locking for scheme_new_type()
 - better Inside docs on places

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
+ pointers (for the current @|tech-place|). The address of the global 
- size in bytes in @var{size}.In addition to global variables, this
+ 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.}

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]

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);
+ extension is loaded with @racket[load-extension] the first time in a
- the return value from @cpp{scheme_initialize} is used as the return
+ given @|tech-place|; the return value from @cpp{scheme_initialize} is used
- value for @racket[load-extension]. The namespace provided to
+ as the return value for @racket[load-extension]. The namespace
- @cpp{scheme_initialize} is the current namespace when
+ 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},
+ time (or more times) for an extension in a given @|tech-place|. Like
- the return value from this function is the return value for
+ @cpp{scheme_initialize}, the return value from this function is the
- @racket[load-extension].}
+ 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
+any @cpp{scheme_} function.  Only the OS thread representing a
-@cpp{scheme_basic_env} can call @cpp{scheme_} functions. (This
+particular @|tech-place| can call @cpp{scheme_} functions. (This
-restriction is stronger than saying all calls must be serialized
+restriction is stronger than saying all calls for a given place must
-across threads. Racket relies on properties of specific threads to
+be serialized across threads. Racket relies on properties of specific
-avoid stack overflow and garbage collection.) When
+threads to avoid stack overflow and garbage collection.) For the
-@cpp{scheme_basic_env} is called a second time to reset the
+original place, only the OS thread used to call @cpp{scheme_basic_env}
-interpreter, it can be called in an OS thread that is different from
+can call @cpp{scheme_} functions. For any other place, only the OS
-the original call to @cpp{scheme_basic_env}. Thereafter, all calls to
+thread that is created by Racket for the place can be used to call
-@cpp{scheme_} functions must originate from the new thread.
+@cpp{scheme_} functions.
 
 See @secref["threads"] for more information about threads, including
 the possible effects of Racket's thread implementation on extension

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)))

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]

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)
 {

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

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

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

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

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_)
 
 /* **************************************** */
 

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 */
+THREAD_LOCAL_DECL(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 *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,8 +182,14 @@ 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;
+#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 (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
-    }
   }
 #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)) {

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); 

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                                  */
 /************************************************************************/

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);

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

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;

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

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);
+  type_names = RAW_MALLOC_N(char *, allocmax);
-  scheme_type_readers = MALLOC_N_ATOMIC(Scheme_Type_Reader2, 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;
 }