/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library 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 * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H # include #endif #include #include #include #include #include "libguile/_scm.h" #include "libguile/pairs.h" #include "libguile/gc.h" #include "libguile/private-gc.h" size_t scm_max_segment_size; /* Important entry point: try to grab some memory, and make it into a segment; return the index of the segment. SWEEP_STATS should contain global GC sweep statistics collected since the last full GC. Returns the index of the segment. If error_policy != abort_on_error, we return -1 on failure. */ int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, size_t len, policy_on_error error_policy) { if (len > scm_max_segment_size) len = scm_max_segment_size; if (len < SCM_MIN_HEAP_SEG_SIZE) len = SCM_MIN_HEAP_SEG_SIZE; /* todo: consider having a more flexible lower bound. */ { scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist); /* Allocate with decaying ambition. */ while (len >= SCM_MIN_HEAP_SEG_SIZE) { 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; } scm_t_heap_segment * scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl) { scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment)); if (!shs) { fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n"); abort (); } shs->span = fl->span; shs->freelist = fl; return shs; } void scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab) { scm_t_cell *p = seg->bounds[0]; while (p < seg->bounds[1]) { scm_i_card_statistics (p, tab, seg); p += SCM_GC_CARD_N_CELLS; } } /* count number of marked bits, so we know how much cells are live. */ int scm_i_heap_segment_marked_count (scm_t_heap_segment *seg) { scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1]; scm_t_c_bvec_long *bvec_end = (bvec + scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS); int count = 0; while (bvec < bvec_end) { count += count_one_bits_l (*bvec); bvec ++; } return count * seg->span; } int scm_i_segment_card_number (scm_t_heap_segment *seg, scm_t_cell *card) { return (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; } /* 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_cell *memory = 0; /* We use calloc to alloc the heap, so it is nicely initialized. */ 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_total_cells += scm_i_segment_cell_count (segment); /* Don't init the mem or the bitvector. 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_i_segment_cells_per_card (seg); } int scm_i_segment_cells_per_card (scm_t_heap_segment *seg) { return (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); } /* Force a sweep of this entire segment. */ void scm_i_sweep_segment (scm_t_heap_segment *seg, scm_t_sweep_statistics *sweep_stats) { int infinity = 1 << 30; scm_t_cell *remember = seg->next_free_card; while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL) ; seg->next_free_card = remember; } /* Sweep cards from SEG until we've gathered THRESHOLD cells. On return, SWEEP_STATS, if non-NULL, contains the number of cells that have been visited and collected. A freelist is returned, potentially empty. */ SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg, scm_t_sweep_statistics *sweep_stats, int threshold) { SCM cells = SCM_EOL; int collected = 0; int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment *) = (seg->first_time) ? &scm_i_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); next_free += SCM_GC_CARD_N_CELLS; cards_swept ++; } if (sweep_stats != NULL) { int swept = cards_swept * ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) - seg->span + 1); int collected_cells = collected * seg->span; sweep_stats->swept += swept; sweep_stats->collected += collected_cells; } if (next_free == seg->bounds[1]) { seg->first_time = 0; } seg->next_free_card = next_free; return cells; } SCM scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist) { scm_t_sweep_statistics stats = { 0 }; SCM result = scm_i_sweep_some_segments (freelist, &stats); scm_i_gc_sweep_stats.collected += stats.collected; scm_i_gc_sweep_stats.swept += stats.swept; freelist->collected += stats.collected; freelist->swept += stats.swept; return result; }