libguile/gc-segment.c

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