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:
Matthew Flatt 2011-05-13 10:32:07 -06:00
parent 84cb649b87
commit a613e81fcd
19 changed files with 169 additions and 97 deletions

View File

@ -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.}

View File

@ -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]

View File

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

View File

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

View File

@ -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]

View File

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

View File

@ -596,3 +596,5 @@ EXPORTS
scheme_stx_extract_marks
scheme_get_place_table
scheme_register_process_global
scheme_malloc_key
scheme_free_key

View File

@ -612,3 +612,5 @@ EXPORTS
scheme_stx_extract_marks
scheme_get_place_table
scheme_register_process_global
scheme_malloc_key
scheme_free_key

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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;
}