[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,
   *CELLS_SWEPT contains the number of cells that have been visited and
   *CELLS_COLLECTED contains the number of cells actually 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);

  while (scm_i_sweep_some_cards (seg, &sweep) != SCM_EOL)
    scm_i_sweep_statistics_sum (sweep_stats, 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;

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