~ chicken-core (chicken-5) c387ae7cfc0a8312017473dccd2cba6576860e51
commit c387ae7cfc0a8312017473dccd2cba6576860e51
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Thu Apr 16 22:42:33 2020 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Thu Apr 16 22:42:33 2020 +0200
Move Cheney algorithm into its own function
This allows us to drop a goto, and one level of ifs.
While we're at it, also remove one unnecessarily global variable,
heap_scan_top. This presumably could make things a bit faster due to
using registers (benchmark measurements don't agree; there's no
difference).
diff --git a/runtime.c b/runtime.c
index 8085369e..3d4fdc27 100644
--- a/runtime.c
+++ b/runtime.c
@@ -385,8 +385,7 @@ static C_TLS C_byte
*tospace_limit,
*new_tospace_start,
*new_tospace_top,
- *new_tospace_limit,
- *heap_scan_top;
+ *new_tospace_limit;
static C_TLS C_uword
heapspace1_size,
heapspace2_size,
@@ -548,6 +547,7 @@ static C_word C_fcall lookup_bucket(C_word sym, C_SYMBOL_TABLE *stable) C_regpar
static double compute_symbol_table_load(double *avg_bucket_len, int *total);
static double C_fcall decode_flonum_literal(C_char *str) C_regparm;
static C_regparm C_word str_to_bignum(C_word bignum, char *str, char *str_end, int radix);
+static void C_fcall mark_nested_objects(C_byte *heap_scan_top, C_byte *tgt_space_start, C_byte **tgt_space_top, C_byte *tgt_space_limit) C_regparm;
static void C_fcall mark_live_objects(C_byte *tgt_space_start, C_byte **tgt_space_top, C_byte *tgt_space_limit) C_regparm;
static void C_fcall mark_live_heap_only_objects(C_byte *tgt_space_start, C_byte **tgt_space_top, C_byte *tgt_space_limit) C_regparm;
static C_word C_fcall intern0(C_char *name) C_regparm;
@@ -3365,12 +3365,10 @@ static void _mark(C_word *x, C_byte *s, C_byte **t, C_byte *l) { \
C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
{
- int i, j, n, fcount;
- C_uword count, bytes;
- C_word *p, **msp, last;
- C_header h;
+ int i, j, fcount;
+ C_uword count;
+ C_word **msp, last;
C_byte *tmp, *start;
- C_SCHEME_BLOCK *bp;
C_GC_ROOT *gcrp;
double tgc = 0;
volatile int finalizers_checked;
@@ -3397,7 +3395,6 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
finalizers_checked = 0;
C_restart_trampoline = trampoline;
C_restart_c = c;
- heap_scan_top = (C_byte *)C_align((C_uword)C_fromspace_top);
gc_mode = GC_MINOR;
tgt_space_start = fromspace_start;
tgt_space_top = &C_fromspace_top;
@@ -3432,7 +3429,7 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
goto i_like_spaghetti;
}
- heap_scan_top = (C_byte *)C_align((C_uword)tospace_top);
+ start = (C_byte *)C_align((C_uword)tospace_top);
gc_mode = GC_MAJOR;
tgt_space_start = tospace_start;
tgt_space_top = &tospace_top;
@@ -3456,33 +3453,8 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
mark_live_objects(tgt_space_start, tgt_space_top, tgt_space_limit);
- rescan:
- /* Mark nested values in already moved (marked) blocks in breadth-first manner: */
- while(heap_scan_top < *tgt_space_top) {
- bp = (C_SCHEME_BLOCK *)heap_scan_top;
-
- if(*((C_word *)bp) == ALIGNMENT_HOLE_MARKER)
- bp = (C_SCHEME_BLOCK *)((C_word *)bp + 1);
-
- n = C_header_size(bp);
- h = bp->header;
- bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word);
- p = bp->data;
-
- if(n > 0 && (h & C_BYTEBLOCK_BIT) == 0) {
- if(h & C_SPECIALBLOCK_BIT) {
- /* Minor GC needs to be fast; always mark weakly held symbols */
- if (gc_mode != GC_MINOR || h != C_WEAK_PAIR_TAG) {
- --n;
- ++p;
- }
- }
-
- while(n--) mark(p++);
- }
-
- heap_scan_top = (C_byte *)bp + C_align(bytes) + sizeof(C_word);
- }
+ mark_nested_objects(start, tgt_space_start, tgt_space_top, tgt_space_limit);
+ start = *tgt_space_top;
if(gc_mode == GC_MINOR) {
count = (C_uword)C_fromspace_top - (C_uword)start;
@@ -3491,89 +3463,87 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
update_locative_table(GC_MINOR);
}
else {
- if(!finalizers_checked) {
- /* Mark finalizer list and remember pointers to non-forwarded items: */
- last = C_block_item(pending_finalizers_symbol, 0);
-
- if(!C_immediatep(last) && (j = C_unfix(C_block_item(last, 0))) != 0) {
- /* still finalizers pending: just mark table items... */
- if(gc_report_flag)
- C_dbg(C_text("GC"), C_text("%d finalized item(s) still pending\n"), j);
+ /* Mark finalizer list and remember pointers to non-forwarded items: */
+ last = C_block_item(pending_finalizers_symbol, 0);
- j = fcount = 0;
+ if(!C_immediatep(last) && (j = C_unfix(C_block_item(last, 0))) != 0) {
+ /* still finalizers pending: just mark table items... */
+ if(gc_report_flag)
+ C_dbg(C_text("GC"), C_text("%d finalized item(s) still pending\n"), j);
- for(flist = finalizer_list; flist != NULL; flist = flist->next) {
- mark(&flist->item);
- mark(&flist->finalizer);
- ++fcount;
- }
+ j = fcount = 0;
- /* mark finalizable GC roots: */
- for(gcrp = gc_root_list; gcrp != NULL; gcrp = gcrp->next) {
- if(gcrp->finalizable) mark(&gcrp->value);
- }
+ for(flist = finalizer_list; flist != NULL; flist = flist->next) {
+ mark(&flist->item);
+ mark(&flist->finalizer);
+ ++fcount;
+ }
- if(gc_report_flag && fcount > 0)
- C_dbg(C_text("GC"), C_text("%d finalizer value(s) marked\n"), fcount);
+ /* mark finalizable GC roots: */
+ for(gcrp = gc_root_list; gcrp != NULL; gcrp = gcrp->next) {
+ if(gcrp->finalizable) mark(&gcrp->value);
}
- else {
- j = fcount = 0;
- /* move into pending */
- for(flist = finalizer_list; flist != NULL; flist = flist->next) {
- if(j < C_max_pending_finalizers) {
- if(!is_fptr(C_block_header(flist->item)))
- pending_finalizer_indices[ j++ ] = flist;
- }
- }
+ if(gc_report_flag && fcount > 0)
+ C_dbg(C_text("GC"), C_text("%d finalizer value(s) marked\n"), fcount);
+ }
+ else {
+ j = fcount = 0;
- /* mark */
- for(flist = finalizer_list; flist != NULL; flist = flist->next) {
- mark(&flist->item);
- mark(&flist->finalizer);
- }
+ /* move into pending */
+ for(flist = finalizer_list; flist != NULL; flist = flist->next) {
+ if(j < C_max_pending_finalizers) {
+ if(!is_fptr(C_block_header(flist->item)))
+ pending_finalizer_indices[ j++ ] = flist;
+ }
+ }
- /* mark finalizable GC roots: */
- for(gcrp = gc_root_list; gcrp != NULL; gcrp = gcrp->next) {
- if(gcrp->finalizable) mark(&gcrp->value);
- }
+ /* mark */
+ for(flist = finalizer_list; flist != NULL; flist = flist->next) {
+ mark(&flist->item);
+ mark(&flist->finalizer);
}
- pending_finalizer_count = j;
- finalizers_checked = 1;
+ /* mark finalizable GC roots: */
+ for(gcrp = gc_root_list; gcrp != NULL; gcrp = gcrp->next) {
+ if(gcrp->finalizable) mark(&gcrp->value);
+ }
+ }
- if(pending_finalizer_count > 0 && gc_report_flag)
- C_dbg(C_text("GC"), C_text("%d finalizer(s) pending (%d live)\n"),
- pending_finalizer_count, live_finalizer_count);
+ pending_finalizer_count = j;
+ finalizers_checked = 1;
- goto rescan;
- }
- else {
- /* Copy finalized items with remembered indices into `##sys#pending-finalizers'
- (and release finalizer node): */
- if(pending_finalizer_count > 0) {
- if(gc_report_flag)
- C_dbg(C_text("GC"), C_text("queueing %d finalizer(s)\n"), pending_finalizer_count);
-
- last = C_block_item(pending_finalizers_symbol, 0);
- assert(C_block_item(last, 0) == C_fix(0));
- C_set_block_item(last, 0, C_fix(pending_finalizer_count));
-
- for(i = 0; i < pending_finalizer_count; ++i) {
- flist = pending_finalizer_indices[ i ];
- C_set_block_item(last, 1 + i * 2, flist->item);
- C_set_block_item(last, 2 + i * 2, flist->finalizer);
+ if(pending_finalizer_count > 0 && gc_report_flag)
+ C_dbg(C_text("GC"), C_text("%d finalizer(s) pending (%d live)\n"),
+ pending_finalizer_count, live_finalizer_count);
+
+ /* Once more mark nested objects after (maybe) copying finalizer objects: */
+ mark_nested_objects(start, tgt_space_start, tgt_space_top, tgt_space_limit);
+
+ /* Copy finalized items with remembered indices into `##sys#pending-finalizers'
+ (and release finalizer node): */
+ if(pending_finalizer_count > 0) {
+ if(gc_report_flag)
+ C_dbg(C_text("GC"), C_text("queueing %d finalizer(s)\n"), pending_finalizer_count);
+
+ last = C_block_item(pending_finalizers_symbol, 0);
+ assert(C_block_item(last, 0) == C_fix(0));
+ C_set_block_item(last, 0, C_fix(pending_finalizer_count));
+
+ for(i = 0; i < pending_finalizer_count; ++i) {
+ flist = pending_finalizer_indices[ i ];
+ C_set_block_item(last, 1 + i * 2, flist->item);
+ C_set_block_item(last, 2 + i * 2, flist->finalizer);
- if(flist->previous != NULL) flist->previous->next = flist->next;
- else finalizer_list = flist->next;
+ if(flist->previous != NULL) flist->previous->next = flist->next;
+ else finalizer_list = flist->next;
- if(flist->next != NULL) flist->next->previous = flist->previous;
+ if(flist->next != NULL) flist->next->previous = flist->previous;
- flist->next = finalizer_free_list;
- flist->previous = NULL;
- finalizer_free_list = flist;
- --live_finalizer_count;
- }
+ flist->next = finalizer_free_list;
+ flist->previous = NULL;
+ finalizer_free_list = flist;
+ --live_finalizer_count;
}
}
@@ -3755,6 +3725,46 @@ static C_regparm void C_fcall mark_live_heap_only_objects(C_byte *tgt_space_star
}
+/*
+ * Mark nested values in already moved (i.e., marked) blocks in
+ * breadth-first manner (Cheney's algorithm).
+ */
+static C_regparm void C_fcall mark_nested_objects(C_byte *heap_scan_top, C_byte *tgt_space_start, C_byte **tgt_space_top, C_byte *tgt_space_limit)
+{
+ int n;
+ C_word bytes;
+ C_word *p;
+ C_header h;
+ C_SCHEME_BLOCK *bp;
+
+ while(heap_scan_top < *tgt_space_top) {
+ bp = (C_SCHEME_BLOCK *)heap_scan_top;
+
+ if(*((C_word *)bp) == ALIGNMENT_HOLE_MARKER)
+ bp = (C_SCHEME_BLOCK *)((C_word *)bp + 1);
+
+ n = C_header_size(bp);
+ h = bp->header;
+ bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word);
+ p = bp->data;
+
+ if(n > 0 && (h & C_BYTEBLOCK_BIT) == 0) {
+ if(h & C_SPECIALBLOCK_BIT) {
+ /* Minor GC needs to be fast; always mark weakly held symbols */
+ if (gc_mode != GC_MINOR || h != C_WEAK_PAIR_TAG) {
+ --n;
+ ++p;
+ }
+ }
+
+ while(n--) mark(p++);
+ }
+
+ heap_scan_top = (C_byte *)bp + C_align(bytes) + sizeof(C_word);
+ }
+}
+
+
static C_regparm void C_fcall really_mark(C_word *x, C_byte *tgt_space_start, C_byte **tgt_space_top, C_byte *tgt_space_limit)
{
C_word val;
@@ -3838,13 +3848,9 @@ static C_regparm void C_fcall really_mark(C_word *x, C_byte *tgt_space_start, C_
C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize)
{
int i;
- C_uword n, bytes;
- C_word *p;
- C_header h;
- C_SCHEME_BLOCK *bp;
C_GC_ROOT *gcrp;
FINALIZER_NODE *flist;
- C_byte *new_heapspace;
+ C_byte *new_heapspace, *start;
size_t new_heapspace_size;
if(C_pre_gc_hook != NULL) C_pre_gc_hook(GC_REALLOC);
@@ -3914,7 +3920,7 @@ C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize)
new_tospace_top = new_tospace_start;
new_tospace_limit = new_tospace_start + size;
- heap_scan_top = new_tospace_top;
+ start = new_tospace_top;
/* Mark standard live objects in nursery and heap */
mark_live_objects(new_tospace_start, &new_tospace_top, new_tospace_limit);
@@ -3938,30 +3944,7 @@ C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize)
update_locative_table(GC_REALLOC);
/* Mark nested values in already moved (marked) blocks in breadth-first manner: */
- while(heap_scan_top < new_tospace_top) {
- bp = (C_SCHEME_BLOCK *)heap_scan_top;
-
- if(*((C_word *)bp) == ALIGNMENT_HOLE_MARKER)
- bp = (C_SCHEME_BLOCK *)((C_word *)bp + 1);
-
- n = C_header_size(bp);
- h = bp->header;
- assert(!is_fptr(h));
- bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word);
- p = bp->data;
-
- if(n > 0 && (h & C_BYTEBLOCK_BIT) == 0) {
- if(h & C_SPECIALBLOCK_BIT) {
- --n;
- ++p;
- }
-
- while(n--) remark(p++);
- }
-
- heap_scan_top = (C_byte *)bp + C_align(bytes) + sizeof(C_word);
- }
-
+ mark_nested_objects(start, new_tospace_start, &new_tospace_top, new_tospace_limit);
update_symbol_tables(GC_REALLOC);
heap_free (heapspace1, heapspace1_size);
Trap