diff --git a/src/mzscheme/gc2/README b/src/mzscheme/gc2/README index 54e6e9daeb..4250dc0d41 100644 --- a/src/mzscheme/gc2/README +++ b/src/mzscheme/gc2/README @@ -83,7 +83,8 @@ MzScheme allocates the following kinds of memory objects: Note that a two-space copying collector might use only the fixup operation, while a non-moving collector might use only the mark - operation. + operation. However, MzScheme currently relies on at least fixup + calls for scheme_runstack_rt-tagged objects. * Atomic - The allocated object contains no pointers to other allocated objects. diff --git a/src/mzscheme/gc2/compact.c b/src/mzscheme/gc2/compact.c index 8003f29410..c8ecaa9011 100644 --- a/src/mzscheme/gc2/compact.c +++ b/src/mzscheme/gc2/compact.c @@ -440,7 +440,7 @@ static int just_checking, the_size; #if defined(OS_X) # if GENERATIONS -static void designate_modified(void *p); +static int designate_modified(void *p); # endif # define TEST 0 @@ -3920,6 +3920,11 @@ void *GC_malloc_allow_interior(size_t size_in_bytes) return malloc_bigblock(size_in_bytes, MTYPE_ARRAY, 1); } +void *GC_malloc_tagged_allow_interior(size_t size_in_bytes) +{ + return malloc_bigblock(size_in_bytes, MTYPE_TAGGED, 1); +} + void *GC_malloc_array_tagged(size_t size_in_bytes) { return malloc_untagged(size_in_bytes, MTYPE_TAGGED_ARRAY, &tagged_array); diff --git a/src/mzscheme/gc2/gc2.h b/src/mzscheme/gc2/gc2.h index 03a5663f4f..82b6d4e655 100644 --- a/src/mzscheme/gc2/gc2.h +++ b/src/mzscheme/gc2/gc2.h @@ -179,6 +179,10 @@ GC2_EXTERN void *GC_malloc_allow_interior(size_t size_in_bytes); pointers into the middle of the array, or just past the end of the array. */ +GC2_EXTERN void *GC_malloc_tagged_allow_interior(size_t size_in_bytes); +/* + Like GC_malloc_allow_interior(), but for a tagged object. */ + GC2_EXTERN void *GC_malloc_weak_array(size_t size_in_bytes, void *replace_val); /* Alloc an array of weak pointers, initially zeroed. When a value in diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index a623e0ef7c..027aa6b4b3 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -510,6 +510,7 @@ void *GC_malloc_array_tagged(size_t s) { return allocate(s, PAGE_TARRAY); } void *GC_malloc_atomic(size_t s) { return allocate(s, PAGE_ATOMIC); } void *GC_malloc_atomic_uncollectable(size_t s) { return malloc(s); } void *GC_malloc_allow_interior(size_t s) {return allocate_big(s, PAGE_ARRAY);} +void *GC_malloc_tagged_allow_interior(size_t s) {return allocate_big(s, PAGE_TAGGED);} void GC_free(void *p) {} void *GC_malloc_one_small_tagged(size_t sizeb) diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 2a38b56752..cda1c5dbb7 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -716,16 +716,16 @@ void *scheme_enlarge_runstack(long size, void *(*k)()) size = 1000; } - p->runstack_saved = saved; if (p->spare_runstack && (size <= p->spare_runstack_size)) { size = p->spare_runstack_size; MZ_RUNSTACK_START = p->spare_runstack; p->spare_runstack = NULL; } else { - MZ_RUNSTACK_START = scheme_malloc_allow_interior(sizeof(Scheme_Object*) * size); + MZ_RUNSTACK_START = scheme_alloc_runstack(size); } p->runstack_size = size; MZ_RUNSTACK = MZ_RUNSTACK_START + size; + p->runstack_saved = saved; cont_count = scheme_cont_capture_count; diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 65c551f686..a44270f23a 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -4277,7 +4277,7 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr MZ_MARK_STACK_TYPE copied_cms = 0; Scheme_Object **mv, *sub_conts = NULL; int mc; - + if (SAME_OBJ(result, SCHEME_MULTIPLE_VALUES)) { /* Get values out before GC */ mv = p->ku.multiple.array; @@ -4349,6 +4349,7 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr mc = cont->meta_continuation; p->meta_continuation = mc; } + if (shortcut_prompt) { /* In shortcut mode, we need to preserve saved runstacks that were pruned when capturing the continuation. */ @@ -4370,14 +4371,19 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr p->runstack_saved = rs; } else p->runstack_saved = cont->runstack_saved; + MZ_RUNSTACK_START = cont->runstack_start; p->runstack_size = cont->runstack_size; scheme_restore_env_stack_w_thread(cont->ss, p); if (p->runstack_owner - && (*p->runstack_owner == p)) + && (*p->runstack_owner == p)) { *p->runstack_owner = NULL; + } + + if (resume) + p->meta_prompt = NULL; /* in case there's a GC before we can set it */ p->runstack_owner = cont->runstack_owner; if (p->runstack_owner && (*p->runstack_owner != p)) { diff --git a/src/mzscheme/src/mkmark.ss b/src/mzscheme/src/mkmark.ss index 7fe6d00c2d..267d0220b7 100644 --- a/src/mzscheme/src/mkmark.ss +++ b/src/mzscheme/src/mkmark.ss @@ -6,6 +6,8 @@ (define re:mark "^ mark:") (define re:size "^ size:") +(define re:size-or-more "^ (?:size|more):") +(define re:fixup-start "^ fixup:") (define re:close "^}") (define re:const-size (regexp "^[ \t]*gcBYTES_TO_WORDS[(]sizeof[(][A-Za-z0-9_]*[)][)];[ \t]*$")) @@ -24,7 +26,8 @@ [(regexp-match re:done l) null] [(or (regexp-match re:mark l) - (regexp-match re:size l)) + (regexp-match re:size-or-more l) + (regexp-match re:fixup-start l)) (error 'mkmark.ss "unexpected label: ~a at ~a" l (file-position (current-input-port)))] [(regexp-match re:close l) @@ -36,7 +39,12 @@ (printf "~a~n" s)) l))]) (let ([prefix (read-lines re:mark)] - [mark (read-lines re:size)] + [mark (read-lines re:size-or-more)] + [fixup (if (regexp-match-peek re:fixup-start (current-input-port)) + (begin + (regexp-match re:fixup-start (current-input-port)) + (read-lines re:size)) + null)] [size (read-lines re:close)]) (printf "static int ~a_SIZE(void *p) {~n" name) (print-lines prefix) @@ -69,7 +77,9 @@ s "FIXUP") "\\1")) - mark)) + (append + mark + fixup))) (printf " return~n") (print-lines size) (printf "}~n~n") diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 7808351577..fbfd32ebe6 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -1752,6 +1752,57 @@ static int thread_val_FIXUP(void *p) { #define thread_val_IS_CONST_SIZE 1 +static int runstack_val_SIZE(void *p) { + long *s = (long *)p; + return + s[1]; +} + +static int runstack_val_MARK(void *p) { + long *s = (long *)p; + void **a, **b; + a = (void **)s + 4 + s[2]; + b = (void **)s + 4 + s[3]; + while (a < b) { + gcMARK(*a); + a++; + } + return + s[1]; +} + +static int runstack_val_FIXUP(void *p) { + long *s = (long *)p; + void **a, **b; + a = (void **)s + 4 + s[2]; + b = (void **)s + 4 + s[3]; + while (a < b) { + gcFIXUP(*a); + a++; + } + + /* Zero out the part that we didn't mark, in case it becomes + live later. */ + a = (void **)s + 4; + b = (void **)s + 4 + s[2]; + while (a < b) { + *a = NULL; + a++; + } + a = (void **)s + 4 + s[3]; + b = (void **)s + 4 + (s[1] - 4); + while (a < b) { + *a = NULL; + a++; + } + return + s[1]; +} + +#define runstack_val_IS_ATOMIC 0 +#define runstack_val_IS_CONST_SIZE 0 + + static int prompt_val_SIZE(void *p) { return gcBYTES_TO_WORDS(sizeof(Scheme_Prompt)); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index a0dbd4755e..82cf367b03 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -684,6 +684,36 @@ thread_val { gcBYTES_TO_WORDS(sizeof(Scheme_Thread)); } +runstack_val { + long *s = (long *)p; + mark: + void **a, **b; + a = (void **)s + 4 + s[2]; + b = (void **)s + 4 + s[3]; + while (a < b) { + gcMARK(*a); + a++; + } + more: + fixup: + /* Zero out the part that we didn't mark, in case it becomes + live later. */ + a = (void **)s + 4; + b = (void **)s + 4 + s[2]; + while (a < b) { + *a = NULL; + a++; + } + a = (void **)s + 4 + s[3]; + b = (void **)s + 4 + (s[1] - 4); + while (a < b) { + *a = NULL; + a++; + } + size: + s[1]; +} + prompt_val { mark: Scheme_Prompt *pr = (Scheme_Prompt *)p; diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 2f38261d21..8f8a2b55cc 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -324,6 +324,9 @@ void scheme_start_itimer_thread(long usec); void scheme_block_child_signals(int block); #endif +Scheme_Object **scheme_alloc_runstack(long len); +void scheme_set_runstack_limits(Scheme_Object **rs, long len, long start, long end); + void scheme_alloc_list_stack(Scheme_Thread *p); void scheme_clean_list_stack(Scheme_Thread *p); diff --git a/src/mzscheme/src/stypes.h b/src/mzscheme/src/stypes.h index aa2f3db7f9..303d468097 100644 --- a/src/mzscheme/src/stypes.h +++ b/src/mzscheme/src/stypes.h @@ -227,6 +227,7 @@ enum { scheme_rt_delay_load_info, /* 205 */ scheme_rt_marshal_info, /* 206 */ scheme_rt_unmarshal_info, /* 207 */ + scheme_rt_runstack, /* 208 */ #endif _scheme_last_type_ diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index 345eee70f4..2cdba5f41b 100644 --- a/src/mzscheme/src/thread.c +++ b/src/mzscheme/src/thread.c @@ -2037,7 +2037,7 @@ static Scheme_Thread *make_thread(Scheme_Config *config, process->runstack_size = init_stack_size; { Scheme_Object **sa; - sa = scheme_malloc_allow_interior(sizeof(Scheme_Object*) * init_stack_size); + sa = scheme_alloc_runstack(init_stack_size); process->runstack_start = sa; } process->runstack = process->runstack_start + init_stack_size; @@ -2162,6 +2162,48 @@ void *scheme_tls_get(int pos) return p->user_tls[pos]; } +#ifdef MZ_XFORM +START_XFORM_SKIP; +#endif + +Scheme_Object **scheme_alloc_runstack(long len) +{ +#ifdef MZ_PRECISE_GC + long sz; + void **p; + sz = sizeof(Scheme_Object*) * (len + 4); + p = (void **)GC_malloc_tagged_allow_interior(sz); + *(Scheme_Type *)(void *)p = scheme_rt_runstack; + ((long *)(void *)p)[1] = gcBYTES_TO_WORDS(sz); + ((long *)(void *)p)[2] = 0; + ((long *)(void *)p)[3] = len; + return (Scheme_Object **)(p + 4); +#else + return (Scheme_Object **)scheme_malloc_allow_interior(sizeof(Scheme_Object*) * len); +#endif +} + +void scheme_set_runstack_limits(Scheme_Object **rs, long len, long start, long end) +/* With 3m, we can tell the GC not to scan the unused parts, and we + can have the fixup function zero out the unused parts; that avoids + writing and scanning pages that could be skipped for a minor + GC. For CGC, we have to just clear out the unused part. */ +{ +#ifdef MZ_PRECISE_GC + if (((long *)(void *)rs)[-2] != start) + ((long *)(void *)rs)[-2] = start; + if (((long *)(void *)rs)[-1] != end) + ((long *)(void *)rs)[-1] = end; +#else + memset(rs, 0, start * sizeof(Scheme_Object *)); + memset(rs + end, 0, (len - end) * sizeof(Scheme_Object *)); +#endif +} + +#ifdef MZ_XFORM +END_XFORM_SKIP; +#endif + /*========================================================================*/ /* thread creation and swapping */ /*========================================================================*/ @@ -2371,10 +2413,12 @@ static void remove_thread(Scheme_Thread *r) if (r->runstack_owner) { /* Drop ownership, if active, and clear the stack */ if (r == *(r->runstack_owner)) { - memset(r->runstack_start, 0, r->runstack_size * sizeof(Scheme_Object*)); - r->runstack_start = NULL; + if (r->runstack_start) { + scheme_set_runstack_limits(r->runstack_start, r->runstack_size, 0, 0); + r->runstack_start = NULL; + } for (saved = r->runstack_saved; saved; saved = saved->prev) { - memset(saved->runstack_start, 0, saved->runstack_size * sizeof(Scheme_Object*)); + scheme_set_runstack_limits(saved->runstack_start, saved->runstack_size, 0, 0); } r->runstack_saved = NULL; *(r->runstack_owner) = NULL; @@ -6596,39 +6640,41 @@ static void prepare_thread_for_GC(Scheme_Object *t) /* zero ununsed part of env stack in each thread */ if (!p->nestee) { - Scheme_Object **o, **e, **e2; Scheme_Saved_Stack *saved; # define RUNSTACK_TUNE(x) /* x - Used for performance tuning */ RUNSTACK_TUNE( long size; ); if (!p->runstack_owner || (p == *p->runstack_owner)) { - o = p->runstack_start; - e = p->runstack; - e2 = p->runstack_tmp_keep; - - while (o < e && (o != e2)) { - *(o++) = NULL; - } + long rs_end; /* If there's a meta-prompt, we can also zero out past the unused part */ if (p->meta_prompt && (p->meta_prompt->runstack_boundary_start == p->runstack_start)) { - e = p->runstack_start + p->runstack_size; - o = p->runstack_start + p->meta_prompt->runstack_boundary_offset; - while (o < e) { - *(o++) = NULL; - } + rs_end = p->meta_prompt->runstack_boundary_offset; + } else { + rs_end = p->runstack_size; } + + scheme_set_runstack_limits(p->runstack_start, + p->runstack_size, + p->runstack - p->runstack_start, + rs_end); RUNSTACK_TUNE( size = p->runstack_size - (p->runstack - p->runstack_start); ); for (saved = p->runstack_saved; saved; saved = saved->prev) { - o = saved->runstack_start; - e = o + saved->runstack_offset; RUNSTACK_TUNE( size += saved->runstack_size; ); - while (o < e) { - *(o++) = NULL; - } + + if (p->meta_prompt && (p->meta_prompt->runstack_boundary_start == saved->runstack_start)) { + rs_end = p->meta_prompt->runstack_boundary_offset; + } else { + rs_end = saved->runstack_size; + } + + scheme_set_runstack_limits(saved->runstack_start, + saved->runstack_size, + saved->runstack_offset, + rs_end); } } @@ -6662,11 +6708,16 @@ static void prepare_thread_for_GC(Scheme_Object *t) if (segpos < p->cont_mark_seg_count) { Scheme_Cont_Mark *seg = p->cont_mark_stack_segments[segpos]; - int stackpos = ((long)p->cont_mark_stack & SCHEME_MARK_SEGMENT_MASK), i; + int stackpos = ((long)p->cont_mark_stack & SCHEME_MARK_SEGMENT_MASK); for (i = stackpos; i < SCHEME_MARK_SEGMENT_SIZE; i++) { - seg[i].key = NULL; - seg[i].val = NULL; - seg[i].cache = NULL; + if (seg[i].key) { + seg[i].key = NULL; + seg[i].val = NULL; + seg[i].cache = NULL; + } else { + /* NULL means we already cleared from here on. */ + break; + } } } @@ -6729,9 +6780,7 @@ static void get_ready_for_GC() scheme_current_thread->cont_mark_pos = MZ_CONT_MARK_POS; #endif - if (scheme_fuel_counter) { - for_each_managed(scheme_thread_type, prepare_thread_for_GC); - } + for_each_managed(scheme_thread_type, prepare_thread_for_GC); #ifdef MZ_PRECISE_GC scheme_flush_stack_copy_cache(); diff --git a/src/mzscheme/src/type.c b/src/mzscheme/src/type.c index 7c55bc9ce6..79459c77a2 100644 --- a/src/mzscheme/src/type.c +++ b/src/mzscheme/src/type.c @@ -540,6 +540,8 @@ void scheme_register_traversers(void) GC_REG_TRAV(scheme_global_ref_type, small_object); GC_REG_TRAV(scheme_delay_syntax_type, small_object); + + GC_REG_TRAV(scheme_rt_runstack, runstack_val); } END_XFORM_SKIP;