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