libguile/gc-segment.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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
  28
  29
  30
  31 size_t scm_max_segment_size;
  32
  33 scm_t_heap_segment *
  34 scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
  35 {
  36   scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment));
  37
  38   if (!shs)
  39     {
  40       fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
  41       abort ();
  42     }
  43
  44   shs->bounds[0] = NULL;
  45   shs->bounds[1] = NULL;
  46   shs->malloced = NULL;
  47   shs->span = fl->span;
  48   shs->freelist  = fl;
  49   shs->next_free_card = NULL;
  50
  51   return shs;
  52 }
  53
  54
  55 /*
  56   Fill SEGMENT with memory both for data and mark bits.
  57
  58   RETURN:  1 on success, 0 failure
  59  */
  60 int
  61 scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested)
  62 {
  63   /*
  64     round upwards
  65    */
  66   int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
  67   int card_count =1 + (requested / sizeof (scm_t_cell)) /  card_data_cell_count;
  68
  69   /*
  70     one card extra due to alignment
  71   */
  72   size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD
  73     + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG
  74     ;
  75   scm_t_c_bvec_long * bvec_ptr = 0;
  76   scm_t_cell *  memory = 0;
  77
  78   /*
  79     We use malloc to alloc the heap. On GNU libc this is
  80     equivalent to mmapping /dev/zero
  81    */
  82   SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed));
  83
  84   if (memory == NULL)
  85     return 0;
  86
  87   segment->malloced = memory;
  88   segment->bounds[0] = SCM_GC_CARD_UP (memory);
  89   segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
  90
  91   segment->freelist->heap_size += scm_i_segment_cell_count (segment);
  92
  93   bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1];
  94
  95   /*
  96     Don't init the mem or the bitvector. This is handled by lazy
  97     sweeping.
  98   */
  99
 100   segment->next_free_card = segment->bounds[0];
 101   segment->first_time = 1;
 102   return 1;
 103 }
 104
 105 int
 106 scm_i_segment_card_count (scm_t_heap_segment * seg)
 107 {
 108   return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
 109 }
 110
 111 /*
 112   Return the number of available single-cell data cells.
 113  */
 114 int
 115 scm_i_segment_cell_count (scm_t_heap_segment * seg)
 116 {
 117   return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
 118     + ((seg->span == 2) ? -1 : 0);
 119 }
 120
 121 void
 122 scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
 123 {
 124   scm_t_cell *  markspace = seg->bounds[1];
 125
 126   memset (markspace, 0x00,
 127           scm_i_segment_card_count (seg) *  SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
 128 }
 129
 130 /*
 131   Sweep cards from SEG until we've gathered THRESHOLD cells
 132
 133   RETURN:
 134
 135   Freelist.
 136 */
 137 SCM
 138 scm_i_sweep_some_cards (scm_t_heap_segment *seg)
 139 {
 140   SCM cells = SCM_EOL;
 141   int threshold = 512;
 142   int collected = 0;
 143   int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* )
 144     = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
 145
 146   scm_t_cell * next_free = seg->next_free_card;
 147   int cards_swept = 0;
 148
 149   while (collected < threshold && next_free < seg->bounds[1])
 150     {
 151       collected += (*sweeper) (next_free, &cells, seg);
 152       next_free += SCM_GC_CARD_N_CELLS;
 153       cards_swept ++;
 154     }
 155
 156   scm_gc_cells_swept +=  cards_swept * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
 157   scm_gc_cells_collected += collected * seg->span;
 158
 159   if (!seg->first_time)
 160     scm_cells_allocated -= collected * seg->span;
 161
 162   seg->freelist->collected += collected  * seg->span;
 163
 164
 165   if(next_free == seg->bounds[1])
 166     {
 167       seg->first_time = 0;
 168     }
 169
 170   seg->next_free_card = next_free;
 171   return cells;
 172 }
 173
 174
 175 /*
 176   Force a sweep of this entire segment. This doesn't modify sweep
 177   statistics, it just frees the memory pointed to by to-be-swept
 178   cells.
 179
 180   Implementation is slightly ugh.
 181
 182   FIXME: if you do scm_i_sweep_segment(), and then allocate from this
 183   segment again, the statistics are off.
 184  */
 185 void
 186 scm_i_sweep_segment (scm_t_heap_segment * seg)
 187 {
 188   scm_t_cell * p = seg->next_free_card;
 189   int yield = scm_gc_cells_collected;
 190   int coll = seg->freelist->collected;
 191   unsigned long alloc = scm_cells_allocated ;
 192
 193   while (scm_i_sweep_some_cards (seg) != SCM_EOL)
 194     ;
 195
 196   scm_gc_cells_collected = yield;
 197   scm_cells_allocated = alloc;
 198   seg->freelist->collected = coll;
 199
 200   seg->next_free_card =p;
 201 }
 202
 203 void
 204 scm_i_sweep_all_segments (char const  *reason)
 205 {
 206   int i= 0;
 207
 208   for (i = 0; i < scm_i_heap_segment_table_size; i++)
 209     {
 210       scm_i_sweep_segment (scm_i_heap_segment_table[i]);
 211     }
 212 }
 213
 214
 215 /*
 216   Heap segment table.
 217
 218   The table is sorted by the address of the data itself. This makes
 219   for easy lookups. This is not portable: according to ANSI C,
 220   pointers can only be compared within the same object (i.e. the same
 221   block of malloced memory.). For machines with weird architectures,
 222   this should be revised.
 223
 224   (Apparently, for this reason 1.6 and earlier had macros for pointer
 225   comparison. )
 226
 227   perhaps it is worthwhile to remove the 2nd level of indirection in
 228   the table, but this certainly makes for cleaner code.
 229 */
 230 scm_t_heap_segment ** scm_i_heap_segment_table;
 231 size_t scm_i_heap_segment_table_size;
 232 scm_t_cell *lowest_cell;
 233 scm_t_cell *highest_cell;
 234
 235
 236 void
 237 scm_i_clear_mark_space (void)
 238 {
 239   int i = 0;
 240   for (; i < scm_i_heap_segment_table_size; i++)
 241     {
 242       scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
 243     }
 244 }
 245
 246
 247 /*
 248   RETURN: index of inserted segment.
 249  */
 250 int
 251 scm_i_insert_segment (scm_t_heap_segment * seg)
 252 {
 253   size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
 254   SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **)
 255                                realloc ((char *)scm_i_heap_segment_table, size)));
 256
 257   /*
 258     We can't alloc 4 more bytes. This is hopeless.
 259    */
 260   if (!scm_i_heap_segment_table)
 261     {
 262       fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
 263       abort ();
 264     }
 265
 266   if (!lowest_cell)
 267     {
 268       lowest_cell = seg->bounds[0];
 269       highest_cell = seg->bounds[1];
 270     }
 271   else
 272     {
 273       lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
 274       highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
 275     }
 276
 277
 278   {
 279     int i = 0;
 280     int j = 0;
 281
 282     while (i < scm_i_heap_segment_table_size
 283            && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
 284       i++;
 285
 286     /*
 287       We insert a new entry; if that happens to be before the
 288       "current" segment of a freelist, we must move the freelist index
 289       as well.
 290     */
 291     if (scm_i_master_freelist.heap_segment_idx >= i)
 292       scm_i_master_freelist.heap_segment_idx ++;
 293     if (scm_i_master_freelist2.heap_segment_idx >= i)
 294       scm_i_master_freelist2.heap_segment_idx ++;
 295
 296     for (j = scm_i_heap_segment_table_size; j > i; --j)
 297       scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
 298
 299     scm_i_heap_segment_table [i] = seg;
 300     scm_i_heap_segment_table_size ++;
 301
 302     return i;
 303   }
 304 }
 305
 306 SCM
 307 scm_i_sweep_some_segments (scm_t_cell_type_statistics * fl)
 308 {
 309   int i = fl->heap_segment_idx;
 310   SCM collected =SCM_EOL;
 311
 312   if (i == -1)
 313     i++;
 314
 315   for (;
 316        i < scm_i_heap_segment_table_size; i++)
 317     {
 318       if (scm_i_heap_segment_table[i]->freelist != fl)
 319         continue;
 320
 321       collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i]);
 322
 323
 324       if (collected != SCM_EOL)       /* Don't increment i */
 325         break;
 326     }
 327
 328   fl->heap_segment_idx = i;
 329
 330   return collected;
 331 }
 332
 333
 334
 335
 336 void
 337 scm_i_reset_segments (void)
 338 {
 339   int i = 0;
 340   for (; i < scm_i_heap_segment_table_size; i++)
 341     {
 342       scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
 343       seg->next_free_card = seg->bounds[0];
 344     }
 345 }
 346
 347
 348 /*
 349   Determine whether the given value does actually represent a cell in
 350   some heap segment.  If this is the case, the number of the heap
 351   segment is returned.  Otherwise, -1 is returned.  Binary search is
 352   used to determine the heap segment that contains the cell.
 353
 354
 355   I think this function is too long to be inlined. --hwn
 356 */
 357 long int
 358 scm_i_find_heap_segment_containing_object (SCM obj)
 359 {
 360   if (!CELL_P (obj))
 361     return -1;
 362
 363   if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell)
 364     return -1;
 365
 366
 367     {
 368       scm_t_cell *  ptr = SCM2PTR (obj);
 369       unsigned long int i = 0;
 370       unsigned long int j = scm_i_heap_segment_table_size - 1;
 371
 372       if (ptr < scm_i_heap_segment_table[i]->bounds[0])
 373         return -1;
 374       else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
 375         return -1;
 376       else
 377         {
 378           while (i < j)
 379             {
 380               if (ptr < scm_i_heap_segment_table[i]->bounds[1])
 381                 {
 382                   break;
 383                 }
 384               else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
 385                 {
 386                   i = j;
 387                   break;
 388                 }
 389               else
 390                 {
 391                   unsigned long int k = (i + j) / 2;
 392
 393                   if (k == i)
 394                     return -1;
 395                   else if (ptr <  scm_i_heap_segment_table[k]->bounds[1])
 396                     {
 397                       j = k;
 398                       ++i;
 399                       if (ptr <  scm_i_heap_segment_table[i]->bounds[0])
 400                         return -1;
 401                     }
 402                   else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
 403                     {
 404                       i = k;
 405                       --j;
 406                       if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
 407                         return -1;
 408                     }
 409                 }
 410             }
 411
 412           if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
 413             return -1;
 414           else if (SCM_GC_IN_CARD_HEADERP (ptr))
 415             return -1;
 416           else
 417             return i;
 418         }
 419     }
 420 }
 421
 422
 423 /*
 424   Important entry point: try to grab some memory, and make it into a
 425   segment.
 426
 427   RETURN: the index of the segment.
 428  */
 429 int
 430 scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_error error_policy)
 431 {
 432   size_t len;
 433
 434   if (scm_gc_heap_lock)
 435     {
 436       /* Critical code sections (such as the garbage collector) aren't
 437        * supposed to add heap segments.
 438        */
 439       fprintf (stderr, "scm_i_get_new_heap_segment: Can not extend locked heap.\n");
 440       abort ();
 441     }
 442
 443   {
 444     /* Assure that the new segment is predicted to be large enough.
 445      *
 446      * New yield should at least equal GC fraction of new heap size, i.e.
 447      *
 448      *   y + dh > f * (h + dh)
 449      *
 450      *    y : yield
 451      *    f : min yield fraction
 452      *    h : heap size
 453      *   dh : size of new heap segment
 454      *
 455      * This gives dh > (f * h - y) / (1 - f)
 456      */
 457     float f = freelist->min_yield_fraction / 100.0;
 458     float h = SCM_HEAP_SIZE;
 459     float min_cells
 460       = (f * h - scm_gc_cells_collected) / (1.0 - f);
 461
 462     /* Make heap grow with factor 1.5 */
 463     len =  freelist->heap_size / 2;
 464 #ifdef DEBUGINFO
 465     fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
 466 #endif
 467
 468     if (len < min_cells)
 469       len = (unsigned long) min_cells;
 470     len *= sizeof (scm_t_cell);
 471     /* force new sampling */
 472     freelist->collected = LONG_MAX;
 473   }
 474
 475   if (len > scm_max_segment_size)
 476     len = scm_max_segment_size;
 477   if (len < SCM_MIN_HEAP_SEG_SIZE)
 478     len = SCM_MIN_HEAP_SEG_SIZE;
 479
 480   {
 481     scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
 482
 483     /* Allocate with decaying ambition. */
 484     while (len >= SCM_MIN_HEAP_SEG_SIZE)
 485       {
 486         if (scm_i_initialize_heap_segment_data (seg, len))
 487           {
 488             return scm_i_insert_segment (seg);
 489           }
 490
 491         len /= 2;
 492       }
 493   }
 494
 495   if (error_policy == abort_on_error)
 496     {
 497       fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n");
 498       abort ();
 499     }
 500   return -1;
 501 }
 502
 503 void
 504 scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist)
 505 {
 506   scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
 507
 508   if (init_heap_size < 1)
 509     {
 510       init_heap_size =  SCM_DEFAULT_INIT_HEAP_SIZE_1;
 511     }
 512
 513   if (scm_i_initialize_heap_segment_data (seg, init_heap_size))
 514     {
 515       freelist->heap_segment_idx = scm_i_insert_segment (seg);
 516     }
 517
 518   /*
 519     Why the fuck  try twice? --hwn
 520    */
 521   if (!seg->malloced)
 522     {
 523       scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE);
 524     }
 525
 526   if (freelist->min_yield_fraction)
 527     freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction
 528                             / 100);
 529 }