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
This commit is contained in:
parent
84cb649b87
commit
a613e81fcd
|
@ -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.}
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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)
|
||||
{
|
||||
|
|
|
@ -596,3 +596,5 @@ EXPORTS
|
|||
scheme_stx_extract_marks
|
||||
scheme_get_place_table
|
||||
scheme_register_process_global
|
||||
scheme_malloc_key
|
||||
scheme_free_key
|
||||
|
|
|
@ -612,3 +612,5 @@ EXPORTS
|
|||
scheme_stx_extract_marks
|
||||
scheme_get_place_table
|
||||
scheme_register_process_global
|
||||
scheme_malloc_key
|
||||
scheme_free_key
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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_)
|
||||
|
||||
/* **************************************** */
|
||||
|
||||
|
|
|
@ -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)) {
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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 */
|
||||
/************************************************************************/
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user