summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Livshin <mlivshin@bigfoot.com>2000-03-18 11:09:41 +0000
committerMichael Livshin <mlivshin@bigfoot.com>2000-03-18 11:09:41 +0000
commita00c95d9c6ef0e219313ed61f8938a2b9ba23d06 (patch)
treeb783e31559b0bfd5ade63e8a97f28d0f4dd47c67
parent28b3236d36f7747e6a722a1178fa40eb550b5636 (diff)
downloadguile-a00c95d9c6ef0e219313ed61f8938a2b9ba23d06.tar.gz
* tags.h: (SCM_DOUBLE_CELLP, SCM_NDOUBLE_CELLP): new macros.
* gc.h: (typedef struct scm_freelist_t) remove from here. * gc.c: (CELL_UP, CELL_DN) make these macros take additional parameter (the span). (CLUSTER_SIZE_IN_BYTES, ALIGNMENT_SLACK) new macros. (typedef struct scm_freelist_t) move here from gc.h, it had no business being externally visible. (typedef struct scm_heap_seg_data_t) renamed from scm_heap_seg_data, to be style-compliant. (scm_mark_locations) if the possible pointer points to a multy-cell, check that it's properly aligned. (init_heap_seg) alighn multy-cells properly, work with the assumption that the segment size divides cleanly by cluster size (so that there's no spill). (round_to_cluster_size) new function. (alloc_some_heap, make_initial_segment) use round_to_cluster_size to satisfy the new init_heap_seg invariant.
-rw-r--r--libguile/ChangeLog90
-rw-r--r--libguile/gc.c246
-rw-r--r--libguile/gc.h57
-rw-r--r--libguile/tags.h3
4 files changed, 221 insertions, 175 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 2eaf597b2..3057073c8 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,25 @@
+2000-03-18 Michael Livshin <mlivshin@bigfoot.com>
+
+ * tags.h: (SCM_DOUBLE_CELLP, SCM_NDOUBLE_CELLP): new macros.
+
+ * gc.h: (typedef struct scm_freelist_t) remove from here.
+
+ * gc.c: (CELL_UP, CELL_DN) make these macros take additional
+ parameter (the span).
+ (CLUSTER_SIZE_IN_BYTES, ALIGNMENT_SLACK) new macros.
+ (typedef struct scm_freelist_t) move here from gc.h, it had no
+ business being externally visible.
+ (typedef struct scm_heap_seg_data_t) renamed from
+ scm_heap_seg_data, to be style-compliant.
+ (scm_mark_locations) if the possible pointer points to a
+ multy-cell, check that it's properly aligned.
+ (init_heap_seg) alighn multy-cells properly, work with the
+ assumption that the segment size divides cleanly by cluster size
+ (so that there's no spill).
+ (round_to_cluster_size) new function.
+ (alloc_some_heap, make_initial_segment) use round_to_cluster_size
+ to satisfy the new init_heap_seg invariant.
+
2000-03-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
* _scm.h: Don't include async.h everywhere...
@@ -69,13 +91,13 @@
GUILE_INIT_SEGMENT_SIZE_2, GUILE_GC_TRIGGER_2
2000-03-16 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
-
+
* __scm.h (GC_FREE_SEGMENTS): Disable this until we have made
freeing of segment work with the new GC scheme. (Thanks to
Michael Livshin.) Oops, also happened to make GUILE_NEW_GC_SCHEME
the default, but I'll let this change stay in CVS Guile since this
code is not expected to contain serious bugs.
-
+
2000-03-16 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* gc.c, gc.h (scm_map_free_list): Define also if GUILE_DEBUG is
@@ -98,7 +120,7 @@ Wed Mar 15 08:27:04 2000 Greg J. Badros <gjb@cs.washington.edu>
Wed Mar 15 08:24:58 2000 Greg J. Badros <gjb@cs.washington.edu>
* Makefile.am: Separate out DOT_X_FILES and DOT_DOC_FILES, and
- generate the latter from the concrete listing of the former. Then
+ generate the latter from the concrete listing of the former. Then
make guile-procedures.txt depend on DOT_DOC_FILES instead of
*.doc, so that rebuilding it works.
@@ -130,7 +152,7 @@ Wed Mar 15 08:12:14 2000 Greg J. Badros <gjb@cs.washington.edu>
The following change to init.c is only enabled if Guile was
configured with --enable-guile-debug.
-
+
* init.c (scm_i_getenv_int): New function.
(scm_boot_guile_1): Use the environment variables
GUILE_INIT_HEAP_SIZE, GUILE_INIT_HEAP_SIZE2 to select heap size if
@@ -264,7 +286,7 @@ Wed Mar 15 08:12:14 2000 Greg J. Badros <gjb@cs.washington.edu>
* async.c, async.h: made async representation a double cell.
* dynl.c: made dynamic_obj representation a double cell.
-
+
2000-03-13 Gary Houston <ghouston@arglist.com>
* ports.c (flush_void_port): renamed to flush_port_default.
@@ -294,7 +316,7 @@ Wed Mar 15 08:12:14 2000 Greg J. Badros <gjb@cs.washington.edu>
that we can't use autoconf for this. Autoconf itself relies on
the existence of `sed' somewhere on your path.) (Thanks to Dirk
Herrman.)
-
+
2000-03-13 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* Makefile.am (libguile_la_SOURCES): Moved iselect.c here from
@@ -364,10 +386,10 @@ Sun Mar 12 13:26:30 2000 Greg J. Badros <gjb@cs.washington.edu>
* struct.c, coop-threads.c: SCM_ASSCM/ASWORD fixes.
2000-03-12 Marius Vollmer <mvo@zagadka.ping.de>
-
+
* init.c (scm_standard_stream_to_port): Check whether the file
descriptor is valid and substitute "/dev/null" when not.
-
+
2000-03-12 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* coop-defs.h (struct timespec): Conditionally defined.
@@ -383,14 +405,14 @@ Sun Mar 12 13:26:30 2000 Greg J. Badros <gjb@cs.washington.edu>
code. It moves things to better places, makes arguments more
consistent with the POSIX API (which is used in GNOME's glib), and
adds new functionality.
-
+
* readline.c (scm_init_readline): Added new arg to scm_init_mutex.
* coop-defs.h (scm_mutex_trylock): New macro: alias for
coop_mutex_trylock.
(scm_cond_init): Changed definition to
coop_new_condition_variable_init.
-
+
* coop.c: #include <errno.h>
(coop_timeout_qinsert): Moved here from iselect.c
(coop_new_mutex_init, coop_new_condition_variable_init): New
@@ -434,7 +456,7 @@ Sun Mar 12 13:26:30 2000 Greg J. Badros <gjb@cs.washington.edu>
Thu Mar 9 11:33:25 2000 Greg J. Badros <gjb@cs.washington.edu>
- * vectors.h (SCM_VELTS_AS_STACKITEMS): Added this macro to help in
+ * vectors.h (SCM_VELTS_AS_STACKITEMS): Added this macro to help in
eliminating some warnings.
* unif.c, strports.c, print.c, options.c: Fix some warnings on
@@ -450,7 +472,7 @@ Thu Mar 9 11:33:25 2000 Greg J. Badros <gjb@cs.washington.edu>
storing tags and immediates (now a long int). Introduced
SCM_ASWORD and SCM_ASSCM for conversion. Fixed various dubious
code in the process: arbiter.c (use macros), unif.c (scm_array_p),
-
+
Wed Mar 8 10:15:59 2000 Greg J. Badros <gjb@cs.washington.edu>
* numbers.c: Use SCM_VALIDATE_LONG_COPY, and longs, not ints, in
@@ -493,7 +515,7 @@ Thu Mar 2 15:13:25 2000 Greg J. Badros <gjb@cs.washington.edu>
Thu Mar 2 12:38:30 2000 Greg J. Badros <gjb@cs.washington.edu>
- * list.c: Moved append docs to append! Thanks Dirk Hermann. Also,
+ * list.c: Moved append docs to append! Thanks Dirk Hermann. Also,
added append docs from R4RS.
* strings.c: Docstring typo fix, + eliminate unneeded IMP tests.
@@ -501,7 +523,7 @@ Thu Mar 2 12:38:30 2000 Greg J. Badros <gjb@cs.washington.edu>
* chars.h: Provide SCM_CHARP, SCM_CHAR, SCM_MAKE_CHAR and
deprecate SCM_ICHRP, SCM_ICHR, SCM_MAKICHR. Thanks Dirk Hermann!
-
+
* *.h, *.c: Use SCM_CHARP, SCM_CHAR, SCM_MAKE_CHAR throughout.
Drop use of SCM_P for function prototypes... assume an ANSI C
compiler. Thanks Dirk Hermann!
@@ -516,7 +538,7 @@ Sat Feb 19 12:20:12 2000 Greg J. Badros <gjb@cs.washington.edu>
Sun Feb 13 19:11:42 2000 Greg J. Badros <gjb@cs.washington.edu>
* arbiters.c, eq.c, gc.c, guardians.c, list.c, ports.c, print.c,
- regex-posix.c, scmsigs.c, stime.c, strings.c, variable.c, stime.c,
+ regex-posix.c, scmsigs.c, stime.c, strings.c, variable.c, stime.c,
strings.c, variable.c: Added lots of documentation, cleaned up
some existing documentation. Occasionally changed formal params
to match docs. Also folded an #ifdef into the inners of a
@@ -576,7 +598,7 @@ Sun Feb 6 20:26:21 2000 Greg J. Badros <gjb@cs.washington.edu>
* strings.h: don't use SCM_P. don't include <string.h>.
* error.c, gh_data.c, ports.c, script.c, strop.c: include <string.h>.
-
+
* strings.c (scm_string_ref): make the 2nd argument compulsory.
previously it defaulted to zero for no good reason that I can see.
use a local variable for SCM_INUM (k). replace
@@ -602,7 +624,7 @@ Sun Feb 6 20:26:21 2000 Greg J. Badros <gjb@cs.washington.edu>
"select" tests port buffers for the ability to provide input
or accept output. Previously only the underlying file descriptors
were checked. Rewrote the docstring.
-
+
Thu Jan 27 10:14:25 2000 Greg J. Badros <gjb@cs.washington.edu>
* vectors.c, symbols.c, strorder.c: Documentation cut and pasted
@@ -624,13 +646,13 @@ Wed Jan 26 17:33:52 2000 Greg J. Badros <gjb@cs.washington.edu>
Wed Jan 26 10:02:11 2000 Greg J. Badros <gjb@cs.washington.edu>
- * tag.c: Added doc for `tag', but mark as deprecated since Mikael
+ * tag.c: Added doc for `tag', but mark as deprecated since Mikael
suggests removing tag.c altogether (and using a new `class-of'
instead).
* strings.c: Added documentation from Gregg A. Reynolds. Edited
a bit by me to use FOO instead of @var{foo} and to have the
- summary come before preconditions on input. Also dropped trailing
+ summary come before preconditions on input. Also dropped trailing
(rnrs) note.
* gsubr.c: Do not use SCM_DEFINE for `gsubr-apply'. Register the
@@ -652,7 +674,7 @@ Tue Jan 25 17:15:47 2000 Greg J. Badros <gjb@cs.washington.edu>
* eq.c: Added docs for eq?, eqv? equal? abridged from R4RS.
* boolean.c: Added docs for `not', `boolean?' (by hand).
-
+
Tue Jan 25 13:28:56 2000 Greg J. Badros <gjb@cs.washington.edu>
* random.c: Added documentation, from SLIB page:
@@ -666,7 +688,7 @@ Mon Jan 24 17:50:20 2000 Greg J. Badros <gjb@cs.washington.edu>
2000-01-23 Gary Houston <ghouston@arglist.com>
- * filesys.c (scm_chown): omit port/fdes support if HAVE_FCHOWN is
+ * filesys.c (scm_chown): omit port/fdes support if HAVE_FCHOWN is
not defined (thanks to Richard Y. Kim).
Thu Jan 20 13:00:38 2000 Greg J. Badros <gjb@cs.washington.edu>
@@ -713,7 +735,7 @@ Tue Jan 18 13:21:08 2000 Mikael Djurfeldt <mdj@r11n07-s.pdc.kth.se>
stacks.c, stime.c, strings.c, strop.c, strports.c, struct.c,
symbols.c, throw.c, unif.c, vectors.c, version.c, vports.c,
weaks.c: Converted docstrings to ANSI C format.
-
+
* filesys.c (scm_chmod), simpos.c (scm_system), version
(scm_version), vports (scm_make_soft_port): Escape " occuring
inside docstring.
@@ -749,7 +771,7 @@ Tue Jan 11 18:24:18 2000 Greg J. Badros <gjb@cs.washington.edu>
* guile-doc-snarf.in: Use new $fullfilename for running
guile-func-name-check, and put "$fullfilename" and "$filename" in
quotes at uses to make sure re-splitting on whitespace does not
- occur (so filenames w/ embedded whitespace would work okay, though
+ occur (so filenames w/ embedded whitespace would work okay, though
I sure hope we never have to deal with that! :-) ). Thanks to
Mikael for pointing out the source_dir != build_dir was broken.
@@ -827,7 +849,7 @@ Tue Jan 11 13:44:07 2000 Greg J. Badros <gjb@cs.washington.edu>
* ramap.c: Fix #if 0'd out code to be syntactically acceptable to
guile-func-name-check.
- * guile-doc-snarf.in: Run guile-func-name-check on the file before
+ * guile-doc-snarf.in: Run guile-func-name-check on the file before
doing the snarf.
Tue Jan 11 11:31:10 2000 Greg J. Badros <gjb@cs.washington.edu>
@@ -852,7 +874,7 @@ Tue Jan 11 10:41:46 2000 Greg J. Badros <gjb@cs.washington.edu>
* print.h, print.c (scm_simple_format): Added `simple-format'
primitive. It's the old scm_display_error, with ARGS now a rest
- parameter, and the destination first instead of last (and a couple
+ parameter, and the destination first instead of last (and a couple
new capabilities inspired by `format' -- #t as destination means
current-output-port, #f means return the formatted text as a
string.
@@ -873,7 +895,7 @@ Tue Jan 11 10:41:46 2000 Greg J. Badros <gjb@cs.washington.edu>
* dynl.c: Use ANSI prototypes.
(sysdep_dynl_link): Use lt_dlopenext instead of lt_dlopen.
* scmconfig.h.in: Do not change, as it is automatically generated.
-
+
1999-07-25 Thomas Tanner <tanner@ffii.org>
* dynl-dl.c, dynl-dld.c, dynl-shl.c, dynl-vms.c: deleted
@@ -910,12 +932,12 @@ Tue Jan 11 10:41:46 2000 Greg J. Badros <gjb@cs.washington.edu>
scm_lookupcar1: throw an error with key 'unbound-variable instead
of 'misc-error when an unbound variable is encountered.
- * filesys.c (scm_mkdir, scm_rmdir, scm_getcwd, scm_select,
+ * filesys.c (scm_mkdir, scm_rmdir, scm_getcwd, scm_select,
scm_symlink, scm_readlink, scm_lstat),
posix.c (scm_setpgid, scm_setsid, scm_ctermid, scm_tcgetpgrp,
scm_tcsetpgrp, scm_uname, scm_setlocale, scm_mknod, scm_nice,
scm_sync),
- simpos.c (scm_system),
+ simpos.c (scm_system),
stime.c (scm_times, scm_strptime):
move the HAVE_XXX feature tests out of the procedure bodies.
don't use SCM_SYSMISSING.
@@ -939,9 +961,9 @@ Fri Jan 7 15:50:46 2000 Greg J. Badros <gjb@cs.washington.edu>
* scm_validate.h (SCM_OUT_OF_RANGE): Use scm_out_of_range_pos to
report the position of the argument.
- * error.h, error.c (scm_out_of_range_pos): Added this function to
+ * error.h, error.c (scm_out_of_range_pos): Added this function to
take extra "pos" argument, the position number of the errant
- argument.
+ argument.
* debug.c: Use SCM_OUT_OF_RANGE instead of scm_out_of_range.
@@ -980,7 +1002,7 @@ Thu Jan 6 11:22:53 2000 Greg J. Badros <gjb@cs.washington.edu>
Thu Jan 6 11:21:49 2000 Greg J. Badros <gjb@cs.washington.edu>
- * alist.c: Do not report mismatch errors on some uses of `tmp' (do
+ * alist.c: Do not report mismatch errors on some uses of `tmp' (do
this by using SCM_ARG2 instead of `2' in the SCM_VALIDATE_CONS
macro call.
@@ -1043,7 +1065,7 @@ Wed Jan 5 10:50:39 2000 Greg J. Badros <gjb@cs.washington.edu>
formal in the current argument snarfing check.
* snarf.h: Give new definition of SCM_ASSERT when in
- snarfing mode to output a lexically-identifiable sequence that the
+ snarfing mode to output a lexically-identifiable sequence that the
guile-snarf.awk script uses to verify argument/position matching.
* ramap.c: Remove extraneous #undef FUNC_NAME.
@@ -1051,7 +1073,7 @@ Wed Jan 5 10:50:39 2000 Greg J. Badros <gjb@cs.washington.edu>
Wed Jan 5 08:36:38 2000 Greg J. Badros <gjb@cs.washington.edu>
* guile-doc-snarf.awk.in: Removed -- guile-snarf.awk.in is the
- current version of the same functionality; it writes the .x output
+ current version of the same functionality; it writes the .x output
to stdout instead of directly into the file.
Wed Jan 5 08:15:04 2000 Greg J. Badros <gjb@cs.washington.edu>
@@ -1083,7 +1105,7 @@ Tue Jan 4 14:21:35 2000 Greg J. Badros <gjb@cs.washington.edu>
Mon Jan 3 08:30:02 2000 Greg Harvey <Greg.Harvey@thezone.net> (applied --01/03/00 gjb)
* gc.c (scm_debug_newcell): Added SCM_SETCAR of the newly
- allocated cell.
+ allocated cell.
* pairs.h: Added a comment about the need for the SCM_SETCAR in
SCM_NEWCELL macro.
diff --git a/libguile/gc.c b/libguile/gc.c
index dbd5d278b..806f19ae0 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,15 +1,15 @@
/* Copyright (C) 1995, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
- *
+ *
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
- *
+ *
* This program 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 General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
@@ -79,7 +79,7 @@
/* {heap tuning parameters}
- *
+ *
* These are parameters for controlling memory allocation. The heap
* is the area out of which scm_cons, and object headers are allocated.
*
@@ -95,7 +95,7 @@
* 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
* 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
* SCM_EXPHEAP(scm_heap_size) when more heap is needed.
*
@@ -103,13 +103,13 @@
* is needed.
*
* INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
- * trigger a GC.
+ * trigger a GC.
*
* SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must be
* reclaimed by a GC triggered by must_malloc. If less than this is
* reclaimed, the trigger threshold is raised. [I don't know what a
* good value is. I arbitrarily chose 1/10 of the INIT_MALLOC_LIMIT to
- * work around a oscillation that caused almost constant GC.]
+ * work around a oscillation that caused almost constant GC.]
*/
#define SCM_INIT_HEAP_SIZE_1 (40000L * sizeof (scm_cell))
@@ -145,23 +145,58 @@
#ifdef PROT386
/*in 386 protected mode we must only adjust the offset */
-# define CELL_UP(p) MK_FP(FP_SEG(p), ~7&(FP_OFF(p)+7))
-# define CELL_DN(p) MK_FP(FP_SEG(p), ~7&FP_OFF(p))
+# define CELL_UP(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&(FP_OFF(p)+8*(span)-1))
+# define CELL_DN(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&FP_OFF(p))
#else
# ifdef _UNICOS
-# define CELL_UP(p) (SCM_CELLPTR)(~1L & ((long)(p)+1L))
-# define CELL_DN(p) (SCM_CELLPTR)(~1L & (long)(p))
+# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((long)(p)+(span)))
+# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (long)(p))
# else
-# define CELL_UP(p) (SCM_CELLPTR)(~(sizeof(scm_cell)-1L) & ((long)(p)+sizeof(scm_cell)-1L))
-# define CELL_DN(p) (SCM_CELLPTR)(~(sizeof(scm_cell)-1L) & (long)(p))
+# 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))
# endif /* UNICOS */
#endif /* PROT386 */
+#define CLUSTER_SIZE_IN_BYTES(freelist) ((freelist)->cluster_size * (freelist)->span * sizeof(scm_cell))
+#define ALIGNMENT_SLACK(freelist) (sizeof (scm_cell) * (freelist)->span - 1)
/* scm_freelists
*/
+typedef struct scm_freelist_t {
+ /* collected cells */
+ SCM cells;
+#ifdef GUILE_NEW_GC_SCHEME
+ /* number of cells left to collect before cluster is full */
+ unsigned int left_to_collect;
+ /* a list of freelists, each of size gc_trigger,
+ except the last one which may be shorter */
+ SCM clusters;
+ SCM *clustertail;
+ /* this is the number of cells in each cluster, including the spine cell */
+ int cluster_size;
+ /* set to grow the heap when we run out of clusters
+ */
+ int grow_heap_p;
+ /* minimum number of objects allocated before GC is triggered
+ */
+ int gc_trigger;
+ /* defines gc_trigger as percent of heap size
+ * 0 => constant trigger
+ */
+ int gc_trigger_fraction;
+#endif
+ /* number of cells per object on this list */
+ int span;
+ /* number of collected cells during last GC */
+ int collected;
+ /* total number of cells in heap segments
+ * belonging to this list.
+ */
+ int heap_size;
+} scm_freelist_t;
+
#ifdef GUILE_NEW_GC_SCHEME
SCM scm_freelist = SCM_EOL;
scm_freelist_t scm_master_freelist = {
@@ -222,8 +257,7 @@ SCM_SYMBOL (sym_mtrigger, "gc-malloc-threshold");
SCM_SYMBOL (sym_heap_segments, "cell-heap-segments");
SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken");
-
-struct scm_heap_seg_data
+typedef struct scm_heap_seg_data_t
{
/* lower and upper bounds of the segment */
SCM_CELLPTR bounds[2];
@@ -240,7 +274,7 @@ struct scm_heap_seg_data
SEG_DATA, and mark the object iff the function returns non-zero.
At the moment, I don't think anyone uses this. */
int (*valid) ();
-};
+} scm_heap_seg_data_t;
@@ -277,7 +311,7 @@ map_free_list (scm_freelist_t *master, SCM freelist)
{
int last_seg = -1, count = 0;
SCM f;
-
+
for (f = freelist; SCM_NIMP (f); f = SCM_CDR (f))
{
int this_seg = which_seg (f);
@@ -302,7 +336,7 @@ map_free_list (scm_freelist_t *freelist)
{
int last_seg = -1, count = 0;
SCM f;
-
+
for (f = freelist->cells; SCM_NIMP (f); f = SCM_CDR (f))
{
int this_seg = which_seg (f);
@@ -323,7 +357,7 @@ map_free_list (scm_freelist_t *freelist)
}
#endif
-SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
+SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
(),
"Print debugging information about the free-list.\n"
"`map-free-list' is only included in --enable-guile-debug builds of Guile.")
@@ -409,7 +443,7 @@ free_list_lengths (char *title, scm_freelist_t *master, SCM freelist)
fprintf (stderr, "\ntotal %d objects\n\n", n);
}
-SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0,
+SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0,
(),
"Print debugging information about the free-list.\n"
"`free-list-length' is only included in --enable-guile-debug builds of Guile.")
@@ -468,7 +502,7 @@ scm_check_freelist (scm_freelist_t *freelist)
static int scm_debug_check_freelist = 0;
-SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0,
+SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0,
(SCM flag),
"If FLAG is #t, check the freelist for consistency on each cell allocation.\n"
"This procedure only exists because the GUILE_DEBUG_FREELIST \n"
@@ -598,7 +632,7 @@ scm_debug_newcell2 (void)
/* {Scheme Interface to GC}
*/
-SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
+SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
(),
"Returns an association list of statistics about Guile's current use of storage. ")
#define FUNC_NAME s_scm_gc_stats
@@ -626,7 +660,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
goto retry;
scm_block_gc = 0;
- /// ? ?? ?
+ /// ? ?? ?
local_scm_mtrigger = scm_mtrigger;
local_scm_mallocated = scm_mallocated;
#ifdef GUILE_NEW_GC_SCHEME
@@ -650,7 +684,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
#undef FUNC_NAME
-void
+void
scm_gc_start (const char *what)
{
scm_gc_rt = SCM_INUM (scm_get_internal_run_time ());
@@ -659,7 +693,7 @@ scm_gc_start (const char *what)
scm_gc_ports_collected = 0;
}
-void
+void
scm_gc_end ()
{
scm_gc_rt = SCM_INUM (scm_get_internal_run_time ()) - scm_gc_rt;
@@ -668,7 +702,7 @@ scm_gc_end ()
}
-SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
+SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
(SCM obj),
"Return an integer that for the lifetime of @var{obj} is uniquely\n"
"returned by this function for @var{obj}")
@@ -679,7 +713,7 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
+SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
(),
"Scans all of SCM objects and reclaims for further use those that are\n"
"no longer accessible.")
@@ -764,7 +798,7 @@ scm_gc_for_alloc (scm_freelist_t *freelist)
}
-SCM
+SCM
scm_gc_for_newcell (scm_freelist_t *freelist)
{
SCM fl;
@@ -860,7 +894,7 @@ scm_igc (const char *what)
}
#ifndef USE_THREADS
-
+
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
* are "in-use" by the C code. "in-use" objects are those
@@ -914,13 +948,13 @@ scm_igc (const char *what)
/* FIXME: we should have a means to register C functions to be run
* in different phases of GC
- */
+ */
scm_mark_subr_table ();
-
+
#ifndef USE_THREADS
scm_gc_mark (scm_root->handle);
#endif
-
+
scm_mark_weak_vector_spines ();
scm_guardian_zombify ();
@@ -936,14 +970,14 @@ scm_igc (const char *what)
}
-/* {Mark/Sweep}
+/* {Mark/Sweep}
*/
/* Mark an object precisely.
*/
-void
+void
scm_gc_mark (SCM p)
{
register long i;
@@ -1016,7 +1050,7 @@ gc_mark_nimp:
/* We're using SCM_GCCDR here like STRUCT_DATA, except
that it removes the mark */
mem = (SCM *)SCM_GCCDR (ptr);
-
+
if (SCM_UNPACK (vtable_data[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY)
{
scm_gc_mark (mem[scm_struct_i_procedure]);
@@ -1127,7 +1161,7 @@ gc_mark_nimp:
len = SCM_LENGTH (ptr);
weak_keys = SCM_IS_WHVEC (ptr) || SCM_IS_WHVEC_B (ptr);
weak_values = SCM_IS_WHVEC_V (ptr) || SCM_IS_WHVEC_B (ptr);
-
+
for (x = 0; x < len; ++x)
{
SCM alist;
@@ -1144,7 +1178,7 @@ gc_mark_nimp:
kvpair = SCM_CAR (alist);
next_alist = SCM_CDR (alist);
- /*
+ /*
* Do not do this:
* SCM_SETGCMARK (alist);
* SCM_SETGCMARK (kvpair);
@@ -1239,7 +1273,7 @@ gc_mark_nimp:
/* Mark a Region Conservatively
*/
-void
+void
scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
{
register long m = n;
@@ -1292,7 +1326,9 @@ scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
if ( !scm_heap_table[seg_id].valid
|| scm_heap_table[seg_id].valid (ptr,
&scm_heap_table[seg_id]))
- scm_gc_mark (*(SCM *) & x[m]);
+ if ( scm_heap_table[seg_id].span == 1
+ || SCM_DOUBLE_CELLP (*(SCM **) (& x[m])))
+ scm_gc_mark (*(SCM *) & x[m]);
break;
}
@@ -1311,7 +1347,7 @@ scm_cellp (SCM value)
{
register int i, j;
register SCM_CELLPTR ptr;
-
+
if SCM_CELLP (*(SCM **) (& value))
{
ptr = (SCM_CELLPTR) SCM2PTR ((*(SCM **) & value));
@@ -1390,7 +1426,7 @@ scm_mark_weak_vector_spines ()
alist = ptr[j];
while ( SCM_CONSP (alist)
- && !SCM_GCMARKP (alist)
+ && !SCM_GCMARKP (alist)
&& SCM_CONSP (SCM_CAR (alist)))
{
SCM_SETGCMARK (alist);
@@ -1426,12 +1462,12 @@ gc_sweep_freelist_finish (scm_freelist_t *freelist)
freelist->collected +=
freelist->span * (freelist->cluster_size - freelist->left_to_collect);
}
-
+
freelist->grow_heap_p = (freelist->collected < freelist->gc_trigger);
}
#endif
-void
+void
scm_gc_sweep ()
{
register SCM_CELLPTR ptr;
@@ -1459,7 +1495,7 @@ scm_gc_sweep ()
for (i = 0; i < scm_n_heap_segs; i++)
scm_heap_table[i].freelist->cells = SCM_EOL;
#endif
-
+
for (i = 0; i < scm_n_heap_segs; i++)
{
#ifdef GUILE_NEW_GC_SCHEME
@@ -1482,8 +1518,8 @@ scm_gc_sweep ()
#endif
span = scm_heap_table[i].span;
- ptr = CELL_UP (scm_heap_table[i].bounds[0]);
- seg_size = CELL_DN (scm_heap_table[i].bounds[1]) - ptr;
+ ptr = CELL_UP (scm_heap_table[i].bounds[0], span);
+ seg_size = CELL_DN (scm_heap_table[i].bounds[1], span) - ptr;
for (j = seg_size + span; j -= span; ptr += span)
{
#ifdef SCM_POINTERS_MUNGED
@@ -1686,7 +1722,7 @@ scm_gc_sweep ()
SCM_SETCAR (scmptr, nfreelist);
*freelist->clustertail = scmptr;
freelist->clustertail = SCM_CDRLOC (scmptr);
-
+
nfreelist = SCM_EOL;
freelist->collected += span * freelist->cluster_size;
left_to_collect = freelist->cluster_size;
@@ -1702,7 +1738,7 @@ scm_gc_sweep ()
SCM_SETCDR (scmptr, nfreelist);
nfreelist = scmptr;
}
-
+
continue;
c8mrkcontinue:
SCM_CLRGC8MARK (scmptr);
@@ -1750,17 +1786,17 @@ scm_gc_sweep ()
scm_map_free_list ();
#endif
}
-
+
#ifdef GUILE_NEW_GC_SCHEME
gc_sweep_freelist_finish (&scm_master_freelist);
gc_sweep_freelist_finish (&scm_master_freelist2);
-
+
/* When we move to POSIX threads private freelists should probably
be GC-protected instead. */
scm_freelist = SCM_EOL;
scm_freelist2 = SCM_EOL;
#endif
-
+
/* Scan weak vectors. */
{
SCM *ptr, w;
@@ -1790,7 +1826,7 @@ scm_gc_sweep ()
SCM alist;
int weak_keys;
int weak_values;
-
+
weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj);
weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj);
@@ -1838,7 +1874,7 @@ scm_gc_sweep ()
* Return newly malloced storage or throw an error.
*
* The parameter WHAT is a string for error reporting.
- * If the threshold scm_mtrigger will be passed by this
+ * If the threshold scm_mtrigger will be passed by this
* allocation, or if the first call to malloc fails,
* garbage collect -- on the presumption that some objects
* using malloced storage may be collected.
@@ -1924,7 +1960,7 @@ scm_must_realloc (void *where,
return 0; /* never reached */
}
-void
+void
scm_must_free (void *obj)
{
if (obj)
@@ -1999,7 +2035,7 @@ scm_sizet scm_max_segment_size;
*/
SCM_CELLPTR scm_heap_org;
-struct scm_heap_seg_data * scm_heap_table = 0;
+scm_heap_seg_data_t * scm_heap_table = 0;
int scm_n_heap_segs = 0;
/* init_heap_seg
@@ -2013,7 +2049,7 @@ int scm_n_heap_segs = 0;
*/
-static scm_sizet
+static scm_sizet
init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
{
register SCM_CELLPTR ptr;
@@ -2027,19 +2063,17 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
int new_seg_index;
int n_new_cells;
int span = freelist->span;
-
+
if (seg_org == NULL)
return 0;
- ptr = seg_org;
-
- size = (size / sizeof (scm_cell) / span) * span * sizeof (scm_cell);
+ ptr = CELL_UP (seg_org, span);
- /* Compute the ceiling on valid object pointers w/in this segment.
+ /* Compute the ceiling on valid object pointers w/in this segment.
*/
- seg_end = CELL_DN ((char *) ptr + size);
+ seg_end = CELL_DN ((char *) seg_org + size, span);
- /* Find the right place and insert the segment record.
+ /* Find the right place and insert the segment record.
*
*/
for (new_seg_index = 0;
@@ -2053,7 +2087,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
for (i = scm_n_heap_segs; i > new_seg_index; --i)
scm_heap_table[i] = scm_heap_table[i - 1];
}
-
+
++scm_n_heap_segs;
scm_heap_table[new_seg_index].valid = 0;
@@ -2063,9 +2097,9 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
scm_heap_table[new_seg_index].bounds[1] = (SCM_CELLPTR)seg_end;
- /* Compute the least valid object pointer w/in this segment
+ /* Compute the least valid object pointer w/in this segment
*/
- ptr = CELL_UP (ptr);
+ ptr = CELL_UP (ptr, span);
/*n_new_cells*/
@@ -2075,8 +2109,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
freelist->heap_size += n_new_cells;
- /* Partition objects in this segment into clusters
- */
+ /* Partition objects in this segment into clusters */
{
SCM clusters;
SCM *clusterp = &clusters;
@@ -2092,10 +2125,9 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
n_new_cells -= n_cluster_cells;
}
else
- {
- seg_end = ptr + n_new_cells;
- n_new_cells = 0;
- }
+ /* [cmm] looks like the segment size doesn't divide cleanly by
+ cluster size. bad cmm! */
+ abort();
/* Allocate cluster spine
*/
@@ -2103,7 +2135,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
SCM_SETCAR (*clusterp, PTR2SCM (ptr + span));
clusterp = SCM_CDRLOC (*clusterp);
ptr += span;
-
+
while (ptr < seg_end)
{
#ifdef SCM_POINTERS_MUNGED
@@ -2116,7 +2148,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
SCM_SETCDR (PTR2SCM (ptr - span), SCM_EOL);
}
-
+
/* Patch up the last cluster pointer in the segment
* to join it to the input freelist.
*/
@@ -2129,7 +2161,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
#else /* GUILE_NEW_GC_SCHEME */
- /* Prepend objects in this segment to the freelist.
+ /* Prepend objects in this segment to the freelist.
*/
while (ptr < seg_end)
{
@@ -2147,7 +2179,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
* to join it to the input freelist.
*/
SCM_SETCDR (PTR2SCM (ptr), freelist->cells);
- freelist->cells = PTR2SCM (CELL_UP (seg_org));
+ freelist->cells = PTR2SCM (CELL_UP (seg_org, span));
freelist->heap_size += n_new_cells;
@@ -2162,14 +2194,29 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
#endif
}
+#ifndef GUILE_NEW_GC_SCHEME
+#define round_to_cluster_size(freelist, len) len
+#else
+
+static scm_sizet
+round_to_cluster_size (scm_freelist_t *freelist, scm_sizet len)
+{
+ scm_sizet cluster_size_in_bytes = CLUSTER_SIZE_IN_BYTES (freelist);
+
+ return
+ (len + cluster_size_in_bytes - 1) / cluster_size_in_bytes * cluster_size_in_bytes
+ + ALIGNMENT_SLACK (freelist);
+}
+
+#endif
-static void
+static void
alloc_some_heap (scm_freelist_t *freelist)
{
- struct scm_heap_seg_data * tmptable;
+ scm_heap_seg_data_t * tmptable;
SCM_CELLPTR ptr;
scm_sizet len;
-
+
/* Critical code sections (such as the garbage collector)
* aren't supposed to add heap segments.
*/
@@ -2180,9 +2227,9 @@ alloc_some_heap (scm_freelist_t *freelist)
* Do not yet increment scm_n_heap_segs -- that is done by init_heap_seg
* only if the allocation of the segment itself succeeds.
*/
- len = (1 + scm_n_heap_segs) * sizeof (struct scm_heap_seg_data);
+ len = (1 + scm_n_heap_segs) * sizeof (scm_heap_seg_data_t);
- SCM_SYSCALL (tmptable = ((struct scm_heap_seg_data *)
+ SCM_SYSCALL (tmptable = ((scm_heap_seg_data_t *)
realloc ((char *)scm_heap_table, len)));
if (!tmptable)
scm_wta (SCM_UNDEFINED, "could not grow", "hplims");
@@ -2191,7 +2238,7 @@ alloc_some_heap (scm_freelist_t *freelist)
/* Pick a size for the new heap segment.
- * The rule for picking the size of a segment is explained in
+ * The rule for picking the size of a segment is explained in
* gc.h
*/
#ifdef GUILE_NEW_GC_SCHEME
@@ -2207,7 +2254,7 @@ alloc_some_heap (scm_freelist_t *freelist)
len = min_cells + 1;
len *= sizeof (scm_cell);
}
-
+
if (len > scm_max_segment_size)
len = scm_max_segment_size;
#else
@@ -2225,18 +2272,24 @@ alloc_some_heap (scm_freelist_t *freelist)
{
scm_sizet smallest;
+#ifndef GUILE_NEW_GC_SCHEME
smallest = (freelist->span * sizeof (scm_cell));
+#else
+ smallest = CLUSTER_SIZE_IN_BYTES (freelist);
+#endif
+
if (len < smallest)
- len = (freelist->span * sizeof (scm_cell));
+ len = smallest;
/* Allocate with decaying ambition. */
while ((len >= SCM_MIN_HEAP_SEG_SIZE)
&& (len >= smallest))
{
- SCM_SYSCALL (ptr = (SCM_CELLPTR) malloc (len));
+ scm_sizet rounded_len = round_to_cluster_size(freelist, len);
+ SCM_SYSCALL (ptr = (SCM_CELLPTR) malloc (rounded_len));
if (ptr)
{
- init_heap_seg (ptr, len, freelist);
+ init_heap_seg (ptr, rounded_len, freelist);
return;
}
len /= 2;
@@ -2248,7 +2301,7 @@ alloc_some_heap (scm_freelist_t *freelist)
-SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,
+SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,
(SCM name),
"")
#define FUNC_NAME s_scm_unhash_name
@@ -2399,13 +2452,14 @@ cleanup (int status, void *arg)
static int
make_initial_segment (scm_sizet init_heap_size, scm_freelist_t *freelist)
{
- if (!init_heap_seg ((SCM_CELLPTR) malloc (init_heap_size),
- init_heap_size,
+ scm_sizet rounded_size = round_to_cluster_size (freelist, init_heap_size);
+ if (!init_heap_seg ((SCM_CELLPTR) malloc (rounded_size),
+ rounded_size,
freelist))
{
- init_heap_size = SCM_HEAP_SEG_SIZE;
- if (!init_heap_seg ((SCM_CELLPTR) malloc (init_heap_size),
- init_heap_size,
+ rounded_size = round_to_cluster_size (freelist, SCM_HEAP_SEG_SIZE);
+ if (!init_heap_seg ((SCM_CELLPTR) malloc (rounded_size),
+ rounded_size,
freelist))
return 1;
}
@@ -2413,7 +2467,7 @@ make_initial_segment (scm_sizet init_heap_size, scm_freelist_t *freelist)
scm_expmem = 1;
freelist->grow_heap_p = (freelist->heap_size < freelist->gc_trigger);
-
+
return 0;
}
@@ -2487,8 +2541,8 @@ scm_init_storage (scm_sizet init_heap_size, scm_sizet init_heap2_size)
j = SCM_HEAP_SEG_SIZE;
scm_mtrigger = SCM_INIT_MALLOC_LIMIT;
- scm_heap_table = ((struct scm_heap_seg_data *)
- scm_must_malloc (sizeof (struct scm_heap_seg_data) * 2, "hplims"));
+ scm_heap_table = ((scm_heap_seg_data_t *)
+ scm_must_malloc (sizeof (scm_heap_seg_data_t) * 2, "hplims"));
#ifdef GUILE_NEW_GC_SCHEME
if (make_initial_segment (init_heap_size_1, &scm_master_freelist) ||
@@ -2500,7 +2554,7 @@ scm_init_storage (scm_sizet init_heap_size, scm_sizet init_heap2_size)
return 1;
#endif
- scm_heap_org = CELL_UP (scm_heap_table[0].bounds[0]);
+ scm_heap_org = CELL_UP (scm_heap_table[0].bounds[0], 1);
/* scm_hplims[0] can change. do not remove scm_heap_org */
scm_weak_vectors = SCM_EOL;
diff --git a/libguile/gc.h b/libguile/gc.h
index 72d697eeb..cb64d7d18 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -3,17 +3,17 @@
#ifndef GCH
#define GCH
/* Copyright (C) 1995, 96, 98, 99, 2000 Free Software Foundation, Inc.
- *
+ *
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
- *
+ *
* This program 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 General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
@@ -60,56 +60,23 @@
: SCM_GCMARKP(x))
#define SCM_NMARKEDP(x) (!SCM_MARKEDP(x))
-extern struct scm_heap_seg_data *scm_heap_table;
+extern struct scm_heap_seg_data_t *scm_heap_table;
extern int scm_n_heap_segs;
extern int scm_take_stdin;
extern int scm_block_gc;
extern int scm_gc_heap_lock;
-typedef struct scm_freelist_t {
- /* collected cells */
- SCM cells;
-#ifdef GUILE_NEW_GC_SCHEME
- /* number of cells left to collect before cluster is full */
- unsigned int left_to_collect;
- /* a list of freelists, each of size gc_trigger,
- except the last one which may be shorter */
- SCM clusters;
- SCM *clustertail;
- /* this is the number of cells in each cluster, including the spine cell */
- int cluster_size;
- /* set to grow the heap when we run out of clusters
- */
- int grow_heap_p;
- /* minimum number of objects allocated before GC is triggered
- */
- int gc_trigger;
- /* defines gc_trigger as percent of heap size
- * 0 => constant trigger
- */
- int gc_trigger_fraction;
-#endif
- /* number of cells per object on this list */
- int span;
- /* number of collected cells during last GC */
- int collected;
- /* total number of cells in heap segments
- * belonging to this list.
- */
- int heap_size;
-} scm_freelist_t;
-
extern scm_sizet scm_max_segment_size;
extern SCM_CELLPTR scm_heap_org;
#ifdef GUILE_NEW_GC_SCHEME
extern SCM scm_freelist;
-extern scm_freelist_t scm_master_freelist;
+extern struct scm_freelist_t scm_master_freelist;
extern SCM scm_freelist2;
-extern scm_freelist_t scm_master_freelist2;
+extern struct scm_freelist_t scm_master_freelist2;
#else
-extern scm_freelist_t scm_freelist;
-extern scm_freelist_t scm_freelist2;
+extern struct scm_freelist_t scm_freelist;
+extern struct scm_freelist_t scm_freelist2;
#endif
extern unsigned long scm_gc_cells_collected;
extern unsigned long scm_gc_malloc_collected;
@@ -136,14 +103,14 @@ extern SCM scm_gc_stats (void);
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 *freelist);
+extern void scm_gc_for_alloc (struct scm_freelist_t *freelist);
#ifdef GUILE_NEW_GC_SCHEME
-extern SCM scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist);
+extern SCM scm_gc_for_newcell (struct scm_freelist_t *master, SCM *freelist);
#if 0
-extern void scm_alloc_cluster (scm_freelist_t *master);
+extern void scm_alloc_cluster (struct scm_freelist_t *master);
#endif
#else
-extern SCM scm_gc_for_newcell (scm_freelist_t *freelist);
+extern SCM scm_gc_for_newcell (struct scm_freelist_t *freelist);
#endif
extern void scm_igc (const char *what);
extern void scm_gc_mark (SCM p);
diff --git a/libguile/tags.h b/libguile/tags.h
index dc19d0e0f..5288bd3ff 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -305,6 +305,9 @@ typedef void * SCM;
#define SCM_CELLP(x) (!SCM_NCELLP (x))
#define SCM_NCELLP(x) ((sizeof (scm_cell) - 1) & SCM_UNPACK (x))
+#define SCM_DOUBLE_CELLP(x) (!SCM_NDOUBLE_CELLP (x))
+#define SCM_NDOUBLE_CELLP(x) ((2 * sizeof (scm_cell) - 1) & SCM_UNPACK (x))
+
/* See numbers.h for macros relating to immediate integers.
*/