[bpt/guile.git] / libguile / gc-segment.c

/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 */

#include <assert.h> 
#include <stdio.h>
#include <string.h>

#include "libguile/_scm.h"
#include "libguile/pairs.h"
#include "libguile/gc.h"
#include "libguile/private-gc.h"

size_t scm_max_segment_size;

scm_t_heap_segment *
scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
{
  scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment));

  if (!shs)
    {
      fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
      abort ();
    }
  
  shs->bounds[0] = NULL;
  shs->bounds[1] = NULL;
  shs->malloced = NULL;
  shs->span = fl->span;
  shs->freelist  = fl;
  shs->next_free_card = NULL;
  
  return shs;
}


void
scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
{
  scm_t_cell *p = seg->bounds[0];
  while (p <  seg->bounds[1])
    {
      scm_i_card_statistics (p, tab, seg); 
      p += SCM_GC_CARD_N_CELLS;
    }
}

/*
  Fill SEGMENT with memory both for data and mark bits.

  RETURN:  1 on success, 0 failure  
 */
int 
scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested)
{
  /*
    round upwards
   */
  int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
  int card_count =1 + (requested / sizeof (scm_t_cell)) /  card_data_cell_count; 

  /*
    one card extra due to alignment
  */
  size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD
    + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG
    ;
  scm_t_c_bvec_long * bvec_ptr = 0;
  scm_t_cell *  memory = 0;

  /*
    We use calloc to alloc the heap. On GNU libc this is 
    equivalent to mmapping /dev/zero
   */
  SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed));

  if (memory == NULL)
    return 0;

  segment->malloced = memory;
  segment->bounds[0] = SCM_GC_CARD_UP (memory);
  segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;

  segment->freelist->heap_size += scm_i_segment_cell_count (segment);
  
  bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1];

  /*
    Don't init the mem or the bitvector. This is handled by lazy
    sweeping.
  */
  
  segment->next_free_card = segment->bounds[0];
  segment->first_time = 1;
  return 1;
}

int
scm_i_segment_card_count (scm_t_heap_segment * seg)
{
  return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
}

/*
  Return the number of available single-cell data cells. 
 */
int
scm_i_segment_cell_count (scm_t_heap_segment * seg)
{
  return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
    + ((seg->span == 2) ? -1 : 0);
}

void
scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
{
  scm_t_cell *  markspace = seg->bounds[1];

  memset (markspace, 0x00,
	  scm_i_segment_card_count (seg) *  SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
}

/* Sweep cards from SEG until we've gathered THRESHOLD cells.  On return,
   SWEEP_STATS contains the number of cells that have been visited and
   collected.  A freelist is returned, potentially empty.  */
SCM
scm_i_sweep_some_cards (scm_t_heap_segment *seg,
			scm_t_sweep_statistics *sweep_stats)
{
  SCM cells = SCM_EOL;
  int threshold = 512;
  int collected = 0;
  int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* )
    = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;

  scm_t_cell * next_free = seg->next_free_card;
  int cards_swept = 0;

  while (collected < threshold && next_free < seg->bounds[1])
    {
      collected += (*sweeper) (next_free, &cells, seg);
      next_free += SCM_GC_CARD_N_CELLS;
      cards_swept ++;
    }

  sweep_stats->swept = cards_swept * seg->span
    * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);

  if (!seg->first_time)
    {
      /* scm_cells_allocated -= collected * seg->span; */
      sweep_stats->collected = collected * seg->span;
    }
  else
    sweep_stats->collected = 0;

  seg->freelist->collected += collected * seg->span;

  if(next_free == seg->bounds[1])
    {
      seg->first_time = 0;
    }

  seg->next_free_card = next_free;
  return cells;
}


/*
  Force a sweep of this entire segment. This doesn't modify sweep
  statistics, it just frees the memory pointed to by to-be-swept
  cells.

  Implementation is slightly ugh.

  FIXME: if you do scm_i_sweep_segment(), and then allocate from this
  segment again, the statistics are off.
 */
