mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* gc.c, gc.h, pairs.h, init.c: Implementation of a new way of

Browse source 
allocating heap.  The basic idea is to trigger GC every Nth
allocated cell and grow heap when free list runs out.  The scheme
has been extended so that GC isn't triggered until all remaining
cells are used.  The implementation is also prepared for
development in the direction of POSIX threads.

* gc.c (SCM_EXPHEAP): In order to grow by a factor of 1.5,
SCM_EXPHEAP should return half of the heap size.
This commit is contained in:
Mikael Djurfeldt 2000-03-15 07:30:53 +00:00
parent 83c4c29dcb
commit 4a4c9785e0
4 changed files with 376 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

319
libguile/gc.c
View file

@ -120,10 +120,13 @@
# define SCM_HEAP_SEG_SIZE (16384L*sizeof(scm_cell))
# endif
#endif
#define SCM_EXPHEAP(scm_heap_size) (scm_heap_size * 3 / 2)
#define SCM_EXPHEAP(scm_heap_size) (scm_heap_size / 2)
#define SCM_INIT_MALLOC_LIMIT 100000
#define SCM_MTRIGGER_HYSTERESIS (SCM_INIT_MALLOC_LIMIT/10)
#define SCM_GC_TRIGGER 10000
#define SCM_GC_TRIGGER2 10000
/* CELL_UP and CELL_DN are used by scm_init_heap_seg to find scm_cell aligned inner
bounds for allocated storage */
@ -146,8 +149,19 @@
/* scm_freelists
*/
#ifdef GUILE_NEW_GC_SCHEME
SCM scm_freelist = SCM_EOL;
scm_freelist_t scm_master_freelist = {
SCM_EOL, 0, SCM_EOL, SCM_EOL, 0, 0, 0, 1, 0, 0
};
SCM scm_freelist2 = SCM_EOL;
scm_freelist_t scm_master_freelist2 = {
SCM_EOL, 0, SCM_EOL, SCM_EOL, 0, 0, 0, 2, 0, 0
};
#else
scm_freelist_t scm_freelist = { SCM_EOL, 1, 0, 0 };
scm_freelist_t scm_freelist2 = { SCM_EOL, 2, 0, 0 };
#endif
/* scm_mtrigger
* is the number of bytes of must_malloc allocation needed to trigger gc.
@ -276,8 +290,13 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
#define FUNC_NAME s_scm_map_free_list
{
fprintf (stderr, "%d segments total\n", scm_n_heap_segs);
#ifdef GUILE_NEW_GC_SCHEME
map_free_list (&scm_master_freelist);
map_free_list (&scm_master_freelist2);
#else
map_free_list (&scm_freelist);
map_free_list (&scm_freelist2);
#endif
fflush (stderr);
return SCM_UNSPECIFIED;
@ -322,6 +341,62 @@ SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1
#undef FUNC_NAME
#ifdef GUILE_NEW_GC_SCHEME
SCM
scm_debug_newcell (void)
{
SCM new;
scm_newcell_count++;
if (scm_debug_check_freelist)
{
scm_check_freelist (&scm_master_freelist);
scm_gc();
}
/* The rest of this is supposed to be identical to the SCM_NEWCELL
macro. */
if (SCM_IMP (scm_freelist))
new = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist);
else
{
new = scm_freelist;
scm_freelist = SCM_CDR (scm_freelist);
SCM_SETCAR (new, scm_tc16_allocated);
}
return new;
}
SCM
scm_debug_newcell2 (void)
{
SCM new;
scm_newcell2_count++;
if (scm_debug_check_freelist)
{
scm_check_freelist (&scm_master_freelist2);
scm_gc ();
}
/* The rest of this is supposed to be identical to the SCM_NEWCELL
macro. */
if (SCM_IMP (scm_freelist2))
new = scm_gc_for_newcell (&scm_master_freelist2, &scm_freelist2);
else
{
new = scm_freelist2;
scm_freelist2 = SCM_CDR (scm_freelist2);
SCM_SETCAR (new, scm_tc16_allocated);
}
return new;
}
#else /* GUILE_NEW_GC_SCHEME */
SCM
scm_debug_newcell (void)
{
@ -375,6 +450,7 @@ scm_debug_newcell2 (void)
return new;
}
#endif /* GUILE_NEW_GC_SCHEME */
#endif /* GUILE_DEBUG_FREELIST */
@ -413,7 +489,11 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
/// ? ?? ?
local_scm_mtrigger = scm_mtrigger;
local_scm_mallocated = scm_mallocated;
#ifdef GUILE_NEW_GC_SCHEME
local_scm_heap_size = scm_master_freelist.heap_size; /*fixme*/
#else
local_scm_heap_size = scm_freelist.heap_size; /*fixme*/
#endif
local_scm_cells_allocated = scm_cells_allocated;
local_scm_gc_time_taken = scm_gc_time_taken;
@ -477,6 +557,33 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
/* {C Interface For When GC is Triggered}
*/
#ifdef GUILE_NEW_GC_SCHEME
/* When we get POSIX threads support, the master will be global and
common while the freelist will be individual for each thread. */
SCM
scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
{
SCM cell;
++scm_ints_disabled;
if (master->triggeredp)
scm_igc ("cells");
else if (SCM_NULLP (master->clusters))
alloc_some_heap (master);
else if (master->triggerp && SCM_NULLP (SCM_CDR (master->clusters)))
/* we are satisfied; GC instead of alloc next time around */
master->triggeredp = 1;
--scm_ints_disabled;
cell = SCM_CAR (master->clusters);
master->clusters = SCM_CDR (master->clusters);
*freelist = SCM_CDR (cell);
SCM_SETCAR (cell, scm_tc16_allocated);
return cell;
}
#else /* GUILE_NEW_GC_SCHEME */
void
scm_gc_for_alloc (scm_freelist_t *freelistp)
{
@ -504,6 +611,8 @@ scm_gc_for_newcell (scm_freelist_t *freelistp)
return fl;
}
#endif /* GUILE_NEW_GC_SCHEME */
void
scm_igc (const char *what)
{
@ -1139,16 +1248,34 @@ scm_gc_sweep ()
register scm_freelist_t *hp_freelist;
register long m;
register int span;
#ifdef GUILE_NEW_GC_SCHEME
long n_objects;
#endif
long i;
scm_sizet seg_size;
m = 0;
#ifdef GUILE_NEW_GC_SCHEME
/* Reset all free list pointers. We'll reconstruct them completely
while scanning. */
for (i = 0; i < scm_n_heap_segs; i++)
{
scm_heap_table[i].freelistp->cells = SCM_EOL;
scm_heap_table[i].freelistp->n_objects
= scm_heap_table[i].freelistp->gc_trigger;
scm_heap_table[i].freelistp->clusters = SCM_EOL;
scm_heap_table[i].freelistp->clustertail
= &scm_heap_table[i].freelistp->clusters;
scm_heap_table[i].freelistp->triggeredp = 0;
}
#else
/* Reset all free list pointers. We'll reconstruct them completely
while scanning. */
for (i = 0; i < scm_n_heap_segs; i++)
scm_heap_table[i].freelistp->cells = SCM_EOL;
#endif
for (i = 0; i < scm_n_heap_segs; i++)
{
register scm_sizet n = 0;
@ -1162,6 +1289,9 @@ scm_gc_sweep ()
simply don't assign nfreelist back into the real freelist. */
hp_freelist = scm_heap_table[i].freelistp;
nfreelist = hp_freelist->cells;
#ifdef GUILE_NEW_GC_SCHEME
n_objects = hp_freelist->n_objects;
#endif
span = scm_heap_table[i].span;
hp_freelist->collected = 0;
@ -1357,18 +1487,34 @@ scm_gc_sweep ()
default:
sweeperr:scm_wta (scmptr, "unknown type in ", "gc_sweep");
}
n += span;
#if 0
if (SCM_CAR (scmptr) == (SCM) scm_tc_free_cell)
exit (2);
#endif
/* Stick the new cell on the front of nfreelist. It's
critical that we mark this cell as freed; otherwise, the
conservative collector might trace it as some other type
of object. */
SCM_SETCAR (scmptr, (SCM) scm_tc_free_cell);
SCM_SETCDR (scmptr, nfreelist);
nfreelist = scmptr;
#ifndef GUILE_NEW_GC_SCHEME
n += span;
#else
if (--n_objects < 0)
{
SCM_SETCAR (scmptr, nfreelist);
*hp_freelist->clustertail = scmptr;
hp_freelist->clustertail = SCM_CDRLOC (scmptr);
nfreelist = SCM_EOL;
n_objects = hp_freelist->gc_trigger;
n += span * (n_objects + 1);
}
else
#endif
{
/* Stick the new cell on the front of nfreelist. It's
critical that we mark this cell as freed; otherwise, the
conservative collector might trace it as some other type
of object. */
SCM_SETCAR (scmptr, scm_tc_free_cell);
SCM_SETCDR (scmptr, nfreelist);
nfreelist = scmptr;
}
continue;
c8mrkcontinue:
@ -1392,18 +1538,65 @@ scm_gc_sweep ()
}
else
#endif /* ifdef GC_FREE_SEGMENTS */
/* Update the real freelist pointer to point to the head of
the list of free cells we've built for this segment. */
hp_freelist->cells = nfreelist;
{
/* Update the real freelist pointer to point to the head of
the list of free cells we've built for this segment. */
hp_freelist->cells = nfreelist;
#ifdef GUILE_NEW_GC_SCHEME
hp_freelist->n_objects = n_objects;
#endif
}
#ifdef GUILE_NEW_GC_SCHEME
j = span * (hp_freelist->gc_trigger - n_objects);
/* sum up---if this is last turn for this freelist */
hp_freelist->collected += n + j;
n -= j; /* compensate for the sum up */
#else
hp_freelist->collected += n;
#endif
scm_cells_allocated += hp_freelist->heap_size - hp_freelist->collected;
#ifdef GUILE_DEBUG_FREELIST
scm_check_freelist (hp_freelist);
scm_map_free_list ();
#endif
hp_freelist->collected += n;
scm_cells_allocated += hp_freelist->heap_size - hp_freelist->collected;
}
#ifdef GUILE_NEW_GC_SCHEME
for (i = 0; i < scm_n_heap_segs; i++)
{
scm_freelist_t *hp_freelist = scm_heap_table[i].freelistp;
if (hp_freelist->gc_trigger - hp_freelist->n_objects > 1)
{
SCM c = hp_freelist->cells;
SCM_SETCAR (c, SCM_CDR (c));
SCM_SETCDR (c, SCM_EOL);
*hp_freelist->clustertail = c;
hp_freelist->n_objects = hp_freelist->gc_trigger;
}
else
*hp_freelist->clustertail = SCM_EOL;
#if 0
fprintf (stderr, "%d:%d: ",
i, scm_ilength (hp_freelist->clusters));
{
SCM ls, c = hp_freelist->clusters;
int n;
while (SCM_NNULLP (c))
{
ls = SCM_CAR (c);
for (n = 0; SCM_NNULLP (ls); ls = SCM_CDR (ls))
++n;
fprintf (stderr, "%d ", n);
c = SCM_CDR (c);
}
fprintf (stderr, "\n");
}
#endif
}
#endif
/* Scan weak vectors. */
{
SCM *ptr, w;
@ -1698,6 +1891,58 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelistp)
/*n_new_cells*/
n_new_cells = seg_end - ptr;
#ifdef GUILE_NEW_GC_SCHEME
freelistp->heap_size += n_new_cells;
/* Partition objects in this segment into clusters
*/
{
SCM clusters;
SCM *clusterp = &clusters;
int trigger = span * freelistp->gc_trigger;
int n, c = 0;
while (n_new_cells > span)
{
if (n_new_cells > trigger)
n = span + trigger;
else
n = n_new_cells;
n_new_cells -= n;
n -= span;
c += span;
*clusterp = PTR2SCM (ptr);
SCM_SETCAR (*clusterp, PTR2SCM (ptr + span));
clusterp = SCM_CDRLOC (*clusterp);
ptr += span;
seg_end = ptr + n;
while (ptr < seg_end)
{
#ifdef SCM_POINTERS_MUNGED
scmptr = PTR2SCM (ptr);
#endif
SCM_SETCAR (scmptr, scm_tc_free_cell);
SCM_SETCDR (scmptr, PTR2SCM (ptr + span));
ptr += span;
}
SCM_SETCDR (PTR2SCM (ptr - span), SCM_EOL);
}
/* Correction for cluster cells + spill */
freelistp->heap_size -= c + n_new_cells;
/* Patch up the last cluster pointer in the segment
* to join it to the input freelist.
*/
*clusterp = freelistp->clusters;
freelistp->clusters = clusters;
}
#else /* GUILE_NEW_GC_SCHEME */
/* Prepend objects in this segment to the freelist.
*/
while (ptr < seg_end)
@ -1719,6 +1964,9 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelistp)
freelistp->cells = PTR2SCM (CELL_UP (seg_org));
freelistp->heap_size += n_new_cells;
#endif /* GUILE_NEW_GC_SCHEME */
return size;
#ifdef scmptr
#undef scmptr
@ -1963,8 +2211,14 @@ make_initial_segment (scm_sizet init_heap_size, scm_freelist_t *freelistp)
}
#ifdef GUILE_NEW_GC_SCHEME
int
scm_init_storage (scm_sizet init_heap_size, int triggerp, int gc_trigger,
scm_sizet init_heap2_size, int triggerp2, int gc_trigger2)
#else
int
scm_init_storage (scm_sizet init_heap_size, scm_sizet init_heap2_size)
#endif
{
scm_sizet j;
@ -1972,14 +2226,41 @@ scm_init_storage (scm_sizet init_heap_size, scm_sizet init_heap2_size)
while (j)
scm_sys_protects[--j] = SCM_BOOL_F;
scm_block_gc = 1;
#ifdef GUILE_NEW_GC_SCHEME
scm_freelist = SCM_EOL;
scm_master_freelist.clusters = SCM_EOL;
scm_master_freelist.triggeredp = 0;
scm_master_freelist.triggerp = triggerp;
scm_master_freelist.gc_trigger
= gc_trigger ? gc_trigger : SCM_GC_TRIGGER;
scm_master_freelist.span = 1;
scm_master_freelist.collected = 0;
scm_master_freelist.heap_size = 0;
#else
scm_freelist.cells = SCM_EOL;
scm_freelist.span = 1;
scm_freelist.collected = 0;
scm_freelist.heap_size = 0;
#endif
#ifdef GUILE_NEW_GC_SCHEME
scm_freelist2 = SCM_EOL;
scm_master_freelist2.clusters = SCM_EOL;
scm_master_freelist2.triggeredp = 0;
scm_master_freelist2.triggerp = triggerp2;
scm_master_freelist2.gc_trigger
= gc_trigger2 ? gc_trigger2 : SCM_GC_TRIGGER2;
scm_master_freelist2.span = 2;
scm_master_freelist2.collected = 0;
scm_master_freelist2.heap_size = 0;
#else
scm_freelist2.cells = SCM_EOL;
scm_freelist2.span = 2;
scm_freelist2.collected = 0;
scm_freelist2.heap_size = 0;
#endif
scm_expmem = 0;
j = SCM_HEAP_SEG_SIZE;
@ -1987,9 +2268,15 @@ scm_init_storage (scm_sizet init_heap_size, scm_sizet init_heap2_size)
scm_heap_table = ((struct scm_heap_seg_data *)
scm_must_malloc (sizeof (struct scm_heap_seg_data) * 2, "hplims"));
#ifdef GUILE_NEW_GC_SCHEME
if (make_initial_segment (init_heap_size, &scm_master_freelist) ||
make_initial_segment (init_heap2_size, &scm_master_freelist2))
return 1;
#else
if (make_initial_segment (init_heap_size, &scm_freelist) ||
make_initial_segment (init_heap2_size, &scm_freelist2))
return 1;
#endif
scm_heap_org = CELL_UP (scm_heap_table[0].bounds[0]);

30
libguile/gc.h
View file

@ -69,6 +69,20 @@ extern int scm_gc_heap_lock;
typedef struct scm_freelist_t {
SCM cells;
#ifdef GUILE_NEW_GC_SCHEME
int n_objects;
/* a list of freelists, each of size gc_trigger,
except the last one which may be shorter */
SCM clusters;
SCM *clustertail;
/* GC trigger */
int triggeredp;
/* trigger GC ? */
int triggerp;
/* minimum number of objects allocated before GC is triggered
and cluster size. */
int gc_trigger;
#endif
/* number of cells per object on this list */
int span;
/* number of collected cells during last GC */
@ -81,8 +95,15 @@ typedef struct scm_freelist_t {
extern unsigned long scm_heap_size;
extern SCM_CELLPTR scm_heap_org;
#ifdef GUILE_NEW_GC_SCHEME
extern SCM scm_freelist;
extern scm_freelist_t scm_master_freelist;
extern SCM scm_freelist2;
extern scm_freelist_t scm_master_freelist2;
#else
extern scm_freelist_t scm_freelist;
extern scm_freelist_t scm_freelist2;
#endif
extern unsigned long scm_gc_cells_collected;
extern unsigned long scm_gc_malloc_collected;
extern unsigned long scm_gc_ports_collected;
@ -106,7 +127,11 @@ extern void scm_gc_start (const char *what);
extern void scm_gc_end (void);
extern SCM scm_gc (void);
extern void scm_gc_for_alloc (scm_freelist_t *freelistp);
#ifdef GUILE_NEW_GC_SCHEME
extern SCM scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist);
#else
extern SCM scm_gc_for_newcell (scm_freelist_t *freelistp);
#endif
extern void scm_igc (const char *what);
extern void scm_gc_mark (SCM p);
extern void scm_mark_locations (SCM_STACKITEM x[], scm_sizet n);
@ -124,7 +149,12 @@ extern int scm_return_first_int (int x, ...);
extern SCM scm_permanent_object (SCM obj);
extern SCM scm_protect_object (SCM obj);
extern SCM scm_unprotect_object (SCM obj);
#ifdef GUILE_NEW_GC_SCHEME
extern int scm_init_storage (scm_sizet init_heap_size, int tp, int trig,
scm_sizet init_heap2_size, int tp2, int trig2);
#else
extern int scm_init_storage (scm_sizet init_heap_size,
scm_sizet init_heap2_size);
#endif
extern void scm_init_gc (void);
#endif /* GCH */

16
libguile/init.c
View file

@ -474,9 +474,19 @@ scm_boot_guile_1 (SCM_STACKITEM *base, struct main_func_closure *closure)
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_tables_prehistory ();
#if GUILE_DEBUG
scm_init_storage (scm_i_getenv_int ("GUILE_INIT_HEAP_SIZE", 0),
scm_i_getenv_int ("GUILE_INIT_HEAP_SIZE2", 0));
#if defined (GUILE_DEBUG) && defined (GUILE_NEW_GC_SCHEME)
{
int gc_trigger = scm_i_getenv_int ("GUILE_GC_TRIGGER", 0);
int gc_trigger2 = scm_i_getenv_int ("GUILE_GC_TRIGGER2", 0);
scm_init_storage (scm_i_getenv_int ("GUILE_INIT_HEAP_SIZE", 0),
/* default: trigger */
gc_trigger >= 0 ? 1 : 0,
gc_trigger < 0 ? - gc_trigger : gc_trigger,
scm_i_getenv_int ("GUILE_INIT_HEAP_SIZE2", 40000),
/* default: don't trigger GC */
gc_trigger2 > 0 ? 1 : 0,
gc_trigger2 < 0 ? - gc_trigger2 : gc_trigger2);
}
#else
scm_init_storage (0, 0);
#endif

30
libguile/pairs.h
View file

@ -179,6 +179,35 @@ typedef SCM huge *SCMPTR;
#define SCM_NEWCELL(_into) do { _into = scm_debug_newcell (); } while (0)
#define SCM_NEWCELL2(_into) do { _into = scm_debug_newcell2 (); } while (0)
#else
#ifdef GUILE_NEW_GC_SCHEME
/* When we introduce POSIX threads support, every thread will have
a freelist of its own. Then it won't any longer be necessary to
initialize cells with scm_tc16_allocated. */
#define SCM_NEWCELL(_into) \
do { \
if (SCM_IMP (scm_freelist)) \
_into = scm_gc_for_newcell (&scm_master_freelist, \
&scm_freelist); \
else \
{ \
_into = scm_freelist; \
scm_freelist = SCM_CDR (scm_freelist);\
SCM_SETCAR (_into, scm_tc16_allocated); \
} \
} while(0)
#define SCM_NEWCELL2(_into) \
do { \
if (SCM_IMP (scm_freelist2)) \
_into = scm_gc_for_newcell (&scm_master_freelist2, \
&scm_freelist2); \
else \
{ \
_into = scm_freelist2; \
scm_freelist2 = SCM_CDR (scm_freelist2);\
SCM_SETCAR (_into, scm_tc16_allocated); \
} \
} while(0)
#else /* GUILE_NEW_GC_SCHEME */
#define SCM_NEWCELL(_into) \
do { \
if (SCM_IMP (scm_freelist.cells)) \
@ -203,6 +232,7 @@ typedef SCM huge *SCMPTR;
scm_cells_allocated += 2; \
} \
} while(0)
#endif /* GUILE_NEW_GC_SCHEME */
#endif