libguile/gc-segment.c

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