summaryrefslogtreecommitdiff
path: root/libguile/gc.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/gc.c')
-rw-r--r--libguile/gc.c420
1 files changed, 245 insertions, 175 deletions
diff --git a/libguile/gc.c b/libguile/gc.c
index 657346d84..3aaab5c0e 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -71,6 +71,7 @@
#include "libguile/tags.h"
#include "libguile/validate.h"
+#include "libguile/deprecation.h"
#include "libguile/gc.h"
#ifdef GUILE_DEBUG_MALLOC
@@ -124,7 +125,8 @@ scm_assert_cell_valid (SCM cell)
if (!scm_cellp (cell))
{
- fprintf (stderr, "scm_assert_cell_valid: Not a cell object: %lx\n", SCM_UNPACK (cell));
+ fprintf (stderr, "scm_assert_cell_valid: Not a cell object: %lux\n",
+ (unsigned long) SCM_UNPACK (cell));
abort ();
}
else if (!scm_gc_running_p)
@@ -140,7 +142,8 @@ scm_assert_cell_valid (SCM cell)
*/
if (SCM_FREE_CELL_P (cell))
{
- fprintf (stderr, "scm_assert_cell_valid: Accessing free cell: %lx\n", SCM_UNPACK (cell));
+ fprintf (stderr, "scm_assert_cell_valid: Accessing free cell: %lux\n",
+ (unsigned long) SCM_UNPACK (cell));
abort ();
}
}
@@ -187,7 +190,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
*
* If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE
* will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more
- * heap is needed. SCM_HEAP_SEG_SIZE must fit into type scm_sizet. This code
+ * heap is needed. SCM_HEAP_SEG_SIZE must fit into type size_t. This code
* is in scm_init_storage() and alloc_some_heap() in sys.c
*
* If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by
@@ -216,19 +219,19 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
#define SCM_DATA_CELLS2CARDS(n) (((n) + SCM_GC_CARD_N_DATA_CELLS - 1) / SCM_GC_CARD_N_DATA_CELLS)
#define SCM_CARDS_PER_CLUSTER SCM_DATA_CELLS2CARDS (2000L)
#define SCM_CLUSTER_SIZE_1 (SCM_CARDS_PER_CLUSTER * SCM_GC_CARD_N_DATA_CELLS)
-int scm_default_init_heap_size_1 = (((SCM_DATA_CELLS2CARDS (45000L) + SCM_CARDS_PER_CLUSTER - 1)
+size_t scm_default_init_heap_size_1 = (((SCM_DATA_CELLS2CARDS (45000L) + SCM_CARDS_PER_CLUSTER - 1)
/ SCM_CARDS_PER_CLUSTER) * SCM_GC_CARD_SIZE);
int scm_default_min_yield_1 = 40;
#define SCM_CLUSTER_SIZE_2 (SCM_CARDS_PER_CLUSTER * (SCM_GC_CARD_N_DATA_CELLS / 2))
-int scm_default_init_heap_size_2 = (((SCM_DATA_CELLS2CARDS (2500L * 2) + SCM_CARDS_PER_CLUSTER - 1)
+size_t scm_default_init_heap_size_2 = (((SCM_DATA_CELLS2CARDS (2500L * 2) + SCM_CARDS_PER_CLUSTER - 1)
/ SCM_CARDS_PER_CLUSTER) * SCM_GC_CARD_SIZE);
/* The following value may seem large, but note that if we get to GC at
* all, this means that we have a numerically intensive application
*/
int scm_default_min_yield_2 = 40;
-int scm_default_max_segment_size = 2097000L;/* a little less (adm) than 2 Mb */
+size_t scm_default_max_segment_size = 2097000L;/* a little less (adm) than 2 Mb */
#define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_CARD_SIZE)
#ifdef _QC
@@ -254,11 +257,11 @@ int scm_default_max_segment_size = 2097000L;/* a little less (adm) than 2 Mb */
# define CELL_DN(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&FP_OFF(p))
#else
# ifdef _UNICOS
-# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((long)(p)+(span)))
-# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (long)(p))
+# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((scm_ubits_t)(p)+(span)))
+# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (scm_ubits_t)(p))
# else
-# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & ((long)(p)+sizeof(scm_cell)*(span)-1L))
-# define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & (long)(p))
+# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & ((scm_ubits_t)(p)+sizeof(scm_cell)*(span)-1L))
+# define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & (scm_ubits_t)(p))
# endif /* UNICOS */
#endif /* PROT386 */
@@ -285,7 +288,7 @@ typedef struct scm_freelist_t {
SCM clusters;
SCM *clustertail;
/* this is the number of objects in each cluster, including the spine cell */
- int cluster_size;
+ unsigned int cluster_size;
/* indicates that we should grow heap instead of GC:ing
*/
int grow_heap_p;
@@ -298,13 +301,13 @@ typedef struct scm_freelist_t {
/* number of cells per object on this list */
int span;
/* number of collected cells during last GC */
- long collected;
+ scm_ubits_t collected;
/* number of collected cells during penultimate GC */
- long collected_1;
+ scm_ubits_t collected_1;
/* total number of cells in heap segments
* belonging to this list.
*/
- long heap_size;
+ scm_ubits_t heap_size;
} scm_freelist_t;
SCM scm_freelist = SCM_EOL;
@@ -319,7 +322,7 @@ scm_freelist_t scm_master_freelist2 = {
/* scm_mtrigger
* is the number of bytes of must_malloc allocation needed to trigger gc.
*/
-unsigned long scm_mtrigger;
+scm_ubits_t scm_mtrigger;
/* scm_gc_heap_lock
* If set, don't expand the heap. Set only during gc, during which no allocation
@@ -344,20 +347,20 @@ SCM scm_structs_to_free;
/* GC Statistics Keeping
*/
-unsigned long scm_cells_allocated = 0;
-long scm_mallocated = 0;
-unsigned long scm_gc_cells_collected;
-unsigned long scm_gc_yield;
-static unsigned long scm_gc_yield_1 = 0; /* previous GC yield */
-unsigned long scm_gc_malloc_collected;
-unsigned long scm_gc_ports_collected;
+scm_ubits_t scm_cells_allocated = 0;
+scm_ubits_t scm_mallocated = 0;
+scm_ubits_t scm_gc_cells_collected;
+scm_ubits_t scm_gc_yield;
+static scm_ubits_t scm_gc_yield_1 = 0; /* previous GC yield */
+scm_ubits_t scm_gc_malloc_collected;
+scm_ubits_t scm_gc_ports_collected;
unsigned long scm_gc_time_taken = 0;
-static unsigned long t_before_gc;
-static unsigned long t_before_sweep;
+static scm_ubits_t t_before_gc;
+static scm_ubits_t t_before_sweep;
unsigned long scm_gc_mark_time_taken = 0;
unsigned long scm_gc_sweep_time_taken = 0;
-unsigned long scm_gc_times = 0;
-unsigned long scm_gc_cells_swept = 0;
+scm_ubits_t scm_gc_times = 0;
+scm_ubits_t scm_gc_cells_swept = 0;
double scm_gc_cells_marked_acc = 0.;
double scm_gc_cells_swept_acc = 0.;
@@ -388,7 +391,7 @@ typedef struct scm_heap_seg_data_t
-static scm_sizet init_heap_seg (SCM_CELLPTR, scm_sizet, scm_freelist_t *);
+static size_t init_heap_seg (SCM_CELLPTR, size_t, scm_freelist_t *);
typedef enum { return_on_error, abort_on_error } policy_on_error;
static void alloc_some_heap (scm_freelist_t *, policy_on_error);
@@ -412,7 +415,7 @@ typedef struct scm_mark_space_t
static scm_mark_space_t *current_mark_space;
static scm_mark_space_t **mark_space_ptr;
-static int current_mark_space_offset;
+static ptrdiff_t current_mark_space_offset;
static scm_mark_space_t *mark_space_head;
static scm_c_bvec_limb_t *
@@ -479,17 +482,17 @@ clear_mark_space ()
#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
/* Return the number of the heap segment containing CELL. */
-static int
+static scm_bits_t
which_seg (SCM cell)
{
- int i;
+ scm_bits_t i;
for (i = 0; i < scm_n_heap_segs; i++)
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], SCM2PTR (cell))
&& SCM_PTR_GT (scm_heap_table[i].bounds[1], SCM2PTR (cell)))
return i;
- fprintf (stderr, "which_seg: can't find segment containing cell %lx\n",
- SCM_UNPACK (cell));
+ fprintf (stderr, "which_seg: can't find segment containing cell %lux\n",
+ (unsigned long) SCM_UNPACK (cell));
abort ();
}
@@ -497,26 +500,26 @@ which_seg (SCM cell)
static void
map_free_list (scm_freelist_t *master, SCM freelist)
{
- int last_seg = -1, count = 0;
+ scm_bits_t last_seg = -1, count = 0;
SCM f;
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f))
{
- int this_seg = which_seg (f);
+ scm_bits_t this_seg = which_seg (f);
if (this_seg != last_seg)
{
if (last_seg != -1)
- fprintf (stderr, " %5d %d-cells in segment %d\n",
- count, master->span, last_seg);
+ fprintf (stderr, " %5ld %d-cells in segment %ld\n",
+ (long) count, master->span, (long) last_seg);
last_seg = this_seg;
count = 0;
}
count++;
}
if (last_seg != -1)
- fprintf (stderr, " %5d %d-cells in segment %d\n",
- count, master->span, last_seg);
+ fprintf (stderr, " %5ld %d-cells in segment %ld\n",
+ (long) count, master->span, (long) last_seg);
}
SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
@@ -526,15 +529,15 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
"@code{--enable-guile-debug} builds of Guile.")
#define FUNC_NAME s_scm_map_free_list
{
- int i;
- fprintf (stderr, "%d segments total (%d:%d",
- scm_n_heap_segs,
+ scm_bits_t i;
+ fprintf (stderr, "%ld segments total (%d:%ld",
+ (long) scm_n_heap_segs,
scm_heap_table[0].span,
- scm_heap_table[0].bounds[1] - scm_heap_table[0].bounds[0]);
+ (long) (scm_heap_table[0].bounds[1] - scm_heap_table[0].bounds[0]));
for (i = 1; i < scm_n_heap_segs; i++)
- fprintf (stderr, ", %d:%d",
+ fprintf (stderr, ", %d:%ld",
scm_heap_table[i].span,
- scm_heap_table[i].bounds[1] - scm_heap_table[i].bounds[0]);
+ (long) (scm_heap_table[i].bounds[1] - scm_heap_table[i].bounds[0]));
fprintf (stderr, ")\n");
map_free_list (&scm_master_freelist, scm_freelist);
map_free_list (&scm_master_freelist2, scm_freelist2);
@@ -544,20 +547,20 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
}
#undef FUNC_NAME
-static int last_cluster;
-static int last_size;
+static scm_bits_t last_cluster;
+static scm_bits_t last_size;
-static int
-free_list_length (char *title, int i, SCM freelist)
+static scm_bits_t
+free_list_length (char *title, scm_bits_t i, SCM freelist)
{
SCM ls;
- int n = 0;
+ scm_bits_t n = 0;
for (ls = freelist; !SCM_NULLP (ls); ls = SCM_FREE_CELL_CDR (ls))
if (SCM_FREE_CELL_P (ls))
++n;
else
{
- fprintf (stderr, "bad cell in %s at position %d\n", title, n);
+ fprintf (stderr, "bad cell in %s at position %ld\n", title, (long) n);
abort ();
}
if (n != last_size)
@@ -565,14 +568,14 @@ free_list_length (char *title, int i, SCM freelist)
if (i > 0)
{
if (last_cluster == i - 1)
- fprintf (stderr, "\t%d\n", last_size);
+ fprintf (stderr, "\t%ld\n", (long) last_size);
else
- fprintf (stderr, "-%d\t%d\n", i - 1, last_size);
+ fprintf (stderr, "-%ld\t%ld\n", (long) (i - 1), (long) last_size);
}
if (i >= 0)
- fprintf (stderr, "%s %d", title, i);
+ fprintf (stderr, "%s %ld", title, (long) i);
else
- fprintf (stderr, "%s\t%d\n", title, n);
+ fprintf (stderr, "%s\t%ld\n", title, (long) n);
last_cluster = i;
last_size = n;
}
@@ -583,7 +586,7 @@ static void
free_list_lengths (char *title, scm_freelist_t *master, SCM freelist)
{
SCM clusters;
- int i = 0, len, n = 0;
+ scm_bits_t i = 0, len, n = 0;
fprintf (stderr, "%s\n\n", title);
n += free_list_length ("free list", -1, freelist);
for (clusters = master->clusters;
@@ -594,10 +597,10 @@ free_list_lengths (char *title, scm_freelist_t *master, SCM freelist)
n += len;
}
if (last_cluster == i - 1)
- fprintf (stderr, "\t%d\n", last_size);
+ fprintf (stderr, "\t%ld\n", (long) last_size);
else
- fprintf (stderr, "-%d\t%d\n", i - 1, last_size);
- fprintf (stderr, "\ntotal %d objects\n\n", n);
+ fprintf (stderr, "-%ld\t%ld\n", (long) (i - 1), (long) last_size);
+ fprintf (stderr, "\ntotal %ld objects\n\n", (long) n);
}
SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0,
@@ -622,8 +625,8 @@ SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0,
static int scm_debug_check_freelist = 0;
/* Number of calls to SCM_NEWCELL since startup. */
-static unsigned long scm_newcell_count;
-static unsigned long scm_newcell2_count;
+static scm_ubits_t scm_newcell_count;
+static scm_ubits_t scm_newcell2_count;
/* Search freelist for anything that isn't marked as a free cell.
Abort if we find something. */
@@ -631,13 +634,13 @@ static void
scm_check_freelist (SCM freelist)
{
SCM f;
- int i = 0;
+ scm_bits_t i = 0;
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f), i++)
if (!SCM_FREE_CELL_P (f))
{
- fprintf (stderr, "Bad cell in freelist on newcell %lu: %d'th elt\n",
- scm_newcell_count, i);
+ fprintf (stderr, "Bad cell in freelist on newcell %lu: %lu'th elt\n",
+ (long) scm_newcell_count, (long) i);
abort ();
}
}
@@ -719,26 +722,26 @@ scm_debug_newcell2 (void)
-static unsigned long
+static scm_ubits_t
master_cells_allocated (scm_freelist_t *master)
{
/* the '- 1' below is to ignore the cluster spine cells. */
- int objects = master->clusters_allocated * (master->cluster_size - 1);
+ scm_bits_t objects = master->clusters_allocated * (master->cluster_size - 1);
if (SCM_NULLP (master->clusters))
objects -= master->left_to_collect;
return master->span * objects;
}
-static unsigned long
+static scm_ubits_t
freelist_length (SCM freelist)
{
- int n;
+ scm_bits_t n;
for (n = 0; !SCM_NULLP (freelist); freelist = SCM_FREE_CELL_CDR (freelist))
++n;
return n;
}
-static unsigned long
+static scm_ubits_t
compute_cells_allocated ()
{
return (scm_cells_allocated
@@ -757,17 +760,17 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
"use of storage.")
#define FUNC_NAME s_scm_gc_stats
{
- int i;
- int n;
+ scm_bits_t i;
+ scm_bits_t n;
SCM heap_segs;
- long int local_scm_mtrigger;
- long int local_scm_mallocated;
- long int local_scm_heap_size;
- long int local_scm_cells_allocated;
- long int local_scm_gc_time_taken;
- long int local_scm_gc_times;
- long int local_scm_gc_mark_time_taken;
- long int local_scm_gc_sweep_time_taken;
+ scm_ubits_t local_scm_mtrigger;
+ scm_ubits_t local_scm_mallocated;
+ scm_ubits_t local_scm_heap_size;
+ scm_ubits_t local_scm_cells_allocated;
+ unsigned long local_scm_gc_time_taken;
+ scm_ubits_t local_scm_gc_times;
+ unsigned long local_scm_gc_mark_time_taken;
+ unsigned long local_scm_gc_sweep_time_taken;
double local_scm_gc_cells_swept;
double local_scm_gc_cells_marked;
SCM answer;
@@ -780,8 +783,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
heap_segs = SCM_EOL;
n = scm_n_heap_segs;
for (i = scm_n_heap_segs; i--; )
- heap_segs = scm_cons (scm_cons (scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[1]),
- scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[0])),
+ heap_segs = scm_cons (scm_cons (scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[1]),
+ scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[0])),
heap_segs);
if (scm_n_heap_segs != n)
goto retry;
@@ -803,15 +806,15 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
local_scm_gc_cells_marked = scm_gc_cells_marked_acc;
answer = scm_listify (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)),
- scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)),
- scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)),
- scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)),
- scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)),
- scm_cons (sym_times, scm_ulong2num (local_scm_gc_times)),
+ scm_cons (sym_cells_allocated, scm_ubits2num (local_scm_cells_allocated)),
+ scm_cons (sym_heap_size, scm_ubits2num (local_scm_heap_size)),
+ scm_cons (sym_mallocated, scm_ubits2num (local_scm_mallocated)),
+ scm_cons (sym_mtrigger, scm_ubits2num (local_scm_mtrigger)),
+ scm_cons (sym_times, scm_ubits2num (local_scm_gc_times)),
scm_cons (sym_gc_mark_time_taken, scm_ulong2num (local_scm_gc_mark_time_taken)),
scm_cons (sym_gc_sweep_time_taken, scm_ulong2num (local_scm_gc_sweep_time_taken)),
- scm_cons (sym_cells_marked, scm_dbl2big (local_scm_gc_cells_marked)),
- scm_cons (sym_cells_swept, scm_dbl2big (local_scm_gc_cells_swept)),
+ scm_cons (sym_cells_marked, scm_i_dbl2big (local_scm_gc_cells_marked)),
+ scm_cons (sym_cells_swept, scm_i_dbl2big (local_scm_gc_cells_swept)),
scm_cons (sym_heap_segments, heap_segs),
SCM_UNDEFINED);
SCM_ALLOW_INTS;
@@ -854,7 +857,7 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
"returned by this function for @var{obj}")
#define FUNC_NAME s_scm_object_address
{
- return scm_ulong2num ((unsigned long) SCM_UNPACK (obj));
+ return scm_ubits2num (SCM_UNPACK (obj));
}
#undef FUNC_NAME
@@ -897,12 +900,12 @@ adjust_min_yield (scm_freelist_t *freelist)
if (freelist->min_yield_fraction)
{
/* Pick largest of last two yields. */
- int delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100)
+ long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100)
- (long) SCM_MAX (scm_gc_yield_1, scm_gc_yield));
#ifdef DEBUGINFO
- fprintf (stderr, " after GC = %d, delta = %d\n",
- scm_cells_allocated,
- delta);
+ fprintf (stderr, " after GC = %lu, delta = %ld\n",
+ (long) scm_cells_allocated,
+ (long) delta);
#endif
if (delta > 0)
freelist->min_yield += delta;
@@ -939,10 +942,10 @@ scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
* both cases we have to try gc to get some free cells.
*/
#ifdef DEBUGINFO
- fprintf (stderr, "allocated = %d, ",
- scm_cells_allocated
+ fprintf (stderr, "allocated = %lu, ",
+ (long) (scm_cells_allocated
+ master_cells_allocated (&scm_master_freelist)
- + master_cells_allocated (&scm_master_freelist2));
+ + master_cells_allocated (&scm_master_freelist2)));
#endif
scm_igc ("cells");
adjust_min_yield (master);
@@ -999,7 +1002,7 @@ scm_c_hook_t scm_after_gc_c_hook;
void
scm_igc (const char *what)
{
- int j;
+ scm_bits_t j;
++scm_gc_running_p;
scm_c_hook_run (&scm_before_gc_c_hook, 0);
@@ -1022,14 +1025,6 @@ scm_igc (const char *what)
gc_start_stats (what);
- if (scm_mallocated < 0)
- /* The byte count of allocated objects has underflowed. This is
- probably because you forgot to report the sizes of objects you
- have allocated, by calling scm_done_malloc or some such. When
- the GC freed them, it subtracted their size from
- scm_mallocated, which underflowed. */
- abort ();
-
if (scm_gc_heap_lock)
/* We've invoked the collector while a GC is already in progress.
That should never happen. */
@@ -1039,8 +1034,8 @@ scm_igc (const char *what)
/* flush dead entries from the continuation stack */
{
- int x;
- int bound;
+ scm_bits_t x;
+ scm_bits_t bound;
SCM * elts;
elts = SCM_VELTS (scm_continuation_stack);
bound = SCM_VECTOR_LENGTH (scm_continuation_stack);
@@ -1063,12 +1058,12 @@ scm_igc (const char *what)
/* This assumes that all registers are saved into the jmp_buf */
setjmp (scm_save_regs_gc_mark);
scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
- ( (scm_sizet) (sizeof (SCM_STACKITEM) - 1 +
+ ( (size_t) (sizeof (SCM_STACKITEM) - 1 +
sizeof scm_save_regs_gc_mark)
/ sizeof (SCM_STACKITEM)));
{
- scm_sizet stack_len = scm_stack_size (scm_stack_base);
+ size_t stack_len = scm_stack_size (scm_stack_base);
#ifdef SCM_STACK_GROWS_UP
scm_mark_locations (scm_stack_base, stack_len);
#else
@@ -1129,7 +1124,7 @@ void
MARK (SCM p)
#define FUNC_NAME FNAME
{
- register long i;
+ register scm_bits_t i;
register SCM ptr;
scm_bits_t cell_type;
@@ -1238,7 +1233,7 @@ gc_mark_loop_first_time:
{
/* ptr is a struct */
SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
- int len = SCM_SYMBOL_LENGTH (layout);
+ scm_bits_t len = SCM_SYMBOL_LENGTH (layout);
char * fields_desc = SCM_SYMBOL_CHARS (layout);
scm_bits_t * struct_data = (scm_bits_t *) SCM_STRUCT_DATA (ptr);
@@ -1249,7 +1244,7 @@ gc_mark_loop_first_time:
}
if (len)
{
- int x;
+ scm_bits_t x;
for (x = 0; x < len - 2; x += 2, ++struct_data)
if (fields_desc[x] == 'p')
@@ -1290,8 +1285,8 @@ gc_mark_loop_first_time:
#ifdef CCLO
case scm_tc7_cclo:
{
- unsigned long int i = SCM_CCLO_LENGTH (ptr);
- unsigned long int j;
+ size_t i = SCM_CCLO_LENGTH (ptr);
+ size_t j;
for (j = 1; j != i; ++j)
{
SCM obj = SCM_CCLO_REF (ptr, j);
@@ -1327,8 +1322,8 @@ gc_mark_loop_first_time:
scm_weak_vectors = ptr;
if (SCM_IS_WHVEC_ANY (ptr))
{
- int x;
- int len;
+ scm_bits_t x;
+ scm_bits_t len;
int weak_keys;
int weak_values;
@@ -1454,9 +1449,9 @@ gc_mark_loop_first_time:
*/
void
-scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
+scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n)
{
- unsigned long m;
+ scm_ubits_t m;
for (m = 0; m < n; ++m)
{
@@ -1464,14 +1459,14 @@ scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
if (SCM_CELLP (obj))
{
SCM_CELLPTR ptr = SCM2PTR (obj);
- int i = 0;
- int j = scm_n_heap_segs - 1;
+ scm_bits_t i = 0;
+ scm_bits_t j = scm_n_heap_segs - 1;
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
&& SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
{
while (i <= j)
{
- int seg_id;
+ scm_bits_t seg_id;
seg_id = -1;
if ((i == j)
|| SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr))
@@ -1480,7 +1475,7 @@ scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
seg_id = j;
else
{
- int k;
+ scm_bits_t k;
k = (i + j) / 2;
if (k == i)
break;
@@ -1528,14 +1523,14 @@ scm_cellp (SCM value)
{
if (SCM_CELLP (value)) {
scm_cell * ptr = SCM2PTR (value);
- unsigned int i = 0;
- unsigned int j = scm_n_heap_segs - 1;
+ scm_bits_t i = 0;
+ scm_bits_t j = scm_n_heap_segs - 1;
if (SCM_GC_IN_CARD_HEADERP (ptr))
return 0;
while (i < j) {
- int k = (i + j) / 2;
+ scm_bits_t k = (i + j) / 2;
if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) {
j = k;
} else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) {
@@ -1571,7 +1566,7 @@ gc_sweep_freelist_start (scm_freelist_t *freelist)
static void
gc_sweep_freelist_finish (scm_freelist_t *freelist)
{
- int collected;
+ scm_bits_t collected;
*freelist->clustertail = freelist->cells;
if (!SCM_NULLP (freelist->cells))
{
@@ -1609,10 +1604,10 @@ scm_gc_sweep ()
register SCM_CELLPTR ptr;
register SCM nfreelist;
register scm_freelist_t *freelist;
- register long m;
+ register scm_ubits_t m;
register int span;
- long i;
- scm_sizet seg_size;
+ scm_bits_t i;
+ size_t seg_size;
m = 0;
@@ -1621,8 +1616,8 @@ scm_gc_sweep ()
for (i = 0; i < scm_n_heap_segs; i++)
{
- register unsigned int left_to_collect;
- register scm_sizet j;
+ register scm_bits_t left_to_collect;
+ register size_t j;
/* Unmarked cells go onto the front of the freelist this heap
segment points to. Rather than updating the real freelist
@@ -1700,7 +1695,7 @@ scm_gc_sweep ()
break;
case scm_tc7_vector:
{
- unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
+ scm_ubits_t length = SCM_VECTOR_LENGTH (scmptr);
if (length > 0)
{
m += length * sizeof (scm_bits_t);
@@ -1717,10 +1712,10 @@ scm_gc_sweep ()
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
{
- unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
+ size_t length = SCM_BITVECTOR_LENGTH (scmptr);
if (length > 0)
{
- m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
+ m += sizeof (long) * ((length + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH);
scm_must_free (SCM_BITVECTOR_BASE (scmptr));
}
}
@@ -1832,7 +1827,7 @@ scm_gc_sweep ()
#ifdef GC_FREE_SEGMENTS
if (n == seg_size)
{
- register long j;
+ register scm_bits_t j;
freelist->heap_size -= seg_size;
free ((char *) scm_heap_table[i].bounds[0]);
@@ -1866,6 +1861,15 @@ scm_gc_sweep ()
scm_cells_allocated = (SCM_HEAP_SIZE - scm_gc_cells_collected);
scm_gc_yield -= scm_cells_allocated;
+
+ if (scm_mallocated < m)
+ /* The byte count of allocated objects has underflowed. This is
+ probably because you forgot to report the sizes of objects you
+ have allocated, by calling scm_done_malloc or some such. When
+ the GC freed them, it subtracted their size from
+ scm_mallocated, which underflowed. */
+ abort ();
+
scm_mallocated -= m;
scm_gc_malloc_collected = m;
}
@@ -1896,10 +1900,16 @@ scm_gc_sweep ()
* The limit scm_mtrigger may be raised by this allocation.
*/
void *
-scm_must_malloc (scm_sizet size, const char *what)
+scm_must_malloc (size_t size, const char *what)
{
void *ptr;
- unsigned long nm = scm_mallocated + size;
+ scm_ubits_t nm = scm_mallocated + size;
+
+ if (nm < size)
+ /* The byte count of allocated objects has overflowed. This is
+ probably because you forgot to report the correct size of freed
+ memory in some of your smob free methods. */
+ abort ();
if (nm <= scm_mtrigger)
{
@@ -1917,6 +1927,13 @@ scm_must_malloc (scm_sizet size, const char *what)
scm_igc (what);
nm = scm_mallocated + size;
+
+ if (nm < size)
+ /* The byte count of allocated objects has overflowed. This is
+ probably because you forgot to report the correct size of freed
+ memory in some of your smob free methods. */
+ abort ();
+
SCM_SYSCALL (ptr = malloc (size));
if (NULL != ptr)
{
@@ -1943,12 +1960,23 @@ scm_must_malloc (scm_sizet size, const char *what)
*/
void *
scm_must_realloc (void *where,
- scm_sizet old_size,
- scm_sizet size,
+ size_t old_size,
+ size_t size,
const char *what)
{
void *ptr;
- scm_sizet nm = scm_mallocated + size - old_size;
+ scm_ubits_t nm;
+
+ if (size <= old_size)
+ return where;
+
+ nm = scm_mallocated + size - old_size;
+
+ if (nm < (size - old_size))
+ /* The byte count of allocated objects has overflowed. This is
+ probably because you forgot to report the correct size of freed
+ memory in some of your smob free methods. */
+ abort ();
if (nm <= scm_mtrigger)
{
@@ -1966,6 +1994,13 @@ scm_must_realloc (void *where,
scm_igc (what);
nm = scm_mallocated + size - old_size;
+
+ if (nm < (size - old_size))
+ /* The byte count of allocated objects has overflowed. This is
+ probably because you forgot to report the correct size of freed
+ memory in some of your smob free methods. */
+ abort ();
+
SCM_SYSCALL (ptr = realloc (where, size));
if (NULL != ptr)
{
@@ -1986,7 +2021,7 @@ scm_must_realloc (void *where,
}
char *
-scm_must_strndup (const char *str, unsigned long length)
+scm_must_strndup (const char *str, size_t length)
{
char * dst = scm_must_malloc (length + 1, "scm_must_strndup");
memcpy (dst, str, length);
@@ -2030,8 +2065,25 @@ scm_must_free (void *obj)
* eh? Or even better, call scm_done_free. */
void
-scm_done_malloc (long size)
+scm_done_malloc (scm_bits_t size)
{
+ if (size < 0) {
+ if (scm_mallocated < size)
+ /* The byte count of allocated objects has underflowed. This is
+ probably because you forgot to report the sizes of objects you
+ have allocated, by calling scm_done_malloc or some such. When
+ the GC freed them, it subtracted their size from
+ scm_mallocated, which underflowed. */
+ abort ();
+ } else {
+ scm_ubits_t nm = scm_mallocated + size;
+ if (nm < size)
+ /* The byte count of allocated objects has overflowed. This is
+ probably because you forgot to report the correct size of freed
+ memory in some of your smob free methods. */
+ abort ();
+ }
+
scm_mallocated += size;
if (scm_mallocated > scm_mtrigger)
@@ -2048,8 +2100,25 @@ scm_done_malloc (long size)
}
void
-scm_done_free (long size)
+scm_done_free (scm_bits_t size)
{
+ if (size >= 0) {
+ if (scm_mallocated < size)
+ /* The byte count of allocated objects has underflowed. This is
+ probably because you forgot to report the sizes of objects you
+ have allocated, by calling scm_done_malloc or some such. When
+ the GC freed them, it subtracted their size from
+ scm_mallocated, which underflowed. */
+ abort ();
+ } else {
+ scm_ubits_t nm = scm_mallocated + size;
+ if (nm < size)
+ /* The byte count of allocated objects has overflowed. This is
+ probably because you forgot to report the correct size of freed
+ memory in some of your smob free methods. */
+ abort ();
+ }
+
scm_mallocated -= size;
}
@@ -2071,7 +2140,7 @@ scm_done_free (long size)
*/
int scm_expmem = 0;
-scm_sizet scm_max_segment_size;
+size_t scm_max_segment_size;
/* scm_heap_org
* is the lowest base address of any heap segment.
@@ -2079,8 +2148,8 @@ scm_sizet scm_max_segment_size;
SCM_CELLPTR scm_heap_org;
scm_heap_seg_data_t * scm_heap_table = 0;
-static unsigned int heap_segment_table_size = 0;
-int scm_n_heap_segs = 0;
+static size_t heap_segment_table_size = 0;
+size_t scm_n_heap_segs = 0;
/* init_heap_seg
* initializes a new heap segment and returns the number of objects it contains.
@@ -2100,13 +2169,13 @@ int scm_n_heap_segs = 0;
SCM_GC_SET_CARD_DOUBLECELL (card); \
} while (0)
-static scm_sizet
-init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
+static size_t
+init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_freelist_t *freelist)
{
register SCM_CELLPTR ptr;
SCM_CELLPTR seg_end;
- int new_seg_index;
- int n_new_cells;
+ scm_bits_t new_seg_index;
+ ptrdiff_t n_new_cells;
int span = freelist->span;
if (seg_org == NULL)
@@ -2214,10 +2283,10 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
return size;
}
-static scm_sizet
-round_to_cluster_size (scm_freelist_t *freelist, scm_sizet len)
+static size_t
+round_to_cluster_size (scm_freelist_t *freelist, size_t len)
{
- scm_sizet cluster_size_in_bytes = CLUSTER_SIZE_IN_BYTES (freelist);
+ size_t cluster_size_in_bytes = CLUSTER_SIZE_IN_BYTES (freelist);
return
(len + cluster_size_in_bytes - 1) / cluster_size_in_bytes * cluster_size_in_bytes
@@ -2229,7 +2298,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
#define FUNC_NAME "alloc_some_heap"
{
SCM_CELLPTR ptr;
- long len;
+ size_t len;
if (scm_gc_heap_lock)
{
@@ -2246,9 +2315,9 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
* segment. Do not yet increment scm_n_heap_segs -- that is done by
* init_heap_seg only if the allocation of the segment itself succeeds.
*/
- unsigned int new_table_size = scm_n_heap_segs + 1;
+ size_t new_table_size = scm_n_heap_segs + 1;
size_t size = new_table_size * sizeof (scm_heap_seg_data_t);
- scm_heap_seg_data_t * new_heap_table;
+ scm_heap_seg_data_t *new_heap_table;
SCM_SYSCALL (new_heap_table = ((scm_heap_seg_data_t *)
realloc ((char *)scm_heap_table, size)));
@@ -2290,11 +2359,11 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
* This gives dh > (f * h - y) / (1 - f)
*/
int f = freelist->min_yield_fraction;
- long h = SCM_HEAP_SIZE;
- long min_cells = (f * h - 100 * (long) scm_gc_yield) / (99 - f);
+ scm_ubits_t h = SCM_HEAP_SIZE;
+ size_t min_cells = (f * h - 100 * (long) scm_gc_yield) / (99 - f);
len = SCM_EXPHEAP (freelist->heap_size);
#ifdef DEBUGINFO
- fprintf (stderr, "(%d < %d)", len, min_cells);
+ fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
#endif
if (len < min_cells)
len = min_cells + freelist->cluster_size;
@@ -2307,7 +2376,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
len = scm_max_segment_size;
{
- scm_sizet smallest;
+ size_t smallest;
smallest = CLUSTER_SIZE_IN_BYTES (freelist);
@@ -2318,7 +2387,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
while ((len >= SCM_MIN_HEAP_SEG_SIZE)
&& (len >= smallest))
{
- scm_sizet rounded_len = round_to_cluster_size (freelist, len);
+ size_t rounded_len = round_to_cluster_size (freelist, len);
SCM_SYSCALL (ptr = (SCM_CELLPTR) malloc (rounded_len));
if (ptr)
{
@@ -2391,7 +2460,8 @@ scm_remember_upto_here (SCM obj, ...)
void
scm_remember (SCM *ptr)
{
- /* empty */
+ scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
+ "Use the `scm_remember_upto_here*' family of functions instead.");
}
#endif /* SCM_DEBUG_DEPRECATED == 0 */
@@ -2450,7 +2520,7 @@ scm_protect_object (SCM obj)
SCM_REDEFER_INTS;
handle = scm_hashq_create_handle_x (scm_protects, obj, SCM_MAKINUM (0));
- SCM_SETCDR (handle, SCM_MAKINUM (SCM_INUM (SCM_CDR (handle)) + 1));
+ SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_MAKINUM (1)));
SCM_REALLOW_INTS;
@@ -2479,11 +2549,11 @@ scm_unprotect_object (SCM obj)
}
else
{
- unsigned long int count = SCM_INUM (SCM_CDR (handle)) - 1;
- if (count == 0)
+ SCM count = scm_difference (SCM_CDR (handle), SCM_MAKINUM (1));
+ if (SCM_EQ_P (count, SCM_MAKINUM (0)))
scm_hashq_remove_x (scm_protects, obj);
else
- SCM_SETCDR (handle, SCM_MAKINUM (count));
+ SCM_SETCDR (handle, count);
}
SCM_REALLOW_INTS;
@@ -2514,9 +2584,9 @@ cleanup (int status, void *arg)
static int
-make_initial_segment (scm_sizet init_heap_size, scm_freelist_t *freelist)
+make_initial_segment (size_t init_heap_size, scm_freelist_t *freelist)
{
- scm_sizet rounded_size = round_to_cluster_size (freelist, init_heap_size);
+ size_t rounded_size = round_to_cluster_size (freelist, init_heap_size);
if (!init_heap_seg ((SCM_CELLPTR) malloc (rounded_size),
rounded_size,
@@ -2543,7 +2613,7 @@ make_initial_segment (scm_sizet init_heap_size, scm_freelist_t *freelist)
static void
init_freelist (scm_freelist_t *freelist,
int span,
- int cluster_size,
+ scm_bits_t cluster_size,
int min_yield)
{
freelist->clusters = SCM_EOL;
@@ -2577,11 +2647,11 @@ scm_i_getenv_int (const char *var, int def)
int
scm_init_storage ()
{
- scm_sizet gc_trigger_1;
- scm_sizet gc_trigger_2;
- scm_sizet init_heap_size_1;
- scm_sizet init_heap_size_2;
- scm_sizet j;
+ unsigned long gc_trigger_1;
+ unsigned long gc_trigger_2;
+ size_t init_heap_size_1;
+ size_t init_heap_size_2;
+ size_t j;
#if (SCM_DEBUG_CELL_ACCESSES == 1)
scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
@@ -2626,8 +2696,8 @@ scm_init_storage ()
scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
/* Initialise the list of ports. */
- scm_port_table = (scm_port **)
- malloc (sizeof (scm_port *) * scm_port_table_room);
+ scm_port_table = (scm_port_t **)
+ malloc (sizeof (scm_port_t *) * scm_port_table_room);
if (!scm_port_table)
return 1;