libguile/gc-segment.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18 #ifdef HAVE_CONFIG_H
  19 # include <config.h>
  20 #endif
  21
  22 #include <assert.h>
  23 #include <stdio.h>
  24 #include <string.h>
  25
  26 #include <count-one-bits.h>
  27
  28 #include "libguile/_scm.h"
  29 #include "libguile/pairs.h"
  30 #include "libguile/gc.h"
  31 #include "libguile/private-gc.h"
  32
  33 size_t scm_max_segment_size;
  34
  35 /* Important entry point: try to grab some memory, and make it into a
  36    segment; return the index of the segment.  SWEEP_STATS should contain
  37    global GC sweep statistics collected since the last full GC.
  38
  39    Returns the index of the segment.  If error_policy !=
  40    abort_on_error, we return -1 on failure.
  41 */
  42 int
  43 scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
  44                             size_t len,
  45                             policy_on_error error_policy)
  46 {
  47   if (len > scm_max_segment_size)
  48     len = scm_max_segment_size;
  49
  50   if (len < SCM_MIN_HEAP_SEG_SIZE)
  51     len = SCM_MIN_HEAP_SEG_SIZE;
  52
  53   /* todo: consider having a more flexible lower bound. */
  54   {
  55     scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist);
  56
  57     /* Allocate with decaying ambition. */
  58     while (len >= SCM_MIN_HEAP_SEG_SIZE)
  59       {
  60         if (scm_i_initialize_heap_segment_data (seg, len))
  61           return scm_i_insert_segment (seg);
  62
  63         len /= 2;
  64       }
  65   }
  66
  67   if (error_policy == abort_on_error)
  68     {
  69       fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n");
  70       abort ();
  71     }
  72   return -1;
  73 }
  74
  75
  76 scm_t_heap_segment *
  77 scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
  78 {
  79   scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment));
  80
  81   if (!shs)
  82     {
  83       fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
  84       abort ();
  85     }
  86
  87   shs->span = fl->span;
  88   shs->freelist  = fl;
  89
  90   return shs;
  91 }
  92
  93 void
  94 scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
  95 {
  96   scm_t_cell *p = seg->bounds[0];
  97   while (p <  seg->bounds[1])
  98     {
  99       scm_i_card_statistics (p, tab, seg);
 100       p += SCM_GC_CARD_N_CELLS;
 101     }
 102 }
 103
 104 /*
 105   count number of marked bits, so we know how much cells are live.
 106  */
 107 int
 108 scm_i_heap_segment_marked_count (scm_t_heap_segment *seg)
 109 {
 110   scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1];
 111   scm_t_c_bvec_long *bvec_end =
 112     (bvec +
 113      scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
 114
 115   int count = 0;
 116   while (bvec < bvec_end)
 117     {
 118       count += count_one_bits_l (*bvec);
 119       bvec ++;
 120     }
 121   return count * seg->span;
 122 }
 123
 124 int
 125 scm_i_segment_card_number (scm_t_heap_segment *seg,
 126                            scm_t_cell *card)
 127 {
 128   return (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
 129 }
 130
 131 /*
 132   Fill SEGMENT with memory both for data and mark bits.
 133
 134   RETURN: 1 on success, 0 failure
 135  */
 136 int
 137 scm_i_initialize_heap_segment_data (scm_t_heap_segment *segment, size_t requested)
 138 {
 139   /*
 140     round upwards
 141    */
 142   int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
 143   int card_count = 1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count;
 144
 145   /*
 146     one card extra due to alignment
 147   */
 148   size_t mem_needed = (1 + card_count) * SCM_GC_SIZEOF_CARD
 149     + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG;
 150   scm_t_cell *memory = 0;
 151
 152   /*
 153     We use calloc to alloc the heap, so it is nicely initialized.
 154    */
 155   SCM_SYSCALL (memory = (scm_t_cell *) calloc (1, mem_needed));
 156
 157   if (memory == NULL)
 158     return 0;
 159
 160   segment->malloced = memory;
 161   segment->bounds[0] = SCM_GC_CARD_UP (memory);
 162   segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
 163   segment->freelist->heap_total_cells += scm_i_segment_cell_count (segment);
 164
 165   /*
 166     Don't init the mem or the bitvector. This is handled by lazy
 167     sweeping.
 168   */
 169   segment->next_free_card = segment->bounds[0];
 170   segment->first_time = 1;
 171   return 1;
 172 }
 173
 174 int
 175 scm_i_segment_card_count (scm_t_heap_segment *seg)
 176 {
 177   return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
 178 }
 179
 180 /*
 181   Return the number of available single-cell data cells.
 182  */
 183 int
 184 scm_i_segment_cell_count (scm_t_heap_segment *seg)
 185 {
 186   return scm_i_segment_card_count (seg)
 187     * scm_i_segment_cells_per_card (seg);
 188 }
 189
 190 int
 191 scm_i_segment_cells_per_card (scm_t_heap_segment *seg)
 192 {
 193   return (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS
 194           + ((seg->span == 2) ? -1 : 0));
 195 }
 196
 197 void
 198 scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
 199 {
 200   scm_t_cell *markspace = seg->bounds[1];
 201
 202   memset (markspace, 0x00,
 203           scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
 204 }
 205
 206
 207 /*
 208   Force a sweep of this entire segment.
 209  */
 210 void
 211 scm_i_sweep_segment (scm_t_heap_segment *seg,
 212                      scm_t_sweep_statistics *sweep_stats)
 213 {
 214   int infinity = 1 << 30;
 215   scm_t_cell *remember = seg->next_free_card;
 216   while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL)
 217     ;
 218   seg->next_free_card = remember;
 219 }
 220
 221
 222 /* Sweep cards from SEG until we've gathered THRESHOLD cells.  On
 223    return, SWEEP_STATS, if non-NULL, contains the number of cells that
 224    have been visited and collected.  A freelist is returned,
 225    potentially empty.  */
 226 SCM
 227 scm_i_sweep_some_cards (scm_t_heap_segment *seg,
 228                         scm_t_sweep_statistics *sweep_stats,
 229                         int threshold)
 230 {
 231   SCM cells = SCM_EOL;
 232   int collected = 0;
 233   int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment *)
 234     = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
 235
 236   scm_t_cell *next_free = seg->next_free_card;
 237   int cards_swept = 0;
 238   while (collected < threshold && next_free < seg->bounds[1])
 239     {
 240       collected += (*sweeper) (next_free, &cells, seg);
 241       next_free += SCM_GC_CARD_N_CELLS;
 242       cards_swept ++;
 243     }
 244
 245   if (sweep_stats != NULL)
 246     {
 247       int swept = cards_swept
 248         * ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
 249            - seg->span + 1);
 250       int collected_cells = collected * seg->span;
 251       sweep_stats->swept += swept;
 252       sweep_stats->collected += collected_cells;
 253     }
 254
 255   if (next_free == seg->bounds[1])
 256     {
 257       seg->first_time = 0;
 258     }
 259
 260   seg->next_free_card = next_free;
 261   return cells;
 262 }
 263
 264
 265
 266 SCM
 267 scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist)
 268 {
 269   scm_t_sweep_statistics stats = { 0 };
 270   SCM result = scm_i_sweep_some_segments (freelist, &stats);
 271
 272   scm_i_gc_sweep_stats.collected += stats.collected;
 273   scm_i_gc_sweep_stats.swept += stats.swept;
 274
 275   freelist->collected += stats.collected;
 276   freelist->swept += stats.swept;
 277   return result;
 278 }
 279