//////////// in C_reclaim rescan: // <-- XXXXXXXXXXX extracted the loop here to own function mark_nested if(gc_mode == GC_MINOR) { mark_nested(GC_MINOR); // <- call here count = (C_uword)C_fromspace_top - (C_uword)start; ++gc_count_1; ++gc_count_1_total; update_locative_table(GC_MINOR); } else { mark_nested(gc_mode); // <- call here if(!finalizers_checked) { //////////// static C_regparm void C_fcall mark_nested(int mode) { C_word *p; C_uword bytes; C_SCHEME_BLOCK *bp; C_header h; // ----- XXXXXXX Capture some globals into globals so compiler has better time with aliasing double start_t = C_cpu_milliseconds(); int n; int weak_gc_p = C_enable_gcweak; C_byte *fs_s = fromspace_start, *fs_l = C_fromspace_limit, *ts_s = tospace_start, *ts_l = tospace_limit; C_word *stack_bot = stack_bottom, *stack_p = C_stack_pointer_test; while(heap_scan_top < (mode == GC_MINOR ? C_fromspace_top : 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; 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--) { // ------------------------- XXXXXXXXXX manually inlined lots of stuff here // inlined mark(p++) C_word *_x = p++, _val = *_x; if(!C_immediatep(_val)) { C_word *wptr = (C_word *)(C_uword)_val; C_byte *ptr = (C_byte *)(C_uword)_val; if ( // C_in_stackp in_stackp_3(_val, stack_p, stack_bot) // C_in_heapp || (fs_s <= ptr && ptr < fs_l) || (ts_s <= ptr && ptr < ts_l)) if(mode == GC_MINOR) { really_mark_minor(_x); } else { if (weak_gc_p) { really_mark_major(_x, tospace_limit); } else { really_mark_major_no_weak(_x, tospace_limit); } } } } } heap_scan_top = (C_byte *)bp + C_align(bytes) + sizeof(C_word); } /* if(mode != GC_MINOR) printf("mark_nested: %.1f\n", C_cpu_milliseconds() - start_t); */ } // XXXXXXXXXX Original really_mark C_regparm void C_fcall really_mark(C_word *x) { C_word val, item; C_uword n, bytes; C_header h; C_SCHEME_BLOCK *p, *p2; WEAK_TABLE_ENTRY *wep; val = *x; if (!C_in_stackp(val) && !C_in_heapp(val)) { #ifdef C_GC_HOOKS if(C_gc_trace_hook != NULL) C_gc_trace_hook(x, gc_mode); #endif return; } p = (C_SCHEME_BLOCK *)val; h = p->header; if(gc_mode == GC_MINOR) { if(is_fptr(h)) { *x = val = fptr_to_ptr(h); return; } if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top) return; p2 = (C_SCHEME_BLOCK *)C_align((C_uword)C_fromspace_top); #ifndef C_SIXTY_FOUR if((h & C_8ALIGN_BIT) && C_aligned8(p2) && (C_byte *)p2 < C_fromspace_limit) { *((C_word *)p2) = ALIGNMENT_HOLE_MARKER; p2 = (C_SCHEME_BLOCK *)((C_word *)p2 + 1); } #endif n = C_header_size(p); bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); if(((C_byte *)p2 + bytes + sizeof(C_word)) > C_fromspace_limit) #ifdef HAVE_SIGSETJMP C_siglongjmp(gc_restart, 1); #else C_longjmp(gc_restart, 1); #endif C_fromspace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word); scavenge: *x = (C_word)p2; p2->header = h; p->header = ptr_to_fptr((C_uword)p2); C_memcpy(p2->data, p->data, bytes); } else { /* (major GC) */ /* Increase counter (saturated at 2) if weakly held item (someone pointed to this object): */ if(C_enable_gcweak && (h & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE && (wep = lookup_weak_table_entry(val, 0)) != NULL) { if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container; } if(is_fptr(h)) { val = fptr_to_ptr(h); /* When we marked the bucket, it may have already referred to * the moved symbol instead of its original location. Re-check: */ if(C_enable_gcweak && (C_block_header(val) & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE && (wep = lookup_weak_table_entry(*x, 0)) != NULL) { if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container; } if((C_uword)val >= (C_uword)tospace_start && (C_uword)val < (C_uword)tospace_top) { *x = val; return; } /* Link points into fromspace: fetch new pointer + header and copy... */ p = (C_SCHEME_BLOCK *)val; h = p->header; if(is_fptr(h)) { /* Link points into fromspace and into a link which points into from- or tospace: */ val = fptr_to_ptr(h); /* See above: might happen twice */ if(C_enable_gcweak && (C_block_header(val) & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE && /* Check both the original and intermediate location: */ ((wep = lookup_weak_table_entry((C_word)p, 0)) != NULL || (wep = lookup_weak_table_entry(*x, 0)) != NULL)) { if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container; } if((C_uword)val >= (C_uword)tospace_start && (C_uword)val < (C_uword)tospace_top) { *x = val; return; } p = (C_SCHEME_BLOCK *)val; h = p->header; } } p2 = (C_SCHEME_BLOCK *)C_align((C_uword)tospace_top); #ifndef C_SIXTY_FOUR if((h & C_8ALIGN_BIT) && C_aligned8(p2) && (C_byte *)p2 < tospace_limit) { *((C_word *)p2) = ALIGNMENT_HOLE_MARKER; p2 = (C_SCHEME_BLOCK *)((C_word *)p2 + 1); } #endif if(C_enable_gcweak && (h & C_HEADER_TYPE_BITS) == C_BUCKET_TYPE) { item = C_block_item(val,0); /* Lookup item in weak item table or add entry: */ if((wep = lookup_weak_table_entry(item, (C_word)p2)) != NULL) { /* If item is already forwarded, then set count to 2: */ if(is_fptr(C_block_header(item))) wep->container |= 2; } } n = C_header_size(p); bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); if(((C_byte *)p2 + bytes + sizeof(C_word)) > tospace_limit) { /* Detect impossibilities before GC_REALLOC to preserve state: */ if (C_in_stackp((C_word)p) && bytes > stack_size) panic(C_text("Detected corrupted data in stack")); if (C_in_heapp((C_word)p) && bytes > (heap_size / 2)) panic(C_text("Detected corrupted data in heap")); if(C_heap_size_is_fixed) panic(C_text("out of memory - heap full")); gc_mode = GC_REALLOC; #ifdef HAVE_SIGSETJMP C_siglongjmp(gc_restart, 1); #else C_longjmp(gc_restart, 1); #endif } tospace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word); goto scavenge; } } // XXXXXXXXXXXX New really_mark C_regparm void C_fcall really_mark(C_word *x) { if(gc_mode == GC_MINOR) really_mark_minor(x); else really_mark_major(x, tospace_limit); } // XXXXXXXXXXXXX These functions are just subsets of the original really_mark that // make "assumptions" so conditionals can be removed C_regparm void C_fcall really_mark_major(C_word *x, C_byte *ts_limit) { C_word val, item; C_uword n, bytes; C_header h; C_SCHEME_BLOCK *p, *p2; WEAK_TABLE_ENTRY *wep; int weak_gc_p = C_enable_gcweak; C_uword ts_s = (C_uword)tospace_start, ts_top = (C_uword)tospace_top; val = *x; p = (C_SCHEME_BLOCK *)val; h = p->header; /* Increase counter (saturated at 2) if weakly held item (someone pointed to this object): */ if(weak_gc_p && (h & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE && (wep = lookup_weak_table_entry(val, 0)) != NULL) { if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container; } if(is_fptr(h)) { val = fptr_to_ptr(h); /* When we marked the bucket, it may have already referred to * the moved symbol instead of its original location. Re-check: */ if(weak_gc_p && (C_block_header(val) & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE && (wep = lookup_weak_table_entry(*x, 0)) != NULL) { if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container; } if((C_uword)val >= ts_s && (C_uword)val < ts_top) { *x = val; return; } /* Link points into fromspace: fetch new pointer + header and copy... */ p = (C_SCHEME_BLOCK *)val; h = p->header; if(is_fptr(h)) { /* Link points into fromspace and into a link which points into from- or tospace: */ val = fptr_to_ptr(h); /* See above: might happen twice */ if(weak_gc_p && (C_block_header(val) & C_HEADER_TYPE_BITS) == C_SYMBOL_TYPE && /* Check both the original and intermediate location: */ ((wep = lookup_weak_table_entry((C_word)p, 0)) != NULL || (wep = lookup_weak_table_entry(*x, 0)) != NULL)) { if((wep->container & WEAK_COUNTER_MAX) == 0) ++wep->container; } if((C_uword)val >= ts_s && (C_uword)val < ts_top) { *x = val; return; } p = (C_SCHEME_BLOCK *)val; h = p->header; } } p2 = (C_SCHEME_BLOCK *)C_align(ts_top); #ifndef C_SIXTY_FOUR if((h & C_8ALIGN_BIT) && C_aligned8(p2) && (C_byte *)p2 < ts_limit) { *((C_word *)p2) = ALIGNMENT_HOLE_MARKER; p2 = (C_SCHEME_BLOCK *)((C_word *)p2 + 1); } #endif if(weak_gc_p && (h & C_HEADER_TYPE_BITS) == C_BUCKET_TYPE) { item = C_block_item(val,0); /* Lookup item in weak item table or add entry: */ if((wep = lookup_weak_table_entry(item, (C_word)p2)) != NULL) { /* If item is already forwarded, then set count to 2: */ if(is_fptr(C_block_header(item))) wep->container |= 2; } } n = C_header_size(p); bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); if(((C_byte *)p2 + bytes + sizeof(C_word)) > ts_limit) { /* Detect impossibilities before GC_REALLOC to preserve state: */ if (C_in_stackp((C_word)p) && bytes > stack_size) panic(C_text("Detected corrupted data in stack")); if (C_in_heapp((C_word)p) && bytes > (heap_size / 2)) panic(C_text("Detected corrupted data in heap")); if(C_heap_size_is_fixed) panic(C_text("out of memory - heap full")); gc_mode = GC_REALLOC; #ifdef HAVE_SIGSETJMP C_siglongjmp(gc_restart, 1); #else C_longjmp(gc_restart, 1); #endif } tospace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word); // inlined goot scanvege; *x = (C_word)p2; p2->header = h; p->header = ptr_to_fptr((C_uword)p2); C_memcpy(p2->data, p->data, bytes); } C_regparm void C_fcall really_mark_major_no_weak(C_word *x, C_byte *ts_limit) { C_word val, item; C_uword n, bytes; C_header h; C_SCHEME_BLOCK *p, *p2; WEAK_TABLE_ENTRY *wep; C_uword ts_s = (C_uword)tospace_start, ts_top = (C_uword)tospace_top; val = *x; p = (C_SCHEME_BLOCK *)val; h = p->header; /* Increase counter (saturated at 2) if weakly held item (someone pointed to this object): */ if(is_fptr(h)) { val = fptr_to_ptr(h); /* When we marked the bucket, it may have already referred to * the moved symbol instead of its original location. Re-check: */ if((C_uword)val >= ts_s && (C_uword)val < ts_top) { *x = val; return; } /* Link points into fromspace: fetch new pointer + header and copy... */ p = (C_SCHEME_BLOCK *)val; h = p->header; if(is_fptr(h)) { /* Link points into fromspace and into a link which points into from- or tospace: */ val = fptr_to_ptr(h); if((C_uword)val >= ts_s && (C_uword)val < ts_top) { *x = val; return; } p = (C_SCHEME_BLOCK *)val; h = p->header; } } p2 = (C_SCHEME_BLOCK *)C_align(ts_top); #ifndef C_SIXTY_FOUR if((h & C_8ALIGN_BIT) && C_aligned8(p2) && (C_byte *)p2 < ts_limit) { *((C_word *)p2) = ALIGNMENT_HOLE_MARKER; p2 = (C_SCHEME_BLOCK *)((C_word *)p2 + 1); } #endif n = C_header_size(p); bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); if(((C_byte *)p2 + bytes + sizeof(C_word)) > ts_limit) { /* Detect impossibilities before GC_REALLOC to preserve state: */ if (C_in_stackp((C_word)p) && bytes > stack_size) panic(C_text("Detected corrupted data in stack")); if (C_in_heapp((C_word)p) && bytes > (heap_size / 2)) panic(C_text("Detected corrupted data in heap")); if(C_heap_size_is_fixed) panic(C_text("out of memory - heap full")); gc_mode = GC_REALLOC; #ifdef HAVE_SIGSETJMP C_siglongjmp(gc_restart, 1); #else C_longjmp(gc_restart, 1); #endif } tospace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word); // XXXXXXXXXX inlined goot scanvege; *x = (C_word)p2; p2->header = h; p->header = ptr_to_fptr((C_uword)p2); C_memcpy(p2->data, p->data, bytes); } C_regparm void C_fcall really_mark_minor_2(C_word *x, C_uword fs_start, C_byte *fs_limit) { C_word val; C_uword n, bytes; C_header h; C_SCHEME_BLOCK *p, *p2; val = *x; p = (C_SCHEME_BLOCK *)val; h = p->header; n = C_header_size(p); bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); if(is_fptr(h)) { *x = val = fptr_to_ptr(h); return; } if((C_uword)val >= fs_start && (C_uword)val < (C_uword)C_fromspace_top) return; p2 = (C_SCHEME_BLOCK *)C_align((C_uword)C_fromspace_top); #ifndef C_SIXTY_FOUR if((h & C_8ALIGN_BIT) && C_aligned8(p2) && (C_byte *)p2 < fs_limit) { *((C_word *)p2) = ALIGNMENT_HOLE_MARKER; p2 = (C_SCHEME_BLOCK *)((C_word *)p2 + 1); } #endif if(((C_byte *)p2 + bytes + sizeof(C_word)) > fs_limit) #ifdef HAVE_SIGSETJMP C_siglongjmp(gc_restart, 1); #else C_longjmp(gc_restart, 1); #endif C_fromspace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word); // XXXXXXXXX old scavenge: label *x = (C_word)p2; p2->header = h; p->header = ptr_to_fptr((C_uword)p2); C_memcpy(p2->data, p->data, bytes); } C_regparm void C_fcall really_mark_minor(C_word *x) { C_word val; C_uword n, bytes; C_header h; C_SCHEME_BLOCK *p, *p2; val = *x; p = (C_SCHEME_BLOCK *)val; h = p->header; n = C_header_size(p); bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word); if(is_fptr(h)) { *x = val = fptr_to_ptr(h); return; } if((C_uword)val >= (C_uword)fromspace_start && (C_uword)val < (C_uword)C_fromspace_top) return; p2 = (C_SCHEME_BLOCK *)C_align((C_uword)C_fromspace_top); #ifndef C_SIXTY_FOUR if((h & C_8ALIGN_BIT) && C_aligned8(p2) && (C_byte *)p2 < C_fromspace_limit) { *((C_word *)p2) = ALIGNMENT_HOLE_MARKER; p2 = (C_SCHEME_BLOCK *)((C_word *)p2 + 1); } #endif if(((C_byte *)p2 + bytes + sizeof(C_word)) > C_fromspace_limit) #ifdef HAVE_SIGSETJMP C_siglongjmp(gc_restart, 1); #else C_longjmp(gc_restart, 1); #endif C_fromspace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word); // XXXXXX old scavenge: label *x = (C_word)p2; p2->header = h; p->header = ptr_to_fptr((C_uword)p2); C_memcpy(p2->data, p->data, bytes); }