diff --git a/src/mzscheme/gc2/compact.c b/src/mzscheme/gc2/compact.c deleted file mode 100644 index 3a89dde466..0000000000 --- a/src/mzscheme/gc2/compact.c +++ /dev/null @@ -1,4801 +0,0 @@ -/* - Precise GC for MzScheme - Copyright (c) 2004-2010 PLT Scheme Inc. - Copyright (c) 1999 Matthew Flatt - All rights reserved. - - Please see the full copyright in the documentation. -*/ - -#include -#include -#include -#include "platforms.h" -#include "gc2.h" - -#define NUMBER_OF_TAGS 512 -#include "compactgc_internal.h" -#include "../src/schpriv.h" - -static THREAD_LOCAL CompactGC *GC; -#define GCTYPE CompactGC -#define GC_get_GC() (GC) -#define ofm_malloc malloc - -/**************** Configuration ****************/ - -#define GROW_FACTOR 1.5 -#define GROW_ADDITION 500000 - -#define GENERATIONS 1 - -/* Platform-specific disablers (`and'ed with GENERATIONS): */ -#define OS_X_GENERATIONS 1 -#define WIN32_GENERATIONS 1 - - -#ifdef NO_GC_SIGNALS -# undef GENERATIONS -# define GENERATIONS 0 -#endif - -#ifdef OS_X -# if GENERATIONS -# undef GENERATIONS -# define GENERATIONS OS_X_GENERATIONS -# endif -#endif - -#ifdef _WIN32 -# if GENERATIONS -# undef GENERATIONS -# define GENERATIONS WIN32_GENERATIONS -/* Under Windows, setting the unhandled-exception handler doesn't work - within Windows callbacks. Perhaps in the future we can fix all - callbacks to insert an appropriate wrapper. For now, we use - AddVectoredExceptionHandler, but that's only available starting - with XP. We detect the presence of AddVectoredExceptionHandler - dynamically (and disable generations if it's not present), but we - also make generations easy to disable entirely above. */ -# endif -#endif - -#define USE_FREELIST 0 - -/* When USE_FREELIST is on: */ -#define COMPACTING SELECTIVELY_COMPACT -# define ALWAYS_COMPACT 2 -# define SELECTIVELY_COMPACT 1 -# define NEVER_COMPACT 0 -#define COMPACT_THRESHOLD 0.2 - -#ifdef _WIN32 -# include -# define gcINLINE _inline -#endif -#ifdef OSKIT -# undef GENERATIONS -# define GENERATIONS 0 -#endif - -#if defined(sparc) || defined(__sparc) || defined(__sparc__) -# define ALIGN_DOUBLES 1 -#else -# define ALIGN_DOUBLES 0 -#endif - -#define LOG_WORD_SIZE 2 -#define WORD_SIZE (1 << LOG_WORD_SIZE) -#define WORD_BIT_COUNT (WORD_SIZE << 3) - -#define INCREMENT_CYCLE_COUNT_GROWTH 1048576 - - -#include "gc2_dump.h" - -#define BYTEPTR(x) ((char *)x) - -/* Debugging and performance tools: */ -#define TIME 0 -#define SEARCH 0 -#define CHECKS 0 -#define CHECK_STACK_PTRS 0 -#define NOISY 0 -#define MARK_STATS 0 -#define ALLOC_GC_PHASE 0 -#define SKIP_FORCED_GC 0 -#define RECORD_MARK_SRC 0 -#define KEEP_BACKPOINTERS 0 -#define DEFINE_MALLOC_FREE 0 - -#ifdef MZ_GC_BACKTRACE -# undef KEEP_BACKPOINTERS -# define KEEP_BACKPOINTERS 1 -#endif - -#if TIME -# include -# include -# include -#endif - -#include "msgprint.c" - -/**************** Stack for mark phase ****************/ -#define MARK_STACK_MAX 4096 -static void *mark_stack[MARK_STACK_MAX]; -static unsigned short mark_stack_type[MARK_STACK_MAX]; -static long mark_stack_pos = 0; - -#if KEEP_BACKPOINTERS -# undef RECORD_MARK_SRC -# define RECORD_MARK_SRC 1 -/* Disabled generations, since old-page ifxups would be wrong, - and even if that were fixed, the results would be confusing. */ -# undef GENERATIONS -# define GENERATIONS 0 -#endif - -#if RECORD_MARK_SRC -static void *mark_src; -static int mark_type; -static void *mark_src_stack[MARK_STACK_MAX]; -static int mark_src_type[MARK_STACK_MAX]; - -static void *current_mark_src; -static int current_mark_type; - -#define MTYPE_ROOT 6 -#define MTYPE_STACK 7 -#define MTYPE_FINALIZER 8 -#define MTYPE_WEAKLINK 9 -#define MTYPE_WEAKLINKX 10 -#define MTYPE_IMMOBILE 11 -#endif - -/********************* Client hooks *********************/ -void (*GC_collect_start_callback)(void); -void (*GC_collect_end_callback)(void); -void (*GC_collect_inform_callback)(int major_gc, long pre_used, long post_used); -void (*GC_out_of_memory)(void); -void (*GC_report_out_of_memory)(void); -unsigned long (*GC_get_thread_stack_base)(void); - -void (*GC_mark_xtagged)(void *obj); -void (*GC_fixup_xtagged)(void *obj); - -THREAD_LOCAL void **GC_variable_stack; - -void **GC_get_variable_stack() { return GC_variable_stack; } -void GC_set_variable_stack(void **p) { GC_variable_stack = p; } -void GC_register_root_custodian(void *_c) {} - -/********************* Type tags *********************/ -Type_Tag weak_box_tag = 42; /* set by client */ -Type_Tag ephemeron_tag = 42; /* set by client */ -Type_Tag weak_array_tag = 42; /* set by client */ -Type_Tag pair_tag = 42; /* set by client */ - -#define gc_on_free_list_tag 511 - - -Size_Proc size_table[NUMBER_OF_TAGS]; -Mark_Proc mark_table[NUMBER_OF_TAGS]; -Fixup_Proc fixup_table[NUMBER_OF_TAGS]; - -/****************** Memory Pages ******************/ - -/* An MPage (as opposed to the OS's page) is an allocation region - for a particular kind of object (tagged, atomic, array, etc.). - It's also the granluarity of memory-mapping (i.e., taking an - arbitrary pointer an determining whether it's in the GC's - domain. - - It has an associated offset table, which is mainly used for - updating pointers during the fixup phase. -*/ - -#if ALIGN_DOUBLES || DEFINE_MALLOC_FREE -# define SQUASH_OFFSETS 0 -#else -# define SQUASH_OFFSETS 1 -#endif -/* Offsets must fit into 14 bits, saving 2 bits for tags. But since - the minimum size of an allocation is two words (unless - ALIGN_DOUBLES), we can squash the index array into half as much - space as we might otherwise. For example, let **** and #### be the - offsets for indexes 0 and 3, respectively: - - ---- ---- ---- ---- ---- - |****| | |####| | Unsquashed representation - ---- ---- ---- ---- ---- - -- -- -- -- -- - |**|**| |##|##| Squashed representation - -- -- -- -- -- -*/ - -typedef unsigned short OffsetTy; -#if SQUASH_OFFSETS -typedef unsigned char OffsetArrTy; -#else -typedef unsigned short OffsetArrTy; -#endif - -typedef unsigned char mtype_t; /* object type */ -typedef unsigned char mflags_t; /* mark state, etc. */ - -typedef struct MPage { - mtype_t type; /* object type */ - mflags_t flags; /* mark state, etc. */ - short alloc_boundary; - short compact_boundary; - short age, refs_age, compact_to_age; - union { - OffsetArrTy *offsets; /* for small objects */ - long size; /* for one big object */ - } u; - union { - void **compact_to; /* for small objects */ - void *bigblock_start; /* for one big object */ - } o; - void *block_start; /* start of memory in this page */ - struct MPage *next, *prev; /* for linked list of pages */ - - /* For mark-stack overflow, or slowing mark categories: */ - OffsetTy gray_start, gray_end; - struct MPage *gray_next; - -#if KEEP_BACKPOINTERS - void **backpointer_page; -#endif -} MPage; - -/* Linked list of allocated pages: */ -static MPage *first, *last; - -/* For mark-stack overflow, or slowish mark categories. */ -static MPage *gray_first; - -/* For memory-mapping: */ -MPage **mpage_maps; - -/* MPage size: */ -#define LOG_MPAGE_SIZE 14 -#define MPAGE_SIZE (1 << LOG_MPAGE_SIZE) -#define MPAGE_WORDS (1 << (LOG_MPAGE_SIZE - LOG_WORD_SIZE)) -#define MPAGE_MASK ((1 << LOG_MPAGE_SIZE) - 1) -#define MPAGE_START ~MPAGE_MASK - -#define BIGBLOCK_MIN_SIZE (1 << (LOG_MPAGE_SIZE - 2)) -#define FREE_LIST_ARRAY_SIZE (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE) - -/* Offset-page size: */ -#define LOG_OPAGE_SIZE (LOG_MPAGE_SIZE - LOG_WORD_SIZE - SQUASH_OFFSETS) -#define OPAGE_SIZE (sizeof(OffsetTy) << LOG_OPAGE_SIZE) - -/* We use a two-level table to map the universe. The MAP_SIZE is the - size of the outer table, so LOG_MAP_SIZE is the number of high-order - bits used to index the table. */ -#define LOG_MAP_SIZE 9 -#define LOG_MAPS_SIZE (WORD_BIT_COUNT - LOG_MAP_SIZE - LOG_MPAGE_SIZE) -#define MAP_SIZE (1 << LOG_MAP_SIZE) -#define MAPS_SIZE (1 << LOG_MAPS_SIZE) - -/* MASK_MASK followed by MAP_SHIFT gives the 2nd-page index. */ -#define MAPS_SHIFT (WORD_BIT_COUNT - LOG_MAPS_SIZE) -#define MAP_MASK ((1 << (LOG_MAP_SIZE + LOG_MPAGE_SIZE)) - 1) -#define MAP_SHIFT LOG_MPAGE_SIZE - -/* Allocation (MPage) types */ -#define MTYPE_NONE 0 -#define MTYPE_TAGGED 1 -#define MTYPE_ATOMIC 2 -#define MTYPE_TAGGED_ARRAY 3 -#define MTYPE_ARRAY 4 -#define MTYPE_XTAGGED 5 -#define MTYPE_MALLOCFREE 6 - -/* Allocation flags */ - -#define COLOR_MASK 0x3 - -#define MFLAG_GRAY 0x1 -#define MFLAG_BLACK 0x2 - -#define NONCOLOR_MASK 0xFC - -#define MFLAG_BIGBLOCK 0x4 -#define MFLAG_CONTINUED 0x8 - -#define MFLAG_OLD 0x10 -#define MFLAG_MODIFIED 0x20 -#define MFLAG_INITED 0x40 -#define MFLAG_MARK 0x80 - -/* Offset table manipulations */ - -#define OFFSET_COLOR_UNMASKED(offsets, pos) (offsets[pos]) -#define OFFSET_COLOR(offsets, pos) (offsets[pos] & COLOR_MASK) -#define OFFSET_SET_COLOR_UNMASKED(offsets, pos, c) (offsets[pos] = c) - -#if SQUASH_OFFSETS -# define OFFSET_HI_MASK 0xFC -# define OFFSET_LO_MASK 0xFF -# define OFFSET_HI_SHIFT 6 -# define OFFSET_SIZE(offsets, pos) (((OffsetTy)(offsets[pos] & OFFSET_HI_MASK) << OFFSET_HI_SHIFT) | (offsets[(pos)+1])) -# define OFFSET_SET_SIZE_UNMASKED(offsets, pos, s) (offsets[pos] = (((s) >> OFFSET_HI_SHIFT) & OFFSET_HI_MASK), offsets[(pos)+1] = ((s) & OFFSET_LO_MASK)) -#else -# define OFFSET_SHIFT 2 -# define OFFSET_SIZE(offsets, pos) ((offsets[pos]) >> OFFSET_SHIFT) -# define OFFSET_SET_SIZE_UNMASKED(offsets, pos, s) (offsets[pos] = ((s) << OFFSET_SHIFT)) -#endif - -/* Special tags */ - -#define SKIP ((Type_Tag)0x7000) -#define TAGGED_EOM ((Type_Tag)0x6000) -#define UNTAGGED_EOM (MPAGE_SIZE + 1) - -/* One MSet for every type of MPage: */ - -typedef struct { - void **low, **high; - MPage *malloc_page, *compact_page; - void **compact_to; - OffsetTy compact_to_offset; -#if USE_FREELIST - void *free_lists[FREE_LIST_ARRAY_SIZE]; -#endif -} MSet; - -#define NUM_SETS 5 -#define NUM_TAGGED_SETS 1 -#define NUM_NONATOMIC_SETS 4 -static MSet tagged, atomic, array, tagged_array, xtagged; -static MSet *sets[NUM_SETS]; /* First one is tagged, last one is atomic */ - -/********************* Statistics *********************/ -static long page_allocations = 0; - -static long memory_in_use, gc_threshold = GROW_ADDITION, max_memory_use; -static int prev_memory_in_use, memory_use_growth; -#if USE_FREELIST -static long on_free_list; -# define FREE_LIST_DELTA (on_free_list << LOG_WORD_SIZE) -#else -# define FREE_LIST_DELTA 0 -#endif - -#if GENERATIONS -static int generations_available = 1; -static long num_seg_faults; -#endif - -static int cycle_count = 0, compact_count = 0, gc_count = 0; -static int skipped_pages, scanned_pages, young_pages, inited_pages; - -static long iterations; - -#if TIME -static long mark_stackoflw; -#endif - -static int fnl_weak_link_count; - -static int ran_final; -static int running_finals; - -/******************** Misc ********************/ - -/* The answer for all 0-byte requests: */ -static char zero_sized[4]; - -/* Temporary pointer-holder used by routines that allocate */ -static void *park[2], *park_save[2]; - -static int during_gc, avoid_collection; - -static int resolve_for_fixup = 0; - -static MPage *find_page(void *p); - -#if CHECKS -static void CRASH(int where) -{ - GCPRINT(GCOUTF, "crash @%d\n", where); - GCFLUSHOUT(); -#ifdef _WIN32 - DebugBreak(); -#endif - abort(); -} - -#if DEFINE_MALLOC_FREE -static void check_not_freed(MPage *page, const void *p); -#endif - -static int just_checking, the_size; -#endif - -#include "my_qsort.c" - -/******************************************************************************/ -/* OS-specific low-level allocator */ -/******************************************************************************/ - -#define DONT_NEED_MAX_HEAP_SIZE -#include "vm.c" - - -static void *malloc_pages(size_t len, size_t alignment) -{ - page_allocations += len; - return vm_malloc_pages(GC->vm, len, alignment, 0); -} - -static void free_pages(void *p, size_t len) -{ - page_allocations -= len; - vm_free_pages(GC->vm, p, len); -} - -/******************************************************************************/ -/* client setup */ -/******************************************************************************/ - -static unsigned long stack_base; - -void GC_set_stack_base(void *base) -{ - stack_base = (unsigned long)base; -} - -void CompactGC_initialize(CompactGC *gc) { - memset(gc, 0, sizeof(CompactGC)); - gc->vm = vm_create(); -} - -void GC_init_type_tags(int count, int pair, int mutable_pair, int weakbox, int ephemeron, int weakarray, int custbox) -{ - CompactGC *gc; - weak_box_tag = weakbox; - ephemeron_tag = ephemeron; - weak_array_tag = weakarray; - pair_tag = pair; - - gc = malloc(sizeof(CompactGC)); - GC = gc; - CompactGC_initialize(gc); -} - -void GC_register_traversers(Type_Tag tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup, - int is_constant_size, int is_atomic) -{ - if (is_constant_size) { - long v; - v = size(NULL); - if (v < 100) - size = (Size_Proc)v; - } - - size_table[tag] = size; - mark_table[tag] = mark; - fixup_table[tag] = fixup; -} - -/******************************************************************************/ -/* root table */ -/******************************************************************************/ - -#include "roots.c" - -void GC_register_thread(void *p, void *c) -{ -} -void GC_register_new_thread(void *p, void *c) -{ -} - -/******************************************************************************/ -/* immobile box */ -/******************************************************************************/ - -/* The ImmobileBox struct is an internal view, only. To a GC client, - an immobile box starts with a longword for a pointer, and the rest - is undefined. */ -typedef struct ImmobileBox { - void *p; /* must be first in the record */ - struct ImmobileBox *next, *prev; -} ImmobileBox; - -static ImmobileBox *immobile; - -void **GC_malloc_immobile_box(void *p) -{ - ImmobileBox *ib; - - ib = (ImmobileBox *)malloc(sizeof(ImmobileBox)); - ib->p = p; - ib->next = immobile; - if (immobile) - immobile->prev = ib; - ib->prev = NULL; - - immobile = ib; - - return (void **)ib; -} - -void GC_free_immobile_box(void **b) -{ - ImmobileBox *ib = (ImmobileBox *)b; - - if (!ib) - return; - - if (ib->prev) - ib->prev->next = ib->next; - else - immobile = ib->next; - if (ib->next) - ib->next->prev = ib->prev; - - free(ib); -} - -/******************************************************************************/ -/* free list element */ -/******************************************************************************/ - -#if USE_FREELIST - -static int size_on_free_list(void *p) -{ - return ((OffsetTy *)p)[1]; -} - -#endif - -/******************************************************************************/ -/* weak arrays and boxes */ -/******************************************************************************/ - -static int is_marked(CompactGC *gc, void *p); -#define weak_box_resolve(p) (p) - -#include "weak.c" - -/******************************************************************************/ -/* finalization */ -/******************************************************************************/ - -static int is_finalizable_page(CompactGC *gc, void *p) -{ - MPage *page; - page = find_page(p); - return page && page->type; -} - -#include "fnls.c" - -static Fnl *run_queue, *last_in_queue; - -static void mark_finalizer(Fnl *fnl) -{ - gcMARK(fnl->next); - gcMARK(fnl->data); - /* !eager_level => queued for run: */ - if (!fnl->eager_level) { - gcMARK(fnl->p); - } -#if CHECKS - if (!fnl->tagged && fnl->size < BIGBLOCK_MIN_SIZE) { - if (((long *)fnl->p)[-1] != fnl->size) - CRASH(2); - } -#endif -} - -static void fixup_finalizer(Fnl *fnl) -{ -#if CHECKS - static void *old_fnl_p; - static MPage *old_fnl_page; - - old_fnl_p = fnl->p; - old_fnl_page = find_page(fnl->p); -#endif - - gcFIXUP(fnl->next); - gcFIXUP(fnl->data); - gcFIXUP(fnl->p); - -#if CHECKS - if (!fnl->tagged && fnl->size < BIGBLOCK_MIN_SIZE) { - if (!(((long)fnl->p) & MPAGE_MASK)) - CRASH(3); - } -#endif -} - -typedef struct Fnl_Weak_Link { - void *p; - int offset; - void *saved; - struct Fnl_Weak_Link *next; -} Fnl_Weak_Link; - -static Fnl_Weak_Link *fnl_weaks; - -static void mark_finalizer_weak_link(Fnl_Weak_Link *wl) -{ - gcMARK(wl->next); -} - -static void fixup_finalizer_weak_link(Fnl_Weak_Link *wl) -{ - gcFIXUP(wl->next); - gcFIXUP(wl->p); -} - -void GC_finalization_weak_ptr(void **p, int offset) -{ - Fnl_Weak_Link *wl; - -#if CHECKS - if (offset < 0) - CRASH(6); -#endif - - /* Allcation might trigger GC, so we use park: */ - park[0] = p; - - wl = (Fnl_Weak_Link *)GC_malloc_atomic(sizeof(Fnl_Weak_Link)); - - p = park[0]; - park[0] = NULL; - - wl->p = p; - wl->next = fnl_weaks; - wl->offset = offset * sizeof(void*); - - fnl_weaks = wl; - - fnl_weak_link_count++; -} - -/******************************************************************************/ -/* alloc state info */ -/******************************************************************************/ - -/* Works anytime: */ -static MPage *find_page(void *p) -{ - unsigned long g = ((unsigned long)p >> MAPS_SHIFT); - MPage *map; - - map = mpage_maps[g]; - if (map) { - unsigned long addr = (((unsigned long)p & MAP_MASK) >> MAP_SHIFT); - MPage *page; - - page = map + addr; - return page; - } - - return NULL; -} - -int GC_is_allocated(void *p) -{ - return !!find_page(p); -} - -/* Works only during GC: */ -static int is_marked(CompactGC *gc, void *p) -{ - unsigned long g = ((unsigned long)p >> MAPS_SHIFT); - MPage *map; - - map = mpage_maps[g]; - if (map) { - MPage *page; - - page = map + (((unsigned long)p & MAP_MASK) >> MAP_SHIFT); -#if DEFINE_MALLOC_FREE - if (page->type == MTYPE_MALLOCFREE) - return 1; -#endif - if (page->flags & MFLAG_BIGBLOCK) { - if (page->flags & MFLAG_CONTINUED) - return is_marked(gc, page->o.bigblock_start); - else - return (page->flags & (COLOR_MASK | MFLAG_OLD)); - } else { - if (page->flags & MFLAG_OLD) - return 1; - else if (page->flags & COLOR_MASK) { - long offset = ((long)p & MPAGE_MASK) >> LOG_WORD_SIZE; - - if (page->type > MTYPE_TAGGED) - offset -= 1; - - return OFFSET_COLOR(page->u.offsets, offset); - } else if ((long)p & 0x1) - return 1; - else - return 0; - } - } - - return 1; -} - -#if SEARCH -void *search_for, *search_mark = 0x7; -long search_size; - -void stop() -{ - GCPRINT(GCOUTF, "stopped\n"); -} -#endif - -/******************************************************************************/ -/* init phase */ -/******************************************************************************/ - -/* Init: set color to white and install offsets (to indicate the - offset to the start of and allocation block) for marking. */ - -#if CHECKS -static void **prev_ptr, **prev_prev_ptr, **prev_prev_prev_ptr; -static void **prev_prev_prev_prev_ptr, **prev_prev_prev_prev_prev_ptr; -static void **prev_var_stack; -#endif - -static void init_tagged_mpage(void **p, MPage *page) -{ - OffsetTy offset = 0; - OffsetArrTy *offsets; - void **top; - - page->flags = (page->flags & NONCOLOR_MASK); - offsets = page->u.offsets; - top = p + MPAGE_WORDS; - - page->alloc_boundary = MPAGE_WORDS; - - while (p < top) { - Type_Tag tag; - long size; - - tag = *(Type_Tag *)p; - - if (tag == TAGGED_EOM) { - /* Remember empty space for prop and compact: */ - page->alloc_boundary = offset; - break; - } - -#if ALIGN_DOUBLES - if (tag == SKIP) { - OFFSET_SET_SIZE_UNMASKED(offsets, offset, 1); - offset++; - p++; - } else { -#endif - -#if CHECKS - if ((tag < 0) || (tag >= NUMBER_OF_TAGS) || !size_table[tag]) { - GCPRINT(GCOUTF, "bad tag: %d at %lx\n", tag, (long)p); - GCFLUSHOUT(); - CRASH(7); - } - prev_prev_prev_prev_prev_ptr = prev_prev_prev_prev_ptr; - prev_prev_prev_prev_ptr = prev_prev_prev_ptr; - prev_prev_prev_ptr = prev_prev_ptr; - prev_prev_ptr = prev_ptr; - prev_ptr = p; - prev_var_stack = GC_variable_stack; -#endif - - { - Size_Proc size_proc; - - size_proc = size_table[tag]; - if (((long)size_proc) < 100) - size = (long)size_proc; - else - size = size_proc(p); - } - -#if CHECKS - if (size < 1) { - CRASH(57); - } -#endif - - OFFSET_SET_SIZE_UNMASKED(offsets, offset, size); - offset += size; - -#if CHECKS - if (prev_var_stack != GC_variable_stack) { - CRASH(8); - } -#endif - - p += size; -#if ALIGN_DOUBLES - } -#endif - } - - inited_pages++; -} - -static void init_untagged_mpage(void **p, MPage *page) -{ - OffsetTy offset = 0; - OffsetArrTy *offsets; - void **top; - - page->flags = (page->flags & NONCOLOR_MASK); - offsets = page->u.offsets; - page->alloc_boundary = MPAGE_WORDS; - - top = p + MPAGE_WORDS; - - while (p < top) { - long size; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) { - /* Remember empty space for prop: */ - page->alloc_boundary = offset; - - break; - } - -#if CHECKS - if (0 && page->type == MTYPE_XTAGGED) { - just_checking = 1; - GC_mark_xtagged(p + 1); - just_checking = 0; - } - - the_size = size; -#endif - - OFFSET_SET_SIZE_UNMASKED(offsets, offset, 0); - offset += size; - - p += size; - } - - inited_pages++; -} - -static void init_all_mpages(int young) -{ - MPage *page; - - for (page = first; page; page = page->next) { - int is_old = (page->age > young); -#if GENERATIONS - void *p = page->block_start; -#endif - - if (!is_old && !(page->flags & MFLAG_MODIFIED)) { -#if GENERATIONS - if (generations_available) { - if (page->flags & MFLAG_BIGBLOCK) - vm_protect_pages((void *)p, page->u.size, 1); - else - vm_protect_pages((void *)p, MPAGE_SIZE, 1); - } -#endif - page->flags |= MFLAG_MODIFIED; - } - - if (is_old) { - page->flags -= (page->flags & MFLAG_MARK); - page->flags |= MFLAG_OLD; - } else { - page->flags -= (page->flags & MFLAG_OLD); - page->flags |= MFLAG_MARK; - young_pages++; - } - - if (!(page->flags & MFLAG_INITED)) { - void *p = page->block_start; - - if (page->flags & MFLAG_BIGBLOCK) { - page->flags = (page->flags & NONCOLOR_MASK); - page->flags |= MFLAG_INITED; - } else { - if (is_old) { - if (page->type <= MTYPE_TAGGED) - init_tagged_mpage((void **)p, page); - else - init_untagged_mpage((void **)p, page); - page->flags |= MFLAG_INITED; - } else { - /* Young pages: initialize lazily as needed by `mark'. - Not initialized means full page is garbage. */ - page->flags = (page->flags & NONCOLOR_MASK); - } - - if (is_old) { - skipped_pages++; - } - } - } else { - if (is_old) - skipped_pages++; - /* Clear color flags: */ - page->flags = (page->flags & NONCOLOR_MASK); - } - - if (is_old - && ((page->refs_age <= young) - || (page->flags & MFLAG_MODIFIED)) - && (page->type != MTYPE_ATOMIC)) { - /* Offsets inited; need to set gray flag */ - page->flags |= MFLAG_GRAY; - - page->gray_next = gray_first; - gray_first = page; - - page->gray_start = 0; - page->gray_end = page->alloc_boundary - 2; - - if (!(page->flags & MFLAG_MODIFIED)) { -#if GENERATIONS - if (generations_available) { - if (page->flags & MFLAG_BIGBLOCK) - vm_protect_pages((void *)p, page->u.size, 1); - else - vm_protect_pages((void *)p, MPAGE_SIZE, 1); - } -#endif - page->flags |= MFLAG_MODIFIED; - } - - scanned_pages++; - } - } -} - -/******************************************************************************/ -/* mark phase */ -/******************************************************************************/ - -/* Mark: mark a block as reachable. */ - -#if MARK_STATS -long mark_calls, mark_hits, mark_recalls, mark_colors, mark_many, mark_slow; -#endif - -void GC_mark(const void *p) -{ - unsigned long g; - MPage *map; - -#if CHECKS - if (just_checking) { - return; - } -#endif -#if MARK_STATS - mark_calls++; -#endif - - if ((long)p & 0x1) return; - g = ((unsigned long)p >> MAPS_SHIFT); - - map = mpage_maps[g]; - if (map) { - MPage *page; - mflags_t flags; - - page = map + (((unsigned long)p & MAP_MASK) >> MAP_SHIFT); - -#if SEARCH - if (p == search_mark) { - stop(); - } -#endif - -#if DEFINE_MALLOC_FREE - if (page->type == MTYPE_MALLOCFREE) { -#if CHECKS - check_not_freed(page, p); -#endif - return; - } -#endif - - flags = page->flags; - if (flags & (MFLAG_MARK | MFLAG_CONTINUED)) { -#if MARK_STATS - mark_hits++; -#endif - - if (flags & MFLAG_BIGBLOCK) { - if (flags & MFLAG_CONTINUED) { - void *p2; - unsigned long g2; -#if MARK_STATS - mark_recalls++; -#endif - p2 = page->o.bigblock_start; - g2 = ((unsigned long)p2 >> MAPS_SHIFT); - page = mpage_maps[g2] + (((unsigned long)p2 & MAP_MASK) >> MAP_SHIFT); - flags = page->flags; - - if (!(flags & MFLAG_MARK)) - return; - } - - if (!(flags & COLOR_MASK)) { -#if MARK_STATS - mark_colors++; -#endif - page->flags = (flags | MFLAG_GRAY); - - if (page->type != MTYPE_ATOMIC) { - page->gray_next = gray_first; - gray_first = page; - } - -#if KEEP_BACKPOINTERS - page->backpointer_page = mark_src; -#endif - } - } else { - long offset; - OffsetArrTy v; - mtype_t type; - - type = page->type; - - /* Check for lazy initialization: */ - if (!(flags & MFLAG_INITED)) { - if (type <= MTYPE_TAGGED) - init_tagged_mpage((void **)page->block_start, page); - else - init_untagged_mpage((void **)page->block_start, page); - flags |= MFLAG_INITED; - page->flags = flags; - } - - if (type > MTYPE_TAGGED) { -#if CHECKS - if (!((long)p & MPAGE_MASK)) { - /* Can't point to beginning of non-tagged block! */ - CRASH(9); - } -#endif - p = BYTEPTR(p) - WORD_SIZE; - } - - offset = ((long)p & MPAGE_MASK) >> LOG_WORD_SIZE; - -#if CHECKS - if (offset >= page->alloc_boundary) { - /* Past allocation region. */ - CRASH(10); - } -#endif - - v = OFFSET_COLOR_UNMASKED(page->u.offsets, offset); - if (!(v & COLOR_MASK)) { -#if MARK_STATS - mark_colors++; -#endif - - switch(type) { - case MTYPE_ATOMIC: - OFFSET_SET_COLOR_UNMASKED(page->u.offsets, offset, v | MFLAG_BLACK); - if (!(flags & MFLAG_BLACK)) { - page->flags = (flags | MFLAG_BLACK); - } -#if KEEP_BACKPOINTERS - page->backpointer_page[offset] = mark_src; -#endif - break; - case MTYPE_TAGGED: -#if CHECKS - { - Type_Tag tag = *(Type_Tag *)p; - if ((tag < 0) || (tag >= NUMBER_OF_TAGS) || !size_table[tag]) { - GCPRINT(GCOUTF, "bad tag: %d at %lx\n", tag, (long)p); - CRASH(11); - } - } -#endif - case MTYPE_XTAGGED: - case MTYPE_ARRAY: - if (mark_stack_pos < MARK_STACK_MAX) { - page->flags = (flags | MFLAG_BLACK); - OFFSET_SET_COLOR_UNMASKED(page->u.offsets, offset, v | MFLAG_BLACK); /* black can mean on stack */ -# if RECORD_MARK_SRC -# if CHECKS - if ((long)mark_src & 0x1) CRASH(12); -# endif - mark_src_stack[mark_stack_pos] = mark_src; - mark_src_type[mark_stack_pos] = mark_type; -# endif - mark_stack[mark_stack_pos] = (void *)p; - mark_stack_type[mark_stack_pos++] = type; -#if KEEP_BACKPOINTERS - page->backpointer_page[offset] = mark_src; -#endif - break; - } - default: /* ^^^ fallthrough */ - OFFSET_SET_COLOR_UNMASKED(page->u.offsets, offset, v | MFLAG_GRAY); -#if TIME - mark_stackoflw++; -#endif -#if KEEP_BACKPOINTERS - page->backpointer_page[offset] = mark_src; -#endif - if (!(flags & MFLAG_GRAY)) { - page->flags = (flags | MFLAG_GRAY); - - page->gray_next = gray_first; - gray_first = page; - - page->gray_start = offset; - page->gray_end = offset; - } else { - if (page->gray_start > offset) - page->gray_start = offset; - if (page->gray_end < offset) - page->gray_end = offset; - } - } - } else { -#if CHECKS - if (!(flags & COLOR_MASK)) { - CRASH(13); - } -#endif - } - } - } - } -} - -/******************************************************************************/ -/* prop phase */ -/******************************************************************************/ - -/* Propoagate: for each marked object, mark objects it - reaches... until fixpoint. */ - -static void propagate_tagged_mpage(void **bottom, MPage *page) -{ - OffsetTy offset; - OffsetArrTy *offsets; - void **p, **graytop; - - offsets = page->u.offsets; - - offset = page->gray_start; - p = bottom + offset; - graytop = bottom + page->gray_end; - - while (p <= graytop) { - OffsetArrTy v; - Type_Tag tag; - long size; - - tag = *(Type_Tag *)p; - -#if ALIGN_DOUBLES - if (tag != SKIP) { -#endif - -#if RECORD_MARK_SRC - mark_src = p; - mark_type = MTYPE_TAGGED; -#endif - - v = OFFSET_COLOR_UNMASKED(offsets, offset); - size = OFFSET_SIZE(offsets, offset); - if (v & MFLAG_GRAY) { - v -= MFLAG_GRAY; - v |= MFLAG_BLACK; - OFFSET_SET_COLOR_UNMASKED(offsets, offset, v); - mark_table[tag](p); - } - -#if ALIGN_DOUBLES - } else - size = 1; -#endif - - p += size; - offset += size; - } - -#if MARK_STATS - mark_many++; -#endif - -#if MARK_STATS - if (page->flags & MFLAG_GRAY) { - mark_slow++; - } -#endif -} - -static void propagate_tagged_whole_mpage(void **p, MPage *page) -{ - void **top; - - top = p + MPAGE_WORDS; - - while (p < top) { - Type_Tag tag; - long size; - - tag = *(Type_Tag *)p; - - if (tag == TAGGED_EOM) { - break; - } - -#if ALIGN_DOUBLES - if (tag == SKIP) { - p++; - } else { -#endif - -#if RECORD_MARK_SRC - mark_src = p; - mark_type = MTYPE_TAGGED; -#endif - - size = mark_table[tag](p); - - p += size; - -#if ALIGN_DOUBLES - } -#endif - } -} - -static void propagate_array_mpage(void **bottom, MPage *page) -{ - OffsetTy offset; - OffsetArrTy *offsets; - void **p, **top; - - offset = page->gray_start; - p = bottom + offset; - top = bottom + page->gray_end; - offsets = page->u.offsets; - - while (p <= top) { - OffsetArrTy v; - long size; - - size = *(long *)p + 1; - -#if CHECKS - if ((size < 2) || (size > MPAGE_WORDS)) { - CRASH(14); - } - prev_ptr = p; -#endif - - v = OFFSET_COLOR_UNMASKED(offsets, offset); - if (v & MFLAG_GRAY) { - int i; - -#if RECORD_MARK_SRC - mark_src = p + 1; - mark_type = MTYPE_ARRAY; -#endif - - v -= MFLAG_GRAY; - v |= MFLAG_BLACK; - OFFSET_SET_COLOR_UNMASKED(offsets, offset, v); - - for (i = 1; i < size; i++) { - gcMARK(p[i]); - } - } - - p += size; - offset += size; - -#if CHECKS - if ((p > bottom + MPAGE_WORDS + 1) || (p < bottom)) { - CRASH(15); - } -#endif - } -} - -static void propagate_array_whole_mpage(void **p, MPage *page) -{ - void **top; - - top = p + MPAGE_WORDS; - - while (p < top) { - long size, i; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) { - break; - } - -#if RECORD_MARK_SRC - mark_src = p + 1; - mark_type = MTYPE_ARRAY; -#endif - - for (i = 1; i < size; i++) { - gcMARK(p[i]); - } - - p += size; - } -} - -static void propagate_tagged_array_mpage(void **bottom, MPage *page) -{ - OffsetTy offset; - OffsetArrTy *offsets; - void **p, **top; - - offset = page->gray_start; - p = bottom + offset; - top = bottom + page->gray_end; - offsets = page->u.offsets; - - while (p <= top) { - OffsetArrTy v; - int size; - - size = *(long *)p + 1; - - v = OFFSET_COLOR_UNMASKED(offsets, offset); - if (v & MFLAG_GRAY) { - v -= MFLAG_GRAY; - v |= MFLAG_BLACK; - OFFSET_SET_COLOR_UNMASKED(offsets, offset, v); - - { - int i, elem_size; - void **mp = p + 1; - Type_Tag tag; - Mark_Proc traverse; - -#if RECORD_MARK_SRC - mark_src = mp; - mark_type = MTYPE_TAGGED_ARRAY; -#endif - - size--; - tag = *(Type_Tag *)mp; - - traverse = mark_table[tag]; - elem_size = traverse(mp); - mp += elem_size; - for (i = elem_size; i < size; i += elem_size, mp += elem_size) - traverse(mp); - - size++; - } - } - - p += size; - offset += size; - } -} - -static void propagate_tagged_array_whole_mpage(void **p, MPage *page) -{ - void **top; - - top = p + MPAGE_WORDS; - - while (p < top) { - int i, elem_size, size; - void **mp; - Type_Tag tag; - Mark_Proc traverse; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) - break; - - mp = p + 1; - p += size; - size--; - - tag = *(Type_Tag *)mp; - -#if RECORD_MARK_SRC - mark_src = mp; - mark_type = MTYPE_TAGGED_ARRAY; -#endif - - traverse = mark_table[tag]; - elem_size = traverse(mp); - mp += elem_size; - for (i = elem_size; i < size; i += elem_size, mp += elem_size) - traverse(mp); - } -} - -static void propagate_xtagged_mpage(void **bottom, MPage *page) -{ - OffsetTy offset; - OffsetArrTy *offsets; - void **p, **top; - - offset = page->gray_start; - p = bottom + offset; - top = bottom + page->gray_end; - offsets = page->u.offsets; - - while (p <= top) { - OffsetArrTy v; - long size; - - size = *(long *)p + 1; - -#if ALIGN_DOUBLES - if (size > 1) { -#endif - - v = OFFSET_COLOR_UNMASKED(offsets, offset); - if (v & MFLAG_GRAY) { - v -= MFLAG_GRAY; - v |= MFLAG_BLACK; - OFFSET_SET_COLOR_UNMASKED(offsets, offset, v); - -#if RECORD_MARK_SRC - mark_src = p + 1; - mark_type = MTYPE_XTAGGED; -#endif - - GC_mark_xtagged(p + 1); - } - -#if ALIGN_DOUBLES - } -#endif - - p += size; - offset += size; - } -} - -static void propagate_xtagged_whole_mpage(void **p, MPage *page) -{ - void **top; - - top = p + MPAGE_WORDS; - - while (p < top) { - long size; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) { - break; - } - -#if RECORD_MARK_SRC - mark_src = p + 1; - mark_type = MTYPE_XTAGGED; -#endif - -#if ALIGN_DOUBLES - if (size > 1) { -#endif - - GC_mark_xtagged(p + 1); - -#if ALIGN_DOUBLES - } -#endif - - p += size; - } -} - -static void do_bigblock(void **p, MPage *page, int fixup) -{ - switch (page->type) { - case MTYPE_ATOMIC: - return; - - case MTYPE_TAGGED: - { - Type_Tag tag; - - tag = *(Type_Tag *)p; - -#if CHECKS - if ((tag < 0) || (tag >= NUMBER_OF_TAGS) || !size_table[tag]) { - CRASH(16); - } - prev_var_stack = GC_variable_stack; -#endif -#if RECORD_MARK_SRC - mark_src = p; - mark_type = MTYPE_TAGGED; -#endif - - if (fixup) - fixup_table[tag](p); - else - mark_table[tag](p); - -#if CHECKS - if (prev_var_stack != GC_variable_stack) { - CRASH(17); - } -#endif - - return; - } - - case MTYPE_TAGGED_ARRAY: - { - int i, elem_size, size; - void **mp = p; - Type_Tag tag; - Mark_Proc mark; - - size = page->u.size >> LOG_WORD_SIZE; - tag = *(Type_Tag *)mp; - -#if RECORD_MARK_SRC - mark_src = mp; - mark_type = MTYPE_TAGGED_ARRAY; -#endif - - if (fixup) - mark = fixup_table[tag]; - else - mark = mark_table[tag]; - elem_size = mark(mp); - mp += elem_size; - for (i = elem_size; i < size; i += elem_size, mp += elem_size) - mark(mp); - - return; - } - - case MTYPE_ARRAY: - { - int i; - long size = page->u.size >> LOG_WORD_SIZE; - - if (fixup) { - for (i = 0; i < size; i++, p++) { - if (*p) - gcFIXUP(*p); - } - } else { -#if RECORD_MARK_SRC - mark_src = p; - mark_type = MTYPE_ARRAY; -#endif - for (i = 0; i < size; i++, p++) { - if (*p) - gcMARK(*p); - } - } - - return; - } - - case MTYPE_XTAGGED: - default: -#if RECORD_MARK_SRC - mark_src = p; - mark_type = MTYPE_XTAGGED; -#endif - if (fixup) - GC_fixup_xtagged(p); - else - GC_mark_xtagged(p); - return; - } -} - -static int old_tag; -static void *old_p; - -static void propagate_all_mpages() -{ - MPage *page; - void *p; - - while (gray_first || mark_stack_pos) { - iterations++; - - while (mark_stack_pos) { - mtype_t type; - - p = mark_stack[--mark_stack_pos]; - type = mark_stack_type[mark_stack_pos]; -# if RECORD_MARK_SRC - current_mark_src = mark_src_stack[mark_stack_pos]; - current_mark_type = mark_src_type[mark_stack_pos]; -# endif - - switch (type) { - case MTYPE_TAGGED: - { - Type_Tag tag; - tag = *(Type_Tag *)p; - -#if ALIGN_DOUBLES - if (tag != SKIP) { -#endif - -#if CHECKS - if ((tag < 0) || (tag >= NUMBER_OF_TAGS) || !size_table[tag]) { - CRASH(18); - } -#endif -#if RECORD_MARK_SRC - mark_src = p; - mark_type = MTYPE_TAGGED; -#endif - - old_tag = tag; - old_p = p; - mark_table[tag](p); - -#if ALIGN_DOUBLES - } -#endif - } - break; - - case MTYPE_XTAGGED: -#if RECORD_MARK_SRC - mark_src = (void **)p + 1; - mark_type = MTYPE_XTAGGED; -#endif - GC_mark_xtagged((void **)p + 1); - break; - - default: /* MTYPE_ARRAY */ - { - long size, i; - - size = ((long *)p)[0]; - -#if RECORD_MARK_SRC - mark_src = (void **)p + 1; - mark_type = MTYPE_ARRAY; -#endif - - for (i = 1; i <= size; i++) { - gcMARK(((void **)p)[i]); - } - } - } - } - - if (gray_first) { - page = gray_first; - gray_first = page->gray_next; - - page->flags = ((page->flags & NONCOLOR_MASK) | MFLAG_BLACK); - p = page->block_start; - - if (page->flags & MFLAG_BIGBLOCK) { - if (!(page->flags & MFLAG_CONTINUED)) - do_bigblock((void **)p, page, 0); - } else { - switch (page->type) { - case MTYPE_ATOMIC: - break; - case MTYPE_TAGGED: - if (page->flags & MFLAG_OLD) - propagate_tagged_whole_mpage((void **)p, page); - else - propagate_tagged_mpage((void **)p, page); - break; - case MTYPE_TAGGED_ARRAY: - if (page->flags & MFLAG_OLD) - propagate_tagged_array_whole_mpage((void **)p, page); - else - propagate_tagged_array_mpage((void **)p, page); - break; - case MTYPE_XTAGGED: - if (page->flags & MFLAG_OLD) - propagate_xtagged_whole_mpage((void **)p, page); - else - propagate_xtagged_mpage((void **)p, page); - break; - case MTYPE_ARRAY: - default: - if (page->flags & MFLAG_OLD) - propagate_array_whole_mpage((void **)p, page); - else - propagate_array_mpage((void **)p, page); - break; - } - } - } - } -} - -/******************************************************************************/ -/* compact phase */ -/******************************************************************************/ - -/* Compact: compact objects, setting page color to white if all - objects are moved elsewhere */ - -static void compact_tagged_mpage(void **p, MPage *page) -{ - int to_near = 0, set_age = 0; - OffsetTy offset, dest_offset, dest_start_offset; - OffsetArrTy *offsets; - void **dest, **startp; - void **top; - MSet *set; - - offsets = page->u.offsets; - - top = p + page->alloc_boundary; - - startp = p; - switch (page->type) { - case MTYPE_TAGGED: - default: - set = &tagged; - break; - } - dest = set->compact_to; - dest_start_offset = set->compact_to_offset; - dest_offset = dest_start_offset; - offset = 0; - - page->o.compact_to = dest; - page->compact_boundary = MPAGE_WORDS; - - while (p < top) { - long size; - - size = OFFSET_SIZE(offsets, offset); - -#if CHECKS - if (!size) { - CRASH(19); - } - prev_prev_prev_ptr = prev_prev_ptr; - prev_prev_ptr = prev_ptr; - prev_ptr = p; -#endif - - if (OFFSET_COLOR(offsets, offset)) { -#if ALIGN_DOUBLES -#define PLUS_ALIGNMENT + alignment - long alignment; - if (!(size & 0x1) && (dest_offset & 0x1)) - alignment = 1; - else - alignment = 0; -#else -# define PLUS_ALIGNMENT /**/ -#endif - - if (dest_offset + size PLUS_ALIGNMENT > MPAGE_WORDS) { - /* Set end of allocation area in previous page: */ - if (dest_offset < MPAGE_WORDS) - *(Type_Tag *)(dest + dest_offset) = TAGGED_EOM; - -#if NOISY - GCPRINT(GCOUTF, "t: %lx [0,%d] -> %lx [%d,%d]\n", - (long)startp, offset, - (long)dest, dest_start_offset, dest_offset); -#endif - - dest_offset = 0; - dest = startp; - to_near = 1; - if (set_age) { - page->compact_boundary = offset; - set->compact_page->age = page->age; - set->compact_page->refs_age = page->age; - } else - /* Haven't moved anything; set boundary to 0 to indicate this */ - page->compact_boundary = 0; - } else { - set_age = 1; -#if ALIGN_DOUBLES - if (alignment) { - *(Type_Tag *)(dest + dest_offset) = SKIP; - dest_offset++; - } -#endif - } - - if (!to_near || (dest_offset != offset)) { - memmove(dest + dest_offset, p, size << LOG_WORD_SIZE); -#if KEEP_BACKPOINTERS - if (to_near) - page->backpointer_page[dest_offset] = page->backpointer_page[offset]; - else - set->compact_page->backpointer_page[dest_offset] = page->backpointer_page[offset]; -#endif - } - - OFFSET_SET_SIZE_UNMASKED(offsets, offset, dest_offset); - offset += size; - dest_offset += size; - - p += size; - } else { - p += size; - offset += size; - } - } - - if (to_near) - set->compact_page = page; - set->compact_to = dest; - set->compact_to_offset = dest_offset; - - if (!to_near) { - /* Nothing left in here. Reset color to white: */ - page->flags = (page->flags & NONCOLOR_MASK); -#if NOISY - GCPRINT(GCOUTF, "t: %lx [all=%d] -> %lx [%d,%d]\n", - (long)startp, offset, - (long)dest, dest_start_offset, dest_offset); -#endif - } -} - -static void compact_untagged_mpage(void **p, MPage *page) -{ - int to_near = 0, set_age = 0; - OffsetTy offset = 0, dest_offset; - OffsetArrTy *offsets; - void **dest, **startp, **top; - MSet *set; - - offsets = page->u.offsets; - - startp = p; - switch (page->type) { - case MTYPE_TAGGED_ARRAY: - set = &tagged_array; - break; - case MTYPE_ATOMIC: - set = &atomic; - break; - case MTYPE_XTAGGED: - set = &xtagged; - break; - default: - set = &array; - break; - } - - dest = set->compact_to; - dest_offset = set->compact_to_offset; - - page->o.compact_to = dest; - page->compact_boundary = MPAGE_WORDS; - - top = p + MPAGE_WORDS; - -#if CHECKS - if (dest == startp) { - if (dest_offset < MPAGE_WORDS) { - /* Can't compact to self! */ - CRASH(20); - } - } -#endif - - while (p < top) { - long size; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) { -#if CHECKS - if (p < startp + page->alloc_boundary) { - /* Premature end */ - CRASH(21); - } -#endif - break; - } - -#if CHECKS - if (size >= BIGBLOCK_MIN_SIZE) { - CRASH(22); - } -#endif - - if (OFFSET_COLOR(offsets, offset)) { -#if ALIGN_DOUBLES - long alignment; - if ((size & 0x1) && !(dest_offset & 0x1)) - alignment = 1; - else - alignment = 0; -#endif - - if ((long)dest_offset + size PLUS_ALIGNMENT > MPAGE_WORDS) { - /* Set end of allocation area in previous page: */ - if (dest_offset < MPAGE_WORDS) - *(long *)(dest + dest_offset) = UNTAGGED_EOM - 1; - -#if NOISY - GCPRINT(GCOUTF, "u: %lx -> %lx [%d]\n", (long)startp, (long)dest, offset); -#endif - - dest_offset = 0; - dest = startp; - to_near = 1; -#if ALIGN_DOUBLES - if (size & 0x1) { - dest[0] = 0; - dest_offset++; - } -#endif - - if (set_age) { - page->compact_boundary = offset; - set->compact_page->age = page->age; - set->compact_page->refs_age = page->age; - } else - /* Haven't moved anything; set boundary to 0 to indicate this */ - page->compact_boundary = 0; - } else { - set_age = 1; -#if ALIGN_DOUBLES - if (alignment) { - dest[dest_offset] = 0; - dest_offset++; - } -#endif - } - - if (!to_near || (dest_offset != offset)) { - memmove(dest + dest_offset, p, size << LOG_WORD_SIZE); -#if KEEP_BACKPOINTERS - if (to_near) - page->backpointer_page[dest_offset] = page->backpointer_page[offset]; - else - set->compact_page->backpointer_page[dest_offset] = page->backpointer_page[offset]; -#endif - } - - OFFSET_SET_SIZE_UNMASKED(offsets, offset, dest_offset+1); -#if CHECKS - if (!offsets[offset] && !offsets[offset+1]) - CRASH(23); -#endif - offset += size; - dest_offset += size; - - p += size; - } else { - p += size; - offset += size; - } - } - - set->compact_to = dest; - set->compact_to_offset = dest_offset; - if (to_near) - set->compact_page = page; - - if (!to_near) { - /* Nothing left in here. Reset color to white: */ - page->flags = (page->flags & NONCOLOR_MASK); -#if NOISY - GCPRINT(GCOUTF, "u: %lx -> %lx [all]\n", (long)startp, (long)dest); -#endif - } -} - -static void compact_all_mpages() -{ - MPage *page; - int i; - - for (i = 0; i < NUM_SETS; i++) - sets[i]->compact_to_offset = MPAGE_WORDS; - - for (page = first; page; page = page->next) { - if (!(page->flags & (MFLAG_BIGBLOCK | MFLAG_OLD))) { - if (page->flags & COLOR_MASK) { - void *p; - - page->flags -= (page->flags & MFLAG_INITED); - p = page->block_start; - - if (page->type <= MTYPE_TAGGED) - compact_tagged_mpage((void **)p, page); - else - compact_untagged_mpage((void **)p, page); - } else { - /* Set compact_boundar to 0 to indicate no moves: */ - page->compact_boundary = 0; -#if NOISY - GCPRINT(GCOUTF, "x: %lx\n", (long)page->block_start); -#endif - } - } - } - - for (i = 0; i < NUM_TAGGED_SETS; i++) { - if (sets[i]->compact_to_offset < MPAGE_WORDS) - *(Type_Tag *)(sets[i]->compact_to + sets[i]->compact_to_offset) = TAGGED_EOM; - } - for (i = NUM_TAGGED_SETS; i < NUM_SETS; i++) { - if (sets[i]->compact_to_offset < MPAGE_WORDS) - *(long *)(sets[i]->compact_to + sets[i]->compact_to_offset) = UNTAGGED_EOM - 1; - } -} - -/******************************************************************************/ -/* freelist phase */ -/******************************************************************************/ - -/* Freelist: put unmarked blocks onto the free list */ - -#if USE_FREELIST - -static void freelist_tagged_mpage(void **p, MPage *page) -{ - OffsetTy offset; - OffsetArrTy *offsets; - void **top; - void **free_lists; - long on_at_start = on_free_list; - - offsets = page->u.offsets; - - top = p + page->alloc_boundary; - - offset = 0; - - switch (page->type) { - case MTYPE_TAGGED: - default: - free_lists = tagged.free_lists; - break; - } - - while (p < top) { - long size; - OffsetArrTy v; - - size = OFFSET_SIZE(offsets, offset); - - v = OFFSET_COLOR_UNMASKED(offsets, offset); - if (!(v & COLOR_MASK)) { -#if ALIGN_DOUBLES - if (size > 1) { -#endif - /* HACK! This relies on both Type_Tag and OffsetTy being `short' */ - ((Type_Tag *)p)[0] = gc_on_free_list_tag; - ((Type_Tag *)p)[1] = size; - p[1] = free_lists[size]; - free_lists[size] = (void *)p; - on_free_list += size; -#if ALIGN_DOUBLES - } -#endif - } else { - /* Remove color: */ - v -= (v & (MFLAG_GRAY | MFLAG_BLACK)); - OFFSET_SET_COLOR_UNMASKED(offsets, offset, v); - } - - p += size; - offset += size; - } - - if (on_at_start != on_free_list) - page->age = page->refs_age = -1; /* will be promoted to 0 */ -} - -static void freelist_untagged_mpage(void **p, MPage *page) -{ - OffsetTy offset = 0; - OffsetArrTy *offsets; - void **free_lists, **top; - long on_at_start = on_free_list; - - switch (page->type) { - case MTYPE_TAGGED_ARRAY: - free_lists = tagged_array.free_lists; - break; - case MTYPE_ATOMIC: - free_lists = atomic.free_lists; - break; - case MTYPE_XTAGGED: - free_lists = xtagged.free_lists; - break; - default: - free_lists = array.free_lists; - break; - } - - offsets = page->u.offsets; - top = p + MPAGE_WORDS; - - while (p < top) { - long size; - OffsetArrTy v; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) - break; - -#if CHECKS - if (size >= BIGBLOCK_MIN_SIZE) { - CRASH(24); - } -#endif - - v = OFFSET_COLOR_UNMASKED(offsets, offset); - if (!(v & COLOR_MASK)) { -#if ALIGN_DOUBLES - if (size > 1) { -#endif - p[1] = free_lists[size-1]; - free_lists[size-1] = (void *)(p + 1); - on_free_list += (size-1); -#if ALIGN_DOUBLES - } -#endif - } else { - /* Remove color: */ - v -= (v & (MFLAG_GRAY | MFLAG_BLACK)); - OFFSET_SET_COLOR_UNMASKED(offsets, offset, v); - } - - p += size; - offset += size; - } - - if (on_at_start != on_free_list) - page->age = page->refs_age = -1; /* will be promoted to 0 */ -} - -static void freelist_all_mpages(int young) -{ - MPage *page; - - for (page = first; page; page = page->next) { - if (page->flags & COLOR_MASK) { - if (page->refs_age <= young) - page->refs_age = -1; /* best we can assume */ - if (!(page->flags & (MFLAG_BIGBLOCK | MFLAG_OLD))) { - void *p; - - p = page->block_start; - - if (page->type <= MTYPE_TAGGED) - freelist_tagged_mpage((void **)p, page); - else - freelist_untagged_mpage((void **)p, page); - } - } - } -} - -#endif - -/******************************************************************************/ -/* fixup phase */ -/******************************************************************************/ - -/* Fixup: translate an old address to a new one, and note age of - youngest referenced page */ - -static int min_referenced_page_age; -#if CHECKS -static void *bad_dest_addr; -#endif - -void GC_fixup(void *pp) -{ - void *p = *(void **)pp; - unsigned long g; - MPage *map; - - if ((long)p & 0x1) return; - g = ((unsigned long)p >> MAPS_SHIFT); - - map = mpage_maps[g]; - if (map) { - unsigned long addr = (((unsigned long)p & MAP_MASK) >> MAP_SHIFT); - MPage *page; - - page = map + addr; - -#if DEFINE_MALLOC_FREE - if (page->type == MTYPE_MALLOCFREE) - return; -#endif - - if (page->type) { - if (page->compact_to_age < min_referenced_page_age) - min_referenced_page_age = page->compact_to_age; - - if (!(page->flags & (MFLAG_OLD | MFLAG_BIGBLOCK))) { - long offset = ((long)p & MPAGE_MASK) >> LOG_WORD_SIZE; - OffsetTy v; - void *r; - - if (page->type > MTYPE_TAGGED) { -#if CHECKS - if (!offset) { - /* Can't point to beginning of non-tagged block! */ - CRASH(25); - } -#endif - offset--; - } - - v = OFFSET_SIZE(page->u.offsets, offset); -#if CHECKS - if (page->type > MTYPE_TAGGED) { - if (!v) { - /* Can't point to beginning of non-tagged block! */ - CRASH(26); - } - } -#endif - - if (offset < page->compact_boundary) - r = (void *)(page->o.compact_to + v); - else - r = (void *)(((long)p & MPAGE_START) + ((long)v << LOG_WORD_SIZE)); - -#if SEARCH - if (r == search_for) - stop(); -#endif - -#if CHECKS - if (!(find_page(r)->flags & COLOR_MASK)) { - bad_dest_addr = r; - CRASH(27); - } -#endif - - if (r != p) - *(void **)pp = r; - } - } - } -} - -/**********************************************************************/ - -/* set compact_to_age field of a page: */ - -void reverse_propagate_new_age(void) -{ - MPage *page; - - for (page = first; page; page = page->next) { - if (!(page->flags & (MFLAG_BIGBLOCK | MFLAG_OLD))) { - if (page->compact_boundary > 0) { - MPage *page_to; - page_to = find_page(page->o.compact_to); - if (page_to->age < page->age) - page->compact_to_age = page_to->age; - else - page->compact_to_age = page->age; - } else - page->compact_to_age = page->age; - } else - page->compact_to_age = page->age; - } -} - -/**********************************************************************/ - -/* Fixup: fixup addresses in all readable objects */ - -static void fixup_tagged_mpage(void **p, MPage *page) -{ - void **top; -#if KEEP_BACKPOINTERS - long bp_delta = page->backpointer_page - p; -#endif - - top = p + MPAGE_WORDS; - - while (p < top) { - Type_Tag tag; - long size; - - tag = *(Type_Tag *)p; - - if (tag == TAGGED_EOM) - break; - -#if ALIGN_DOUBLES - if (tag == SKIP) { - p++; - } else { -#endif - -#if CHECKS - if ((tag < 0) || (tag >= NUMBER_OF_TAGS) || !size_table[tag]) { - GCFLUSHOUT(); - CRASH(28); - } - prev_var_stack = prev_ptr; - prev_ptr = p; -#endif - - size = fixup_table[tag](p); - -#if KEEP_BACKPOINTERS - GC_fixup((void *)(p + bp_delta)); -#endif - - p += size; - -#if ALIGN_DOUBLES - } -#endif - } -} - -static void fixup_array_mpage(void **p, MPage *page) -{ - void **top; -#if KEEP_BACKPOINTERS - long bp_delta = page->backpointer_page - p; -#endif - - top = p + MPAGE_WORDS; - - while (p < top) { - long size; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) - break; - -#if CHECKS - if (size >= BIGBLOCK_MIN_SIZE) { - CRASH(29); - } -#endif - -#if KEEP_BACKPOINTERS - GC_fixup((void *)(p + bp_delta)); -#endif - - for (p++; --size; p++) { - gcFIXUP(*p); - } - } -} - -static void fixup_tagged_array_mpage(void **p, MPage *page) -{ - void **top; -#if KEEP_BACKPOINTERS - long bp_delta = page->backpointer_page - p; -#endif - - top = p + MPAGE_WORDS; - - while (p < top) { - long size; - int i, elem_size; - void **mp; - Type_Tag tag; - Fixup_Proc traverse; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) - break; - - mp = p + 1; - p += size; - size--; - -#if ALIGN_DOUBLES - if (size) { -#endif -#if KEEP_BACKPOINTERS - GC_fixup((void *)(mp - 1 + bp_delta)); -#endif - tag = *(Type_Tag *)mp; - - traverse = fixup_table[tag]; - elem_size = traverse(mp); - mp += elem_size; - for (i = elem_size; i < size; i += elem_size, mp += elem_size) - traverse(mp); - -#if ALIGN_DOUBLES - } -#endif - } -} - -static void fixup_xtagged_mpage(void **p, MPage *page) -{ - void **top; -#if KEEP_BACKPOINTERS - long bp_delta = page->backpointer_page - p; -#endif - - top = p + MPAGE_WORDS; - - while (p < top) { - long size; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) - break; - -#if CHECKS - if (size >= BIGBLOCK_MIN_SIZE) { - CRASH(30); - } -#endif - -#if ALIGN_DOUBLES - if (size > 1) { -#endif - GC_fixup_xtagged(p + 1); -#if KEEP_BACKPOINTERS - GC_fixup((void *)(p + bp_delta)); -#endif -#if ALIGN_DOUBLES - } -#endif - - p += size; - } -} - -static void fixup_all_mpages() -{ - MPage *page; - - for (page = first; page; page = page->next) { - if (page->flags & COLOR_MASK) { - if (page->type != MTYPE_ATOMIC) { - void *p; - - scanned_pages++; - min_referenced_page_age = page->age; - p = page->block_start; - -#if NOISY - GCPRINT(GCOUTF, "Fixup %lx\n", (long)p); -#endif - - if (page->flags & MFLAG_BIGBLOCK) { - do_bigblock((void **)p, page, 1); -#if KEEP_BACKPOINTERS - GC_fixup((void *)&(page->backpointer_page)); -#endif - } else { - switch (page->type) { - case MTYPE_TAGGED: - fixup_tagged_mpage((void **)p, page); - break; - case MTYPE_TAGGED_ARRAY: - fixup_tagged_array_mpage((void **)p, page); - break; - case MTYPE_XTAGGED: - fixup_xtagged_mpage((void **)p, page); - break; - default: - fixup_array_mpage((void **)p, page); - } - } - - page->refs_age = min_referenced_page_age; - } - } - } -} - -/******************************************************************************/ -/* free phase */ -/******************************************************************************/ - -/* Free: release unused pages. */ - -static void free_unused_mpages() -{ - MPage *page, *next; - memory_in_use = 0; - - for (page = first; page; page = next) { - next = page->next; - if (!(page->flags & (COLOR_MASK | MFLAG_OLD))) { - void *p; - p = page->block_start; - - if (page->prev) - page->prev->next = page->next; - else - first = page->next; - if (page->next) - page->next->prev = page->prev; - else - last = page->prev; - - if (page->flags & MFLAG_BIGBLOCK) { -#if NOISY - GCPRINT(GCOUTF, "Free %lx - %lx\n", (long)p, - (long)p + page->u.size); -#endif - - free_pages((void *)p, page->u.size); - - { - long s = page->u.size; - unsigned long i = ((unsigned long)p >> MAPS_SHIFT); - unsigned long j = (((unsigned long)p & MAP_MASK) >> MAP_SHIFT); - while (s > MPAGE_SIZE) { - s -= MPAGE_SIZE; - j++; - if (j == MAP_SIZE) { - j = 0; - i++; - } - mpage_maps[i][j].type = 0; - mpage_maps[i][j].flags = 0; - } - } - } else { -#if NOISY - GCPRINT(GCOUTF, "Free %lx\n", (long)p); -#endif - free_pages((void *)p, MPAGE_SIZE); - free_pages(page->u.offsets, OPAGE_SIZE); -#if KEEP_BACKPOINTERS - free_pages(page->backpointer_page, MPAGE_SIZE); -#endif - } - - if (page->flags & MFLAG_INITED) - scanned_pages++; - - page->type = 0; - page->flags = 0; - skipped_pages++; - } else { - if (page->flags & MFLAG_BIGBLOCK) { - if (!(page->flags & MFLAG_CONTINUED)) - memory_in_use += page->u.size; - } else - memory_in_use += MPAGE_SIZE; - } - } - - vm_flush_freed_pages(GC->vm); -} - -void promote_all_ages() -{ - MPage *page; - - for (page = first; page; page = page->next) { - if (page->age < 15) - page->age++; - if (page->refs_age < 15) - page->refs_age++; - } -} - - -void protect_old_mpages() -{ -#if GENERATIONS - MPage *page; - - if (generations_available) { - for (page = first; page; page = page->next) { - if (page->age && (page->type != MTYPE_ATOMIC)) { - void *p; - - if (page->flags & MFLAG_MODIFIED) { - page->flags -= MFLAG_MODIFIED; - - p = page->block_start; - if (page->flags & MFLAG_BIGBLOCK) - vm_protect_pages((void *)p, page->u.size, 0); - else - vm_protect_pages((void *)p, MPAGE_SIZE, 0); - } - } - } - } -#endif -} - -/******************************************************************************/ -/* modification tracking */ -/******************************************************************************/ - -#if GENERATIONS - -static int designate_modified(void *p); - -static int designate_modified_maybe(void *p, int no_barrier_ok) -{ - unsigned long g = ((unsigned long)p >> MAPS_SHIFT); - MPage *map; - -#if CHECKS - if (during_gc) - CRASH(31); -#endif - - map = mpage_maps[g]; - if (map) { - unsigned long addr = (((unsigned long)p & MAP_MASK) >> MAP_SHIFT); - MPage *page; - - page = map + addr; - if (page->type) { - if (page->flags & MFLAG_CONTINUED) { - designate_modified(page->o.bigblock_start); - num_seg_faults++; - return 1; - } else if (page->age) { - if (page->flags & MFLAG_MODIFIED) { - if (no_barrier_ok) - return 0; - } else { - page->flags |= MFLAG_MODIFIED; - p = (void *)((long)p & MPAGE_START); - if (page->flags & MFLAG_BIGBLOCK) - vm_protect_pages(p, page->u.size, 1); - else - vm_protect_pages(p, MPAGE_SIZE, 1); - num_seg_faults++; - return 1; - } - } else if (no_barrier_ok) { - return 0; - } - - GCPRINT(GCOUTF, "Seg fault (internal error) at %lx [%ld]\n", - (long)p, num_seg_faults); - return 0; - } - } - - - GCPRINT(GCOUTF, "Access on unmapped page at %lx [%ld]\n", - (long)p, num_seg_faults); - -#if defined(_WIN32) && defined(CHECKS) - DebugBreak(); -#endif - return 0; -} - -static int designate_modified(void *p) -{ - return designate_modified_maybe(p, 0); -} - -void GC_write_barrier(void *p) -{ - designate_modified_maybe(p, 1); -} - -/* The platform-specific signal handlers, and initialization function: */ -# include "sighand.c" - -#endif /* GENERATIONS */ - -/******************************************************************************/ -/* stack walking */ -/******************************************************************************/ - -#if CHECKS -static void **o_var_stack, **oo_var_stack; -#endif -#if TIME -static int stack_depth; -#endif -#if RECORD_MARK_SRC -static int record_stack_source = 0; -#endif - -#include "stack_comp.c" - -#define GC_X_variable_stack GC_mark_variable_stack -#if RECORD_MARK_SRC -# define X_source(stk, p) if (record_stack_source) { mark_src = (stk ? stk : p); mark_type = MTYPE_STACK; } -#else -# define X_source(stk, p) /* */ -#endif -#define gcX(a) gcMARK(*a) -#include "var_stack.c" -#undef GC_X_variable_stack -#undef gcX -#undef X_source - -#define GC_X_variable_stack GC_fixup_variable_stack -#define gcX(a) gcFIXUP(*a) -#define X_source(stk, p) /* */ -#include "var_stack.c" -#undef GC_X_variable_stack -#undef gcX -#undef X_source - -#if CHECKS -# if CHECK_STACK_PTRS -static void check_ptr(void **a) -{ - void *p = *a; - MPage *page; - - if (!mpage_maps) return; - - if ((long)p & 0x1) return; - - page = find_page(p); - if (page) { - if ((page->type == MTYPE_TAGGED) - && !(page->flags & MFLAG_BIGBLOCK)) { - Type_Tag tag; - - tag = *(Type_Tag *)p; - if ((tag < 0) || (tag >= NUMBER_OF_TAGS) - || (!size_table[tag] - && (tag != weak_box_tag) - && (tag != ephemeron_tag) - && (tag != weak_array_tag) - && (tag != gc_on_free_list_tag))) { - GCPRINT(GCOUTF, "bad tag: %d at %lx, references from %lx\n", tag, (long)p, (long)a); - GCFLUSHOUT(); - CRASH(70); - } - - } -#if DEFINE_MALLOC_FREE - else if (page->type == MTYPE_MALLOCFREE) { - check_not_freed(page, p); - } -#endif - } -} - -#define GC_X_variable_stack GC_do_check_variable_stack -#define gcX(a) check_ptr(a) -#define X_source(stk, p) /* */ -#include "var_stack.c" -#undef GC_X_variable_stack -#undef gcX -#undef X_source - -# endif - -void GC_check_variable_stack() -{ -# if CHECK_STACK_PTRS - GC_do_check_variable_stack(GC_variable_stack, - 0, - (void **)(GC_get_thread_stack_base - ? GC_get_thread_stack_base() - : stack_base), - NULL); -# endif -} -#endif - -/******************************************************************************/ -/* main GC driver */ -/******************************************************************************/ - -static void set_ending_tags(void) -{ - int i; - - for (i = 0; i < NUM_TAGGED_SETS; i++) { - if (sets[i]->low < sets[i]->high) - *(Type_Tag *)sets[i]->low = TAGGED_EOM; - } - for (i = NUM_TAGGED_SETS; i < NUM_SETS; i++) { - if (sets[i]->low < sets[i]->high) - *(long *)sets[i]->low = UNTAGGED_EOM - 1; - } -} - -static int initialized; - -static void init(void) -{ - if (!initialized) { - GC_register_traversers(weak_box_tag, size_weak_box, mark_weak_box, fixup_weak_box, 1, 0); - GC_register_traversers(ephemeron_tag, size_ephemeron, mark_ephemeron, fixup_ephemeron, 1, 0); - GC_register_traversers(weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array, 0, 0); -#if USE_FREELIST - GC_register_traversers(gc_on_free_list_tag, size_on_free_list, size_on_free_list, size_on_free_list, 0, 0); -#endif - GC_add_roots(&GC->finalizers, (char *)&GC->finalizers + sizeof(GC->finalizers) + 1); - GC_add_roots(&fnl_weaks, (char *)&fnl_weaks + sizeof(fnl_weaks) + 1); - GC_add_roots(&run_queue, (char *)&run_queue + sizeof(run_queue) + 1); - GC_add_roots(&last_in_queue, (char *)&last_in_queue + sizeof(last_in_queue) + 1); - GC_add_roots(&park, (char *)&park + sizeof(park) + 1); - GC_add_roots(&park_save, (char *)&park_save + sizeof(park_save) + 1); - - sets[0] = &tagged; - sets[1] = &array; - sets[2] = &tagged_array; - sets[3] = &xtagged; - sets[4] = &atomic; - - initialized = 1; - -#if GENERATIONS - initialize_signal_handler(GC); -#endif - } -} - -#if 0 -# define GETTIME() ((long)scheme_get_milliseconds()) -#else -extern long scheme_get_process_milliseconds(); -# define GETTIME() ((long)scheme_get_process_milliseconds()) -#endif - -#if TIME -# define PRINTTIME(x) GCPRINT x -# define STDERR GCOUTF -static long started, rightnow, old; -# define INITTIME() (started = GETTIME()) -# define GETTIMEREL() (rightnow = GETTIME(), old = started, started = rightnow, rightnow - old) -#else -# define INITTIME() /* empty */ -# define PRINTTIME(x) /* empty */ -#endif - -static void mark_roots() -{ - Roots *roots = &GC->roots; - ImmobileBox *ib; - int i; - - for (i = 0; i < roots->count; i += 2) { - void **s = (void **)roots->roots[i]; - void **e = (void **)roots->roots[i + 1]; - - while (s < e) { -#if RECORD_MARK_SRC - mark_src = s; - mark_type = MTYPE_ROOT; -#endif - gcMARK(*s); - s++; - } - } - -#if RECORD_MARK_SRC - record_stack_source = 1; -#endif - GC_mark_variable_stack(GC_variable_stack, - 0, - (void *)(GC_get_thread_stack_base - ? GC_get_thread_stack_base() - : stack_base), - NULL); -#if RECORD_MARK_SRC - record_stack_source = 0; -#endif - - /* Do immobiles: */ - for (ib = immobile; ib; ib = ib->next) { -#if RECORD_MARK_SRC - mark_src = ib; - mark_type = MTYPE_IMMOBILE; -#endif - gcMARK(ib->p); - } -} - -static void fixup_roots() -{ - Roots *roots = &GC->roots; - ImmobileBox *ib; - int i; - - for (i = 0; i < roots->count; i += 2) { - void **s = (void **)roots->roots[i]; - void **e = (void **)roots->roots[i + 1]; - - while (s < e) { - gcFIXUP(*s); - s++; - } - } - - GC_fixup_variable_stack(GC_variable_stack, - 0, - (void *)(GC_get_thread_stack_base - ? GC_get_thread_stack_base() - : stack_base), - NULL); - - /* Do immobiles: */ - for (ib = immobile; ib; ib = ib->next) { - gcFIXUP(ib->p); - } -} - -static void gcollect(int full) -{ - CompactGC *gc = GC; - int did_fnls; -#if TIME - struct rusage pre, post; -#endif - int young; - int compact; - int i; - - INITTIME(); - PRINTTIME((STDERR, "gc: << start with %ld [%d]: %ld\n", - memory_in_use, cycle_count, GETTIMEREL())); - - if (memory_in_use > max_memory_use) - max_memory_use = memory_in_use; - - init(); - - set_ending_tags(); - - init_weak_boxes(gc); - init_ephemerons(gc); - init_weak_arrays(gc); - - did_fnls = 0; - - gray_first = NULL; - - if (GC_collect_start_callback) - GC_collect_start_callback(); - -#if TIME - getrusage(RUSAGE_SELF, &pre); -#endif - - sort_and_merge_roots(&GC->roots); - - during_gc = 1; - - /******************** Init ****************************/ - - skipped_pages = 0; - scanned_pages = 0; - young_pages = 0; - inited_pages = 0; - - if (full) - young = 15; - else if ((cycle_count & 0xF) == 0xF) - young = 15; - else if ((cycle_count & 0x7) == 0x7) - young = 7; - else if ((cycle_count & 0x3) == 0x3) - young = 3; - else if ((cycle_count & 0x1) == 0x1) - young = 1; - else - young = 0; - -#if !GENERATIONS - young = 15; -#else - if (!generations_available) - young = 15; -#endif - -#if USE_FREELIST && (COMPACTING == SELECTIVELY_COMPACT) - if (full) - compact = 1; - else { - /* Remaining free list items few enough? */ - if (((float)(on_free_list << LOG_WORD_SIZE) / memory_in_use) < COMPACT_THRESHOLD) - compact = 0; - else - compact = 1; - } -#else -# if (COMPACTING == ALWAYS_COMPACT) || !USE_FREELIST - compact = 1; -# endif -# if (COMPACTING == NEVER_COMPACT) - compact = 0; -# endif -#endif - - if (compact) - compact_count++; - - init_all_mpages(young); - - PRINTTIME((STDERR, "gc: init %s [freelist=%f] (young:%d skip:%d scan:%d init:%d): %ld\n", - compact ? "cmpct" : "frlst", (double)(FREE_LIST_DELTA << LOG_WORD_SIZE) / memory_in_use, - young_pages, skipped_pages, scanned_pages, inited_pages, - GETTIMEREL())); - - /************* Mark and Propagate *********************/ - - inited_pages = 0; -#if TIME - mark_stackoflw = 0; -#endif - -#if MARK_STATS - mark_calls = mark_hits = mark_recalls = mark_colors = mark_many = mark_slow = 0; -#endif - - mark_roots(); - - { - Fnl *f; - for (f = GC->finalizers; f; f = f->next) { -#if RECORD_MARK_SRC - mark_src = f; - mark_type = MTYPE_FINALIZER; -#endif - mark_finalizer(f); - } - for (f = run_queue; f; f = f->next) { -#if RECORD_MARK_SRC - mark_src = f; - mark_type = MTYPE_FINALIZER; -#endif - mark_finalizer(f); - } - } - - { - Fnl_Weak_Link *wl; - for (wl = fnl_weaks; wl; wl = wl->next) { -#if RECORD_MARK_SRC - mark_src = wl; - mark_type = MTYPE_WEAKLINK; -#endif - mark_finalizer_weak_link(wl); - } - } - -#if TIME - getrusage(RUSAGE_SELF, &post); -#endif - -#if MARK_STATS -# define STATS_FORMAT " {c=%ld h=%ld c=%ld r=%ld m=%ld s=%ld}" -# define STATS_ARGS mark_calls, mark_hits, mark_colors, mark_recalls, mark_many, mark_slow, -#else -# define STATS_FORMAT -# define STATS_ARGS -#endif - - PRINTTIME((STDERR, "gc: roots (init:%d deep:%d)" - STATS_FORMAT - " [%ld/%ld faults]: %ld\n", - inited_pages, stack_depth, - STATS_ARGS - post.ru_minflt - pre.ru_minflt, post.ru_majflt - pre.ru_majflt, - GETTIMEREL())); - - iterations = 0; - - /* Propagate, mark ready ephemerons */ - propagate_all_mpages(); - mark_ready_ephemerons(gc); - - /* Propagate, loop to do finalization */ - while (1) { - - /* Propagate all marks. */ - propagate_all_mpages(); - - if ((did_fnls >= 3) || !GC->finalizers) { - if (did_fnls == 3) { - /* Finish up ordered finalization */ - Fnl *f, *next, *prev; - Fnl_Weak_Link *wl; - - /* Enqueue and mark level 3 finalizers that still haven't been marked. */ - /* (Recursive marking is already done, though.) */ - prev = NULL; - for (f = GC->finalizers; f; f = next) { - next = f->next; - if (f->eager_level == 3) { - if (!is_marked(gc, f->p)) { - /* Not yet marked. Mark it and enqueue it. */ -#if RECORD_MARK_SRC - mark_src = f; - mark_type = MTYPE_FINALIZER; -#endif - gcMARK(f->p); - - if (prev) - prev->next = next; - else - GC->finalizers = next; - - f->eager_level = 0; /* indicates queued */ - - f->next = NULL; - if (last_in_queue) { - last_in_queue->next = f; - last_in_queue = f; - } else { - run_queue = last_in_queue = f; - } - } else { - prev = f; - } - } else { - prev = f; - } - } - - if (young == 15) { - /* Restore zeroed out weak links, marking as we go: */ - for (wl = fnl_weaks; wl; wl = wl->next) { - void *wp = (void *)wl->p; - int markit; - markit = is_marked(gc, wp); - if (markit) { -#if RECORD_MARK_SRC - mark_src = wp; - mark_type = MTYPE_WEAKLINKX; -#endif - gcMARK(wl->saved); - } - *(void **)(BYTEPTR(wp) + wl->offset) = wl->saved; - } - } - - /* We have to mark one more time, because restoring a weak - link may have made something reachable. */ - - did_fnls++; - } else - break; - } else { - int eager_level = did_fnls + 1; - - if (eager_level == 3) { - /* Ordered finalization */ - Fnl *f; - Fnl_Weak_Link *wl; - - /* If full collect, zero out weak links for ordered finalization. */ - /* (Only done on full collect to avoid modifying old pages.) */ - if (young == 15) { - for (wl = fnl_weaks; wl; wl = wl->next) { - void *wp = (void *)wl->p; - wl->saved = *(void **)(BYTEPTR(wp) + wl->offset); - *(void **)(BYTEPTR(wp) + wl->offset) = NULL; - } - } - - /* Mark content of not-yet-marked finalized objects, - but don't mark the finalized objects themselves. */ - for (f = GC->finalizers; f; f = f->next) { - if (f->eager_level == 3) { -#if RECORD_MARK_SRC - mark_src = f; - mark_type = MTYPE_TAGGED; -#endif - if (!is_marked(gc, f->p)) { - /* Not yet marked. Mark content. */ - if (f->tagged) { - Type_Tag tag = *(Type_Tag *)f->p; -#if CHECKS - if ((tag < 0) || (tag >= NUMBER_OF_TAGS) || !size_table[tag]) { - CRASH(34); - } -#endif - mark_table[tag](f->p); - } else { - GC_mark_xtagged(f->p); - } - } - } - } - } else { - /* Unordered finalization */ - Fnl *f, *prev, *queue; - - f = GC->finalizers; - prev = NULL; - queue = NULL; - - while (f) { - if (f->eager_level == eager_level) { - if (!is_marked(gc, f->p)) { - /* Not yet marked. Move finalization to run queue. */ - Fnl *next = f->next; - - if (prev) - prev->next = next; - else - GC->finalizers = next; - - f->eager_level = 0; /* indicates queued */ - - f->next = NULL; - if (last_in_queue) { - last_in_queue->next = f; - last_in_queue = f; - } else { - run_queue = last_in_queue = f; - } - if (!queue) - queue = f; - - f = next; - } else { - prev = f; - f = f->next; - } - } else { - prev = f; - f = f->next; - } - } - - /* Mark items added to run queue: */ - f = queue; - while (f) { -#if RECORD_MARK_SRC - mark_src = f; - mark_type = MTYPE_FINALIZER; -#endif - gcMARK(f->p); - f = f->next; - } - - mark_ready_ephemerons(gc); - } - - did_fnls++; - } - } - -#if CHECKS - { - Fnl *f; - /* All finalized objects must be marked at this point. */ - for (f = finalizers; f; f = f->next) { - if (!is_marked(f->p)) - CRASH(35); - } - for (f = run_queue; f; f = f->next) { - if (!is_marked(f->p)) - CRASH(36); - } - } -#endif - -#if TIME - getrusage(RUSAGE_SELF, &post); -#endif - - PRINTTIME((STDERR, "gc: mark (init:%d cycle:%ld stkoflw:%ld)" - STATS_FORMAT - " [%ld/%ld faults]: %ld\n", - inited_pages, iterations, - mark_stackoflw, - STATS_ARGS - post.ru_minflt - pre.ru_minflt, post.ru_majflt - pre.ru_majflt, - GETTIMEREL())); - - /******************************************************/ - - zero_remaining_ephemerons(gc); - zero_weak_boxes(gc); - zero_weak_arrays(gc); - - /* Cleanup weak finalization links: */ - { - Fnl_Weak_Link *wl, *prev, *next; - - prev = NULL; - for (wl = fnl_weaks; wl; wl = next) { - next = wl->next; - if (!is_marked(gc, wl->p)) { - /* Will be collected. Removed this link. */ - wl->p = NULL; - if (prev) - prev->next = next; - else - fnl_weaks = next; - --fnl_weak_link_count; - } else { - prev = wl; - } - } - } - - PRINTTIME((STDERR, "gc: weak: %ld\n", GETTIMEREL())); - - /******************************************************/ - -#if USE_FREELIST - { - int j; - - for (j = 0; j < NUM_SETS; j++) { - void **free_lists = sets[j]->free_lists; - for (i = 0; i < FREE_LIST_ARRAY_SIZE; i++) - free_lists[i] = NULL; - } - - on_free_list = 0; - } -#endif - - if (compact) - compact_all_mpages(); -#if USE_FREELIST - else - freelist_all_mpages(young); -#endif - -#if TIME - getrusage(RUSAGE_SELF, &post); -#endif - - PRINTTIME((STDERR, "gc: %s [%ld/%ld faults]: %ld\n", - compact ? "compact" : "freelist", - post.ru_minflt - pre.ru_minflt, post.ru_majflt - pre.ru_majflt, - GETTIMEREL())); - - /******************************************************/ - - promote_all_ages(); - - if (compact) { - for (i = 0; i < NUM_SETS; i++) { - sets[i]->malloc_page = sets[i]->compact_page; - sets[i]->low = sets[i]->compact_to + sets[i]->compact_to_offset; - sets[i]->high = sets[i]->compact_to + MPAGE_WORDS; - if (sets[i]->compact_to_offset < MPAGE_WORDS) { - sets[i]->compact_page->age = 0; - sets[i]->compact_page->refs_age = 0; - sets[i]->compact_page->flags |= MFLAG_MODIFIED; - } - } - - reverse_propagate_new_age(); - } else { - for (i = 0; i < NUM_SETS; i++) { - if (sets[i]->malloc_page) { - if (!(sets[i]->malloc_page->flags & COLOR_MASK)) { - sets[i]->malloc_page= NULL; - sets[i]->low = sets[i]->high = (void **)0; - } else - sets[i]->malloc_page->flags -= (sets[i]->malloc_page->flags & MFLAG_INITED); - } - } - } - - /******************************************************/ - - resolve_for_fixup = 1; - - if (compact) { -#if CHECKS - int fnl_count = 0; -#endif - - scanned_pages = 0; - - fixup_roots(); - - { - Fnl *f; - for (f = GC->finalizers; f; f = f->next) { -#if CHECKS - fnl_count++; -#endif - fixup_finalizer(f); - } - for (f = run_queue; f; f = f->next) { -#if CHECKS - fnl_count++; -#endif - fixup_finalizer(f); - } -#if CHECKS - if (fnl_count != num_fnls) - CRASH(38); -#endif - } - - { - Fnl_Weak_Link *wl; - for (wl = fnl_weaks; wl; wl = wl->next) - fixup_finalizer_weak_link(wl); - } - - fixup_all_mpages(); - -#if TIME - getrusage(RUSAGE_SELF, &post); -#endif - - PRINTTIME((STDERR, "gc: fixup (%d) [%ld/%ld faults]: %ld\n", - scanned_pages, - post.ru_minflt - pre.ru_minflt, post.ru_majflt - pre.ru_majflt, - GETTIMEREL())); - } - - resolve_for_fixup = 0; - - /******************************************************/ - - skipped_pages = scanned_pages = 0; - - free_unused_mpages(); - - protect_old_mpages(); - - reset_finalizer_tree(GC); - -#if (COMPACTING == NEVER_COMPACT) -# define THRESH_FREE_LIST_DELTA (FREE_LIST_DELTA >> LOG_WORD_SIZE) -#else -# define THRESH_FREE_LIST_DELTA FREE_LIST_DELTA -#endif - - gc_threshold = (long)((GROW_FACTOR * (memory_in_use - THRESH_FREE_LIST_DELTA)) - + GROW_ADDITION); - - if (compact) { - for (i = 0; i < NUM_NONATOMIC_SETS; i++) { - if (sets[i]->compact_to_offset < MPAGE_WORDS) - memset(sets[i]->low, 0, (sets[i]->high - sets[i]->low) << LOG_WORD_SIZE); - } - } - -#if TIME - getrusage(RUSAGE_SELF, &post); -#endif - - memory_use_growth += (memory_in_use - prev_memory_in_use); - prev_memory_in_use = memory_in_use; - - PRINTTIME((STDERR, "gc: done with %ld delta=%ld (free:%d cheap:%d) [%ld/%ld faults]: %ld >>\n", - memory_in_use, memory_use_growth, skipped_pages, scanned_pages, - post.ru_minflt - pre.ru_minflt, post.ru_majflt - pre.ru_majflt, - GETTIMEREL())); - - during_gc = 0; - - if (young == 15) { - cycle_count = 0; - memory_use_growth = 0; - } else { - if ((cycle_count & 0x1) - || (memory_use_growth > INCREMENT_CYCLE_COUNT_GROWTH)) - cycle_count++; - } - gc_count++; - - if (GC_collect_start_callback) - GC_collect_end_callback(); - - /**********************************************************************/ - - /* Run Finalizations. Collections may happen */ - - ran_final = 0; - - if (!running_finals) { - running_finals = 1; - - /* Finalization might allocate, which might need park: */ - park_save[0] = park[0]; - park_save[1] = park[1]; - park[0] = NULL; - park[1] = NULL; - - while (run_queue) { - Fnl *f; - void **gcs; - - ran_final++; - - f = run_queue; - run_queue = run_queue->next; - if (!run_queue) - last_in_queue = NULL; - --GC->num_fnls; - - gcs = GC_variable_stack; - f->f(f->p, f->data); - GC_variable_stack = gcs; - } - - running_finals = 0; - - park[0] = park_save[0]; - park[1] = park_save[1]; - park_save[0] = NULL; - park_save[1] = NULL; - } -} - -void *GC_resolve(void *p) -{ - if (resolve_for_fixup) { - GC_fixup(&p); - return p; - } else - return p; -} - -void *GC_fixup_self(void *p) -{ - return p; -} - -/******************************************************************************/ -/* allocators */ -/******************************************************************************/ - -void *malloc_pages_try_hard(size_t len, size_t alignment) -{ - void *m; - int i = 5; - - ran_final = 1; - - while (i--) { - m = malloc_pages(len, alignment); - if (m) - return m; - if (!ran_final) - break; - else - gcollect(1); - } - - if (GC_out_of_memory) - GC_out_of_memory(); - - GCPRINT(GCOUTF, "Out of memory\n"); - abort(); -} - -/**********************************************************************/ - -static MPage *get_page_rec(void *p, mtype_t mtype, mflags_t flags) -{ - unsigned long g, addr; - MPage *map; - - g = ((unsigned long)p >> MAPS_SHIFT); - - if (!mpage_maps) { - int i; - mpage_maps = (MPage **)malloc_pages(sizeof(MPage *) * MAPS_SIZE, 0); - if (!mpage_maps) { - GCPRINT(GCOUTF, "Can't allocate map list\n"); - abort(); - } - for (i = 0; i < MAPS_SIZE; i++) - mpage_maps[i] = NULL; - } - - map = mpage_maps[g]; - if (!map) { - int i; - - map = (MPage *)malloc_pages_try_hard(sizeof(MPage) * MAP_SIZE, 0); - for (i = 0; i < MAP_SIZE; i++) { - map[i].type = 0; - map[i].flags = 0; - } - - mpage_maps[g] = map; - } - - addr = (((unsigned long)p & MAP_MASK) >> MAP_SHIFT); - -#if NOISY - { - int c; - if (!mtype) - c = '.'; - else { - if (mtype <= MTYPE_TAGGED) - c = 't'; - else if (mtype == MTYPE_ATOMIC) - c = 'a'; - else if (mtype == MTYPE_TAGGED_ARRAY) - c = 'g'; - else - c = 'v'; - - if (flags & MFLAG_BIGBLOCK) - c = c - ('a' - 'A'); - } - GCPRINT(GCOUTF, "%c p = %lx, g = %lx, addr = %lx\n", c, (long)p, g, addr); - } -#endif - - return map + addr; -} - -static void new_page(mtype_t mtype, mflags_t mflags, MSet *set, int link) -{ - void *p; - MPage *map; - OffsetArrTy *offsets; - - if ((memory_in_use > gc_threshold) && link && !avoid_collection) { - gcollect(0); - return; - } - - p = (void *)malloc_pages_try_hard(MPAGE_SIZE, MPAGE_SIZE); - offsets = (OffsetArrTy *)malloc_pages_try_hard(OPAGE_SIZE, 0); - - memory_in_use += MPAGE_SIZE; - - map = get_page_rec(p, mtype, mflags); - - map->type = mtype; - map->flags = (mflags | MFLAG_MODIFIED); - map->u.offsets = offsets; - map->block_start = p; - map->age = 0; - map->refs_age = 0; - - if (link) { - map->next = NULL; - map->prev = last; - if (last) - last->next = map; - else - first = map; - last = map; - } else { - map->next = map->prev = NULL; - } - - set->malloc_page = map; - - set->low = (void **)p; - set->high = (void **)(BYTEPTR(p) + MPAGE_SIZE); - -#if KEEP_BACKPOINTERS - map->backpointer_page = (void **)malloc_pages_try_hard(MPAGE_SIZE, 0); -#endif -} - -static void *malloc_bigblock(long size_in_bytes, mtype_t mtype, int link) -{ - void *p, *mp; - MPage *map; - long s; - -#if SEARCH - if (size_in_bytes == search_size) - stop(); -#endif - - if ((memory_in_use > gc_threshold) && link && !avoid_collection) { - gcollect(0); - return malloc_bigblock(size_in_bytes, mtype, 1); - } - - p = (void *)malloc_pages_try_hard(size_in_bytes, MPAGE_SIZE); - - memory_in_use += size_in_bytes; - - map = get_page_rec(p, mtype, MFLAG_BIGBLOCK); - - map->type = mtype; - map->flags = (MFLAG_BIGBLOCK | MFLAG_MODIFIED); - map->u.size = size_in_bytes; - map->block_start = p; - map->age = 0; - map->refs_age = 0; - - if (link) { - map->next = NULL; - map->prev = last; - if (last) - last->next = map; - else - first = map; - last = map; - } else { - map->next = NULL; - map->prev = NULL; - } - - s = size_in_bytes; - mp = p; - while (s > MPAGE_SIZE) { - mp = BYTEPTR(mp) + MPAGE_SIZE; - s -= MPAGE_SIZE; - map = get_page_rec(mp, 0, MFLAG_CONTINUED | MFLAG_BIGBLOCK); - map->type = mtype; - map->flags = MFLAG_CONTINUED | MFLAG_BIGBLOCK; - map->o.bigblock_start = p; - } - -#if SEARCH - if (p == search_for) { - stop(); - } -#endif - - return p; -} - -void *GC_malloc_one_tagged(size_t size_in_bytes) -{ - size_t size_in_words; - void **m, **naya; - -#if CHECKS - GC_check_variable_stack(); -#endif - - size_in_words = ((size_in_bytes + 3) >> LOG_WORD_SIZE); - -#if CHECKS - if (size_in_words < 2) - CRASH(37); -#endif - - if (size_in_words >= (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE)) { - return malloc_bigblock(size_in_words << LOG_WORD_SIZE, MTYPE_TAGGED, 1); - } - -#if USE_FREELIST - m = (void *)tagged.free_lists[size_in_words]; - if (m) { - int i; - - tagged.free_lists[size_in_words] = m[1]; - - for (i = 0; i < size_in_words; i++) - m[i] = NULL; - - on_free_list -= size_in_words; - - return m; - } -#endif - -#if ALIGN_DOUBLES - if (!(size_in_words & 0x1)) { - /* Make sure memory is 8-aligned */ - if (((long)tagged.low & 0x4)) { - if (tagged.low == tagged.high) { - new_page(MTYPE_TAGGED, 0, &tagged, 1); - return GC_malloc_one_tagged(size_in_words << LOG_WORD_SIZE); - } - ((Type_Tag *)tagged.low)[0] = SKIP; - tagged.low += 1; - } - } -#endif - -#if SEARCH - if (size_in_bytes == search_size) - stop(); -#endif - - m = tagged.low; - naya = tagged.low + size_in_words; - if (naya >= tagged.high) { - if (tagged.low < tagged.high) - *(Type_Tag *)tagged.low = TAGGED_EOM; - new_page(MTYPE_TAGGED, 0, &tagged, 1); - return GC_malloc_one_tagged(size_in_words << LOG_WORD_SIZE); - } - tagged.low = naya; - -#if SEARCH - if (m == search_for) { - stop(); - } -#endif - - return m; -} - -void *GC_malloc_one_small_tagged(size_t size_in_bytes) -{ - return GC_malloc_one_tagged(size_in_bytes); -} - -void *GC_malloc_one_small_dirty_tagged(size_t size_in_bytes) -{ - return GC_malloc_one_tagged(size_in_bytes); -} - -void *GC_malloc_pair(void *a, void *b) -{ - void *p; - - park[0] = a; - park[1] = b; - p = GC_malloc_one_tagged(3 << LOG_WORD_SIZE); - a = park[0]; - b = park[1]; - - ((Type_Tag *)p)[0] = pair_tag; - ((void **)p)[1] = a; - ((void **)p)[2] = b; - - return p; -} - -#ifndef gcINLINE -# define gcINLINE inline -#endif - -static gcINLINE void *malloc_untagged(size_t size_in_bytes, mtype_t mtype, MSet *set) -{ - size_t size_in_words; - void **m, **naya; - -#if CHECKS - GC_check_variable_stack(); -#endif - - if (!size_in_bytes) - return zero_sized; - - size_in_words = ((size_in_bytes + 3) >> LOG_WORD_SIZE); - - if (size_in_words >= (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE)) { - return malloc_bigblock(size_in_words << LOG_WORD_SIZE, mtype, 1); - } - -#if USE_FREELIST - m = (void *)set->free_lists[size_in_words]; - if (m) { - int i; - - set->free_lists[size_in_words] = m[0]; - - if (mtype != MTYPE_ATOMIC) - memset(m, 0, size_in_words << LOG_WORD_SIZE); - - on_free_list -= size_in_words; - - return m; - } -#endif - -#if ALIGN_DOUBLES - if (!(size_in_words & 0x1)) { - /* Make sure memory is 8-aligned */ - if (!((long)set->low & 0x4)) { - if (set->low == set->high) { - new_page(mtype, 0, set, 1); - return malloc_untagged(size_in_words << LOG_WORD_SIZE, mtype, set); - } - (set->low)[0] = 0; - set->low += 1; - } - } -#endif - -#if SEARCH - if (size_in_bytes == search_size) - stop(); -#endif - - m = set->low; - naya = set->low + size_in_words + 1; - if (naya >= set->high) { - if (set->low < set->high) - *(long *)set->low = UNTAGGED_EOM - 1; - new_page(mtype, 0, set, 1); - return malloc_untagged(size_in_words << LOG_WORD_SIZE, mtype, set); - } - set->low = naya; - -#if SEARCH - if ((m + 1) == search_for) { - stop(); - } -#endif - - *(long *)m = size_in_words; - - return m + 1; -} - -/* Array of pointers: */ -void *GC_malloc(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, MTYPE_ARRAY, &array); -} - -void *GC_malloc_allow_interior(size_t size_in_bytes) -{ - return malloc_bigblock(size_in_bytes, MTYPE_ARRAY, 1); -} - -void *GC_malloc_atomic_allow_interior(size_t size_in_bytes) -{ - return malloc_bigblock(size_in_bytes, MTYPE_ATOMIC, 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); -} - -void *GC_malloc_one_xtagged(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, MTYPE_XTAGGED, &xtagged); -} - -/* Pointerless */ -void *GC_malloc_atomic(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, MTYPE_ATOMIC, &atomic); -} - -/* Plain malloc: */ -void *GC_malloc_atomic_uncollectable(size_t size_in_bytes) -{ - void *p; - p = malloc(size_in_bytes); - memset(p, 0, size_in_bytes); - return p; -} - -/******************************************************************************/ -/* misc */ -/******************************************************************************/ - -static void free_bigpage(MPage *page) -{ - long s; - unsigned long i, j; - - page->type = 0; - page->flags = 0; - - free_pages(page->block_start, page->u.size); - - s = page->u.size; - i = ((unsigned long)page->block_start >> MAPS_SHIFT); - j = (((unsigned long)page->block_start & MAP_MASK) >> MAP_SHIFT); - while (s > MPAGE_SIZE) { - s -= MPAGE_SIZE; - j++; - if (j == MAP_SIZE) { - j = 0; - i++; - } - mpage_maps[i][j].type = 0; - mpage_maps[i][j].flags = 0; - } -} - -void GC_free(void *p) -{ - MPage *page; - - page = find_page(p); - - if ((page->flags & MFLAG_BIGBLOCK) - && !(page->flags & MFLAG_CONTINUED) - && (p == page->block_start)) { - memory_in_use -= page->u.size; - - if (page->prev) - page->prev->next = page->next; - else - first = page->next; - if (page->next) - page->next->prev = page->prev; - else - last = page->prev; - - free_bigpage(page); - } -} - -long GC_malloc_stays_put_threshold() -{ - return BIGBLOCK_MIN_SIZE; -} - -void GC_gcollect() -{ - gcollect(1); -} - -long GC_get_memory_use(void *c) -{ - return memory_in_use; -} - -int GC_set_account_hook(int type, void *cust, unsigned long b, void *f) -{ - return 0; -} - -int GC_mtrace_new_id(void *f) -{ - return 0; -} - -int GC_mtrace_union_current_with(int newval) -{ - return 0; -} - -unsigned long GC_get_stack_base(void) -{ - return stack_base; -} - -/******************************************************************************/ -/* malloc and free replacements */ -/******************************************************************************/ - -#if DEFINE_MALLOC_FREE - -# define MALLOC_MIDDLE_SIZE (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE) - -static MSet mallocfree_set; - -void *mallocfree_freelists[FREE_LIST_ARRAY_SIZE]; - -void *malloc(size_t size) -{ - void **m, **naya; - long size_in_words = (size + (WORD_SIZE - 1)) >> LOG_WORD_SIZE; - int pos; - - if (size_in_words < 2) - size_in_words = 2; /* need at least 2 for freelist */ - - if (size_in_words >= (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE)) { - return malloc_bigblock(size_in_words << LOG_WORD_SIZE, MTYPE_MALLOCFREE, 0); - } - -#if ALIGN_DOUBLES - if (size_in_words & 0x1) - size_in_words++; -#endif - - if (mallocfree_freelists[size_in_words]) { - MPage *page; - - m = mallocfree_freelists[size_in_words]; - mallocfree_freelists[size_in_words] = ((void **)m)[1]; - - page = find_page(m); - pos = m - (void **)((long)m & MPAGE_START); - - OFFSET_SET_SIZE_UNMASKED(page->u.offsets, pos, size_in_words); - while (--size_in_words) { - pos++; - OFFSET_SET_SIZE_UNMASKED(page->u.offsets, pos, MALLOC_MIDDLE_SIZE); - } - - return m; - } - - m = mallocfree_set.low; - naya = m + size_in_words; - if (naya >= mallocfree_set.high) { - new_page(MTYPE_MALLOCFREE, 0, &mallocfree_set, 0); - return malloc(size); - } - mallocfree_set.low = naya; - - pos = m - (void **)mallocfree_set.malloc_page->block_start; - - OFFSET_SET_SIZE_UNMASKED(mallocfree_set.malloc_page->u.offsets, pos, size_in_words); - while (--size_in_words) { - pos++; - OFFSET_SET_SIZE_UNMASKED(mallocfree_set.malloc_page->u.offsets, pos, MALLOC_MIDDLE_SIZE); - } - - return m; -} - -void free(void *p) -{ - MPage *page; - int pos; - long sz; - - if (!p) - return; - - page = find_page(p); - if (!page || (page->type != MTYPE_MALLOCFREE)) { - GCPRINT(GCOUTF, "Free of non-malloced pointer! %p\n", p); - return; - } - - if (page->flags & MFLAG_BIGBLOCK) { - if ((page->flags & MFLAG_CONTINUED) || (p != page->block_start)) { - GCPRINT(GCOUTF, "Free of in the middle of large malloced pointer! %p\n", p); - return; - } - - free_bigpage(page); - - return; - } - - pos = (void **)p - (void **)page->block_start; - - sz = OFFSET_SIZE(page->u.offsets, pos); - - if (!sz) { - GCPRINT(GCOUTF, "Free of non-malloced to already-freed pointer! %p\n", p); - return; - } - - if (sz == MALLOC_MIDDLE_SIZE) { - GCPRINT(GCOUTF, "Free in middle of malloced pointer! %p\n", p); - return; - } - - OFFSET_SET_SIZE_UNMASKED(page->u.offsets, pos, 0); - - ((int *)p)[0] = sz; - ((void **)p)[1] = mallocfree_freelists[sz]; - mallocfree_freelists[sz] = p; - - while (--sz) { - pos++; - OFFSET_SET_SIZE_UNMASKED(page->u.offsets, pos, 0); - } -} - -void *realloc(void *p, size_t size) -{ - void *naya; - size_t oldsize; - - if (p) { - MPage *page; - page = find_page(p); - if (!page || (page->type != MTYPE_MALLOCFREE)) { - GCPRINT(GCOUTF, "Realloc of non-malloced pointer! %p\n", p); - oldsize = 0; - } else { - if (page->flags & MFLAG_BIGBLOCK) { - if ((page->flags & MFLAG_CONTINUED) || (p != page->block_start)) { - GCPRINT(GCOUTF, "Realloc of in the middle of large malloced pointer! %p\n", p); - oldsize = 0; - } else - oldsize = page->u.size; - } else { - int pos; - pos = (void **)p - (void **)page->block_start; - oldsize = OFFSET_SIZE(page->u.offsets, pos); - if (oldsize == MALLOC_MIDDLE_SIZE) { - GCPRINT(GCOUTF, "Realloc in middle of malloced pointer! %p\n", p); - oldsize = 0; - } - } - } - } else - oldsize = 0; - - oldsize <<= LOG_WORD_SIZE; - - naya = malloc(size); - if (oldsize > size) - oldsize = size; - memcpy(naya, p, oldsize); - if (p) - free(p); - - return naya; -} - -void *calloc(size_t n, size_t size) -{ - void *p; - long c; - - c = n * size; - p = malloc(c); - memset(p, 0, c); - - return p; -} - -# if CHECKS -static void check_not_freed(MPage *page, const void *p) -{ - if (page->flags & MFLAG_BIGBLOCK) { - /* Ok */ - } else { - int pos; - pos = (void **)p - (void **)page->block_start; - if (!OFFSET_SIZE(page->u.offsets, pos)) { - GCPRINT(GCOUTF, "Mark of previously malloced? (now freed) pointer: %p\n", p); - CRASH(77); - } - } -} -# endif - -#endif - -/******************************************************************************/ -/* GC stat dump */ -/******************************************************************************/ - -static long dump_info_array[BIGBLOCK_MIN_SIZE]; - -#if KEEP_BACKPOINTERS - -static void *trace_backpointer(MPage *page, void *p) -{ - - if (page->flags & MFLAG_BIGBLOCK) - return (void *)page->backpointer_page; - else { - int offset; - offset = ((char *)p - (char *)page->block_start) >> LOG_WORD_SIZE; - if (page->type != MTYPE_TAGGED) - offset -= 1; - if (offset > 0) - return page->backpointer_page[offset]; - else - return NULL; /* This shouldn't happen */ - } -} - -# define trace_page_t MPage -# define trace_page_type(page) (page)->type -static void *trace_pointer_start(struct mpage *page, void *p) { - if (page->flags & MFLAG_BIGBLOCK) - return page->block_start; - else - return p; -} -# define TRACE_PAGE_TAGGED MTYPE_TAGGED -# define TRACE_PAGE_ARRAY MTYPE_ARRAY -# define TRACE_PAGE_TAGGED_ARRAY MTYPE_TAGGED_ARRAY -# define TRACE_PAGE_ATOMIC MTYPE_ATOMIC -# define TRACE_PAGE_XTAGGED MTYPE_XTAGGED -# define TRACE_PAGE_MALLOCFREE MTYPE_MALLOCFREE -# define TRACE_PAGE_BAD 0 -# define trace_page_is_big(page) ((page)->flags & MFLAG_BIGBLOCK) - -# include "backtrace.c" - -#endif - -static long scan_tagged_mpage(void **p, MPage *page, short trace_for_tag, - GC_for_each_found_proc for_each_found) -{ - void **top, **bottom = p; - - top = p + MPAGE_WORDS; - - while (p < top) { - Type_Tag tag; - long size; - - tag = *(Type_Tag *)p; - - if (tag == TAGGED_EOM) { - return (p - bottom); - } - -#if ALIGN_DOUBLES - if (tag == SKIP) { - p++; - } else { -#endif - { - Size_Proc size_proc; - - size_proc = size_table[tag]; - if (((long)size_proc) < 100) - size = (long)size_proc; - else - size = size_proc(p); - } - - dump_info_array[tag]++; - dump_info_array[tag + NUMBER_OF_TAGS] += size; - - if (tag == trace_for_tag) { -#if KEEP_BACKPOINTERS - register_traced_object(p); -#endif - if (for_each_found) - for_each_found(p); - } - - p += size; -#if ALIGN_DOUBLES - } -#endif - } - - return MPAGE_WORDS; -} - -static long scan_untagged_mpage(void **p, MPage *page) -{ - void **top, **bottom = p; - - top = p + MPAGE_WORDS; - - while (p < top) { - long size; - - size = *(long *)p + 1; - - if (size == UNTAGGED_EOM) { - return (p - bottom); - } - - dump_info_array[size - 1] += 1; - - p += size; - } - - return MPAGE_WORDS; -} - -#if KEEP_BACKPOINTERS - -int GC_is_tagged(void *p) -{ - MPage *page; - page = find_page(p); - return page && (page->type == MTYPE_TAGGED); -} - -static void *next_tagged_start(void *p, int stop_at_p) -{ - MPage *page; - void **p2, **top; - int prev_was_p = 0; - - page = find_page(p); - if (page && (page->type == MTYPE_TAGGED)) { - p2 = (void **)page->block_start; - - if (page->flags & MFLAG_CONTINUED) - return NULL; - if (page->flags & MFLAG_BIGBLOCK) { - if (p == (void *)p2) { - if (stop_at_p) - return p; - } - return NULL; - } - - top = p2 + MPAGE_WORDS; - - while (p2 < top) { - Type_Tag tag; - long size; - - if (stop_at_p) { - if ((void *)p2 == p) - return p; - if ((unsigned long)p2 > (unsigned long)p) - break; - } - - tag = *(Type_Tag *)p2; - - if (tag == TAGGED_EOM) - break; - -#if ALIGN_DOUBLES - if (tag == SKIP) { - p2++; - } else { -#endif - if (prev_was_p) - return (void *)p2; - - { - Size_Proc size_proc; - - size_proc = size_table[tag]; - if (((long)size_proc) < 100) - size = (long)size_proc; - else - size = size_proc(p2); - } - - prev_was_p = (p == p2); - - p2 += size; -#if ALIGN_DOUBLES - } -#endif - } - } - - return NULL; -} - -int GC_is_tagged_start(void *p) -{ - if (next_tagged_start(p, 1)) - return 1; - else - return 0; -} - -void *GC_next_tagged_start(void *p) -{ - void *p2; - - while (1) { - p2 = next_tagged_start(p, 0); - if (p2) - return p2; - - p = (void *)(((long)p & MPAGE_START) + MPAGE_SIZE); - if (!p) - return NULL; - } -} - -#endif - -void GC_dump_with_traces(int flags, - GC_get_type_name_proc get_type_name, - GC_get_xtagged_name_proc get_xtagged_name, - GC_for_each_found_proc for_each_found, - short trace_for_tag, - GC_print_tagged_value_proc print_tagged_value, - int path_length_limit) -{ - int i; - long waste = 0; - - if (!(flags & GC_DUMP_SHOW_TRACE)) - trace_for_tag = -1; -#if KEEP_BACKPOINTERS - reset_object_traces(); -#endif - if (for_each_found) - avoid_collection++; - - if (flags & GC_DUMP_SHOW_DETAILS) { - GCPRINT(GCOUTF, "t=tagged a=atomic v=array x=xtagged g=tagarray\n"); - GCPRINT(GCOUTF, "mpagesize=%ld opagesize=%ld\n", (long)MPAGE_SIZE, (long)OPAGE_SIZE); - GCPRINT(GCOUTF, "["); - for (i = 0; i < MAPS_SIZE; i++) { - if (i && !(i & 63)) - GCPRINT(GCOUTF, "\n "); - - if (mpage_maps[i]) - GCPRINT(GCOUTF, "*"); - else - GCPRINT(GCOUTF, "-"); - } - GCPRINT(GCOUTF, "]\n"); - for (i = 0; i < MAPS_SIZE; i++) { - MPage *maps = mpage_maps[i]; - if (maps) { - int j; - GCPRINT(GCOUTF, "%.2x:\n ", i); - for (j = 0; j < MAP_SIZE; j++) { - if (j && !(j & 63)) - GCPRINT(GCOUTF, "\n "); - - if (maps[j].type -#if DEFINE_MALLOC_FREE - && (maps[j].type != MTYPE_MALLOCFREE) -#endif - ) { - int c; - - if (maps[j].flags & MFLAG_CONTINUED) - c = '.'; - else { - if (maps[j].type <= MTYPE_TAGGED) - c = 't'; - else if (maps[j].type == MTYPE_TAGGED_ARRAY) - c = 'g'; - else if (maps[j].type == MTYPE_ATOMIC) - c = 'a'; - else if (maps[j].type == MTYPE_XTAGGED) - c = 'x'; - else - c = 'v'; - - if (maps[j].flags & MFLAG_BIGBLOCK) - c = c - ('a' - 'A'); - } - - GCPRINT(GCOUTF, "%c", c); - } else { - GCPRINT(GCOUTF, "-"); - } - } - GCPRINT(GCOUTF, "\n"); - } - } - - { - MPage *page; - - GCPRINT(GCOUTF, "Block info: [type][modified?][age][refs-age]\n"); - for (page = first, i = 0; page; page = page->next, i++) { - int c; - - if (page->flags & MFLAG_CONTINUED) - c = '.'; - else { - if (page->type <= MTYPE_TAGGED) - c = 't'; - else if (page->type == MTYPE_TAGGED_ARRAY) - c = 'g'; - else if (page->type == MTYPE_ATOMIC) - c = 'a'; - else if (page->type == MTYPE_XTAGGED) - c = 'x'; - else - c = 'v'; - - if (page->flags & MFLAG_BIGBLOCK) - c = c - ('a' - 'A'); - } - - GCPRINT(GCOUTF, " %c%c%c%c", - c, - ((page->flags & MFLAG_MODIFIED) - ? 'M' - : '_'), - ((page->age < 10) - ? (page->age + '0') - : (page->age + 'a' - 10)), - ((page->type == MTYPE_ATOMIC) - ? '-' - : ((page->refs_age < 10) - ? (page->refs_age + '0') - : (page->refs_age + 'a' - 10)))); - if ((i % 10) == 9) - GCPRINT(GCOUTF, "\n"); - } - GCPRINT(GCOUTF, "\n"); - } - } - - { - int j; - - init(); - set_ending_tags(); - - for (j = 0; j < NUM_SETS; j++) { - int kind, i; - char *name; - MPage *page; - long used, total; - - switch (j) { - case 1: kind = MTYPE_ARRAY; name = "array"; break; - case 2: kind = MTYPE_ATOMIC; name = "atomic"; break; - case 3: kind = MTYPE_XTAGGED; name = "xtagged"; break; - case 4: kind = MTYPE_TAGGED_ARRAY; name = "tagarray"; break; - default: kind = MTYPE_TAGGED; name = "tagged"; break; - } - - for (i = 0; i < (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE); i++) - dump_info_array[i] = 0; - - total = 0; - - for (page = first; page; page = page->next) { - if ((page->type == kind) && !(page->flags & MFLAG_BIGBLOCK)) { - if (j >= NUM_TAGGED_SETS) - used = scan_untagged_mpage(page->block_start, page); /* gets size counts */ - else - used = scan_tagged_mpage(page->block_start, page, - trace_for_tag, for_each_found); /* gets tag counts */ - - total += used; - waste += (MPAGE_WORDS - used); - } - if ((page->flags & MFLAG_BIGBLOCK) - && (page->type == kind) - && (((trace_for_tag >= (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE)) - && (page->u.size > trace_for_tag)) - || (page->u.size == -trace_for_tag))) { -#if KEEP_BACKPOINTERS - register_traced_object(page->block_start); -#endif - if (for_each_found) - for_each_found(page->block_start); - } - } - - if (j >= NUM_TAGGED_SETS) { - int k = 0; - if (flags & GC_DUMP_SHOW_DETAILS) { - GCPRINT(GCOUTF, "%s counts: ", name); - for (i = 0; i < (BIGBLOCK_MIN_SIZE >> LOG_WORD_SIZE); i++) { - if (dump_info_array[i]) { - k++; - if (k == 10) { - GCPRINT(GCOUTF, "\n "); - k = 0; - } - GCPRINT(GCOUTF, " [%d:%ld]", i << LOG_WORD_SIZE, dump_info_array[i]); - } - } - GCPRINT(GCOUTF, "\n"); - } - } else { - GCPRINT(GCOUTF, "Tag counts and sizes:\n"); - GCPRINT(GCOUTF, "Begin MzScheme3m\n"); - for (i = 0; i < NUMBER_OF_TAGS; i++) { - if (dump_info_array[i]) { - char *tn, buf[256]; - switch(i) { - case gc_on_free_list_tag: tn = "freelist-elem"; break; - default: - if (i == weak_array_tag) - tn = "weak-array"; - else if (get_type_name) - tn = get_type_name((Type_Tag)i); - else - tn = NULL; - if (!tn) { - sprintf(buf, "unknown,%d", i); - tn = buf; - } - break; - } - GCPRINT(GCOUTF, " %20.20s: %10ld %10ld\n", tn, dump_info_array[i], (dump_info_array[i + NUMBER_OF_TAGS]) << LOG_WORD_SIZE); - } - } - GCPRINT(GCOUTF, "End MzScheme3m\n"); - } - - if (flags & GC_DUMP_SHOW_DETAILS) { - int did_big = 0; - for (page = first; page; page = page->next) { - if ((page->type == kind) && (page->flags & MFLAG_BIGBLOCK) && !(page->flags & MFLAG_CONTINUED)) { - if (!did_big) { - GCPRINT(GCOUTF, " "); - did_big = 1; - } - if (j >= NUM_TAGGED_SETS) - GCPRINT(GCOUTF, " [+%ld]", page->u.size); - else - GCPRINT(GCOUTF, " %d:[+%ld]", (int)*(Type_Tag *)(page->block_start), page->u.size); - - total += (page->u.size >> LOG_WORD_SIZE); - waste += ((page->u.size >> LOG_WORD_SIZE) & (MPAGE_WORDS - 1)); - } - } - if (did_big) - GCPRINT(GCOUTF, "\n"); - } - - GCPRINT(GCOUTF, " Total %s: %ld\n", name, total << LOG_WORD_SIZE); - } - } - - GCPRINT(GCOUTF, "Active fnls: %d\n", GC->num_fnls); - GCPRINT(GCOUTF, "Active fnl weak links: %d\n", fnl_weak_link_count); - - if (memory_in_use > max_memory_use) - max_memory_use = memory_in_use; - - GCPRINT(GCOUTF, "Number of collections: %d (%d compacting)\n", gc_count, compact_count); - GCPRINT(GCOUTF, "Memory high point: %ld\n", max_memory_use); - - GCPRINT(GCOUTF, "Memory use: %ld\n", memory_in_use - FREE_LIST_DELTA); - GCPRINT(GCOUTF, "Memory wasted: %ld (%.2f%%)\n", waste << LOG_WORD_SIZE, - (100.0 * (waste << LOG_WORD_SIZE)) / memory_in_use); - GCPRINT(GCOUTF, "Memory overhead: %ld (%.2f%%) %ld (%.2f%%) on free list\n", - page_allocations - memory_in_use + FREE_LIST_DELTA, - (100.0 * ((double)page_allocations - memory_in_use)) / memory_in_use, - (long)FREE_LIST_DELTA, - (100.0 * FREE_LIST_DELTA) / memory_in_use); - GCPRINT(GCOUTF, "Mmap overhead: %ld (%.2f%%)\n", - vm_memory_allocated(GC->vm) - memory_in_use + FREE_LIST_DELTA, - (100.0 * ((double) vm_memory_allocated(GC->vm) - memory_in_use)) / memory_in_use); - -#if KEEP_BACKPOINTERS - if (flags & GC_DUMP_SHOW_TRACE) { - print_traced_objects(path_length_limit, get_type_name, get_xtagged_name, print_tagged_value); - } - if (flags & GC_DUMP_SHOW_FINALS) { - Fnl *f; - avoid_collection++; - GCPRINT(GCOUTF, "Begin Finalizations\n"); - for (f = finalizers; f; f = f->next) { - print_out_pointer("==@ ", f->p, get_type_name, get_xtagged_name, print_tagged_value); - } - GCPRINT(GCOUTF, "End Finalizations\n"); - --avoid_collection; - } -#endif - if (for_each_found) - --avoid_collection; -} - -void GC_dump(void) -{ - GC_dump_with_traces(0, NULL, NULL, NULL, 0, NULL, 0); -} - -/******************************************************************************/ -/* GC free all */ -/******************************************************************************/ - -void GC_free_all(void) -{ - vm_flush_freed_pages(GC->vm); - vm_free(GC->vm); - free(GC); -} - diff --git a/src/mzscheme/gc2/compactgc_internal.h b/src/mzscheme/gc2/compactgc_internal.h deleted file mode 100644 index b06ef01a84..0000000000 --- a/src/mzscheme/gc2/compactgc_internal.h +++ /dev/null @@ -1,23 +0,0 @@ -#include "commongc_internal.h" - -typedef struct CompactGC { - /* Common with NewGC */ - Fnl *finalizers; - Fnl *splayed_finalizers; - int num_fnls; - - void *park[2]; - void *park_save[2]; - - unsigned short weak_array_tag; - unsigned short weak_box_tag; - unsigned short ephemeron_tag; - unsigned short cust_box_tag; - - Roots roots; - GC_Weak_Array *weak_arrays; - GC_Weak_Box *weak_boxes; - GC_Ephemeron *ephemerons; - int num_last_seen_ephemerons; - struct VM *vm; -} CompactGC; diff --git a/src/mzscheme/gc2/copy.c b/src/mzscheme/gc2/copy.c deleted file mode 100644 index 3873342d80..0000000000 --- a/src/mzscheme/gc2/copy.c +++ /dev/null @@ -1,1789 +0,0 @@ -/* - Precise GC for MzScheme - Copyright (c) 2004-2010 PLT Scheme Inc. - Copyright (c) 1999 Matthew Flatt - All rights reserved. - - Please see the full copyright in the documentation. -*/ - -/* This implementation is currently hard-wired for 4-byte words */ - -#include -#include -#include - -#define USE_MMAP 1 -#define GROW_FACTOR 1.5 - -#if defined(sparc) || defined(__sparc) || defined(__sparc__) -# define ALIGN_DOUBLES 1 -#else -# define ALIGN_DOUBLES 0 -#endif - -#if USE_MMAP -/* For mmap: */ -# include -# include -# include -# include -#endif - -typedef short Type_Tag; - -#include "gc2.h" - -#define TIME 0 -#define SEARCH 1 -#define SAFETY 1 -#define RECYCLE_HEAP 0 -#define KEEP_FROM_PTR 0 - -#define GC_EVERY_ALLOC 0 -#define ALLOC_GC_PHASE 0 -#define SKIP_FORCED_GC 0 - -#define CHECK_STACK_EVERY 5 -#define CHECK_STACK_START -1 - -void (*GC_collect_start_callback)(void); -void (*GC_collect_end_callback)(void); -void (*GC_out_of_memory)(void); -unsigned long (*GC_get_thread_stack_base)(void); - -void (*GC_mark_xtagged)(void *obj); -void (*GC_fixup_xtagged)(void *obj); - -void **GC_variable_stack; - -Type_Tag weak_box_tag; - -#define gc_finalization_tag 256 -#define gc_finalization_weak_link_tag 257 -#define gc_weak_array_tag 258 - -#define _num_tags_ 259 - -Size_Proc size_table[_num_tags_]; -Mark_Proc mark_table[_num_tags_]; -Fixup_Proc fixup_table[_num_tags_]; - -#define STARTING_PLACE ((void *)0x400000) - -void *GC_alloc_space = STARTING_PLACE, *GC_alloc_top; -static long alloc_size, heap_size = 32000; -static void **tagged_high = STARTING_PLACE, **untagged_low = STARTING_PLACE; -static void **new_tagged_high, **new_untagged_low; - -static void *old_space; -static long old_size; - -static char *alloc_bitmap; - -static char zero_sized[4]; - -static void *park[2]; - -static int cycle_count = 0; -#if GC_EVERY_ALLOC -static int alloc_cycle = ALLOC_GC_PHASE; -static int skipped_first = !SKIP_FORCED_GC; -#endif - -#if KEEP_FROM_PTR -static void *mark_source; -# define FROM_STACK ((void *)0xAAAA1) -# define FROM_ROOT ((void *)0xAAAA3) -# define FROM_FNL ((void *)0xAAAA5) -# define FROM_NEW ((void *)0xAAAA7) -# define FROM_IMM ((void *)0xAAAA7) -#endif - -/******************************************************************************/ - -#if USE_MMAP - -int fd, fd_created; - -#define PAGE_SIZE 4096 - -void *malloc_pages(size_t len) -{ - void *r; - - if (!fd_created) { - fd_created = 1; - fd = open("/dev/zero", O_RDWR); - } - - if (len & (PAGE_SIZE - 1)) { - len += PAGE_SIZE - (len & (PAGE_SIZE - 1)); - } - - r = mmap(NULL, len, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0); - - if (r == (void *)-1) { - printf("mmap failed: %s\n", strerror(errno)); - exit(-1); - } - - return r; -} - -void free_pages(void *p, size_t len) -{ - munmap(p, len); -} - -#endif - -/******************************************************************************/ - -#if !USE_MMAP - -void *malloc_pages(size_t len) -{ - return malloc(len); -} - -void free_pages(void *p, size_t len) -{ - free(p); -} - -#endif - -/******************************************************************************/ - -#define PTR_ALIGNMENT 4 -#define PTR_TO_INT(x) ((unsigned long)x) -#define INT_TO_PTR(x) ((void *)x) - -static long roots_count; -static long roots_size; -static unsigned long *roots; - -static int compare_roots(const void *a, const void *b) -{ - if (*(unsigned long *)a < *(unsigned long *)b) - return -1; - else - return 1; -} - -static void sort_and_merge_roots() -{ - static int counter = 0; - int i, offset, top; - - if (roots_count < 4) - return; - - /* Only try this every 5 collections or so: */ - if (counter--) - return; - counter = 5; - - qsort(roots, roots_count >> 1, 2 * sizeof(unsigned long), compare_roots); - offset = 0; - top = roots_count; - for (i = 2; i < top; i += 2) { - if ((roots[i - 2 - offset] <= roots[i]) - && ((roots[i - 1 - offset] + (PTR_ALIGNMENT - 1)) >= roots[i])) { - /* merge: */ - if (roots[i + 1] > roots[i - 1 - offset]) - roots[i - 1 - offset] = roots[i + 1]; - offset += 2; - roots_count -= 2; - } else if (roots[i] == roots[i + 1]) { - /* Remove empty range: */ - offset += 2; - roots_count -= 2; - } else if (offset) { - /* compact: */ - roots[i - offset] = roots[i]; - roots[i + 1 - offset] = roots[i + 1]; - } - } -} - -void GC_add_roots(void *start, void *end) -{ - if (roots_count >= roots_size) { - unsigned long *naya; - - roots_size = roots_size ? 2 * roots_size : 500; - naya = (unsigned long *)malloc(sizeof(unsigned long) * (roots_size + 1)); - - memcpy((void *)naya, (void *)roots, - sizeof(unsigned long) * roots_count); - - if (roots) - free(roots); - - roots = naya; - } - - roots[roots_count++] = PTR_TO_INT(start); - roots[roots_count++] = PTR_TO_INT(end) - PTR_ALIGNMENT; -} - -typedef struct ImmobileBox { - void *p; - struct ImmobileBox *next, *prev; -} ImmobileBox; - -static ImmobileBox *immobile; - -void *GC_malloc_immobile_box(void *p) -{ - ImmobileBox *ib; - - ib = (ImmobileBox *)malloc(sizeof(ImmobileBox)); - ib->p = p; - ib->next = immobile; - if (immobile) - immobile->prev = ib; - ib->prev = NULL; - - immobile = ib; - - return ib; -} - -void GC_free_immobile_box(void *b) -{ - ImmobileBox *ib = (ImmobileBox *)b; - - if (!ib) - return; - - if (ib->prev) - ib->prev->next = ib->next; - else - immobile = ib->next; - if (ib->next) - ib->next->prev = ib->prev; - - free(ib); -} - -/******************************************************************************/ - -typedef struct GC_Weak_Array { - Type_Tag type; - short keyex; - long count; - void *replace_val; - struct GC_Weak_Array *next; - void *data[1]; -} GC_Weak_Array; - -static GC_Weak_Array *weak_arrays; - -static int size_weak_array(void *p) -{ - GC_Weak_Array *a = (GC_Weak_Array *)p; - - return gcBYTES_TO_WORDS(sizeof(GC_Weak_Array) - + ((a->count - 1) * sizeof(void *))); -} - -static int mark_weak_array(void *p) -{ - /* Not used */ - return size_weak_array(p); -} - -static int fixup_weak_array(void *p) -{ - GC_Weak_Array *a = (GC_Weak_Array *)p; - - gcFIXUP(a->replace_val); - - a->next = weak_arrays; - weak_arrays = a; - - return size_weak_array(p); -} - -void *GC_malloc_weak_array(size_t size_in_bytes, void *replace_val) -{ - GC_Weak_Array *w; - - /* Allcation might trigger GC, so we use park: */ - park[0] = replace_val; - - w = (GC_Weak_Array *)GC_malloc_one_tagged(size_in_bytes - + sizeof(GC_Weak_Array) - - sizeof(void *)); - - replace_val = park[0]; - park[0] = NULL; - - w->type = gc_weak_array_tag; - w->replace_val = replace_val; - w->count = (size_in_bytes >> 2); - - return w; -} - -typedef struct GC_Weak_Box { - /* The first three fields are mandated by the GC spec: */ - Type_Tag type; - short keyex; - void *val; - /* The rest is up to us: */ - void **secondary_erase; - int soffset; - struct GC_Weak_Box *next; -} GC_Weak_Box; - -static GC_Weak_Box *weak_boxes; - -static int size_weak_box(void *p) -{ - return gcBYTES_TO_WORDS(sizeof(GC_Weak_Box)); -} - -static int mark_weak_box(void *p) -{ - /* Not used */ - return gcBYTES_TO_WORDS(sizeof(GC_Weak_Box)); -} - -static int fixup_weak_box(void *p) -{ - GC_Weak_Box *wb = (GC_Weak_Box *)p; - - gcFIXUP(wb->secondary_erase); - if (wb->val) { - wb->next = weak_boxes; - weak_boxes = wb; - } - - return gcBYTES_TO_WORDS(sizeof(GC_Weak_Box)); -} - -void *GC_malloc_weak_box(void *p, void **secondary, int soffset) -{ - GC_Weak_Box *w; - - /* Allcation might trigger GC, so we use park: */ - park[0] = p; - park[1] = secondary; - - w = (GC_Weak_Box *)GC_malloc_one_tagged(sizeof(GC_Weak_Box)); - - p = park[0]; - park[0] = NULL; - secondary = (void **)park[1]; - park[1] = NULL; - - w->type = weak_box_tag; - w->val = p; - w->secondary_erase = secondary; - w->soffset = soffset; - - return w; -} - -/******************************************************************************/ - -typedef struct Fnl { - Type_Tag type; - short eager_level; - void *p; - void (*f)(void *p, void *data); - void *data; - struct Fnl *next; -} Fnl; - -static Fnl *fnls, *run_queue, *last_in_queue; - -static int size_finalizer(void *p) -{ - return gcBYTES_TO_WORDS(sizeof(Fnl)); -} - -static int mark_finalizer(void *p) -{ - /* Not used */ - return gcBYTES_TO_WORDS(sizeof(Fnl)); -} - -static int fixup_finalizer(void *p) -{ - Fnl *fnl = (Fnl *)p; - - gcFIXUP(fnl->next); - gcFIXUP(fnl->data); - if (!fnl->eager_level) { - /* Queued for run: */ - gcFIXUP(fnl->p); - } - - return gcBYTES_TO_WORDS(sizeof(Fnl)); -} - -void GC_set_finalizer(void *p, int tagged, int level, void (*f)(void *p, void *data), - void *data, void (**oldf)(void *p, void *data), - void **olddata) -{ - Fnl *fnl, *prev; - - if (((long)p & 0x1) || (p < GC_alloc_space) || (p > GC_alloc_top)) { - /* Never collected. Don't finalize it. */ - if (oldf) *oldf = NULL; - if (olddata) *olddata = NULL; - return; - } - - fnl = fnls; - prev = NULL; - while (fnl) { - if (fnl->p == p) { - if (oldf) *oldf = fnl->f; - if (olddata) *olddata = fnl->data; - if (f) { - fnl->f = f; - fnl->data = data; - fnl->eager_level = level; - } else { - if (prev) - prev->next = fnl->next; - else - fnls = fnl->next; - return; - } - return; - } else { - prev = fnl; - fnl = fnl->next; - } - } - - if (oldf) *oldf = NULL; - if (olddata) *olddata = NULL; - - if (!f) - return; - - /* Allcation might trigger GC, so we use park: */ - park[0] = p; - park[1] = data; - - fnl = GC_malloc_one_tagged(sizeof(Fnl)); - - p = park[0]; - park[0] = NULL; - data = park[1]; - park[1] = NULL; - - fnl->type = gc_finalization_tag; - fnl->next = fnls; - fnl->p = p; - fnl->f = f; - fnl->data = data; - fnl->eager_level = level; - - fnls = fnl; -} - -typedef struct Fnl_Weak_Link { - Type_Tag type; - void *p; - long offset; /* offset from beginning of block */ - void *saved; - struct Fnl_Weak_Link *next; -} Fnl_Weak_Link; - -static Fnl_Weak_Link *fnl_weaks; - -static int size_finalizer_weak_link(void *p) -{ - return gcBYTES_TO_WORDS(sizeof(Fnl_Weak_Link)); -} - -static int mark_finalizer_weak_link(void *p) -{ - /* Not used */ - return gcBYTES_TO_WORDS(sizeof(Fnl_Weak_Link)); -} - -static int fixup_finalizer_weak_link(void *p) -{ - Fnl_Weak_Link *wl = (Fnl_Weak_Link *)p; - - gcFIXUP(wl->next); - - return gcBYTES_TO_WORDS(sizeof(Fnl_Weak_Link)); -} - -void GC_finalization_weak_ptr(void **p, int offset) -{ - Fnl_Weak_Link *wl; - -#ifdef SAFETY - if (((void *)p < GC_alloc_space) || (p >= GC_alloc_top)) { - *(int *)0x0 = 1; - } -#endif - - /* Allcation might trigger GC, so we use park: */ - park[0] = p; - - wl = (Fnl_Weak_Link *)GC_malloc_one_tagged(sizeof(Fnl_Weak_Link)); - - p = park[0]; - park[0] = NULL; - - wl->type = gc_finalization_weak_link_tag; - wl->p = p; - wl->offset = offset * sizeof(void*); - wl->next = fnl_weaks; - - fnl_weaks = wl; -} - -/******************************************************************************/ - -static unsigned long stack_base; - -void GC_set_stack_base(void *base) -{ - stack_base = (unsigned long)base; -} - -unsigned long GC_get_stack_base(void) -{ - return stack_base; -} - -void GC_dump(void) -{ - fprintf(stderr, "Memory use: %ld\n", GC_get_memory_use()); -} - -long GC_get_memory_use() -{ - return (alloc_size - ((untagged_low - tagged_high) << 2)); -} - -void GC_init_type_tags(int count, int weakbox) -{ - weak_box_tag = weakbox; -} - -#define SKIP ((Type_Tag)0x7000) -#define MOVED ((Type_Tag)0x3000) - -#if SEARCH -void *search_for, *search_mark; -long search_size; -int detail_cycle; -int atomic_detail_cycle; -#endif - -#if SEARCH -void stop() -{ - printf("stopped\n"); -} -#endif - -/* Only works during GC: */ -void *find_start(void *p) -{ - long diff = ((char *)p - (char *)GC_alloc_space) >> 2; - - if (((long)p & 0x3) || !(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) { - while (!(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) { - diff--; - } - - diff <<= 2; - - return (void *)((char *)GC_alloc_space + diff); - } else - return p; -} - -#ifdef SAFETY -static void middle(unsigned long p, long delta, unsigned long where) -{ - fprintf(stderr, "Middle!: 0x%lx d: %ld at 0x%lx\n", p, delta, where); -} - -static int check_count = CHECK_STACK_START; - -static void check_interior_pointer(void **pp) -{ - void *p = *pp; - - if (check_count--) - return; - else - check_count = CHECK_STACK_EVERY; - - if (!((long)p & 0x1) - && (p >= GC_alloc_space) - && (p <= GC_alloc_top)) { - long diff = ((char *)p - (char *)GC_alloc_space) >> 2; - - if (((long)p & 0x3) || !(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) { - long diff1 = ((char *)p - (char *)GC_alloc_space); - - while (!(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) { - diff--; - } - - diff <<= 2; - - if (((diff + (char *)GC_alloc_space) > (char *)tagged_high) - && ((*(long *)(diff + (char *)GC_alloc_space - 4) & 0x20000000))) { - /* Middle is ok. */ - } else { - middle((unsigned long)p, diff1 - diff, (unsigned long)pp); - } - } - } -} -#endif - -static void *mark(void *p) -{ - long diff = ((char *)p - (char *)GC_alloc_space) >> 2; - -#if SEARCH - if (p == search_mark) - stop(); -#endif - - if (((long)p & 0x3) || !(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) { - long diff1 = ((char *)p - (char *)GC_alloc_space); - - while (!(alloc_bitmap[diff >> 3] & (1 << (diff & 0x7)))) { - diff--; - } - - diff <<= 2; - -#ifdef SAFETY - if (((diff + (char *)GC_alloc_space) > (char *)tagged_high) - && ((*(long *)(diff + (char *)GC_alloc_space - 4) & 0x20000000) - || (!(*(long *)(diff + (char *)GC_alloc_space - 4)) - && (*(long **)(diff + (char *)GC_alloc_space))[-1] & 0x20000000))) { - /* Middle is ok. */ - } else { - middle((unsigned long)p, diff1 - diff, 0); - } -#endif - - return (void *)((char *)mark(diff + (char *)GC_alloc_space) + (diff1 - diff)); - } else { - if (p < (void *)tagged_high) { - Type_Tag tag = *(Type_Tag *)p; - long size; - void *naya; - - if (tag == MOVED) - return ((void **)p)[1]; - -#if SAFETY - if ((tag < 0) || (tag >= _num_tags_) || !size_table[tag]) { - *(int *)0x0 = 1; - } -#endif - - size = size_table[tag](p); -#if ALIGN_DOUBLES - if (!(size & 0x1)) { - if ((long)new_tagged_high & 0x4) { - ((Type_Tag *)new_tagged_high)[0] = SKIP; - new_tagged_high += 1; - } - } -#endif - -#if KEEP_FROM_PTR - *new_tagged_high = mark_source; - new_tagged_high++; -#endif - - { - int i; - long *a, *b; - a = (long *)new_tagged_high; - b = (void *)p; - for (i = size; i--; ) - *(a++) = *(b++); - } - - naya = new_tagged_high; - ((Type_Tag *)p)[0] = MOVED; - ((void **)p)[1] = naya; - - new_tagged_high += size; -#if SEARCH - if (naya == search_for) { - stop(); - } -#endif - return naya; - } else { - long size; - - p -= 4; - size = ((*(long *)p) & 0x0FFFFFFF); - - if (!size) - return ((void **)p)[1]; - -#if ALIGN_DOUBLES - if (!(size & 1)) { - if (!((long)new_untagged_low & 0x4)) { - new_untagged_low--; - *(long *)new_untagged_low = 0; - } - } -#endif - size++; - - new_untagged_low -= size; - -#if SAFETY - if ((unsigned long)new_untagged_low < (unsigned long)new_tagged_high) { - *(int *)0x0 = 1; - } -#endif - - { - int i; - long *a, *b; - a = (long *)new_untagged_low; - b = (void *)p; - for (i = size; i--; ) - *(a++) = *(b++); - } - ((void **)p)[1] = new_untagged_low + 1; - ((long *)p)[0] = 0; - -#if SEARCH - if ((new_untagged_low + 1) == search_for) { - stop(); - } -#endif - -#if SEARCH - if (atomic_detail_cycle == cycle_count) { - printf("%ld at %lx\n", size, (long)new_untagged_low); - } -#endif - -#if KEEP_FROM_PTR - --new_untagged_low; - *new_untagged_low = mark_source; - return new_untagged_low + 2; -#else - return new_untagged_low + 1; -#endif - } - } -} - -void GC_mark(const void *p) -{ - /* Not used. */ -} - -void GC_fixup(void *_p) -{ - void *p; - - p = *(void **)_p; - - if (!((long)p & 0x1) - && (p >= GC_alloc_space) - && (p <= GC_alloc_top)) - *(void **)_p = mark(p); -} - -static void **o_var_stack, **oo_var_stack; - -void GC_mark_variable_stack(void **var_stack, - long delta, - void *limit) -{ - /* Not used. */ -} - -void GC_trace_variable_stack(void **var_stack, - long delta, - void *limit, - int just_check) -{ - int stack_depth; - - stack_depth = 0; - while (var_stack) { - long size; - void ***p; - - var_stack = (void **)((char *)var_stack + delta); - if (var_stack == limit) - return; - - size = *(long *)(var_stack + 1); - - oo_var_stack = o_var_stack; - o_var_stack = var_stack; - - p = (void ***)(var_stack + 2); - - while (size--) { - if (!*p) { - /* Array */ - long count = ((long *)p)[2]; - void **a = ((void ***)p)[1]; - p += 2; - size -= 2; - a = (void **)((char *)a + delta); - while (count--) { -#ifdef SAFETY - if (just_check) { - check_interior_pointer(a); - } else -#endif - { gcFIXUP(*a); } - a++; - } - } else { - void **a = *p; - a = (void **)((char *)a + delta); -#ifdef SAFETY - if (just_check) { - check_interior_pointer(a); - } else -#endif - { gcFIXUP(*a); } - } - p++; - } - -#if SAFETY - if (*var_stack && ((unsigned long)*var_stack <= (unsigned long)var_stack)) - *(int *)0x0 = 1; -#endif - - var_stack = *var_stack; - stack_depth++; - } -} - -void GC_fixup_variable_stack(void **var_stack, - long delta, - void *limit) -{ - GC_trace_variable_stack(var_stack, delta, limit, 0); -} - -#if SAFETY -void check_variable_stack() -{ - void **limit, **var_stack; - - if (!alloc_bitmap) - return; - - limit = (void **)(GC_get_thread_stack_base - ? GC_get_thread_stack_base() - : stack_base); - - var_stack = GC_variable_stack; - - GC_trace_variable_stack(var_stack, 0, limit, 1); -} -#endif - -#if 0 -# define GETTIME() ((long)scheme_get_milliseconds()) -#else -# define GETTIME() ((long)scheme_get_process_milliseconds()) -#endif - -#if TIME -# define PRINTTIME(x) fprintf x -# define STDERR stderr -static long started, rightnow, old; -# define INITTIME() (started = GETTIME()) -# define GETTIMEREL() (rightnow = GETTIME(), old = started, started = rightnow, rightnow - old) -#else -# define INITTIME() /* empty */ -# define PRINTTIME(x) /* empty */ -#endif - -static int initialized; -#if SAFETY -static long *prev_ptr; -static void **prev_var_stack; -#endif - -void gcollect(int needsize) -{ - /* Check old: */ - long *p, *top; - void *new_space; - long new_size; - void **tagged_mark, **untagged_mark; - char *bitmap; - int i, did_fnls; - long diff, iterations; - ImmobileBox *ib; - GC_Weak_Box *wb; - GC_Weak_Array *wa; - - INITTIME(); - PRINTTIME((STDERR, "gc: start: %ld\n", GETTIMEREL())); - - cycle_count++; - - if (!initialized) { - GC_register_traversers(weak_box_tag, size_weak_box, mark_weak_box, fixup_weak_box); - GC_register_traversers(gc_weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array); - GC_register_traversers(gc_finalization_tag, size_finalizer, mark_finalizer, fixup_finalizer); - GC_register_traversers(gc_finalization_weak_link_tag, size_finalizer_weak_link, mark_finalizer_weak_link, fixup_finalizer_weak_link); - - GC_add_roots(&fnls, (char *)&fnls + sizeof(fnls) + 1); - GC_add_roots(&fnl_weaks, (char *)&fnl_weaks + sizeof(fnl_weaks) + 1); - GC_add_roots(&run_queue, (char *)&run_queue + sizeof(run_queue) + 1); - GC_add_roots(&last_in_queue, (char *)&last_in_queue + sizeof(last_in_queue) + 1); - GC_add_roots(&park, (char *)&park + sizeof(park) + 1); - initialized = 1; - } - - weak_boxes = NULL; - weak_arrays = NULL; - did_fnls = 0; - - if (GC_collect_start_callback) - GC_collect_start_callback(); - - sort_and_merge_roots(); - - new_size = (heap_size * GROW_FACTOR); - if (new_size < alloc_size) - new_size = alloc_size; - - new_size += needsize; - - /* word-aligned: */ - new_size = (new_size + 3) & 0xFFFFFFFC; - - if (old_size >= new_size) { - new_size = old_size; - new_space = old_space; - } else { - if (old_size) { - free_pages(old_space, old_size); - old_size = 0; - } - - new_space = malloc_pages(new_size + 4); - - if (!new_space) { - printf("Out of memory"); - abort(); - } - } - - /******************** Mark/Copy ****************************/ - - tagged_mark = new_tagged_high = (void **)new_space; - untagged_mark = new_untagged_low = (void **)(new_space + new_size); - -#if KEEP_FROM_PTR - mark_source = FROM_STACK; -#endif - - GC_fixup_variable_stack(GC_variable_stack, - 0, - (void *)(GC_get_thread_stack_base - ? GC_get_thread_stack_base() - : stack_base)); - - PRINTTIME((STDERR, "gc: stack: %ld\n", GETTIMEREL())); - -#if KEEP_FROM_PTR - mark_source = FROM_ROOT; -#endif - - for (i = 0; i < roots_count; i += 2) { - void **s = (void **)roots[i]; - void **e = (void **)roots[i + 1]; - - while (s < e) { - gcFIXUP(*s); - s++; - } - } - -#if KEEP_FROM_PTR - mark_source = FROM_IMM; -#endif - - /* Do immobiles: */ - for (ib = immobile; ib; ib = ib->next) { - gcFIXUP(ib->p); - } - - PRINTTIME((STDERR, "gc: roots: %ld\n", GETTIMEREL())); - - iterations = 0; - - while (1) { /* Loop to do finalization */ - - while ((tagged_mark < new_tagged_high) - || (untagged_mark > new_untagged_low)) { - - iterations++; - - while (tagged_mark < new_tagged_high) { - Type_Tag tag; - long size; - -#if KEEP_FROM_PTR - tagged_mark++; -#endif - - tag = *(Type_Tag *)tagged_mark; - -#if ALIGN_DOUBLES - if (tag == SKIP) - tagged_mark++; - else { -#endif - -#if SAFETY - if ((tag < 0) || (tag >= _num_tags_) || !size_table[tag]) { - *(int *)0x0 = 1; - } -#endif - -#if KEEP_FROM_PTR - mark_source = tagged_mark; -#endif - - size = size_table[tag](tagged_mark); - fixup_table[tag](tagged_mark); - -#if SAFETY - if (size <= 1) { - *(int *)0x0 = 1; - } -#endif - - tagged_mark += size; - -#if SAFETY - if ((void *)tagged_mark < new_space) { - *(int *)0x0 = 1; - } -#endif -#if ALIGN_DOUBLES - } -#endif - } - - while (untagged_mark > new_untagged_low) { - void **mp, **started; - - mp = started = new_untagged_low; - while (mp < untagged_mark) { - long v, size; -#if KEEP_FROM_PTR - mp++; -#endif - v = *(long *)mp; - size = (v & 0x0FFFFFFF); - - if (v & 0xF0000000) { -#if KEEP_FROM_PTR - mark_source = mp; -#endif - mp++; - if (v & 0x80000000) { - /* Array of pointers */ - int i; - /* printf("parray: %d %lx\n", size, (long)mp); */ - for (i = size; i--; mp++) { - gcFIXUP(*mp); - } - } else if (v & 0x10000000) { - /* xtagged */ - GC_fixup_xtagged(mp); - mp += size; - } else { - /* Array of tagged */ - int i, elem_size; - Type_Tag tag = *(Type_Tag *)mp; - - elem_size = size_table[tag](mp); - fixup_table[tag](mp); - mp += elem_size; - for (i = elem_size; i < size; i += elem_size, mp += elem_size) - fixup_table[tag](mp); - } - } else - mp += v + 1; - } - untagged_mark = started; - } - } - - if ((did_fnls >= 3) || !fnls) { - if (did_fnls == 3) { - /* Finish up ordered finalization */ - Fnl *f, *next, *prev; - Fnl_Weak_Link *wl; - - /* Enqueue and mark level 3 finalizers that still haven't been marked. */ - /* (Recursive marking is already done, though.) */ - prev = NULL; - for (f = fnls; f; f = next) { - next = f->next; - if (f->eager_level == 3) { - void *v; - - v = GC_resolve(f->p); - - if (v == f->p) { - /* Not yet marked. Mark it and enqueue it. */ -#if KEEP_FROM_PTR - mark_source = f; -#endif - gcFIXUP(f->p); - - if (prev) - prev->next = next; - else - fnls = next; - - f->eager_level = 0; /* indicates queued */ - - f->next = NULL; - if (last_in_queue) { - last_in_queue->next = f; - last_in_queue = f; - } else { - run_queue = last_in_queue = f; - } - } else { - f->p = v; - prev = f; - } - } - } - - /* Restore zeroed out weak links, marking as we go: */ - for (wl = fnl_weaks; wl; wl = wl->next) { - void *wp = (void *)GC_resolve(wl->p); - int markit; - markit = (wp != wl->p); - wp = (wp + wl->offset); - if (markit) - gcFIXUP(wl->saved); - *(void **)wp = wl->saved; - } - - /* We have to mark one more time, because restoring a weak - link may have made something reachable. */ - - did_fnls++; - } else - break; - } else { - int eager_level = did_fnls + 1; - - if (eager_level == 3) { - /* Ordered finalization */ - Fnl *f; - Fnl_Weak_Link *wl; - - /* Zero out weak links for ordered finalization */ - for (wl = fnl_weaks; wl; wl = wl->next) { - void *wp = (void *)GC_resolve(wl->p); - wl->saved = *(void **)(wp + wl->offset); - *(void **)(wp + wl->offset) = NULL; - } - - /* Mark content of not-yet-marked finalized objects, - but don't mark the finalized objects themselves. */ - for (f = fnls; f; f = f->next) { - if (f->eager_level == 3) { - void *v; - - v = GC_resolve(f->p); - - if (v == f->p) { - /* Not yet marked. Do content. */ - Type_Tag tag = *(Type_Tag *)v; -#if SAFETY - if ((tag < 0) || (tag >= _num_tags_) || !fixup_table[tag]) { - *(int *)0x0 = 1; - } -#endif -#if KEEP_FROM_PTR - mark_source = FROM_FNL; -#endif - fixup_table[tag](v); - } - } - } - } else { - /* Unordered finalization */ - Fnl *f, *prev, *queue; - - f = fnls; - prev = NULL; - queue = NULL; - - while (f) { - if (f->eager_level == eager_level) { - void *v; - - v = GC_resolve(f->p); - - if (v == f->p) { - /* Not yet marked. Move finalization to run queue. */ - Fnl *next = f->next; - - if (prev) - prev->next = next; - else - fnls = next; - - f->eager_level = 0; /* indicates queued */ - - f->next = NULL; - if (last_in_queue) { - last_in_queue->next = f; - last_in_queue = f; - } else { - run_queue = last_in_queue = f; - } - if (!queue) - queue = f; - - f = next; - } else { - f->p = v; - prev = f; - f = f->next; - } - } else { - prev = f; - f = f->next; - } - } - - /* Mark items added to run queue: */ - f = queue; - while (f) { -#if KEEP_FROM_PTR - mark_source = f; -#endif - gcFIXUP(f->p); - f = f->next; - } - } - - did_fnls++; - } - - } - - PRINTTIME((STDERR, "gc: mark/copy (%d): %ld\n", iterations, GETTIMEREL())); - - /******************************************************/ - - /* Do weak boxes: */ - wb = weak_boxes; - while (wb) { - if (!((long)wb->val & 0x1) && ((void *)wb->val >= GC_alloc_space) && ((void *)wb->val <= GC_alloc_top)) { - void *v; - v = GC_resolve(wb->val); - if (v == wb->val) { - wb->val = NULL; - if (wb->secondary_erase) { - *(wb->secondary_erase + wb->soffset) = NULL; - wb->secondary_erase = NULL; - } - } else - wb->val = v; - } /* else not collectable */ - - wb = wb->next; - } - - /* Do weak arrays: */ - wa = weak_arrays; - while (wa) { - int i; - - for (i = wa->count; i--; ) { - void *p = wa->data[i]; - if (!((long)p & 0x1) && (p >= GC_alloc_space) && (p <= GC_alloc_top)) { - void *v; - v = GC_resolve(p); - if (v == p) - wa->data[i] = wa->replace_val; - else - wa->data[i] = v; - } /* else not collectable */ - } - - wa = wa->next; - } - - /* Cleanup weak finalization links: */ - { - Fnl_Weak_Link *wl, *prev, *next; - - prev = NULL; - for (wl = fnl_weaks; wl; wl = next) { - void *wp; - next = wl->next; - wp = (void *)GC_resolve(wl->p); - if (wp == wl->p) { - /* Collectable. Removed this link. */ - if (prev) - prev->next = next; - else - fnl_weaks = next; - } else { - wl->p = wp; - prev = wl; - } - } - } - - /******************************************************/ - -#if RECYCLE_HEAP - old_space = GC_alloc_space; - old_size = alloc_size; -#else - if (alloc_size) - free_pages(GC_alloc_space, alloc_size + 4); -#endif - - free(alloc_bitmap); - - PRINTTIME((STDERR, "gc: free: %ld\n", GETTIMEREL())); - - if (new_untagged_low < new_tagged_high) { - printf("Ouch: Tagged area collided with untagged area.\n"); - abort(); - } - - alloc_size = new_size; - GC_alloc_space = new_space; - GC_alloc_top = GC_alloc_space + alloc_size; - tagged_high = new_tagged_high; - untagged_low = new_untagged_low; - - heap_size = new_size - ((untagged_low - tagged_high) << 2); - - { - long *p = (long *)untagged_low; - while (p-- > (long *)tagged_high) - *p = 0; - } - - PRINTTIME((STDERR, "gc: restored: %ld\n", GETTIMEREL())); - - /******************** Make initial bitmap image: ****************************/ - - { - alloc_bitmap = bitmap = (char *)malloc((alloc_size >> 5) + 1); - memset(bitmap, 0, (alloc_size >> 5) + 1); - } - - p = (long *)untagged_low; - diff = (((char *)p - (char *)GC_alloc_space) + 4) >> 2; - top = (long *)GC_alloc_top; - while (p < top) { - long size; - -#if KEEP_FROM_PTR - diff++; - p++; -#endif - - size = (*p & 0x0FFFFFFF) + 1; - - bitmap[diff >> 3] |= (1 << (diff & 0x7)); - - p += size; - diff += size; - } - - p = ((long *)GC_alloc_space); - diff = ((char *)p - (char *)GC_alloc_space) >> 2; - while (p < (long *)tagged_high) { - Type_Tag tag; - long size; - -#if KEEP_FROM_PTR - diff++; - p++; -#endif - tag = *(Type_Tag *)p; - -#if ALIGN_DOUBLES - if (tag == SKIP) { - p++; - diff++; - } else { -#endif - bitmap[diff >> 3] |= (1 << (diff & 0x7)); - -#if SEARCH - if (cycle_count == detail_cycle) - printf("tag: %lx = %d\n", (long)p, tag); -#endif - -#if SAFETY - if ((tag < 0) || (tag >= _num_tags_) || !size_table[tag]) { - fflush(NULL); - *(int *)0x0 = 1; - } - prev_ptr = p; - prev_var_stack = GC_variable_stack; -#endif - size = size_table[tag](p); -#if SAFETY - if (prev_var_stack != GC_variable_stack) { - *(int *)0x0 = 1; - } -#endif - - p += size; - diff += size; -#if ALIGN_DOUBLES - } -#endif - } - - PRINTTIME((STDERR, "gc: done (t=%d, u=%d): %ld\n", - (long)((void *)tagged_high - GC_alloc_space), - (long)(GC_alloc_top - (void *)untagged_low), - GETTIMEREL())); - - if (GC_collect_start_callback) - GC_collect_end_callback(); - - /**********************************************************************/ - - /* Run Finalizations. Collections may happen */ - - while (run_queue) { - Fnl *f; - void **gcs; - - f = run_queue; - run_queue = run_queue->next; - if (!run_queue) - last_in_queue = NULL; - - gcs = GC_variable_stack; - f->f(f->p, f->data); - GC_variable_stack = gcs; - } -} - -void *GC_resolve(void *p) -{ - if (!((long)p & 0x1) && (p >= GC_alloc_space) && (p <= GC_alloc_top)) { - if (p < (void *)tagged_high) { - Type_Tag tag = *(Type_Tag *)p; - - if (tag == MOVED) - return ((void **)p)[1]; - else - return p; - } else { - long size; - - p -= 4; - size = ((*(long *)p) & 0x0FFFFFFF); - - if (!size) - return ((void **)p)[1]; - else - return p + 4; - } - } else - return p; -} - -static void *malloc_tagged(size_t size_in_bytes) -{ - void **m, **naya; - -#if SAFETY - check_variable_stack(); -#endif - -#if GC_EVERY_ALLOC -# if SKIP_FORCED_GC - if (!skipped_first) { - alloc_cycle++; - if (alloc_cycle >= SKIP_FORCED_GC) { - alloc_cycle = 0; - skipped_first = 1; - } - } -# endif - if (skipped_first) { - alloc_cycle++; - if (alloc_cycle >= GC_EVERY_ALLOC) { - alloc_cycle = 0; - gcollect(size_in_bytes); - } - } -#endif - -#if KEEP_FROM_PTR - size_in_bytes += 4; -#endif - - size_in_bytes = ((size_in_bytes + 3) & 0xFFFFFFFC); -#if ALIGN_DOUBLES - if (!(size_in_bytes & 0x4)) { - /* Make sure memory is 8-aligned */ - if (((long)tagged_high & 0x4)) { - if (tagged_high == untagged_low) { - gcollect(size_in_bytes); -#if KEEP_FROM_PTR - size_in_bytes -= 4; -#endif - return malloc_tagged(size_in_bytes); - } - ((Type_Tag *)tagged_high)[0] = SKIP; - tagged_high += 1; - } - } -#endif - -#if SEARCH - if (size_in_bytes == search_size) - stop(); -#endif - - m = tagged_high; - naya = tagged_high + (size_in_bytes >> 2); - if (naya > untagged_low) { - gcollect(size_in_bytes); -#if KEEP_FROM_PTR - size_in_bytes -= 4; -#endif - return malloc_tagged(size_in_bytes); - } - tagged_high = naya; - -#if KEEP_FROM_PTR - *m = FROM_NEW; - m++; -#endif - -#if SEARCH - if (m == search_for) { - stop(); - } -#endif - - { - long diff = ((char *)m - (char *)GC_alloc_space) >> 2; - - alloc_bitmap[diff >> 3] |= (1 << (diff & 0x7)); - } - - return m; -} - -static void *malloc_untagged(size_t size_in_bytes, unsigned long nonatomic) -{ - void **naya; - -#if SAFETY - check_variable_stack(); -#endif - -#if GC_EVERY_ALLOC -# if SKIP_FORCED_GC - if (!skipped_first) { - alloc_cycle++; - if (alloc_cycle >= SKIP_FORCED_GC) { - alloc_cycle = 0; - skipped_first = 1; - } - } -# endif - if (skipped_first) { - alloc_cycle++; - if (alloc_cycle >= GC_EVERY_ALLOC) { - alloc_cycle = 0; - gcollect(size_in_bytes); - } - } -#endif - - if (!size_in_bytes) - return zero_sized; - -#if KEEP_FROM_PTR - size_in_bytes += 4; -#endif - - size_in_bytes = ((size_in_bytes + 3) & 0xFFFFFFFC); -#if ALIGN_DOUBLES - if (!(size_in_bytes & 0x4)) { - /* Make sure memory is 8-aligned */ - if ((long)untagged_low & 0x4) { - if (untagged_low == tagged_high) { -#if KEEP_FROM_PTR - size_in_bytes -= 4; -#endif - gcollect(size_in_bytes); - return malloc_untagged(size_in_bytes, nonatomic); - } - untagged_low -= 1; - ((long *)untagged_low)[0] = 0; - } - } -#endif - -#if SEARCH - if (size_in_bytes == search_size) - stop(); -#endif - - naya = untagged_low - ((size_in_bytes >> 2) + 1); - if (naya < tagged_high) { - gcollect(size_in_bytes); -#if KEEP_FROM_PTR - size_in_bytes -= 4; -#endif - return malloc_untagged(size_in_bytes, nonatomic); - } - untagged_low = naya; - -#if KEEP_FROM_PTR - *naya = FROM_NEW; - naya++; - size_in_bytes -= 4; -#endif - - ((long *)naya)[0] = (size_in_bytes >> 2) | nonatomic; - -#if SEARCH - if ((naya + 1) == search_for) { - stop(); - } -#endif - - { - long diff = ((char *)(naya + 1) - (char *)GC_alloc_space) >> 2; - - alloc_bitmap[diff >> 3] |= (1 << (diff & 0x7)); - } - - return naya + 1; -} - -/* Array of pointers: */ -void *GC_malloc(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, 0x80000000); -} - -/* Tagged item: */ -void *GC_malloc_one_tagged(size_t size_in_bytes) -{ - return malloc_tagged(size_in_bytes); -} - -void *GC_malloc_one_xtagged(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, 0x10000000); -} - -void *GC_malloc_array_tagged(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, 0x40000000); -} - -/* Pointerless */ -void *GC_malloc_atomic(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, 0x00000000); -} - -/* Plain malloc: */ -void *GC_malloc_atomic_uncollectable(size_t size_in_bytes) -{ - return malloc(size_in_bytes); -} - -/* Array of pointers: */ -void *GC_malloc_allow_interior(size_t size_in_bytes) -{ - return malloc_untagged(size_in_bytes, 0xA0000000); -} - -void GC_free(void *s) /* noop */ -{ -} - -void GC_register_traversers(Type_Tag tag, Size_Proc size, Mark_Proc mark, Fixup_Proc fixup) -{ - size_table[tag] = size; - mark_table[tag] = mark; - fixup_table[tag] = fixup; -} - -void GC_gcollect() -{ - gcollect(0); -} - -/*************************************************************/ - -#if KEEP_FROM_PTR - -void GC_print_back_trace(void *p) -{ - while ((p > GC_alloc_space) && (p < GC_alloc_top)) { - if (p < (void *)tagged_high) { - printf("%lx = tagged: %d\n", (long)p, *(short *)p); - p = ((void **)p)[-1]; - } else if (p > (void *)untagged_low) { - printf("%lx = untagged: %lx\n", (long)p, *(long *)p); - p = ((void **)p)[-1]; - } else - break; - } - - if (p == FROM_STACK) - printf("stack\n"); - if (p == FROM_ROOT) - printf("root\n"); - if (p == FROM_FNL) - printf("fnl\n"); - if (p == FROM_IMM) - printf("immobile\n"); -} -#endif diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index 2517b314cb..53c1c4eab5 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -2046,13 +2046,6 @@ void GC_switch_out_master_gc() { } } -/* used to initialize a MasterGC Thread, bad idea - * scheme_master_fast_path is more performant */ -void GC_switch_in_master_gc() { - GC_set_GC(MASTERGC); - restore_globals_from_gc(MASTERGC); -} - /*used in scheme_master_fast_path*/ void *GC_switch_to_master_gc() { NewGC *gc = GC_get_GC(); diff --git a/src/mzscheme/gc2/osx_addr.inc b/src/mzscheme/gc2/osx_addr.inc deleted file mode 100644 index 7f36731047..0000000000 --- a/src/mzscheme/gc2/osx_addr.inc +++ /dev/null @@ -1,104 +0,0 @@ - -/* This code comes from the conservative collector, ../gc/os_dep.c */ - -/* Decodes the machine instruction which was responsible for the sending of the - SIGBUS signal. Sadly this is the only way to find the faulting address because - the signal handler doesn't get it directly from the kernel (although it is - available on the Mach level, but droppped by the BSD personality before it - calls our signal handler...) - This code should be able to deal correctly with all PPCs starting from the - 601 up to and including the G4s (including Velocity Engine). */ -#define EXTRACT_OP1(iw) (((iw) & 0xFC000000) >> 26) -#define EXTRACT_OP2(iw) (((iw) & 0x000007FE) >> 1) -#define EXTRACT_REGA(iw) (((iw) & 0x001F0000) >> 16) -#define EXTRACT_REGB(iw) (((iw) & 0x03E00000) >> 21) -#define EXTRACT_REGC(iw) (((iw) & 0x0000F800) >> 11) -#define EXTRACT_DISP(iw) ((short *) &(iw))[1] - -static char *get_fault_addr(unsigned int instr, unsigned int * regs) -{ - int disp = 0, tmp; - unsigned int baseA = 0, baseB = 0; - unsigned int addr, alignmask = 0xFFFFFFFF; - - switch(EXTRACT_OP1(instr)) { - case 38: /* stb */ - case 39: /* stbu */ - case 54: /* stfd */ - case 55: /* stfdu */ - case 52: /* stfs */ - case 53: /* stfsu */ - case 44: /* sth */ - case 45: /* sthu */ - case 47: /* stmw */ - case 36: /* stw */ - case 37: /* stwu */ - tmp = EXTRACT_REGA(instr); - if(tmp > 0) - baseA = regs[tmp]; - disp = EXTRACT_DISP(instr); - break; - case 31: - switch(EXTRACT_OP2(instr)) { - case 86: /* dcbf */ - case 54: /* dcbst */ - case 1014: /* dcbz */ - case 247: /* stbux */ - case 215: /* stbx */ - case 759: /* stfdux */ - case 727: /* stfdx */ - case 983: /* stfiwx */ - case 695: /* stfsux */ - case 663: /* stfsx */ - case 918: /* sthbrx */ - case 439: /* sthux */ - case 407: /* sthx */ - case 661: /* stswx */ - case 662: /* stwbrx */ - case 150: /* stwcx. */ - case 183: /* stwux */ - case 151: /* stwx */ - case 135: /* stvebx */ - case 167: /* stvehx */ - case 199: /* stvewx */ - case 231: /* stvx */ - case 487: /* stvxl */ - tmp = EXTRACT_REGA(instr); - if(tmp > 0) - baseA = regs[tmp]; - baseB = regs[EXTRACT_REGC(instr)]; - /* determine Altivec alignment mask */ - switch(EXTRACT_OP2(instr)) { - case 167: /* stvehx */ - alignmask = 0xFFFFFFFE; - break; - case 199: /* stvewx */ - alignmask = 0xFFFFFFFC; - break; - case 231: /* stvx */ - alignmask = 0xFFFFFFF0; - break; - case 487: /* stvxl */ - alignmask = 0xFFFFFFF0; - break; - } - break; - case 725: /* stswi */ - tmp = EXTRACT_REGA(instr); - if(tmp > 0) - baseA = regs[tmp]; - break; - default: /* ignore instruction */ - return NULL; - break; - } - break; - default: /* ignore instruction */ - return NULL; - break; - } - - addr = (baseA + baseB) + disp; - addr &= alignmask; - return (char *)addr; -} diff --git a/src/mzscheme/src/places.c b/src/mzscheme/src/places.c index 2e4677ba38..84380c04e3 100644 --- a/src/mzscheme/src/places.c +++ b/src/mzscheme/src/places.c @@ -463,26 +463,6 @@ Scheme_Object *scheme_places_deep_copy_in_master(Scheme_Object *so) { #ifdef MZ_PRECISE_GC static void* scheme_master_place_handlemsg(int msg_type, void *msg_payload); -#if 0 -static void *master_scheme_place(void *data) { - mz_proc_thread *myself; - myself = proc_thread_self; - GC_switch_in_master_gc(); - - while(1) { - int recv_type; - void *recv_payload; - pt_mbox *origin; - Scheme_Object *o; - - pt_mbox_recv(myself->mbox, &recv_type, &recv_payload, &origin); - o = scheme_master_place_handlemsg(recv_type, recv_payload); - pt_mbox_send(origin, 2, (void *) o, NULL); - } - return NULL; -} -#endif - static void* scheme_master_place_handlemsg(int msg_type, void *msg_payload) { switch(msg_type) {