void
scm_i_sweep_segment (scm_t_heap_segment *seg,
		     scm_t_sweep_statistics *sweep_stats)
{
  scm_t_sweep_statistics sweep;
  scm_t_cell * p = seg->next_free_card;

  scm_i_sweep_statistics_init (sweep_stats);

  scm_i_sweep_statistics_init (&sweep);
  while (scm_i_sweep_some_cards (seg, &sweep) != SCM_EOL)
    {
      scm_i_sweep_statistics_sum (sweep_stats, sweep);
      scm_i_sweep_statistics_init (&sweep);
    }

  seg->next_free_card =p;
}

void
scm_i_sweep_all_segments (char const *reason,
			  scm_t_sweep_statistics *sweep_stats)
{
  unsigned i= 0;

  scm_i_sweep_statistics_init (sweep_stats);
  for (i = 0; i < scm_i_heap_segment_table_size; i++)
    {
      scm_t_sweep_statistics sweep;

      scm_i_sweep_segment (scm_i_heap_segment_table[i], &sweep);
      scm_i_sweep_statistics_sum (sweep_stats, sweep);
    }
}


/*
  Heap segment table.

  The table is sorted by the address of the data itself. This makes
  for easy lookups. This is not portable: according to ANSI C,
  pointers can only be compared within the same object (i.e. the same
  block of malloced memory.). For machines with weird architectures,
  this should be revised.
  
  (Apparently, for this reason 1.6 and earlier had macros for pointer
  comparison. )
  
  perhaps it is worthwhile to remove the 2nd level of indirection in
  the table, but this certainly makes for cleaner code.
*/
scm_t_heap_segment ** scm_i_heap_segment_table;
size_t scm_i_heap_segment_table_size;
scm_t_cell *lowest_cell;
scm_t_cell *highest_cell; 


void
scm_i_clear_mark_space (void)
{
  int i = 0;
  for (; i < scm_i_heap_segment_table_size; i++)
    {
      scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
    }
}


/*
  RETURN: index of inserted segment.
 */
int
scm_i_insert_segment (scm_t_heap_segment * seg)
{
  size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
  SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **)
			       realloc ((char *)scm_i_heap_segment_table, size)));

  /*
    We can't alloc 4 more bytes. This is hopeless.
   */
  if (!scm_i_heap_segment_table)
    {
      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
      abort ();
    }

  if (!lowest_cell)
    {
      lowest_cell = seg->bounds[0];
      highest_cell = seg->bounds[1];
    }
  else
    {
      lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
      highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
    }


  {
    int i = 0;
    int j = 0;

    while (i < scm_i_heap_segment_table_size
	   && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
      i++;

    /*
      We insert a new entry; if that happens to be before the
      "current" segment of a freelist, we must move the freelist index
      as well.
    */
    if (scm_i_master_freelist.heap_segment_idx >= i)
      scm_i_master_freelist.heap_segment_idx ++;
    if (scm_i_master_freelist2.heap_segment_idx >= i)
      scm_i_master_freelist2.heap_segment_idx ++;

    for (j = scm_i_heap_segment_table_size; j > i; --j)
      scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];

    scm_i_heap_segment_table [i] = seg;
    scm_i_heap_segment_table_size ++;

    return i;
  }
}

SCM
scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl,
			   scm_t_sweep_statistics *sweep_stats)
{
  int i = fl->heap_segment_idx;
  SCM collected = SCM_EOL;

  scm_i_sweep_statistics_init (sweep_stats);
  if (i == -1)
    i++;

  for (;
       i < scm_i_heap_segment_table_size; i++)
    {
      scm_t_sweep_statistics sweep;

      if (scm_i_heap_segment_table[i]->freelist != fl)
	continue;

      scm_i_sweep_statistics_init (&sweep);
      collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
					  &sweep);

      scm_i_sweep_statistics_sum (sweep_stats, sweep);

      if (collected != SCM_EOL)       /* Don't increment i */
	break;
    }

  fl->heap_segment_idx = i;

  return collected;
}


void
scm_i_reset_segments (void)
{
  int i = 0;
  for (; i < scm_i_heap_segment_table_size; i++)
    {
      scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
      seg->next_free_card = seg->bounds[0];
    }
}

