suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

atomic increase of max_symbol_length, locking for jit freelist, globals tagging

Browse Source 
svn: r17584
This commit is contained in:
Kevin Tew 2010-01-08 23:05:33 +00:00
parent a0ba9a7649
commit 0dc9ae031c
10 changed files with 181 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/mzscheme/include/schthread.h
View File

@ -258,6 +258,7 @@ typedef struct Thread_Local_Variables {
long scheme_code_page_total_;
int locale_on_;
const mzchar *current_locale_name_;
int gensym_counter_;
/*KPLAKE1*/
} Thread_Local_Variables;
@ -501,6 +502,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define scheme_code_page_total XOA (scheme_get_thread_local_variables()->scheme_code_page_total_)
#define locale_on XOA (scheme_get_thread_local_variables()->locale_on_)
#define current_locale_name XOA (scheme_get_thread_local_variables()->current_locale_name_)
#define gensym_counter XOA (scheme_get_thread_local_variables()->gensym_counter_)
/*KPLAKE2*/
/* **************************************** */

1
src/mzscheme/src/env.c
View File

@ -354,6 +354,7 @@ Scheme_Env *scheme_engine_instance_init() {
#ifndef DONT_USE_FOREIGN
scheme_init_foreign_globals();
#endif
scheme_init_salloc();
#ifdef MZ_USE_JIT
scheme_init_jit();
#endif

12
src/mzscheme/src/error.c
View File

@ -771,14 +771,18 @@ static long get_print_width(void)
static char *init_buf(long *len, long *_size)
{
long size, print_width;
unsigned long local_max_symbol_length;
long print_width;
long size;
local_max_symbol_length = scheme_get_max_symbol_length();
print_width = get_print_width();
print_width = get_print_width();
size = (3 * local_max_symbol_length + 500 + 2 * print_width);
/* out parameters */
if (len)
*len = print_width;
size = (3 * scheme_max_found_symbol_name + 500 + 2 * print_width);
if (_size)
*_size = size;

81
src/mzscheme/src/mzrt.h
View File

@ -110,6 +110,87 @@ void pt_mbox_recv(pt_mbox *mbox, int *type, void **payload, pt_mbox **origin);
void pt_mbox_send_recv(pt_mbox *mbox, int type, void *payload, pt_mbox *origin, int *return_type, void **return_payload);
void pt_mbox_destroy(pt_mbox *mbox);
static inline int mzrt_cas(volatile size_t *addr, size_t old, size_t new_val) {
#if defined(__GNUC__) && !defined(__INTEL_COMPILER)
# if defined(__i386__)
char result;
__asm__ __volatile__("lock; cmpxchgl %3, %0; setz %1"
: "=m"(*addr), "=q"(result)
: "m"(*addr), "r" (new_val), "a"(old)
: "memory");
return (int) result;
# elif defined(__x86_64__)
char result;
__asm__ __volatile__("lock; cmpxchgq %3, %0; setz %1"
: "=m"(*addr), "=q"(result)
: "m"(*addr), "r" (new_val), "a"(old)
: "memory");
return (int) result;
# elif defined(__powerpc__) || defined(__ppc__) || defined(__PPC__) \
|| defined(__powerpc64__) || defined(__ppc64__)
# if defined(__powerpc64__) || defined(__ppc64__) || defined(__64BIT__)
/* FIXME: Completely untested. */
AO_t oldval;
int result = 0;
__asm__ __volatile__(
"1:ldarx %0,0,%2\n" /* load and reserve */
"cmpd %0, %4\n" /* if load is not equal to */
"bne 2f\n" /* old, fail */
"stdcx. %3,0,%2\n" /* else store conditional */
"bne- 1b\n" /* retry if lost reservation */
"li %1,1\n" /* result = 1; */
"2:\n"
: "=&r"(oldval), "=&r"(result)
: "r"(addr), "r"(new_val), "r"(old), "1"(result)
: "memory", "cc");
return result;
# else
AO_t oldval;
int result = 0;
__asm__ __volatile__(
"1:lwarx %0,0,%2\n" /* load and reserve */
"cmpw %0, %4\n" /* if load is not equal to */
"bne 2f\n" /* old, fail */
"stwcx. %3,0,%2\n" /* else store conditional */
"bne- 1b\n" /* retry if lost reservation */
"li %1,1\n" /* result = 1; */
"2:\n"
: "=&r"(oldval), "=&r"(result)
: "r"(addr), "r"(new_val), "r"(old), "1"(result)
: "memory", "cc");
return result;
# endif
# else
# error mzrt_cas not defined on this platform
# endif
#elif defined(_MSC_VER)
# if defined(_AMD64_)
return _InterlockedCompareExchange64((LONGLONG volatile *)addr, (LONGLONG)new_val, (LONGLONG)old) == (LONGLONG)old
# elif _M_IX86 >= 400
return _InterlockedCompareExchange((LONG volatile *)addr, (LONG)new_val, (LONG)old) == (LONG)old;
# endif
#else
# error mzrt_cas not defined on this platform
#endif
}
static inline void mzrt_ensure_max_cas(unsigned long *atomic_val, unsigned long len) {
int set = 0;
while(!set) {
unsigned long old_val = *atomic_val;
if (len > old_val) {
set = !mzrt_cas(atomic_val, old_val, len);
}
else {
set = 1;
}
}
}
#endif
#endif

2
src/mzscheme/src/port.c
View File

@ -310,7 +310,7 @@ HOOK_SHARED_OK Scheme_Object *(*scheme_make_stdin)(void) = NULL;
HOOK_SHARED_OK Scheme_Object *(*scheme_make_stdout)(void) = NULL;
HOOK_SHARED_OK Scheme_Object *(*scheme_make_stderr)(void) = NULL;
MZ_DLLSPEC int scheme_binary_mode_stdio;
SHARED_OK MZ_DLLSPEC int scheme_binary_mode_stdio = 0;
void scheme_set_binary_mode_stdio(int v) { scheme_binary_mode_stdio = v; }
THREAD_LOCAL_DECL(static int special_is_ok);

2
src/mzscheme/src/print.c
View File

@ -47,7 +47,7 @@ THREAD_LOCAL_DECL(static Scheme_Hash_Table *cache_ht);
/* read-only globals */
SHARED_OK static char compacts[_CPT_COUNT_];
SHARED_OK static Scheme_Hash_Table *global_constants_ht;
static Scheme_Object *quote_link_symbol = NULL;
SHARED_OK static Scheme_Object *quote_link_symbol = NULL;
/* Flag for debugging compiled code in printed form: */
#define NO_COMPACT 0

112
src/mzscheme/src/salloc.c
View File

@ -89,6 +89,25 @@ SHARED_OK static int use_registered_statics;
extern MZ_DLLIMPORT void GC_init();
#endif
struct free_list_entry {
long size; /* size of elements in this bucket */
void *elems; /* doubly linked list for free blocks */
int count; /* number of items in `elems' */
};
SHARED_OK static struct free_list_entry *free_list;
SHARED_OK static int free_list_bucket_count;
#ifdef MZ_USE_PLACES
SHARED_OK static mzrt_mutex *free_list_mutex;
#endif
void scheme_init_salloc() {
#ifdef MZ_USE_PLACES
mzrt_mutex_create(&free_list_mutex);
#endif
}
void scheme_set_stack_base(void *base, int no_auto_statics)
{
#ifdef MZ_PRECISE_GC
@ -739,15 +758,6 @@ static int fd, fd_created;
#if defined(MZ_JIT_USE_MPROTECT) || defined(MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC)
FIXME_LATER struct free_list_entry {
long size; /* size of elements in this bucket */
void *elems; /* doubly linked list for free blocks */
int count; /* number of items in `elems' */
};
static struct free_list_entry *free_list;
static int free_list_bucket_count;
static long get_page_size()
{
# ifdef PAGESIZE
@ -865,9 +875,14 @@ static long free_list_find_bucket(long size)
void *scheme_malloc_code(long size)
{
#if defined(MZ_JIT_USE_MPROTECT) || defined(MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC)
long size2, bucket, sz, page_size;
void *p, *pg, *prev;
# ifdef MZ_USE_PLACES
mzrt_mutex_lock(free_list_mutex);
# endif
if (size < CODE_HEADER_SIZE) {
/* ensure CODE_HEADER_SIZE alignment
and room for free-list pointers */
@ -891,44 +906,49 @@ void *scheme_malloc_code(long size)
*(long *)pg = sz;
LOG_CODE_MALLOC(1, printf("allocated large %p (%ld) [now %ld]\n",
pg, size + CODE_HEADER_SIZE, scheme_code_page_total));
return ((char *)pg) + CODE_HEADER_SIZE;
p = ((char *)pg) + CODE_HEADER_SIZE;
}
else {
bucket = free_list_find_bucket(size);
size2 = free_list[bucket].size;
bucket = free_list_find_bucket(size);
size2 = free_list[bucket].size;
if (!free_list[bucket].elems) {
/* add a new page's worth of items to the free list */
int i, count = 0;
pg = malloc_page(page_size);
scheme_code_page_total += page_size;
LOG_CODE_MALLOC(2, printf("new page for %ld / %ld at %p [now %ld]\n",
size2, bucket, pg, scheme_code_page_total));
sz = page_size - size2;
for (i = CODE_HEADER_SIZE; i <= sz; i += size2) {
p = ((char *)pg) + i;
prev = free_list[bucket].elems;
((void **)p)[0] = prev;
((void **)p)[1] = NULL;
if (prev)
((void **)prev)[1] = p;
free_list[bucket].elems = p;
count++;
if (!free_list[bucket].elems) {
/* add a new page's worth of items to the free list */
int i, count = 0;
pg = malloc_page(page_size);
scheme_code_page_total += page_size;
LOG_CODE_MALLOC(2, printf("new page for %ld / %ld at %p [now %ld]\n",
size2, bucket, pg, scheme_code_page_total));
sz = page_size - size2;
for (i = CODE_HEADER_SIZE; i <= sz; i += size2) {
p = ((char *)pg) + i;
prev = free_list[bucket].elems;
((void **)p)[0] = prev;
((void **)p)[1] = NULL;
if (prev)
((void **)prev)[1] = p;
free_list[bucket].elems = p;
count++;
}
((long *)pg)[0] = bucket; /* first long of page indicates bucket */
((long *)pg)[1] = 0; /* second long indicates number of allocated on page */
free_list[bucket].count = count;
}
((long *)pg)[0] = bucket; /* first long of page indicates bucket */
((long *)pg)[1] = 0; /* second long indicates number of allocated on page */
free_list[bucket].count = count;
p = free_list[bucket].elems;
prev = ((void **)p)[0];
free_list[bucket].elems = prev;
--free_list[bucket].count;
if (prev)
((void **)prev)[1] = NULL;
((long *)CODE_PAGE_OF(p))[1] += 1;
LOG_CODE_MALLOC(0, printf("allocated %ld (->%ld / %ld)\n", size, size2, bucket));
}
p = free_list[bucket].elems;
prev = ((void **)p)[0];
free_list[bucket].elems = prev;
--free_list[bucket].count;
if (prev)
((void **)prev)[1] = NULL;
((long *)CODE_PAGE_OF(p))[1] += 1;
LOG_CODE_MALLOC(0, printf("allocated %ld (->%ld / %ld)\n", size, size2, bucket));
# ifdef MZ_USE_PLACES
mzrt_mutex_unlock(free_list_mutex);
# endif
return p;
#else
@ -943,6 +963,10 @@ void scheme_free_code(void *p)
int per_page, n;
void *prev;
# ifdef MZ_USE_PLACES
mzrt_mutex_lock(free_list_mutex);
# endif
page_size = get_page_size();
size = *(long *)CODE_PAGE_OF(p);
@ -1015,6 +1039,10 @@ void scheme_free_code(void *p)
CODE_PAGE_OF(p), scheme_code_page_total));
free_page(CODE_PAGE_OF(p), page_size);
}
# ifdef MZ_USE_PLACES
mzrt_mutex_unlock(free_list_mutex);
# endif
#else
free(p);
#endif

3
src/mzscheme/src/schpriv.h
View File

@ -233,6 +233,7 @@ void scheme_init_dynamic_extension(Scheme_Env *env);
#ifndef NO_REGEXP_UTILS
extern void scheme_regexp_initialize(Scheme_Env *env);
#endif
void scheme_init_salloc(void);
#ifdef MZ_USE_JIT
void scheme_init_jit(void);
#endif
@ -2965,7 +2966,7 @@ void scheme_non_fixnum_result(const char *name, Scheme_Object *o);
void scheme_raise_out_of_memory(const char *where, const char *msg, ...);
extern unsigned long scheme_max_found_symbol_name;
unsigned long scheme_get_max_symbol_length();
char *scheme_make_arity_expect_string(Scheme_Object *proc,
int argc, Scheme_Object **argv,

2
src/mzscheme/src/sstoinc.ss
View File

@ -14,7 +14,7 @@
[p (open-output-bytes)])
(write c p)
(let ([s (get-output-bytes p)])
(printf " {~n static MZCOMPILED_STRING_FAR unsigned char expr[] = {")
(printf " {~n SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {")
(let loop ([chars (bytes->list s)][pos 0])
(unless (null? chars)
(let ([char (car chars)])

18
src/mzscheme/src/symbol.c
View File

@ -60,11 +60,11 @@ SHARED_OK mzrt_rwlock *symbol_table_lock;
# define mzrt_rwlock_unlock(l) /* empty */
#endif
unsigned long scheme_max_found_symbol_name;
SHARED_OK static unsigned long scheme_max_symbol_length;
/* globals */
SHARED_OK int scheme_case_sensitive = 1;
static int gensym_counter; /*FIXME need atomic increment*/
THREAD_LOCAL_DECL(static int gensym_counter);
void scheme_set_case_sensitive(int v) { scheme_case_sensitive = v; }
@ -333,6 +333,12 @@ scheme_init_symbol (Scheme_Env *env)
GLOBAL_IMMED_PRIM("gensym", gensym, 0, 1, env);
}
unsigned long scheme_get_max_symbol_length() {
/* x86, x86_64, and powerpc support aligned_atomic_loads_and_stores */
return scheme_max_symbol_length;
}
static Scheme_Object *
make_a_symbol(const char *name, unsigned int len, int kind)
{
@ -346,9 +352,13 @@ make_a_symbol(const char *name, unsigned int len, int kind)
memcpy(sym->s, name, len);
sym->s[len] = 0;
if (len > scheme_max_found_symbol_name) {
scheme_max_found_symbol_name = len;
#ifdef MZ_USE_PLACES
mzrt_ensure_max_cas(&scheme_max_symbol_length, len);
#else
if ( len > scheme_max_symbol_length ) {
scheme_max_symbol_length = len;
}
#endif
return (Scheme_Object *) sym;
}