Permalink
Switch branches/tags
version-14_01_1 version-14_01 version-13_05_2 version-13_05_1 version-13_05 version-12_08-branchpoint version-12_08-GIT version-11_07_2 version-11_07_1 version-11_07 version-11_07-branchpoint version-11_01 version-11_01-branchpoint version-10_04_2 version-10_04_1 version-10_04 version-10_04-branchpoint version-0_13_1 version-0_13-branchpoint version-0_12_2 version-0_12_1 version-0_12-branchpoint version-0_11_0 version-0_11-branchpoint version-0_10 version-0_9_1 version-0_9 version-0_9_x-snapshot version-0_9_x-snapshot-19991220 unstable-version-0_13_1-x86_64-unknown-linux-gnu-libc2_3 unstable-version-0_13_1-i686-pc-linux-libc2_3-gnu-O5-intermod unstable-version-0_13-branch-x86_64-unknown-linux-gnu-libc2_3 unstable-version-0_13-branch-i686-pc-linux-libc2_3-gnu-O5-intermod unstable-version-0_12_2-i686-pc-linux-libc2_2-gnu-O5-intermod unstable-version-0_12_2-i386-pc-solaris2_8 unstable-version-0_12_1-i686-pc-linux-libc2_3-gnu-O4-intermod unstable-version-0_12_1-i686-pc-linux-libc2_3-gnu-O2 unstable-version-0_12_1-i686-pc-linux-libc2_2-gnu-O5-intermod unstable-version-0_12_1-i386-pc-solaris2_8 unstable-version-0_12-branch-i686-pc-linux-libc2_3-gnu-O5 unstable-version-0_12-branch-i686-pc-linux-libc2_3-gnu-O4-intermod unstable-version-0_12-branch-i686-pc-linux-libc2_3-gnu-O4-hlc unstable-version-0_12-branch-i686-pc-linux-libc2_3-gnu-O2 unstable-version-0_12-branch-i686-pc-linux-libc2_2-gnu-O5 unstable-version-0_12-branch-i686-pc-linux-libc2_2-gnu-O5-intermod unstable-version-0_12-branch-i686-pc-linux-libc2_2-gnu-O3 unstable-version-0_12-branch-i386-pc-solaris2_8 unstable-version-0_11_0-sparc-sun-solaris2_7 unstable-version-0_11_0-i686-pc-linux-libc2_3-gnu-O5-intermod unstable-version-0_11_0-i686-pc-linux-libc2_2-gnu-O5 unstable-version-0_11_0-i686-pc-linux-libc2_2-gnu-O5-lcc unstable-version-0_11_0-i686-pc-linux-libc2_2-gnu-O5-hlc unstable-version-0_11_0-i686-pc-linux-libc2_1-gnu-O4 unstable-version-0_11_0-i686-pc-linux-libc2_1-gnu-O4-asm unstable-version-0_11_0-i686-pc-linux-libc2_1-gnu-O3 unstable-version-0_11_0-i386-pc-solaris2_8 unstable-version-0_11-branch-i686-pc-linux-libc2_3-gnu-O5-intermod unstable-version-0_11-branch-i686-pc-linux-libc2_2-gnu-O5-intermod unstable-version-0_11-branch-i686-pc-linux-libc2_2-gnu-O5-hlc unstable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5 unstable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5-lcc unstable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5-intermod unstable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5-hlc unstable-version-0_11-branch-alpha-dec-osf5_1 unstable-version-0_10_y-sparc-sun-solaris2_7 unstable-version-0_10_y-i686-pc-linux-libc2_1-gnu-O5 unstable-version-0_10_y-i686-pc-linux-libc2_1-gnu-O5-lcc unstable-version-0_10_y-i686-pc-linux-libc2_1-gnu-O5-intermod unstable-version-0_10_y-i686-pc-linux-libc2_1-gnu-O5-hlc unstable-version-0_10_y-i686-pc-linux-libc2_1-gnu-O4 unstable-version-0_10_y-i686-pc-linux-libc2_1-gnu-O4-hlc unstable-version-0_10_y-i686-pc-linux-libc2_1-gnu-O2 unstable-version-0_10_y-i586-pc-linux-libc2_1-gnu-O0 unstable-version-0_10_y-alpha-dec-osf5_1 unstable-version-0_10_y-alpha-dec-osf3_2 unstable-version-0_10_x-sparc-sun-solaris2_7 unstable-version-0_10_x-i686-pc-linux-libc2_1-gnu-O5 unstable-version-0_10_x-i686-pc-linux-libc2_1-gnu-O5-lcc unstable-version-0_10_x-i686-pc-linux-libc2_1-gnu-O4 unstable-version-0_10_x-i686-pc-linux-libc2_1-gnu-O4-hlc unstable-version-0_10_x-i686-pc-linux-libc2_1-gnu-O3 unstable-version-0_10_x-i686-pc-linux-libc2_1-gnu-O2 unstable-version-0_10_x-i586-pc-linux-libc2_1-gnu-O0 unstable-version-0_10_x-alpha-dec-osf3_2 termination2_trunk stable-version-0_11_0-i686-pc-linux-libc2_3-gnu-O5-intermod stable-version-0_11_0-i686-pc-linux-libc2_2-gnu-O5 stable-version-0_11_0-i686-pc-linux-libc2_2-gnu-O5-lcc stable-version-0_11_0-i686-pc-linux-libc2_2-gnu-O5-hlc stable-version-0_11_0-i686-pc-linux-libc2_1-gnu-O4 stable-version-0_11_0-i686-pc-linux-libc2_1-gnu-O4-asm stable-version-0_11_0-i686-pc-linux-libc2_1-gnu-O3 stable-version-0_11-branch-i686-pc-linux-libc2_3-gnu-O5-intermod stable-version-0_11-branch-i686-pc-linux-libc2_2-gnu-O5-lcc stable-version-0_11-branch-i686-pc-linux-libc2_2-gnu-O5-intermod stable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5 stable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5-lcc stable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5-intermod stable-version-0_11-branch-i686-pc-linux-libc2_1-gnu-O5-hlc stable-version-0_11-branch-alpha-dec-osf5_1
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
1258 lines (1057 sloc) 37.1 KB
// vim: ts=4 sw=4 expandtab ft=c
// Copyright (C) 2009 Ralph Becket <ralphbecket@gmail.com>
// Copyright (C) 2010 The University of Melbourne.
// Copyright (C) 2015-2016, 2018 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
// hgc.c - A history-based conservative garbage collector.
//
// TODO: support collection of mutables.
// TODO: explore incremental collection.
//
// This collector assumes that large and/or mutable heap cells are rare and
// that otherwise all heap cells contain pointers only to less recently
// allocated cells (i.e. a cell allocated at time t will never contain a
// pointer to a cell allocated at time t' > t). This assumption is valid
// for many declarative programming languages.
//
// Cells are allocated in 4 Kbyte "pages" (allocated on 4 KByte boundaries).
// Cells are powers of two in size and are allocated on the corresponding
// address boundaries. Each page contains cells of the same size "payload"
// (i.e. the user accessible portion of the cell). The first cell in each page
// is reserved for metadata, specifically the payload size and bit mask
// used to convert a pointer into the page to a pointer to the corresponding
// cell in the page.
//
// Each cell contains an extra "next" pointer, in addition to the cell
// payload. This pointer is used to link the cell on to either the
// appropriate free list (there is one free list for each payload size) or
// the allocation chain. The least significant bit of the "next" pointer
// is used to mark cells by the mark/sweep garbage collector.
//
// The allocation chain is a singly linked list of cells that have been
// allocated. The successors of each cell on the allocation list are those
// cells which were allocated before the cell in question.
//
// Garbage collection proceeds as follows:
// (1) mark all cells referred to from roots (registers, the stack, etc.);
// (2) considering each cell in order on the allocation chain,
// (2a) if the cell is marked then preserve it and mark any cells to which
// its payload refers;
// (2b) if the cell is not marked then sweep it on to the appropriate free
// list.
//
// In this way marking and sweeping occur in a single pass without the need
// for a mark stack.
//
// Special handling is required for cells that contain mutable data
// (i.e. cells which may contain pointers to more recently allocated cells)
// and for "big" cells (i.e. those for which the big-bag-o-pages approach
// doesn't scale).
//
// NOTES
//
// - "Ordinary" cells (up to a set size) are referred to as "small cells".
// Other cells are referred to as "big cells". Big cells are assumed to be
// rare and are allocated using a different structure (see hgc_big.c).
//
// - Empirically, bit-masking is nearly ten times faster than using division
// and modulo arithmetic, which makes a modest amount of memory wastage
// acceptable for performance. This is why cells are allocated on power-
// of-two address boundaries.
//
// - We could consider using a spare tag bit to identify cells that contain
// only non-pointer data (and thereby avoid marking through them).
// This could be useful for allocating strings and arrays of numbers.
#include "mercury_imp.h"
#ifdef MR_HGC
// Default values that can be overridden by setting the appropriate
// environment variable (e.g., set HGC_X or get default_HGC_X).
// Sizes are in megabytes, except for the growth variables which are
// per centages.
// Amount of memory (in megabytes) to reserve for the entire heap.
#define default_HGC_HEAP_SIZE 256
// Megabytes consumed before the first GC by the small heap.
#define default_HGC_INITIAL_SMALL_HEAP_SIZE 1
// More than this per centage of live data causes the small heap to grow.
#define default_HGC_GROWTH_THRESHOLD 20
// The per centage by which the small heap is grown.
#define default_HGC_GROWTH_FACTOR 50
// Megabytes consumed before the first GC by the big heap.
#define default_HGC_INITIAL_BIG_HEAP_SIZE 1
#include <stdio.h>
#include <setjmp.h>
#include <bits/setjmp.h>
#include "mercury_hgc.h"
#include "mercury_expanding_array.h"
#ifdef TRACE_HGC // Define this to enable tracing messages.
#define TRC
#else
#define TRC if (0)
#endif
typedef MR_Integer hgc_int;
typedef MR_Word hgc_word;
typedef hgc_word* hgc_ptr;
#define hgc_num_tag_bits (MR_LOW_TAG_BITS)
#define word_size_bytes (sizeof(hgc_word))
#define words(size_in_bytes) \
(((size_in_bytes) + word_size_bytes - 1) / word_size_bytes)
#define bytes(size_in_words) \
((size_in_words) * word_size_bytes)
// The least significant bit of the cell "next" field is used as a "mark bit"
// to indicate live data during mark/sweep garbage collection.
#define tag_mask (((hgc_int)(1 << hgc_num_tag_bits)) - 1)
#define addr_mask (~tag_mask)
#define tag(p) (((hgc_int)(p)) & tag_mask)
#define untag(p) (hgc_ptr)(((hgc_int)(p)) & addr_mask)
#define set_tag(p) (hgc_ptr)(((hgc_int)(p)) | 0x1)
#define clear_tag(p) (hgc_ptr)(((hgc_int)(p)) & ~0x1)
// A page is a 4 KByte collection of small_cells of the same payload size.
// The first cell on a page is reserved for page meta-data (the bit mask
// used to find the start address of cells in the page and the payload
// size of the cells in the page). Pages are allocated upwards from the
// bottom of the heap.
#define page_size_in_bytes (1 << 12)
#define page_size words(page_size_in_bytes)
#define page_mask (~(hgc_int)(page_size_in_bytes - 1))
#define page(p) (hgc_ptr)((hgc_int)(p) & page_mask)
#define page_small_cell_mask(pg) ((pg) + 0)
#define page_payload_size(pg) (hgc_int *)((pg) + 1)
#define page_small_cell(pg, p) \
(hgc_ptr)((hgc_int)(p) & *page_small_cell_mask(pg))
// Small cells.
// A small_cell consists of a "next" pointer (either in the allocation list
// or the corresponding free list), the payload data, and padding to round
// the cell size up to a power of two. ALWAYS remember to untag the value
// obtained from dereferencing small_cell_next.
#define small_cell_next(cl) (hgc_ptr *)((cl) + 0)
#define get_small_cell_next(cl) untag(*small_cell_next(cl))
#define set_small_cell_next(cl, p) *small_cell_next(cl) = (p)
#define small_cell_payload(cl) ((cl) + 1)
#define max_small_payload 32 // Sizes 0..max_small_payload.
// Big cells.
// The prev field is the backwards link for a big_cell on a free list.
// The is_free field is 0 iff the cell is not on a free list.
// A size_index field of k means the cell occupies 1<<k words.
// The big_cell with the lowest address is found at big_bot. ALWAYS remember
// to untag the value obtained form dereferencing big_cell_next.
#define big_cell_next(cl) (hgc_ptr *)((cl) + 0)
#define get_big_cell_next(cl) untag(*big_cell_next(cl))
#define set_big_cell_next(cl, p) *big_cell_next(cl) = (p)
#define big_cell_prev(cl) (hgc_ptr *)((cl) + 1)
#define get_big_cell_prev(cl) *big_cell_prev(cl)
#define set_big_cell_prev(cl, p) *big_cell_prev(cl) = (p)
#define big_cell_is_free(cl) (hgc_int *)((cl) + 1)
#define big_cell_size_index(cl) (hgc_int *)((cl) + 2)
#define big_cell_payload_size(cl) (hgc_int *)((cl) + 3)
#define big_cell_payload(cl) ((cl) + 4)
#define big_cell_min_size(payload_size) ((payload_size) + 4)
#define big_cell_buddy(cl) \
(big_bot + (((cl) - big_bot) ^ (1 << *big_cell_size_index(cl))))
#define min_big_cell_size_index 5
#define max_big_cell_size_index 64
static hgc_int hgc_initialised = 0; // 1 if hgc_init() has been called.
static hgc_ptr heap_bot = NULL; // Start of heap memory.
static hgc_ptr heap_top; // One past heap end.
static hgc_ptr small_bot = NULL; // The first initialised page.
static hgc_ptr small_top; // One past last initialised page.
static hgc_ptr small_high_water; // Used to control heap expansion.
static hgc_int growth_threshold = 20; // Grow small heap if more than
// this percent of memory is live.
static hgc_int growth_factor = 50; // Percent growth for small_high_water.
static hgc_ptr small_cell_free_list[max_small_payload + 1];
// Array of small_cell free lists.
static hgc_ptr big_bot = NULL; // The start of the big_cell heap.
static hgc_ptr big_top; // One past the end.
static hgc_int big_size_index; // big_top =
// big_bot + 1 << big_size_index
static hgc_ptr big_low_water; // Used to control heap expansion.
static hgc_ptr alloc_list = NULL; // List of allocated cells.
static hgc_ptr big_cell_free_list[max_big_cell_size_index + 1];
// Array of big_cell free lists.
static hgc_ptr *stack_bot = NULL; // Base of the C stack.
// The roots structure is used to hold fixed ranges of addresses that
// may contain pointers to cells.
struct roots_range {
hgc_ptr *roots_bot; // Start of range.
hgc_ptr *roots_top; // One past end of range.
};
// Define the roots_array expanding array type and its operations.
MR_DEFINE_EXPANDING_ARRAY(roots_array, struct roots_range, 256);
static roots_array *roots = NULL; // The roots ranges.
// Define the mutables_array expanding array type and its operations.
MR_DEFINE_EXPANDING_ARRAY(mutables_array, hgc_ptr, 256);
static mutables_array *mutables = NULL; // The mutables array.
// Define the uncollectables_array expanding array type and its operations.
MR_DEFINE_EXPANDING_ARRAY(uncollectables_array, hgc_ptr, 256);
static uncollectables_array *uncollectables = NULL;
////////////////////////////////////////////////////////////////////////////
// Small heap management.
////////////////////////////////////////////////////////////////////////////
// Set the mark bit on a small_cell (the mark bit lives in the
// small_cell_next field).
static void
mark_small_cell(hgc_ptr cl)
{
set_small_cell_next(cl, set_tag(get_small_cell_next(cl)));
}
// Return non-zero iff the mark bit is set on this small_cell.
static hgc_int
small_cell_is_marked(hgc_ptr cl)
{
return tag(*small_cell_next(cl));
}
// Find the small_cell referenced by a pointer.
// Returns 0 iff the pointer points outside the small heap.
static int
find_small_cell(hgc_ptr p, hgc_ptr *cl_ref, hgc_ptr *payload_ref,
hgc_int *payload_size_ref)
{
if (small_bot <= p && p < small_top) {
hgc_ptr pg = page(p);
*cl_ref = page_small_cell(pg, p);
*payload_size_ref = *page_payload_size(pg);
*payload_ref = small_cell_payload(*cl_ref);
return 1;
} else {
return 0;
}
}
// Initialise a new page and add its small_cells to the given
// small_cell_free_list.
static void
init_new_page(hgc_int payload_size)
{
hgc_ptr pg;
hgc_int pg_cell_size;
hgc_ptr cl;
TRC if (!hgc_initialised) {
fprintf(stderr, "hgc: hgc_init() has not been called.\n");
exit(1);
}
pg = small_top;
small_top += page_size;
if (small_top > big_low_water) {
fprintf(stderr, "hgc: init_new_page: out of memory.\n");
exit(1);
}
// Each small_cell has to be at least one word larger than its payload to
// include the small_cell_next 'history' pointer. Cell sizes are always
// a power of 2.
for (pg_cell_size = 2; pg_cell_size <= payload_size; pg_cell_size <<= 1) {}
*page_payload_size(pg) = payload_size;
// Cells are allocated at addresses that are multiples of the small_cell
// size.
*page_small_cell_mask(pg) = ~((pg_cell_size * sizeof(hgc_word)) - 1);
// Add the small_cells in this page to the appropriate free list
// (recall that the first cell in a page is reserved for page metadata).
for (cl = pg + pg_cell_size; cl < small_top; cl += pg_cell_size) {
set_small_cell_next(cl, small_cell_free_list[payload_size]);
small_cell_free_list[payload_size] = cl;
}
}
// Allocate a new small_cell from a free list (the pointer returned is to
// the small_cell, not its payload).
static hgc_ptr
alloc_small_cell(hgc_int payload_size)
{
hgc_ptr cl = small_cell_free_list[payload_size];
if (cl != NULL) {
small_cell_free_list[payload_size] = get_small_cell_next(cl);
set_small_cell_next(cl, alloc_list);
alloc_list = cl;
return cl;
}
// There are no free cells of this size. Allocate a new page if possible.
if (small_top + page_size <= small_high_water) {
init_new_page(payload_size);
return alloc_small_cell(payload_size);
}
// We can't allocate a new page, try garbage collecting.
MR_hgc_gc();
if (small_cell_free_list[payload_size] != NULL) {
return alloc_small_cell(payload_size);
}
// Try growing small_high_water.
small_high_water =
small_bot + ((100 + growth_factor) * (small_top - small_bot)) / 100;
if (small_high_water <= big_low_water) {
return alloc_small_cell(payload_size);
}
// Nope, we are out of memory.
fprintf(stderr, "hgc: alloc_small_cell: out of memory.\n");
exit(1);
}
////////////////////////////////////////////////////////////////////////////
// Big heap management.
////////////////////////////////////////////////////////////////////////////
// "Big" cells don't work well in the BIBOP approach used for "small" cells
// and indeed some big cells won't even fit inside a small_cell page. Instead
// we use a buddy style memory allocator.
//
// Each big_cell is a power of two words in size. A big_cell can be split into
// two smaller, equally sized, "buddy" big_cells. If both buddies become free,
// they are merged into a single cell of the next size up. A free list exists
// for each size of big_cell. Allocations are made to the smallest sized
// big_cell that can accommodate the payload; this may mean first splitting up
// a larger big_cell if one of the right size is unavailable.
//
// To support O(1) removal of a buddy from its free list during free cell
// merging, each free list is doubly linked. We re-use the "prev" field
// to indicate whether a big_cell is allocated or not (it is NULL if it
// is allocated, non-NULL otherwise).
// Set the mark bit on a big_cell (the mark bit lives in the
// big_cell_next field).
static void
mark_big_cell(hgc_ptr cl)
{
set_big_cell_next(cl, set_tag(get_big_cell_next(cl)));
}
// Return non-zero iff the mark bit is set on this big_cell.
static hgc_int
big_cell_is_marked(hgc_ptr cl)
{
return tag(*big_cell_next(cl));
}
// Print out a representation of the big cell heap for debugging.
static void
print_big_cells(void)
{
hgc_ptr cl;
hgc_int ix;
for (cl = big_bot; cl < big_top; cl += 1 << ix) {
int i;
ix = *big_cell_size_index(cl);
for (i = big_size_index - ix; i > 0; i--) {
printf(" ");
}
printf("[ %l ] %p ", ix, cl);
if (*big_cell_is_free(cl)) {
printf("free\n");
} else {
printf("allocated %l\n", *big_cell_payload_size(cl));
}
}
}
static void
print_big_cell_free_list(void)
{
hgc_int i;
hgc_ptr cl;
for (i = 0; i <= max_big_cell_size_index; i++) {
if (big_cell_free_list[i] != NULL) {
printf("free %2d", i);
for (
cl = big_cell_free_list[i];
cl != NULL;
cl = get_big_cell_next(cl)
) {
printf(" %p", cl);
// Do some sanity checking.
if (! *big_cell_is_free(cl)) {
printf(" is not marked as free!\n");
exit(1);
}
if (*big_cell_size_index(cl) != i) {
printf(" has the wrong size index!\n");
exit(1);
}
}
printf("\n");
}
}
}
static void
print_big_heap(void)
{
printf("big_top = %p\n", big_top);
printf("big_bot = %p\n", big_bot);
printf("big heap is %l words\n", big_top - big_bot);
printf("big_size_index = %l\n", big_size_index);
print_big_cells();
print_big_cell_free_list();
}
// Check the integrity of the big heap.
static void
check_big_heap(void)
{
hgc_ptr cl;
hgc_ptr prev_cl;
hgc_int ix;
// Mark every free cell with a 0xDEADBEEF marker in its first
// payload slot.
for (cl = big_bot; cl < big_top; cl += 1 << *big_cell_size_index(cl)) {
if (*big_cell_is_free(cl)) {
*big_cell_payload(cl) = 0xDEADBEEF;
}
}
// Check the sizes and links on the free lists.
for (ix = 0; ix <= max_big_cell_size_index; ix++) {
prev_cl = (hgc_ptr)(1);
for (
cl = big_cell_free_list[ix];
cl != NULL;
cl = get_big_cell_next(cl)
) {
if (*big_cell_size_index(cl) != ix) {
printf("hgc: check_big_heap: %p has size index %l, "
"but should have %l\n", cl,
*big_cell_size_index(cl), ix);
print_big_heap();
exit(1);
}
if (get_big_cell_prev(cl) != prev_cl) {
printf("hgc: check_big_heap: %p has prev pointer %p, "
"but should have %p\n", cl,
get_big_cell_prev(cl), prev_cl);
print_big_heap();
exit(1);
}
if (*big_cell_payload(cl) != 0xDEADBEEF) {
printf("hgc: check_big_heap: %p is free, but does not "
"contain 0xDEADBEEF\n", cl);
print_big_heap();
exit(1);
}
prev_cl = cl;
}
}
}
// Find the big_cell referenced by a pointer.
// Returns 0 iff the pointer points outside the big heap or the cell
// referenced is unallocated.
static int
find_big_cell(hgc_ptr p, hgc_ptr *cl_ref, hgc_ptr *payload_ref,
hgc_int *payload_size_ref)
{
hgc_ptr cl = big_bot;
hgc_int ix = big_size_index;
hgc_int size = 1 << big_size_index;
if (p < big_bot || big_top <= p) {
return 0;
}
while (1) {
if (*big_cell_size_index(cl) == ix) {
// We have found the cell.
if (*big_cell_is_free(cl)) {
return 0;
}
*cl_ref = cl;
*payload_ref = big_cell_payload(cl);
*payload_size_ref = *big_cell_payload_size(cl);
return 1;
}
// It has to be a subdivision of this cell.
ix--;
size /= 2;
if (cl + size <= p) {
// It is in the upper half.
cl += size;
}
}
}
// Add a big_cell to the appropriate free list (but don't attempt to merge
// with its buddy).
static void
add_big_cell_to_free_list(hgc_ptr cl)
{
hgc_int ix = *big_cell_size_index(cl);
hgc_ptr next_cl = big_cell_free_list[ix];
big_cell_free_list[ix] = cl;
// We have to mark this cell as free.
*big_cell_is_free(cl) = 1;
set_big_cell_next(cl, next_cl);
if (next_cl != NULL) {
set_big_cell_prev(next_cl, cl);
}
}
// Unlink a big_cell from its free list.
static void
unlink_big_cell_from_free_list(hgc_ptr cl)
{
hgc_ptr next_cl = get_big_cell_next(cl);
hgc_ptr prev_cl = get_big_cell_prev(cl);
hgc_int ix = *big_cell_size_index(cl);
if (big_cell_free_list[ix] == cl) {
big_cell_free_list[ix] = next_cl;
} else {
set_big_cell_next(prev_cl, next_cl);
}
if (next_cl != NULL) {
set_big_cell_prev(next_cl, prev_cl);
}
}
// Split an unlinked big_cell in two and add the upper half to the
// appropriate free list.
static void
split_big_cell(hgc_ptr cl)
{
hgc_int new_ix = *big_cell_size_index(cl) - 1;
hgc_int new_size = 1 << new_ix;
hgc_ptr buddy = cl + new_size;
*big_cell_size_index(cl) = new_ix;
*big_cell_size_index(buddy) = new_ix;
add_big_cell_to_free_list(buddy);
}
// Free an unlinked big_cell, making sure we recursively merge it with its
// buddy as long as its buddy is free.
static void
free_big_cell(hgc_ptr cl)
{
hgc_int ix = *big_cell_size_index(cl);
hgc_ptr buddy = big_cell_buddy(cl);
while (
ix < big_size_index &&
*big_cell_size_index(buddy) == ix &&
*big_cell_is_free(buddy)
) {
unlink_big_cell_from_free_list(buddy);
if (buddy < cl) {
cl = buddy;
}
ix++;
*big_cell_size_index(cl) = ix;
buddy = big_cell_buddy(cl);
}
add_big_cell_to_free_list(cl);
}
// Allocate a free big_cell of the right size.
static hgc_ptr
alloc_big_cell(hgc_int payload_size)
{
hgc_int min_cell_size = big_cell_min_size(payload_size);
hgc_int ix;
hgc_int size;
// Find the smallest sufficiently large free big_cell.
for (
ix = min_big_cell_size_index, size = 1 << ix;
ix <= big_size_index;
ix++, size = 1 << ix
) {
if (size >= min_cell_size && big_cell_free_list[ix] != NULL) {
// Found one. Now we may need to split it down to size.
hgc_ptr cl = big_cell_free_list[ix];
unlink_big_cell_from_free_list(cl);
while (size / 2 >= min_cell_size) {
split_big_cell(cl);
size /= 2;
}
// Add it to the alloc_list and return the big_cell.
*big_cell_payload_size(cl) = payload_size;
*big_cell_is_free(cl) = 0;
set_big_cell_next(cl, alloc_list);
alloc_list = cl;
return cl;
}
}
// We couldn't find a big enough cell. We can either grow the big heap
// or try garbage collecting.
size = big_top - big_bot;
if (big_bot - size >= big_low_water) {
// We can grow the big heap.
big_bot -= size;
*big_cell_size_index(big_bot) = big_size_index;
big_size_index++;
free_big_cell(big_bot);
return alloc_big_cell(payload_size);
}
// We can't grow the big heap right now; try garbage collecting and
// seeing what happens.
MR_hgc_gc();
for (ix = big_size_index; 0 <= ix && min_cell_size <= 1 << ix; ix --) {
if (big_cell_free_list[ix] != NULL) {
return alloc_big_cell(payload_size);
}
}
// Try growing big_low_water.
size = big_top - big_bot;
if (big_low_water - size >= small_high_water) {
big_low_water -= size;
return alloc_big_cell(payload_size);
}
// Nope, we are out of memory.
fprintf(stderr, "hgc: alloc_big_cell: out of memory.\n");
exit(1);
}
////////////////////////////////////////////////////////////////////////////
// Top-level garbage collection code.
////////////////////////////////////////////////////////////////////////////
// Find a cell (small or big). Returns 0 iff the pointer does not point to
// a valid cell.
static int
find_cell(hgc_ptr p, hgc_ptr *cl_ref, hgc_ptr *payload_ref,
hgc_int *payload_size_ref)
{
return
find_small_cell(p, cl_ref, payload_ref, payload_size_ref) ||
find_big_cell(p, cl_ref, payload_ref, payload_size_ref);
}
// If p points to a cell in the heap, then mark that cell.
static void
mark_ptr_target(hgc_ptr p)
{
hgc_ptr cl;
hgc_ptr payload;
hgc_int payload_size;
p = untag(p);
if (
find_small_cell(p, &cl, &payload, &payload_size) &&
payload <= p && p < payload + payload_size
) {
mark_small_cell(cl);
return;
}
if (
find_big_cell(p, &cl, &payload, &payload_size) &&
payload <= p && p < payload + payload_size
) {
mark_big_cell(cl);
return;
}
}
// Perform a single-pass mark and sweep of the alloc_list.
// If we fail to collect enough memory, allow extra pages by
// extending small_high_water.
static void
mark_and_sweep_alloc_list(void)
{
hgc_ptr pg;
hgc_ptr cl;
hgc_ptr next_cl;
hgc_ptr payload;
hgc_ptr p;
hgc_ptr *alloc_list_tail;
hgc_int payload_size;
hgc_int small_live_mem = 0;
hgc_int small_dead_mem = 0;
hgc_int big_live_mem = 0;
hgc_int big_dead_mem = 0;
TRC printf("hgc: mark_and_sweep_alloc_list()\n");
TRC {
int n;
for (
n = 0, cl = alloc_list;
cl != NULL;
n++, cl = (cl < small_top) ? get_small_cell_next(cl)
: get_big_cell_next(cl)
) {}
printf("hgc: mark_and_sweep_alloc_list: %l cells on alloc_list\n", n);
}
cl = alloc_list;
alloc_list = NULL;
alloc_list_tail = &alloc_list;
while (cl != NULL) {
if (cl < small_top) {
// This is a small_cell.
next_cl = get_small_cell_next(cl);
pg = page(cl);
payload_size = *page_payload_size(pg);
if (small_cell_is_marked(cl)) {
payload = small_cell_payload(cl);
for (p = payload; p < payload + payload_size; p++) {
mark_ptr_target((hgc_ptr)(*p));
}
*alloc_list_tail = cl;
alloc_list_tail = small_cell_next(cl);
small_live_mem += payload_size;
} else {
set_small_cell_next(cl, small_cell_free_list[payload_size]);
small_cell_free_list[payload_size] = cl;
small_dead_mem += payload_size;
}
} else {
// This is a big_cell.
next_cl = get_big_cell_next(cl);
payload = big_cell_payload(cl);
payload_size = *big_cell_payload_size(cl);
if (big_cell_is_marked(cl)) {
for (p = payload; p < payload + payload_size; p++) {
mark_ptr_target((hgc_ptr)(*p));
}
*alloc_list_tail = cl;
alloc_list_tail = big_cell_next(cl);
big_live_mem += payload_size;
} else {
free_big_cell(cl);
big_dead_mem += payload_size;
}
}
cl = next_cl;
}
// Important! We have to terminate the alloc_list properly.
*alloc_list_tail = NULL;
TRC {
check_big_heap();
print_big_heap();
printf("hgc: mark_and_sweep_alloc_list: "
"%l live words in small_cells\n",
small_live_mem);
printf("hgc: mark_and_sweep_alloc_list: "
"%l dead words in small_cells\n",
small_dead_mem);
printf("hgc: mark_and_sweep_alloc_list: "
"%l live words in big_cells\n",
big_live_mem);
printf("hgc: mark_and_sweep_alloc_list: "
"%l dead words in big_cells\n",
big_dead_mem);
printf("hgc: mark_and_sweep_alloc_list: small_bot = %p\n",
small_bot);
printf("hgc: mark_and_sweep_alloc_list: small_top = %p\n",
small_top);
printf("hgc: mark_and_sweep_alloc_list: small_h/w = %p\n",
small_high_water);
printf("hgc: mark_and_sweep_alloc_list: big_top = %p\n",
big_top);
printf("hgc: mark_and_sweep_alloc_list: big_bot = %p\n",
big_bot);
printf("hgc: mark_and_sweep_alloc_list: big_l/w = %p\n",
big_low_water);
printf("\n");
}
}
// Look up an environment variable. Return a default value if the envvar
// is absent or negative.
static hgc_int
lookup_env_var(const char *name, hgc_int default_value)
{
char *envvar = getenv(name);
if (envvar == NULL) {
return default_value;
} else {
hgc_int val = atoi(envvar);
if (val < 0) {
return default_value;
} else {
return val;
}
}
}
// Initialise the heap.
void
MR_hgc_init(void)
{
hgc_int heap_size; // In words.
hgc_int initial_small_heap_size; // In words.
hgc_int initial_big_heap_size; // In words.
hgc_int initial_heap_size; // In words.
hgc_ptr heap_midpoint;
int i;
char *envvar;
// Just return if we have already been initialised.
if (hgc_initialised) {
return;
}
// Set stack_bot if it hasn't already been fixed.
if (stack_bot == NULL) {
stack_bot = (hgc_ptr *)(&heap_size);
}
// Check the environment variables.
heap_size =
words(lookup_env_var("HGC_HEAP_SIZE",
default_HGC_HEAP_SIZE) << 20);
growth_threshold =
lookup_env_var("HGC_GROWTH_THRESHOLD",
default_HGC_GROWTH_THRESHOLD);
growth_factor =
lookup_env_var("HGC_GROWTH_FACTOR",
default_HGC_GROWTH_FACTOR);
initial_small_heap_size =
words(lookup_env_var("HGC_INITIAL_SMALL_HEAP_SIZE",
default_HGC_INITIAL_SMALL_HEAP_SIZE) << 20);
initial_big_heap_size =
words(lookup_env_var("HGC_INITIAL_BIG_HEAP_SIZE",
default_HGC_INITIAL_BIG_HEAP_SIZE) << 20);
initial_heap_size = initial_small_heap_size + initial_big_heap_size;
// Ask for as much memory as malloc will give us, give or take a factor
// of two.
for (
heap_bot = NULL;
heap_bot == NULL && heap_size >= initial_heap_size;
heap_size /= 2
) {
heap_bot = (hgc_ptr)malloc(heap_size * sizeof(hgc_word));
}
if (heap_bot == NULL) {
fprintf(stderr, "hgc: failed to malloc heap.\n");
exit(1);
}
TRC printf("hgc: hgc_init: allocated %l MByte heap.\n",
(heap_size * sizeof(hgc_word)) >> 20);
// Set up the small heap (this grows upwards).
heap_top = heap_bot + heap_size;
heap_midpoint = heap_bot + (heap_size / 2);
small_bot = page(heap_bot + page_size - 1);
small_top = small_bot;
small_high_water = small_bot + initial_small_heap_size;
for (i = 0; i <= max_small_payload; i++) {
small_cell_free_list[i] = NULL;
}
// Set up the big heap (this grows downwards). We have to create the
// initial empty cell and add it to the right free list.
for (i = 0; i <= max_big_cell_size_index; i++) {
big_cell_free_list[i] = NULL;
}
big_size_index = min_big_cell_size_index;
if (big_low_water < small_high_water) {
big_low_water = small_high_water;
}
big_top = heap_top;
big_bot = heap_top - (1 << min_big_cell_size_index);
*big_cell_size_index(big_bot) = min_big_cell_size_index;
add_big_cell_to_free_list(big_bot);
big_low_water = big_top - initial_big_heap_size;
// Set up the roots and mutables arrays.
roots = init_roots_array();
mutables = init_mutables_array();
uncollectables = init_uncollectables_array();
// Report that all is well.
hgc_initialised = 1;
}
// Add a roots range.
void
MR_hgc_add_roots_range(void *bot, void *top)
{
struct roots_range rr = {bot, top};
TRC if (!hgc_initialised) {
fprintf(stderr, "hgc: hgc_init() has not been called.\n");
exit(1);
}
roots = roots_array_append_item(roots, rr);
}
void
MR_hgc_add_root(void *rt)
{
MR_hgc_add_roots_range(rt, rt + 1);
}
// Mark any cells referred to on the C stack.
static void
mark_from_C_stack(void)
{
hgc_ptr *stack_top = (hgc_ptr *)(&stack_top);
hgc_ptr *bot = (stack_bot < stack_top) ? stack_bot : stack_top;
hgc_ptr *top = (stack_bot < stack_top) ? stack_top : stack_bot;
hgc_ptr *p;
TRC printf("hgc: mark_from_C_stack()\n");
for (p = bot; p <= top; p++) {
mark_ptr_target(*p);
}
}
// Mark any cells referred to in registers. This is currently very Linux
// centric.
static void
mark_from_registers(void)
{
jmp_buf jbuf;
hgc_ptr *bot;
hgc_ptr *top;
hgc_ptr *p;
TRC printf("hgc: mark_from_registers()\n");
(void)setjmp(jbuf); // Copy the register file.
bot = (hgc_ptr *)(jbuf[0].__jmpbuf);
top = (hgc_ptr *)(&(jbuf[0].__mask_was_saved));
TRC printf("hgc: mark_from_registers: %l registers\n", top - bot);
for (p = bot; p <= top; p++) {
mark_ptr_target(*p);
}
}
// Mark any cells referred to in the roots array ranges.
static void
mark_from_roots(void)
{
int i;
TRC printf("hgc: mark_from_roots()\n");
for (i = roots_array_num_occupants(roots) - 1; i >= 0; i--) {
struct roots_range rr = roots_array_get_item(roots, i);
hgc_ptr *p;
for (p = rr.roots_bot; p < rr.roots_top; p++) {
mark_ptr_target(*p);
}
}
}
// Mark a cell and any cells referenced in its payload.
static void
mark_cell_and_referents(hgc_ptr p)
{
hgc_ptr cl;
hgc_ptr payload;
hgc_int payload_size;
if (find_small_cell(p, &cl, &payload, &payload_size)) {
mark_small_cell(cl);
for (p = payload; p < payload + payload_size; p++) {
mark_ptr_target((hgc_ptr)*p);
}
return;
}
if (find_big_cell(p, &cl, &payload, &payload_size)) {
mark_big_cell(cl);
for (p = payload; p < payload + payload_size; p++) {
mark_ptr_target((hgc_ptr)*p);
}
return;
}
}
// Mark any uncollectable cells and their referents.
static void
mark_from_uncollectables(void)
{
int i;
int n = uncollectables_array_num_occupants(uncollectables);
TRC printf("hgc: mark_from_uncollectables()\n");
for (i = 0; i < n; i++) {
mark_cell_and_referents(
uncollectables_array_get_item(uncollectables, i)
);
}
}
// Mark any cells referred to in the mutables array and any cells
// referred to by those mutables.
static void
mark_from_mutables(void)
{
int i;
int n = mutables_array_num_occupants(mutables);
TRC printf("hgc: mark_from_mutables()\n");
for (i = 0; i < n; i++) {
mark_cell_and_referents(
mutables_array_get_item(mutables, i)
);
}
}
// Perform a garbage collection.
void
MR_hgc_gc(void)
{
TRC if (!hgc_initialised) {
fprintf(stderr, "hgc: hgc_init() has not been called.\n");
exit(1);
}
TRC printf("hgc: hgc_gc()\n");
mark_from_roots();
mark_from_C_stack();
mark_from_registers();
mark_from_uncollectables();
mark_from_mutables();
mark_and_sweep_alloc_list();
}
// Malloc replacement.
void *
MR_hgc_malloc_immutable(size_t size_bytes)
{
hgc_int size = words(size_bytes);
TRC if (!hgc_initialised) {
fprintf(stderr, "hgc: hgc_init() has not been called.\n");
exit(1);
}
if (size <= max_small_payload) {
return small_cell_payload(alloc_small_cell(size));
} else {
return big_cell_payload(alloc_big_cell(size));
}
}
// Add a cell to the mutables array.
void
MR_hgc_make_mutable(void *p)
{
mutables = mutables_array_append_item(mutables, (hgc_ptr) p);
}
// Allocate a mutable cell.
void *
MR_hgc_malloc_mutable(size_t size_bytes)
{
void *p = MR_hgc_malloc_immutable(size_bytes);
MR_hgc_make_mutable(p);
return p;
}
// Make a cell uncollectable (i.e. always live).
void
MR_hgc_make_uncollectable(void *p)
{
uncollectables = uncollectables_array_append_item(uncollectables, p);
}
// Allocate an uncollectable, mutable cell.
void *
MR_hgc_malloc_uncollectable(size_t size_bytes)
{
void *p = MR_hgc_malloc_mutable(size_bytes);
MR_hgc_make_uncollectable(p);
return p;
}
// Allow the application to change stack_bot.
void
MR_hgc_set_stack_bot(void *p)
{
stack_bot = (hgc_ptr *)untag((hgc_ptr) p);
}
// If necessary, allocate a new cell of the given size and copy as much of the
// data from the old cell as will fit. The new cell is mutable if the old cell
// is. The new cell is uncollectable if the old cell is.
void *
MR_hgc_realloc(void *p, size_t size_bytes)
{
hgc_int new_payload_size = words(size_bytes);
hgc_ptr old_cl;
hgc_ptr old_payload;
hgc_int old_payload_size;
if (find_cell(p, &old_cl, &old_payload, &old_payload_size)) {
if (old_payload_size < new_payload_size) {
hgc_ptr new_payload =
MR_hgc_malloc_immutable(new_payload_size);
hgc_int i;
for (i = 0; i < old_payload_size; i++) {
new_payload[i] = old_payload[i];
}
for (i = 0; i < mutables_array_num_occupants(mutables); i++) {
if (mutables_array_get_item(mutables, i) == old_payload) {
mutables_array_set_item(mutables, i, new_payload);
break;
}
}
for (
i = 0;
i < uncollectables_array_num_occupants(uncollectables);
i++
) {
if (uncollectables_array_get_item(uncollectables, i)
== old_payload)
{
uncollectables_array_set_item(uncollectables, i,
new_payload);
break;
}
}
return new_payload;
} else {
return old_payload;
}
} else {
fprintf(stderr, "hgc: hgc_realloc(): not an allocated cell.\n");
exit(1);
}
}
// "Free" a cell by either NULLing its payload (small cells) or reducing
// its payload size to zero (big cells).
void
MR_hgc_free(void *p)
{
hgc_ptr cl;
hgc_ptr payload;
hgc_int payload_size;
p = untag(p);
if (find_small_cell(p, &cl, &payload, &payload_size)) {
hgc_ptr payload_ptr;
for (payload_ptr = payload;
payload_ptr < payload + payload_size;
payload_ptr++)
{
*payload_ptr = 0;
}
return;
}
if (find_big_cell(p, &cl, &payload, &payload_size)) {
*big_cell_payload_size(cl) = 0;
return;
}
fprintf(stderr, "hgc: hgc_free(): not an allocated cell.\n");
exit(1);
}
#endif // MR_HGC