diff options
author | Han-Wen Nienhuys <hanwen@lilypond.org> | 2002-08-04 00:18:33 +0000 |
---|---|---|
committer | Han-Wen Nienhuys <hanwen@lilypond.org> | 2002-08-04 00:18:33 +0000 |
commit | c7743d027a335eae585335b959e483c5a6c38d36 (patch) | |
tree | 02409da918b6e5dd1635a7db6c41e5b93b1051ef /libguile/gc-segment.c | |
parent | c8a1bdc460f892847d0fb3f1321cdeb305160bf8 (diff) | |
download | guile-c7743d027a335eae585335b959e483c5a6c38d36.tar.gz |
more code
Diffstat (limited to 'libguile/gc-segment.c')
-rw-r--r-- | libguile/gc-segment.c | 562 |
1 files changed, 562 insertions, 0 deletions
diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c new file mode 100644 index 000000000..a3859df7b --- /dev/null +++ b/libguile/gc-segment.c @@ -0,0 +1,562 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + +#include <assert.h> +#include <stdio.h> +#include <string.h> + +#include "libguile/_scm.h" +#include "libguile/pairs.h" +#include "libguile/gc.h" +#include "libguile/private-gc.h" + + + +#define SCM_GC_CARD_BVEC_SIZE_IN_LONGS \ + ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LONG_BITS - 1) / SCM_C_BVEC_LONG_BITS) +#define SCM_GC_IN_CARD_HEADERP(x) \ + (scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS + + +size_t scm_max_segment_size; + +scm_t_heap_segment * +scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl) +{ + scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment)); + + if (!shs) + { + fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n"); + abort (); + } + + shs->bounds[0] = NULL; + shs->bounds[1] = NULL; + shs->malloced = NULL; + shs->span = fl->span; + shs->freelist = fl; + shs->next_free_card = NULL; + + return shs; +} + + +/* + Fill SEGMENT with memory both for data and mark bits. + + RETURN: 1 on success, 0 failure + */ +int +scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested) +{ + /* + round upwards + */ + int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); + int card_count =1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; + + /* + one card extra due to alignment + */ + size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD + + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG + ; + scm_t_c_bvec_long * bvec_ptr = 0; + scm_t_cell * memory = 0; + + /* + We use malloc to alloc the heap. On GNU libc this is + equivalent to mmapping /dev/zero + */ + SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed)); + + if (memory == NULL) + return 0; + + segment->malloced = memory; + segment->bounds[0] = SCM_GC_CARD_UP (memory); + segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS; + + segment->freelist->heap_size += scm_i_segment_cell_count (segment); + + bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1]; + + + { + scm_t_cell * ptr = segment->bounds [0]; + + for (; + ptr < segment->bounds[1]; ptr += SCM_GC_CARD_N_CELLS) + { + SCM_GC_CELL_BVEC (ptr) = bvec_ptr; + if (segment->span == 2) + SCM_GC_SET_CARD_DOUBLECELL (ptr); + + bvec_ptr += SCM_GC_CARD_BVEC_SIZE_IN_LONGS; + + /* + Don't init the mem. This is handled by lazy sweeping. + */ + } + } + + segment->next_free_card = segment->bounds[0]; + segment->first_time = 1; + return 1; +} + +int +scm_i_segment_card_count (scm_t_heap_segment * seg) +{ + return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; +} + +/* + Return the number of available single-cell data cells. + */ +int +scm_i_segment_cell_count (scm_t_heap_segment * seg) +{ + return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) + + ((seg->span == 2) ? -1 : 0); +} + +void +scm_i_clear_segment_mark_space (scm_t_heap_segment *seg) +{ + scm_t_cell * markspace = seg->bounds[1]; + + memset (markspace, 0x00, + scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG); +} + +/* + RETURN: + + Freelist. +*/ +SCM +scm_i_sweep_some_cards (scm_t_heap_segment *seg) +{ + SCM cells = SCM_EOL; + int threshold = 512; + int collected = 0; + int (*sweeper) (scm_t_cell *, SCM *, int ) + = (seg->first_time) ? &scm_init_card_freelist : &scm_i_sweep_card; + + scm_t_cell * next_free = seg->next_free_card; + int cards_swept = 0; + + while (collected < threshold && next_free < seg->bounds[1]) + { + collected += (*sweeper) (next_free, &cells, seg->span); + next_free += SCM_GC_CARD_N_CELLS; + cards_swept ++; + } + + scm_gc_cells_swept += cards_swept * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); + scm_gc_cells_collected += collected * seg->span; + seg->freelist->collected += collected * seg->span; + + if(next_free == seg->bounds[1]) + { + seg->first_time = 0; + } + + seg->next_free_card = next_free; + return cells; +} + + +/* + Force a sweep of this entire segment. This doesn't modify sweep + statistics, it just frees the memory pointed to by to-be-swept + cells. + + Implementation is slightly ugh, and how do we handle the swept_cells + statistic? + */ +void +scm_i_sweep_segment (scm_t_heap_segment * seg) +{ + scm_t_cell * p = seg->next_free_card; + int yield = scm_gc_cells_collected; + int coll = seg->freelist->collected; + + while (scm_i_sweep_some_cards (seg) != SCM_EOL) + ; + + scm_gc_cells_collected = yield; + seg->freelist->collected = coll; + + seg->next_free_card =p; +} + +void +scm_i_sweep_all_segments (char const *reason) +{ + int i= 0; + + for (i = 0; i < scm_i_heap_segment_table_size; i++) + { + scm_i_sweep_segment (scm_i_heap_segment_table[i]); + } +} + + +/* + Heap segment table. + + The table is sorted by the address of the data itself. This makes + for easy lookups. This is not portable: according to ANSI C, + pointers can only be compared within the same object (i.e. the same + block of malloced memory.). For machines with weird architectures, + this should be revised. + + (Apparently, for this reason 1.6 and earlier had macros for pointer + comparison. ) + + perhaps it is worthwhile to remove the 2nd level of indirection in + the table, but this certainly makes for cleaner code. +*/ +scm_t_heap_segment ** scm_i_heap_segment_table; +size_t scm_i_heap_segment_table_size; +scm_t_cell *lowest_cell; +scm_t_cell *highest_cell; + + +void +scm_i_clear_mark_space (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]); + } +} + + +/* + RETURN: index of inserted segment. + */ +int +scm_i_insert_segment (scm_t_heap_segment * seg) +{ + size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *); + SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **) + realloc ((char *)scm_i_heap_segment_table, size))); + + /* + We can't alloc 4 more bytes. This is hopeless. + */ + if (!scm_i_heap_segment_table) + { + fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n"); + abort (); + } + + if (!lowest_cell) + { + lowest_cell = seg->bounds[0]; + highest_cell = seg->bounds[1]; + } + else + { + lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]); + highest_cell = SCM_MAX (highest_cell, seg->bounds[1]); + } + + + { + int i = 0; + int j = 0; + + while (i < scm_i_heap_segment_table_size + && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0]) + i++; + for (j = scm_i_heap_segment_table_size; j > i; --j) + scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1]; + + scm_i_heap_segment_table [i] = seg; + scm_i_heap_segment_table_size ++; + + return i; + } +} + +SCM +scm_i_sweep_some_segments (scm_t_cell_type_statistics * fl) +{ + int i = fl->heap_segment_idx; + SCM collected =SCM_EOL; + + if (i == -1) + i++; + + for (; + i < scm_i_heap_segment_table_size; i++) + { + if (scm_i_heap_segment_table[i]->freelist != fl) + continue; + + collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i]); + + + if (collected != SCM_EOL) /* Don't increment i */ + break; + } + + fl->heap_segment_idx = i; + + return collected; +} + + + + +void +scm_i_reset_segments (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_t_heap_segment * seg = scm_i_heap_segment_table[i]; + seg->next_free_card = seg->bounds[0]; + } +} + + +/* + Determine whether the given value does actually represent a cell in + some heap segment. If this is the case, the number of the heap + segment is returned. Otherwise, -1 is returned. Binary search is + used to determine the heap segment that contains the cell. + + + I think this function is too long to be inlined. --hwn +*/ +long int +scm_i_find_heap_segment_containing_object (SCM obj) +{ + if (!CELL_P (obj)) + return -1; + + if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell) + return -1; + + + { + scm_t_cell * ptr = SCM2PTR (obj); + unsigned long int i = 0; + unsigned long int j = scm_i_heap_segment_table_size - 1; + + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + else + { + while (i < j) + { + if (ptr < scm_i_heap_segment_table[i]->bounds[1]) + { + break; + } + else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr) + { + i = j; + break; + } + else + { + unsigned long int k = (i + j) / 2; + + if (k == i) + return -1; + else if (ptr < scm_i_heap_segment_table[k]->bounds[1]) + { + j = k; + ++i; + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + } + else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr) + { + i = k; + --j; + if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + } + } + } + + if (!DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) + return -1; + else if (SCM_GC_IN_CARD_HEADERP (ptr)) + return -1; + else + return i; + } + } +} + + +/* + Important entry point: try to grab some memory, and make it into a + segment. + + RETURN: the index of the segment. + */ +int +scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_error error_policy) +{ + size_t len; + + if (scm_gc_heap_lock) + { + /* Critical code sections (such as the garbage collector) aren't + * supposed to add heap segments. + */ + fprintf (stderr, "scm_i_get_new_heap_segment: Can not extend locked heap.\n"); + abort (); + } + + + /* Pick a size for the new heap segment. + * The rule for picking the size of a segment is explained in + * gc.h + */ + { + /* Assure that the new segment is predicted to be large enough. + * + * New yield should at least equal GC fraction of new heap size, i.e. + * + * y + dh > f * (h + dh) + * + * y : yield + * f : min yield fraction + * h : heap size + * dh : size of new heap segment + * + * This gives dh > (f * h - y) / (1 - f) + */ + + /* + where is is this explanation supposed to be? --hwn + */ + int f = freelist->min_yield_fraction; + unsigned long h = SCM_HEAP_SIZE; + size_t min_cells = (f * h - 100 * (long) scm_gc_cells_collected) / (99 - f); + + /* Make heap grow with factor 1.5 */ + len = freelist->heap_size / 2; +#ifdef DEBUGINFO + fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells); +#endif + + /* + Original code adds freelist->cluster_size here. + */ + if (len < min_cells) + len = min_cells; + len *= sizeof (scm_t_cell); + /* force new sampling */ + freelist->collected = LONG_MAX; + } + + if (len > scm_max_segment_size) + len = scm_max_segment_size; + + { + size_t smallest; + scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); + + smallest = 1024 * 10; /* UGH. */ + + if (len < smallest) + len = smallest; + + /* Allocate with decaying ambition. */ + while ((len >= SCM_MIN_HEAP_SEG_SIZE) + && (len >= smallest)) + { + if (scm_i_initialize_heap_segment_data (seg, len)) + { + return scm_i_insert_segment (seg); + } + + len /= 2; + } + } + + if (error_policy == abort_on_error) + { + fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n"); + abort (); + } + return -1; +} + + +void +scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist) +{ + scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); + + if (scm_i_initialize_heap_segment_data (seg, init_heap_size)) + { + freelist->heap_segment_idx = scm_i_insert_segment (seg); + } + + /* + Why the fuck try twice? --hwn + */ + if (!seg->malloced) + { + scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE); + } + + if (freelist->min_yield_fraction) + freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction + / 100); +} + |