fixes for places
svn: r17557
This commit is contained in:
Matthew Flatt
parent
b497787b89
commit
42172e4fda
|
|
@ -138,7 +138,7 @@ xobjects: $(OBJS) main.@LTO@
|
|||
XFORMDEP = $(srcdir)/gc2.h $(srcdir)/gc2_obj.h $(srcdir)/xform.ss $(srcdir)/xform-mod.ss \
|
||||
$(srcdir)/precomp.c $(srcdir)/../src/schpriv.h $(srcdir)/../include/scheme.h \
|
||||
$(srcdir)/../sconfig.h $(srcdir)/../uconfig.h $(srcdir)/../src/schemef.h \
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/../include/schthread.h
|
||||
$(srcdir)/../src/stypes.h $(srcdir)/../include/schthread.h $(srcdir)/../src/mzrt.h
|
||||
|
||||
LIGHTNINGDEP = $(srcdir)/../src/lightning/i386/core.h $(srcdir)/../src/lightning/i386/core-common.h \
|
||||
$(srcdir)/../src/lightning/i386/asm.h $(srcdir)/../src/lightning/i386/asm-common.h \
|
||||
|
|
|
|||
|
|
@ -33,12 +33,6 @@ typedef unsigned long (*GC_get_thread_stack_base_Proc)(void);
|
|||
|
||||
#endif
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
# define GC_OBJHEAD_SIZE (2*sizeof(unsigned long))
|
||||
#else
|
||||
# define GC_OBJHEAD_SIZE (sizeof(unsigned long))
|
||||
#endif
|
||||
|
||||
#ifndef GC2_JUST_MACROS
|
||||
|
||||
#include <stddef.h>
|
||||
|
|
|
|||
|
|
@ -9,9 +9,6 @@
|
|||
# define LOG_APAGE_SIZE 14
|
||||
#endif
|
||||
typedef struct objhead {
|
||||
# ifdef MZ_USE_PLACES
|
||||
unsigned long owner;
|
||||
#endif
|
||||
unsigned long hash : ((8 * sizeof(unsigned long)) - (4+3+LOG_APAGE_SIZE) );
|
||||
/* the type and size of the object */
|
||||
unsigned long type : 3;
|
||||
|
|
|
|||
|
|
@ -97,7 +97,6 @@ static const char *type_name[PAGE_TYPES] = {
|
|||
#ifdef MZ_USE_PLACES
|
||||
static NewGC *MASTERGC;
|
||||
static NewGCMasterInfo *MASTERGCINFO;
|
||||
THREAD_LOCAL_DECL(static objhead GC_objhead_template);
|
||||
inline static int premaster_or_master_gc(NewGC *gc) {
|
||||
return (!MASTERGC || gc == MASTERGC);
|
||||
}
|
||||
|
|
@ -584,7 +583,8 @@ static inline void* REMOVE_BIG_PAGE_PTR_TAG(void *p) {
|
|||
|
||||
void GC_check_master_gc_request() {
|
||||
#ifdef MZ_USE_PLACES
|
||||
if (MASTERGC && MASTERGC->major_places_gc == 1 && MASTERGCINFO->have_collected[GC_objhead_template.owner] != 0) {
|
||||
NewGC *gc = GC_get_GC();
|
||||
if (MASTERGC && MASTERGC->major_places_gc == 1 && MASTERGCINFO->have_collected[gc->place_id] != 0) {
|
||||
GC_gcollect();
|
||||
}
|
||||
#endif
|
||||
|
|
@ -662,10 +662,6 @@ static void *allocate_big(const size_t request_size_bytes, int type)
|
|||
bpage->page_type = type;
|
||||
GCVERBOSEPAGE("NEW BIG PAGE", bpage);
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
memcpy(BIG_PAGE_TO_OBJHEAD(bpage), &GC_objhead_template, sizeof(objhead));
|
||||
#endif
|
||||
|
||||
/* push new bpage onto GC->gen0.big_pages */
|
||||
bpage->next = gc->gen0.big_pages;
|
||||
if(bpage->next) bpage->next->prev = bpage;
|
||||
|
|
@ -694,9 +690,6 @@ inline static mpage *create_new_medium_page(NewGC *gc, const int sz, const int p
|
|||
|
||||
for (n = page->previous_size; ((n + sz) <= APAGE_SIZE); n += sz) {
|
||||
objhead *info = (objhead *)PTR(NUM(page->addr) + n);
|
||||
#ifdef MZ_USE_PLACES
|
||||
memcpy(info, &GC_objhead_template, sizeof(objhead));
|
||||
#endif
|
||||
info->dead = 1;
|
||||
info->size = gcBYTES_TO_WORDS(sz);
|
||||
}
|
||||
|
|
@ -959,10 +952,6 @@ inline static void *allocate(const size_t request_size, const int type)
|
|||
else
|
||||
bzero(info, allocate_size);
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
memcpy(info, &GC_objhead_template, sizeof(objhead));
|
||||
#endif
|
||||
|
||||
info->type = type;
|
||||
info->size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumbed us up to the next word boundary */
|
||||
{
|
||||
|
|
@ -996,10 +985,6 @@ inline static void *fast_malloc_one_small_tagged(size_t request_size, int dirty)
|
|||
else
|
||||
bzero(info, allocate_size);
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
memcpy(info, &GC_objhead_template, sizeof(objhead));
|
||||
#endif
|
||||
|
||||
info->size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumbed us up to the next word boundary */
|
||||
|
||||
{
|
||||
|
|
@ -1035,12 +1020,7 @@ void *GC_malloc_pair(void *car, void *cdr)
|
|||
objhead *info = (objhead *) PTR(GC_gen0_alloc_page_ptr);
|
||||
GC_gen0_alloc_page_ptr = newptr;
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
memcpy(info, &GC_objhead_template, sizeof(objhead));
|
||||
#else
|
||||
memset(info, 0, sizeof(objhead)); /* init objhead */
|
||||
#endif
|
||||
|
||||
|
||||
/* info->type = type; */ /* We know that the type field is already 0 */
|
||||
info->size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumbed us up to the next word boundary */
|
||||
|
|
@ -1075,7 +1055,6 @@ void *GC_malloc_one_small_dirty_tagged(size_t s) { return fast_malloc_one_small
|
|||
void *GC_malloc_one_small_tagged(size_t s) { return fast_malloc_one_small_tagged(s, 0); }
|
||||
void GC_free(void *p) {}
|
||||
|
||||
|
||||
long GC_compute_alloc_size(long sizeb)
|
||||
{
|
||||
return COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(sizeb);
|
||||
|
|
@ -1088,33 +1067,14 @@ long GC_initial_word(int request_size)
|
|||
|
||||
const size_t allocate_size = COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(request_size);
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
memcpy(&info, &GC_objhead_template, sizeof(objhead));
|
||||
#else
|
||||
memset(&info, 0, sizeof(objhead));
|
||||
#endif
|
||||
|
||||
info.size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumbed us up to the next word boundary */
|
||||
info.size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumped us up to the next word boundary */
|
||||
memcpy(&w, &info, sizeof(objhead));
|
||||
|
||||
return w;
|
||||
}
|
||||
|
||||
void GC_initial_words(char *buffer, long sizeb)
|
||||
{
|
||||
objhead *info = (objhead *)buffer;
|
||||
|
||||
const size_t allocate_size = COMPUTE_ALLOC_SIZE_FOR_OBJECT_SIZE(sizeb);
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
memcpy(info, &GC_objhead_template, sizeof(objhead));
|
||||
#else
|
||||
memset(info, 0, sizeof(objhead));
|
||||
#endif
|
||||
|
||||
info->size = BYTES_MULTIPLE_OF_WORD_TO_WORDS(allocate_size); /* ALIGN_BYTES_SIZE bumbed us up to the next word boundary */
|
||||
}
|
||||
|
||||
long GC_alloc_alignment()
|
||||
{
|
||||
return APAGE_SIZE;
|
||||
|
|
@ -1874,8 +1834,8 @@ static void NewGCMasterInfo_cleanup() {
|
|||
MASTERGCINFO = NULL;
|
||||
}
|
||||
|
||||
static void NewGCMasterInfo_set_have_collected() {
|
||||
MASTERGCINFO->have_collected[GC_objhead_template.owner] = 1;
|
||||
static void NewGCMasterInfo_set_have_collected(NewGC *gc) {
|
||||
MASTERGCINFO->have_collected[gc->place_id] = 1;
|
||||
}
|
||||
|
||||
static void Master_collect() {
|
||||
|
|
@ -1932,18 +1892,19 @@ static void NewGCMasterInfo_get_next_id(NewGC *newgc) {
|
|||
/* waiting for other threads to finish a possible concurrent GC is not optimal*/
|
||||
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
|
||||
newid = MASTERGCINFO->next_GC_id++;
|
||||
GC_objhead_template.owner = newid;
|
||||
/* printf("ALLOCATED GC OID %li\n", GC_objhead_template.owner); */
|
||||
newgc->place_id = newid;
|
||||
/* printf("ALLOCATED GC OID %li\n", newgc->place_id); */
|
||||
MASTERGCINFO->have_collected = realloc(MASTERGCINFO->have_collected, sizeof(char) * MASTERGCINFO->next_GC_id);
|
||||
MASTERGCINFO->signal_fds = realloc(MASTERGCINFO->signal_fds, sizeof(void*) * MASTERGCINFO->next_GC_id);
|
||||
MASTERGCINFO->have_collected[newid] = 0;
|
||||
MASTERGCINFO->signal_fds[newid] = -1;
|
||||
MASTERGCINFO->signal_fds[newid] = (void *)-1;
|
||||
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
|
||||
}
|
||||
|
||||
void GC_set_put_external_event_fd(void *fd) {
|
||||
NewGC *gc = GC_get_GC();
|
||||
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
|
||||
MASTERGCINFO->signal_fds[GC_objhead_template.owner] = fd;
|
||||
MASTERGCINFO->signal_fds[gc->place_id] = fd;
|
||||
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
|
||||
}
|
||||
#endif
|
||||
|
|
@ -2053,14 +2014,12 @@ static inline void save_globals_to_gc(NewGC *gc) {
|
|||
gc->saved_GC_variable_stack = GC_variable_stack;
|
||||
gc->saved_GC_gen0_alloc_page_ptr = GC_gen0_alloc_page_ptr;
|
||||
gc->saved_GC_gen0_alloc_page_end = GC_gen0_alloc_page_end;
|
||||
gc->saved_GC_objhead_template = GC_objhead_template;
|
||||
}
|
||||
|
||||
static inline void restore_globals_from_gc(NewGC *gc) {
|
||||
GC_variable_stack = gc->saved_GC_variable_stack;
|
||||
GC_gen0_alloc_page_ptr = gc->saved_GC_gen0_alloc_page_ptr;
|
||||
GC_gen0_alloc_page_end = gc->saved_GC_gen0_alloc_page_end;
|
||||
GC_objhead_template = gc->saved_GC_objhead_template;
|
||||
}
|
||||
|
||||
void GC_switch_out_master_gc() {
|
||||
|
|
@ -3444,7 +3403,7 @@ static void garbage_collect(NewGC *gc, int force_full)
|
|||
#ifdef MZ_USE_PLACES
|
||||
if (postmaster_and_place_gc(gc)) {
|
||||
mzrt_rwlock_rdlock(MASTERGCINFO->cangc);
|
||||
/* printf("RD MGCLOCK garbage_collect %i\n", GC_objhead_template.owner); */
|
||||
/* printf("RD MGCLOCK garbage_collect %i\n", gc->place_id); */
|
||||
}
|
||||
#endif
|
||||
|
||||
|
|
@ -3695,9 +3654,9 @@ static void garbage_collect(NewGC *gc, int force_full)
|
|||
#ifdef MZ_USE_PLACES
|
||||
if (postmaster_and_place_gc(gc)) {
|
||||
if (gc->gc_full) {
|
||||
NewGCMasterInfo_set_have_collected();
|
||||
NewGCMasterInfo_set_have_collected(gc);
|
||||
}
|
||||
/* printf("UN RD MGCLOCK garbage_collect %i\n", GC_objhead_template.owner); */
|
||||
/* printf("UN RD MGCLOCK garbage_collect %i\n", gc->place_id); */
|
||||
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
|
||||
if (gc->gc_full) {
|
||||
Master_collect();
|
||||
|
|
|
|||
|
|
@ -174,7 +174,7 @@ typedef struct NewGC {
|
|||
unsigned long saved_GC_gen0_alloc_page_end;
|
||||
/* Distributed GC over places info */
|
||||
#ifdef MZ_USE_PLACES
|
||||
objhead saved_GC_objhead_template;
|
||||
int place_id;
|
||||
int major_places_gc; /* :1; */
|
||||
#endif
|
||||
|
||||
|
|
|
|||
|
|
@ -83,7 +83,6 @@ typedef long objhead;
|
|||
|
||||
typedef struct Thread_Local_Variables {
|
||||
void **GC_variable_stack_;
|
||||
objhead GC_objhead_template_;
|
||||
struct NewGC *GC_;
|
||||
unsigned long GC_gen0_alloc_page_ptr_;
|
||||
unsigned long GC_gen0_alloc_page_end_;
|
||||
|
|
@ -96,6 +95,10 @@ typedef struct Thread_Local_Variables {
|
|||
unsigned long volatile scheme_jit_stack_boundary_;
|
||||
volatile int scheme_future_need_gc_pause_;
|
||||
int scheme_use_rtcall_;
|
||||
int in_jit_critical_section_;
|
||||
void *jit_buffer_cache_;
|
||||
long jit_buffer_cache_size_;
|
||||
int jit_buffer_cache_registered_;
|
||||
struct Scheme_Object *quick_stx_;
|
||||
int scheme_continuation_application_count_;
|
||||
int scheme_cont_capture_count_;
|
||||
|
|
@ -315,6 +318,10 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
|
|||
#define scheme_jit_stack_boundary XOA (scheme_get_thread_local_variables()->scheme_jit_stack_boundary_)
|
||||
#define scheme_future_need_gc_pause XOA (scheme_get_thread_local_variables()->scheme_future_need_gc_pause_)
|
||||
#define scheme_use_rtcall XOA (scheme_get_thread_local_variables()->scheme_use_rtcall_)
|
||||
#define in_jit_critical_section XOA (scheme_get_thread_local_variables()->in_jit_critical_section_)
|
||||
#define jit_buffer_cache XOA (scheme_get_thread_local_variables()->jit_buffer_cache_)
|
||||
#define jit_buffer_cache_size XOA (scheme_get_thread_local_variables()->jit_buffer_cache_size_)
|
||||
#define jit_buffer_cache_registered XOA (scheme_get_thread_local_variables()->jit_buffer_cache_registered_)
|
||||
#define quick_stx XOA (scheme_get_thread_local_variables()->quick_stx_)
|
||||
#define scheme_continuation_application_count XOA (scheme_get_thread_local_variables()->scheme_continuation_application_count_)
|
||||
#define scheme_cont_capture_count XOA (scheme_get_thread_local_variables()->scheme_cont_capture_count_)
|
||||
|
|
|
|||
|
|
@ -353,6 +353,9 @@ Scheme_Env *scheme_engine_instance_init() {
|
|||
#ifndef DONT_USE_FOREIGN
|
||||
scheme_init_foreign_globals();
|
||||
#endif
|
||||
#ifdef MZ_USE_JIT
|
||||
scheme_init_jit();
|
||||
#endif
|
||||
|
||||
#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
|
||||
scheme_places_block_child_signal();
|
||||
|
|
@ -475,9 +478,7 @@ static Scheme_Env *place_instance_init_post_kernel(int initial_main_os_thread) {
|
|||
/* this check prevents initializing orig ports twice for the first initial
|
||||
* place. The kernel initializes orig_ports early. */
|
||||
scheme_init_fun_places();
|
||||
if (!scheme_orig_stdout_port) {
|
||||
scheme_init_port_places();
|
||||
}
|
||||
scheme_init_port_places();
|
||||
scheme_init_error_escape_proc(NULL);
|
||||
scheme_init_print_buffers_places();
|
||||
scheme_init_logger();
|
||||
|
|
|
|||
|
|
@ -901,7 +901,7 @@ Scheme_Object *scheme_jit_closure(Scheme_Object *code, Scheme_Object *context)
|
|||
|
||||
/* We need to cache clones to support multiple references
|
||||
to a zero-sized closure in bytecode. We need either a clone
|
||||
or native code, and context determines which field is releveant,
|
||||
or native code, and context determines which field is relevant,
|
||||
so we put the two possibilities in a union `u'. */
|
||||
|
||||
if (!context)
|
||||
|
|
|
|||
|
|
@ -120,55 +120,55 @@ static void assert_failure(int where) { printf("JIT assert failed %d\n", where);
|
|||
/* Used by vector-set-performance-stats!: */
|
||||
int scheme_jit_malloced;
|
||||
|
||||
static int skip_checks = 0;
|
||||
SHARED_OK static int skip_checks = 0;
|
||||
|
||||
#define MAX_SHARED_CALL_RANDS 25
|
||||
static void *shared_tail_code[4][MAX_SHARED_CALL_RANDS];
|
||||
static void *shared_non_tail_code[4][MAX_SHARED_CALL_RANDS][2];
|
||||
static void *shared_non_tail_retry_code[2];
|
||||
static void *shared_non_tail_argc_code[2];
|
||||
static void *shared_tail_argc_code;
|
||||
SHARED_OK static void *shared_tail_code[4][MAX_SHARED_CALL_RANDS];
|
||||
SHARED_OK static void *shared_non_tail_code[4][MAX_SHARED_CALL_RANDS][2];
|
||||
SHARED_OK static void *shared_non_tail_retry_code[2];
|
||||
SHARED_OK static void *shared_non_tail_argc_code[2];
|
||||
SHARED_OK static void *shared_tail_argc_code;
|
||||
|
||||
#define MAX_SHARED_ARITY_CHECK 25
|
||||
static void *shared_arity_check[MAX_SHARED_ARITY_CHECK][2][2];
|
||||
SHARED_OK static void *shared_arity_check[MAX_SHARED_ARITY_CHECK][2][2];
|
||||
|
||||
static void *bad_result_arity_code;
|
||||
static void *unbound_global_code;
|
||||
static void *quote_syntax_code;
|
||||
static void *call_original_unary_arith_code;
|
||||
static void *call_original_binary_arith_code;
|
||||
static void *call_original_binary_rev_arith_code;
|
||||
static void *call_original_unary_arith_for_branch_code;
|
||||
static void *call_original_binary_arith_for_branch_code;
|
||||
static void *call_original_binary_rev_arith_for_branch_code;
|
||||
static void *call_original_nary_arith_code;
|
||||
static void *bad_car_code, *bad_cdr_code;
|
||||
static void *bad_caar_code, *bad_cdar_code, *bad_cadr_code, *bad_cddr_code;
|
||||
static void *bad_mcar_code, *bad_mcdr_code;
|
||||
static void *bad_set_mcar_code, *bad_set_mcdr_code;
|
||||
static void *bad_unbox_code;
|
||||
static void *bad_vector_length_code;
|
||||
static void *bad_flvector_length_code;
|
||||
static void *vector_ref_code, *vector_ref_check_index_code, *vector_set_code, *vector_set_check_index_code;
|
||||
static void *string_ref_code, *string_ref_check_index_code, *string_set_code, *string_set_check_index_code;
|
||||
static void *bytes_ref_code, *bytes_ref_check_index_code, *bytes_set_code, *bytes_set_check_index_code;
|
||||
static void *flvector_ref_check_index_code, *flvector_set_check_index_code, *flvector_set_flonum_check_index_code;
|
||||
static void *syntax_e_code;
|
||||
void *scheme_on_demand_jit_code;
|
||||
static void *on_demand_jit_arity_code;
|
||||
static void *get_stack_pointer_code;
|
||||
static void *stack_cache_pop_code;
|
||||
static void *struct_pred_code, *struct_pred_multi_code;
|
||||
static void *struct_pred_branch_code;
|
||||
static void *struct_get_code, *struct_get_multi_code;
|
||||
static void *struct_set_code, *struct_set_multi_code;
|
||||
static void *struct_proc_extract_code;
|
||||
static void *bad_app_vals_target;
|
||||
static void *app_values_slow_code, *app_values_multi_slow_code, *app_values_tail_slow_code;
|
||||
static void *finish_tail_call_code, *finish_tail_call_fixup_code;
|
||||
static void *module_run_start_code, *module_start_start_code;
|
||||
static void *box_flonum_from_stack_code;
|
||||
static void *fl1_fail_code, *fl2rr_fail_code[2], *fl2fr_fail_code[2], *fl2rf_fail_code[2];
|
||||
SHARED_OK static void *bad_result_arity_code;
|
||||
SHARED_OK static void *unbound_global_code;
|
||||
SHARED_OK static void *quote_syntax_code;
|
||||
SHARED_OK static void *call_original_unary_arith_code;
|
||||
SHARED_OK static void *call_original_binary_arith_code;
|
||||
SHARED_OK static void *call_original_binary_rev_arith_code;
|
||||
SHARED_OK static void *call_original_unary_arith_for_branch_code;
|
||||
SHARED_OK static void *call_original_binary_arith_for_branch_code;
|
||||
SHARED_OK static void *call_original_binary_rev_arith_for_branch_code;
|
||||
SHARED_OK static void *call_original_nary_arith_code;
|
||||
SHARED_OK static void *bad_car_code, *bad_cdr_code;
|
||||
SHARED_OK static void *bad_caar_code, *bad_cdar_code, *bad_cadr_code, *bad_cddr_code;
|
||||
SHARED_OK static void *bad_mcar_code, *bad_mcdr_code;
|
||||
SHARED_OK static void *bad_set_mcar_code, *bad_set_mcdr_code;
|
||||
SHARED_OK static void *bad_unbox_code;
|
||||
SHARED_OK static void *bad_vector_length_code;
|
||||
SHARED_OK static void *bad_flvector_length_code;
|
||||
SHARED_OK static void *vector_ref_code, *vector_ref_check_index_code, *vector_set_code, *vector_set_check_index_code;
|
||||
SHARED_OK static void *string_ref_code, *string_ref_check_index_code, *string_set_code, *string_set_check_index_code;
|
||||
SHARED_OK static void *bytes_ref_code, *bytes_ref_check_index_code, *bytes_set_code, *bytes_set_check_index_code;
|
||||
SHARED_OK static void *flvector_ref_check_index_code, *flvector_set_check_index_code, *flvector_set_flonum_check_index_code;
|
||||
SHARED_OK static void *syntax_e_code;
|
||||
SHARED_OK void *scheme_on_demand_jit_code;
|
||||
SHARED_OK static void *on_demand_jit_arity_code;
|
||||
SHARED_OK static void *get_stack_pointer_code;
|
||||
SHARED_OK static void *stack_cache_pop_code;
|
||||
SHARED_OK static void *struct_pred_code, *struct_pred_multi_code;
|
||||
SHARED_OK static void *struct_pred_branch_code;
|
||||
SHARED_OK static void *struct_get_code, *struct_get_multi_code;
|
||||
SHARED_OK static void *struct_set_code, *struct_set_multi_code;
|
||||
SHARED_OK static void *struct_proc_extract_code;
|
||||
SHARED_OK static void *bad_app_vals_target;
|
||||
SHARED_OK static void *app_values_slow_code, *app_values_multi_slow_code, *app_values_tail_slow_code;
|
||||
SHARED_OK static void *finish_tail_call_code, *finish_tail_call_fixup_code;
|
||||
SHARED_OK static void *module_run_start_code, *module_start_start_code;
|
||||
SHARED_OK static void *box_flonum_from_stack_code;
|
||||
SHARED_OK static void *fl1_fail_code, *fl2rr_fail_code[2], *fl2fr_fail_code[2], *fl2rf_fail_code[2];
|
||||
|
||||
typedef struct {
|
||||
MZTAG_IF_REQUIRED
|
||||
|
|
@ -240,8 +240,8 @@ typedef struct {
|
|||
|
||||
typedef int (*Native_Check_Arity_Proc)(Scheme_Object *o, int argc, int dummy);
|
||||
typedef Scheme_Object *(*Native_Get_Arity_Proc)(Scheme_Object *o, int dumm1, int dummy2);
|
||||
static Native_Check_Arity_Proc check_arity_code;
|
||||
static Native_Get_Arity_Proc get_arity_code;
|
||||
SHARED_OK static Native_Check_Arity_Proc check_arity_code;
|
||||
SHARED_OK static Native_Get_Arity_Proc get_arity_code;
|
||||
|
||||
static int generate_non_tail(Scheme_Object *obj, mz_jit_state *jitter, int multi_ok, int need_ends, int ignored);
|
||||
static int generate_non_tail_with_branch(Scheme_Object *obj, mz_jit_state *jitter, int multi_ok, int need_ends, int ignored,
|
||||
|
|
@ -481,9 +481,9 @@ static int past_limit(mz_jit_state *jitter)
|
|||
|
||||
#define JIT_INIT_MAPPINGS_SIZE 32
|
||||
|
||||
static void *jit_buffer_cache;
|
||||
static long jit_buffer_cache_size;
|
||||
static int jit_buffer_cache_registered;
|
||||
THREAD_LOCAL_DECL(static void *jit_buffer_cache);
|
||||
THREAD_LOCAL_DECL(static long jit_buffer_cache_size);
|
||||
THREAD_LOCAL_DECL(static int jit_buffer_cache_registered);
|
||||
|
||||
typedef int (*Generate_Proc)(mz_jit_state *j, void *data);
|
||||
|
||||
|
|
@ -736,6 +736,41 @@ static void emit_indentation(mz_jit_state *jitter)
|
|||
# define LOG_IT(args) /* empty */
|
||||
#endif
|
||||
|
||||
/*========================================================================*/
|
||||
/* initialization */
|
||||
/*========================================================================*/
|
||||
|
||||
#ifdef MZ_USE_PLACES
|
||||
|
||||
static mzrt_mutex *jit_lock;
|
||||
THREAD_LOCAL_DECL(static int in_jit_critical_section);
|
||||
|
||||
static void BEGIN_JIT_CRITICAL_SECTION()
|
||||
{
|
||||
if (!in_jit_critical_section)
|
||||
mzrt_mutex_lock(jit_lock);
|
||||
in_jit_critical_section++;
|
||||
}
|
||||
|
||||
static void END_JIT_CRITICAL_SECTION()
|
||||
{
|
||||
--in_jit_critical_section;
|
||||
if (!in_jit_critical_section)
|
||||
mzrt_mutex_unlock(jit_lock);
|
||||
}
|
||||
|
||||
#else
|
||||
# define BEGIN_JIT_CRITICAL_SECTION() /* empty */
|
||||
# define END_JIT_CRITICAL_SECTION() /* empty */
|
||||
#endif
|
||||
|
||||
void scheme_init_jit()
|
||||
{
|
||||
#ifdef MZ_USE_PLACES
|
||||
mzrt_mutex_create(&jit_lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
/*========================================================================*/
|
||||
/* run time */
|
||||
/*========================================================================*/
|
||||
|
|
@ -1564,7 +1599,6 @@ static void _jit_prolog_again(mz_jit_state *jitter, int n, int ret_addr_reg)
|
|||
#ifdef CAN_INLINE_ALLOC
|
||||
THREAD_LOCAL_DECL(extern unsigned long GC_gen0_alloc_page_ptr);
|
||||
long GC_initial_word(int sizeb);
|
||||
void GC_initial_words(char *buffer, int sizeb);
|
||||
long GC_compute_alloc_size(long sizeb);
|
||||
|
||||
static void *retry_alloc_code;
|
||||
|
|
@ -1628,9 +1662,6 @@ static int inline_alloc(mz_jit_state *jitter, int amt, Scheme_Type ty, int immut
|
|||
{
|
||||
GC_CAN_IGNORE jit_insn *ref, *reffail;
|
||||
long a_word, sz, algn;
|
||||
#if defined(MZ_USE_PLACES)
|
||||
long a_words[2];
|
||||
#endif
|
||||
|
||||
sz = GC_compute_alloc_size(amt);
|
||||
algn = GC_alloc_alignment();
|
||||
|
|
@ -1665,28 +1696,16 @@ static int inline_alloc(mz_jit_state *jitter, int amt, Scheme_Type ty, int immut
|
|||
mz_patch_branch(ref);
|
||||
jit_addi_ul(JIT_R2, JIT_V1, sz);
|
||||
(void)mz_tl_sti_l(tl_GC_gen0_alloc_page_ptr, JIT_R2, JIT_R0);
|
||||
#if !defined(MZ_USE_PLACES)
|
||||
|
||||
/* GC header: */
|
||||
a_word = GC_initial_word(amt);
|
||||
jit_movi_l(JIT_R2, a_word);
|
||||
jit_str_l(JIT_V1, JIT_R2);
|
||||
|
||||
/*SchemeObject header*/
|
||||
/* Scheme_Object header: */
|
||||
a_word = initial_tag_word(ty, immut);
|
||||
jit_movi_l(JIT_R2, a_word);
|
||||
jit_stxi_l(sizeof(long), JIT_V1, JIT_R2);
|
||||
#else
|
||||
GC_initial_words((char *)a_words, amt);
|
||||
jit_movi_l(JIT_R2, a_words[0]);
|
||||
jit_str_l(JIT_V1, JIT_R2);
|
||||
|
||||
jit_movi_l(JIT_R2, a_words[1]);
|
||||
jit_stxi_l(sizeof(long), JIT_V1, JIT_R2);
|
||||
|
||||
/*SchemeObject header*/
|
||||
a_word = initial_tag_word(ty, immut);
|
||||
jit_movi_l(JIT_R2, a_word);
|
||||
jit_stxi_l(sizeof(long)*2, JIT_V1, JIT_R2);
|
||||
#endif
|
||||
|
||||
CHECK_LIMIT();
|
||||
__END_TINY_JUMPS__(1);
|
||||
|
|
@ -4442,7 +4461,7 @@ static int generate_alloc_double(mz_jit_state *jitter, int inline_retry)
|
|||
# ifdef CAN_INLINE_ALLOC
|
||||
inline_alloc(jitter, sizeof(Scheme_Double), scheme_double_type, 0, 0, 1, inline_retry);
|
||||
CHECK_LIMIT();
|
||||
jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
|
||||
jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
|
||||
(void)jit_stxi_d_fppop(&((Scheme_Double *)0x0)->double_val, JIT_R0, JIT_FPR0);
|
||||
# else
|
||||
(void)mz_tl_sti_d_fppop(tl_double_result, JIT_FPR0, JIT_R0);
|
||||
|
|
@ -6741,8 +6760,8 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
|
|||
inline_alloc(jitter, sizeof(Scheme_Small_Object), scheme_box_type, 0, 1, 0, 0);
|
||||
CHECK_LIMIT();
|
||||
|
||||
jit_stxi_p((long)&SCHEME_BOX_VAL(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
|
||||
jit_stxi_p((long)&SCHEME_BOX_VAL(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
|
||||
#else
|
||||
/* Non-inlined */
|
||||
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
|
||||
|
|
@ -7657,9 +7676,9 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
|
|||
inline_alloc(jitter, sizeof(Scheme_Simple_Object), scheme_mutable_pair_type, 0, 1, 0, 0);
|
||||
CHECK_LIMIT();
|
||||
|
||||
jit_stxi_p((long)&SCHEME_MCAR(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_MCDR(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
|
||||
jit_stxi_p((long)&SCHEME_MCAR(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_MCDR(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
|
||||
#else
|
||||
/* Non-inlined alloc */
|
||||
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
|
||||
|
|
@ -8087,13 +8106,13 @@ static int generate_cons_alloc(mz_jit_state *jitter, int rev, int inline_retry)
|
|||
CHECK_LIMIT();
|
||||
|
||||
if (rev) {
|
||||
jit_stxi_p((long)&SCHEME_CAR(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_stxi_p((long)&SCHEME_CDR(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_CAR(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_stxi_p((long)&SCHEME_CDR(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
} else {
|
||||
jit_stxi_p((long)&SCHEME_CAR(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_CDR(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_stxi_p((long)&SCHEME_CAR(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_CDR(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
}
|
||||
jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
|
||||
jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
|
||||
#else
|
||||
/* Non-inlined */
|
||||
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
|
||||
|
|
@ -8147,14 +8166,14 @@ static int generate_vector_alloc(mz_jit_state *jitter, Scheme_Object *rator,
|
|||
CHECK_LIMIT();
|
||||
|
||||
if ((c == 2) || (c == 1)) {
|
||||
jit_stxi_p((long)&SCHEME_VEC_ELS(0x0)[0] + GC_OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_VEC_ELS(0x0)[0] + OBJHEAD_SIZE, JIT_V1, JIT_R0);
|
||||
}
|
||||
if (c == 2) {
|
||||
jit_stxi_p((long)&SCHEME_VEC_ELS(0x0)[1] + GC_OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_stxi_p((long)&SCHEME_VEC_ELS(0x0)[1] + OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
}
|
||||
jit_movi_l(JIT_R1, c);
|
||||
jit_stxi_i((long)&SCHEME_VEC_SIZE(0x0) + GC_OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
|
||||
jit_stxi_i((long)&SCHEME_VEC_SIZE(0x0) + OBJHEAD_SIZE, JIT_V1, JIT_R1);
|
||||
jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
|
||||
#else
|
||||
/* Non-inlined */
|
||||
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
|
||||
|
|
@ -8285,12 +8304,15 @@ static int generate_flonum_local_unboxing(mz_jit_state *jitter, int push)
|
|||
static Scheme_Object example_so = { scheme_native_closure_type, 0 };
|
||||
#endif
|
||||
|
||||
static Scheme_Native_Closure_Data *create_native_lambda(Scheme_Closure_Data *data, int clear_code_after_jit,
|
||||
Scheme_Native_Closure_Data *case_lam);
|
||||
|
||||
static void ensure_closure_native(Scheme_Closure_Data *data,
|
||||
Scheme_Native_Closure_Data *case_lam)
|
||||
{
|
||||
if (!data->u.native_code || SCHEME_FALSEP((Scheme_Object *)data->u.native_code)) {
|
||||
Scheme_Native_Closure_Data *code;
|
||||
code = scheme_generate_lambda(data, 0, case_lam);
|
||||
code = create_native_lambda(data, 0, case_lam);
|
||||
data->u.native_code = code;
|
||||
}
|
||||
}
|
||||
|
|
@ -8316,7 +8338,7 @@ static int generate_closure(Scheme_Closure_Data *data,
|
|||
/* Inlined alloc */
|
||||
inline_alloc(jitter, sz, scheme_native_closure_type, 0, 0, 0, 0);
|
||||
CHECK_LIMIT();
|
||||
jit_addi_p(JIT_R0, JIT_V1, GC_OBJHEAD_SIZE);
|
||||
jit_addi_p(JIT_R0, JIT_V1, OBJHEAD_SIZE);
|
||||
} else
|
||||
# endif
|
||||
{
|
||||
|
|
@ -8404,7 +8426,7 @@ static int generate_closure_prep(Scheme_Closure_Data *data, mz_jit_state *jitter
|
|||
return retval;
|
||||
}
|
||||
|
||||
Scheme_Native_Closure_Data *scheme_generate_case_lambda(Scheme_Case_Lambda *c)
|
||||
static Scheme_Native_Closure_Data *create_native_case_lambda(Scheme_Case_Lambda *c)
|
||||
{
|
||||
Scheme_Closure_Data *data;
|
||||
Scheme_Native_Closure_Data *ndata;
|
||||
|
|
@ -8447,11 +8469,24 @@ Scheme_Native_Closure_Data *scheme_generate_case_lambda(Scheme_Case_Lambda *c)
|
|||
return ndata;
|
||||
}
|
||||
|
||||
Scheme_Native_Closure_Data *scheme_generate_case_lambda(Scheme_Case_Lambda *c)
|
||||
{
|
||||
Scheme_Native_Closure_Data *ndata;
|
||||
|
||||
BEGIN_JIT_CRITICAL_SECTION();
|
||||
|
||||
ndata = create_native_case_lambda(c);
|
||||
|
||||
END_JIT_CRITICAL_SECTION();
|
||||
|
||||
return ndata;
|
||||
}
|
||||
|
||||
static void ensure_case_closure_native(Scheme_Case_Lambda *c)
|
||||
{
|
||||
if (!c->native_code || SCHEME_FALSEP((Scheme_Object *)c->native_code)) {
|
||||
Scheme_Native_Closure_Data *ndata;
|
||||
ndata = scheme_generate_case_lambda(c);
|
||||
ndata = create_native_case_lambda(c);
|
||||
c->native_code = ndata;
|
||||
}
|
||||
}
|
||||
|
|
@ -11785,7 +11820,7 @@ static int do_generate_closure(mz_jit_state *jitter, void *_data)
|
|||
return 1;
|
||||
}
|
||||
|
||||
void scheme_on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Scheme_Object **argv)
|
||||
static void on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Scheme_Object **argv)
|
||||
{
|
||||
Scheme_Native_Closure_Data *ndata = nc->code;
|
||||
Scheme_Closure_Data *data;
|
||||
|
|
@ -11857,6 +11892,15 @@ void scheme_on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Schem
|
|||
ndata->max_let_depth = max_depth;
|
||||
}
|
||||
|
||||
void scheme_on_demand_generate_lambda(Scheme_Native_Closure *nc, int argc, Scheme_Object **argv)
|
||||
{
|
||||
BEGIN_JIT_CRITICAL_SECTION();
|
||||
|
||||
on_demand_generate_lambda(nc, argc, argv);
|
||||
|
||||
END_JIT_CRITICAL_SECTION();
|
||||
}
|
||||
|
||||
static void on_demand_with_args(Scheme_Object **in_argv)
|
||||
{
|
||||
/* On runstack: closure (nearest), argc, argv (deepest) */
|
||||
|
|
@ -11875,8 +11919,8 @@ static void on_demand()
|
|||
return on_demand_with_args(MZ_RUNSTACK);
|
||||
}
|
||||
|
||||
Scheme_Native_Closure_Data *scheme_generate_lambda(Scheme_Closure_Data *data, int clear_code_after_jit,
|
||||
Scheme_Native_Closure_Data *case_lam)
|
||||
static Scheme_Native_Closure_Data *create_native_lambda(Scheme_Closure_Data *data, int clear_code_after_jit,
|
||||
Scheme_Native_Closure_Data *case_lam)
|
||||
{
|
||||
Scheme_Native_Closure_Data *ndata;
|
||||
|
||||
|
|
@ -11910,12 +11954,26 @@ Scheme_Native_Closure_Data *scheme_generate_lambda(Scheme_Closure_Data *data, in
|
|||
|
||||
#if 0
|
||||
/* Compile immediately: */
|
||||
scheme_on_demand_generate_lambda(ndata);
|
||||
on_demand_generate_lambda(ndata);
|
||||
#endif
|
||||
|
||||
return ndata;
|
||||
}
|
||||
|
||||
Scheme_Native_Closure_Data *scheme_generate_lambda(Scheme_Closure_Data *data, int clear_code_after_jit,
|
||||
Scheme_Native_Closure_Data *case_lam)
|
||||
{
|
||||
Scheme_Native_Closure_Data *ndata;
|
||||
|
||||
BEGIN_JIT_CRITICAL_SECTION();
|
||||
|
||||
ndata = create_native_lambda(data, clear_code_after_jit, case_lam);
|
||||
|
||||
END_JIT_CRITICAL_SECTION();
|
||||
|
||||
return ndata;
|
||||
}
|
||||
|
||||
static int generate_simple_arity_check(mz_jit_state *jitter, int num_params, int has_rest, int is_method)
|
||||
{
|
||||
/* JIT_R0 is closure */
|
||||
|
|
|
|||
|
|
@ -328,11 +328,13 @@ void scheme_init_module(Scheme_Env *env)
|
|||
REGISTER_SO(empty_self_modname);
|
||||
empty_self_modidx = scheme_make_modidx(scheme_false, scheme_false, scheme_false);
|
||||
(void)scheme_hash_key(empty_self_modidx);
|
||||
#ifdef MZ_USE_PLACES
|
||||
empty_self_modname = scheme_intern_symbol("expanded module"); /* FIXME: needs to be uninterned */
|
||||
#else
|
||||
empty_self_modname = scheme_make_symbol("expanded module"); /* uninterned */
|
||||
#endif
|
||||
empty_self_modname = scheme_intern_resolved_module_path(empty_self_modname);
|
||||
}
|
||||
|
||||
|
||||
|
||||
REGISTER_SO(quote_symbol);
|
||||
REGISTER_SO(file_symbol);
|
||||
|
|
|
|||
|
|
@ -1,3 +1,6 @@
|
|||
#ifdef MZ_USE_PLACES
|
||||
if (!do_atomic)
|
||||
#endif
|
||||
SCHEME_USE_FUEL(1);
|
||||
#ifdef DO_STACK_CHECK
|
||||
{
|
||||
|
|
|
|||
|
|
@ -166,22 +166,22 @@ void *mzrt_thread_stub(void *data){
|
|||
scheme_init_os_thread();
|
||||
proc_thread_self = stub_data->thread;
|
||||
|
||||
//free(data); REMOVEME --- why does this break Mac OS X?
|
||||
free(data);
|
||||
|
||||
return start_proc(start_proc_data);
|
||||
}
|
||||
|
||||
unsigned int mz_proc_thread_self() {
|
||||
mzrt_thread_id mz_proc_thread_self() {
|
||||
#ifdef WIN32
|
||||
#error !!!mz_proc_thread_id not implemented!!!
|
||||
#else
|
||||
return (unsigned int) pthread_self();
|
||||
return pthread_self();
|
||||
#endif
|
||||
}
|
||||
|
||||
unsigned int mz_proc_thread_id(mz_proc_thread* thread) {
|
||||
mzrt_thread_id mz_proc_thread_id(mz_proc_thread* thread) {
|
||||
|
||||
return (unsigned int) thread->threadid;
|
||||
return thread->threadid;
|
||||
}
|
||||
|
||||
mz_proc_thread* mzrt_proc_first_thread_init() {
|
||||
|
|
@ -207,7 +207,6 @@ mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start start_proc, void* dat
|
|||
attr = NULL;
|
||||
#endif
|
||||
|
||||
#ifdef MZ_PRECISE_GC
|
||||
mzrt_thread_stub_data *stub_data = (mzrt_thread_stub_data*)malloc(sizeof(mzrt_thread_stub_data));
|
||||
thread->mbox = pt_mbox_create();
|
||||
stub_data->start_proc = start_proc;
|
||||
|
|
@ -218,13 +217,7 @@ mz_proc_thread* mz_proc_thread_create(mz_proc_thread_start start_proc, void* dat
|
|||
# else
|
||||
pthread_create(&thread->threadid, attr, mzrt_thread_stub, stub_data);
|
||||
# endif
|
||||
#else
|
||||
# ifdef WIN32
|
||||
thread->threadid = GC_CreateThread(NULL, 0, start_proc, data, 0, NULL);
|
||||
# else
|
||||
GC_pthread_create(&thread->threadid, attr, start_proc, data);
|
||||
# endif
|
||||
#endif
|
||||
|
||||
return thread;
|
||||
}
|
||||
|
||||
|
|
@ -361,6 +354,66 @@ int mzrt_cond_destroy(mzrt_cond *cond) {
|
|||
return pthread_cond_destroy(&cond->cond);
|
||||
}
|
||||
|
||||
struct mzrt_sema {
|
||||
int ready;
|
||||
pthread_mutex_t m;
|
||||
pthread_cond_t c;
|
||||
};
|
||||
|
||||
int mzrt_sema_create(mzrt_sema **_s, int v)
|
||||
{
|
||||
mzrt_sema *s;
|
||||
int err;
|
||||
|
||||
s = (mzrt_sema *)malloc(sizeof(mzrt_sema));
|
||||
err = pthread_mutex_init(&s->m, NULL);
|
||||
if (err) {
|
||||
free(s);
|
||||
return err;
|
||||
}
|
||||
err = pthread_cond_init(&s->c, NULL);
|
||||
if (err) {
|
||||
pthread_mutex_destroy(&s->m);
|
||||
free(s);
|
||||
return err;
|
||||
}
|
||||
s->ready = v;
|
||||
*_s = s;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
int mzrt_sema_wait(mzrt_sema *s)
|
||||
{
|
||||
pthread_mutex_lock(&s->m);
|
||||
while (!s->ready) {
|
||||
pthread_cond_wait(&s->c, &s->m);
|
||||
}
|
||||
--s->ready;
|
||||
pthread_mutex_unlock(&s->m);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
int mzrt_sema_post(mzrt_sema *s)
|
||||
{
|
||||
pthread_mutex_lock(&s->m);
|
||||
s->ready++;
|
||||
pthread_cond_signal(&s->c);
|
||||
pthread_mutex_unlock(&s->m);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
int mzrt_sema_destroy(mzrt_sema *s)
|
||||
{
|
||||
pthread_mutex_destroy(&s->m);
|
||||
pthread_cond_destroy(&s->c);
|
||||
free(s);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
/****************** PROCESS THREAD MAIL BOX *******************************/
|
||||
|
||||
pt_mbox *pt_mbox_create() {
|
||||
|
|
|
|||
|
|
@ -22,13 +22,16 @@ void mzrt_set_user_break_handler(void (*user_break_handler)(int));
|
|||
|
||||
|
||||
/****************** PROCESS WEIGHT THREADS ********************************/
|
||||
/* mzrt_threads.c */
|
||||
typedef struct mz_proc_thread {
|
||||
|
||||
#ifdef WIN32
|
||||
HANDLE threadid;
|
||||
typedef HANDLE mzrt_thread_id;
|
||||
#else
|
||||
pthread_t threadid;
|
||||
typedef pthread_t mzrt_thread_id;
|
||||
#endif
|
||||
|
||||
|
||||
typedef struct mz_proc_thread {
|
||||
mzrt_thread_id threadid;
|
||||
struct pt_mbox *mbox;
|
||||
} mz_proc_thread;
|
||||
|
||||
|
|
@ -46,8 +49,8 @@ int mz_proc_thread_detach(mz_proc_thread *thread);
|
|||
|
||||
void mzrt_sleep(int seconds);
|
||||
|
||||
unsigned int mz_proc_thread_self();
|
||||
unsigned int mz_proc_thread_id(mz_proc_thread* thread);
|
||||
mzrt_thread_id mz_proc_thread_self();
|
||||
mzrt_thread_id mz_proc_thread_id(mz_proc_thread* thread);
|
||||
|
||||
/****************** THREAD RWLOCK ******************************************/
|
||||
/* mzrt_rwlock_*.c */
|
||||
|
|
@ -77,6 +80,13 @@ int mzrt_cond_signal(mzrt_cond *cond);
|
|||
int mzrt_cond_broadcast(mzrt_cond *cond);
|
||||
int mzrt_cond_destroy(mzrt_cond *cond);
|
||||
|
||||
/****************** THREAD SEMA ******************************************/
|
||||
typedef struct mzrt_sema mzrt_sema; /* OPAQUE DEFINITION */
|
||||
int mzrt_sema_create(mzrt_sema **sema, int init);
|
||||
int mzrt_sema_post(mzrt_sema *sema);
|
||||
int mzrt_sema_wait(mzrt_sema *sema);
|
||||
int mzrt_sema_destroy(mzrt_sema *sema);
|
||||
|
||||
/****************** PROCESS THREAD MAIL BOX *******************************/
|
||||
typedef struct pt_mbox_msg {
|
||||
int type;
|
||||
|
|
|
|||
|
|
@ -15,8 +15,6 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]);
|
|||
static Scheme_Object *scheme_place_wait(int argc, Scheme_Object *args[]);
|
||||
static Scheme_Object *scheme_place_sleep(int argc, Scheme_Object *args[]);
|
||||
static Scheme_Object *scheme_place_p(int argc, Scheme_Object *args[]);
|
||||
static void load_namespace(char *namespace_name);
|
||||
static void load_namespace_utf8(Scheme_Object *namespace_name);
|
||||
static Scheme_Object *scheme_places_deep_copy_in_master(Scheme_Object *so);
|
||||
|
||||
# ifdef MZ_PRECISE_GC
|
||||
|
|
@ -57,7 +55,7 @@ void scheme_init_place(Scheme_Env *env)
|
|||
|
||||
plenv = scheme_primitive_module(scheme_intern_symbol("#%place"), env);
|
||||
|
||||
PLACE_PRIM_W_ARITY("place", scheme_place, 1, 3, plenv);
|
||||
PLACE_PRIM_W_ARITY("place", scheme_place, 3, 3, plenv);
|
||||
PLACE_PRIM_W_ARITY("place-sleep", scheme_place_sleep, 1, 1, plenv);
|
||||
PLACE_PRIM_W_ARITY("place-wait", scheme_place_wait, 1, 1, plenv);
|
||||
PLACE_PRIM_W_ARITY("place?", scheme_place_p, 1, 1, plenv);
|
||||
|
|
@ -71,15 +69,14 @@ void scheme_init_place(Scheme_Env *env)
|
|||
/************************************************************************/
|
||||
/************************************************************************/
|
||||
|
||||
/* FIXME this struct probably will need to be garbage collected as stuff
|
||||
* is added to it */
|
||||
typedef struct Place_Start_Data {
|
||||
int argc;
|
||||
Scheme_Object *thunk;
|
||||
/* Allocated as array of objects, so all
|
||||
field must be pointers */
|
||||
Scheme_Object *module;
|
||||
Scheme_Object *function;
|
||||
Scheme_Object *channel;
|
||||
Scheme_Object *current_library_collection_paths;
|
||||
mzrt_sema *ready;
|
||||
} Place_Start_Data;
|
||||
|
||||
static void null_out_runtime_globals() {
|
||||
|
|
@ -103,31 +100,35 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
|
|||
Place_Start_Data *place_data;
|
||||
mz_proc_thread *proc_thread;
|
||||
Scheme_Object *collection_paths;
|
||||
mzrt_sema *ready;
|
||||
|
||||
/* create place object */
|
||||
place = MALLOC_ONE_TAGGED(Scheme_Place);
|
||||
place->so.type = scheme_place_type;
|
||||
|
||||
mzrt_sema_create(&ready, 0);
|
||||
|
||||
/* pass critical info to new place */
|
||||
place_data = MALLOC_ONE(Place_Start_Data);
|
||||
place_data->argc = argc;
|
||||
if (argc == 1) {
|
||||
place_data->thunk = args[0];
|
||||
}
|
||||
else if (argc == 3 ) {
|
||||
place_data->module = args[0];
|
||||
place_data->function = args[1];
|
||||
place_data->channel = args[2];
|
||||
}
|
||||
else {
|
||||
scheme_wrong_count_m("place", 1, 2, argc, args, 0);
|
||||
}
|
||||
|
||||
place_data->module = args[0];
|
||||
place_data->function = args[1];
|
||||
place_data->channel = args[2];
|
||||
place_data->ready = ready;
|
||||
|
||||
collection_paths = scheme_current_library_collection_paths(0, NULL);
|
||||
collection_paths = scheme_places_deep_copy_in_master(collection_paths);
|
||||
place_data->current_library_collection_paths = collection_paths;
|
||||
|
||||
/* create new place */
|
||||
proc_thread = mz_proc_thread_create(place_start_proc, place_data);
|
||||
|
||||
/* wait until the place has started and grabbed the value
|
||||
from `place_data'; it's important that a GC doesn't happen
|
||||
here until the other place is far enough. */
|
||||
mzrt_sema_wait(ready);
|
||||
mzrt_sema_destroy(ready);
|
||||
|
||||
place->proc_thread = proc_thread;
|
||||
|
||||
return (Scheme_Object*) place;
|
||||
|
|
@ -345,29 +346,6 @@ static Scheme_Object *scheme_place_p(int argc, Scheme_Object *args[])
|
|||
return SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_type) ? scheme_true : scheme_false;
|
||||
}
|
||||
|
||||
static void load_namespace(char *namespace_name) {
|
||||
load_namespace_utf8( scheme_make_utf8_string(namespace_name));
|
||||
}
|
||||
|
||||
static void load_namespace_utf8(Scheme_Object *namespace_name) {
|
||||
Scheme_Object *nsreq;
|
||||
Scheme_Object *a[1];
|
||||
Scheme_Thread * volatile p;
|
||||
mz_jmp_buf * volatile saved_error_buf;
|
||||
mz_jmp_buf new_error_buf;
|
||||
|
||||
nsreq = scheme_builtin_value("namespace-require");
|
||||
a[0] = scheme_make_pair(scheme_intern_symbol("lib"),
|
||||
scheme_make_pair(namespace_name, scheme_make_null()));
|
||||
|
||||
p = scheme_get_current_thread();
|
||||
saved_error_buf = p->error_buf;
|
||||
p->error_buf = &new_error_buf;
|
||||
if (!scheme_setjmp(new_error_buf))
|
||||
scheme_apply(nsreq, 1, a);
|
||||
p->error_buf = saved_error_buf;
|
||||
}
|
||||
|
||||
Scheme_Object *scheme_places_deep_copy(Scheme_Object *so)
|
||||
{
|
||||
Scheme_Object *new_so = so;
|
||||
|
|
@ -386,10 +364,11 @@ Scheme_Object *scheme_places_deep_copy(Scheme_Object *so)
|
|||
new_so = scheme_make_sized_offset_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
|
||||
break;
|
||||
case scheme_symbol_type:
|
||||
{
|
||||
Scheme_Symbol *sym = (Scheme_Symbol *)so;
|
||||
new_so = scheme_intern_exact_symbol(sym->s, sym->len);
|
||||
}
|
||||
if (SCHEME_SYM_UNINTERNEDP(so)) {
|
||||
scheme_log_abort("cannot copy uninterned symbol");
|
||||
abort();
|
||||
} else
|
||||
new_so = so;
|
||||
break;
|
||||
case scheme_pair_type:
|
||||
{
|
||||
|
|
@ -406,9 +385,8 @@ Scheme_Object *scheme_places_deep_copy(Scheme_Object *so)
|
|||
new_so = so;
|
||||
break;
|
||||
case scheme_resolved_module_path_type:
|
||||
abort();
|
||||
break;
|
||||
default:
|
||||
scheme_log_abort("cannot copy object");
|
||||
abort();
|
||||
break;
|
||||
}
|
||||
|
|
@ -417,15 +395,16 @@ Scheme_Object *scheme_places_deep_copy(Scheme_Object *so)
|
|||
|
||||
static void *place_start_proc(void *data_arg) {
|
||||
void *stack_base;
|
||||
Scheme_Object *thunk;
|
||||
Place_Start_Data *place_data;
|
||||
Scheme_Object *a[2];
|
||||
int ptid;
|
||||
Scheme_Object *place_main;
|
||||
Scheme_Object *a[2], *channel;
|
||||
mzrt_thread_id ptid;
|
||||
long rc = 0;
|
||||
ptid = mz_proc_thread_self();
|
||||
|
||||
|
||||
stack_base = PROMPT_STACK(stack_base);
|
||||
place_data = (Place_Start_Data *) data_arg;
|
||||
data_arg = NULL;
|
||||
|
||||
/* printf("Startin place: proc thread id%u\n", ptid); */
|
||||
|
||||
|
|
@ -438,41 +417,37 @@ static void *place_start_proc(void *data_arg) {
|
|||
a[0] = place_data->current_library_collection_paths;
|
||||
scheme_current_library_collection_paths(1, a);
|
||||
|
||||
a[0] = scheme_places_deep_copy(place_data->module);
|
||||
a[1] = scheme_places_deep_copy(place_data->function);
|
||||
channel = scheme_places_deep_copy(place_data->channel);
|
||||
|
||||
mzrt_sema_post(place_data->ready);
|
||||
place_data = NULL;
|
||||
/* at point point, don't refer to place_data or its content
|
||||
anymore, because it's allocated in the other place */
|
||||
|
||||
if (place_data->argc == 1)
|
||||
{
|
||||
load_namespace("scheme/init");
|
||||
thunk = place_data->thunk;
|
||||
scheme_apply(thunk, 0, NULL);
|
||||
stack_base = NULL;
|
||||
} else {
|
||||
Scheme_Object *place_main;
|
||||
a[0] = scheme_places_deep_copy(place_data->module);
|
||||
a[1] = scheme_places_deep_copy(place_data->function);
|
||||
Scheme_Thread * volatile p;
|
||||
mz_jmp_buf * volatile saved_error_buf;
|
||||
mz_jmp_buf new_error_buf;
|
||||
|
||||
{
|
||||
Scheme_Thread * volatile p;
|
||||
mz_jmp_buf * volatile saved_error_buf;
|
||||
mz_jmp_buf new_error_buf;
|
||||
|
||||
p = scheme_get_current_thread();
|
||||
saved_error_buf = p->error_buf;
|
||||
p->error_buf = &new_error_buf;
|
||||
if (!scheme_setjmp(new_error_buf)) {
|
||||
place_main = scheme_dynamic_require(2, a);
|
||||
a[0] = scheme_places_deep_copy(place_data->channel);
|
||||
scheme_apply(place_main, 1, a);
|
||||
}
|
||||
else {
|
||||
rc = 1;
|
||||
}
|
||||
p->error_buf = saved_error_buf;
|
||||
p = scheme_get_current_thread();
|
||||
saved_error_buf = p->error_buf;
|
||||
p->error_buf = &new_error_buf;
|
||||
if (!scheme_setjmp(new_error_buf)) {
|
||||
place_main = scheme_dynamic_require(2, a);
|
||||
a[0] = channel;
|
||||
scheme_apply(place_main, 1, a);
|
||||
}
|
||||
|
||||
/*printf("Leavin place: proc thread id%u\n", ptid);*/
|
||||
scheme_place_instance_destroy();
|
||||
else {
|
||||
rc = 1;
|
||||
}
|
||||
p->error_buf = saved_error_buf;
|
||||
}
|
||||
|
||||
/*printf("Leavin place: proc thread id%u\n", ptid);*/
|
||||
scheme_place_instance_destroy();
|
||||
|
||||
return (void*) rc;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -550,11 +550,6 @@ scheme_init_port (Scheme_Env *env)
|
|||
}
|
||||
#endif
|
||||
|
||||
scheme_init_port_places();
|
||||
|
||||
flush_out = SCHEME_TRUEP(scheme_terminal_port_p(1, &scheme_orig_stdout_port));
|
||||
flush_err = SCHEME_TRUEP(scheme_terminal_port_p(1, &scheme_orig_stderr_port));
|
||||
|
||||
#ifdef MZ_FDS
|
||||
scheme_add_atexit_closer(flush_if_output_fds);
|
||||
/* Note: other threads might continue to write even after
|
||||
|
|
@ -653,6 +648,9 @@ void scheme_init_port_places(void)
|
|||
}
|
||||
# endif
|
||||
#endif
|
||||
|
||||
flush_out = SCHEME_TRUEP(scheme_terminal_port_p(1, &scheme_orig_stdout_port));
|
||||
flush_err = SCHEME_TRUEP(scheme_terminal_port_p(1, &scheme_orig_stderr_port));
|
||||
}
|
||||
|
||||
void scheme_init_port_config(void)
|
||||
|
|
|
|||
|
|
@ -184,7 +184,7 @@ static void macosx_get_thread_local_key_for_assembly_code() {
|
|||
the Go implementation (see "http://golang.org/src/libcgo/darwin_386.c").
|
||||
In brief, we assume that thread-local variables are going to be
|
||||
accessed via the gs segment register at offset 0x48 (i386) or 0x60 (x86_64),
|
||||
and we also hardwire the therad-local key 0x108. Here we have to try to get
|
||||
and we also hardwire the thread-local key 0x108. Here we have to try to get
|
||||
that particular key and double-check that it worked. */
|
||||
pthread_key_t unwanted[16];
|
||||
int num_unwanted = 0;
|
||||
|
|
|
|||
|
|
@ -232,6 +232,9 @@ void scheme_init_dynamic_extension(Scheme_Env *env);
|
|||
#ifndef NO_REGEXP_UTILS
|
||||
extern void scheme_regexp_initialize(Scheme_Env *env);
|
||||
#endif
|
||||
#ifdef MZ_USE_JIT
|
||||
void scheme_init_jit(void);
|
||||
#endif
|
||||
void scheme_init_memtrace(Scheme_Env *env);
|
||||
void scheme_init_parameterization_readonly_globals();
|
||||
void scheme_init_parameterization(Scheme_Env *env);
|
||||
|
|
|
|||
|
|
@ -120,8 +120,8 @@ extern void scheme_gmp_tls_restore_snapshot(long *s, void *data, long *save, int
|
|||
static void check_ready_break();
|
||||
|
||||
extern int scheme_num_read_syntax_objects;
|
||||
extern long scheme_hash_request_count;
|
||||
extern long scheme_hash_iteration_count;
|
||||
THREAD_LOCAL_DECL(extern long scheme_hash_request_count);
|
||||
THREAD_LOCAL_DECL(extern long scheme_hash_iteration_count);
|
||||
#ifdef MZ_USE_JIT
|
||||
extern int scheme_jit_malloced;
|
||||
#else
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user