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

add GC-stress mode

Browse Source 
Stress mode forces a GC on every N allocation attempts, and it makes
JIT-generated code always take a slow path.

This mode uncovered only a bad test case and some boring start-up
bugs (boring because start-up is deterministic enough that they
never happen), so far.
This commit is contained in:
Matthew Flatt 2013-05-01 12:59:58 -06:00
parent 93b1f3ef2c
commit 61ca229a57
11 changed files with 889 additions and 848 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/racket/basic.rktl
View File

@ -2471,7 +2471,7 @@
(define ht2 (make-hash))
(define wht (make-weak-hash))
(define wht2 (make-weak-hash))
(define keys (make-hash))
(define keys (make-hasheq))
(struct a (x) #:transparent)
@ -2519,7 +2519,11 @@
[ht2 (for/hash ([i (in-list l2)])
(values (a i) (a (a i))))])
(test (equal-hash-code ht) values (equal-hash-code ht2))
(test (equal-secondary-hash-code ht) values (equal-secondary-hash-code ht2))))
(test (equal-secondary-hash-code ht) values (equal-secondary-hash-code ht2)))
;; make sure `key's is retained until here:
(when (positive? (random 1))
(display keys)))
;; Check that immutable hash trees aren't confused by an
;; "is a list" bit set in a key:

47
src/racket/gc2/newgc.c
View File

@ -1212,6 +1212,19 @@ inline static void gen0_free_mpage(NewGC *gc, mpage *page) {
}
#define OVERFLOWS_GEN0(ptr) ((ptr) > GC_gen0_alloc_page_end)
#ifdef MZ_GC_STRESS_TESTING
# define GC_TRIGGER_COUNT 100
static int stress_counter = 0;
static int TAKE_SLOW_PATH()
{
stress_counter++;
if (stress_counter > GC_TRIGGER_COUNT)
return 1;
return 0;
}
#else
# define TAKE_SLOW_PATH() 0
#endif
inline static size_t gen0_size_in_use(NewGC *gc) {
return (gc->gen0.current_size + ((GC_gen0_alloc_page_ptr - NUM(gc->gen0.curr_alloc_page->addr)) - PREFIX_SIZE));
@ -1246,7 +1259,7 @@ inline static void gen0_allocate_and_setup_new_page(NewGC *gc) {
inline static uintptr_t allocate_slowpath(NewGC *gc, size_t allocate_size, uintptr_t newptr)
{
do {
/* master always overflows and uses allocate_medium because master allocations can't move */
/* master always overflows and uses allocate_medium(), because master allocations can't move */
/* bring page size used up to date */
gen0_sync_page_size_from_globals(gc);
@ -1257,12 +1270,12 @@ inline static uintptr_t allocate_slowpath(NewGC *gc, size_t allocate_size, uintp
ASSERT_VALID_INFOPTR(GC_gen0_alloc_page_ptr);
GC_gen0_alloc_page_end = NUM(gc->gen0.curr_alloc_page->addr) + GEN0_ALLOC_SIZE(gc->gen0.curr_alloc_page);
}
/* WARNING: tries to avoid a collection but
* gen0_create_new_mpage can cause a collection via malloc_pages due to check_used_against_max */
/* WARNING: tries to avoid a collection, but
gen0_create_new_mpage() can cause a collection via
malloc_pages(), due to check_used_against_max() */
else if (gc->dumping_avoid_collection) {
gen0_allocate_and_setup_new_page(gc);
}
else {
} else {
#ifdef INSTRUMENT_PRIMITIVES
LOG_PRIM_START(((void*)garbage_collect));
#endif
@ -1301,6 +1314,17 @@ inline static void *allocate(const size_t request_size, const int type)
size_t allocate_size;
uintptr_t newptr;
#ifdef MZ_GC_STRESS_TESTING
stress_counter++;
if (stress_counter > GC_TRIGGER_COUNT) {
NewGC *gc = GC_get_GC();
if (!gc->dumping_avoid_collection) {
stress_counter = 0;
garbage_collect(gc, 0, 0, NULL);
}
}
#endif
if(request_size == 0) return (void *) zero_sized;
check_allocation_time_invariants();
@ -1312,7 +1336,7 @@ inline static void *allocate(const size_t request_size, const int type)
newptr = GC_gen0_alloc_page_ptr + allocate_size;
/* SLOW PATH: allocate_size overflows current gen0 page */
if(OVERFLOWS_GEN0(newptr)) {
if(TAKE_SLOW_PATH() || OVERFLOWS_GEN0(newptr)) {
NewGC *gc = GC_get_GC();
if (GC_gen0_alloc_only) return NULL;
@ -1360,7 +1384,7 @@ inline static void *fast_malloc_one_small_tagged(size_t request_size, int dirty)
newptr = GC_gen0_alloc_page_ptr + allocate_size;
if(OVERFLOWS_GEN0(newptr)) {
if (TAKE_SLOW_PATH() || OVERFLOWS_GEN0(newptr)) {
return GC_malloc_one_tagged(request_size);
} else {
objhead *info = (objhead *)PTR(GC_gen0_alloc_page_ptr);
@ -1395,7 +1419,7 @@ void *GC_malloc_pair(void *car, void *cdr)
newptr = GC_gen0_alloc_page_ptr + allocate_size;
if(OVERFLOWS_GEN0(newptr)) {
if (TAKE_SLOW_PATH() || OVERFLOWS_GEN0(newptr)) {
NewGC *gc = GC_get_GC();
gc->park[0] = car;
gc->park[1] = cdr;
@ -1407,8 +1431,7 @@ void *GC_malloc_pair(void *car, void *cdr)
/* Future-local allocation can fail: */
if (!pair) return NULL;
}
else {
} else {
objhead *info = (objhead *) PTR(GC_gen0_alloc_page_ptr);
GC_gen0_alloc_page_ptr = newptr;
ASSERT_VALID_INFOPTR(GC_gen0_alloc_page_ptr);
@ -2889,8 +2912,6 @@ void GC_destruct_child_gc() {
GC_LOCK_DEBUG("UNMGCLOCK GC_destruct_child_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
if (waiting) {
garbage_collect(gc, 1, 0, NULL);
waiting = 1;
@ -4798,10 +4819,12 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master, Log
#ifdef MZ_USE_PLACES
is_master = (gc == MASTERGC);
#endif
gc->dumping_avoid_collection++;
gc->GC_collect_inform_callback(is_master, gc->gc_full,
old_mem_use + old_gen0, gc->memory_in_use,
old_mem_allocated, mmu_memory_allocated(gc->mmu),
gc->child_gc_total);
--gc->dumping_avoid_collection;
}
#ifdef MZ_USE_PLACES
if (lmi) {

1558
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

8
src/racket/src/env.c
View File

@ -466,6 +466,8 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
printf("pre-process @ %" PRIdPTR "\n", scheme_get_process_milliseconds());
#endif
scheme_init_file_places();
scheme_make_thread(stack_base);
#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
@ -503,7 +505,6 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
scheme_init_gmp_places();
scheme_init_kqueue();
scheme_alloc_global_fdset();
scheme_init_file_places();
#ifndef DONT_USE_FOREIGN
scheme_init_foreign_places();
#endif
@ -672,13 +673,16 @@ static void make_kernel_env(void)
MZTIMEIT(bool, scheme_init_bool(env));
MZTIMEIT(syntax, scheme_init_compile(env));
MZTIMEIT(eval, scheme_init_eval(env));
MZTIMEIT(error, scheme_init_error(env));
MZTIMEIT(struct, scheme_init_struct(env));
MZTIMEIT(error, scheme_init_error(env));
#ifndef NO_SCHEME_EXNS
MZTIMEIT(exn, scheme_init_exn(env));
#endif
MZTIMEIT(process, scheme_init_thread(env));
scheme_init_port_wait();
scheme_init_inspector();
scheme_init_logger_wait();
scheme_init_struct_wait();
MZTIMEIT(reduced, scheme_init_reduced_proc_struct(env));
#ifndef NO_SCHEME_THREADS
MZTIMEIT(sema, scheme_init_sema(env));

7
src/racket/src/error.c
View File

@ -728,8 +728,6 @@ void scheme_init_error(Scheme_Env *env)
GLOBAL_PARAMETER("current-logger", current_logger, MZCONFIG_LOGGER, env);
scheme_add_evt(scheme_log_reader_type, (Scheme_Ready_Fun)log_reader_get, NULL, NULL, 1);
REGISTER_SO(scheme_def_exit_proc);
REGISTER_SO(default_display_handler);
REGISTER_SO(emergency_display_handler);
@ -777,6 +775,11 @@ void scheme_init_error(Scheme_Env *env)
1, 1);
}
void scheme_init_logger_wait()
{
scheme_add_evt(scheme_log_reader_type, (Scheme_Ready_Fun)log_reader_get, NULL, NULL, 1);
}
void scheme_init_logger()
{
REGISTER_SO(scheme_main_logger);

14
src/racket/src/future.c
View File

@ -608,11 +608,18 @@ void futures_init(void)
fs->pool_threads = ftss;
fs->thread_pool_size = pool_size;
mzrt_mutex_create(&fs->future_mutex);
mzrt_sema_create(&fs->future_pending_sema, 0);
mzrt_sema_create(&fs->gc_ok_c, 0);
mzrt_sema_create(&fs->gc_done_c, 0);
fs->gc_counter_ptr = &scheme_did_gc_count;
/* Create a 'dummy' FTS for the RT thread */
rt_fts = alloc_future_thread_state();
rt_fts->is_runtime_thread = 1;
rt_fts->gen0_size = 1;
scheme_future_thread_state = rt_fts;
scheme_add_swap_callback(set_fts_thread, scheme_false);
set_fts_thread(scheme_false);
@ -625,13 +632,6 @@ void futures_init(void)
REGISTER_SO(fs->fevent_prefab);
REGISTER_SO(jit_future_storage);
mzrt_mutex_create(&fs->future_mutex);
mzrt_sema_create(&fs->future_pending_sema, 0);
mzrt_sema_create(&fs->gc_ok_c, 0);
mzrt_sema_create(&fs->gc_done_c, 0);
fs->gc_counter_ptr = &scheme_did_gc_count;
hand = scheme_get_signal_handle();
fs->signal_handle = hand;

9
src/racket/src/jitalloc.c
View File

@ -126,17 +126,26 @@ int scheme_inline_alloc(mz_jit_state *jitter, int amt, Scheme_Type ty, int flags
Save FP0 when FP ops are enabled. */
{
GC_CAN_IGNORE jit_insn *ref, *reffail;
#ifdef MZ_GC_STRESS_TESTING
GC_CAN_IGNORE jit_insn *refstress;
#endif
intptr_t a_word, sz, algn;
sz = GC_compute_alloc_size(amt);
algn = GC_alloc_alignment();
__START_TINY_JUMPS__(1);
#ifdef MZ_GC_STRESS_TESTING
refstress = jit_jmpi(jit_forward());
#endif
reffail = jit_get_ip();
mz_tl_ldi_p(JIT_V1, tl_GC_gen0_alloc_page_ptr);
jit_subi_l(JIT_R2, JIT_V1, 1);
jit_andi_l(JIT_R2, JIT_R2, (algn - 1));
ref = jit_blti_l(jit_forward(), JIT_R2, (algn - sz));
#ifdef MZ_GC_STRESS_TESTING
mz_patch_ucbranch(refstress);
#endif
CHECK_LIMIT();
__END_TINY_JUMPS__(1);

10
src/racket/src/port.c
View File

@ -606,8 +606,6 @@ scheme_init_port (Scheme_Env *env)
}
#endif
register_port_wait();
scheme_add_global_constant("subprocess", scheme_make_prim_w_arity2(subprocess, "subprocess", 4, -1, 4, 4), env);
scheme_add_global_constant("subprocess-status", scheme_make_prim_w_arity(subprocess_status, "subprocess-status", 1, 1), env);
scheme_add_global_constant("subprocess-kill", scheme_make_prim_w_arity(subprocess_kill, "subprocess-kill", 2, 2), env);
@ -618,9 +616,13 @@ scheme_init_port (Scheme_Env *env)
GLOBAL_PARAMETER("subprocess-group-enabled", subproc_group_on, MZCONFIG_SUBPROC_GROUP_ENABLED, env);
GLOBAL_PARAMETER("current-subprocess-custodian-mode", current_subproc_cust_mode, MZCONFIG_SUBPROC_CUSTODIAN_MODE, env);
register_subprocess_wait();
scheme_add_global_constant("shell-execute", scheme_make_prim_w_arity(sch_shell_execute, "shell-execute", 5, 5), env);
}
void scheme_init_port_wait()
{
register_port_wait();
register_subprocess_wait();
scheme_add_evt(scheme_progress_evt_type, (Scheme_Ready_Fun)progress_evt_ready, NULL, NULL, 1);
scheme_add_evt(scheme_write_evt_type, (Scheme_Ready_Fun)rw_evt_ready, rw_evt_wakeup, NULL, 1);

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

@ -262,6 +262,9 @@ void scheme_init_optimize();
void scheme_init_resolve();
void scheme_init_sfs();
void scheme_init_validate();
void scheme_init_port_wait();
void scheme_init_logger_wait();
void scheme_init_struct_wait();
void scheme_init_list(Scheme_Env *env);
void scheme_init_unsafe_list(Scheme_Env *env);
void scheme_init_stx(Scheme_Env *env);

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.3.4.6"
#define MZSCHEME_VERSION "5.3.4.7"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 4
#define MZSCHEME_VERSION_W 6
#define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

69
src/racket/src/struct.c
View File

@ -376,15 +376,6 @@ scheme_init_struct (Scheme_Env *env)
evt_property = scheme_make_struct_type_property_w_guard(scheme_intern_symbol("evt"),
guard);
scheme_add_global_constant("prop:evt", evt_property, env);
scheme_add_evt(scheme_structure_type,
(Scheme_Ready_Fun)evt_struct_is_ready,
NULL,
is_evt_struct, 1);
scheme_add_evt(scheme_proc_struct_type,
(Scheme_Ready_Fun)evt_struct_is_ready,
NULL,
is_evt_struct, 1);
}
{
@ -521,30 +512,6 @@ scheme_init_struct (Scheme_Env *env)
scheme_display_symbol = scheme_intern_symbol("display");
scheme_write_special_symbol = scheme_intern_symbol("write-special");
scheme_add_evt(scheme_wrap_evt_type,
(Scheme_Ready_Fun)wrapped_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_handle_evt_type,
(Scheme_Ready_Fun)wrapped_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_chaperone_type,
(Scheme_Ready_Fun)chaperone_evt_is_ready,
NULL,
is_chaperone_evt, 1);
scheme_add_evt(scheme_proc_chaperone_type,
(Scheme_Ready_Fun)chaperone_evt_is_ready,
NULL,
is_chaperone_evt, 1);
scheme_add_evt(scheme_nack_guard_evt_type,
(Scheme_Ready_Fun)nack_guard_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_nack_evt_type,
(Scheme_Ready_Fun)nack_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_poll_evt_type,
(Scheme_Ready_Fun)poll_evt_is_ready,
NULL, NULL, 1);
/*** basic interface ****/
REGISTER_SO(scheme_make_struct_type_proc);
@ -861,6 +828,42 @@ scheme_init_struct (Scheme_Env *env)
}
}
void scheme_init_struct_wait()
{
scheme_add_evt(scheme_structure_type,
(Scheme_Ready_Fun)evt_struct_is_ready,
NULL,
is_evt_struct, 1);
scheme_add_evt(scheme_proc_struct_type,
(Scheme_Ready_Fun)evt_struct_is_ready,
NULL,
is_evt_struct, 1);
scheme_add_evt(scheme_wrap_evt_type,
(Scheme_Ready_Fun)wrapped_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_handle_evt_type,
(Scheme_Ready_Fun)wrapped_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_chaperone_type,
(Scheme_Ready_Fun)chaperone_evt_is_ready,
NULL,
is_chaperone_evt, 1);
scheme_add_evt(scheme_proc_chaperone_type,
(Scheme_Ready_Fun)chaperone_evt_is_ready,
NULL,
is_chaperone_evt, 1);
scheme_add_evt(scheme_nack_guard_evt_type,
(Scheme_Ready_Fun)nack_guard_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_nack_evt_type,
(Scheme_Ready_Fun)nack_evt_is_ready,
NULL, NULL, 1);
scheme_add_evt(scheme_poll_evt_type,
(Scheme_Ready_Fun)poll_evt_is_ready,
NULL, NULL, 1);
}
/*========================================================================*/
/* inspectors */
/*========================================================================*/