/*
  Return a hashtab with counts of live objects, with tags as keys.
 */


SCM
scm_i_all_segments_statistics (SCM tab)
{
  int i = 0;
  for (; i < scm_i_heap_segment_table_size; i++)
    {
      scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
      scm_i_heap_segment_statistics (seg, tab);
    }

  return tab;
}

/*
  Determine whether the given value does actually represent a cell in
  some heap segment.  If this is the case, the number of the heap
  segment is returned.  Otherwise, -1 is returned.  Binary search is
  used to determine the heap segment that contains the cell.


  I think this function is too long to be inlined. --hwn
*/
long int
scm_i_find_heap_segment_containing_object (SCM obj)
{
  if (!CELL_P (obj))
    return -1;

  if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell)
    return -1;

  
    {
      scm_t_cell *  ptr = SCM2PTR (obj);
      unsigned long int i = 0;
      unsigned long int j = scm_i_heap_segment_table_size - 1;

      if (ptr < scm_i_heap_segment_table[i]->bounds[0])
	return -1;
      else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
	return -1;
      else
	{
	  while (i < j)
	    {
	      if (ptr < scm_i_heap_segment_table[i]->bounds[1])
		{
		  break;
		}
	      else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
		{
		  i = j;
		  break;
		}
	      else
		{
		  unsigned long int k = (i + j) / 2;

		  if (k == i)
		    return -1;
		  else if (ptr <  scm_i_heap_segment_table[k]->bounds[1])
		    {
		      j = k;
		      ++i;
		      if (ptr <  scm_i_heap_segment_table[i]->bounds[0])
			return -1;
		    }
		  else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
		    {
		      i = k;
		      --j;
		      if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
			return -1;
		    }
		}
	    }

	  if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
	    return -1;
	  else if (SCM_GC_IN_CARD_HEADERP (ptr))
	    return -1;
	  else
	    return i;
	}
    }
}


/* Important entry point: try to grab some memory, and make it into a
   segment; return the index of the segment.  SWEEP_STATS should contain
   global GC sweep statistics collected since the last full GC.  */
int
scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
			    scm_t_sweep_statistics sweep_stats,
			    policy_on_error error_policy)
{
  size_t len;

  {
    /* Assure that the new segment is predicted to be large enough.
     *
     * New yield should at least equal GC fraction of new heap size, i.e.
     *
     *   y + dh > f * (h + dh)
     *
     *    y : yield
     *    f : min yield fraction
     *    h : heap size
     *   dh : size of new heap segment
     *
     * This gives dh > (f * h - y) / (1 - f)
     */
    float f = freelist->min_yield_fraction / 100.0;
    float h = SCM_HEAP_SIZE;
    float min_cells = (f * h - sweep_stats.collected) / (1.0 - f);

    /* Make heap grow with factor 1.5 */
    len = freelist->heap_size / 2;
#ifdef DEBUGINFO
    fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
#endif
	   
    if (len < min_cells)
      len = (unsigned long) min_cells;

    len *= sizeof (scm_t_cell);
    /* force new sampling */
    freelist->collected = LONG_MAX;
  }

  if (len > scm_max_segment_size)
    len = scm_max_segment_size;

  if (len < SCM_MIN_HEAP_SEG_SIZE)
    len = SCM_MIN_HEAP_SEG_SIZE;

  {
    scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);

    /* Allocate with decaying ambition. */
    while (len >= SCM_MIN_HEAP_SEG_SIZE)
      {
	if (scm_i_initialize_heap_segment_data (seg, len))
	  {
	    return scm_i_insert_segment (seg);
	  }
	
	len /= 2;
      }
  }

  if (error_policy == abort_on_error)
    {
      fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n");
      abort ();
    }
  return -1;
}

void
scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist)
{
  scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);

  if (init_heap_size < 1)
    {
      init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1;
    }
 
  if (scm_i_initialize_heap_segment_data (seg, init_heap_size))
    {
      freelist->heap_segment_idx = scm_i_insert_segment (seg);
    }

  /*
    Why the fuck  try twice? --hwn
   */
  if (!seg->malloced)
    {
      scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE);
    }

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