guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-331-g6d


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-2-331-g6dc797e
Date: Wed, 09 Sep 2009 20:40:41 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6dc797eee9041498eec7053d32d8721c3660fb51

The branch, master has been updated
       via  6dc797eee9041498eec7053d32d8721c3660fb51 (commit)
       via  d66b74dce74c2824726746e82a8a413463cb80fd (commit)
       via  f07c349eb38d6c7b160b8980fc4007fb502e3433 (commit)
       via  56273dea4bc44b798f6b661e4fca953437f512f7 (commit)
       via  cab6e6c0410f07b0f414215fec89842deb0a0792 (commit)
       via  0588379a2aeddc7346e9d57daa2e26f98ec7c4fd (commit)
       via  b529eb5797ca0f62e0c57fcfde8e43c5fb00b3c0 (commit)
       via  0e0d97c477b160f193b289b4aabfa73bbaf52e9b (commit)
       via  f538a0709aa89fe8cc3a25996d447f35ef05fab1 (commit)
       via  d7e7a02a6251c8ed4f76933d9d30baeee3f599c0 (commit)
       via  ba54a2026beaadb4e7566d4b9e2c9e4c7cd793e6 (commit)
       via  13a9455669c2a8d1e4ed59cb8736bf23e91eaa55 (commit)
       via  4812ce85ddf1d04c49436ada34152ac7751a8b50 (commit)
       via  0665b3ffcb7ec5232a51ff632a818a638dfd4054 (commit)
       via  807e5a6641b2aa37ce4198a6c13f1aaebd3a5f25 (commit)
       via  d6097d1d63a269ce960c47f81902aaaf26d46a64 (commit)
       via  760fb97d1f5ae2fc745cbe6b6af3d8fe0023ebbd (commit)
       via  7af531508c5931261ff8957708642cac67bf86a5 (commit)
       via  f86f3b5b113b4cb383c531150b13bef9b2789221 (commit)
       via  78747ac6fbdcbca423ecaed65a5d6da9c3262b58 (commit)
       via  e3eb628d889b8cb9821a274e41b72f9751b6ee0a (commit)
       via  75d315e1fbb0da6af8c48d17fd5b2a7a759fe849 (commit)
       via  1f7de769402cf8a9ad54b5283dc96d60e86fb5bb (commit)
       via  aec3d99bcd1dd4020e56c426909dc570d0109d91 (commit)
       via  512c35950752d1482d87c5052c8d923e0d16ad15 (commit)
       via  3c13664ebe86c87223d59db7dc7187be9d32b8d7 (commit)
       via  05762e724b27c2bf7b6f5af00db02312ceb0509e (commit)
       via  3b882d69fb4d4be9e46767d57c22c5f0e33a9be4 (commit)
       via  1ac8a47f0187d2a96bc4571cb10cbf45b0edc9d4 (commit)
       via  fbb857a472eb4e69c1cba05e86646b7004f32df6 (commit)
       via  49c9839eae84f7f3cd10db45f389fa1ea1050659 (commit)
       via  85d7012ec3456bc74de7c0dacbcfb9e4ecaf6698 (commit)
       via  3d94d862f898929876aaa8ed2937347fa3ce7ec1 (commit)
       via  d9e59f894e1b41958203ddda7f21f4817cfcfe37 (commit)
       via  f307fbcec2cbaaa95b8c861395133b519c7519cf (commit)
       via  1eefa363bd7f0db07a907c773c890b78ff6415a9 (commit)
       via  6a7489ace3f07a8d190110cd1244963526c65729 (commit)
       via  5aec3cf4078f773903807677e8142a3ded337404 (commit)
       via  f7a1ab8b946e03f6ad5ccdecba5e8d69b3ce0a1a (commit)
       via  63385df2fdc2f9bc70804383f071f2fb74743a86 (commit)
       via  0953b549464e5bf1433e7f0b8a49ac4b464c3c11 (commit)
       via  474554694f5618be238054e736540f567a0e02a0 (commit)
       via  c891a40e9fc5f718bfaf6e70f8fd0b19311d14a6 (commit)
       via  d0cad2492cd880fded45b4ab52afb61e6047b1ac (commit)
       via  1a531c80b2d4d57ae80b0515e66e03efa18bb938 (commit)
       via  2a77682322b3d466ac16ce4bd1244d29085a3555 (commit)
       via  33ed7a1644eda55a8dc479acf26418631cb937f9 (commit)
       via  6bf4c3f9c1ae495a1bf401788806151f40510ec5 (commit)
       via  0208ec4013a88fda2e590921c0dd4295d4c2ebde (commit)
       via  f48393a99b4886e6005baad9d25d8fefe6cefecc (commit)
       via  81ba12d74d03e3aa9398efb2949346ab1710469a (commit)
       via  2b807ea75c9a4dc3059918d2d04e1cb3ed301acf (commit)
       via  c501d037b6a5b6953edd6a1da38b0d8e80ad4c7e (commit)
       via  46e17bd2337fe8d3deda1089c6c3bf4f42d4498e (commit)
       via  083f810fe9b7f04dc0de6b8ebc62053a41714f2b (commit)
       via  c9d15b05833feccf1cbc644ab534b9beeaa5b744 (commit)
       via  ecdbb582ffa4bb6b5223875f63cca55eec1a52d7 (commit)
       via  d7b3f25d5a3bdad8e9b769cee8a1efd42a447eab (commit)
       via  e4c8d2a2c3e3c7af14a7d6e7b2ec777672c97c63 (commit)
       via  857a263e4f28fe1e9afb44141c6aec66611acd17 (commit)
       via  613ed506cb86e2dff21d588cc7904e3411b5f8b0 (commit)
       via  1f26b531ecc56f18ab11399284d63c8729492495 (commit)
       via  59e21020916cdc0e7bbea55128cc0e0a66065b99 (commit)
       via  c1d1d8247c0673d1bdae7aaeb79352e746c3f2b5 (commit)
       via  b777f3b64cbba05aca3ac9a9f5b5f937d8ee77f0 (commit)
       via  490cf75094167556289716c49ad43ad827f1d0dc (commit)
       via  00b8057d1f73c71b8784c38ae54e38a479fbafbd (commit)
       via  f8e7dfdc5396fe6e68ec269a4c76e01db9cc7768 (commit)
       via  627796347f04312b69a869e62dc3ce69f785da55 (commit)
       via  47b6e9bd8ea4c19404a990688c57f76d27f7768d (commit)
       via  979172b6562f737232f42470a3480e99c2f0f273 (commit)
       via  7f9ec18a1fdd1b29a87e407d330461fa13de47b5 (commit)
       via  c38a561f73512bfccac490b91b47ea33be907aa6 (commit)
       via  074f69cdf2712420e9f1ab0ee382835ac9e9c12a (commit)
       via  2956b07140da269fada704dab16d99cfd81f7d0a (commit)
       via  8c2b314350fb1926586922549ef53744ce6ea862 (commit)
       via  b66a552487b875b2897177eafcb7e4b68b140b0a (commit)
       via  21c097e0ed0fb2e934c3a1b112c018e6cbe51e43 (commit)
       via  72e6b60838ee9cfb80b6a5c24531c8b924d703db (commit)
       via  108e4c5b6449e89223afe696935c23deb4fc11f1 (commit)
       via  9625c900e4a21e54f92cfabf05003b1706329c3d (commit)
       via  2a5bf2eeec07e4ff29fe233227593b02a0403766 (commit)
       via  6033d3266cedeeb608d0727513de37a5d8b203bc (commit)
       via  f5cc9619df6cb172b36e21791fd3eabb13f6ae41 (commit)
       via  43adae308c3827d93ad2b79d073288887a99c47d (commit)
       via  902578f15aaef0ae1eefdde4c822d163fffb58f0 (commit)
       via  8b039053b8899c6951e064128292b8086827251a (commit)
       via  bc743877ffdb5a90099b0c92601133f21bbeb8aa (commit)
       via  a284cc7ed84d34b01525e3d6ae2bc9c6e2335455 (commit)
       via  737219ddbb026289521df207710f0d5310d0f4d1 (commit)
       via  3db825b0677614b1fe8fd135a1bd125dde6c03e1 (commit)
       via  d3be55145a8c5481d7eb58ec66639645b7ef7f3f (commit)
       via  53ea4fdf99878eb603c8f650a09b91f0c92fc6f5 (commit)
       via  d6c74168a7312dd574dbb33e4f2933473fc05e7d (commit)
       via  11d2fc0660605ed4331c897291300c556be94001 (commit)
       via  04f8c62ca60d4be9542bda6de1990c5479cd7cfa (commit)
       via  44e268898b522dd1c15e968d68adcb2f6fe12359 (commit)
       via  aa25debf1d3ab0e05e5276f7b015a7980efb99d1 (commit)
       via  ebd782132167a267828760d129804b52482f1cb7 (commit)
       via  e9d8bc255881aff0906c881f4557f9acfe4ef626 (commit)
       via  0306509bc89b753442b503c61310d319e37eee5b (commit)
       via  b359b36a63844f6fb1e18a070528bcc4fb45c16d (commit)
       via  7f2a6c387c0610b774c5b90ab080e69845f76dfc (commit)
       via  6f03035fe80d1c25ffadc42ec59c473402f65f60 (commit)
       via  328efeb9a66dddcf78a24fad96d3db58e9c3375d (commit)
       via  35747a3e063ae0dd2e8828c680a76e8589d7b8c7 (commit)
       via  071e0d93299d49158c737069597c7a74265628d8 (commit)
       via  e0513d4d77a7dbf42252a5dddfee62c46a700b9c (commit)
       via  6774820f1e83a388b3232cd61a66340886b395d8 (commit)
       via  b74e86cf5f50612742609210ad8e04d46069437f (commit)
       via  e9b8556ec92039396e740620238d56a3748f2a99 (commit)
       via  ea4f8ea13f1e9b9d25330251f69d6e9a49e107b4 (commit)
       via  4a4849dbe0ae1b731b408167f90222e05d1ca2bd (commit)
       via  3ec17f28b8f96fa43218db83656c0d85b4f69d7c (commit)
       via  35a9197ccc91a3663313e1bf7d369101754a1075 (commit)
       via  e7bca22779c68b800c75fdad8841440dfeb32f8d (commit)
       via  8e7b3e98072ef30557a0396367ae8b42170e5507 (commit)
       via  fdab75a144580898b4917e01191df1f1875c5a1f (commit)
       via  184327a68d7aa6aa2576c398d324bd9def12ad67 (commit)
       via  915b3f9f9af5b9dce63e8d9df2ae4edba709d4b5 (commit)
       via  42e6668b5e91a101c9d163aae0039451444546be (commit)
       via  488b10b5a5cf64ac9bb79a41d3fa663672e7abf9 (commit)
       via  639e56a4edaae413a238e62158503978c18545be (commit)
       via  e13f1cbdffa4f333d9866d1b22cd2c9a3b17b3bd (commit)
       via  9778b58a19aa8eed5d795f8785fd61a41849560c (commit)
       via  72c9d17bf35d6ad3e09b41a6ccdeb288a6e16c28 (commit)
       via  986ec82209fe327e44dc897d8f5219b1f53ed939 (commit)
       via  c6a35e35f76e800bd85cb28e6ace743aedd87e61 (commit)
       via  651a0735225da3e4887df018824e9baaada5194e (commit)
       via  92d8fd328c66df2132e13ff1428bb83b2f4350c2 (commit)
       via  6cc80cb6ab28b6b1c3b016465d61c0e77c0ee290 (commit)
       via  077644c8a4be1e6ed9b325414018d9db95763b4d (commit)
       via  5e67dc27e396e3d4f534e028c8cf06d57f7cd508 (commit)
       via  73e6fc23cdbf3a105fe0bdb895e8863d0180b4dc (commit)
       via  bebc45ae90481ca461c6fa0d81c14e4d291f912e (commit)
       via  194c0a3e402f20c51f5bf7041d8b9edce913b071 (commit)
       via  10fb3386dd186244becc493d83c291b9bec2075e (commit)
       via  a4a141f679fa66b1538148aae8046a9f351b3216 (commit)
       via  4a6a4b492ff7677fd9ec5136d55bb75985245b18 (commit)
       via  e9d635e5d82e882ed39de65f6312aae1ade43d1f (commit)
       via  8574d367a9de70b2882c0f3393c6b5040d0f6e4d (commit)
       via  53cc0209fad717f4a72f42dfd5ab4d71889d0ccb (commit)
       via  febd2677c9b1028bc3cd30401672ccc7e3314199 (commit)
       via  378f262561cb381e8b3cff3faac1157605422015 (commit)
       via  6bad09ba9f203f5aaf8024ab198995d2470fb688 (commit)
       via  296278188ec42aec4ff2a60c8cd52f0f1e8ec47a (commit)
       via  080ecf3f7bb9575109e42753eb42ddedbf15062a (commit)
       via  ce6660664198cc05a30ab5f342f8f95d491dbb41 (commit)
       via  59cac9e3d8fb0097aba43dd3351274593ec552d7 (commit)
       via  741e83fcbfd629c8e043dccad291d265edcf9643 (commit)
       via  b6ed39c411acebf6c94efe149942310422adc891 (commit)
       via  c367c4b44eb9a20137930ec8771c69da9cec50a3 (commit)
       via  d525e4f9a21d1c483bc23fb047cb35edae2997ae (commit)
       via  4650cdd20dd8b4931bed910e299e766f391546aa (commit)
       via  bc700b6dd35fe224a239bc27e439ec7439b6ea9c (commit)
       via  89f423d5ad0d3105e0dba70389c19c647239a260 (commit)
       via  d9c82e2051df5bb9eaa03c664a2a6bac88adaf2c (commit)
       via  e4d21e6bc92e78fa8c89559ec38cd5a106b4101e (commit)
       via  3a2de079d507b612fb7ada1a957ea539bea29fc5 (commit)
       via  a82e7953257db9d70cd2f05d0d7cbc98153bd10f (commit)
       via  c5018a2bbb4e48c57072b6d9bba35197a7c589fa (commit)
       via  6a4be32986a1af4aa6cab917b3b62f90b3436476 (commit)
       via  fca4388748645f817e69505cb2c2c7733debb99b (commit)
       via  c812243ba15a9d13bb6f1876892e7a1efea9bf4e (commit)
       via  26224b3f5d795e523e921ec32ffec424893ea035 (commit)
      from  e354d7689aca1f6482bd90a2c367617222052265 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6dc797eee9041498eec7053d32d8721c3660fb51
Merge: d66b74dce74c2824726746e82a8a413463cb80fd 
e354d7689aca1f6482bd90a2c367617222052265
Author: Ludovic Courtès <address@hidden>
Date:   Wed Sep 9 22:32:02 2009 +0200

    Merge branch 'master' into boehm-demers-weiser-gc
    
    Conflicts:
        libguile/gc_os_dep.c

-----------------------------------------------------------------------

Summary of changes:
 README                                             |   13 +-
 benchmark-guile.in                                 |    4 +-
 configure.ac                                       |   19 +
 doc/ref/api-memory.texi                            |  108 +-
 doc/ref/api-smobs.texi                             |   57 +-
 gc-benchmarks/larceny/dynamic-input-large.sch      |    2 +-
 gc-benchmarks/run-benchmark.scm                    |  166 ++-
 lib/Makefile.am                                    |    9 +-
 lib/count-one-bits.h                               |   77 -
 libguile/Makefile.am                               |   14 -
 libguile/arbiters.c                                |    1 -
 libguile/array-map.c                               |   18 +-
 libguile/async.c                                   |    6 -
 libguile/boehm-gc.h                                |   48 +
 libguile/bytevectors.c                             |  218 +--
 libguile/bytevectors.h                             |   40 +-
 libguile/continuations.c                           |   38 -
 libguile/debug.c                                   |    1 -
 libguile/deprecated.c                              |   25 +-
 libguile/deprecated.h                              |   23 +-
 libguile/dynl.c                                    |   20 +-
 libguile/dynwind.c                                 |    9 -
 libguile/environments.c                            |  137 +--
 libguile/environments.h                            |    2 -
 libguile/eq.c                                      |    3 +
 libguile/eval.c                                    |   17 +-
 libguile/evalext.c                                 |    1 +
 libguile/fluids.c                                  |  216 +--
 libguile/fluids.h                                  |    7 -
 libguile/fports.c                                  |   17 +-
 libguile/frames.c                                  |   17 +-
 libguile/futures.c                                 |    5 -
 libguile/gc-card.c                                 |  481 -----
 libguile/gc-freelist.c                             |  193 --
 libguile/gc-malloc.c                               |  191 +--
 libguile/gc-mark.c                                 |  520 ------
 libguile/gc-segment-table.c                        |  300 ---
 libguile/gc-segment.c                              |  280 ---
 libguile/gc.c                                      |  617 ++-----
 libguile/gc.h                                      |  170 +--
 libguile/gc_os_dep.c                               | 1946 --------------------
 libguile/gdbint.c                                  |   40 +-
 libguile/goops.c                                   |   16 +-
 libguile/guardians.c                               |  301 ++--
 libguile/hashtab.c                                 |  320 +++--
 libguile/hashtab.h                                 |    4 -
 libguile/hooks.c                                   |   12 +-
 libguile/i18n.c                                    |   26 +-
 libguile/init.c                                    |    4 +-
 libguile/inline.h                                  |  145 +-
 libguile/keywords.c                                |    1 -
 libguile/load.c                                    |    9 +-
 libguile/macros.c                                  |   13 +-
 libguile/mallocs.c                                 |   11 +-
 libguile/modules.c                                 |   23 +-
 libguile/numbers.c                                 |    5 +-
 libguile/objcodes.c                                |   11 +-
 libguile/objects.c                                 |    1 -
 libguile/ports.c                                   |   92 +-
 libguile/ports.h                                   |    1 -
 libguile/posix.c                                   |   31 +-
 libguile/print.c                                   |   30 +-
 libguile/private-gc.h                              |  229 +---
 libguile/procs.c                                   |    9 -
 libguile/procs.h                                   |    8 -
 libguile/pthread-threads.h                         |    3 +
 libguile/r6rs-ports.c                              |   52 +-
 libguile/random.c                                  |   17 +-
 libguile/regex-posix.c                             |    2 +-
 libguile/root.h                                    |   12 +-
 libguile/scmsigs.c                                 |   30 +-
 libguile/simpos.c                                  |   13 +-
 libguile/smob.c                                    |  167 ++-
 libguile/smob.h                                    |   97 +-
 libguile/srcprop.c                                 |    9 +-
 libguile/srfi-14.c                                 |   41 -
 libguile/srfi-4.c                                  |   41 +-
 libguile/srfi-4.i.c                                |   12 +-
 libguile/strings.c                                 |  351 ++---
 libguile/strings.h                                 |   14 -
 libguile/struct.c                                  |  143 +-
 libguile/struct.h                                  |   14 -
 libguile/symbols.c                                 |   51 +-
 libguile/tags.h                                    |   12 +-
 libguile/threads.c                                 |  334 ++--
 libguile/threads.h                                 |   42 +-
 libguile/validate.h                                |    5 +-
 libguile/vectors.c                                 |  144 ++-
 libguile/vectors.h                                 |    3 +-
 libguile/version.c                                 |   14 +-
 libguile/vm-engine.h                               |    2 +-
 libguile/vm.c                                      |  148 +-
 libguile/weaks.c                                   |  320 ++--
 libguile/weaks.h                                   |   29 +
 m4/count-one-bits.m4                               |   12 -
 m4/gnulib-cache.m4                                 |    3 +-
 m4/gnulib-comp.m4                                  |    3 -
 meta/guile-2.0-uninstalled.pc.in                   |    2 +-
 meta/guile-2.0.pc.in                               |    2 +-
 module/ice-9/boot-9.scm                            |   14 +-
 test-suite/Makefile.am                             |    1 -
 test-suite/standalone/.gitignore                   |    1 +
 test-suite/standalone/Makefile.am                  |    7 +
 ...ke-locale-symbol.c => test-scm-take-u8vector.c} |   29 +-
 test-suite/tests/bytevectors.test                  |    3 +
 .../{environments.test => environments.nottest}    |    3 +-
 test-suite/tests/gc.test                           |   17 +-
 test-suite/tests/guardians.test                    |   70 +-
 test-suite/tests/strings.test                      |   20 -
 test-suite/tests/symbols.test                      |   19 -
 110 files changed, 2484 insertions(+), 7222 deletions(-)
 delete mode 100644 lib/count-one-bits.h
 create mode 100644 libguile/boehm-gc.h
 delete mode 100644 libguile/gc-card.c
 delete mode 100644 libguile/gc-freelist.c
 delete mode 100644 libguile/gc-mark.c
 delete mode 100644 libguile/gc-segment-table.c
 delete mode 100644 libguile/gc-segment.c
 delete mode 100644 libguile/gc_os_dep.c
 delete mode 100644 m4/count-one-bits.m4
 copy test-suite/standalone/{test-scm-take-locale-symbol.c => 
test-scm-take-u8vector.c} (61%)
 rename test-suite/tests/{environments.test => environments.nottest} (99%)

diff --git a/README b/README
index bea40de..c4f24f8 100644
--- a/README
+++ b/README
@@ -33,6 +33,7 @@ Guile depends on the following external libraries.
 - libintl
 - libltdl
 - libunistring
+- libgc
 It will also use the libreadline library if it is available.  For each
 of these there is a corresponding --with-XXX-prefix option that you
 can use when invoking ./configure, if you have these libraries
@@ -68,12 +69,12 @@ Guile requires the following external packages:
   - GNU MP, at least version 4.1
 
     GNU MP is used for bignum arithmetic.  It is available from
-    http://swox.com/gmp
+    http://gmplib.org/ .
 
-  - libltdl from libtool, at least from libtool version 1.5.6
+  - libltdl from GNU Libtool, at least version 1.5.6
 
     libltdl is used for loading extensions at run-time.  It is
-    available from http://www.gnu.org/software/libtool/
+    available from http://www.gnu.org/software/libtool/ .
 
   - GNU libunistring
 
@@ -81,6 +82,12 @@ Guile requires the following external packages:
     `utf*->string' procedures.  It is available from
     http://www.gnu.org/software/libunistring/ .
 
+  - libgc, at least version 7.0
+
+    libgc (aka. the Boehm-Demers-Weiser garbage collector) is the
+    conservative garbage collector used by Guile.  It is available
+    from http://www.hpl.hp.com/personal/Hans_Boehm/gc/ .
+
 
 Special Instructions For Some Systems =====================================
 
diff --git a/benchmark-guile.in b/benchmark-guile.in
index af1ade6..34f9c06 100644
--- a/benchmark-guile.in
+++ b/benchmark-guile.in
@@ -1,6 +1,6 @@
 #! /bin/sh
 # Usage: benchmark-guile [-i GUILE-INTERPRETER] [GUILE-BENCHMARK-ARGS]
-# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/pre-inst-guile.
+# If `-i GUILE-INTERPRETER' is omitted, use ${top_builddir}/meta/guile.
 # See ${top_srcdir}/benchmark-suite/guile-benchmark for documentation on 
GUILE-BENCHMARK-ARGS.
 #
 # Example invocations:
@@ -21,7 +21,7 @@ if [ x"$1" = x-i ] ; then
     shift
     shift
 else
-    guile=${top_builddir}/pre-inst-guile
+    guile=${top_builddir}/meta/guile
 fi
 
 GUILE_LOAD_PATH=$BENCHMARK_SUITE_DIR
diff --git a/configure.ac b/configure.ac
index 8f420b5..0e878a2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1167,6 +1167,25 @@ main ()
               [],
               [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)])
 
+#--------------------------------------------------------------------
+#
+# Boehm's GC library
+#
+#--------------------------------------------------------------------
+PKG_CHECK_MODULES([BDW_GC], [bdw-gc])
+
+CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
+LIBS="$BDW_GC_LIBS $LIBS"
+
+# `GC_do_blocking ()' is available in GC 7.1 but not declared.
+AC_CHECK_FUNCS([GC_do_blocking])
+AC_CHECK_DECL([GC_do_blocking],
+  [AC_DEFINE([HAVE_DECL_GC_DO_BLOCKING], [1],
+    [Define this if the `GC_do_blocking ()' function is declared])],
+  [],
+  [#include <gc/gc.h>])
+
+
 AC_CHECK_SIZEOF(float)
 if test "$ac_cv_sizeof_float" -le "$ac_cv_sizeof_long"; then
     AC_DEFINE(SCM_SINGLES, 1, 
diff --git a/doc/ref/api-memory.texi b/doc/ref/api-memory.texi
index f492203..2bf7f10 100644
--- a/doc/ref/api-memory.texi
+++ b/doc/ref/api-memory.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -41,6 +41,11 @@ otherwise might be.  When you are done with the object, call
 the object remains protected until it has been unprotected as many times
 as it was protected. It is an error to unprotect an object more times
 than it has been protected. Returns the SCM object it was passed.
+
+Note that storing @var{obj} in a C global variable has the same
address@hidden Guile up to version 1.8, C global variables were not
+scanned by the garbage collector; hence, @code{scm_gc_protect_object}
+was the only way in C to prevent a Scheme object from being freed.}.
 @end deftypefn
 
 @deftypefn {C Function} SCM scm_gc_unprotect_object (SCM @var{obj})
@@ -98,38 +103,52 @@ typically from a smob @emph{mark} function.
 @node Memory Blocks
 @subsection Memory Blocks
 
address@hidden automatically-managed memory
address@hidden GC-managed memory
address@hidden conservative garbage collection
+
 In C programs, dynamic management of memory blocks is normally done
 with the functions malloc, realloc, and free.  Guile has additional
 functions for dynamic memory allocation that are integrated into the
 garbage collector and the error reporting system.
 
 Memory blocks that are associated with Scheme objects (for example a
-smob) should be allocated and freed with @code{scm_gc_malloc} and
address@hidden  The function @code{scm_gc_malloc} will either
-return a valid pointer or signal an error.  It will also assume that
-the new memory can be freed by a garbage collection.  The garbage
-collector uses this information to decide when to try to actually
-collect some garbage.  Memory blocks allocated with
address@hidden must be freed with @code{scm_gc_free}.
+smob) should be allocated and freed with @code{scm_gc_malloc} or
address@hidden  These two functions will either
+return a valid pointer or signal an error.  Memory blocks allocated this
+way can be freed with @code{scm_gc_free}; however, this is not strictly
+needed: memory allocated with @code{scm_gc_malloc} or
address@hidden is automatically reclaimed when the
+garbage collector no longer sees any live reference to address@hidden
+Guile up to version 1.8, memory allocated with @code{scm_gc_malloc}
address@hidden to be freed with @code{scm_gc_free}.}.
+
+Memory allocated with @code{scm_gc_malloc} is scanned for live pointers.
+This means that if @code{scm_gc_malloc}-allocated memory contains a
+pointer to some other part of the memory, the garbage collector notices
+it and prevents it from being address@hidden Guile up to 1.8,
+memory allocated with @code{scm_gc_malloc} was @emph{not} scanned.
+Consequently, the GC had to be told explicitly about pointers to live
+objects contained in the memory block, e.g., @i{via} SMOB mark functions
+(@pxref{Smobs, @code{scm_set_smob_mark}})}.  Conversely, memory
+allocated with @code{scm_gc_malloc_pointerless} is assumed to be
+``pointer-less'' and is not scanned.
 
 For memory that is not associated with a Scheme object, you can use
 @code{scm_malloc} instead of @code{malloc}.  Like
 @code{scm_gc_malloc}, it will either return a valid pointer or signal
 an error.  However, it will not assume that the new memory block can
-be freed by a garbage collection.  The memory can be freed with
address@hidden
+be freed by a garbage collection.  The memory must be explicitly freed
+with @code{free}.
 
 There is also @code{scm_gc_realloc} and @code{scm_realloc}, to be used
 in place of @code{realloc} when appropriate, and @code{scm_gc_calloc}
 and @code{scm_calloc}, to be used in place of @code{calloc} when
 appropriate.
 
-The function @code{scm_dynwind_free} can be useful when memory should
-be freed when a dynwind context, @xref{Dynamic Wind}.
-
-For really specialized needs, take at look at
address@hidden and
address@hidden
+The function @code{scm_dynwind_free} can be useful when memory should be
+freed with libc's @code{free} when leaving a dynwind context,
address@hidden Wind}.
 
 @deftypefn {C Function} {void *} scm_malloc (size_t @var{size})
 @deftypefnx {C Function} {void *} scm_calloc (size_t @var{size})
@@ -161,6 +180,36 @@ runs the GC to free up some memory when it deems it 
appropriate.
 
 
 
address@hidden {C Function} {void *} scm_gc_malloc (size_t @var{size}, const 
char address@hidden)
address@hidden {C Function} {void *} scm_gc_malloc_pointerless (size_t 
@var{size}, const char address@hidden)
address@hidden {C Function} {void *} scm_gc_realloc (void address@hidden, 
size_t @var{old_size}, size_t @var{new_size}, const char address@hidden);
address@hidden {C Function} {void *} scm_gc_calloc (size_t @var{size}, const 
char address@hidden)
+Allocate @var{size} bytes of automatically-managed memory.  The memory
+is automatically freed when no longer referenced from any live memory
+block.
+
+Memory allocated with @code{scm_gc_malloc} or @code{scm_gc_calloc} is
+scanned for pointers.  Memory allocated by
address@hidden is not scanned.
+
+The @code{scm_gc_realloc} call preserves the ``pointerlessness'' of the
+memory area pointed to by @var{mem}.  Note that you need to pass the old
+size of a reallocated memory block as well.  See below for a motivation.
address@hidden deftypefn
+
+
address@hidden {C Function} void scm_gc_free (void address@hidden, size_t 
@var{size}, const char address@hidden)
+Explicitly free the memory block pointed to by @var{mem}, which was
+previously allocated by one of the above @code{scm_gc} functions.
+
+Note that you need to explicitly pass the @var{size} parameter.  This
+is done since it should normally be easy to provide this parameter
+(for memory that is associated with GC controlled objects) and help keep
+the memory management overhead very low.  However, in Guile 2.x,
address@hidden is always ignored.
address@hidden deftypefn
+
+
 @deftypefn {C Function} void scm_gc_register_collectable_memory (void 
address@hidden, size_t @var{size}, const char address@hidden)
 Informs the GC that the memory at @var{mem} of size @var{size} can
 potentially be freed during a GC.  That is, announce that @var{mem} is
@@ -170,13 +219,12 @@ object, @var{size} bytes will be freed along with it.  
The GC will
 much bytes of memory are associated with GC controlled objects and the
 memory system figures this into its decisions when to run a GC.
 
address@hidden does not need to come from @code{scm_malloc}.  You can only
-call this function once for every memory block.
-
 The @var{what} argument is used for statistical purposes.  It should
 describe the type of object that the memory will be used for so that
 users can identify just what strange objects are eating up their
 memory.
+
+In Guile 2.x, this function has no effect.
 @end deftypefn
 
 @deftypefn {C Function} void scm_gc_unregister_collectable_memory (void 
address@hidden, size_t @var{size})
@@ -186,28 +234,11 @@ match up every call to 
@code{scm_gc_register_collectable_memory} with
 a call to @code{scm_gc_unregister_collectable_memory}.  If you don't do
 this, the GC might have a wrong impression of what is going on and run
 much less efficiently than it could.
address@hidden deftypefn
 
address@hidden {C Function} {void *} scm_gc_malloc (size_t @var{size}, const 
char address@hidden)
address@hidden {C Function} {void *} scm_gc_realloc (void address@hidden, 
size_t @var{old_size}, size_t @var{new_size}, const char address@hidden);
address@hidden {C Function} {void *} scm_gc_calloc (size_t @var{size}, const 
char address@hidden)
-Like @code{scm_malloc}, @code{scm_realloc} or @code{scm_calloc}, but
-also call @code{scm_gc_register_collectable_memory}.  Note that you
-need to pass the old size of a reallocated memory block as well.  See
-below for a motivation.
+In Guile 2.x, this function has no effect.
 @end deftypefn
 
 
address@hidden {C Function} void scm_gc_free (void address@hidden, size_t 
@var{size}, const char address@hidden)
-Like @code{free}, but also call @code{scm_gc_unregister_collectable_memory}.
-
-Note that you need to explicitly pass the @var{size} parameter.  This
-is done since it should normally be easy to provide this parameter
-(for memory that is associated with GC controlled objects) and this
-frees us from tracking this value in the GC itself, which will keep
-the memory management overhead very low.
address@hidden deftypefn
-
 @deftypefn {C Function} void scm_frame_free (void *mem)
 Equivalent to @code{scm_frame_unwind_handler (free, @var{mem},
 SCM_F_WIND_EXPLICITLY)}.  That is, the memory block at @var{mem} will
@@ -220,6 +251,9 @@ of malloced objects.
 @var{what} is the second argument to @code{scm_gc_malloc},
 @var{n} is the number of objects of that type currently
 allocated.
+
+This function is only available if the @code{GUILE_DEBUG_MALLOC}
+preprocessor macro was defined when Guile was compiled.
 @end deffn
 
 
diff --git a/doc/ref/api-smobs.texi b/doc/ref/api-smobs.texi
index df000d8..cc7f08b 100644
--- a/doc/ref/api-smobs.texi
+++ b/doc/ref/api-smobs.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -8,6 +8,8 @@
 @node Smobs
 @section Smobs
 
address@hidden smob
+
 This chapter contains reference information related to defining and
 working with smobs.  See @ref{Defining New Types (Smobs)} for a
 tutorial-like introduction to smobs.
@@ -33,10 +35,47 @@ immediately followed by calls to one or several of
 @code{scm_set_smob_print}, and/or @code{scm_set_smob_equalp}.
 @end deftypefun
 
address@hidden finalizer
address@hidden finalization
+
address@hidden {C Function} void scm_set_smob_free (scm_t_bits tc, size_t 
(*free) (SCM obj))
+This function sets the smob freeing procedure (sometimes referred to as
+a @dfn{finalizer}) for the smob type specified by the tag
address@hidden @var{tc} is the tag returned by @code{scm_make_smob_type}.
+
+The @var{free} procedure must deallocate all resources that are
+directly associated with the smob instance @var{OBJ}.  It must assume
+that all @code{SCM} values that it references have already been freed
+and are thus invalid.
+
+It must also not call any libguile function or macro except
address@hidden, @code{SCM_SMOB_FLAGS}, @code{SCM_SMOB_DATA},
address@hidden, and @code{SCM_SMOB_DATA_3}.
+
+The @var{free} procedure must return 0.
+
+Note that defining a freeing procedure is not necessary if the resources
+associated with @var{obj} consists only of memory allocated with
address@hidden or @code{scm_gc_malloc_pointerless} because this
+memory is automatically reclaimed by the garbage collector when it is no
+longer needed (@pxref{Memory Blocks, @code{scm_gc_malloc}}).
address@hidden deftypefn
+
address@hidden precise marking
+
 @deftypefn {C Function} void scm_set_smob_mark (scm_t_bits tc, SCM (*mark) 
(SCM obj))
 This function sets the smob marking procedure for the smob type specified by
 the tag @var{tc}. @var{tc} is the tag returned by @code{scm_make_smob_type}.
 
+Defining a marking procedure should rarely be necessary because all the
+process' memory (with the exception of @code{scm_gc_malloc_pointerless}
+or read-only regions) is scanned for live address@hidden,
+in Guile up to the 1.8 series, the marking procedure was required.  The
+reason is that Guile's GC would only look for pointers in the memory
+area used for built-in types (the @dfn{cell heap}), not in
+user-allocated or statically allocated memory.  This approach is often
+referred to as @dfn{precise marking}.}.
+
 The @var{mark} procedure must cause @code{scm_gc_mark} to be called
 for every @code{SCM} value that is directly referenced by the smob
 instance @var{obj}.  One of these @code{SCM} values can be returned
@@ -49,22 +88,6 @@ It must not call any libguile function or macro except
 @code{SCM_SMOB_DATA_2}, and @code{SCM_SMOB_DATA_3}.
 @end deftypefn
 
address@hidden {C Function} void scm_set_smob_free (scm_t_bits tc, size_t 
(*free) (SCM obj))
-This function sets the smob freeing procedure for the smob type
-specified by the tag @var{tc}. @var{tc} is the tag returned by
address@hidden
-
-The @var{free} procedure must deallocate all resources that are
-directly associated with the smob instance @var{OBJ}.  It must assume
-that all @code{SCM} values that it references have already been freed
-and are thus invalid.
-
-It must also not call any libguile function or macro except
address@hidden, @code{SCM_SMOB_FLAGS}, @code{SCM_SMOB_DATA},
address@hidden, and @code{SCM_SMOB_DATA_3}.
-
-The @var{free} procedure must return 0.
address@hidden deftypefn
 
 @deftypefn {C Function} void scm_set_smob_print (scm_t_bits tc, int (*print) 
(SCM obj, SCM port, scm_print_state* pstate))
 This function sets the smob printing procedure for the smob type
diff --git a/gc-benchmarks/larceny/dynamic-input-large.sch 
b/gc-benchmarks/larceny/dynamic-input-large.sch
index 068ea3e..7bc52ef 100644
--- a/gc-benchmarks/larceny/dynamic-input-large.sch
+++ b/gc-benchmarks/larceny/dynamic-input-large.sch
@@ -1190,7 +1190,7 @@
 (let () (begin (set! make-fasl (lambda (.infilename|1 . .rest|1) (let 
((.doit|2 (unspecified))) (begin (set! .doit|2 (lambda () (let ((.outfilename|6 
(if (not (null? .rest|1)) (let ((.x|8|11 .rest|1)) (begin (.check! (pair? 
.x|8|11) 0 .x|8|11) (car:pair .x|8|11))) (rewrite-file-type .infilename|1 
*lop-file-type* *fasl-file-type*)))) (begin (process-file .infilename|1 
.outfilename|6 dump-fasl-segment-to-port (lambda (.x|7) .x|7)) 
(unspecified))))) (if (eq? (nbuild-parameter 'target-machine) 'standard-c) 
(error "Make-fasl not supported on this target architecture.") (.doit|2)))))) 
'make-fasl))
 (let () (begin (set! disassemble (lambda (.item|1 . .rest|1) (let 
((.output-port|4 (if (null? .rest|1) (current-output-port) (let ((.x|5|8 
.rest|1)) (begin (.check! (pair? .x|5|8) 0 .x|5|8) (car:pair .x|5|8)))))) 
(begin (disassemble-item .item|1 #f .output-port|4) (unspecified))))) 
'disassemble))
 (let () (begin (set! disassemble-item (lambda (.item|1 .segment-no|1 .port|1) 
(let ((.disassemble-item|2 0)) (begin (set! .disassemble-item|2 (lambda 
(.item|3 .segment-no|3 .port|3) (let ((.print-segment|5 (unspecified)) 
(.print-constvector|5 (unspecified)) (.print|5 (unspecified))) (begin (set! 
.print-segment|5 (lambda (.segment|6) (begin (.print|5 "Segment # " 
.segment-no|3) (print-instructions (disassemble-codevector (let ((.x|7|10 
.segment|6)) (begin (.check! (pair? .x|7|10) 0 .x|7|10) (car:pair .x|7|10)))) 
.port|3) (.print-constvector|5 (let ((.x|11|14 .segment|6)) (begin (.check! 
(pair? .x|11|14) 1 .x|11|14) (cdr:pair .x|11|14)))) (.print|5 
"========================================")))) (set! .print-constvector|5 
(lambda (.cv|15) (let () (let ((.loop|17|19|22 (unspecified))) (begin (set! 
.loop|17|19|22 (lambda (.i|23) (if (= .i|23 (let ((.v|25|28 .cv|15)) (begin 
(.check! (vector? .v|25|28) 42 .v|25|28) (vector-length:vec .v|25|28)))) (if #f 
#f (unspecified)) (begin (begin #t (.print|5 
"------------------------------------------") (.print|5 "Constant vector 
element # " .i|23) (let ((.temp|30|33 (let ((.x|90|93 (let ((.v|94|97 .cv|15) 
(.i|94|97 .i|23)) (begin (.check! (fixnum? .i|94|97) 40 .v|94|97 .i|94|97) 
(.check! (vector? .v|94|97) 40 .v|94|97 .i|94|97) (.check! (<:fix:fix .i|94|97 
(vector-length:vec .v|94|97)) 40 .v|94|97 .i|94|97) (.check! (>=:fix:fix 
.i|94|97 0) 40 .v|94|97 .i|94|97) (vector-ref:trusted .v|94|97 .i|94|97))))) 
(begin (.check! (pair? .x|90|93) 0 .x|90|93) (car:pair .x|90|93))))) (if (memv 
.temp|30|33 '(codevector)) (begin (.print|5 "Code vector") (print-instructions 
(disassemble-codevector (let ((.x|36|39 (let ((.x|40|43 (let ((.v|44|47 .cv|15) 
(.i|44|47 .i|23)) (begin (.check! (fixnum? .i|44|47) 40 .v|44|47 .i|44|47) 
(.check! (vector? .v|44|47) 40 .v|44|47 .i|44|47) (.check! (<:fix:fix .i|44|47 
(vector-length:vec .v|44|47)) 40 .v|44|47 .i|44|47) (.check! (>=:fix:fix 
.i|44|47 0) 40 .v|44|47 .i|44|47) (vector-ref:trusted .v|44|47 .i|44|47))))) 
(begin (.check! (pair? .x|40|43) 1 .x|40|43) (cdr:pair .x|40|43))))) (begin 
(.check! (pair? .x|36|39) 0 .x|36|39) (car:pair .x|36|39)))) .port|3)) (if 
(memv .temp|30|33 '(constantvector)) (begin (.print|5 "Constant vector") 
(.print-constvector|5 (let ((.x|50|53 (let ((.x|54|57 (let ((.v|58|61 .cv|15) 
(.i|58|61 .i|23)) (begin (.check! (fixnum? .i|58|61) 40 .v|58|61 .i|58|61) 
(.check! (vector? .v|58|61) 40 .v|58|61 .i|58|61) (.check! (<:fix:fix .i|58|61 
(vector-length:vec .v|58|61)) 40 .v|58|61 .i|58|61) (.check! (>=:fix:fix 
.i|58|61 0) 40 .v|58|61 .i|58|61) (vector-ref:trusted .v|58|61 .i|58|61))))) 
(begin (.check! (pair? .x|54|57) 1 .x|54|57) (cdr:pair .x|54|57))))) (begin 
(.check! (pair? .x|50|53) 0 .x|50|53) (car:pair .x|50|53))))) (if (memv 
.temp|30|33 '(global)) (.print|5 "Global: " (let ((.x|64|67 (let ((.x|68|71 
(let ((.v|72|75 .cv|15) (.i|72|75 .i|23)) (begin (.check! (fixnum? .i|72|75) 40 
.v|72|75 .i|72|75) (.check! (vector? .v|72|75) 40 .v|72|75 .i|72|75) (.check! 
(<:fix:fix .i|72|75 (vector-length:vec .v|72|75)) 40 .v|72|75 .i|72|75) 
(.check! (>=:fix:fix .i|72|75 0) 40 .v|72|75 .i|72|75) (vector-ref:trusted 
.v|72|75 .i|72|75))))) (begin (.check! (pair? .x|68|71) 1 .x|68|71) (cdr:pair 
.x|68|71))))) (begin (.check! (pair? .x|64|67) 0 .x|64|67) (car:pair 
.x|64|67)))) (if (memv .temp|30|33 '(data)) (.print|5 "Data: " (let ((.x|78|81 
(let ((.x|82|85 (let ((.v|86|89 .cv|15) (.i|86|89 .i|23)) (begin (.check! 
(fixnum? .i|86|89) 40 .v|86|89 .i|86|89) (.check! (vector? .v|86|89) 40 
.v|86|89 .i|86|89) (.check! (<:fix:fix .i|86|89 (vector-length:vec .v|86|89)) 
40 .v|86|89 .i|86|89) (.check! (>=:fix:fix .i|86|89 0) 40 .v|86|89 .i|86|89) 
(vector-ref:trusted .v|86|89 .i|86|89))))) (begin (.check! (pair? .x|82|85) 1 
.x|82|85) (cdr:pair .x|82|85))))) (begin (.check! (pair? .x|78|81) 0 .x|78|81) 
(car:pair .x|78|81)))) (unspecified))))))) (.loop|17|19|22 (+ .i|23 1)))))) 
(.loop|17|19|22 0)))))) (set! .print|5 (lambda .rest|98 (begin (let () (let 
((.loop|104|106|109 (unspecified))) (begin (set! .loop|104|106|109 (lambda 
(.y1|99|100|110) (if (null? .y1|99|100|110) (if #f #f (unspecified)) (begin 
(begin #t (let ((.x|114 (let ((.x|115|118 .y1|99|100|110)) (begin (.check! 
(pair? .x|115|118) 0 .x|115|118) (car:pair .x|115|118))))) (display .x|114 
.port|3))) (.loop|104|106|109 (let ((.x|119|122 .y1|99|100|110)) (begin 
(.check! (pair? .x|119|122) 1 .x|119|122) (cdr:pair .x|119|122)))))))) 
(.loop|104|106|109 .rest|98)))) (newline .port|3)))) (if (procedure? .item|3) 
(print-instructions (disassemble-codevector (procedure-ref .item|3 0)) .port|3) 
(if (if (pair? .item|3) (if (bytevector? (let ((.x|126|129 .item|3)) (begin 
(.check! (pair? .x|126|129) 0 .x|126|129) (car:pair .x|126|129)))) (vector? 
(let ((.x|131|134 .item|3)) (begin (.check! (pair? .x|131|134) 1 .x|131|134) 
(cdr:pair .x|131|134)))) #f) #f) (.print-segment|5 .item|3) (error 
"disassemble-item: " .item|3 " is not disassemblable."))))))) 
(.disassemble-item|2 .item|1 .segment-no|1 .port|1))))) 'disassemble-item))
-(let () (begin (set! disassemble-file (lambda (.file|1 . .rest|1) (let 
((.doit|2 (unspecified))) (begin (set! .doit|2 (lambda (.input-port|3 
.output-port|3) (begin (display "\; From " .output-port|3) (display .file|1 
.output-port|3) (newline .output-port|3) (let () (let ((.loop|5|8|11 
(unspecified))) (begin (set! .loop|5|8|11 (lambda (.segment-no|12 .segment|12) 
(if (eof-object? .segment|12) (if #f #f (unspecified)) (begin (begin #t 
(disassemble-item .segment|12 .segment-no|12 .output-port|3)) (.loop|5|8|11 (+ 
.segment-no|12 1) (read .input-port|3)))))) (.loop|5|8|11 0 (read 
.input-port|3)))))))) (call-with-input-file .file|1 (lambda (.input-port|15) 
(if (null? .rest|1) (.doit|2 .input-port|15 (current-output-port)) (begin 
(delete-file (let ((.x|16|19 .rest|1)) (begin (.check! (pair? .x|16|19) 0 
.x|16|19) (car:pair .x|16|19)))) (call-with-output-file (let ((.x|20|23 
.rest|1)) (begin (.check! (pair? .x|20|23) 0 .x|20|23) (car:pair .x|20|23))) 
(lambda (.output-port|24) (.doit|2 .input-port|15 .output-port|24))))))) 
(unspecified))))) 'disassemble-file))
+(let () (begin (set! disassemble-file (lambda (.file|1 . .rest|1) (let 
((.doit|2 (unspecified))) (begin (set! .doit|2 (lambda (.input-port|3 
.output-port|3) (begin (display "; From " .output-port|3) (display .file|1 
.output-port|3) (newline .output-port|3) (let () (let ((.loop|5|8|11 
(unspecified))) (begin (set! .loop|5|8|11 (lambda (.segment-no|12 .segment|12) 
(if (eof-object? .segment|12) (if #f #f (unspecified)) (begin (begin #t 
(disassemble-item .segment|12 .segment-no|12 .output-port|3)) (.loop|5|8|11 (+ 
.segment-no|12 1) (read .input-port|3)))))) (.loop|5|8|11 0 (read 
.input-port|3)))))))) (call-with-input-file .file|1 (lambda (.input-port|15) 
(if (null? .rest|1) (.doit|2 .input-port|15 (current-output-port)) (begin 
(delete-file (let ((.x|16|19 .rest|1)) (begin (.check! (pair? .x|16|19) 0 
.x|16|19) (car:pair .x|16|19)))) (call-with-output-file (let ((.x|20|23 
.rest|1)) (begin (.check! (pair? .x|20|23) 0 .x|20|23) (car:pair .x|20|23))) 
(lambda (.output-port|24) (.doit|2 .input-port|15 .output-port|24))))))) 
(unspecified))))) 'disassemble-file))
 (let () (begin (set! compiler-switches (lambda .rest|1 (let 
((.fast-unsafe-code|3 (unspecified)) (.fast-safe-code|3 (unspecified)) 
(.standard-code|3 (unspecified)) (.slow-code|3 (unspecified))) (begin (set! 
.fast-unsafe-code|3 (lambda () (begin (set-compiler-flags! 'fast-unsafe) 
(set-assembler-flags! 'fast-unsafe)))) (set! .fast-safe-code|3 (lambda () 
(begin (set-compiler-flags! 'fast-safe) (set-assembler-flags! 'fast-safe)))) 
(set! .standard-code|3 (lambda () (begin (set-compiler-flags! 'standard) 
(set-assembler-flags! 'standard)))) (set! .slow-code|3 (lambda () (begin 
(set-compiler-flags! 'no-optimization) (set-assembler-flags! 
'no-optimization)))) (if (null? .rest|1) (begin (display "Debugging:") 
(newline) (display-twobit-flags 'debugging) (display-assembler-flags 
'debugging) (newline) (display "Safety:") (newline) (display-twobit-flags 
'safety) (display-assembler-flags 'safety) (newline) (display "Speed:") 
(newline) (display-twobit-flags 'optimization) (display-assembler-flags 
'optimization) (if #f #f (unspecified))) (if (null? (let ((.x|9|12 .rest|1)) 
(begin (.check! (pair? .x|9|12) 1 .x|9|12) (cdr:pair .x|9|12)))) (begin (let 
((.temp|13|16 (let ((.x|27|30 .rest|1)) (begin (.check! (pair? .x|27|30) 0 
.x|27|30) (car:pair .x|27|30))))) (if (memv .temp|13|16 '(0 slow)) 
(.slow-code|3) (if (memv .temp|13|16 '(1 standard)) (.standard-code|3) (if 
(memv .temp|13|16 '(2 fast-safe)) (.fast-safe-code|3) (if (memv .temp|13|16 '(3 
fast-unsafe)) (.fast-unsafe-code|3) (if (memv .temp|13|16 '(default 
factory-settings)) (begin (.fast-safe-code|3) (include-source-code #t) 
(benchmark-mode #f) (benchmark-block-mode #f) (common-subexpression-elimination 
#f) (representation-inference #f)) (error "Unrecognized flag " (let ((.x|23|26 
.rest|1)) (begin (.check! (pair? .x|23|26) 0 .x|23|26) (car:pair .x|23|26))) " 
to compiler-switches."))))))) (unspecified)) (error "Too many arguments to 
compiler-switches."))))))) 'compiler-switches))
 (let () (begin (set! process-file (lambda (.infilename|1 .outfilename|1 
.writer|1 .processer|1) (let ((.process-file|2 0)) (begin (set! .process-file|2 
(lambda (.infilename|3 .outfilename|3 .writer|3 .processer|3) (let ((.doit|6 
(unspecified))) (begin (set! .doit|6 (lambda () (begin (delete-file 
.outfilename|3) (call-with-output-file .outfilename|3 (lambda (.outport|8) 
(call-with-input-file .infilename|3 (lambda (.inport|9) (let ((.x|12 (read 
.inport|9))) (let () (let ((.loop|15 (unspecified))) (begin (set! .loop|15 
(lambda (.x|16) (if (eof-object? .x|16) #t (begin (.writer|3 (.processer|3 
.x|16) .outport|8) (.loop|15 (read .inport|9)))))) (.loop|15 .x|12)))))))))))) 
(let ((.current-syntactic-environment|17 (syntactic-copy 
global-syntactic-environment))) (dynamic-wind (lambda () #t) (lambda () 
(.doit|6)) (lambda () (set! global-syntactic-environment 
.current-syntactic-environment|17)))))))) (.process-file|2 .infilename|1 
.outfilename|1 .writer|1 .processer|1))))) 'process-file))
 (let () (begin (set! process-file-block (lambda (.infilename|1 .outfilename|1 
.writer|1 .processer|1) (let ((.process-file-block|2 0)) (begin (set! 
.process-file-block|2 (lambda (.infilename|3 .outfilename|3 .writer|3 
.processer|3) (let ((.doit|6 (unspecified))) (begin (set! .doit|6 (lambda () 
(begin (delete-file .outfilename|3) (call-with-output-file .outfilename|3 
(lambda (.outport|8) (call-with-input-file .infilename|3 (lambda (.inport|9) 
(let () (let ((.loop|10|13|16 (unspecified))) (begin (set! .loop|10|13|16 
(lambda (.x|17 .forms|17) (if (eof-object? .x|17) (.writer|3 (.processer|3 
(reverse .forms|17)) .outport|8) (begin #t (.loop|10|13|16 (read .inport|9) 
(cons .x|17 .forms|17)))))) (.loop|10|13|16 (read .inport|9) '()))))))))))) 
(let ((.current-syntactic-environment|20 (syntactic-copy 
global-syntactic-environment))) (dynamic-wind (lambda () #t) (lambda () 
(.doit|6)) (lambda () (set! global-syntactic-environment 
.current-syntactic-environment|20)))))))) (.process-file-block|2 .infilename|1 
.outfilename|1 .writer|1 .processer|1))))) 'process-file-block))
diff --git a/gc-benchmarks/run-benchmark.scm b/gc-benchmarks/run-benchmark.scm
index 915143f..7a9e67b 100755
--- a/gc-benchmarks/run-benchmark.scm
+++ b/gc-benchmarks/run-benchmark.scm
@@ -4,7 +4,7 @@ exec ${GUILE-guile} -q -l "$0"                                  
\
                     -c '(apply main (cdr (command-line)))'      \
                     --benchmark-dir="$(dirname $0)" "$@"
 !#
-;;; Copyright (C) 2008 Free Software Foundation, Inc.
+;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -25,6 +25,7 @@ exec ${GUILE-guile} -q -l "$0"                                
  \
              (ice-9 popen)
              (ice-9 regex)
              (ice-9 format)
+             (ice-9 pretty-print)
              (srfi srfi-1)
              (srfi srfi-37))
 
@@ -103,23 +104,64 @@ exec ${GUILE-guile} -q -l "$0"                            
      \
           result)))
 
 (define (pretty-print-result benchmark reference bdwgc)
+  (define ref-heap (assoc-ref reference 'heap-size))
+  (define ref-time (assoc-ref reference 'execution-time))
+
+  (define (distance x1 y1 x2 y2)
+    ;; Return the distance between (X1,Y1) and (X2,Y2).  Y is the heap size,
+    ;; in MiB and X is the execution time in seconds.
+    (let ((y1 (/ y1 (expt 2 20)))
+          (y2 (/ y2 (expt 2 20))))
+      (sqrt (+ (expt (- y1 y2) 2)
+               (expt (- x1 x2) 2)))))
+
+  (define (score time heap)
+    ;; Return a score lower than +1.0.  The score is positive if the
+    ;; distance to the origin of (TIME,HEAP) is smaller than that of
+    ;; (REF-TIME,REF-HEAP), negative otherwise.
+
+    ;; heap  ^         .
+    ;; size  |         .   worse
+    ;;       |         .    [-]
+    ;;       |         .
+    ;;       | . . . .ref. . . .
+    ;;       |         .
+    ;;       |  [+]    .
+    ;;       | better  .
+    ;;     0 +-------------------->
+    ;;                        exec. time
+
+    (let ((ref-dist (distance ref-time ref-heap 0 0))
+          (dist     (distance time heap 0 0)))
+      (/ (- ref-dist dist) ref-dist)))
+
+  (define (score-string time heap)
+    ;; Return a string denoting a bar to illustrate the score of (TIME,HEAP)
+    ;; relative to (REF-TIME,REF-HEAP).
+    (define %max-width 15)
+
+    (let ((s (score time heap)))
+      (make-string (inexact->exact (round (* (if (< s 0.0) (- s) s)
+                                             %max-width)))
+                   (if (< s 0.0)
+                       #\-
+                       #\+))))
+
   (define (print-line name result ref?)
-    (let ((name     (string-pad-right name 23))
-          (time     (assoc-ref result 'execution-time))
-          (heap     (assoc-ref result 'heap-size))
-          (ref-heap (assoc-ref reference 'heap-size))
-          (ref-time (assoc-ref reference 'execution-time)))
-      (format #t "~a ~1,2f (~,2fx)     ~6,3f (~,2fx)~A~%"
+    (let ((name (string-pad-right name 23))
+          (time (assoc-ref result 'execution-time))
+          (heap (assoc-ref result 'heap-size)))
+      (format #t "~a ~6,2f (~,2fx)    ~7,3f (~,2fx)~A~%"
               name
-              (/ heap 1000000.0) (/ heap ref-heap 1.0)
+              (/ heap (expt 2.0 20)) (/ heap ref-heap 1.0)
               time (/ time ref-time 1.0)
-              (if (and (not ref?)
-                       (<= heap ref-heap) (<= time ref-time))
-                  " !"
+              (if (not ref?)
+                  (string-append " "
+                                 (score-string time heap))
                   ""))))
 
   (format #t "benchmark: `~a'~%" benchmark)
-  (format #t "                     heap size (MiB) execution time (s.)~%")
+  (format #t "                       heap size (MiB)  execution time (s.)~%")
   (print-line "Guile" reference #t)
   (for-each (lambda (bdwgc)
               (let ((name (format #f "BDW-GC, FSD=~a~a"
@@ -134,6 +176,12 @@ exec ${GUILE-guile} -q -l "$0"                             
     \
                 (print-line name bdwgc #f)))
             bdwgc))
 
+(define (print-raw-result benchmark reference bdwgc)
+  (pretty-print `(,benchmark
+                  (reference . ,reference)
+                  (bdw-gc    . ,bdwgc))))
+
+
 
 ;;;
 ;;; Option processing.
@@ -170,14 +218,22 @@ exec ${GUILE-guile} -q -l "$0"                            
      \
                 (lambda (opt name arg result)
                   (alist-cons 'log-port (open-output-file arg)
                               (alist-delete 'log-port result
-                                            eq?))))))
+                                            eq?))))
+        (option '("raw") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'printer print-raw-result
+                              (alist-delete 'printer result eq?))))
+        (option '("load-results") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'load-results? #t result)))))
 
 (define %default-options
   `((reference-environment . "GUILE=guile")
     (benchmark-directory   . "./gc-benchmarks")
     (log-port              . ,(current-output-port))
     (profile-options       . "")
-    (input                 . ())))
+    (input                 . ())
+    (printer               . ,pretty-print-result)))
 
 (define (show-help)
   (format #t "Usage: run-benchmark [OPTIONS] BENCHMARKS...
@@ -199,6 +255,12 @@ comparison of standard Guile (1.9) and the BDW-GC-based 
Guile.
                   Pass OPTS as additional options for `gc-profile.scm'.
   -l, --log-file=FILE
                   Save output to FILE instead of the standard output.
+
+      --raw       Write benchmark results in raw (s-exp) format.
+      --load-results
+                  Load raw (s-exp) results instead of actually running
+                  the benchmarks.
+
   -d, --benchmark-dir=DIR
                   Use DIR as the GC benchmark directory where `gc-profile.scm'
                   lives (it is automatically determined by default).
@@ -234,36 +296,54 @@ Report bugs to <address@hidden>.~%"))
            (bdwgc-env (or (assoc-ref args 'bdwgc-environment)
                           (string-append "GUILE=" bench-dir
                                          "/../meta/guile")))
-           (prof-opts (assoc-ref args 'profile-options)))
-      (for-each (lambda (benchmark)
-                  (let ((ref   (parse-result (run-reference-guile ref-env
-                                                                  bench-dir
-                                                                  prof-opts
-                                                                  benchmark)))
-                        (bdwgc (map (lambda (fsd incremental?
-                                             generational? parallel?)
-                                      (let ((opts
-                                             (list
-                                              (cons 'free-space-divisor fsd)
-                                              (cons 'incremental? incremental?)
-                                              (cons 'generational? 
generational?)
-                                              (cons 'parallel? parallel?))))
-                                        (append opts
-                                                (parse-result
-                                                 (run-bdwgc-guile bdwgc-env
-                                                                  bench-dir
-                                                                  prof-opts
-                                                                  opts
-                                                                  
benchmark)))))
-                                    '( 3  6  9  3  3)
-                                    '(#f #f #f #t #f)    ;; incremental
-                                    '(#f #f #f #f #t)    ;; generational
-                                    '(#f #f #f #f #f)))) ;; parallel
-                    ;;(format #t "ref=~A~%" ref)
-                    ;;(format #t "bdw-gc=~A~%" bdwgc)
+           (prof-opts (assoc-ref args 'profile-options))
+           (print     (assoc-ref args 'printer)))
+      (define (run benchmark)
+        (let ((ref   (parse-result (run-reference-guile ref-env
+                                                        bench-dir
+                                                        prof-opts
+                                                        benchmark)))
+              (bdwgc (map (lambda (fsd incremental?
+                                       generational? parallel?)
+                            (let ((opts
+                                   (list
+                                    (cons 'free-space-divisor fsd)
+                                    (cons 'incremental? incremental?)
+                                    (cons 'generational? generational?)
+                                    (cons 'parallel? parallel?))))
+                              (append opts
+                                      (parse-result
+                                       (run-bdwgc-guile bdwgc-env
+                                                        bench-dir
+                                                        prof-opts
+                                                        opts
+                                                        benchmark)))))
+                          '( 3  6  9  3  3)
+                          '(#f #f #f #t #f)      ;; incremental
+                          '(#f #f #f #f #t)      ;; generational
+                          '(#f #f #f #f #f))))   ;; parallel
+          `(,benchmark
+            (reference . ,ref)
+            (bdw-gc    . ,bdwgc))))
+
+      (define (load-results file)
+        (with-input-from-file file
+          (lambda ()
+            (let loop ((results '()) (o (read)))
+              (if (eof-object? o)
+                  (reverse results)
+                  (loop (cons o results)
+                        (read)))))))
+
+      (for-each (lambda (result)
+                  (let ((benchmark (car result))
+                        (ref       (assoc-ref (cdr result) 'reference))
+                        (bdwgc     (assoc-ref (cdr result) 'bdw-gc)))
                     (with-output-to-port log
                       (lambda ()
-                        (pretty-print-result benchmark ref bdwgc)
+                        (print benchmark ref bdwgc)
                         (newline)
                         (force-output)))))
-                benchmark-files))))
+                (if (assoc-ref args 'load-results?)
+                    (append-map load-results benchmark-files)
+                    (map run benchmark-files))))))
diff --git a/lib/Makefile.am b/lib/Makefile.am
index 0f74b51..075cd75 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -9,7 +9,7 @@
 # the same distribution terms as the rest of that program.
 #
 # Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib 
--m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl 
--libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap 
canonicalize-lgpl count-one-bits environ extensions flock fpieee full-read 
full-write havelib iconv_open-utf lib-symbol-versions lib-symbol-visibility 
libunistring putenv stdlib strcase strftime striconveh string verify vsnprintf
+# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib 
--m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl 
--libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap 
canonicalize-lgpl environ extensions flock fpieee full-read full-write havelib 
iconv_open-utf lib-symbol-versions lib-symbol-visibility libunistring putenv 
stdlib strcase strftime striconveh string verify vsnprintf
 
 AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
 
@@ -160,13 +160,6 @@ CLEANFILES += configmake.h configmake.h-t
 
 ## end   gnulib module configmake
 
-## begin gnulib module count-one-bits
-
-
-EXTRA_DIST += count-one-bits.h
-
-## end   gnulib module count-one-bits
-
 ## begin gnulib module errno
 
 BUILT_SOURCES += $(ERRNO_H)
diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h
deleted file mode 100644
index 7ecae84..0000000
--- a/lib/count-one-bits.h
+++ /dev/null
@@ -1,77 +0,0 @@
-/* count-one-bits.h -- counts the number of 1-bits in a word.
-   Copyright (C) 2007-2008 Free Software Foundation, Inc.
-
-   This program 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 3 of the License, 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 Lesser General Public License for more details.
-
-   You should have received a copy of the GNU Lesser General Public License
-   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
-
-/* Written by Ben Pfaff.  */
-
-#ifndef COUNT_ONE_BITS_H
-# define COUNT_ONE_BITS_H 1
-
-#include <stdlib.h>
-#include "verify.h"
-
-/* Expand the code which computes the number of 1-bits of the local
-   variable 'x' of type TYPE (an unsigned integer type) and returns it
-   from the current function.  */
-#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
-#define COUNT_ONE_BITS(BUILTIN, TYPE)              \
-        return BUILTIN (x);
-#else
-#define COUNT_ONE_BITS(BUILTIN, TYPE)                                       \
-        /* This condition is written so as to avoid shifting by more than   \
-           31 bits at once, and also avoids a random HP-UX cc bug.  */      \
-        verify (((TYPE) -1 >> 31 >> 31 >> 2) == 0); /* TYPE has at most 64 
bits */ \
-        int count = count_one_bits_32 (x);                                  \
-        if (1 < (TYPE) -1 >> 31) /* TYPE has more than 32 bits? */          \
-          count += count_one_bits_32 (x >> 31 >> 1);                        \
-        return count;
-
-/* Compute and return the the number of 1-bits set in the least
-   significant 32 bits of X. */
-static inline int
-count_one_bits_32 (unsigned int x)
-{
-  x = ((x & 0xaaaaaaaaU) >> 1) + (x & 0x55555555U);
-  x = ((x & 0xccccccccU) >> 2) + (x & 0x33333333U);
-  x = (x >> 16) + (x & 0xffff);
-  x = ((x & 0xf0f0) >> 4) + (x & 0x0f0f);
-  return (x >> 8) + (x & 0x00ff);
-}
-#endif
-
-/* Compute and return the number of 1-bits set in X. */
-static inline int
-count_one_bits (unsigned int x)
-{
-  COUNT_ONE_BITS (__builtin_popcount, unsigned int);
-}
-
-/* Compute and return the number of 1-bits set in X. */
-static inline int
-count_one_bits_l (unsigned long int x)
-{
-  COUNT_ONE_BITS (__builtin_popcountl, unsigned long int);
-}
-
-#if HAVE_UNSIGNED_LONG_LONG_INT
-/* Compute and return the number of 1-bits set in X. */
-static inline int
-count_one_bits_ll (unsigned long long int x)
-{
-  COUNT_ONE_BITS (__builtin_popcountll, unsigned long long int);
-}
-#endif
-
-#endif /* COUNT_ONE_BITS_H */
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index d4d1a54..046ce21 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -133,14 +133,8 @@ libguile_la_SOURCES =                              \
        fports.c                                \
        frames.c                                \
        futures.c                               \
-       gc-card.c                               \
-       gc-freelist.c                           \
        gc-malloc.c                             \
-       gc-mark.c                               \
-       gc-segment-table.c                      \
-       gc-segment.c                            \
        gc.c                                    \
-       gc_os_dep.c                             \
        gdbint.c                                \
        gettext.c                               \
        generalized-arrays.c                    \
@@ -246,11 +240,7 @@ DOT_X_FILES =                                      \
        fluids.x                                \
        fports.x                                \
        futures.x                               \
-       gc-card.x                               \
        gc-malloc.x                             \
-       gc-mark.x                               \
-       gc-segment-table.x                      \
-       gc-segment.x                            \
        gc.x                                    \
        gettext.x                               \
        generalized-arrays.x                    \
@@ -347,11 +337,7 @@ DOT_DOC_FILES =                            \
        fluids.doc                              \
        fports.doc                              \
        futures.doc                             \
-       gc-card.doc                             \
        gc-malloc.doc                           \
-       gc-mark.doc                             \
-       gc-segment-table.doc                    \
-       gc-segment.doc                          \
        gc.doc                                  \
        gettext.doc                             \
        generalized-arrays.doc                  \
diff --git a/libguile/arbiters.c b/libguile/arbiters.c
index cc68c85..3567c90 100644
--- a/libguile/arbiters.c
+++ b/libguile/arbiters.c
@@ -159,7 +159,6 @@ void
 scm_init_arbiters ()
 {
   scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0);
-  scm_set_smob_mark (scm_tc16_arbiter, scm_markcdr);
   scm_set_smob_print (scm_tc16_arbiter, arbiter_print);
 #include "libguile/arbiters.x"
 }
diff --git a/libguile/array-map.c b/libguile/array-map.c
index fb9ceea..eaac54a 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -37,7 +37,6 @@
 #include "libguile/vectors.h"
 #include "libguile/bitvectors.h"
 #include "libguile/srfi-4.h"
-#include "libguile/dynwind.h"
 #include "libguile/generalized-arrays.h"
 #include "libguile/generalized-vectors.h"
 
@@ -78,6 +77,9 @@ static ra_iproc ra_asubrs[] =
   {0, 0, 0}
 };
 
+/* The WHAT argument for `scm_gc_malloc ()' et al.  */
+static const char indices_gc_hint[] = "array-indices";
+
 
 #define GVREF scm_c_generalized_vector_ref
 #define GVSET scm_c_generalized_vector_set_x
@@ -311,10 +313,8 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
        plvra = SCM_CDRLOC (*plvra);
       }
 
-    scm_dynwind_begin (0);
-
-    vinds = scm_malloc (sizeof(long) * SCM_I_ARRAY_NDIM (ra0));
-    scm_dynwind_free (vinds);
+    vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra0),
+                                      indices_gc_hint);
 
     for (k = 0; k <= kmax; k++)
       vinds[k] = SCM_I_ARRAY_DIMS (ra0)[k].lbnd;
@@ -343,7 +343,6 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
       }
     while (k >= 0);
 
-    scm_dynwind_end ();
     return 1;
     }
 }
@@ -1015,10 +1014,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 
2, 0, 0,
       if (kmax < 0)
        return scm_array_set_x (ra, scm_call_0 (proc), SCM_EOL);
 
-      scm_dynwind_begin (0);
-
-      vinds = scm_malloc (sizeof(long) * SCM_I_ARRAY_NDIM (ra));
-      scm_dynwind_free (vinds);
+      vinds = scm_gc_malloc_pointerless (sizeof(long) * SCM_I_ARRAY_NDIM (ra),
+                                        indices_gc_hint);
 
       for (k = 0; k <= kmax; k++)
        vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
@@ -1050,7 +1047,6 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 
0, 0,
        }
       while (k >= 0);
 
-      scm_dynwind_end ();
       return SCM_UNSPECIFIED;
     }
   else if (scm_is_generalized_vector (ra))
diff --git a/libguile/async.c b/libguile/async.c
index d3fb012..3e5a581 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -89,11 +89,6 @@ static scm_t_bits tc16_async;
 #define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) 
<< 16)))
 #define ASYNC_THUNK(X)         SCM_CELL_OBJECT_1 (X)
 
-static SCM
-async_gc_mark (SCM obj)
-{
-  return ASYNC_THUNK (obj);
-}
 
 SCM_DEFINE (scm_async, "async", 1, 0, 0,
            (SCM thunk),
@@ -483,7 +478,6 @@ scm_init_async ()
 {
   scm_asyncs = SCM_EOL;
   tc16_async = scm_make_smob_type ("async", 0);
-  scm_set_smob_mark (tc16_async, async_gc_mark);
 
 #include "libguile/async.x"
 }
diff --git a/libguile/boehm-gc.h b/libguile/boehm-gc.h
new file mode 100644
index 0000000..b3a8514
--- /dev/null
+++ b/libguile/boehm-gc.h
@@ -0,0 +1,48 @@
+#ifndef SCM_BOEHM_GC_H
+#define SCM_BOEHM_GC_H
+
+/* Copyright (C) 2006, 2008, 2009 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
+ */
+
+/* Correct header inclusion.  */
+
+#include "libguile/scmconfig.h"
+
+#ifdef SCM_USE_PTHREAD_THREADS
+
+/* When pthreads are used, let `libgc' know about it and redirect allocation
+   calls such as `GC_MALLOC ()' to (contention-free, faster) thread-local
+   allocation.  */
+
+# define GC_THREADS 1
+# define GC_REDIRECT_TO_LOCAL 1
+
+#endif
+
+#include <gc/gc.h>
+
+#if (! ((defined GC_VERSION_MAJOR) && (GC_VERSION_MAJOR >= 7)))
+/* This was needed with `libgc' 6.x.  */
+# include <gc/gc_local_alloc.h>
+#endif
+
+#if (defined GC_VERSION_MAJOR) && (GC_VERSION_MAJOR >= 7)
+/* This type was provided by `libgc' 6.x.  */
+typedef void *GC_PTR;
+#endif
+
+#endif /* SCM_BOEHM_GC_H */
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 9c2b119..4246f01 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -175,19 +175,14 @@
 
 /* Bytevector type.  */
 
-scm_t_bits scm_tc16_bytevector;
+#define SCM_BYTEVECTOR_HEADER_BYTES            \
+  (SCM_BYTEVECTOR_HEADER_SIZE * sizeof (SCM))
 
-#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
-#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)        \
-  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
 #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
-  SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
-#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf)          \
-  SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
-#define SCM_BYTEVECTOR_SET_INLINE(bv)                                   \
-  SCM_SET_SMOB_FLAGS (bv, SCM_SMOB_FLAGS (bv) | SCM_F_BYTEVECTOR_INLINE)
-#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint)                          \
-  SCM_SET_SMOB_FLAGS (bv, (SCM_SMOB_FLAGS (bv) & 0xFF) | (hint << 8))
+  SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len))
+
+#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint)      \
+  SCM_SET_BYTEVECTOR_FLAGS ((bv), (hint))
 #define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
   (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
 #define SCM_BYTEVECTOR_TYPED_LENGTH(var)                        \
@@ -198,66 +193,65 @@ SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
 
 static inline SCM
-make_bytevector_from_buffer (size_t len, void *contents,
-                             scm_t_array_element_type element_type)
+make_bytevector (size_t len, scm_t_array_element_type element_type)
 {
   SCM ret;
   size_t c_len;
-  
+
   if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
                     || scm_i_array_element_type_sizes[element_type] < 8
                     || len >= (SCM_I_SIZE_MAX
                                / 
(scm_i_array_element_type_sizes[element_type]/8))))
     /* This would be an internal Guile programming error */
     abort ();
-  
-  c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
-  if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
-    SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, contents);
+
+  if (SCM_UNLIKELY (len == 0 && element_type == SCM_ARRAY_ELEMENT_TYPE_VU8
+                   && SCM_BYTEVECTOR_P (scm_null_bytevector)))
+    ret = scm_null_bytevector;
   else
     {
-      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
-      SCM_BYTEVECTOR_SET_INLINE (ret);
-      if (contents)
-        {
-          memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, c_len);
-          scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
-        }
+      c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+
+      ret = PTR2SCM (scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + 
c_len,
+                                               SCM_GC_BYTEVECTOR));
+
+      SCM_SET_CELL_TYPE (ret, scm_tc7_bytevector);
+      SCM_BYTEVECTOR_SET_LENGTH (ret, c_len);
+      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
     }
-  SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+
   return ret;
 }
 
+/* Return a bytevector of LEN elements of type ELEMENT_TYPE, with element
+   values taken from CONTENTS.  */
 static inline SCM
-make_bytevector (size_t len, scm_t_array_element_type element_type)
+make_bytevector_from_buffer (size_t len, void *contents,
+                            scm_t_array_element_type element_type)
 {
-  size_t c_len;
+  SCM ret;
 
-  if (SCM_UNLIKELY (len == 0 && element_type == 0))
-    return scm_null_bytevector;
-  else if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
-                         || scm_i_array_element_type_sizes[element_type] < 8
-                         || len >= (SCM_I_SIZE_MAX
-                                    / 
(scm_i_array_element_type_sizes[element_type]/8))))
-    /* This would be an internal Guile programming error */
-    abort ();
+  /* We actually never reuse storage from CONTENTS.  Hans Boehm says in
+     <gc/gc.h> that realloc(3) "shouldn't have been invented" and he may well
+     be right.  */
+  ret = make_bytevector (len, element_type);
 
-  c_len = len * (scm_i_array_element_type_sizes[element_type]/8);
-  if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+  if (len > 0)
     {
-      SCM ret;
-      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
-      SCM_BYTEVECTOR_SET_INLINE (ret);
-      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
-      return ret;
-    }
-  else
-    {
-      void *buf = scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
-      return make_bytevector_from_buffer (len, buf, element_type);
+      size_t c_len;
+
+      c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+      memcpy (SCM_BYTEVECTOR_CONTENTS (ret),
+             contents,
+             c_len);
+
+      scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
     }
+
+  return ret;
 }
 
+
 /* Return a new bytevector of size LEN octets.  */
 SCM
 scm_c_make_bytevector (size_t len)
@@ -288,50 +282,36 @@ scm_c_take_typed_bytevector (signed char *contents, 
size_t len,
 }
 
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
-   size) and return BV.  */
+   size) and return the new bytevector (possibly different from BV).  */
 SCM
-scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
+scm_c_shrink_bytevector (SCM bv, size_t c_new_len)
 {
+  SCM new_bv;
+  size_t c_len;
+
   if (SCM_UNLIKELY (c_new_len % SCM_BYTEVECTOR_TYPE_SIZE (bv)))
     /* This would be an internal Guile programming error */
     abort ();
 
-  if (!SCM_BYTEVECTOR_INLINE_P (bv))
-    {
-      size_t c_len;
-      signed char *c_bv, *c_new_bv;
-
-      c_len = SCM_BYTEVECTOR_LENGTH (bv);
-      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  if (SCM_UNLIKELY (c_new_len > c_len))
+    abort ();
 
-      SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
+  SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
 
-      if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_new_len))
-       {
-         /* Copy to the in-line buffer and free the current buffer.  */
-          SCM_BYTEVECTOR_SET_INLINE (bv);
-         c_new_bv = SCM_BYTEVECTOR_CONTENTS (bv);
-         memcpy (c_new_bv, c_bv, c_new_len);
-         scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
-       }
-      else
-       {
-         /* Resize the existing buffer.  */
-         c_new_bv = scm_gc_realloc (c_bv, c_len, c_new_len,
-                                    SCM_GC_BYTEVECTOR);
-         SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
-       }
-    }
-  else
-    SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
+  /* Resize the existing buffer.  */
+  new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
+                                   c_len + SCM_BYTEVECTOR_HEADER_BYTES,
+                                   c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
+                                   SCM_GC_BYTEVECTOR));
 
-  return bv;
+  return new_bv;
 }
 
 int
 scm_is_bytevector (SCM obj)
 {
-  return SCM_SMOB_PREDICATE (scm_tc16_bytevector, obj);
+  return SCM_BYTEVECTOR_P (obj);
 }
 
 size_t
@@ -384,10 +364,8 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 
value)
 
 
 
-
-
-static int
-print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
+int
+scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   ssize_t ubnd, inc, i;
   scm_t_array_handle h;
@@ -409,31 +387,6 @@ print_bytevector (SCM bv, SCM port, scm_print_state 
*pstate SCM_UNUSED)
   return 1;
 }
 
-static SCM
-bytevector_equal_p (SCM bv1, SCM bv2)
-{
-  return scm_bytevector_eq_p (bv1, bv2);
-}
-
-static size_t
-free_bytevector (SCM bv)
-{
-
-  if (!SCM_BYTEVECTOR_INLINE_P (bv))
-    {
-      unsigned c_len;
-      signed char *c_bv;
-
-      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
-      c_len = SCM_BYTEVECTOR_LENGTH (bv);
-
-      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
-    }
-
-  return 0;
-}
-
-
 
 /* General operations.  */
 
@@ -1946,8 +1899,19 @@ utf_encoding_name (char *name, size_t utf_width, SCM 
endianness)
     scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A",       \
                      scm_list_1 (str), err);                           \
   else                                                                 \
-    /* C_UTF is null-terminated.  */                                   \
-    utf = scm_c_take_bytevector ((signed char *) c_utf, c_utf_len);     \
+    {                                                                  \
+      /* C_UTF is null-terminated.  It is malloc(3)-allocated, so we cannot \
+        use `scm_c_take_bytevector ()'.  */                            \
+      scm_dynwind_begin (0);                                           \
+      scm_dynwind_free (c_utf);                                                
\
+                                                                       \
+      utf = make_bytevector (c_utf_len,                                        
\
+                             SCM_ARRAY_ELEMENT_TYPE_VU8);              \
+      memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,                    \
+             c_utf_len);                                               \
+                                                                       \
+      scm_dynwind_end ();                                              \
+    }                                                                  \
                                                                        \
   return (utf);
 
@@ -1981,9 +1945,19 @@ SCM_DEFINE (scm_string_to_utf8, "string->utf8",
   if (SCM_UNLIKELY (c_utf == NULL))
     scm_syserror (FUNC_NAME);
   else
-    /* C_UTF is null-terminated.  */
-    utf = scm_c_take_bytevector ((signed char *) c_utf,
-                                     UTF_STRLEN (8, c_utf));
+    {
+      /* C_UTF is null-terminated.  It is malloc(3)-allocated, so we cannot
+        use `scm_c_take_bytevector ()'.  */
+      scm_dynwind_begin (0);
+      scm_dynwind_free (c_utf);
+
+      utf = make_bytevector (UTF_STRLEN (8, c_utf),
+                            SCM_ARRAY_ELEMENT_TYPE_VU8);
+      memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,
+             UTF_STRLEN (8, c_utf));
+
+      scm_dynwind_end ();
+    }
 
   return (utf);
 }
@@ -2235,17 +2209,11 @@ bytevector_get_handle (SCM v, scm_t_array_handle *h)
 void
 scm_bootstrap_bytevectors (void)
 {
-  /* The SMOB type must be instantiated here because the
-     generalized-vector API may want to access bytevectors even though
-     `(rnrs bytevector)' hasn't been loaded.  */
-  scm_tc16_bytevector = scm_make_smob_type ("bytevector", 0);
-  scm_set_smob_free (scm_tc16_bytevector, free_bytevector);
-  scm_set_smob_print (scm_tc16_bytevector, print_bytevector);
-  scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
-
+  /* This must be instantiated here because the generalized-vector API may
+     want to access bytevectors even though `(rnrs bytevector)' hasn't been
+     loaded.  */
   scm_null_bytevector =
-    scm_gc_protect_object
-    (make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8));
+    scm_gc_protect_object (make_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_VU8));
 
 #ifdef WORDS_BIGENDIAN
   scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol 
("big"));
@@ -2259,9 +2227,9 @@ scm_bootstrap_bytevectors (void)
 
   {
     scm_t_array_implementation impl;
-    
-    impl.tag = scm_tc16_bytevector;
-    impl.mask = 0xffff;
+
+    impl.tag = scm_tc7_bytevector;
+    impl.mask = 0x7f;
     impl.vref = bv_handle_ref;
     impl.vset = bv_handle_set_x;
     impl.get_handle = bytevector_get_handle;
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index e29fe6d..5063126 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -26,12 +26,15 @@
 
 /* R6RS bytevectors.  */
 
+/* The size in words of the bytevector header (type tag, flags, and
+   length).  */
+#define SCM_BYTEVECTOR_HEADER_SIZE   2U
+
 #define SCM_BYTEVECTOR_LENGTH(_bv)             \
-  ((size_t) SCM_SMOB_DATA (_bv))
-#define SCM_BYTEVECTOR_CONTENTS(_bv)           \
-  (SCM_BYTEVECTOR_INLINE_P (_bv)                       \
-   ? (signed char *) SCM_SMOB_OBJECT_2_LOC (_bv)       \
-   : (signed char *) SCM_SMOB_DATA_2 (_bv))
+  ((size_t) SCM_CELL_WORD_1 (_bv))
+#define SCM_BYTEVECTOR_CONTENTS(_bv)                                   \
+  ((signed char *) SCM_CELL_OBJECT_LOC ((_bv),                         \
+                                       SCM_BYTEVECTOR_HEADER_SIZE))
 
 
 SCM_API SCM scm_endianness_big;
@@ -112,17 +115,16 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 
 /* Internal API.  */
 
-/* The threshold (in octets) under which bytevectors are stored "in-line",
-   i.e., without allocating memory beside the SMOB itself (a double cell).
-   This optimization is necessary since small bytevectors are expected to be
-   common.  */
-#define SCM_BYTEVECTOR_P(_bv)                   \
-  SCM_SMOB_PREDICATE (scm_tc16_bytevector, _bv)
-#define SCM_F_BYTEVECTOR_INLINE 0x1
-#define SCM_BYTEVECTOR_INLINE_P(_bv)            \
-  (SCM_SMOB_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_P(x)                            \
+  (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_bytevector)
+#define SCM_BYTEVECTOR_FLAGS(_bv)              \
+  (SCM_CELL_TYPE (_bv) >> 7UL)
+#define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f)                              \
+  SCM_SET_CELL_TYPE ((_bv),                                            \
+                    scm_tc7_bytevector | ((scm_t_bits)(_f) << 7UL))
+
 #define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv)       \
-  (SCM_SMOB_FLAGS (_bv) >> 8)
+  (SCM_BYTEVECTOR_FLAGS (_bv))
 
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
@@ -134,16 +136,12 @@ SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char 
*, size_t,
 SCM_INTERNAL void scm_bootstrap_bytevectors (void);
 SCM_INTERNAL void scm_init_bytevectors (void);
 
-SCM_INTERNAL scm_t_bits scm_tc16_bytevector;
 SCM_INTERNAL SCM scm_i_native_endianness;
 SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, size_t);
 
-#define scm_c_shrink_bytevector(_bv, _len)             \
-  (SCM_BYTEVECTOR_INLINE_P (_bv)                       \
-   ? (_bv)                                             \
-   : scm_i_shrink_bytevector ((_bv), (_len)))
+SCM_INTERNAL int scm_i_print_bytevector (SCM, SCM, scm_print_state *);
 
-SCM_INTERNAL SCM scm_i_shrink_bytevector (SCM, size_t);
+SCM_INTERNAL SCM scm_c_shrink_bytevector (SCM, size_t);
 SCM_INTERNAL void scm_i_bytevector_generalized_set_x (SCM, size_t, SCM);
 SCM_INTERNAL SCM scm_null_bytevector;
 
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 347bd80..aa1fb33 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -48,42 +48,6 @@
 
 scm_t_bits scm_tc16_continuation;
 
-static SCM
-continuation_mark (SCM obj)
-{
-  scm_t_contregs *continuation = SCM_CONTREGS (obj);
-
-  scm_gc_mark (continuation->root);
-  scm_gc_mark (continuation->throw_value);
-  scm_gc_mark (continuation->vm_conts);
-  scm_mark_locations (continuation->stack, continuation->num_stack_items);
-#ifdef __ia64__
-  if (continuation->backing_store)
-    scm_mark_locations (continuation->backing_store, 
-                        continuation->backing_store_size / 
-                        sizeof (SCM_STACKITEM));
-#endif /* __ia64__ */
-  return continuation->dynenv;
-}
-
-static size_t
-continuation_free (SCM obj)
-{
-  scm_t_contregs *continuation = SCM_CONTREGS (obj);
-  /* stack array size is 1 if num_stack_items is 0.  */
-  size_t extra_items = (continuation->num_stack_items > 0)
-    ? (continuation->num_stack_items - 1)
-    : 0;
-  size_t bytes_free = sizeof (scm_t_contregs)
-    + extra_items * sizeof (SCM_STACKITEM);
-
-#ifdef __ia64__
-  scm_gc_free (continuation->backing_store, continuation->backing_store_size,
-              "continuation backing store");
-#endif /* __ia64__ */ 
-  scm_gc_free (continuation, bytes_free, "continuation");
-  return 0;
-}
 
 static int
 continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
@@ -418,8 +382,6 @@ void
 scm_init_continuations ()
 {
   scm_tc16_continuation = scm_make_smob_type ("continuation", 0);
-  scm_set_smob_mark (scm_tc16_continuation, continuation_mark);
-  scm_set_smob_free (scm_tc16_continuation, continuation_free);
   scm_set_smob_print (scm_tc16_continuation, continuation_print);
   scm_set_smob_apply (scm_tc16_continuation, continuation_apply, 0, 0, 1);
 #include "libguile/continuations.x"
diff --git a/libguile/debug.c b/libguile/debug.c
index 4bf3111..5b42ddd 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -564,7 +564,6 @@ scm_init_debug ()
   scm_init_opts (scm_debug_options, scm_debug_opts);
 
   scm_tc16_memoized = scm_make_smob_type ("memoized", 0);
-  scm_set_smob_mark (scm_tc16_memoized, scm_markcdr);
   scm_set_smob_print (scm_tc16_memoized, memoized_print);
 
   scm_tc16_debugobj = scm_make_smob_type ("debug-object", 0);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 6ecef3b..d066996 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2,7 +2,7 @@
    deprecate something, move it here when that is feasible.
 */
 
-/* Copyright (C) 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008, 2009 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
@@ -1503,6 +1503,29 @@ SCM_DEFINE (scm_destroy_guardian_x, "destroy-guardian!", 
1, 0, 0,
 }
 #undef FUNC_NAME
 
+
+/* GC-related things.  */
+
+unsigned long scm_mallocated, scm_mtrigger;
+size_t scm_max_segment_size;
+
+#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
+SCM
+scm_map_free_list (void)
+{
+  return SCM_EOL;
+}
+#endif
+
+#if defined (GUILE_DEBUG_FREELIST)
+SCM
+scm_gc_set_debug_check_freelist_x (SCM flag)
+{
+  return SCM_UNSPECIFIED;
+}
+#endif
+
+
 void
 scm_i_init_deprecated ()
 {
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index ad62a2b..f428f7d 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -118,8 +118,8 @@ SCM_API SCM scm_unprotect_object (SCM obj);
   (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y))))
 #define SCM_SETOR_CDR(x, y)\
   (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y))))
-#define SCM_FREEP(x) (SCM_FREE_CELL_P (x))
-#define SCM_NFREEP(x) (!SCM_FREE_CELL_P (x))
+#define SCM_FREEP(x) (0)
+#define SCM_NFREEP(x) (1)
 #define SCM_GC8MARKP(x) SCM_GC_MARK_P (x)
 #define SCM_SETGC8MARK(x) SCM_SET_GC_MARK (x)
 #define SCM_CLRGC8MARK(x) SCM_CLEAR_GC_MARK (x)
@@ -583,6 +583,25 @@ SCM_API SCM scm_destroy_guardian_x (SCM guardian);
 SCM_API SCM scm_guardian_greedy_p (SCM guardian);
 SCM_API SCM scm_guardian_destroyed_p (SCM guardian);
 
+
+/* GC-related things deprecated with the move to BDW-GC starting from 1.9.3
+   (2009-09-15).  */
+
+SCM_API unsigned long scm_mallocated;
+SCM_API unsigned long scm_mtrigger;
+
+SCM_API size_t scm_max_segment_size;
+
+#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
+SCM_API SCM scm_map_free_list (void);
+#endif
+
+#if defined (GUILE_DEBUG_FREELIST)
+SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag);
+#endif
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 9ac4d4f..dc98e7d 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -1,7 +1,7 @@
 /* dynl.c - dynamic linking
  *
  * Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002,
- * 2003, 2008 Free Software Foundation, Inc.
+ * 2003, 2008, 2009 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
@@ -123,12 +123,6 @@ scm_t_bits scm_tc16_dynamic_obj;
 #define SET_DYNL_HANDLE(x, v) (SCM_SET_SMOB_DATA_2 ((x), (scm_t_bits) (v)))
 
 
-static SCM
-dynl_obj_mark (SCM ptr)
-{
-  return DYNL_FILENAME (ptr);
-}
-
 
 static int
 dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate)
@@ -269,12 +263,6 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-static void
-free_string_pointers (void *data)
-{
-  scm_i_free_string_pointers ((char **)data);
-}
-
 SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, 
             (SCM func, SCM dobj, SCM args),
            "Call the C function indicated by @var{func} and @var{dobj},\n"
@@ -295,21 +283,16 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 
3, 0, 0,
   int result, argc;
   char **argv;
 
-  scm_dynwind_begin (0);
-
   if (scm_is_string (func))
     func = scm_dynamic_func (func, dobj);
 
   fptr = (int (*) (int, char **)) scm_to_ulong (func);
 
   argv = scm_i_allocate_string_pointers (args);
-  scm_dynwind_unwind_handler (free_string_pointers, argv,
-                             SCM_F_WIND_EXPLICITLY);
   for (argc = 0; argv[argc]; argc++)
     ;
   result = (*fptr) (argc, argv);
 
-  scm_dynwind_end ();
   return scm_from_int (result);
 }
 #undef FUNC_NAME
@@ -318,7 +301,6 @@ void
 scm_init_dynamic_linking ()
 {
   scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0);
-  scm_set_smob_mark (scm_tc16_dynamic_obj, dynl_obj_mark);
   scm_set_smob_print (scm_tc16_dynamic_obj, dynl_obj_print);
   sysdep_dynl_init ();
 #include "libguile/dynl.x"
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index a45c5b5..b34f9be 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -191,14 +191,6 @@ scm_dynwind_end (void)
   assert (0);
 }
 
-static SCM
-winder_mark (SCM w)
-{
-  if (WINDER_MARK_P (w))
-    return SCM_PACK (WINDER_DATA (w));
-  return SCM_BOOL_F;
-}
-
 void
 scm_dynwind_unwind_handler (void (*proc) (void *), void *data,
                            scm_t_wind_flags flags)
@@ -376,7 +368,6 @@ scm_init_dynwind ()
   tc16_frame = scm_make_smob_type ("frame", 0);
 
   tc16_winder = scm_make_smob_type ("winder", 0);
-  scm_set_smob_mark (tc16_winder, winder_mark);
 
 #include "libguile/dynwind.x"
 }
diff --git a/libguile/environments.c b/libguile/environments.c
index fae936a..fd4b883 100644
--- a/libguile/environments.c
+++ b/libguile/environments.c
@@ -99,7 +99,7 @@ scm_error_environment_immutable_location (const char *func, 
SCM env, SCM symbol)
 SCM
 scm_make_environment (void *type)
 {
-  return scm_cell (scm_tc16_environment, (scm_t_bits) type);
+  SCM_RETURN_NEWSMOB (scm_tc16_environment, type);
 }
 
 
@@ -446,20 +446,6 @@ SCM_DEFINE (scm_environment_unobserve, 
"environment-unobserve", 1, 0, 0,
 #undef FUNC_NAME
 
 
-static SCM
-environment_mark (SCM env)
-{
-  return (*(SCM_ENVIRONMENT_FUNCS (env)->mark)) (env);
-}
-
-
-static size_t
-environment_free (SCM env)
-{
-  (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env);
-  return 0;
-}
-
 
 static int
 environment_print (SCM env, SCM port, scm_print_state *pstate)
@@ -471,14 +457,6 @@ environment_print (SCM env, SCM port, scm_print_state 
*pstate)
 
 /* observers */
 
-static SCM
-observer_mark (SCM observer)
-{
-  scm_gc_mark (SCM_OBSERVER_ENVIRONMENT (observer));
-  scm_gc_mark (SCM_OBSERVER_DATA (observer));
-  return SCM_BOOL_F;
-}
-
 
 static int
 observer_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -648,10 +626,12 @@ struct core_environments_base {
 static SCM
 core_environments_observe (SCM env, scm_environment_observer proc, SCM data, 
int weak_p)
 {
-  SCM observer = scm_double_cell (scm_tc16_observer,
-                                 SCM_UNPACK (env),
-                                 SCM_UNPACK (data),
-                                 (scm_t_bits) proc);
+  SCM observer;
+
+  SCM_NEWSMOB3 (observer, scm_tc16_observer,
+               SCM_UNPACK (env),
+               SCM_UNPACK (data),
+               (scm_t_bits) proc);
 
   if (!weak_p)
     {
@@ -722,20 +702,6 @@ core_environments_unobserve (SCM env, SCM observer)
 }
 
 
-static SCM
-core_environments_mark (SCM env)
-{
-  scm_gc_mark (CORE_ENVIRONMENT_OBSERVERS (env));
-  return CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env);
-}
-
-
-static void
-core_environments_finalize (SCM env SCM_UNUSED)
-{
-}
-
-
 static void
 core_environments_preinit (struct core_environments_base *body)
 {
@@ -965,22 +931,6 @@ leaf_environment_cell (SCM env, SCM sym, int for_write 
SCM_UNUSED)
 }
 
 
-static SCM
-leaf_environment_mark (SCM env)
-{
-  scm_gc_mark (LEAF_ENVIRONMENT (env)->obarray);
-  return core_environments_mark (env);
-}
-
-
-static void
-leaf_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (LEAF_ENVIRONMENT (env), sizeof (struct leaf_environment),
-              "leaf environment");
-}
-
 
 static int
 leaf_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -1005,8 +955,6 @@ static struct scm_environment_funcs leaf_environment_funcs 
= {
   leaf_environment_cell,
   core_environments_observe,
   core_environments_unobserve,
-  leaf_environment_mark,
-  leaf_environment_free,
   leaf_environment_print
 };
 
@@ -1318,29 +1266,6 @@ eval_environment_cell (SCM env, SCM sym, int for_write)
 #undef FUNC_NAME
 
 
-static SCM
-eval_environment_mark (SCM env)
-{
-  struct eval_environment *body = EVAL_ENVIRONMENT (env);
-
-  scm_gc_mark (body->obarray);
-  scm_gc_mark (body->imported);
-  scm_gc_mark (body->imported_observer);
-  scm_gc_mark (body->local);
-  scm_gc_mark (body->local_observer);
-
-  return core_environments_mark (env);
-}
-
-
-static void
-eval_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (EVAL_ENVIRONMENT (env), sizeof (struct eval_environment),
-              "eval environment");
-}
-
 
 static int
 eval_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -1365,8 +1290,6 @@ static struct scm_environment_funcs 
eval_environment_funcs = {
     eval_environment_cell,
     core_environments_observe,
     core_environments_unobserve,
-    eval_environment_mark,
-    eval_environment_free,
     eval_environment_print
 };
 
@@ -1741,24 +1664,6 @@ import_environment_cell (SCM env, SCM sym, int for_write)
 #undef FUNC_NAME
 
 
-static SCM
-import_environment_mark (SCM env)
-{
-  scm_gc_mark (IMPORT_ENVIRONMENT (env)->imports);
-  scm_gc_mark (IMPORT_ENVIRONMENT (env)->import_observers);
-  scm_gc_mark (IMPORT_ENVIRONMENT (env)->conflict_proc);
-  return core_environments_mark (env);
-}
-
-
-static void
-import_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (IMPORT_ENVIRONMENT (env), sizeof (struct import_environment),
-              "import environment");
-}
-
 
 static int
 import_environment_print (SCM type, SCM port, 
@@ -1784,8 +1689,6 @@ static struct scm_environment_funcs 
import_environment_funcs = {
   import_environment_cell,
   core_environments_observe,
   core_environments_unobserve,
-  import_environment_mark,
-  import_environment_free,
   import_environment_print
 };
 
@@ -2043,27 +1946,6 @@ export_environment_cell (SCM env, SCM sym, int for_write)
 #undef FUNC_NAME
 
 
-static SCM
-export_environment_mark (SCM env)
-{
-  struct export_environment *body = EXPORT_ENVIRONMENT (env);
-
-  scm_gc_mark (body->private);
-  scm_gc_mark (body->private_observer);
-  scm_gc_mark (body->signature);
-
-  return core_environments_mark (env);
-}
-
-
-static void
-export_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (EXPORT_ENVIRONMENT (env), sizeof (struct export_environment),
-              "export environment");
-}
-
 
 static int
 export_environment_print (SCM type, SCM port,
@@ -2089,8 +1971,6 @@ static struct scm_environment_funcs 
export_environment_funcs = {
   export_environment_cell,
   core_environments_observe,
   core_environments_unobserve,
-  export_environment_mark,
-  export_environment_free,
   export_environment_print
 };
 
@@ -2320,13 +2200,10 @@ scm_environments_prehistory ()
 {
   /* create environment smob */
   scm_tc16_environment = scm_make_smob_type ("environment", 0);
-  scm_set_smob_mark (scm_tc16_environment, environment_mark);
-  scm_set_smob_free (scm_tc16_environment, environment_free);
   scm_set_smob_print (scm_tc16_environment, environment_print);
 
   /* create observer smob */
   scm_tc16_observer = scm_make_smob_type ("observer", 0);
-  scm_set_smob_mark (scm_tc16_observer, observer_mark);
   scm_set_smob_print (scm_tc16_observer, observer_print);
 
   /* create system environment */
diff --git a/libguile/environments.h b/libguile/environments.h
index 5680662..1439632 100644
--- a/libguile/environments.h
+++ b/libguile/environments.h
@@ -52,8 +52,6 @@ struct scm_environment_funcs {
   SCM (*observe) (SCM self, scm_environment_observer proc, SCM data, int 
weak_p);
   void (*unobserve) (SCM self, SCM token);
 
-  SCM (*mark) (SCM self);
-  void (*free) (SCM self);
   int (*print) (SCM self, SCM port, scm_print_state *pstate);
 };
 
diff --git a/libguile/eq.c b/libguile/eq.c
index 11dee27..fadd756 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -30,6 +30,7 @@
 #include "libguile/smob.h"
 #include "libguile/arrays.h"
 #include "libguile/vectors.h"
+#include "libguile/bytevectors.h"
 
 #include "libguile/struct.h"
 #include "libguile/goops.h"
@@ -239,6 +240,8 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", 
scm_tc7_rpsubr,
     }
   if (SCM_TYP7 (x) == scm_tc7_string && SCM_TYP7 (y) == scm_tc7_string)
     return scm_string_equal_p (x, y);
+  if (SCM_TYP7 (x) == scm_tc7_bytevector && SCM_TYP7 (y) == scm_tc7_bytevector)
+    return scm_bytevector_eq_p (x, y);
   if (SCM_TYP7 (x) == scm_tc7_smob && SCM_TYP16 (x) == SCM_TYP16 (y))
     {
       int i = SCM_SMOBNUM (x);
diff --git a/libguile/eval.c b/libguile/eval.c
index eeafb0b..59db429 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3739,7 +3739,8 @@ scm_closure (SCM code, SCM env)
 {
   SCM z;
   SCM closcar = scm_cons (code, SCM_EOL);
-  z = scm_cell (SCM_UNPACK (closcar) + scm_tc3_closure, (scm_t_bits) env);
+  z = scm_immutable_cell (SCM_UNPACK (closcar) + scm_tc3_closure,
+                         (scm_t_bits) env);
   scm_remember_upto_here (closcar);
   return z;
 }
@@ -3765,18 +3766,6 @@ SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-static SCM
-promise_mark (SCM promise)
-{
-  scm_gc_mark (SCM_PROMISE_MUTEX (promise));
-  return SCM_PROMISE_DATA (promise);
-}
-
-static size_t
-promise_free (SCM promise)
-{
-  return 0;
-}
 
 static int 
 promise_print (SCM exp, SCM port, scm_print_state *pstate)
@@ -4162,8 +4151,6 @@ scm_init_eval ()
                 scm_eval_opts);
   
   scm_tc16_promise = scm_make_smob_type ("promise", 0);
-  scm_set_smob_mark (scm_tc16_promise, promise_mark);
-  scm_set_smob_free (scm_tc16_promise, promise_free);
   scm_set_smob_print (scm_tc16_promise, promise_print);
 
   undefineds = scm_list_1 (SCM_UNDEFINED);
diff --git a/libguile/evalext.c b/libguile/evalext.c
index b1f185c..78b666f 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -83,6 +83,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 
0,
        case scm_tc7_smob:
        case scm_tc7_pws:
        case scm_tc7_program:
+       case scm_tc7_bytevector:
        case scm_tcs_subrs:
        case scm_tcs_struct:
          return SCM_BOOL_T;
diff --git a/libguile/fluids.c b/libguile/fluids.c
index bcd04c4..75dcccf 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008 Free Software 
Foundation, Inc.
+/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009 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
@@ -22,6 +22,7 @@
 
 #include <stdio.h>
 #include <string.h>
+#include <assert.h>
 
 #include "libguile/_scm.h"
 #include "libguile/print.h"
@@ -82,112 +83,36 @@ static scm_t_bits tc16_dynamic_state;
 #define DYNAMIC_STATE_NEXT_LOC(x)          SCM_SMOB_OBJECT_2_LOC(x)
 #define SET_DYNAMIC_STATE_NEXT(x, y)   SCM_SET_SMOB_OBJECT_2((x), (y))
 
-/* Weak lists of all dynamic states and all fluids.
- */
-static SCM all_dynamic_states = SCM_EOL;
-static SCM all_fluids = SCM_EOL;
 
-/* Make sure that all states have the right size.  This must be called
-   while fluid_admin_mutex is held.
-*/
+
+/* Grow STATE so that it can hold up to ALLOCATED_FLUIDS_NUM fluids.  */
 static void
-resize_all_states ()
+grow_dynamic_state (SCM state)
 {
-  SCM new_vectors, state;
-
-  /* Replacing the vector of a dynamic state must be done atomically:
-     the old values must be copied into the new vector and the new
-     vector must be installed without someone modifying the old vector
-     concurrently.  Since accessing a fluid should be lock-free, we
-     need to put all threads to sleep when replacing a vector.
-     However, when being single threaded, it is best not to do much.
-     Therefore, we allocate the new vectors before going single
-     threaded.
-  */
-
-  new_vectors = SCM_EOL;
-  for (state = all_dynamic_states; !scm_is_null (state);
-       state = DYNAMIC_STATE_NEXT (state))
-    new_vectors = scm_cons (scm_c_make_vector (allocated_fluids_len,
-                                              SCM_BOOL_F),
-                           new_vectors);
-
-  scm_i_thread_put_to_sleep ();
-  for (state = all_dynamic_states; !scm_is_null (state);
-       state = DYNAMIC_STATE_NEXT (state))
-    {
-      SCM old_fluids = DYNAMIC_STATE_FLUIDS (state);
-      SCM new_fluids = SCM_CAR (new_vectors);
-      size_t i, old_len = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
-
-      for (i = 0; i < old_len; i++)
-       SCM_SIMPLE_VECTOR_SET (new_fluids, i,
-                              SCM_SIMPLE_VECTOR_REF (old_fluids, i));
-      SET_DYNAMIC_STATE_FLUIDS (state, new_fluids);
-      new_vectors = SCM_CDR (new_vectors);
-    }
-  scm_i_thread_wake_up ();
-}
+  SCM new_fluids;
+  SCM old_fluids = DYNAMIC_STATE_FLUIDS (state);
+  size_t i, new_len, old_len = SCM_SIMPLE_VECTOR_LENGTH (old_fluids);
 
-/* This is called during GC, that is, while being single threaded.
-   See next_fluid_num for a discussion why it is safe to access
-   allocated_fluids here.
- */
-static void *
-scan_dynamic_states_and_fluids (void *dummy1 SCM_UNUSED,
-                               void *dummy2 SCM_UNUSED,
-                               void *dummy3 SCM_UNUSED)
-{
-  SCM *statep, *fluidp;
+ retry:
+  new_len = allocated_fluids_num;
+  new_fluids = scm_c_make_vector (new_len, SCM_BOOL_F);
 
-  /* Scan all fluids and deallocate the unmarked ones.
-   */
-  fluidp = &all_fluids;
-  while (!scm_is_null (*fluidp))
+  scm_i_pthread_mutex_lock (&fluid_admin_mutex);
+  if (new_len != allocated_fluids_num)
     {
-      if (!SCM_GC_MARK_P (*fluidp))
-       {
-         allocated_fluids_num -= 1;
-         allocated_fluids[FLUID_NUM (*fluidp)] = 0;
-         *fluidp = FLUID_NEXT (*fluidp);
-       }
-      else
-       fluidp = FLUID_NEXT_LOC (*fluidp);
+      /* We lost the race.  */
+      scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
+      goto retry;
     }
 
-  /* Scan all dynamic states and remove the unmarked ones.  The live
-     ones are updated for unallocated fluids.
-  */
-  statep = &all_dynamic_states;
-  while (!scm_is_null (*statep))
-    {
-      if (!SCM_GC_MARK_P (*statep))
-       *statep = DYNAMIC_STATE_NEXT (*statep);
-      else
-       {
-         SCM fluids = DYNAMIC_STATE_FLUIDS (*statep);
-         size_t len, i;
-         
-         len = SCM_SIMPLE_VECTOR_LENGTH (fluids);
-         for (i = 0; i < len && i < allocated_fluids_len; i++)
-           if (allocated_fluids[i] == 0)
-             SCM_SIMPLE_VECTOR_SET (fluids, i, SCM_BOOL_F);
-
-         statep = DYNAMIC_STATE_NEXT_LOC (*statep);
-       }
-    }
+  assert (allocated_fluids_num > old_len);
 
-  return NULL;
-}
+  for (i = 0; i < old_len; i++)
+    SCM_SIMPLE_VECTOR_SET (new_fluids, i,
+                          SCM_SIMPLE_VECTOR_REF (old_fluids, i));
+  SET_DYNAMIC_STATE_FLUIDS (state, new_fluids);
 
-static size_t
-fluid_free (SCM fluid)
-{
-  /* The real work is done in scan_dynamic_states_and_fluids.  We can
-     not touch allocated_fluids etc here since a smob free routine can
-     be run at any time, in any thread.
-  */
-  return 0;
+  scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
 }
 
 static int
@@ -224,16 +149,13 @@ next_fluid_num ()
     }
   else
     {
-      /* During the following call, the GC might run and elements of
-        allocated_fluids might bet set to zero.  Also,
-        allocated_fluids and allocated_fluids_len are used to scan
-        all dynamic states during GC.  Thus we need to make sure that
-        no GC can run while updating these two variables.
-      */
-
-      char *prev_allocated_fluids;
+      /* Grow the vector of allocated fluids.  */
+      /* FIXME: Since we use `scm_malloc ()', ALLOCATED_FLUIDS is scanned by
+        the GC; therefore, all fluids remain reachable for the entire
+        program lifetime.  Hopefully this is not a problem in practice.  */
       char *new_allocated_fluids =
-       scm_malloc (allocated_fluids_len + FLUID_GROW);
+       scm_gc_malloc (allocated_fluids_len + FLUID_GROW,
+                      "allocated fluids");
 
       /* Copy over old values and initialize rest.  GC can not run
         during these two operations since there is no safe point in
@@ -243,17 +165,11 @@ next_fluid_num ()
       memset (new_allocated_fluids + allocated_fluids_len, 0, FLUID_GROW);
       n = allocated_fluids_len;
 
-      prev_allocated_fluids = allocated_fluids;
+      /* Update the vector of allocated fluids.  Dynamic states will
+        eventually be lazily grown to accomodate the new value of
+        ALLOCATED_FLUIDS_LEN in `fluid-ref' and `fluid-set!'.  */
       allocated_fluids = new_allocated_fluids;
       allocated_fluids_len += FLUID_GROW;
-
-      if (prev_allocated_fluids != NULL)
-       free (prev_allocated_fluids);
-
-      /* Now allocated_fluids and allocated_fluids_len are valid again
-        and we can allow GCs to occur.
-      */
-      resize_all_states ();
     }
   
   allocated_fluids_num += 1;
@@ -279,14 +195,6 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
   SCM_NEWSMOB2 (fluid, tc16_fluid,
                (scm_t_bits) next_fluid_num (), SCM_UNPACK (SCM_EOL));
 
-  /* The GC must not run until the fluid is properly entered into the
-     list.
-  */
-  scm_i_scm_pthread_mutex_lock (&fluid_admin_mutex);
-  SET_FLUID_NEXT (fluid, all_fluids);
-  all_fluids = fluid;
-  scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
-
   return fluid;
 }
 #undef FUNC_NAME
@@ -307,11 +215,7 @@ scm_is_fluid (SCM obj)
   return IS_FLUID (obj);
 }
 
-size_t
-scm_i_fluid_num (SCM fluid)
-{
-  return FLUID_NUM (fluid);
-}
+
 
 SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0, 
            (SCM fluid),
@@ -323,17 +227,24 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 
   SCM_VALIDATE_FLUID (1, fluid);
+
+  if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+    {
+      /* We should only get there when the current thread's dynamic state
+        turns out to be too small compared to the set of currently allocated
+        fluids.  */
+      assert (SCM_SIMPLE_VECTOR_LENGTH (fluids) < allocated_fluids_num);
+
+      /* Lazily grow the current thread's dynamic state.  */
+      grow_dynamic_state (SCM_I_CURRENT_THREAD->dynamic_state);
+
+      fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
+    }
+
   return SCM_SIMPLE_VECTOR_REF (fluids, FLUID_NUM (fluid));
 }
 #undef FUNC_NAME
 
-SCM
-scm_i_fast_fluid_ref (size_t n)
-{
-  SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
-  return SCM_SIMPLE_VECTOR_REF (fluids, n);
-}
-
 SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
            (SCM fluid, SCM value),
            "Set the value associated with @var{fluid} in the current dynamic 
root.")
@@ -342,18 +253,25 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
   SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
 
   SCM_VALIDATE_FLUID (1, fluid);
+
+  if (SCM_UNLIKELY (FLUID_NUM (fluid) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+    {
+      /* We should only get there when the current thread's dynamic state
+        turns out to be too small compared to the set of currently allocated
+        fluids.  */
+      assert (SCM_SIMPLE_VECTOR_LENGTH (fluids) < allocated_fluids_num);
+
+      /* Lazily grow the current thread's dynamic state.  */
+      grow_dynamic_state (SCM_I_CURRENT_THREAD->dynamic_state);
+
+      fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
+    }
+
   SCM_SIMPLE_VECTOR_SET (fluids, FLUID_NUM (fluid), value);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-void
-scm_i_fast_fluid_set_x (size_t n, SCM value)
-{
-  SCM fluids = DYNAMIC_STATE_FLUIDS (SCM_I_CURRENT_THREAD->dynamic_state);
-  SCM_SIMPLE_VECTOR_SET (fluids, n, value);
-}
-
 static void
 swap_fluids (SCM data)
 {
@@ -491,7 +409,6 @@ scm_i_make_initial_dynamic_state ()
   SCM state;
   SCM_NEWSMOB2 (state, tc16_dynamic_state,
                SCM_UNPACK (fluids), SCM_UNPACK (SCM_EOL));
-  all_dynamic_states = state;
   return state;
 }
 
@@ -511,14 +428,6 @@ SCM_DEFINE (scm_make_dynamic_state, "make-dynamic-state", 
0, 1, 0,
   SCM_NEWSMOB2 (state, tc16_dynamic_state,
                SCM_UNPACK (fluids), SCM_UNPACK (SCM_EOL));
 
-  /* The GC must not run until the state is properly entered into the
-     list. 
-  */
-  scm_i_scm_pthread_mutex_lock (&fluid_admin_mutex);
-  SET_DYNAMIC_STATE_NEXT (state, all_dynamic_states);
-  all_dynamic_states = state;
-  scm_i_pthread_mutex_unlock (&fluid_admin_mutex);
-
   return state;
 }
 #undef FUNC_NAME
@@ -609,14 +518,9 @@ void
 scm_fluids_prehistory ()
 {
   tc16_fluid = scm_make_smob_type ("fluid", 0);
-  scm_set_smob_free (tc16_fluid, fluid_free);
   scm_set_smob_print (tc16_fluid, fluid_print);
 
   tc16_dynamic_state = scm_make_smob_type ("dynamic-state", 0);
-  scm_set_smob_mark (tc16_dynamic_state, scm_markcdr);
-
-  scm_c_hook_add (&scm_after_sweep_c_hook, scan_dynamic_states_and_fluids,
-                 0, 0);
 }
 
 void
diff --git a/libguile/fluids.h b/libguile/fluids.h
index cf424fa..2bfcce5 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -51,18 +51,11 @@
    eventually.
 */
 
-#define SCM_FLUID_NUM(x)             scm_i_fluid_num (x)
-#define SCM_FAST_FLUID_REF(n)        scm_i_fast_fluid_ref (n)
-#define SCM_FAST_FLUID_SET_X(n, val) scm_i_fast_fluid_set_x ((n),(val))
-
 SCM_API SCM scm_make_fluid (void);
 SCM_API int scm_is_fluid (SCM obj);
 SCM_API SCM scm_fluid_p (SCM fl);
 SCM_API SCM scm_fluid_ref (SCM fluid);
 SCM_API SCM scm_fluid_set_x (SCM fluid, SCM value);
-SCM_API size_t scm_i_fluid_num (SCM fl);
-SCM_API SCM scm_i_fast_fluid_ref (size_t n);
-SCM_API void scm_i_fast_fluid_set_x (size_t n, SCM val);
 
 SCM_API SCM scm_c_with_fluids (SCM fluids, SCM vals,
                               SCM (*cproc)(void *), void *cdata);
diff --git a/libguile/fports.c b/libguile/fports.c
index 8e25ebd..5d37495 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -122,7 +122,7 @@ scm_fport_buffer_add (SCM port, long read_size, int 
write_size)
 
   if (SCM_INPUT_PORT_P (port) && read_size > 0)
     {
-      pt->read_buf = scm_gc_malloc (read_size, "port buffer");
+      pt->read_buf = scm_gc_malloc_pointerless (read_size, "port buffer");
       pt->read_pos = pt->read_end = pt->read_buf;
       pt->read_buf_size = read_size;
     }
@@ -134,7 +134,7 @@ scm_fport_buffer_add (SCM port, long read_size, int 
write_size)
 
   if (SCM_OUTPUT_PORT_P (port) && write_size > 0)
     {
-      pt->write_buf = scm_gc_malloc (write_size, "port buffer");
+      pt->write_buf = scm_gc_malloc_pointerless (write_size, "port buffer");
       pt->write_pos = pt->write_buf;
       pt->write_buf_size = write_size;
     }
@@ -231,9 +231,15 @@ scm_i_evict_port (void *closure, SCM port)
 
   if (SCM_FPORTP (port))
     {
-      scm_t_fport *fp = SCM_FSTREAM (port);
+      scm_t_port *p;
+      scm_t_fport *fp;
+
+      /* XXX: In some cases, we can encounter a port with no associated ptab
+        entry.  */
+      p = SCM_PTAB_ENTRY (port);
+      fp = (p != NULL) ? (scm_t_fport *) p->stream : NULL;
 
-      if (fp->fdes == fd)
+      if ((fp != NULL) && (fp->fdes == fd))
        {
          fp->fdes = dup (fd);
          if (fp->fdes == -1)
@@ -459,7 +465,8 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
   pt = SCM_PTAB_ENTRY(port);
   {
     scm_t_fport *fp
-      = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port");
+      = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
+                                                  "file port");
 
     fp->fdes = fdes;
     pt->rw_random = SCM_FDES_RANDOM_P (fdes);
diff --git a/libguile/frames.c b/libguile/frames.c
index 737babc..a6835fb 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -58,20 +58,7 @@ vm_frame_print (SCM frame, SCM port, scm_print_state *pstate)
   return 1;
 }
 
-static SCM
-vm_frame_mark (SCM obj)
-{
-  return SCM_VM_FRAME_STACK_HOLDER (obj);
-}
-
-static size_t
-vm_frame_free (SCM obj)
-{
-  struct scm_vm_frame *p = SCM_VM_FRAME_DATA (obj);
-  scm_gc_free (p, sizeof(struct scm_vm_frame), "vmframe");
-  return 0;
-}
-
+
 /* Scheme interface */
 
 SCM_DEFINE (scm_vm_frame_p, "vm-frame?", 1, 0, 0,
@@ -263,8 +250,6 @@ void
 scm_bootstrap_frames (void)
 {
   scm_tc16_vm_frame = scm_make_smob_type ("vm-frame", 0);
-  scm_set_smob_mark (scm_tc16_vm_frame, vm_frame_mark);
-  scm_set_smob_free (scm_tc16_vm_frame, vm_frame_free);
   scm_set_smob_print (scm_tc16_vm_frame, vm_frame_print);
   scm_c_register_extension ("libguile", "scm_init_frames",
                             (scm_t_extension_init_func)scm_init_frames, NULL);
diff --git a/libguile/futures.c b/libguile/futures.c
index ad70f7f..b330f4d 100644
--- a/libguile/futures.c
+++ b/libguile/futures.c
@@ -208,10 +208,6 @@ scm_i_make_future (SCM thunk)
   return future;
 }
 
-static SCM
-future_mark (SCM ptr) {
-  return SCM_FUTURE_DATA (ptr);
-}
 
 static int 
 future_print (SCM exp, SCM port, scm_print_state *pstate)
@@ -364,7 +360,6 @@ scm_init_futures ()
     = SCM_VARIABLE_LOC (scm_c_define ("%thread-handler", SCM_BOOL_F));
 
   scm_tc16_future = scm_make_smob_type ("future", 0);
-  scm_set_smob_mark (scm_tc16_future, future_mark);
   scm_set_smob_print (scm_tc16_future, future_print);
 
   scm_c_hook_add (&scm_before_sweep_c_hook, scan_futures, 0, 0);
diff --git a/libguile/gc-card.c b/libguile/gc-card.c
deleted file mode 100644
index aa40312..0000000
--- a/libguile/gc-card.c
+++ /dev/null
@@ -1,481 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2005, 2006, 
2007, 2008, 2009 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 3 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
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <assert.h>
-#include <stdio.h>
-#include <count-one-bits.h>
-
-#include <gmp.h>
-
-#include "libguile/_scm.h"
-#include "libguile/async.h"
-#include "libguile/deprecation.h"
-#include "libguile/eval.h"
-#include "libguile/gc.h"
-#include "libguile/hashtab.h"
-#include "libguile/numbers.h"
-#include "libguile/ports.h"
-#include "libguile/private-gc.h"
-#include "libguile/root.h"
-#include "libguile/smob.h"
-#include "libguile/srfi-4.h"
-#include "libguile/stackchk.h"
-#include "libguile/stime.h"
-#include "libguile/strings.h"
-#include "libguile/struct.h"
-#include "libguile/tags.h"
-#include "libguile/arrays.h"
-#include "libguile/validate.h"
-#include "libguile/vectors.h"
-#include "libguile/weaks.h"
-
-#include "libguile/private-gc.h"
-
-long int scm_i_deprecated_memory_return;
-
-
-/* During collection, this accumulates structures which are to be freed.
- */
-SCM scm_i_structs_to_free;
-
-/*
-  Init all the free cells in CARD, prepending to *FREE_LIST.
-
-  Return: FREE_COUNT, the number of cells collected.  This is
-  typically the length of the *FREE_LIST, but for some special cases,
-  we do not actually free the cell. To make the numbers match up, we
-  do increase the FREE_COUNT.
-
-  It would be cleaner to have a separate function sweep_value (), but
-  that is too slow (functions with switch statements can't be
-  inlined).
-
-  NOTE:
-
-  For many types of cells, allocation and a de-allocation involves
-  calling malloc () and free ().  This is costly for small objects (due
-  to malloc/free overhead.)  (should measure this).
-
-  It might also be bad for threads: if several threads are allocating
-  strings concurrently, then mallocs for both threads may have to
-  fiddle with locks.
-
-  It might be interesting to add a separate memory pool for small
-  objects to each freelist.
-
-  --hwn.
- */
-int
-scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg)
-#define FUNC_NAME "sweep_card"
-{
-  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (card);
-  scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
-  scm_t_cell *p = card;
-  int span = seg->span;
-  int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
-  int free_count = 0;
-  
-  /*
-    I tried something fancy with shifting by one bit every word from
-    the bitvec in turn, but it wasn't any faster, but quite a bit
-    hairier.
-   */
-  for (p += offset; p < end; p += span, offset += span)
-    {
-      SCM scmptr = PTR2SCM (p);
-      if (SCM_C_BVEC_GET (bitvec, offset))
-        continue;
-      free_count++;
-      switch (SCM_TYP7 (scmptr))
-       {
-       case scm_tcs_struct:
-         /* The card can be swept more than once.  Check that it's
-          * the first time!
-          */
-         if (!SCM_STRUCT_GC_CHAIN (scmptr))
-           {
-             /* Structs need to be freed in a special order.
-              * This is handled by GC C hooks in struct.c.
-              */
-             SCM_SET_STRUCT_GC_CHAIN (scmptr, scm_i_structs_to_free);
-             scm_i_structs_to_free = scmptr;
-           }
-         continue;
-      
-       case scm_tcs_cons_imcar:
-       case scm_tcs_cons_nimcar:
-       case scm_tcs_closures:
-       case scm_tc7_pws:
-         break;
-       case scm_tc7_wvect:
-       case scm_tc7_vector:
-         scm_i_vector_free (scmptr);
-         break;
-
-       case scm_tc7_number:
-         switch SCM_TYP16 (scmptr)
-            {
-            case scm_tc16_real:
-              break;
-            case scm_tc16_big:
-              mpz_clear (SCM_I_BIG_MPZ (scmptr));
-              /* nothing else to do here since the mpz is in a double cell */
-              break;
-           case scm_tc16_complex:
-             scm_gc_free (SCM_COMPLEX_MEM (scmptr), sizeof (scm_t_complex),
-                          "complex");
-             break;
-           case scm_tc16_fraction:
-             /* nothing to do here since the num/denum of a fraction
-                are proper SCM objects themselves. */
-             break;
-            }
-          break;
-       case scm_tc7_string:
-         scm_i_string_free (scmptr);
-         break;
-       case scm_tc7_stringbuf:
-         scm_i_stringbuf_free (scmptr);
-         break;
-       case scm_tc7_symbol:
-         scm_i_symbol_free (scmptr); 
-         break;
-       case scm_tc7_variable:
-         break;
-       case scm_tc7_program:
-         break;
-       case scm_tcs_subrs:
-         /* the various "subrs" (primitives) are never freed */
-         continue;
-       case scm_tc7_port:
-         if SCM_OPENP (scmptr)
-           {
-             int k = SCM_PTOBNUM (scmptr);
-             size_t mm;
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-             if (!(k < scm_numptob))
-               {
-                 fprintf (stderr, "undefined port type");
-                 abort ();
-               }
-#endif
-             /* Keep "revealed" ports alive.  */
-             if (scm_revealed_count (scmptr) > 0)
-               continue;
-             
-             /* Yes, I really do mean scm_ptobs[k].free */
-             /* rather than ftobs[k].close.  .close */
-             /* is for explicit CLOSE-PORT by user */
-             mm = scm_ptobs[k].free (scmptr);
-
-             if (mm != 0)
-               {
-#if SCM_ENABLE_DEPRECATED == 1
-                 scm_c_issue_deprecation_warning
-                   ("Returning non-0 from a port free function is "
-                    "deprecated.  Use scm_gc_free et al instead.");
-                 scm_c_issue_deprecation_warning_fmt
-                   ("(You just returned non-0 while freeing a %s.)",
-                    SCM_PTOBNAME (k));
-                 scm_i_deprecated_memory_return += mm;
-#else
-                 abort ();
-#endif
-               }
-
-             SCM_SETSTREAM (scmptr, 0);
-             scm_i_remove_port (scmptr);
-             SCM_CLR_PORT_OPEN_FLAG (scmptr);
-           }
-         break;
-       case scm_tc7_smob:
-         switch SCM_TYP16 (scmptr)
-           {
-           case scm_tc_free_cell:
-             break;
-           default:
-             {
-               int k;
-               k = SCM_SMOBNUM (scmptr);
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-               if (!(k < scm_numsmob))
-                 {
-                   fprintf (stderr, "undefined smob type");
-                   abort ();
-                 }
-#endif
-               if (scm_smobs[k].free)
-                 {
-                   size_t mm;
-                   mm = scm_smobs[k].free (scmptr);
-                   if (mm != 0)
-                     {
-#if SCM_ENABLE_DEPRECATED == 1
-                       scm_c_issue_deprecation_warning
-                         ("Returning non-0 from a smob free function is "
-                          "deprecated.  Use scm_gc_free et al instead.");
-                       scm_c_issue_deprecation_warning_fmt
-                         ("(You just returned non-0 while freeing a %s.)",
-                          SCM_SMOBNAME (k));
-                       scm_i_deprecated_memory_return += mm;
-#else
-                       abort ();
-#endif
-                     }
-                 }
-               break;
-             }
-           }
-         break;
-       default:
-         fprintf (stderr, "unknown type");
-         abort ();
-       }
-
-      SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);        
-      SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
-      *free_list = scmptr;
-    }
-  
-  return free_count;
-}
-#undef FUNC_NAME
-
-
-/*
-  Like sweep, but no complicated logic to do the sweeping.
- */
-int
-scm_i_init_card_freelist (scm_t_cell *card, SCM *free_list,
-                         scm_t_heap_segment *seg)
-{
-  int span = seg->span;
-  scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
-  scm_t_cell *p = end - span;
-  int collected = 0;
-  scm_t_c_bvec_long *bvec_ptr = (scm_t_c_bvec_long*) seg->bounds[1];
-  int idx = (card  - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; 
-
-  bvec_ptr += idx * SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
-  SCM_GC_SET_CELL_BVEC (card, bvec_ptr);
-  
-  /*
-     ASSUMPTION: n_header_cells <= 2. 
-   */
-  for (; p > card;  p -= span)
-    {
-      const SCM scmptr = PTR2SCM (p);
-      SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell);
-      SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list));
-      *free_list = scmptr;
-      collected ++;
-    }
-
-  return collected;
-}
-
-/*
-  Amount of cells marked in this cell, measured in 1-cells.
- */
-int
-scm_i_card_marked_count (scm_t_cell *card, int span)
-{
-  scm_t_c_bvec_long* bvec = SCM_GC_CARD_BVEC (card);
-  scm_t_c_bvec_long* bvec_end = (bvec + SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
-  
-  int count = 0;
-  while (bvec < bvec_end)
-    {
-      count += count_one_bits_l (*bvec);
-      bvec ++;
-    }
-  return count * span;
-}
-
-void
-scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg)
-{
-  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (p);
-  scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
-  int span = seg->span;
-  int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
-
-  if (!bitvec)
-    /* Card P hasn't been initialized yet by `scm_i_init_card_freelist ()'. */
-    return;
-
-  for (p += offset; p < end; p += span, offset += span)
-    {
-      scm_t_bits tag = -1;
-      SCM scmptr = PTR2SCM (p);
-
-      if (!SCM_C_BVEC_GET (bitvec, offset))
-        continue;
-
-      tag = SCM_TYP7 (scmptr);
-      if (tag == scm_tc7_smob || tag == scm_tc7_number)
-       {
-          /* Record smobs and numbers under 16 bits of the tag, so the
-             different smob objects are distinguished, and likewise the
-             different numbers big, real, complex and fraction. */
-         tag = SCM_TYP16(scmptr);
-       }
-      else
-       switch (tag) 
-       {
-       case scm_tcs_cons_imcar:
-         tag = scm_tc2_int;
-         break;
-       case scm_tcs_cons_nimcar:
-         tag = scm_tc3_cons;
-         break;
-
-       case scm_tcs_struct:
-         tag = scm_tc3_struct;
-         break;
-       case scm_tcs_closures:
-         tag = scm_tc3_closure;
-         break;
-       case scm_tcs_subrs:
-         tag = scm_tc7_asubr;
-         break;
-       }
-
-      {      
-        SCM handle = scm_hashq_create_handle_x (hashtab,
-                                                scm_from_int (tag), SCM_INUM0);
-        SCM_SETCDR (handle, scm_from_int (scm_to_int (SCM_CDR (handle)) + 1));
-      }
-    }
-}
-
-/* TAG is the tag word of a cell, return a string which is its name, or NULL
-   if unknown.  Currently this is only used by gc-live-object-stats and the
-   distinctions between types are oriented towards what that code records
-   while scanning what's alive.  */
-char const *
-scm_i_tag_name (scm_t_bits tag)
-{
-  switch (tag & 0x7F) /* 7 bits */
-    {
-    case scm_tcs_struct:
-      return "struct";
-    case scm_tcs_cons_imcar:
-      return "cons (immediate car)";
-    case scm_tcs_cons_nimcar:
-      return "cons (non-immediate car)";
-    case scm_tcs_closures:
-      return "closures";
-    case scm_tc7_pws:
-      return "pws";
-    case scm_tc7_program:
-      return "program";
-    case scm_tc7_wvect:
-      return "weak vector";
-    case scm_tc7_vector:
-      return "vector";
-    case scm_tc7_number:
-      switch (tag)
-       {
-       case scm_tc16_real:
-         return "real";
-       case scm_tc16_big:
-         return "bignum";
-       case scm_tc16_complex:
-         return "complex number";
-       case scm_tc16_fraction:
-         return "fraction";
-       }
-      /* shouldn't reach here unless there's a new class of numbers */
-      return "number";
-    case scm_tc7_string:
-      return "string";
-    case scm_tc7_stringbuf:
-      return "string buffer";
-    case scm_tc7_symbol:
-      return "symbol";
-    case scm_tc7_variable:
-      return "variable";
-    case scm_tcs_subrs:
-      return "subrs";
-    case scm_tc7_port:
-      return "port";
-    case scm_tc7_smob:
-      /* scm_tc_free_cell is smob 0, the name field in that scm_smobs[]
-         entry should be ok for our return here */
-      return scm_smobs[SCM_TC2SMOBNUM (tag)].name;
-    }
-
-  return NULL;
-}
-
-
-#if (SCM_DEBUG_DEBUGGING_SUPPORT == 1)
-
-typedef struct scm_dbg_t_list_cell {
-  scm_t_bits car;  
-  struct scm_dbg_t_list_cell * cdr;
-} scm_dbg_t_list_cell;
-
-
-typedef struct scm_dbg_t_double_cell {
-  scm_t_bits word_0;
-  scm_t_bits word_1;
-  scm_t_bits word_2;
-  scm_t_bits word_3;
-} scm_dbg_t_double_cell;
-
-
-int scm_dbg_gc_marked_p (SCM obj);
-scm_t_cell * scm_dbg_gc_get_card (SCM obj);
-scm_t_c_bvec_long * scm_dbg_gc_get_bvec (SCM obj);
-
-
-int
-scm_dbg_gc_marked_p (SCM obj)
-{
-  if (!SCM_IMP (obj))
-    return SCM_GC_MARK_P (obj);
-  else
-    return 0;
-}
-
-scm_t_cell *
-scm_dbg_gc_get_card (SCM obj)
-{
-  if (!SCM_IMP (obj))
-    return SCM_GC_CELL_CARD (obj);
-  else
-    return NULL;
-}
-
-scm_t_c_bvec_long *
-scm_dbg_gc_get_bvec (SCM obj)
-{
-  if (!SCM_IMP (obj))
-    return SCM_GC_CARD_BVEC (SCM_GC_CELL_CARD (obj));
-  else
-    return NULL;
-}
-
-#endif
diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c
deleted file mode 100644
index 54a10e7..0000000
--- a/libguile/gc-freelist.c
+++ /dev/null
@@ -1,193 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 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 3 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
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <assert.h>
-#include <stdio.h>
-
-#include "libguile/private-gc.h"
-#include "libguile/gc.h"
-#include "libguile/deprecation.h"
-#include "libguile/private-gc.h"
-
-scm_t_cell_type_statistics scm_i_master_freelist;
-scm_t_cell_type_statistics scm_i_master_freelist2;
-
-/*
-
-In older versions of GUILE GC there was extensive support for
-debugging freelists. This was useful, since the freelist was kept
-inside the heap, and writing to an object that was GC'd would mangle
-the list. Mark bits are now separate, and checking for sane cell
-access can be done much more easily by simply checking if the mark bit
-is unset before allocation.  --hwn
-
-*/
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-#if defined(GUILE_DEBUG_FREELIST)
-
-SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
-            (),
-           "DEPRECATED\n")
-#define FUNC_NAME "s_scm_map_free_list"
-{
-  scm_c_issue_deprecation_warning ("map-free-list has been removed from GUILE. 
Doing nothing\n");
-  return SCM_UNSPECIFIED;
-}  
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 
1, 0, 0,
-            (SCM flag),
-           "DEPRECATED.\n")
-#define FUNC_NAME "s_scm_gc_set_debug_check_freelist_x"
-{
-  scm_c_issue_deprecation_warning ("gc-set-debug-check-freelist! has been 
removed from GUILE. Doing nothing\n");
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-#endif /* defined (GUILE_DEBUG) */
-#endif /* deprecated */
-
-static void
-scm_init_freelist (scm_t_cell_type_statistics *freelist,
-                  int span,
-                  int min_yield_percentage)
-{
-  if (min_yield_percentage < 1)
-    min_yield_percentage = 1;
-  if (min_yield_percentage > 99)
-    min_yield_percentage = 99;
-
-  freelist->heap_segment_idx = -1;
-  freelist->min_yield_fraction = min_yield_percentage / 100.0;
-  freelist->span = span;
-  freelist->swept = 0;
-  freelist->collected = 0;
-  freelist->heap_total_cells = 0;
-}
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-size_t scm_default_init_heap_size_1;
-int scm_default_min_yield_1;
-size_t scm_default_init_heap_size_2;
-int scm_default_min_yield_2;
-size_t scm_default_max_segment_size;
-
-static void
-check_deprecated_heap_vars (void)  {
-  if (scm_default_init_heap_size_1 ||
-      scm_default_min_yield_1||
-      scm_default_init_heap_size_2||
-      scm_default_min_yield_2||
-      scm_default_max_segment_size)
-    {
-      scm_c_issue_deprecation_warning ("Tuning heap parameters with C 
variables is deprecated. Use environment variables instead.");
-    }
-}
-#else
-static void check_deprecated_heap_vars (void) { }
-#endif
-
-void
-scm_gc_init_freelist (void)
-{
-  const char *error_message =
-    "Could not allocate initial heap of %uld.\n"
-    "Try adjusting GUILE_INIT_SEGMENT_SIZE_%d\n";
- 
-  int init_heap_size_1
-    = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", 
SCM_DEFAULT_INIT_HEAP_SIZE_1);
-  int init_heap_size_2
-    = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", 
SCM_DEFAULT_INIT_HEAP_SIZE_2);
-
-  scm_init_freelist (&scm_i_master_freelist2, 2, 
-                    scm_getenv_int ("GUILE_MIN_YIELD_2", 
SCM_DEFAULT_MIN_YIELD_2));
-  scm_init_freelist (&scm_i_master_freelist, 1,
-                    scm_getenv_int ("GUILE_MIN_YIELD_1", 
SCM_DEFAULT_MIN_YIELD_1));
-
-  scm_max_segment_size = scm_getenv_int ("GUILE_MAX_SEGMENT_SIZE", 
SCM_DEFAULT_MAX_SEGMENT_SIZE);
-
-  if (scm_max_segment_size <= 0)
-    scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE;
-   
-  if (scm_i_get_new_heap_segment (&scm_i_master_freelist,
-                                 init_heap_size_1, return_on_error) == -1)  {
-    fprintf (stderr, error_message, init_heap_size_1, 1);
-    abort ();
-  }
-  if (scm_i_get_new_heap_segment (&scm_i_master_freelist2,
-                                 init_heap_size_2, return_on_error) == -1) {
-    fprintf (stderr, error_message, init_heap_size_2, 2);
-    abort ();
-  }
-
-  check_deprecated_heap_vars ();
-}
-
-
-
-void
-scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist)
-{
-  freelist->collected = 0;
-  freelist->swept = 0;
-  /*
-    at the end we simply start with the lowest segment again.
-   */
-  freelist->heap_segment_idx = -1;
-}
-
-
-/*
-  Returns how many more cells we should allocate according to our
-  policy.  May return negative if we don't need to allocate more. 
-
-
-  The new yield should at least equal gc fraction of new heap size, i.e.
-
-  c + dh > f * (h + dh)
-
-  c : collected
-  f : min yield fraction
-  h : heap size
-  dh : size of new heap segment
-
-  this gives dh > (f * h - c) / (1 - f).
-*/
-float
-scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist)
-{
-  float f = freelist->min_yield_fraction;
-  float collected = freelist->collected;
-  float swept = freelist->swept;
-  float delta = ((f * swept - collected) / (1.0 - f));
-
-#if 0
-  assert (freelist->heap_total_cells >= freelist->collected);
-  assert (freelist->swept == freelist->heap_total_cells);
-  assert (swept >= collected);
-#endif
-
-  return delta;
-}
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 6e9120e..e48d2cf 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -78,27 +78,6 @@ extern unsigned long * 
__libc_ia64_register_backing_store_base;
 
 /* #define DEBUGINFO */
 
-static int scm_i_minyield_malloc;
-
-void
-scm_gc_init_malloc (void)
-{
-  int mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
-                                SCM_DEFAULT_INIT_MALLOC_LIMIT);
-  scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
-                                         SCM_DEFAULT_MALLOC_MINYIELD);
-
-  if (scm_i_minyield_malloc >= 100)
-    scm_i_minyield_malloc = 99;
-  if (scm_i_minyield_malloc < 1)
-    scm_i_minyield_malloc = 1;
-
-  if (mtrigger < 0)
-    scm_mtrigger = SCM_DEFAULT_INIT_MALLOC_LIMIT;
-  else
-    scm_mtrigger = mtrigger;
-}
-
 
 
 /* Function for non-cell memory management.
@@ -113,23 +92,9 @@ scm_realloc (void *mem, size_t size)
   if (ptr)
     return ptr;
 
-  scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
-  scm_gc_running_p = 1;
-
-  scm_i_gc ("realloc");
+  /* Time is hard: trigger a full, ``stop-the-world'' GC, and try again.  */
+  GC_gcollect ();
 
-  /*
-   We don't want these sweep statistics to influence results for
-   cell GC, so we don't collect statistics.
-   
-   realloc () failed, so we're really desparate to free memory. Run a
-   full sweep.
-  */
-  scm_i_sweep_all_segments ("realloc", NULL);
-
-  scm_gc_running_p = 0;
-  scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
-  
   SCM_SYSCALL (ptr = realloc (mem, size));
   if (ptr)
     return ptr;
@@ -159,7 +124,7 @@ scm_calloc (size_t sz)
   SCM_SYSCALL (ptr = calloc (sz, 1));
   if (ptr)
     return ptr;
-  
+
   ptr = scm_realloc (NULL, sz);
   memset (ptr, 0x0, sz);
   return ptr;
@@ -181,119 +146,15 @@ scm_strdup (const char *str)
   return scm_strndup (str, strlen (str));
 }
 
-static void
-decrease_mtrigger (size_t size, const char * what)
-{
-  scm_i_pthread_mutex_lock (&scm_i_gc_admin_mutex);
-
-  if (size > scm_mallocated)
-    {
-      fprintf (stderr, "`scm_mallocated' underflow.  This means that more "
-              "memory was unregistered\n"
-              "via `scm_gc_unregister_collectable_memory ()' than "
-              "registered.\n");
-      abort ();
-    }
-
-  scm_mallocated -= size;
-  scm_gc_malloc_collected += size;
-  scm_i_pthread_mutex_unlock (&scm_i_gc_admin_mutex);
-}
-
-static void
-increase_mtrigger (size_t size, const char *what)
-{
-  size_t mallocated = 0;
-  int overflow = 0, triggered = 0;
-
-  scm_i_pthread_mutex_lock (&scm_i_gc_admin_mutex);
-  if (ULONG_MAX - size < scm_mallocated)
-    overflow = 1;
-  else
-    {
-      scm_mallocated += size;
-      mallocated = scm_mallocated;
-      if (scm_mallocated > scm_mtrigger)
-       triggered = 1;
-    }
-  scm_i_pthread_mutex_unlock (&scm_i_gc_admin_mutex);
 
-  if (overflow)
-    scm_memory_error ("Overflow of scm_mallocated: too much memory in use.");
-
-  /*
-    A program that uses a lot of malloced collectable memory (vectors,
-    strings), will use a lot of memory off the cell-heap; it needs to
-    do GC more often (before cells are exhausted), otherwise swapping
-    and malloc management will tie it down.
-   */
-  if (triggered)
-    {
-      unsigned long prev_alloced;
-      float yield;
-
-      scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
-      scm_gc_running_p = 1;
-      
-      prev_alloced = mallocated;
-
-      /* The GC will finish the pending sweep. For that reason, we
-        don't execute a complete sweep after GC, although that might
-        free some more memory.
-      */
-      scm_i_gc (what);
-
-      yield = (((float) prev_alloced - (float) scm_mallocated)
-              / (float) prev_alloced);
-      
-      scm_gc_malloc_yield_percentage = (int) (100 * yield);
-
-#ifdef DEBUGINFO
-      fprintf (stderr,  "prev %lud , now %lud, yield %4.2lf, want %d",
-              prev_alloced,
-              scm_mallocated,
-              100.0 * yield,
-              scm_i_minyield_malloc);
-#endif
-      
-      if (yield < scm_i_minyield_malloc /  100.0)
-       {
-         /*
-           We make the trigger a little larger, even; If you have a
-           program that builds up a lot of data in strings, then the
-           desired yield will never be satisfied.
-
-           Instead of getting bogged down, we let the mtrigger grow
-           strongly with it.
-          */
-         float no_overflow_trigger = scm_mallocated * 110.0;
-
-         no_overflow_trigger /= (float)  (100.0 - scm_i_minyield_malloc);
-
-         
-         if (no_overflow_trigger >= (float) ULONG_MAX)
-           scm_mtrigger = ULONG_MAX;
-         else
-           scm_mtrigger = (unsigned long) no_overflow_trigger;
-         
-#ifdef DEBUGINFO
-         fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n",
-                  scm_mtrigger);
-#endif
-       }
-
-      scm_gc_running_p = 0;
-      scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
-    }
-}
 
 void
 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 {
-  increase_mtrigger (size, what); 
+  /* Nothing to do.  */
 #ifdef GUILE_DEBUG_MALLOC
   if (mem)
-    scm_malloc_register (mem, what);
+    scm_malloc_register (mem);
 #endif
 }
 
@@ -301,13 +162,21 @@ scm_gc_register_collectable_memory (void *mem, size_t 
size, const char *what)
 void
 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 {
-  decrease_mtrigger (size, what);
+  /* Nothing to do.  */
 #ifdef GUILE_DEBUG_MALLOC
   if (mem)
     scm_malloc_unregister (mem);
 #endif
 }
 
+/* Allocate SIZE bytes of memory whose contents should not be scanned for
+   pointers (useful, e.g., for strings).  */
+void *
+scm_gc_malloc_pointerless (size_t size, const char *what)
+{
+  return GC_MALLOC_ATOMIC (size);
+}
+
 void *
 scm_gc_malloc (size_t size, const char *what)
 {
@@ -322,8 +191,14 @@ scm_gc_malloc (size_t size, const char *what)
      to write it the program is killed with signal 11. --hwn
   */
 
-  void *ptr = size ? scm_malloc (size) : NULL;
-  scm_gc_register_collectable_memory (ptr, size, what);
+  void *ptr;
+
+  if (size == 0)
+    /* `GC_MALLOC ()' doesn't handle zero.  */
+    size = sizeof (void *);
+
+  ptr = GC_MALLOC (size);
+
   return ptr;
 }
 
@@ -341,26 +216,13 @@ scm_gc_realloc (void *mem, size_t old_size, size_t 
new_size, const char *what)
 {
   void *ptr;
 
-  /* XXX - see scm_gc_malloc. */
-
-
-  /*    
-  scm_realloc () may invalidate the block pointed to by WHERE, eg. by
-  unmapping it from memory or altering the contents.  Since
-  increase_mtrigger () might trigger a GC that would scan
-  MEM, it is crucial that this call precedes realloc ().
-  */
-
-  decrease_mtrigger (old_size, what);
-  increase_mtrigger (new_size, what);
-
-  ptr = scm_realloc (mem, new_size);
+  ptr = GC_REALLOC (mem, new_size);
 
 #ifdef GUILE_DEBUG_MALLOC
   if (mem)
     scm_malloc_reregister (mem, ptr, what);
 #endif
-  
+
   return ptr;
 }
 
@@ -368,14 +230,13 @@ void
 scm_gc_free (void *mem, size_t size, const char *what)
 {
   scm_gc_unregister_collectable_memory (mem, size, what);
-  if (mem)
-    free (mem);
+  GC_FREE (mem);
 }
 
 char *
 scm_gc_strndup (const char *str, size_t n, const char *what)
 {
-  char *dst = scm_gc_malloc (n+1, what);
+  char *dst = GC_MALLOC (n+1);
   memcpy (dst, str, n);
   dst[n] = 0;
   return dst;
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
deleted file mode 100644
index cc881e8..0000000
--- a/libguile/gc-mark.c
+++ /dev/null
@@ -1,520 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 
2006, 2009 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 3 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
- */
-
-
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <stdio.h>
-#include <errno.h>
-#include <string.h>
-#include <assert.h>
-
-#ifdef __ia64__
-#include <ucontext.h>
-extern unsigned long * __libc_ia64_register_backing_store_base;
-#endif
-
-#include "libguile/_scm.h"
-#include "libguile/eval.h"
-#include "libguile/stime.h"
-#include "libguile/stackchk.h"
-#include "libguile/struct.h"
-#include "libguile/smob.h"
-#include "libguile/arrays.h"
-#include "libguile/async.h"
-#include "libguile/programs.h"
-#include "libguile/ports.h"
-#include "libguile/root.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/weaks.h"
-#include "libguile/hashtab.h"
-#include "libguile/tags.h"
-#include "libguile/private-gc.h"
-#include "libguile/validate.h"
-#include "libguile/deprecation.h"
-#include "libguile/gc.h"
-#include "libguile/guardians.h"
-
-#ifdef GUILE_DEBUG_MALLOC
-#include "libguile/debug-malloc.h"
-#endif
-
-#ifdef HAVE_MALLOC_H
-#include <malloc.h>
-#endif
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-int scm_i_marking = 0;
-
-/*
-  Entry point for this file.
- */
-void
-scm_mark_all (void)
-{
-  long j;
-  int loops;
-
-  scm_i_marking = 1;
-  scm_i_init_weak_vectors_for_gc ();
-  scm_i_init_guardians_for_gc ();
-  
-  scm_i_clear_mark_space ();
-  scm_i_find_heap_calls = 0;
-  /* Mark every thread's stack and registers */
-  scm_threads_mark_stacks ();
-
-  j = SCM_NUM_PROTECTS;
-  while (j--)
-    scm_gc_mark (scm_sys_protects[j]);
-
-  /* mark the registered roots */
-  {
-    size_t i;
-    for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (scm_gc_registered_roots); ++i)
-      {
-       SCM l = SCM_HASHTABLE_BUCKET (scm_gc_registered_roots, i);
-       for (; !scm_is_null (l); l = SCM_CDR (l))
-         {
-           SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l)));
-           scm_gc_mark (*p);
-         }
-      }
-  }
-
-  loops = 0;
-  while (1)
-    {
-      int again;
-      loops++;
-
-      /* Mark the non-weak references of weak vectors.  For a weak key
-        alist vector, this would mark the values for keys that are
-        marked.  We need to do this in a loop until everything
-        settles down since the newly marked values might be keys in
-        other weak key alist vectors, for example.
-      */
-      again = scm_i_mark_weak_vectors_non_weaks ();
-      if (again)
-       continue;
-
-      /* Now we scan all marked guardians and move all unmarked objects
-        from the accessible to the inaccessible list.
-      */
-      scm_i_identify_inaccessible_guardeds ();
-
-      /* When we have identified all inaccessible objects, we can mark
-        them.
-      */
-      again = scm_i_mark_inaccessible_guardeds ();
-
-      /* This marking might have changed the situation for weak vectors
-        and might have turned up new guardians that need to be processed,
-        so we do it all over again.
-      */
-      if (again)
-       continue;
-      
-      /* Nothing new marked in this round, we are done.
-       */
-      break;
-    }
-
-  /* Remove all unmarked entries from the weak vectors.
-   */
-  scm_i_remove_weaks_from_weak_vectors ();
-  
-  /* Bring hashtables upto date.
-   */
-  scm_i_scan_weak_hashtables ();
-  scm_i_marking = 0;
-}
-
-/* {Mark/Sweep}
- */
-
-/*
-  Mark an object precisely, then recurse.
- */
-void
-scm_gc_mark (SCM ptr)
-{
-  if (SCM_IMP (ptr))
-    return;
-  
-  if (SCM_GC_MARK_P (ptr))
-    return;
-
-  if (!scm_i_marking)
-    {
-      static const char msg[]
-       = "Should only call scm_gc_mark() during GC.";
-      scm_c_issue_deprecation_warning (msg);
-    }
-
-  SCM_SET_GC_MARK (ptr);
-  scm_gc_mark_dependencies (ptr);
-}
-
-void
-scm_i_ensure_marking (void)
-{
-  assert (scm_i_marking);
-}
-
-/*
-
-Mark the dependencies of an object.
-
-Prefetching:
-
-Should prefetch objects before marking, i.e. if marking a cell, we
-should prefetch the car, and then mark the cdr. This will improve CPU
-cache misses, because the car is more likely to be in cache when we
-finish the cdr.
-
-See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing
-garbage collector cache misses.
-
-Prefetch is supported on GCC >= 3.1 
-
-(Some time later.)
-
-Tried this with GCC 3.1.1 -- the time differences are barely measurable.
-Perhaps this would work better with an explicit markstack?
-
-
-*/
-
-void
-scm_gc_mark_dependencies (SCM p)
-#define FUNC_NAME "scm_gc_mark_dependencies"
-{
-  register long i;
-  register SCM ptr;
-  SCM cell_type;
-
-  ptr = p;
- scm_mark_dependencies_again:
-  
-  cell_type = SCM_GC_CELL_TYPE (ptr);
-  switch (SCM_ITAG7 (cell_type))
-    {
-    case scm_tcs_cons_nimcar:
-      if (SCM_IMP (SCM_CDR (ptr)))
-       {
-         ptr = SCM_CAR (ptr);
-         goto gc_mark_nimp;
-       }
-
-
-      scm_gc_mark (SCM_CAR (ptr));
-      ptr = SCM_CDR (ptr);
-      goto gc_mark_nimp;
-    case scm_tcs_cons_imcar:
-      ptr = SCM_CDR (ptr);
-      goto gc_mark_loop;
-    case scm_tc7_pws:
-
-      scm_gc_mark (SCM_SETTER (ptr));
-      ptr = SCM_PROCEDURE (ptr);
-      goto gc_mark_loop;
-    case scm_tcs_struct:
-      {
-       /* XXX - use less explicit code. */
-       scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct;
-       scm_t_bits * vtable_data = (scm_t_bits *) word0;
-       SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
-       long len = scm_i_symbol_length (layout);
-       scm_t_bits *struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
-
-       if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
-         {
-           scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_procedure]));
-           scm_gc_mark (SCM_PACK (struct_data[scm_struct_i_setter]));
-         }
-       if (len)
-         {
-           long x;
-
-           for (x = 0; x < len - 2; x += 2, ++struct_data)
-             if (scm_i_symbol_ref (layout, x) ==  'p')
-               scm_gc_mark (SCM_PACK (*struct_data));
-           if (scm_i_symbol_ref (layout, x) == 'p')
-             {
-               scm_t_wchar ch = scm_i_symbol_ref (layout, x+1);
-               if (SCM_LAYOUT_TAILP (ch))
-                 for (x = *struct_data++; x; --x, ++struct_data)
-                   scm_gc_mark (SCM_PACK (*struct_data));
-               else
-                 scm_gc_mark (SCM_PACK (*struct_data));
-             }
-         }
-       /* mark vtable */
-       ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]);
-       goto gc_mark_loop;
-      }
-      break;
-    case scm_tcs_closures:
-      if (SCM_IMP (SCM_ENV (ptr)))
-       {
-         ptr = SCM_CLOSCAR (ptr);
-         goto gc_mark_nimp;
-       }
-      scm_gc_mark (SCM_CLOSCAR (ptr));
-      ptr = SCM_ENV (ptr);
-      goto gc_mark_nimp;
-    case scm_tc7_program:
-      if (SCM_PROGRAM_FREE_VARIABLES (ptr) != SCM_BOOL_F)
-        scm_gc_mark (SCM_PROGRAM_FREE_VARIABLES (ptr));
-      if (SCM_PROGRAM_OBJTABLE (ptr) != SCM_BOOL_F)
-        scm_gc_mark (SCM_PROGRAM_OBJTABLE (ptr));
-      ptr = SCM_PROGRAM_OBJCODE (ptr);
-      goto gc_mark_nimp;
-    case scm_tc7_vector:
-      i = SCM_SIMPLE_VECTOR_LENGTH (ptr);
-      if (i == 0)
-       break;
-      while (--i > 0)
-       {
-         SCM elt = SCM_SIMPLE_VECTOR_REF (ptr, i);
-         if (SCM_NIMP (elt))
-           scm_gc_mark (elt);
-       }
-      ptr = SCM_SIMPLE_VECTOR_REF (ptr, 0);
-      goto gc_mark_loop;
-
-    case scm_tc7_string:
-      ptr = scm_i_string_mark (ptr);
-      goto gc_mark_loop;
-    case scm_tc7_stringbuf:
-      ptr = scm_i_stringbuf_mark (ptr);
-      goto gc_mark_loop;
-
-    case scm_tc7_number:
-      if (SCM_TYP16 (ptr) == scm_tc16_fraction)
-       {
-         scm_gc_mark (SCM_CELL_OBJECT_1 (ptr));
-         ptr = SCM_CELL_OBJECT_2 (ptr);
-         goto gc_mark_loop;
-       }
-      break;
-
-    case scm_tc7_wvect:
-      scm_i_mark_weak_vector (ptr);
-      break;
-
-    case scm_tc7_symbol:
-      ptr = scm_i_symbol_mark (ptr);
-      goto gc_mark_loop;
-    case scm_tc7_variable:
-      ptr = SCM_CELL_OBJECT_1 (ptr);
-      goto gc_mark_loop;
-    case scm_tcs_subrs:
-      if (SCM_CELL_WORD_2 (ptr) && *(SCM*)SCM_CELL_WORD_2 (ptr))
-        /* the generic associated with this primitive */
-        scm_gc_mark (*(SCM*)SCM_CELL_WORD_2 (ptr));
-      if (SCM_NIMP (((SCM*)SCM_CELL_WORD_3 (ptr))[1]))
-        scm_gc_mark (((SCM*)SCM_CELL_WORD_3 (ptr))[1]); /* props */
-      ptr = ((SCM*)SCM_CELL_WORD_3 (ptr))[0]; /* name */
-      goto gc_mark_loop;
-    case scm_tc7_port:
-      i = SCM_PTOBNUM (ptr);
-#if (SCM_DEBUG_CELL_ACCESSES == 1) 
-      if (!(i < scm_numptob))
-       {
-         fprintf (stderr, "undefined port type");
-         abort ();
-       }
-#endif
-      if (SCM_PTAB_ENTRY (ptr))
-       scm_gc_mark (SCM_FILENAME (ptr));
-      if (scm_ptobs[i].mark)
-       {
-         ptr = (scm_ptobs[i].mark) (ptr);
-         goto gc_mark_loop;
-       }
-      else
-       return;
-      break;
-    case scm_tc7_smob:
-      switch (SCM_TYP16 (ptr))
-       { /* should be faster than going through scm_smobs */
-       case scm_tc_free_cell:
-         /* We have detected a free cell.  This can happen if non-object data
-          * on the C stack points into guile's heap and is scanned during
-          * conservative marking.  */
-         break;
-       default:
-         i = SCM_SMOBNUM (ptr);
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-         if (!(i < scm_numsmob))
-           {
-             fprintf (stderr, "undefined smob type");
-             abort ();
-           }
-#endif
-         if (scm_smobs[i].mark)
-           {
-             ptr = (scm_smobs[i].mark) (ptr);
-             goto gc_mark_loop;
-           }
-         else
-           return;
-       }
-      break;
-    default:
-      fprintf (stderr, "unknown type");
-      abort ();
-    }
-
-  /*
-    If we got here, then exhausted recursion options for PTR.  we
-    return (careful not to mark PTR, it might be the argument that we
-    were called with.)
-   */
-  return ;
-
- gc_mark_loop:
-  if (SCM_IMP (ptr))
-    return;
-
- gc_mark_nimp:
-  {
-    int valid_cell = CELL_P (ptr);
-
-    
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-    if (scm_debug_cell_accesses_p)
-      {
-    /* We are in debug mode.  Check the ptr exhaustively. */
-       
-       valid_cell = valid_cell && scm_in_heap_p (ptr);
-      }
-    
-#endif
-    if (!valid_cell)
-      {
-       fprintf (stderr, "rogue pointer in heap");
-       abort ();
-      }
-  }
-  
-  if (SCM_GC_MARK_P (ptr))
-    return;
-  
-  SCM_SET_GC_MARK (ptr);
-
-  goto   scm_mark_dependencies_again;
-  
-}
-#undef FUNC_NAME
-
-
-/* Mark a region conservatively */
-void
-scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
-{
-  unsigned long m;
-
-  for (m = 0; m < n; ++m)
-    {
-      SCM obj = * (SCM *) &x[m];
-      long int segment = scm_i_find_heap_segment_containing_object (obj);
-      if (segment >= 0)
-       scm_gc_mark (obj);
-    }
-}
-
-
-/* The function scm_in_heap_p determines whether an SCM value can be regarded 
as a
- * pointer to a cell on the heap.
- */
-int
-scm_in_heap_p (SCM value)
-{
-  long int segment = scm_i_find_heap_segment_containing_object (value);
-  return (segment >= 0);
-}
-
-
-#if SCM_ENABLE_DEPRECATED == 1
-
-/* If an allocated cell is detected during garbage collection, this
- * means that some code has just obtained the object but was preempted
- * before the initialization of the object was completed.  This meanst
- * that some entries of the allocated cell may already contain SCM
- * objects.  Therefore, allocated cells are scanned conservatively.
- */
-
-scm_t_bits scm_tc16_allocated;
-
-static SCM
-allocated_mark (SCM cell)
-{
-  unsigned long int cell_segment = scm_i_find_heap_segment_containing_object 
(cell);
-  unsigned int span = scm_i_heap_segment_table[cell_segment]->span;
-  unsigned int i;
-
-  for (i = 1; i != span * 2; ++i)
-    {
-      SCM obj = SCM_CELL_OBJECT (cell, i);
-      long int obj_segment = scm_i_find_heap_segment_containing_object (obj);
-      if (obj_segment >= 0)
-       scm_gc_mark (obj);
-    }
-  return SCM_BOOL_F;
-}
-
-SCM
-scm_deprecated_newcell (void)
-{
-  scm_c_issue_deprecation_warning 
-    ("SCM_NEWCELL is deprecated.  Use `scm_cell' instead.\n");
-
-  return scm_cell (scm_tc16_allocated, 0);
-}
-
-SCM
-scm_deprecated_newcell2 (void)
-{
-  scm_c_issue_deprecation_warning 
-    ("SCM_NEWCELL2 is deprecated.  Use `scm_double_cell' instead.\n");
-
-  return scm_double_cell (scm_tc16_allocated, 0, 0, 0);
-}
-
-#endif /* SCM_ENABLE_DEPRECATED == 1 */
-
-
-void
-scm_gc_init_mark (void)
-{
-#if SCM_ENABLE_DEPRECATED == 1
-  scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
-  scm_set_smob_mark (scm_tc16_allocated, allocated_mark);
-#endif
-}
-
diff --git a/libguile/gc-segment-table.c b/libguile/gc-segment-table.c
deleted file mode 100644
index 75d109c..0000000
--- a/libguile/gc-segment-table.c
+++ /dev/null
@@ -1,300 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 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 3 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
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#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"
-
-
-/*
-  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;
-static scm_t_cell *lowest_cell;
-static scm_t_cell *highest_cell; 
-
-
-/*
-  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;
-  }
-}
-
-
-/*
-  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
-*/
-
-int
-scm_i_find_heap_segment_containing_object (SCM obj)
-{
-  if (!CELL_P (obj))
-    return -1;
-
-  scm_i_find_heap_calls ++;
-  if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell)
-    return -1;
-  
-  {
-    scm_t_cell *ptr = SCM2PTR (obj);
-    unsigned int i = 0;
-    unsigned 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;
-      }
-  }
-}
-
-
-int
-scm_i_marked_count (void)
-{
-  int i = 0;
-  int c = 0;
-  for (; i < scm_i_heap_segment_table_size; i++)
-    {
-      c += scm_i_heap_segment_marked_count (scm_i_heap_segment_table[i]);
-    }
-  return c;
-}
-
-
-SCM
-scm_i_sweep_some_segments (scm_t_cell_type_statistics *freelist,
-                          scm_t_sweep_statistics *sweep_stats)
-{
-  int i = freelist->heap_segment_idx;
-  SCM collected = SCM_EOL;
-
-  if (i == -1)                 /* huh? --hwn */
-    i++;
-
-  for (;
-       i < scm_i_heap_segment_table_size; i++)
-    {
-      if (scm_i_heap_segment_table[i]->freelist != freelist)
-       continue;
-
-      collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i],
-                                         sweep_stats,
-                                         DEFAULT_SWEEP_AMOUNT);
-
-      if (collected != SCM_EOL)       /* Don't increment i */
-       break;
-    }
-
-  freelist->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;
-}
-
-
-unsigned long*
-scm_i_segment_table_info (int* size)
-{
-  *size = scm_i_heap_segment_table_size;  
-  unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2);
-  int i;
-  if (!bounds)
-    abort ();
-  for (i = *size; i-- > 0; )
-    {
-      bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0];
-      bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1];
-    }
-  return bounds;
-}
-
-
-void
-scm_i_sweep_all_segments (char const *reason,
-                         scm_t_sweep_statistics *sweep_stats)
-{
-  unsigned i= 0;
-  for (i = 0; i < scm_i_heap_segment_table_size; i++)
-    {
-      scm_i_sweep_segment (scm_i_heap_segment_table[i], sweep_stats);
-    }
-}
-
-
-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]);
-    }
-}
diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c
deleted file mode 100644
index 7a937e6..0000000
--- a/libguile/gc-segment.c
+++ /dev/null
@@ -1,280 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 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 3 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
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <assert.h> 
-#include <stdio.h>
-#include <string.h>
-
-#include <count-one-bits.h>
-
-#include "libguile/_scm.h"
-#include "libguile/pairs.h"
-#include "libguile/gc.h"
-#include "libguile/private-gc.h"
-
-size_t scm_max_segment_size;
-
-/* Important entry point: try to grab some memory, and make it into a
-   segment; return the index of the segment.  SWEEP_STATS should contain
-   global GC sweep statistics collected since the last full GC.
-
-   Returns the index of the segment.  If error_policy !=
-   abort_on_error, we return -1 on failure.
-*/
-int
-scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
-                           size_t len,
-                           policy_on_error error_policy)
-{
-  if (len > scm_max_segment_size)
-    len = scm_max_segment_size;
-
-  if (len < SCM_MIN_HEAP_SEG_SIZE)
-    len = SCM_MIN_HEAP_SEG_SIZE;
-
-  /* todo: consider having a more flexible lower bound. */
-  {
-    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;
-}
-
-
-scm_t_heap_segment *
-scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
-{
-  scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment));
-
-  if (!shs)
-    {
-      fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
-      abort ();
-    }
-  
-  shs->span = fl->span;
-  shs->freelist  = fl;
-  
-  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;
-    }
-}
-
-/*
-  count number of marked bits, so we know how much cells are live.
- */
-int
-scm_i_heap_segment_marked_count (scm_t_heap_segment *seg)
-{
-  scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1];
-  scm_t_c_bvec_long *bvec_end =
-    (bvec +
-     scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS);
-  
-  int count = 0;
-  while (bvec < bvec_end)
-    {
-      count += count_one_bits_l (*bvec);
-      bvec ++;
-    }
-  return count * seg->span;
-}
-
-int
-scm_i_segment_card_number (scm_t_heap_segment *seg,
-                          scm_t_cell *card)
-{
-  return (card - seg->bounds[0]) / 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_cell *memory = 0;
-
-  /*
-    We use calloc to alloc the heap, so it is nicely initialized.
-   */
-  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_total_cells += scm_i_segment_cell_count (segment);
-
-  /*
-    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_i_segment_cells_per_card (seg);
-}
-
-int
-scm_i_segment_cells_per_card (scm_t_heap_segment *seg)
-{
-  return (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);
-}
-
-
-/*
-  Force a sweep of this entire segment.
- */
-void
-scm_i_sweep_segment (scm_t_heap_segment *seg,
-                    scm_t_sweep_statistics *sweep_stats)
-{
-  int infinity = 1 << 30;
-  scm_t_cell *remember = seg->next_free_card;  
-  while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL)
-    ;
-  seg->next_free_card = remember;
-}
-
-
-/* Sweep cards from SEG until we've gathered THRESHOLD cells.  On
-   return, SWEEP_STATS, if non-NULL, contains the number of cells that
-   have been visited and collected.  A freelist is returned,
-   potentially empty.  */
-SCM
-scm_i_sweep_some_cards (scm_t_heap_segment *seg,
-                       scm_t_sweep_statistics *sweep_stats,
-                       int threshold)
-{
-  SCM cells = SCM_EOL;
-  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 ++;
-    }
-
-  if (sweep_stats != NULL)
-    {
-      int swept = cards_swept 
-       * ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
-          - seg->span + 1);
-      int collected_cells = collected * seg->span;
-      sweep_stats->swept += swept;
-      sweep_stats->collected += collected_cells;
-    }
-  
-  if (next_free == seg->bounds[1])
-    {
-      seg->first_time = 0;
-    }
-
-  seg->next_free_card = next_free;
-  return cells;
-}
-
-
-
-SCM
-scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist)
-{
-  scm_t_sweep_statistics stats = { 0 };
-  SCM result = scm_i_sweep_some_segments (freelist, &stats);
-
-  scm_i_gc_sweep_stats.collected += stats.collected;
-  scm_i_gc_sweep_stats.swept += stats.swept;
-
-  freelist->collected += stats.collected;
-  freelist->swept += stats.swept; 
-  return result;
-}
-
diff --git a/libguile/gc.c b/libguile/gc.c
index 01f5eff..d3c53c7 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -22,11 +22,18 @@
 #  include <config.h>
 #endif
 
+#include "libguile/gen-scmconfig.h"
+
 #include <stdio.h>
 #include <errno.h>
 #include <string.h>
 #include <assert.h>
 
+#ifdef __ia64__
+#include <ucontext.h>
+extern unsigned long * __libc_ia64_register_backing_store_base;
+#endif
+
 #include "libguile/_scm.h"
 #include "libguile/eval.h"
 #include "libguile/stime.h"
@@ -49,6 +56,8 @@
 #include "libguile/gc.h"
 #include "libguile/dynwind.h"
 
+#include "libguile/boehm-gc.h"
+
 #ifdef GUILE_DEBUG_MALLOC
 #include "libguile/debug-malloc.h"
 #endif
@@ -98,13 +107,6 @@ int scm_i_cell_validation_already_running ;
 void
 scm_i_expensive_validation_check (SCM cell)
 {
-  if (!scm_in_heap_p (cell))
-    {
-      fprintf (stderr, "scm_assert_cell_valid: this object does not live in 
the heap: %lux\n",
-              (unsigned long) SCM_UNPACK (cell));
-      abort ();
-    }
-
   /* If desired, perform additional garbage collections after a user
    * defined number of cell accesses.
    */
@@ -198,43 +200,25 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, 
"set-debug-cell-accesses!", 1, 0, 0,
 #endif  /* SCM_DEBUG_CELL_ACCESSES == 1 */
 
 
+/* Hooks.  */
+scm_t_c_hook scm_before_gc_c_hook;
+scm_t_c_hook scm_before_mark_c_hook;
+scm_t_c_hook scm_before_sweep_c_hook;
+scm_t_c_hook scm_after_sweep_c_hook;
+scm_t_c_hook scm_after_gc_c_hook;
 
 
-/* scm_mtrigger
- * is the number of bytes of malloc allocation needed to trigger gc.
- */
-unsigned long scm_mtrigger;
-
 /* GC Statistics Keeping
  */
-unsigned long scm_cells_allocated = 0;
-unsigned long scm_last_cells_allocated = 0;
-unsigned long scm_mallocated = 0;
-long int scm_i_find_heap_calls = 0;
-/* Global GC sweep statistics since the last full GC.  */
-scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
-
-/* Total count of cells marked/swept.  */
-static double scm_gc_cells_marked_acc = 0.;
-static double scm_gc_cells_marked_conservatively_acc = 0.;
-static double scm_gc_cells_swept_acc = 0.;
-static double scm_gc_cells_allocated_acc = 0.;
-
-static unsigned long scm_gc_time_taken = 0;
-static unsigned long scm_gc_mark_time_taken = 0;
-
-static unsigned long scm_gc_times = 0;
+unsigned long scm_gc_ports_collected = 0;
 
-static int scm_gc_cell_yield_percentage = 0;
 static unsigned long protected_obj_count = 0;
 
-/* The following are accessed from `gc-malloc.c' and `gc-card.c'.  */
-int scm_gc_malloc_yield_percentage = 0;
-unsigned long scm_gc_malloc_collected = 0;
-
 
 SCM_SYMBOL (sym_cells_allocated, "cells-allocated");
-SCM_SYMBOL (sym_heap_size, "cell-heap-size");
+SCM_SYMBOL (sym_heap_size, "heap-size");
+SCM_SYMBOL (sym_heap_free_size, "heap-free-size");
+SCM_SYMBOL (sym_heap_total_allocated, "heap-total-allocated");
 SCM_SYMBOL (sym_mallocated, "bytes-malloced");
 SCM_SYMBOL (sym_mtrigger, "gc-malloc-threshold");
 SCM_SYMBOL (sym_heap_segments, "cell-heap-segments");
@@ -288,8 +272,6 @@ SCM_DEFINE (scm_gc_live_object_stats, 
"gc-live-object-stats", 0, 0, 0,
   SCM tab = scm_make_hash_table (scm_from_int (57));
   SCM alist;
 
-  scm_i_all_segments_statistics (tab);
-  
   alist
     = scm_internal_hash_fold (&tag_table_to_type_alist, NULL, SCM_EOL, tab);
   
@@ -304,84 +286,27 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
            "use of storage.\n")
 #define FUNC_NAME s_scm_gc_stats
 {
-  long i = 0;
-  SCM heap_segs = SCM_EOL ;
-  unsigned long int local_scm_mtrigger;
-  unsigned long int local_scm_mallocated;
-  unsigned long int local_scm_heap_size;
-  int local_scm_gc_cell_yield_percentage;
-  int local_scm_gc_malloc_yield_percentage;
-  unsigned long int local_scm_cells_allocated;
-  unsigned long int local_scm_gc_time_taken;
-  unsigned long int local_scm_gc_times;
-  unsigned long int local_scm_gc_mark_time_taken;
-  unsigned long int local_protected_obj_count;
-  double local_scm_gc_cells_swept;
-  double local_scm_gc_cells_marked;
-  double local_scm_gc_cells_marked_conservatively;
-  double local_scm_total_cells_allocated;
   SCM answer;
-  unsigned long *bounds = 0;
-  int table_size = 0;
-  SCM_CRITICAL_SECTION_START;
+  size_t heap_size, free_bytes, bytes_since_gc, total_bytes;
+  size_t gc_times;
 
-  bounds = scm_i_segment_table_info (&table_size);
+  heap_size      = GC_get_heap_size ();
+  free_bytes     = GC_get_free_bytes ();
+  bytes_since_gc = GC_get_bytes_since_gc ();
+  total_bytes    = GC_get_total_bytes ();
+  gc_times       = GC_gc_no;
 
-  /* Below, we cons to produce the resulting list.  We want a snapshot of
-   * the heap situation before consing.
-   */
-  local_scm_mtrigger = scm_mtrigger;
-  local_scm_mallocated = scm_mallocated;
-  local_scm_heap_size =
-    (scm_i_master_freelist.heap_total_cells + 
scm_i_master_freelist2.heap_total_cells);
-
-  local_scm_cells_allocated =
-    scm_cells_allocated + scm_i_gc_sweep_stats.collected;
-  
-  local_scm_gc_time_taken = scm_gc_time_taken;
-  local_scm_gc_mark_time_taken = scm_gc_mark_time_taken;
-  local_scm_gc_times = scm_gc_times;
-  local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage;
-  local_scm_gc_cell_yield_percentage = scm_gc_cell_yield_percentage;
-  local_protected_obj_count = protected_obj_count;
-  local_scm_gc_cells_swept =
-    (double) scm_gc_cells_swept_acc
-    + (double) scm_i_gc_sweep_stats.swept;
-  local_scm_gc_cells_marked = scm_gc_cells_marked_acc 
-    + (double) scm_i_gc_sweep_stats.swept
-    - (double) scm_i_gc_sweep_stats.collected;
-  local_scm_gc_cells_marked_conservatively
-    = scm_gc_cells_marked_conservatively_acc;
-
-  local_scm_total_cells_allocated = scm_gc_cells_allocated_acc
-    + (double) scm_i_gc_sweep_stats.collected;
-  
-  for (i = table_size; i--;)
-    {
-      heap_segs = scm_cons (scm_cons (scm_from_ulong (bounds[2*i]),
-                                     scm_from_ulong (bounds[2*i+1])),
-                           heap_segs);
-    }
-  
   /* njrev: can any of these scm_cons's or scm_list_n signal a memory
      error?  If so we need a frame here. */
   answer =
-    scm_list_n (scm_cons (sym_gc_time_taken,
-                         scm_from_ulong (local_scm_gc_time_taken)),
+    scm_list_n (scm_cons (sym_gc_time_taken, SCM_INUM0),
+#if 0
                scm_cons (sym_cells_allocated,
                          scm_from_ulong (local_scm_cells_allocated)),
-               scm_cons (sym_total_cells_allocated,
-                         scm_from_double (local_scm_total_cells_allocated)),
-               scm_cons (sym_heap_size,
-                         scm_from_ulong (local_scm_heap_size)),
-               scm_cons (sym_cells_marked_conservatively,
-                         scm_from_ulong 
(local_scm_gc_cells_marked_conservatively)),
                scm_cons (sym_mallocated,
                          scm_from_ulong (local_scm_mallocated)),
                scm_cons (sym_mtrigger,
                          scm_from_ulong (local_scm_mtrigger)),
-               scm_cons (sym_times,
-                         scm_from_ulong (local_scm_gc_times)),
                scm_cons (sym_gc_mark_time_taken,
                          scm_from_ulong (local_scm_gc_mark_time_taken)),
                scm_cons (sym_cells_marked,
@@ -392,37 +317,34 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
                          scm_from_long (local_scm_gc_malloc_yield_percentage)),
                scm_cons (sym_cell_yield,
                          scm_from_long (local_scm_gc_cell_yield_percentage)),
-               scm_cons (sym_protected_objects,
-                         scm_from_ulong (local_protected_obj_count)),
                scm_cons (sym_heap_segments, heap_segs),
+#endif
+               scm_cons (sym_heap_size, scm_from_size_t (heap_size)),
+               scm_cons (sym_heap_free_size, scm_from_size_t (free_bytes)),
+               scm_cons (sym_heap_total_allocated,
+                         scm_from_size_t (total_bytes)),
+               scm_cons (sym_protected_objects,
+                         scm_from_ulong (protected_obj_count)),
+               scm_cons (sym_times, scm_from_size_t (gc_times)),
                SCM_UNDEFINED);
-  SCM_CRITICAL_SECTION_END;
-  
-  free (bounds);
+
   return answer;
 }
 #undef FUNC_NAME
 
-/*
-  Update nice-to-know-statistics.
- */
-static void
-gc_end_stats ()
+
+SCM_DEFINE (scm_gc_dump, "gc-dump", 0, 0, 0,
+           (void),
+           "Dump information about the garbage collector's internal data "
+           "structures and memory usage to the standard output.")
+#define FUNC_NAME s_scm_gc_dump
 {
-  /* CELLS SWEPT is another word for the number of cells that were examined
-     during GC. YIELD is the number that we cleaned out. MARKED is the number
-     that weren't cleaned.  */
-  scm_gc_cell_yield_percentage = (scm_i_gc_sweep_stats.collected * 100) /
-    (scm_i_master_freelist.heap_total_cells + 
scm_i_master_freelist2.heap_total_cells);
-
-  scm_gc_cells_allocated_acc +=
-    (double) scm_i_gc_sweep_stats.collected;
-  scm_gc_cells_marked_acc += (double) scm_i_last_marked_cell_count;
-  scm_gc_cells_marked_conservatively_acc += (double) scm_i_find_heap_calls;
-  scm_gc_cells_swept_acc += (double) scm_i_gc_sweep_stats.swept;
-
-  ++scm_gc_times;
+  GC_dump ();
+
+  return SCM_UNSPECIFIED;
 }
+#undef FUNC_NAME
+
 
 SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
             (SCM obj),
@@ -435,6 +357,29 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
 #undef FUNC_NAME
 
 
+SCM_DEFINE (scm_gc_disable, "gc-disable", 0, 0, 0,
+           (),
+           "Disables the garbage collector.  Nested calls are permitted.  "
+           "GC is re-enabled once @code{gc-enable} has been called the "
+           "same number of times @code{gc-disable} was called.")
+#define FUNC_NAME s_scm_gc_disable
+{
+  GC_disable ();
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_gc_enable, "gc-enable", 0, 0, 0,
+           (),
+           "Enables the garbage collector.")
+#define FUNC_NAME s_scm_gc_enable
+{
+  GC_enable ();
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
 SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
            (),
            "Scans all of SCM objects and reclaims for further use those that 
are\n"
@@ -442,7 +387,6 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
 #define FUNC_NAME s_scm_gc
 {
   scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
-  scm_gc_running_p = 1;
   scm_i_gc ("call");
   /* njrev: It looks as though other places, e.g. scm_realloc,
      can call scm_i_gc without acquiring the sweep mutex.  Does this
@@ -451,240 +395,16 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
      (e.g. scm_permobjs above in scm_gc_stats) by a critical section,
      not by the sweep mutex.  Shouldn't all the GC-relevant objects be
      protected in the same way? */
-  scm_gc_running_p = 0;
   scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
   scm_c_hook_run (&scm_after_gc_c_hook, 0);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-
-
-
-/* The master is global and common while the freelist will be
- * individual for each thread.
- */
-
-SCM
-scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
-{
-  SCM cell;
-  int did_gc = 0;
-
-  scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
-  scm_gc_running_p = 1;
-  
-  *free_cells = scm_i_sweep_for_freelist (freelist);
-  if (*free_cells == SCM_EOL)
-    {
-      float delta = scm_i_gc_heap_size_delta (freelist);
-      if (delta > 0.0)
-       {
-         size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
-         freelist->heap_segment_idx =
-           scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
-
-         *free_cells = scm_i_sweep_for_freelist (freelist);
-       }
-    }
-  
-  if (*free_cells == SCM_EOL)
-    {
-      /*
-       out of fresh cells. Try to get some new ones.
-       */
-      char reason[] = "0-cells";
-      reason[0] += freelist->span;
-      
-      did_gc = 1;
-      scm_i_gc (reason);
-
-      *free_cells = scm_i_sweep_for_freelist (freelist);
-    }
-  
-  if (*free_cells == SCM_EOL)
-    {
-      /*
-       failed getting new cells. Get new juice or die.
-      */
-      float delta = scm_i_gc_heap_size_delta (freelist);
-      assert (delta > 0.0);
-      size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell);
-      freelist->heap_segment_idx =
-       scm_i_get_new_heap_segment (freelist, bytes, abort_on_error);
-
-      *free_cells = scm_i_sweep_for_freelist (freelist);
-    }
-  
-  if (*free_cells == SCM_EOL)
-    abort ();
-
-  cell = *free_cells;
-
-  *free_cells = SCM_FREE_CELL_CDR (cell);
-
-  scm_gc_running_p = 0;
-  scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
-
-  if (did_gc)
-    scm_c_hook_run (&scm_after_gc_c_hook, 0);
-
-  return cell;
-}
-
-
-scm_t_c_hook scm_before_gc_c_hook;
-scm_t_c_hook scm_before_mark_c_hook;
-scm_t_c_hook scm_before_sweep_c_hook;
-scm_t_c_hook scm_after_sweep_c_hook;
-scm_t_c_hook scm_after_gc_c_hook;
-
-static void
-scm_check_deprecated_memory_return ()
-{
-  if (scm_mallocated < scm_i_deprecated_memory_return)
-    {
-      /* 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.  */
-      fprintf (stderr,
-              "scm_gc_sweep: Byte count of allocated objects has 
underflowed.\n"
-              "This is probably because the GC hasn't been correctly 
informed\n"
-              "about object sizes\n");
-      abort ();
-    }
-  scm_mallocated -= scm_i_deprecated_memory_return;
-  scm_i_deprecated_memory_return = 0;
-}
-
-long int scm_i_last_marked_cell_count;
-
-/* Must be called while holding scm_i_sweep_mutex.
-
-   This function is fairly long, but it touches various global
-   variables. To not obscure the side effects on global variables,
-   this function has not been split up.
- */
 void
 scm_i_gc (const char *what)
 {
-  unsigned long t_before_gc = 0;
-  
-  scm_i_thread_put_to_sleep ();
-  
-  scm_c_hook_run (&scm_before_gc_c_hook, 0);
-
-#ifdef DEBUGINFO
-  fprintf (stderr,"gc reason %s\n", what);
-  fprintf (stderr,
-          scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist))
-          ? "*"
-          : (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
-#endif
-
-  t_before_gc = scm_c_get_internal_run_time ();
-  scm_gc_malloc_collected = 0;
-
-  /*
-    Set freelists to NULL so scm_cons () always triggers gc, causing
-    the assertion above to fail.
-  */
-  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
-  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
-  
-  /*
-    Let's finish the sweep. The conservative GC might point into the
-    garbage, and marking that would create a mess.
-   */
-  scm_i_sweep_all_segments ("GC", &scm_i_gc_sweep_stats);
-  scm_check_deprecated_memory_return ();
-
-#if (SCM_DEBUG_CELL_ACCESSES == 0 && SCM_SIZEOF_UNSIGNED_LONG == 4)
-  /* Sanity check our numbers. */
-  /* TODO(hanwen): figure out why the stats are off on x64_64. */
-  /* If this was not true, someone touched mark bits outside of the
-     mark phase. */
-  if (scm_i_last_marked_cell_count != scm_i_marked_count ())
-    {
-      static char msg[] =
-       "The number of marked objects changed since the last GC: %d vs %d.";
-      /* At some point, we should probably use a deprecation warning. */
-      fprintf(stderr, msg, scm_i_last_marked_cell_count, scm_i_marked_count 
());
-    }
-  assert (scm_i_gc_sweep_stats.swept
-         == (scm_i_master_freelist.heap_total_cells
-             + scm_i_master_freelist2.heap_total_cells));
-  assert (scm_i_gc_sweep_stats.collected + scm_i_last_marked_cell_count
-         == scm_i_gc_sweep_stats.swept);
-#endif /* SCM_DEBUG_CELL_ACCESSES */
-  
-  /* Mark */
-  scm_c_hook_run (&scm_before_mark_c_hook, 0);
-
-  scm_mark_all ();
-  scm_gc_mark_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
-
-  scm_i_last_marked_cell_count = scm_cells_allocated = scm_i_marked_count ();
-
-  /* Sweep
-
-    TODO: the after_sweep hook should probably be moved to just before
-    the mark, since that's where the sweep is finished in lazy
-    sweeping.
-
-    MDJ 030219 <address@hidden>: No, probably not.  The
-    original meaning implied at least two things: that it would be
-    called when
-
-      1. the freelist is re-initialized (no evaluation possible, though)
-      
-    and
-    
-      2. the heap is "fresh"
-         (it is well-defined what data is used and what is not)
-
-    Neither of these conditions would hold just before the mark phase.
-    
-    Of course, the lazy sweeping has muddled the distinction between
-    scm_before_sweep_c_hook and scm_after_sweep_c_hook, but even if
-    there were no difference, it would still be useful to have two
-    distinct classes of hook functions since this can prevent some
-    bad interference when several modules adds gc hooks.
-   */
-  scm_c_hook_run (&scm_before_sweep_c_hook, 0);
-
-  /*
-    Nothing here: lazy sweeping.
-   */
-  scm_i_reset_segments ();
-  
-  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
-  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
-
-  /* Invalidate the freelists of other threads. */
-  scm_i_thread_invalidate_freelists ();
-
-  scm_c_hook_run (&scm_after_sweep_c_hook, 0);
-
-  gc_end_stats ();
-
-  scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0;
-  scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist);
-  scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2);
-  
-  /* Arguably, this statistic is fairly useless: marking will dominate
-     the time taken.
-  */
-  scm_gc_time_taken += (scm_c_get_internal_run_time () - t_before_gc);
-    
-  scm_i_thread_wake_up ();
-  /*
-    For debugging purposes, you could do
-    scm_i_sweep_all_segments ("debug"), but then the remains of the
-    cell aren't left to analyse.
-   */
+  GC_gcollect ();
 }
 
 
@@ -766,12 +486,7 @@ scm_return_first_int (int i, ...)
 SCM
 scm_permanent_object (SCM obj)
 {
-  SCM cell = scm_cons (obj, SCM_EOL);
-  SCM_CRITICAL_SECTION_START;
-  SCM_SETCDR (cell, scm_permobjs);
-  scm_permobjs = cell;
-  SCM_CRITICAL_SECTION_END;
-  return obj;
+  return (scm_gc_protect_object (obj));
 }
 
 
@@ -856,48 +571,13 @@ scm_gc_unprotect_object (SCM obj)
 void
 scm_gc_register_root (SCM *p)
 {
-  SCM handle;
-  SCM key = scm_from_ulong ((unsigned long) p);
-
-  /* This critical section barrier will be replaced by a mutex. */
-  /* njrev: and again. */
-  SCM_CRITICAL_SECTION_START;
-
-  handle = scm_hashv_create_handle_x (scm_gc_registered_roots, key,
-                                     scm_from_int (0));
-  /* njrev: note also that the above can probably signal an error */
-  SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), scm_from_int (1)));
-
-  SCM_CRITICAL_SECTION_END;
+  /* Nothing.  */
 }
 
 void
 scm_gc_unregister_root (SCM *p)
 {
-  SCM handle;
-  SCM key = scm_from_ulong ((unsigned long) p);
-
-  /* This critical section barrier will be replaced by a mutex. */
-  /* njrev: and again. */
-  SCM_CRITICAL_SECTION_START;
-
-  handle = scm_hashv_get_handle (scm_gc_registered_roots, key);
-
-  if (scm_is_false (handle))
-    {
-      fprintf (stderr, "scm_gc_unregister_root called on unregistered root\n");
-      abort ();
-    }
-  else
-    {
-      SCM count = scm_difference (SCM_CDR (handle), scm_from_int (1));
-      if (scm_is_eq (count, scm_from_int (0)))
-       scm_hashv_remove_x (scm_gc_registered_roots, key);
-      else
-       SCM_SETCDR (handle, count);
-    }
-
-  SCM_CRITICAL_SECTION_END;
+  /* Nothing.  */
 }
 
 void
@@ -943,6 +623,31 @@ scm_getenv_int (const char *var, int def)
 void
 scm_storage_prehistory ()
 {
+  GC_all_interior_pointers = 0;
+  GC_set_free_space_divisor (scm_getenv_int ("GC_FREE_SPACE_DIVISOR", 3));
+
+  GC_INIT ();
+
+#if (! ((defined GC_VERSION_MAJOR) && (GC_VERSION_MAJOR >= 7))) \
+    && (defined SCM_I_GSC_USE_PTHREAD_THREADS)
+  /* When using GC 6.8, this call is required to initialize thread-local
+     freelists (shouldn't be necessary with GC 7.0).  */
+  GC_init ();
+#endif
+
+  GC_expand_hp (SCM_DEFAULT_INIT_HEAP_SIZE_2);
+
+  /* We only need to register a displacement for those types for which the
+     higher bits of the type tag are used to store a pointer (that is, a
+     pointer to an 8-octet aligned region).  For `scm_tc3_struct', this is
+     handled in `scm_alloc_struct ()'.  */
+  GC_REGISTER_DISPLACEMENT (scm_tc3_cons);
+  GC_REGISTER_DISPLACEMENT (scm_tc3_closure);
+
+  /* Sanity check.  */
+  if (!GC_is_visible (scm_sys_protects))
+    abort ();
+
   scm_c_hook_init (&scm_before_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
   scm_c_hook_init (&scm_before_mark_c_hook, 0, SCM_C_HOOK_NORMAL);
   scm_c_hook_init (&scm_before_sweep_c_hook, 0, SCM_C_HOOK_NORMAL);
@@ -961,9 +666,6 @@ scm_init_storage ()
   while (j)
     scm_sys_protects[--j] = SCM_BOOL_F;
 
-  scm_gc_init_freelist ();
-  scm_gc_init_malloc ();
-
 #if 0
   /* We can't have a cleanup handler since we have no thread to run it
      in. */
@@ -979,9 +681,7 @@ scm_init_storage ()
 #endif
 
   scm_stand_in_procs = scm_make_weak_key_hash_table (scm_from_int (257));
-  scm_permobjs = SCM_EOL;
   scm_protects = scm_c_make_hash_table (31);
-  scm_gc_registered_roots = scm_c_make_hash_table (31);
 
   return 0;
 }
@@ -1049,10 +749,85 @@ mark_gc_async (void * hook_data SCM_UNUSED,
   return NULL;
 }
 
+char const *
+scm_i_tag_name (scm_t_bits tag)
+{
+  if (tag >= 255)
+    {
+      int k = 0xff & (tag >> 8);
+      return (scm_smobs[k].name);
+    }
+
+  switch (tag) /* 7 bits */
+    {
+    case scm_tcs_struct:
+      return "struct";
+    case scm_tcs_cons_imcar:
+      return "cons (immediate car)";
+    case scm_tcs_cons_nimcar:
+      return "cons (non-immediate car)";
+    case scm_tcs_closures:
+      return "closures";
+    case scm_tc7_pws:
+      return "pws";
+    case scm_tc7_wvect:
+      return "weak vector";
+    case scm_tc7_vector:
+      return "vector";
+#ifdef CCLO
+    case scm_tc7_cclo:
+      return "compiled closure";
+#endif
+    case scm_tc7_number:
+      switch (tag)
+       {
+       case scm_tc16_real:
+         return "real";
+         break;
+       case scm_tc16_big:
+         return "bignum";
+         break;
+       case scm_tc16_complex:
+         return "complex number";
+         break;
+       case scm_tc16_fraction:
+         return "fraction";
+         break;
+       }
+      break;
+    case scm_tc7_string:
+      return "string";
+      break;
+    case scm_tc7_stringbuf:
+      return "string buffer";
+      break;
+    case scm_tc7_symbol:
+      return "symbol";
+      break;
+    case scm_tc7_variable:
+      return "variable";
+      break;
+    case scm_tcs_subrs:
+      return "subrs";
+      break;
+    case scm_tc7_port:
+      return "port";
+      break;
+    case scm_tc7_smob:
+      return "smob";           /* should not occur. */
+      break; 
+    }
+
+  return NULL;
+}
+
+
+
+
 void
 scm_init_gc ()
 {
-  scm_gc_init_mark ();
+  /* `GC_INIT ()' was invoked in `scm_storage_prehistory ()'.  */
 
   scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0));
   scm_c_define ("after-gc-hook", scm_after_gc_hook);
@@ -1065,49 +840,13 @@ scm_init_gc ()
 #include "libguile/gc.x"
 }
 
-#ifdef __ia64__
-# ifdef __hpux
-#  include <sys/param.h>
-#  include <sys/pstat.h>
-void *
-scm_ia64_register_backing_store_base (void)
-{
-  struct pst_vm_status vm_status;
-  int i = 0;
-  while (pstat_getprocvm (&vm_status, sizeof (vm_status), 0, i++) == 1)
-    if (vm_status.pst_type == PS_RSESTACK)
-      return (void *) vm_status.pst_vaddr;
-  abort ();
-}
-void *
-scm_ia64_ar_bsp (const void *ctx)
-{
-  uint64_t bsp;
-  __uc_get_ar_bsp (ctx, &bsp);
-  return (void *) bsp;
-}
-# endif /* hpux */
-# ifdef linux
-#  include <ucontext.h>
-void *
-scm_ia64_register_backing_store_base (void)
-{
-  extern void *__libc_ia64_register_backing_store_base;
-  return __libc_ia64_register_backing_store_base;
-}
-void *
-scm_ia64_ar_bsp (const void *opaque)
-{
-  const ucontext_t *ctx = opaque;
-  return (void *) ctx->uc_mcontext.sc_ar_bsp;
-}
-# endif        /* linux */
-#endif /* __ia64__ */
 
 void
 scm_gc_sweep (void)
 #define FUNC_NAME "scm_gc_sweep"
 {
+  /* FIXME */
+  fprintf (stderr, "%s: doing nothing\n", __FUNCTION__);
 }
 
 #undef FUNC_NAME
diff --git a/libguile/gc.h b/libguile/gc.h
index c9d387a..1f03a78 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -3,7 +3,7 @@
 #ifndef SCM_GC_H
 #define SCM_GC_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 
2008, 2009 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
@@ -29,54 +29,12 @@
 #include "libguile/threads.h"
 
 
-
-/* Cell allocation and garbage collection work rouhgly in the
-   following manner:
-
-   Each thread has a 'freelist', which is a list of available cells.
-   (It actually has two freelists, one for single cells and one for
-   double cells.  Everything works analogous for double cells.)
-
-   When a thread wants to allocate a cell and the freelist is empty,
-   it refers to a global list of unswept 'cards'.  A card is a small
-   block of cells that are contigous in memory, together with the
-   corresponding mark bits.  A unswept card is one where the mark bits
-   are set for cells that have been in use during the last global mark
-   phase, but the unmarked cells of the card have not been scanned and
-   freed yet.
-
-   The thread takes one of the unswept cards and sweeps it, thereby
-   building a new freelist that it then uses.  Sweeping a card will
-   call the smob free functions of unmarked cells, for example, and
-   thus, these free functions can run at any time, in any thread.
-
-   When there are no more unswept cards available, the thread performs
-   a global garbage collection.  For this, all other threads are
-   stopped.  A global mark is performed and all cards are put into the
-   global list of unswept cards.  Whennecessary, new cards are
-   allocated and initialized at this time.  The other threads are then
-   started again.
-*/
-
 typedef struct scm_t_cell
 {
   SCM word_0;
   SCM word_1;
 } scm_t_cell;
 
-/*
-  CARDS
-
-  A card is a small `page' of memory; it will be the unit for lazy
-  sweeping, generations, etc. The first cell of a card contains a
-  pointer to the mark bitvector, so that we can find the bitvector
-  efficiently: we knock off some lowerorder bits.
-
-  The size on a 32 bit machine is 256 cells = 2kb. The card [XXX]
-*/
-
-
-
 /* Cray machines have pointers that are incremented once for each
  * word, rather than each byte, the 3 most significant bits encode the
  * byte within the word.  The following macros deal with this by
@@ -93,80 +51,6 @@ typedef struct scm_t_cell
 #endif /* def _UNICOS */
 
 
-#define SCM_GC_CARD_N_HEADER_CELLS 1
-#define SCM_GC_CARD_N_CELLS        256
-#define SCM_GC_SIZEOF_CARD        SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)
-
-#define SCM_GC_CARD_BVEC(card)  ((scm_t_c_bvec_long *) ((card)->word_0))
-#define SCM_GC_SET_CARD_BVEC(card, bvec) \
-    ((card)->word_0 = (SCM) (bvec))
-#define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1))
-#define SCM_GC_SET_CARD_FLAGS(card, flags) \
-    ((card)->word_1 = (SCM) (flags))
-
-#define SCM_GC_GET_CARD_FLAG(card, shift) \
- (SCM_GC_GET_CARD_FLAGS (card) & (1L << (shift)))
-#define SCM_GC_SET_CARD_FLAG(card, shift) \
- (SCM_GC_SET_CARD_FLAGS (card, SCM_GC_GET_CARD_FLAGS(card) | (1L << (shift))))
-#define SCM_GC_CLEAR_CARD_FLAG(card, shift) \
- (SCM_GC_SET_CARD_FLAGS (card, SCM_GC_GET_CARD_FLAGS(card) & ~(1L << (shift))))
-
-/*
-  Remove card flags. They hamper lazy initialization, and aren't used
-  anyways.
- */
-
-/* card addressing. for efficiency, cards are *always* aligned to
-   SCM_GC_CARD_SIZE. */
-
-#define SCM_GC_CARD_SIZE_MASK  (SCM_GC_SIZEOF_CARD-1)
-#define SCM_GC_CARD_ADDR_MASK  (~SCM_GC_CARD_SIZE_MASK)
-
-#define SCM_GC_CELL_CARD(x)    ((scm_t_cell *) ((long) (x) & 
SCM_GC_CARD_ADDR_MASK))
-#define SCM_GC_CELL_OFFSET(x)  (((long) (x) & SCM_GC_CARD_SIZE_MASK) >> 
SCM_CELL_SIZE_SHIFT)
-#define SCM_GC_CELL_BVEC(x)    SCM_GC_CARD_BVEC (SCM_GC_CELL_CARD (x))
-#define SCM_GC_SET_CELL_BVEC(x, bvec)    SCM_GC_SET_CARD_BVEC 
(SCM_GC_CELL_CARD (x), bvec)
-#define SCM_GC_CELL_GET_BIT(x) SCM_C_BVEC_GET (SCM_GC_CELL_BVEC (x), 
SCM_GC_CELL_OFFSET (x))
-#define SCM_GC_CELL_SET_BIT(x) SCM_C_BVEC_SET (SCM_GC_CELL_BVEC (x), 
SCM_GC_CELL_OFFSET (x))
-#define SCM_GC_CELL_CLEAR_BIT(x) SCM_C_BVEC_CLEAR (SCM_GC_CELL_BVEC (x), 
SCM_GC_CELL_OFFSET (x))
-
-#define SCM_GC_CARD_UP(x)      SCM_GC_CELL_CARD ((char *) (x) + 
SCM_GC_SIZEOF_CARD - 1)
-#define SCM_GC_CARD_DOWN       SCM_GC_CELL_CARD
-
-/* low level bit banging aids */
-typedef unsigned long scm_t_c_bvec_long;
-
-#if (SCM_SIZEOF_UNSIGNED_LONG == 8)
-#       define SCM_C_BVEC_LONG_BITS    64
-#       define SCM_C_BVEC_OFFSET_SHIFT 6
-#       define SCM_C_BVEC_POS_MASK     63
-#       define SCM_CELL_SIZE_SHIFT     4
-#else
-#       define SCM_C_BVEC_LONG_BITS    32
-#       define SCM_C_BVEC_OFFSET_SHIFT 5
-#       define SCM_C_BVEC_POS_MASK     31
-#       define SCM_CELL_SIZE_SHIFT     3
-#endif
-
-#define SCM_C_BVEC_OFFSET(pos) (pos >> SCM_C_BVEC_OFFSET_SHIFT)
-
-#define SCM_C_BVEC_GET(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] & (1L << (pos 
& SCM_C_BVEC_POS_MASK)))
-#define SCM_C_BVEC_SET(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] |= (1L << 
(pos & SCM_C_BVEC_POS_MASK)))
-#define SCM_C_BVEC_CLEAR(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] &= ~(1L << 
(pos & SCM_C_BVEC_POS_MASK)))
-
-/* testing and changing GC marks */
-#define SCM_GC_MARK_P(x)   SCM_GC_CELL_GET_BIT (x)
-
-SCM_INTERNAL void scm_i_ensure_marking(void);
-
-#if (SCM_DEBUG_MARKING_API == 1)
-#define SCM_I_ENSURE_MARKING scm_i_ensure_marking(), 
-#else
-#define SCM_I_ENSURE_MARKING
-#endif
-
-#define SCM_SET_GC_MARK(x) SCM_I_ENSURE_MARKING SCM_GC_CELL_SET_BIT (x)
-#define SCM_CLEAR_GC_MARK(x) SCM_I_ENSURE_MARKING SCM_GC_CELL_CLEAR_BIT (x)
 
 /* Low level cell data accessing macros.  These macros should only be used
  * from within code related to garbage collection issues, since they will
@@ -232,15 +116,6 @@ SCM_INTERNAL void scm_i_ensure_marking(void);
 #define SCM_CELL_TYPE(x) SCM_CELL_WORD_0 (x)
 #define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 ((x), (t))
 
-/* Freelists consist of linked cells where the type entry holds the value
- * scm_tc_free_cell and the second entry holds a pointer to the next cell of
- * the freelist.  Due to this structure, freelist cells are not cons cells
- * and thus may not be accessed using SCM_CAR and SCM_CDR.  */
-
-#define SCM_FREE_CELL_CDR(x) \
-  (SCM_GC_CELL_OBJECT ((x), 1))
-#define SCM_SET_FREE_CELL_CDR(x, v) \
-  (SCM_GC_SET_CELL_OBJECT ((x), 1, (v)))
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 /* Set this to != 0 if every cell that is accessed shall be checked:
@@ -253,7 +128,7 @@ SCM_API void scm_i_expensive_validation_check (SCM cell);
 
 SCM_INTERNAL scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
 
-#define scm_gc_running_p (SCM_I_CURRENT_THREAD->gc_running_p)
+#define scm_gc_running_p  0
 SCM_INTERNAL scm_i_pthread_mutex_t scm_i_sweep_mutex;
 
 #ifdef __ia64__
@@ -277,20 +152,7 @@ SCM_API size_t scm_default_max_segment_size;
 #define  scm_default_max_segment_size deprecated
 #endif
 
-
-SCM_API size_t scm_max_segment_size;
-
-#define SCM_SET_FREELIST_LOC(key,ptr) scm_i_pthread_setspecific ((key), (ptr))
-#define SCM_FREELIST_LOC(key) ((SCM *) scm_i_pthread_getspecific (key))
-SCM_API scm_i_pthread_key_t scm_i_freelist;
-SCM_API scm_i_pthread_key_t scm_i_freelist2;
-SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
-SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;
-
-SCM_API unsigned long scm_gc_malloc_collected;
-SCM_API int scm_gc_malloc_yield_percentage;
-SCM_API unsigned long scm_mallocated;
-SCM_API unsigned long scm_mtrigger;
+SCM_API unsigned long scm_gc_ports_collected;
 
 SCM_API SCM scm_after_gc_hook;
 
@@ -300,18 +162,6 @@ SCM_API scm_t_c_hook scm_before_sweep_c_hook;
 SCM_API scm_t_c_hook scm_after_sweep_c_hook;
 SCM_API scm_t_c_hook scm_after_gc_c_hook;
 
-#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
-#if (SCM_ENABLE_DEPRECATED == 1)
-SCM scm_map_free_list (void);
-#else
-#define scm_map_free_list deprecated
-#define scm_free_list_length deprecated
-#endif
-#endif
-
-#if (SCM_ENABLE_DEPRECATED == 1) && defined (GUILE_DEBUG_FREELIST)
-SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag);
-#endif
 
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
@@ -322,16 +172,14 @@ SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag);
 
 
 SCM_API SCM scm_object_address (SCM obj);
+SCM_API SCM scm_gc_enable (void);
+SCM_API SCM scm_gc_disable (void);
+SCM_API SCM scm_gc_dump (void);
 SCM_API SCM scm_gc_stats (void);
 SCM_API SCM scm_gc_live_object_stats (void);
 SCM_API SCM scm_gc (void);
-SCM_API void scm_gc_for_alloc (struct scm_t_cell_type_statistics *freelist);
-SCM_API SCM scm_gc_for_newcell (struct scm_t_cell_type_statistics *master, SCM 
*freelist);
-SCM_INTERNAL void scm_i_gc (const char *what);
+SCM_API void scm_i_gc (const char *what);
 SCM_API void scm_gc_mark (SCM p);
-SCM_API void scm_gc_mark_dependencies (SCM p);
-SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
-SCM_API int scm_in_heap_p (SCM value);
 SCM_API void scm_gc_sweep (void);
 
 SCM_API void *scm_malloc (size_t size);
@@ -343,6 +191,7 @@ SCM_API void scm_gc_register_collectable_memory (void *mem, 
size_t size,
                                                 const char *what);
 SCM_API void scm_gc_unregister_collectable_memory (void *mem, size_t size,
                                                   const char *what);
+SCM_API void *scm_gc_malloc_pointerless (size_t size, const char *what);
 SCM_API void *scm_gc_calloc (size_t size, const char *what);
 SCM_API void *scm_gc_malloc (size_t size, const char *what);
 SCM_API void *scm_gc_realloc (void *mem, size_t old_size, 
@@ -390,8 +239,7 @@ SCM_API void scm_gc_register_roots (SCM *b, unsigned long 
n);
 SCM_API void scm_gc_unregister_roots (SCM *b, unsigned long n);
 SCM_API void scm_storage_prehistory (void);
 SCM_API int scm_init_storage (void);
-SCM_API void *scm_get_stack_base (void);
-SCM_INTERNAL void scm_init_gc (void);
+SCM_API void scm_init_gc (void);
 
 #if SCM_ENABLE_DEPRECATED == 1
 
diff --git a/libguile/gc_os_dep.c b/libguile/gc_os_dep.c
deleted file mode 100644
index c624180..0000000
--- a/libguile/gc_os_dep.c
+++ /dev/null
@@ -1,1946 +0,0 @@
-/*
- * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
- * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
- * Copyright (c) 1999 by Hewlett-Packard Company.  All rights reserved.
- * Copyright (c) 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free Software 
Foundation
- *
- * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
- * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
- *
- * Permission is hereby granted to use or copy this program
- * for any purpose,  provided the above notices are retained on all copies.
- * Permission to modify the code and to distribute modified code is granted,
- * provided the above notices are retained, and a notice that the code was
- * modified is included with the above copyright notice.
- *
- */
-
-/*
- * Copied from gc5.2, files "os_dep.c", "gc_priv.h", "mark.c" and "gcconfig.h",
- * and modified for Guile by Marius Vollmer.
- */
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <ctype.h>
-#include "libguile/gc.h"
-#include "libguile/scmconfig.h"
-
-#ifdef HAVE_LIBC_STACK_END
-
-extern void *__libc_stack_end;
-
-void *
-scm_get_stack_base ()
-{
-  return __libc_stack_end;
-}
-
-#else
-
-#define ABORT(msg) abort ()
-
-typedef char * ptr_t;  /* A generic pointer to which we can add        */
-                       /* byte displacements.                          */
-                       /* Preferably identical to caddr_t, if it       */
-                       /* exists.                                      */
-
-/* Define word and signed_word to be unsigned and signed types of the  */
-/* size as char * or void *.  There seems to be no way to do this      */
-/* even semi-portably.  The following is probably no better/worse      */
-/* than almost anything else.                                          */
-/* The ANSI standard suggests that size_t and ptr_diff_t might be      */
-/* better choices.  But those appear to have incorrect definitions     */
-/* on may systems.  Notably "typedef int size_t" seems to be both      */
-/* frequent and WRONG.                                                 */
-typedef unsigned long GC_word;
-typedef long GC_signed_word;
-
-typedef GC_word word;
-typedef GC_signed_word signed_word;
-
-typedef int GC_bool;
-# define TRUE 1
-# define FALSE 0
-
-#if defined(__STDC__)
-#   include <stdlib.h>
-#   if !(defined( sony_news ) )
-#       include <stddef.h>
-#   endif
-#   define VOLATILE volatile
-#else
-#   ifdef MSWIN32
-#      include <stdlib.h>
-#   endif
-#   define VOLATILE
-#endif
-
-/* Machine dependent parameters.  Some tuning parameters can be found  */
-/* near the top of gc_private.h.                                       */
-
-/* Machine specific parts contributed by various people.  See README file. */
-
-/* First a unified test for Linux: */
-# if defined(linux) || defined(__linux__)
-#    define LINUX
-# endif
-
-/* Determine the machine type: */
-# if defined(sun) && defined(mc68000)
-#    define M68K
-#    define SUNOS4
-#    define mach_type_known
-# endif
-# if defined(hp9000s300)
-#    define M68K
-#    define HP
-#    define mach_type_known
-# endif
-# if defined(__OpenBSD__) && defined(m68k)
-#    define M68K
-#    define OPENBSD
-#    define mach_type_known
-# endif
-# if defined(__OpenBSD__) && defined(__sparc__)
-#    define SPARC
-#    define OPENBSD
-#    define mach_type_known
-# endif
-# if defined(__NetBSD__) && defined(__alpha__)
-#    define ALPHA
-#    define NETBSD
-#    define mach_type_known
-# endif
-# if defined(__NetBSD__) && defined(__powerpc__)
-#    define POWERPC
-#    define NETBSD
-#    define mach_type_known
-# endif
-/* in netbsd 2.0 only __m68k__ is defined, not m68k */
-# if defined(__NetBSD__) && (defined(m68k) || defined(__m68k__))
-#    define M68K
-#    define NETBSD
-#    define mach_type_known
-# endif
-/* in netbsd 2.0 only __arm__ is defined, not arm32 */
-# if defined(__NetBSD__) && (defined(arm32) || defined(__arm__))
-#    define ARM32
-#    define NETBSD
-#    define mach_type_known
-# endif
-# if defined(__NetBSD__) && defined(__sparc__)
-#    define SPARC
-#    define NETBSD
-#    define mach_type_known
-# endif
-# if defined(vax)
-#    define VAX
-#    ifdef ultrix
-#      define ULTRIX
-#    else
-#      define BSD
-#    endif
-#    define mach_type_known
-# endif
-# if defined(mips) || defined(__mips)
-#    define MIPS
-#    if !defined(LINUX)
-#      if defined(ultrix) || defined(__ultrix) || defined(__NetBSD__)
-#       define ULTRIX
-#      else
-#       if defined(_SYSTYPE_SVR4) || defined(SYSTYPE_SVR4) \
-           || defined(__SYSTYPE_SVR4__)
-#         define IRIX5   /* or IRIX 6.X */
-#       else
-#         define RISCOS  /* or IRIX 4.X */
-#       endif
-#      endif
-#    endif /* !LINUX */
-#    define mach_type_known
-# endif
-# if defined(sequent) && defined(i386)
-#    define I386
-#    define SEQUENT
-#    define mach_type_known
-# endif
-# if defined(sun) && defined(i386)
-#    define I386
-#    define SUNOS5
-#    define mach_type_known
-# endif
-# if (defined(__OS2__) || defined(__EMX__)) && defined(__32BIT__)
-#    define I386
-#    define OS2
-#    define mach_type_known
-# endif
-# if defined(ibm032)
-#   define RT
-#   define mach_type_known
-# endif
-# if defined(sun) && (defined(sparc) || defined(__sparc))
-#   define SPARC
-    /* Test for SunOS 5.x */
-#     include <errno.h>
-#     ifdef ECHRNG
-#       define SUNOS5
-#     else
-#      define SUNOS4
-#     endif
-#   define mach_type_known
-# endif
-# if defined(sparc) && defined(unix) && !defined(sun) && !defined(linux) \
-     && !defined(__OpenBSD__)
-#   define SPARC
-#   define DRSNX
-#   define mach_type_known
-# endif
-# if defined(_IBMR2)
-#   define RS6000
-#   define mach_type_known
-# endif
-# if defined(_M_XENIX) && defined(_M_SYSV) && defined(_M_I386)
-       /* The above test may need refinement   */
-#   define I386
-#   if defined(_SCO_ELF)
-#     define SCO_ELF
-#   else
-#     define SCO
-#   endif
-#   define mach_type_known
-# endif
-# if defined(_AUX_SOURCE)
-#   define M68K
-#   define SYSV
-#   define mach_type_known
-# endif
-# if defined(_PA_RISC1_0) || defined(_PA_RISC1_1) || defined(_PA_RISC2_0) \
-     || defined(hppa) || defined(__hppa__)
-#   define HP_PA
-#   ifndef LINUX
-#     define HPUX
-#   endif
-#   define mach_type_known
-# endif
-# if defined(LINUX) && (defined(i386) || defined(__i386__))
-#    define I386
-#    define mach_type_known
-# endif
-# if defined(LINUX) && (defined(__ia64__) || defined(__ia64))
-#    define IA64
-#    define mach_type_known
-# endif
-# if defined(LINUX) && defined(powerpc)
-#    define POWERPC
-#    define mach_type_known
-# endif
-# if defined(LINUX) && defined(__mc68000__)
-#    define M68K
-#    define mach_type_known
-# endif
-# if defined(LINUX) && (defined(sparc) || defined(__sparc__))
-#    define SPARC
-#    define mach_type_known
-# endif
-# if defined(LINUX) && (defined(arm) || defined (__arm__))
-#    define ARM32
-#    define mach_type_known
-# endif
-# if defined(__alpha) || defined(__alpha__)
-#   define ALPHA
-#   if !defined(LINUX) && !defined (NETBSD)
-#     define OSF1      /* a.k.a Digital Unix */
-#   endif
-#   define mach_type_known
-# endif
-# if defined(_AMIGA) && !defined(AMIGA)
-#   define AMIGA
-# endif
-# ifdef AMIGA
-#   define M68K
-#   define mach_type_known
-# endif
-# if defined(THINK_C) || defined(__MWERKS__) && !defined(__powerc)
-#   define M68K
-#   define MACOS
-#   define mach_type_known
-# endif
-# if defined(__MWERKS__) && defined(__powerc)
-#   define POWERPC
-#   define MACOS
-#   define mach_type_known
-# endif
-# if defined(macosx) || \
-     (defined(__APPLE__) && defined(__MACH__) && defined(__ppc__))
-#    define MACOSX
-#    define POWERPC
-#    define mach_type_known
-# endif
-# if defined(NeXT) && defined(mc68000)
-#   define M68K
-#   define NEXT
-#   define mach_type_known
-# endif
-# if defined(NeXT) && defined(i386)
-#   define I386
-#   define NEXT
-#   define mach_type_known
-# endif
-# if defined(__OpenBSD__) && (defined(i386) || defined(__i386__))
-#   define I386
-#   define OPENBSD
-#   define mach_type_known
-# endif
-# if defined(__FreeBSD__) && defined(i386)
-#   define I386
-#   define FREEBSD
-#   define mach_type_known
-# endif
-# if defined(__NetBSD__) && defined(i386)
-#   define I386
-#   define NETBSD
-#   define mach_type_known
-# endif
-# if defined(bsdi) && defined(i386)
-#    define I386
-#    define BSDI
-#    define mach_type_known
-# endif
-# if !defined(mach_type_known) && defined(__386BSD__)
-#   define I386
-#   define THREE86BSD
-#   define mach_type_known
-# endif
-# if defined(_CX_UX) && defined(_M88K)
-#   define M88K
-#   define CX_UX
-#   define mach_type_known
-# endif
-# if defined(DGUX)
-#   define M88K
-    /* DGUX defined */
-#   define mach_type_known
-# endif
-# if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
-     || defined(_WIN32) && !defined(__CYGWIN32__) && !defined(__CYGWIN__)
-#   define I386
-#   define MSWIN32     /* or Win32s */
-#   define mach_type_known
-# endif
-# if defined(__DJGPP__)
-#   define I386
-#   ifndef DJGPP
-#     define DJGPP  /* MSDOS running the DJGPP port of GCC */
-#   endif
-#   define mach_type_known
-# endif
-# if defined(__CYGWIN32__) || defined(__CYGWIN__)
-#   define I386
-#   define CYGWIN32
-#   define mach_type_known
-# endif
-# if defined(__MINGW32__)
-#   define I386
-#   define MSWIN32
-#   define mach_type_known
-# endif
-# if defined(__BORLANDC__)
-#   define I386
-#   define MSWIN32
-#   define mach_type_known
-# endif
-# if defined(_UTS) && !defined(mach_type_known)
-#   define S370
-#   define UTS4
-#   define mach_type_known
-# endif
-# if defined(__pj__)
-#   define PJ
-#   define mach_type_known
-# endif
-/* Ivan Demakov */
-# if defined(__WATCOMC__) && defined(__386__)
-#   define I386
-#   if !defined(OS2) && !defined(MSWIN32) && !defined(DOS4GW)
-#     if defined(__OS2__)
-#       define OS2
-#     else
-#       if defined(__WINDOWS_386__) || defined(__NT__)
-#         define MSWIN32
-#       else
-#         define DOS4GW
-#       endif
-#     endif
-#   endif
-#   define mach_type_known
-# endif
-# if defined(__s390__) && defined(LINUX)
-#    define S370
-#    define mach_type_known
-# endif
-# if defined(__GNU__)
-#    define I386
-#    define GNU
-#    define mach_type_known
-# endif
-# if defined(__SCO_VERSION__)
-#    define I386
-#    define SYSV
-#    define mach_type_known
-# endif
-
-/* Feel free to add more clauses here */
-
-/* Or manually define the machine type here.  A machine type is        */
-/* characterized by the architecture.  Some                            */
-/* machine types are further subdivided by OS.                         */
-/* the macros ULTRIX, RISCOS, and BSD to distinguish.                  */
-/* Note that SGI IRIX is treated identically to RISCOS.                        
*/
-/* SYSV on an M68K actually means A/UX.                                        
*/
-/* The distinction in these cases is usually the stack starting address */
-# ifndef mach_type_known
-
-void *
-scm_get_stack_base ()
-{
-  ABORT ("Can't determine stack base");
-  return NULL;
-}
-
-# else
-                   /* Mapping is: M68K       ==> Motorola 680X0        */
-                   /*             (SUNOS4,HP,NEXT, and SYSV (A/UX),    */
-                   /*             MACOS and AMIGA variants)            */
-                   /*             I386       ==> Intel 386             */
-                   /*              (SEQUENT, OS2, SCO, LINUX, NETBSD,  */
-                   /*               FREEBSD, THREE86BSD, MSWIN32,      */
-                   /*               BSDI,SUNOS5, NEXT, other variants) */
-                    /*             NS32K      ==> Encore Multimax      */
-                    /*             MIPS       ==> R2000 or R3000       */
-                    /*                 (RISCOS, ULTRIX variants)       */
-                    /*            VAX        ==> DEC VAX               */
-                    /*                 (BSD, ULTRIX variants)          */
-                    /*            RS6000     ==> IBM RS/6000 AIX3.X    */
-                    /*            RT         ==> IBM PC/RT             */
-                    /*            HP_PA      ==> HP9000/700 & /800     */
-                    /*                           HP/UX                 */
-                   /*             SPARC      ==> SPARC under SunOS     */
-                   /*                  (SUNOS4, SUNOS5,                */
-                   /*                   DRSNX variants)                */
-                   /*             ALPHA      ==> DEC Alpha             */
-                   /*                  (OSF1 and LINUX variants)       */
-                   /*             M88K       ==> Motorola 88XX0        */
-                   /*                  (CX_UX and DGUX)                */
-                   /*             S370       ==> 370-like machine      */
-                   /*                  running Amdahl UTS4             */
-                   /*             ARM32      ==> Intel StrongARM       */
-                   /*             IA64       ==> Intel IA64            */
-                   /*                            (e.g. Itanium)        */
-
-
-/*
- * For each architecture and OS, the following need to be defined:
- *
- * CPP_WORD_SZ is a simple integer constant representing the word size.
- * in bits.  We assume byte addressibility, where a byte has 8 bits.
- * We also assume CPP_WORD_SZ is either 32 or 64.
- * (We care about the length of pointers, not hardware
- * bus widths.  Thus a 64 bit processor with a C compiler that uses
- * 32 bit pointers should use CPP_WORD_SZ of 32, not 64. Default is 32.)
- *
- * MACH_TYPE is a string representation of the machine type.
- * OS_TYPE is analogous for the OS.
- *
- * ALIGNMENT is the largest N, such that
- * all pointer are guaranteed to be aligned on N byte boundaries.
- * defining it to be 1 will always work, but perform poorly.
- *
- * DATASTART is the beginning of the data segment.
- * On UNIX systems, the collector will scan the area between DATASTART
- * and DATAEND for root pointers.
- *
- * DATAEND, if not &end.
- *
- * ALIGN_DOUBLE of GC_malloc should return blocks aligned to twice
- * the pointer size.
- *
- * STACKBOTTOM is the cool end of the stack, which is usually the
- * highest address in the stack.
- * Under PCR or OS/2, we have other ways of finding thread stacks.
- * For each machine, the following should:
- * 1) define SCM_STACK_GROWS_UP if the stack grows toward higher addresses, and
- * 2) define exactly one of
- *     STACKBOTTOM (should be defined to be an expression)
- *     HEURISTIC1
- *     HEURISTIC2
- * If either of the last two macros are defined, then STACKBOTTOM is computed
- * during collector startup using one of the following two heuristics:
- * HEURISTIC1:  Take an address inside GC_init's frame, and round it up to
- *             the next multiple of STACK_GRAN.
- * HEURISTIC2:  Take an address inside GC_init's frame, increment it repeatedly
- *             in small steps (decrement if SCM_STACK_GROWS_UP), and read the 
value
- *             at each location.  Remember the value when the first
- *             Segmentation violation or Bus error is signalled.  Round that
- *             to the nearest plausible page boundary, and use that instead
- *             of STACKBOTTOM.
- *
- * Gustavo Rodriguez-Rivera points out that on most (all?) Unix machines,
- * the value of environ is a pointer that can serve as STACKBOTTOM.
- * I expect that HEURISTIC2 can be replaced by this approach, which
- * interferes far less with debugging.
- *
- * If no expression for STACKBOTTOM can be found, and neither of the above
- * heuristics are usable, the collector can still be used with all of the above
- * undefined, provided one of the following is done:
- * 1) GC_mark_roots can be changed to somehow mark from the correct stack(s)
- *    without reference to STACKBOTTOM.  This is appropriate for use in
- *    conjunction with thread packages, since there will be multiple stacks.
- *    (Allocating thread stacks in the heap, and treating them as ordinary
- *    heap data objects is also possible as a last resort.  However, this is
- *    likely to introduce significant amounts of excess storage retention
- *    unless the dead parts of the thread stacks are periodically cleared.)
- * 2) Client code may set GC_stackbottom before calling any GC_ routines.
- *    If the author of the client code controls the main program, this is
- *    easily accomplished by introducing a new main program, setting
- *    GC_stackbottom to the address of a local variable, and then calling
- *    the original main program.  The new main program would read something
- *    like:
- *
- *             # include "gc_private.h"
- *
- *             main(argc, argv, envp)
- *             int argc;
- *             char **argv, **envp;
- *             {
- *                 int dummy;
- *
- *                 GC_stackbottom = (ptr_t)(&dummy);
- *                 return(real_main(argc, argv, envp));
- *             }
- *
- *
- * Each architecture may also define the style of virtual dirty bit
- * implementation to be used:
- *   MPROTECT_VDB: Write protect the heap and catch faults.
- *   PROC_VDB: Use the SVR4 /proc primitives to read dirty bits.
- *
- * An architecture may define DYNAMIC_LOADING if dynamic_load.c
- * defined GC_register_dynamic_libraries() for the architecture.
- *
- * An architecture may define PREFETCH(x) to preload the cache with *x.
- * This defaults to a no-op.
- *
- * PREFETCH_FOR_WRITE(x) is used if *x is about to be written.
- *
- * An architecture may also define CLEAR_DOUBLE(x) to be a fast way to
- * clear the two words at GC_malloc-aligned address x.  By default,
- * word stores of 0 are used instead.
- */
-
-
-# define STACK_GRAN 0x1000000
-# ifdef M68K
-#   define MACH_TYPE "M68K"
-#   define ALIGNMENT 2
-#   ifdef OPENBSD
-#      define OS_TYPE "OPENBSD"
-#      define HEURISTIC2
-       extern char etext;
-#      define DATASTART ((ptr_t)(&etext))
-#   endif
-#   ifdef NETBSD
-#      define OS_TYPE "NETBSD"
-#      define HEURISTIC2
-       extern char etext;
-#      define DATASTART ((ptr_t)(&etext))
-#   endif
-#   ifdef LINUX
-#       define OS_TYPE "LINUX"
-#       define STACKBOTTOM ((ptr_t)0xf0000000)
-#       define MPROTECT_VDB
-#       ifdef __ELF__
-#            define DYNAMIC_LOADING
-             extern char **__environ;
-#            define DATASTART ((ptr_t)(&__environ))
-                             /* hideous kludge: __environ is the first */
-                             /* word in crt0.o, and delimits the start */
-                             /* of the data segment, no matter which   */
-                             /* ld options were passed through.        */
-                             /* We could use _etext instead, but that  */
-                             /* would include .rodata, which may       */
-                             /* contain large read-only data tables    */
-                             /* that we'd rather not scan.             */
-             extern int _end;
-#            define DATAEND (&_end)
-#       else
-             extern int etext;
-#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
-#       endif
-#   endif
-#   ifdef SUNOS4
-#      define OS_TYPE "SUNOS4"
-       extern char etext;
-#      define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ffff) & ~0x1ffff))
-#      define HEURISTIC1       /* differs      */
-#      define DYNAMIC_LOADING
-#   endif
-#   ifdef HP
-#      define OS_TYPE "HP"
-       extern char etext;
-#       define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
-#       define STACKBOTTOM ((ptr_t) 0xffeffffc)
-                             /* empirically determined.  seems to work. */
-#      include <unistd.h>
-#      define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
-#   endif
-#   ifdef SYSV
-#      define OS_TYPE "SYSV"
-       extern etext;
-#      define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \
-                                  & ~0x3fffff) \
-                                 +((word)&etext & 0x1fff))
-       /* This only works for shared-text binaries with magic number 0413.
-          The other sorts of SysV binaries put the data at the end of the text,
-          in which case the default of &etext would work.  Unfortunately,
-          handling both would require having the magic-number available.
-                               -- Parag
-          */
-#      define STACKBOTTOM ((ptr_t)0xFFFFFFFE)
-                       /* The stack starts at the top of memory, but   */
-                       /* 0x0 cannot be used as setjump_test complains */
-                       /* that the stack direction is incorrect.  Two  */
-                       /* bytes down from 0x0 should be safe enough.   */
-                       /*              --Parag                         */
-#      include <sys/mmu.h>
-#      define GETPAGESIZE() PAGESIZE   /* Is this still right? */
-#   endif
-#   ifdef AMIGA
-#      define OS_TYPE "AMIGA"
-               /* STACKBOTTOM and DATASTART handled specially  */
-               /* in os_dep.c                                  */
-#      define DATAEND  /* not needed */
-#      define GETPAGESIZE() 4096
-#   endif
-#   ifdef MACOS
-#     ifndef __LOWMEM__
-#     include <LowMem.h>
-#     endif
-#     define OS_TYPE "MACOS"
-                       /* see os_dep.c for details of global data segments. */
-#     define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
-#     define DATAEND   /* not needed */
-#     define GETPAGESIZE() 4096
-#   endif
-#   ifdef NEXT
-#      define OS_TYPE "NEXT"
-#      define DATASTART ((ptr_t) get_etext())
-#      define STACKBOTTOM ((ptr_t) 0x4000000)
-#      define DATAEND  /* not needed */
-#   endif
-# endif
-
-# ifdef POWERPC
-#   define MACH_TYPE "POWERPC"
-#   ifdef MACOS
-#     define ALIGNMENT 2  /* Still necessary?  Could it be 4?  */
-#     ifndef __LOWMEM__
-#     include <LowMem.h>
-#     endif
-#     define OS_TYPE "MACOS"
-                       /* see os_dep.c for details of global data segments. */
-#     define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
-#     define DATAEND  /* not needed */
-#   endif
-#   ifdef LINUX
-#     define ALIGNMENT 4       /* Guess.  Can someone verify?  */
-                               /* This was 2, but that didn't sound right. */
-#     define OS_TYPE "LINUX"
-#     define HEURISTIC1
-#     define DYNAMIC_LOADING
-#     undef STACK_GRAN
-#     define STACK_GRAN 0x10000000
-       /* Stack usually starts at 0x80000000 */
-#     define LINUX_DATA_START
-      extern int _end;
-#     define DATAEND (&_end)
-#   endif
-#   ifdef MACOSX
-#     define ALIGNMENT 4
-#     define OS_TYPE "MACOSX"
-#     define DATASTART ((ptr_t) get_etext())
-#     define STACKBOTTOM ((ptr_t) 0xc0000000)
-#     define DATAEND   /* not needed */
-#   endif
-# endif
-
-# ifdef VAX
-#   define MACH_TYPE "VAX"
-#   define ALIGNMENT 4 /* Pointers are longword aligned by 4.2 C compiler */
-    extern char etext;
-#   define DATASTART ((ptr_t)(&etext))
-#   ifdef BSD
-#      define OS_TYPE "BSD"
-#      define HEURISTIC1
-                       /* HEURISTIC2 may be OK, but it's hard to test. */
-#   endif
-#   ifdef ULTRIX
-#      define OS_TYPE "ULTRIX"
-#      define STACKBOTTOM ((ptr_t) 0x7fffc800)
-#   endif
-# endif
-
-# ifdef RT
-#   define MACH_TYPE "RT"
-#   define ALIGNMENT 4
-#   define DATASTART ((ptr_t) 0x10000000)
-#   define STACKBOTTOM ((ptr_t) 0x1fffd800)
-# endif
-
-# ifdef SPARC
-#   define MACH_TYPE "SPARC"
-#   define ALIGNMENT 4 /* Required by hardware */
-#   define ALIGN_DOUBLE
-    extern int etext;
-#   ifdef SUNOS5
-#      define OS_TYPE "SUNOS5"
-       extern int _etext;
-       extern int _end;
-       extern char * GC_SysVGetDataStart();
-#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext)
-#      define DATAEND (&_end)
-#      ifndef USE_MMAP
-#          define USE_MMAP
-#      endif
-#       ifdef USE_MMAP
-#         define HEAP_START (ptr_t)0x40000000
-#       else
-#        define HEAP_START DATAEND
-#       endif
-#      define PROC_VDB
-/*     HEURISTIC1 reportedly no longer works under 2.7.  Thus we       */
-/*     switched to HEURISTIC2, eventhough it creates some debugging    */
-/*     issues.                                                         */
-#      define HEURISTIC2
-#      include <unistd.h>
-#       define GETPAGESIZE()  sysconf(_SC_PAGESIZE)
-               /* getpagesize() appeared to be missing from at least one */
-               /* Solaris 5.4 installation.  Weird.                      */
-#      define DYNAMIC_LOADING
-#   endif
-#   ifdef SUNOS4
-#      define OS_TYPE "SUNOS4"
-       /* [If you have a weak stomach, don't read this.]               */
-       /* We would like to use:                                        */
-/* #       define DATASTART ((ptr_t)((((word) (&etext)) + 0x1fff) & ~0x1fff)) 
*/
-       /* This fails occasionally, due to an ancient, but very         */
-       /* persistent ld bug.  &etext is set 32 bytes too high.         */
-       /* We instead read the text segment size from the a.out         */
-       /* header, which happens to be mapped into our address space    */
-       /* at the start of the text segment.  The detective work here   */
-       /* was done by Robert Ehrlich, Manuel Serrano, and Bernard      */
-       /* Serpette of INRIA.                                           */
-       /* This assumes ZMAGIC, i.e. demand-loadable executables.       */
-#      define TEXTSTART 0x2000
-#       define DATASTART ((ptr_t)(*(int *)(TEXTSTART+0x4)+TEXTSTART))
-#      define MPROTECT_VDB
-#      define HEURISTIC1
-#      define DYNAMIC_LOADING
-#   endif
-#   ifdef DRSNX
-#       define CPP_WORDSZ 32
-#      define OS_TYPE "DRSNX"
-       extern char * GC_SysVGetDataStart();
-       extern int etext;
-#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext)
-#      define MPROTECT_VDB
-#       define STACKBOTTOM ((ptr_t) 0xdfff0000)
-#      define DYNAMIC_LOADING
-#   endif
-#   ifdef LINUX
-#     define OS_TYPE "LINUX"
-#     ifdef __ELF__
-#       define LINUX_DATA_START
-#       define DYNAMIC_LOADING
-#     else
-          Linux Sparc non elf ?
-#     endif
-      extern int _end;
-#     define DATAEND (&_end)
-#     define SVR4
-#     define STACKBOTTOM ((ptr_t) 0xf0000000)
-#   endif
-#   ifdef OPENBSD
-#     define OS_TYPE "OPENBSD"
-#     define STACKBOTTOM ((ptr_t) 0xf8000000)
-#     define DATASTART ((ptr_t)(&etext))
-#   endif
-# endif
-
-# ifdef I386
-#   define MACH_TYPE "I386"
-#   define ALIGNMENT 4 /* Appears to hold for all "32 bit" compilers   */
-                       /* except Borland.  The -a4 option fixes        */
-                       /* Borland.                                     */
-                        /* Ivan Demakov: For Watcom the option is -zp4. */
-#   ifndef SMALL_CONFIG
-#     define ALIGN_DOUBLE /* Not strictly necessary, but may give speed   */
-                         /* improvement on Pentiums.                     */
-#   endif
-#   ifdef SEQUENT
-#      define OS_TYPE "SEQUENT"
-       extern int etext;
-#       define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
-#       define STACKBOTTOM ((ptr_t) 0x3ffff000)
-#   endif
-#   ifdef SUNOS5
-#      define OS_TYPE "SUNOS5"
-       extern int etext, _start;
-       extern char * GC_SysVGetDataStart();
-#       define DATASTART GC_SysVGetDataStart(0x1000, &etext)
-#      define STACKBOTTOM ((ptr_t)(&_start))
-/** At least in Solaris 2.5, PROC_VDB gives wrong values for dirty bits. */
-/*#    define PROC_VDB*/
-#      define DYNAMIC_LOADING
-#      ifndef USE_MMAP
-#          define USE_MMAP
-#      endif
-#       ifdef USE_MMAP
-#         define HEAP_START (ptr_t)0x40000000
-#       else
-#        define HEAP_START DATAEND
-#       endif
-#   endif
-#   ifdef SCO
-#      define OS_TYPE "SCO"
-       extern int etext;
-#      define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \
-                                 & ~0x3fffff) \
-                                +((word)&etext & 0xfff))
-#      define STACKBOTTOM ((ptr_t) 0x7ffffffc)
-#   endif
-#   ifdef SCO_ELF
-#       define OS_TYPE "SCO_ELF"
-        extern int etext;
-#       define DATASTART ((ptr_t)(&etext))
-#       define STACKBOTTOM ((ptr_t) 0x08048000)
-#       define DYNAMIC_LOADING
-#      define ELF_CLASS ELFCLASS32
-#   endif
-#   ifdef LINUX
-#      define OS_TYPE "LINUX"
-#       define LINUX_STACKBOTTOM
-#      if 0
-#        define HEURISTIC1
-#         undef STACK_GRAN
-#         define STACK_GRAN 0x10000000
-         /* STACKBOTTOM is usually 0xc0000000, but this changes with   */
-         /* different kernel configurations.  In particular, systems   */
-         /* with 2GB physical memory will usually move the user        */
-         /* address space limit, and hence initial SP to 0x80000000.   */
-#       endif
-#       if !defined(LINUX_THREADS) || !defined(REDIRECT_MALLOC)
-#          define MPROTECT_VDB
-#      else
-           /* We seem to get random errors in incremental mode,        */
-           /* possibly because Linux threads is itself a malloc client */
-           /* and can't deal with the signals.                         */
-#      endif
-#       ifdef __ELF__
-#            define DYNAMIC_LOADING
-#           ifdef UNDEFINED    /* includes ro data */
-              extern int _etext;
-#              define DATASTART ((ptr_t)((((word) (&_etext)) + 0xfff) & 
~0xfff))
-#           endif
-#           include <features.h>
-#           if defined(__GLIBC__) && __GLIBC__ >= 2
-#               define LINUX_DATA_START
-#           else
-                extern char **__environ;
-#                define DATASTART ((ptr_t)(&__environ))
-                             /* hideous kludge: __environ is the first */
-                             /* word in crt0.o, and delimits the start */
-                             /* of the data segment, no matter which   */
-                             /* ld options were passed through.        */
-                             /* We could use _etext instead, but that  */
-                             /* would include .rodata, which may       */
-                             /* contain large read-only data tables    */
-                             /* that we'd rather not scan.             */
-#           endif
-            extern int _end;
-#           define DATAEND (&_end)
-#      else
-            extern int etext;
-#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
-#       endif
-#      ifdef USE_I686_PREFETCH
-#        define PREFETCH(x) \
-           __asm__ __volatile__ ("     prefetchnta     %0": : "m"(*(char 
*)(x)))
-           /* Empirically prefetcht0 is much more effective at reducing        
*/
-           /* cache miss stalls for the targetted load instructions.  But it   
*/
-           /* seems to interfere enough with other cache traffic that the net  
*/
-           /* result is worse than prefetchnta.                                
*/
-#         if 0
-           /* Using prefetches for write seems to have a slight negative       
*/
-           /* impact on performance, at least for a PIII/500.                  
*/
-#          define PREFETCH_FOR_WRITE(x) \
-             __asm__ __volatile__ ("   prefetcht0      %0": : "m"(*(char 
*)(x)))
-#        endif
-#      endif
-#      ifdef USE_3DNOW_PREFETCH
-#        define PREFETCH(x) \
-           __asm__ __volatile__ ("     prefetch        %0": : "m"(*(char 
*)(x)))
-#        define PREFETCH_FOR_WRITE(x)
-           __asm__ __volatile__ ("     prefetchw       %0": : "m"(*(char 
*)(x)))
-#      endif
-#   endif
-#   ifdef CYGWIN32
-#       define OS_TYPE "CYGWIN32"
-          extern int _data_start__;
-          extern int _data_end__;
-          extern int _bss_start__;
-          extern int _bss_end__;
-       /* For binutils 2.9.1, we have                  */
-       /*      DATASTART   = _data_start__             */
-       /*      DATAEND     = _bss_end__                */
-       /* whereas for some earlier versions it was     */
-       /*      DATASTART   = _bss_start__              */
-       /*      DATAEND     = _data_end__               */
-       /* To get it right for both, we take the        */
-       /* minumum/maximum of the two.                  */
-#      define MAX(x,y) ((x) > (y) ? (x) : (y))
-#      define MIN(x,y) ((x) < (y) ? (x) : (y))
-#       define DATASTART ((ptr_t) MIN(&_data_start__, &_bss_start__))
-#       define DATAEND  ((ptr_t) MAX(&_data_end__, &_bss_end__))
-#      undef STACK_GRAN
-#       define STACK_GRAN 0x10000
-#       define HEURISTIC1
-#   endif
-#   ifdef OS2
-#      define OS_TYPE "OS2"
-               /* STACKBOTTOM and DATASTART are handled specially in   */
-               /* os_dep.c. OS2 actually has the right                 */
-               /* system call!                                         */
-#      define DATAEND  /* not needed */
-#   endif
-#   ifdef MSWIN32
-#      define OS_TYPE "MSWIN32"
-               /* STACKBOTTOM and DATASTART are handled specially in   */
-               /* os_dep.c.                                            */
-#       ifndef __WATCOMC__
-#        define MPROTECT_VDB
-#      endif
-#       define DATAEND  /* not needed */
-#   endif
-#   ifdef DJGPP
-#       define OS_TYPE "DJGPP"
-#       include "stubinfo.h"
-        extern int etext;
-        extern int _stklen;
-        extern int __djgpp_stack_limit;
-#       define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ff) & ~0x1ff))
-/* #       define STACKBOTTOM ((ptr_t)((word) _stubinfo + _stubinfo->size \
-                                                     + _stklen)) */
-#       define STACKBOTTOM ((ptr_t)((word) __djgpp_stack_limit + _stklen))
-               /* This may not be right.  */
-#   endif
-#   ifdef OPENBSD
-#      define OS_TYPE "OPENBSD"
-#   endif
-#   ifdef FREEBSD
-#      define OS_TYPE "FREEBSD"
-#      define MPROTECT_VDB
-#   endif
-#   ifdef NETBSD
-#      define OS_TYPE "NETBSD"
-#   endif
-#   ifdef THREE86BSD
-#      define OS_TYPE "THREE86BSD"
-#   endif
-#   ifdef BSDI
-#      define OS_TYPE "BSDI"
-#   endif
-#   if defined(OPENBSD) || defined(FREEBSD) || defined(NETBSD) \
-        || defined(THREE86BSD) || defined(BSDI)
-#      define HEURISTIC2
-       extern char etext;
-#      define DATASTART ((ptr_t)(&etext))
-#   endif
-#   ifdef NEXT
-#      define OS_TYPE "NEXT"
-#      define DATASTART ((ptr_t) get_etext())
-#      define STACKBOTTOM ((ptr_t)0xc0000000)
-#      define DATAEND  /* not needed */
-#   endif
-#   ifdef DOS4GW
-#     define OS_TYPE "DOS4GW"
-      extern long __nullarea;
-      extern char _end;
-      extern char *_STACKTOP;
-      /* Depending on calling conventions Watcom C either precedes
-         or does not precedes with undescore names of C-variables.
-         Make sure startup code variables always have the same names.  */
-      #pragma aux __nullarea "*";
-      #pragma aux _end "*";
-#     define STACKBOTTOM ((ptr_t) _STACKTOP)
-                         /* confused? me too. */
-#     define DATASTART ((ptr_t) &__nullarea)
-#     define DATAEND ((ptr_t) &_end)
-#   endif
-#   ifdef GNU
-#      define OS_TYPE "GNU"
-#    endif
-# endif
-
-# ifdef NS32K
-#   define MACH_TYPE "NS32K"
-#   define ALIGNMENT 4
-    extern char **environ;
-#   define DATASTART ((ptr_t)(&environ))
-                             /* hideous kludge: environ is the first   */
-                             /* word in crt0.o, and delimits the start */
-                             /* of the data segment, no matter which   */
-                             /* ld options were passed through.        */
-#   define STACKBOTTOM ((ptr_t) 0xfffff000) /* for Encore */
-# endif
-
-# ifdef MIPS
-#   define MACH_TYPE "MIPS"
-#   ifdef LINUX
-#       define CPP_WORDSZ _MIPS_SZPTR
-#       define OS_TYPE "LINUX"
-#       define ALIGNMENT 4
-#       define ALIGN_DOUBLE
-        extern int _fdata;
-#       define DATASTART ((ptr_t)(&_fdata))
-        extern int _end;
-#       define DATAEND ((ptr_t)(&_end))
-#       define STACKBOTTOM ((ptr_t)0x7fff8000)
-#       define USE_GENERIC_PUSH_REGS 1
-#       define DYNAMIC_LOADING
-#   endif /* Linux */
-#   ifdef ULTRIX
-#      define HEURISTIC2
-#       define DATASTART (ptr_t)0x10000000
-                             /* Could probably be slightly higher since */
-                             /* startup code allocates lots of stuff.   */
-#      define OS_TYPE "ULTRIX"
-#       define ALIGNMENT 4
-#   endif
-#   ifdef RISCOS
-#      define HEURISTIC2
-#       define DATASTART (ptr_t)0x10000000
-#      define OS_TYPE "RISCOS"
-#      define ALIGNMENT 4  /* Required by hardware */
-#   endif
-#   ifdef IRIX5
-#      define HEURISTIC2
-        extern int _fdata;
-#       define DATASTART ((ptr_t)(&_fdata))
-#       ifdef USE_MMAP
-#         define HEAP_START (ptr_t)0x30000000
-#       else
-#        define HEAP_START DATASTART
-#       endif
-                             /* Lowest plausible heap address.         */
-                             /* In the MMAP case, we map there.        */
-                             /* In either case it is used to identify  */
-                             /* heap sections so they're not           */
-                             /* considered as roots.                   */
-#      define OS_TYPE "IRIX5"
-#       define MPROTECT_VDB
-#       ifdef _MIPS_SZPTR
-#        define CPP_WORDSZ _MIPS_SZPTR
-#        define ALIGNMENT (_MIPS_SZPTR/8)
-#        if CPP_WORDSZ != 64
-#          define ALIGN_DOUBLE
-#        endif
-#      else
-#         define ALIGNMENT 4
-#        define ALIGN_DOUBLE
-#      endif
-#      define DYNAMIC_LOADING
-#   endif
-# endif
-
-# ifdef RS6000
-#   define MACH_TYPE "RS6000"
-#   define ALIGNMENT 4
-#   define DATASTART ((ptr_t)0x20000000)
-    extern int errno;
-#   define STACKBOTTOM ((ptr_t)((ulong)&errno))
-#   define DYNAMIC_LOADING
-       /* For really old versions of AIX, this may have to be removed. */
-# endif
-
-# ifdef HP_PA
-    /* OS is assumed to be HP/UX       */
-#   define MACH_TYPE "HP_PA"
-#   define OS_TYPE "HPUX"
-#   ifdef __LP64__
-#     define CPP_WORDSZ 64
-#     define ALIGNMENT 8
-#   else
-#     define CPP_WORDSZ 32
-#     define ALIGNMENT 4
-#     define ALIGN_DOUBLE
-#   endif
-    extern int __data_start;
-#   define DATASTART ((ptr_t)(&__data_start))
-#   if 0
-       /* The following appears to work for 7xx systems running HP/UX  */
-       /* 9.xx Furthermore, it might result in much faster             */
-       /* collections than HEURISTIC2, which may involve scanning      */
-       /* segments that directly precede the stack.  It is not the     */
-       /* default, since it may not work on older machine/OS           */
-       /* combinations. (Thanks to Raymond X.T. Nijssen for uncovering */
-       /* this.)                                                       */
-#       define STACKBOTTOM ((ptr_t) 0x7b033000)  /* from /etc/conf/h/param.h */
-#   else
-       /* Gustavo Rodriguez-Rivera suggested changing HEURISTIC2       */
-       /* to this.  We'll probably do this on other platforms, too.    */
-       /* For now I'll use it where I can test it.                     */
-       extern char ** environ;
-#       define STACKBOTTOM ((ptr_t)environ)
-#   endif
-#   ifndef SCM_STACK_GROWS_UP /* don't fight with scmconfig.h */
-#     define SCM_STACK_GROWS_UP 1
-#   endif
-#   define DYNAMIC_LOADING
-#   ifndef HPUX_THREADS
-#     define MPROTECT_VDB
-#   endif
-#   include <unistd.h>
-#   define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
-# endif
-
-# ifdef ALPHA
-#   define MACH_TYPE "ALPHA"
-#   define ALIGNMENT 8
-#   define USE_GENERIC_PUSH_REGS
-       /* Gcc and probably the DEC/Compaq compiler spill pointers to preserved 
*/
-       /* fp registers in some cases when the target is a 21264.  The assembly 
*/
-       /* code doesn't handle that yet, and version dependencies make that a   
*/
-       /* bit tricky.  Do the easy thing for now.                              
*/
-#   ifdef OSF1
-#      define OS_TYPE "OSF1"
-#      define DATASTART ((ptr_t) 0x140000000)
-       extern int _end;
-#      define DATAEND ((ptr_t) &_end)
-#      define HEURISTIC2
-       /* Normally HEURISTIC2 is too conervative, since                */
-       /* the text segment immediately follows the stack.              */
-       /* Hence we give an upper pound.                                */
-       extern int __start;
-#      define HEURISTIC2_LIMIT ((ptr_t)((word)(&__start) & ~(getpagesize()-1)))
-#      define CPP_WORDSZ 64
-#      define MPROTECT_VDB
-#      define DYNAMIC_LOADING
-#   endif
-#   ifdef LINUX
-#       define OS_TYPE "LINUX"
-#       define CPP_WORDSZ 64
-#       define STACKBOTTOM ((ptr_t) 0x120000000)
-#       ifdef __ELF__
-#        define LINUX_DATA_START
-#         define DYNAMIC_LOADING
-         /* This doesn't work if the collector is in a dynamic library. */
-#       else
-#           define DATASTART ((ptr_t) 0x140000000)
-#       endif
-       extern int _end;
-#      define DATAEND (&_end)
-#      define MPROTECT_VDB
-               /* Has only been superficially tested.  May not */
-               /* work on all versions.                        */
-#   endif
-# endif
-
-# ifdef IA64
-#   define MACH_TYPE "IA64"
-#   define ALIGN_DOUBLE
-       /* Requires 16 byte alignment for malloc */
-#   define ALIGNMENT 8
-#   define USE_GENERIC_PUSH_REGS
-       /* We need to get preserved registers in addition to register windows.  
*/
-       /* That's easiest to do with setjmp.                                    
*/
-#   ifdef HPUX
-       --> needs work
-#   endif
-#   ifdef LINUX
-#       define OS_TYPE "LINUX"
-#       define CPP_WORDSZ 64
-       /* This should really be done through /proc, but that   */
-       /* requires we run on an IA64 kernel.                   */
-#       define STACKBOTTOM ((ptr_t) 0xa000000000000000l)
-       /* We also need the base address of the register stack  */
-       /* backing store.  There is probably a better way to    */
-       /* get that, too ...                                    */
-#      define BACKING_STORE_BASE ((ptr_t) 0x9fffffff80000000l)
-#      if 1
-#          define SEARCH_FOR_DATA_START
-#          define DATASTART GC_data_start
-#      else
-           extern int data_start;
-#          define DATASTART ((ptr_t)(&data_start))
-#      endif
-#       define DYNAMIC_LOADING
-#      define MPROTECT_VDB
-               /* Requires Linux 2.3.47 or later.      */
-       extern int _end;
-#      define DATAEND (&_end)
-#      define PREFETCH(x) \
-         __asm__ ("    lfetch  [%0]": : "r"((void *)(x)))
-#      define PREFETCH_FOR_WRITE(x) \
-         __asm__ ("    lfetch.excl     [%0]": : "r"((void *)(x)))
-#      define CLEAR_DOUBLE(x) \
-         __asm__ ("    stf.spill       [%0]=f0": : "r"((void *)(x)))
-#   endif
-# endif
-
-# ifdef M88K
-#   define MACH_TYPE "M88K"
-#   define ALIGNMENT 4
-#   define ALIGN_DOUBLE
-    extern int etext;
-#   ifdef CX_UX
-#      define OS_TYPE "CX_UX"
-#       define DATASTART ((((word)&etext + 0x3fffff) & ~0x3fffff) + 0x10000)
-#   endif
-#   ifdef  DGUX
-#      define OS_TYPE "DGUX"
-       extern char * GC_SysVGetDataStart();
-#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &etext)
-#   endif
-#   define STACKBOTTOM ((char*)0xf0000000) /* determined empirically */
-# endif
-
-# ifdef S370
-#   define MACH_TYPE "S370"
-#   define OS_TYPE "UTS4"
-#   define ALIGNMENT 4 /* Required by hardware */
-    extern int etext;
-       extern int _etext;
-       extern int _end;
-       extern char * GC_SysVGetDataStart();
-#       define DATASTART (ptr_t)GC_SysVGetDataStart(0x10000, &_etext)
-#      define DATAEND (&_end)
-#      define HEURISTIC2
-# endif
-
-# if defined(PJ)
-#   define ALIGNMENT 4
-    extern int _etext;
-#   define DATASTART ((ptr_t)(&_etext))
-#   define HEURISTIC1
-# endif
-
-# ifdef ARM32
-#   define CPP_WORDSZ 32
-#   define MACH_TYPE "ARM32"
-#   define ALIGNMENT 4
-#   ifdef NETBSD
-#       define OS_TYPE "NETBSD"
-#       define HEURISTIC2
-        extern char etext;
-#       define DATASTART ((ptr_t)(&etext))
-#       define USE_GENERIC_PUSH_REGS
-#   endif
-#   ifdef LINUX
-#       define OS_TYPE "LINUX"
-#       define HEURISTIC1
-#       undef STACK_GRAN
-#       define STACK_GRAN 0x10000000
-#       define USE_GENERIC_PUSH_REGS
-#       ifdef __ELF__
-#            define DYNAMIC_LOADING
-#           include <features.h>
-#           if defined(__GLIBC__) && __GLIBC__ >= 2
-#               define LINUX_DATA_START
-#           else
-                extern char **__environ;
-#                define DATASTART ((ptr_t)(&__environ))
-                             /* hideous kludge: __environ is the first */
-                             /* word in crt0.o, and delimits the start */
-                             /* of the data segment, no matter which   */
-                             /* ld options were passed through.        */
-                             /* We could use _etext instead, but that  */
-                             /* would include .rodata, which may       */
-                             /* contain large read-only data tables    */
-                             /* that we'd rather not scan.             */
-#           endif
-            extern int _end;
-#           define DATAEND (&_end)
-#      else
-            extern int etext;
-#            define DATASTART ((ptr_t)((((word) (&etext)) + 0xfff) & ~0xfff))
-#       endif
-#   endif
-#endif
-
-#ifdef LINUX_DATA_START
-    /* Some Linux distributions arrange to define __data_start.  Some  */
-    /* define data_start as a weak symbol.  The latter is technically  */
-    /* broken, since the user program may define data_start, in which  */
-    /* case we lose.  Nonetheless, we try both, prefering __data_start.        
*/
-    /* We assume gcc.  */
-#   pragma weak __data_start
-    extern int __data_start;
-#   pragma weak data_start
-    extern int data_start;
-#   define DATASTART ((ptr_t)(&__data_start != 0? &__data_start : &data_start))
-#endif
-
-# if SCM_STACK_GROWS_UP
-#   define STACK_GROWS_DOWN 0
-# else
-#   define STACK_GROWS_DOWN 1
-#endif
-
-# ifndef CPP_WORDSZ
-#   define CPP_WORDSZ 32
-# endif
-
-# ifndef OS_TYPE
-#   define OS_TYPE ""
-# endif
-
-# ifndef DATAEND
-    extern int end;
-#   define DATAEND (&end)
-# endif
-
-# if defined(SVR4) && !defined(GETPAGESIZE)
-#    include <unistd.h>
-#    define GETPAGESIZE()  sysconf(_SC_PAGESIZE)
-# endif
-
-# ifndef GETPAGESIZE
-#   if defined(SUNOS5) || defined(IRIX5)
-#      include <unistd.h>
-#   endif
-#   define GETPAGESIZE() getpagesize()
-# endif
-
-# if defined(SUNOS5) || defined(DRSNX) || defined(UTS4)
-    /* OS has SVR4 generic features.  Probably others also qualify.    */
-#   define SVR4
-# endif
-
-# if defined(SUNOS5) || defined(DRSNX)
-    /* OS has SUNOS5 style semi-undocumented interface to dynamic      */
-    /* loader.                                                         */
-#   define SUNOS5DL
-    /* OS has SUNOS5 style signal handlers.                            */
-#   define SUNOS5SIGS
-# endif
-
-# if defined(HPUX)
-#   define SUNOS5SIGS
-# endif
-
-# if CPP_WORDSZ != 32 && CPP_WORDSZ != 64
-   -> bad word size
-# endif
-
-# ifdef PCR
-#   undef DYNAMIC_LOADING
-#   undef STACKBOTTOM
-#   undef HEURISTIC1
-#   undef HEURISTIC2
-#   undef PROC_VDB
-#   undef MPROTECT_VDB
-#   define PCR_VDB
-# endif
-
-# ifdef SRC_M3
-/* Postponed for now. */
-#   undef PROC_VDB
-#   undef MPROTECT_VDB
-# endif
-
-# ifdef SMALL_CONFIG
-/* Presumably not worth the space it takes. */
-#   undef PROC_VDB
-#   undef MPROTECT_VDB
-# endif
-
-# ifdef USE_MUNMAP
-#   undef MPROTECT_VDB  /* Can't deal with address space holes. */
-# endif
-
-# if !defined(PCR_VDB) && !defined(PROC_VDB) && !defined(MPROTECT_VDB)
-#   define DEFAULT_VDB
-# endif
-
-# ifndef PREFETCH
-#   define PREFETCH(x)
-#   define NO_PREFETCH
-# endif
-
-# ifndef PREFETCH_FOR_WRITE
-#   define PREFETCH_FOR_WRITE(x)
-#   define NO_PREFETCH_FOR_WRITE
-# endif
-
-# ifndef CACHE_LINE_SIZE
-#   define CACHE_LINE_SIZE 32  /* Wild guess   */
-# endif
-
-# ifndef CLEAR_DOUBLE
-#   define CLEAR_DOUBLE(x) \
-       ((word*)x)[0] = 0; \
-       ((word*)x)[1] = 0;
-# endif /* CLEAR_DOUBLE */
-
-# if defined(_SOLARIS_PTHREADS) && !defined(SOLARIS_THREADS)
-#   define SOLARIS_THREADS
-# endif
-# if defined(IRIX_THREADS) && !defined(IRIX5)
---> inconsistent configuration
-# endif
-# if defined(IRIX_JDK_THREADS) && !defined(IRIX5)
---> inconsistent configuration
-# endif
-# if defined(LINUX_THREADS) && !defined(LINUX)
---> inconsistent configuration
-# endif
-# if defined(SOLARIS_THREADS) && !defined(SUNOS5)
---> inconsistent configuration
-# endif
-# if defined(HPUX_THREADS) && !defined(HPUX)
---> inconsistent configuration
-# endif
-# if defined(PCR) || defined(SRC_M3) || \
-       defined(SOLARIS_THREADS) || defined(WIN32_THREADS) || \
-       defined(IRIX_THREADS) || defined(LINUX_THREADS) || \
-       defined(IRIX_JDK_THREADS) || defined(HPUX_THREADS)
-#   define THREADS
-# endif
-
-# if defined(HP_PA) || defined(M88K) || defined(POWERPC) \
-     || (defined(I386) && defined(OS2)) || defined(UTS4) || defined(LINT)
-       /* Use setjmp based hack to mark from callee-save registers. */
-#      define USE_GENERIC_PUSH_REGS
-# endif
-# if defined(SPARC) && !defined(LINUX)
-#   define SAVE_CALL_CHAIN
-#   define ASM_CLEAR_CODE      /* Stack clearing is crucial, and we    */
-                               /* include assembly code to do it well. */
-# endif
-
-# if defined(LINUX) && !defined(POWERPC)
-
-# if 0
-#   include <linux/version.h>
-#   if (LINUX_VERSION_CODE <= 0x10400)
-      /* Ugly hack to get struct sigcontext_struct definition.  Required  */
-      /* for some early 1.3.X releases.  Will hopefully go away soon. */
-      /* in some later Linux releases, asm/sigcontext.h may have to   */
-      /* be included instead.                                         */
-#     define __KERNEL__
-#     include <asm/signal.h>
-#     undef __KERNEL__
-#  endif
-
-#  else
-
-      /* Kernels prior to 2.1.1 defined struct sigcontext_struct instead of */
-      /* struct sigcontext.  libc6 (glibc2) uses "struct sigcontext" in     */
-      /* prototypes, so we have to include the top-level sigcontext.h to    */
-      /* make sure the former gets defined to be the latter if appropriate. */
-#     include <features.h>
-#     if 2 <= __GLIBC__
-#       if 2 == __GLIBC__ && 0 == __GLIBC_MINOR__
-         /* glibc 2.1 no longer has sigcontext.h.  But signal.h        */
-         /* has the right declaration for glibc 2.1.                   */
-#         include <sigcontext.h>
-#       endif /* 0 == __GLIBC_MINOR__ */
-#     else /* not 2 <= __GLIBC__ */
-        /* libc5 doesn't have <sigcontext.h>: go directly with the kernel   */
-        /* one.  Check LINUX_VERSION_CODE to see which we should reference. */
-#       include <asm/sigcontext.h>
-#     endif /* 2 <= __GLIBC__ */
-#   endif
-# endif
-# if !defined(OS2) && !defined(PCR) && !defined(AMIGA) && !defined(MACOS)
-#   include <sys/types.h>
-#   if !defined(MSWIN32) && !defined(SUNOS4)
-#      include <unistd.h>
-#   endif
-# endif
-
-# include <signal.h>
-
-/* Blatantly OS dependent routines, except for those that are related  */
-/* to dynamic loading.                                                 */
-
-# if !defined(THREADS) && !defined(STACKBOTTOM) && defined(HEURISTIC2)
-#   define NEED_FIND_LIMIT
-# endif
-
-# if defined(IRIX_THREADS) || defined(HPUX_THREADS)
-#   define NEED_FIND_LIMIT
-# endif
-
-# if (defined(SUNOS4) && defined(DYNAMIC_LOADING)) && !defined(PCR)
-#   define NEED_FIND_LIMIT
-# endif
-
-# if (defined(SVR4) || defined(AUX) || defined(DGUX)) && !defined(PCR)
-#   define NEED_FIND_LIMIT
-# endif
-
-# if defined(LINUX) && \
-     (defined(POWERPC) || defined(SPARC) || defined(ALPHA) || defined(IA64) \
-      || defined(MIPS))
-#   define NEED_FIND_LIMIT
-# endif
-
-#ifdef NEED_FIND_LIMIT
-#   include <setjmp.h>
-#endif
-
-#ifdef FREEBSD
-#  include <machine/trap.h>
-#endif
-
-#ifdef AMIGA
-# include <proto/exec.h>
-# include <proto/dos.h>
-# include <dos/dosextens.h>
-# include <workbench/startup.h>
-#endif
-
-#ifdef MSWIN32
-# define WIN32_LEAN_AND_MEAN
-# define NOSERVICE
-# include <windows.h>
-#endif
-
-#ifdef MACOS
-# include <Processes.h>
-#endif
-
-#ifdef IRIX5
-# include <sys/uio.h>
-# include <malloc.h>   /* for locking */
-#endif
-#ifdef USE_MMAP
-# include <sys/types.h>
-# include <sys/mman.h>
-# include <sys/stat.h>
-# include <fcntl.h>
-#endif
-
-#ifdef SUNOS5SIGS
-# include <sys/siginfo.h>
-# undef setjmp
-# undef longjmp
-# define setjmp(env) sigsetjmp(env, 1)
-# define longjmp(env, val) siglongjmp(env, val)
-# define jmp_buf sigjmp_buf
-#endif
-
-#ifdef DJGPP
-  /* Apparently necessary for djgpp 2.01.  May casuse problems with    */
-  /* other versions.                                                   */
-  typedef long unsigned int caddr_t;
-#endif
-
-#ifdef PCR
-# include "il/PCR_IL.h"
-# include "th/PCR_ThCtl.h"
-# include "mm/PCR_MM.h"
-#endif
-
-#if !defined(NO_EXECUTE_PERMISSION)
-# define OPT_PROT_EXEC PROT_EXEC
-#else
-# define OPT_PROT_EXEC 0
-#endif
-
-# ifdef OS2
-
-# include <stddef.h>
-
-# if !defined(__IBMC__) && !defined(__WATCOMC__) /* e.g. EMX */
-
-# else  /* IBM's compiler */
-
-/* A kludge to get around what appears to be a header file bug */
-# ifndef WORD
-#   define WORD unsigned short
-# endif
-# ifndef DWORD
-#   define DWORD unsigned long
-# endif
-
-# define EXE386 1
-# include <newexe.h>
-# include <exe386.h>
-
-# endif  /* __IBMC__ */
-
-# define INCL_DOSEXCEPTIONS
-# define INCL_DOSPROCESS
-# define INCL_DOSERRORS
-# define INCL_DOSMODULEMGR
-# define INCL_DOSMEMMGR
-# include <os2.h>
-
-# endif /*!OS/2 */
-
-/*
- * Find the base of the stack.
- * Used only in single-threaded environment.
- * With threads, GC_mark_roots needs to know how to do this.
- * Called with allocator lock held.
- */
-# ifdef MSWIN32
-# define is_writable(prot) ((prot) == PAGE_READWRITE \
-                           || (prot) == PAGE_WRITECOPY \
-                           || (prot) == PAGE_EXECUTE_READWRITE \
-                           || (prot) == PAGE_EXECUTE_WRITECOPY)
-/* Return the number of bytes that are writable starting at p. */
-/* The pointer p is assumed to be page aligned.                        */
-/* If base is not 0, *base becomes the beginning of the        */
-/* allocation region containing p.                             */
-static word GC_get_writable_length(ptr_t p, ptr_t *base)
-{
-    MEMORY_BASIC_INFORMATION buf;
-    word result;
-    word protect;
-
-    result = VirtualQuery(p, &buf, sizeof(buf));
-    if (result != sizeof(buf)) ABORT("Weird VirtualQuery result");
-    if (base != 0) *base = (ptr_t)(buf.AllocationBase);
-    protect = (buf.Protect & ~(PAGE_GUARD | PAGE_NOCACHE));
-    if (!is_writable(protect)) {
-        return(0);
-    }
-    if (buf.State != MEM_COMMIT) return(0);
-    return(buf.RegionSize);
-}
-
-void *scm_get_stack_base()
-{
-    int dummy;
-    ptr_t sp = (ptr_t)(&dummy);
-    ptr_t trunc_sp;
-    word size;
-    static word GC_page_size = 0;
-    if (!GC_page_size) {
-        SYSTEM_INFO sysinfo;
-        GetSystemInfo(&sysinfo);
-        GC_page_size = sysinfo.dwPageSize;
-    }
-    trunc_sp = (ptr_t)((word)sp & ~(GC_page_size - 1));
-    size = GC_get_writable_length(trunc_sp, 0);
-    return(trunc_sp + size);
-}
-
-
-# else
-
-# ifdef OS2
-
-void *scm_get_stack_base()
-{
-    PTIB ptib;
-    PPIB ppib;
-
-    if (DosGetInfoBlocks(&ptib, &ppib) != NO_ERROR) {
-       GC_err_printf0("DosGetInfoBlocks failed\n");
-       ABORT("DosGetInfoBlocks failed\n");
-    }
-    return((ptr_t)(ptib -> tib_pstacklimit));
-}
-
-# else
-
-# ifdef AMIGA
-
-void *scm_get_stack_base()
-{
-    struct Process *proc = (struct Process*)SysBase->ThisTask;
-
-    /* Reference: Amiga Guru Book Pages: 42,567,574 */
-    if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS
-        && proc->pr_CLI != NULL) {
-       /* first ULONG is StackSize */
-       /*longPtr = proc->pr_ReturnAddr;
-       size = longPtr[0];*/
-
-       return (char *)proc->pr_ReturnAddr + sizeof(ULONG);
-    } else {
-       return (char *)proc->pr_Task.tc_SPUpper;
-    }
-}
-
-#if 0 /* old version */
-void *scm_get_stack_base()
-{
-    extern struct WBStartup *_WBenchMsg;
-    extern long __base;
-    extern long __stack;
-    struct Task *task;
-    struct Process *proc;
-    struct CommandLineInterface *cli;
-    long size;
-
-    if ((task = FindTask(0)) == 0) {
-       GC_err_puts("Cannot find own task structure\n");
-       ABORT("task missing");
-    }
-    proc = (struct Process *)task;
-    cli = BADDR(proc->pr_CLI);
-
-    if (_WBenchMsg != 0 || cli == 0) {
-       size = (char *)task->tc_SPUpper - (char *)task->tc_SPLower;
-    } else {
-       size = cli->cli_DefaultStack * 4;
-    }
-    return (ptr_t)(__base + GC_max(size, __stack));
-}
-#endif /* 0 */
-
-# else /* !AMIGA, !OS2, ... */
-
-# ifdef NEED_FIND_LIMIT
-  /* Some tools to implement HEURISTIC2        */
-#   define MIN_PAGE_SIZE 256   /* Smallest conceivable page size, bytes */
-    /* static */ jmp_buf GC_jmp_buf;
-
-    /*ARGSUSED*/
-    static void GC_fault_handler(sig)
-    int sig;
-    {
-        longjmp(GC_jmp_buf, 1);
-    }
-
-#   ifdef __STDC__
-       typedef void (*handler)(int);
-#   else
-       typedef void (*handler)();
-#   endif
-
-#   if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1)
-       static struct sigaction old_segv_act;
-#      if defined(_sigargs) || defined(HPUX) /* !Irix6.x */
-           static struct sigaction old_bus_act;
-#      endif
-#   else
-        static handler old_segv_handler, old_bus_handler;
-#   endif
-
-    static void GC_setup_temporary_fault_handler()
-    {
-#      if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1)
-         struct sigaction      act;
-
-         act.sa_handler        = GC_fault_handler;
-          act.sa_flags          = SA_RESTART | SA_NODEFER;
-          /* The presence of SA_NODEFER represents yet another gross    */
-          /* hack.  Under Solaris 2.3, siglongjmp doesn't appear to     */
-          /* interact correctly with -lthread.  We hide the confusion   */
-          /* by making sure that signal handling doesn't affect the     */
-          /* signal mask.                                               */
-
-         (void) sigemptyset(&act.sa_mask);
-#        ifdef IRIX_THREADS
-               /* Older versions have a bug related to retrieving and  */
-               /* and setting a handler at the same time.              */
-               (void) sigaction(SIGSEGV, 0, &old_segv_act);
-               (void) sigaction(SIGSEGV, &act, 0);
-#        else
-               (void) sigaction(SIGSEGV, &act, &old_segv_act);
-#              if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \
-                  || defined(HPUX)
-                   /* Under Irix 5.x or HP/UX, we may get SIGBUS.      */
-                   /* Pthreads doesn't exist under Irix 5.x, so we     */
-                   /* don't have to worry in the threads case.         */
-                   (void) sigaction(SIGBUS, &act, &old_bus_act);
-#              endif
-#        endif /* IRIX_THREADS */
-#      else
-         old_segv_handler = signal(SIGSEGV, GC_fault_handler);
-#        ifdef SIGBUS
-           old_bus_handler = signal(SIGBUS, GC_fault_handler);
-#        endif
-#      endif
-    }
-
-    static void GC_reset_fault_handler()
-    {
-#       if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1)
-         (void) sigaction(SIGSEGV, &old_segv_act, 0);
-#        if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \
-            || defined(HPUX)
-             (void) sigaction(SIGBUS, &old_bus_act, 0);
-#        endif
-#       else
-         (void) signal(SIGSEGV, old_segv_handler);
-#        ifdef SIGBUS
-           (void) signal(SIGBUS, old_bus_handler);
-#        endif
-#       endif
-    }
-
-    /* Single argument version, robust against whole program analysis. */
-    static void
-    GC_noop1(x)
-    word x;
-    {
-      static VOLATILE word sink;
-      sink = x;
-    }
-
-    /* Return the first nonaddressible location > p (up) or    */
-    /* the smallest location q s.t. [q,p] is addressible (!up).        */
-    static ptr_t GC_find_limit(p, up)
-    ptr_t p;
-    GC_bool up;
-    {
-        static VOLATILE ptr_t result;
-               /* Needs to be static, since otherwise it may not be    */
-               /* preserved across the longjmp.  Can safely be         */
-               /* static since it's only called once, with the         */
-               /* allocation lock held.                                */
-
-
-       GC_setup_temporary_fault_handler();
-       if (setjmp(GC_jmp_buf) == 0) {
-           result = (ptr_t)(((word)(p))
-                             & ~(MIN_PAGE_SIZE-1));
-           for (;;) {
-               if (up) {
-                   result += MIN_PAGE_SIZE;
-               } else {
-                   result -= MIN_PAGE_SIZE;
-               }
-               GC_noop1((word)(*result));
-           }
-       }
-       GC_reset_fault_handler();
-       if (!up) {
-           result += MIN_PAGE_SIZE;
-       }
-       return(result);
-    }
-
-# endif
-
-#ifdef LINUX_STACKBOTTOM
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-
-# define STAT_SKIP 27   /* Number of fields preceding startstack       */
-                       /* field in /proc/self/stat                     */
-
-  static ptr_t GC_linux_stack_base(void)
-  {
-    /* We read the stack base value from /proc/self/stat.  We do this  */
-    /* using direct I/O system calls in order to avoid calling malloc   */
-    /* in case REDIRECT_MALLOC is defined.                             */
-#   define STAT_BUF_SIZE 4096
-#   ifdef USE_LD_WRAP
-#      define STAT_READ __real_read
-#   else
-#      define STAT_READ read
-#   endif
-    char stat_buf[STAT_BUF_SIZE];
-    int f;
-    char c;
-    word result = 0;
-    size_t i, buf_offset = 0;
-
-    f = open("/proc/self/stat", O_RDONLY);
-    if (f < 0 || STAT_READ(f, stat_buf, STAT_BUF_SIZE) < 2 * STAT_SKIP) {
-       ABORT("Couldn't read /proc/self/stat");
-    }
-    c = stat_buf[buf_offset++];
-    /* Skip the required number of fields.  This number is hopefully   */
-    /* constant across all Linux implementations.                      */
-      for (i = 0; i < STAT_SKIP; ++i) {
-       while (isspace ((int) c)) 
-          c = stat_buf[buf_offset++];
-       while (!isspace ((int) c)) 
-          c = stat_buf[buf_offset++];
-      }
-      while (isspace ((int) c)) 
-        c = stat_buf[buf_offset++];
-    while (isdigit ((int) c)) {
-      result *= 10;
-      result += c - '0';
-      c = stat_buf[buf_offset++];
-    }
-    close(f);
-    if (result < 0x10000000) ABORT("Absurd stack bottom value");
-    return (ptr_t)result;
-  }
-
-#endif /* LINUX_STACKBOTTOM */
-
-void *scm_get_stack_base()
-{
-    word dummy;
-    void *result;
-
-    result = &dummy;  /* initialize to silence compiler */
-
-#   define STACKBOTTOM_ALIGNMENT_M1 ((word)STACK_GRAN - 1)
-
-#   ifdef STACKBOTTOM
-       return(STACKBOTTOM);
-#   else
-#      ifdef HEURISTIC1
-#         if STACK_GROWS_DOWN
-            result = (ptr_t)((((word)(&dummy))
-                              + STACKBOTTOM_ALIGNMENT_M1)
-                             & ~STACKBOTTOM_ALIGNMENT_M1);
-#         else
-            result = (ptr_t)(((word)(&dummy))
-                             & ~STACKBOTTOM_ALIGNMENT_M1);
-#         endif
-#      endif /* HEURISTIC1 */
-#      ifdef LINUX_STACKBOTTOM
-          result = GC_linux_stack_base();
-#      endif
-#      ifdef HEURISTIC2
-#          if STACK_GROWS_DOWN
-               result = GC_find_limit((ptr_t)(&dummy), TRUE);
-#              ifdef HEURISTIC2_LIMIT
-                   if ((ptr_t)result > HEURISTIC2_LIMIT
-                       && (ptr_t)(&dummy) < HEURISTIC2_LIMIT) {
-                           result = HEURISTIC2_LIMIT;
-                   }
-#              endif
-#          else
-               result = GC_find_limit((ptr_t)(&dummy), FALSE);
-#              ifdef HEURISTIC2_LIMIT
-                   if (result < HEURISTIC2_LIMIT
-                       && (ptr_t)(&dummy) > HEURISTIC2_LIMIT) {
-                           result = HEURISTIC2_LIMIT;
-                   }
-#              endif
-#          endif
-
-#      endif /* HEURISTIC2 */
-#      if STACK_GROWS_DOWN
-           if (result == 0) result = (ptr_t)(signed_word)(-sizeof(ptr_t));
-#      endif
-       return(result);
-#   endif /* STACKBOTTOM */
-}
-
-# endif /* ! AMIGA */
-# endif /* ! OS2 */
-# endif /* ! MSWIN32 */
-
-#endif /* mach_type_known */
-#endif /* ! HAVE_LIBC_STACK_END */
diff --git a/libguile/gdbint.c b/libguile/gdbint.c
index 0f74ce1..0d55e7d 100644
--- a/libguile/gdbint.c
+++ b/libguile/gdbint.c
@@ -102,55 +102,26 @@ int gdb_output_length;
 int scm_print_carefully_p;
 
 static SCM gdb_input_port;
-static int port_mark_p, stream_mark_p, string_mark_p;
-
 static SCM gdb_output_port;
 
 
-static void
-unmark_port (SCM port)
-{
-  SCM stream, string;
-  port_mark_p = SCM_GC_MARK_P (port);
-  SCM_CLEAR_GC_MARK (port);
-  stream = SCM_PACK (SCM_STREAM (port));
-  stream_mark_p = SCM_GC_MARK_P (stream);
-  SCM_CLEAR_GC_MARK (stream);
-  string = SCM_CDR (stream);
-  string_mark_p = SCM_GC_MARK_P (string);
-  SCM_CLEAR_GC_MARK (string);
-}
-
-
-static void
-remark_port (SCM port)
-{
-  SCM stream = SCM_PACK (SCM_STREAM (port));
-  SCM string = SCM_CDR (stream);
-  if (string_mark_p)
-    SCM_SET_GC_MARK (string);
-  if (stream_mark_p)
-    SCM_SET_GC_MARK (stream);
-  if (port_mark_p)
-    SCM_SET_GC_MARK (port);
-}
-
-
 int
 gdb_maybe_valid_type_p (SCM value)
 {
-  return SCM_IMP (value) || scm_in_heap_p (value);
+  return SCM_IMP (value); /*  || scm_in_heap_p (value); */ /* FIXME: What to
+                                                             do? */
 }
 
 
 int
 gdb_read (char *str)
 {
+#if 0
   SCM ans;
   int status = 0;
   RESET_STRING;
   /* Need to be restrictive about what to read? */
-  if (SCM_GC_P)
+  if (1)  /* (SCM_GC_P) */ /* FIXME */
     {
       char *p;
       for (p = str; *p != '\0'; ++p)
@@ -202,6 +173,9 @@ exit:
   remark_port (gdb_input_port);
   SCM_END_FOREIGN_BLOCK;
   return status;
+#else
+  abort ();
+#endif
 }
 
 
diff --git a/libguile/goops.c b/libguile/goops.c
index d1beab3..4616fa2 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -749,9 +749,8 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 
0, 0,
       ls = SCM_CDR (ls);
     }
   flags &= SCM_CLASSF_INHERIT;
-  if (flags & SCM_CLASSF_ENTITY)
-    SCM_SET_CLASS_DESTRUCTOR (class, scm_struct_free_entity);
-  else
+
+  if (! (flags & SCM_CLASSF_ENTITY))
     {
       long n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields));
 #if 0
@@ -768,7 +767,6 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 
0, 0,
        {
          /* NOTE: The following depends on scm_struct_i_size. */
          flags |= SCM_STRUCTF_LIGHT + n * sizeof (SCM); /* use light 
representation */
-         SCM_SET_CLASS_DESTRUCTOR (class, scm_struct_free_light);
        }
     }
   SCM_SET_CLASS_FLAGS (class, flags);
@@ -1890,6 +1888,11 @@ typedef struct t_extension {
   SCM extension;
 } t_extension;
 
+
+/* Hint for `scm_gc_malloc ()' et al. when allocating `t_extension'
+   objects.  */
+static const char extension_gc_hint[] = "GOOPS extension";
+
 static t_extension *extensions = 0;
 
 SCM_VARIABLE (scm_var_make_extended_generic, "make-extended-generic");
@@ -1910,7 +1913,8 @@ scm_c_extend_primitive_generic (SCM extended, SCM 
extension)
     }
   else
     {
-      t_extension *e = scm_malloc (sizeof (t_extension));
+      t_extension *e = scm_gc_malloc (sizeof (t_extension),
+                                     extension_gc_hint);
       t_extension **loc = &extensions;
       /* Make sure that extensions are placed before their own
        * extensions in the extensions list.  O(N^2) algorithm, but
@@ -1933,7 +1937,6 @@ setup_extended_primitive_generics ()
       t_extension *e = extensions;
       scm_c_extend_primitive_generic (e->extended, e->extension);
       extensions = e->next;
-      free (e);
     }
 }
 
@@ -2896,7 +2899,6 @@ scm_make_class (SCM meta, char *s_name, SCM supers, 
size_t size,
     }
   else if (size > 0)
     {
-      SCM_SET_CLASS_DESTRUCTOR (class, scm_struct_free_light);
       SCM_SET_CLASS_INSTANCE_SIZE (class, size);
     }
 
diff --git a/libguile/guardians.c b/libguile/guardians.c
index f7bbb4b..580e212 100644
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -17,7 +17,6 @@
  */
 
 
-
 /* This is an implementation of guardians as described in
  * R. Kent Dybvig, Carl Bruggeman, and David Eby (1993) "Guardians in
  * a Generation-Based Garbage Collector" ACM SIGPLAN Conference on
@@ -38,8 +37,14 @@
  * Now they should again behave like those described in the paper.
  * Scheme guardians should be simple and friendly, not like the greedy
  * monsters we had...
+ *
+ * Rewritten for the Boehm-Demers-Weiser GC by Ludovic Courtès.
+ * FIXME: This is currently not thread-safe.
  */
 
+/* Uncomment the following line to debug guardian finalization.  */
+/* #define DEBUG_GUARDIANS 1 */
+
 #ifdef HAVE_CONFIG_H
 # include <config.h>
 #endif
@@ -57,180 +62,192 @@
 #include "libguile/eval.h"
 
 #include "libguile/guardians.h"
+#include "libguile/boehm-gc.h"
 
 
-/* The live and zombies FIFOs are implemented as tconcs as described
-   in Dybvig's paper.  This decouples addition and removal of elements
-   so that no synchronization between these needs to take place.
-*/
-
-typedef struct t_tconc
-{
-  SCM head;
-  SCM tail;
-} t_tconc;
-
-#define TCONC_EMPTYP(tc) (scm_is_eq ((tc).head, (tc).tail))
-
-#define TCONC_IN(tc, obj, pair) \
-do { \
-  SCM_SETCAR ((tc).tail, obj); \
-  SCM_SET_CELL_OBJECT_1 (pair, SCM_EOL); \
-  SCM_SET_CELL_OBJECT_0 (pair, SCM_BOOL_F); \
-  SCM_SETCDR ((tc).tail, pair); \
-  (tc).tail = pair; \
-} while (0)
-
-#define TCONC_OUT(tc, res) \
-do { \
-  (res) = SCM_CAR ((tc).head); \
-  (tc).head = SCM_CDR ((tc).head); \
-} while (0)
 
 
 static scm_t_bits tc16_guardian;
 
 typedef struct t_guardian
 {
-  t_tconc live;
-  t_tconc zombies;
+  unsigned long live;
+  SCM zombies;
   struct t_guardian *next;
 } t_guardian;
 
 #define GUARDIAN_P(x)    SCM_SMOB_PREDICATE(tc16_guardian, x)
 #define GUARDIAN_DATA(x) ((t_guardian *) SCM_CELL_WORD_1 (x))
 
-static t_guardian *guardians;
 
-void
-scm_i_init_guardians_for_gc ()
-{
-  guardians = NULL;
-}
 
-/* mark a guardian by adding it to the live guardian list.  */
-static SCM
-guardian_mark (SCM ptr)
-{
-  t_guardian *g = GUARDIAN_DATA (ptr);
-  g->next = guardians;
-  guardians = g;
 
-  return SCM_BOOL_F;
-}
-
-/* Identify inaccessible objects and move them from the live list to
-   the zombie list.  An object is inaccessible when it is unmarked at
-   this point.  Therefore, the inaccessible objects are not marked yet
-   since that would prevent them from being recognized as
-   inaccessible.
-
-   The pairs that form the life list itself are marked, tho.
-*/
-void
-scm_i_identify_inaccessible_guardeds ()
+static int
+guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  t_guardian *g;
+  t_guardian *g = GUARDIAN_DATA (guardian);
+  
+  scm_puts ("#<guardian ", port);
+  scm_uintprint ((scm_t_bits) g, 16, port);
 
-  for (g = guardians; g; g = g->next)
-    {
-      SCM pair, next_pair;
-      SCM *prev_ptr;
+  scm_puts (" (reachable: ", port);
+  scm_display (scm_from_uint (g->live), port);
+  scm_puts (" unreachable: ", port);
+  scm_display (scm_length (g->zombies), port);
+  scm_puts (")", port);
 
-      for (pair = g->live.head, prev_ptr = &g->live.head;
-          !scm_is_eq (pair, g->live.tail);
-          pair = next_pair)
-       {
-         SCM obj = SCM_CAR (pair);
-         next_pair = SCM_CDR (pair);
-         if (!SCM_GC_MARK_P (obj))
-           {
-             /* Unmarked, move to 'inaccessible' list.
-              */
-             *prev_ptr = next_pair;
-             TCONC_IN (g->zombies, obj, pair);
-           }
-         else
-           {
-             SCM_SET_GC_MARK (pair);
-             prev_ptr = SCM_CDRLOC (pair);
-           }
-       }
-      SCM_SET_GC_MARK (pair);
-    }
+  scm_puts (">", port);
+
+  return 1;
 }
 
-int
-scm_i_mark_inaccessible_guardeds ()
+/* Handle finalization of OBJ which is guarded by the guardians listed in
+   GUARDIAN_LIST.  */
+static void
+finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data)
 {
-  t_guardian *g;
-  int again = 0;
+  SCM cell_pool;
+  SCM obj, guardian_list, proxied_finalizer;
 
-  /* We never need to see the guardians again that are processed here,
-     so we clear the list.  Calling scm_gc_mark below might find new
-     guardians, however (and other things), and we inform the GC about
-     this by returning non-zero.  See scm_mark_all in gc-mark.c
-  */
+  obj = PTR2SCM (ptr);
+  guardian_list = SCM_CDR (PTR2SCM (finalizer_data));
+  proxied_finalizer = SCM_CAR (PTR2SCM (finalizer_data));
 
-  g = guardians;
-  guardians = NULL;
+#ifdef DEBUG_GUARDIANS
+  printf ("finalizing guarded %p (%u guardians)\n",
+         ptr, scm_to_uint (scm_length (guardian_list)));
+#endif
 
-  for (; g; g = g->next)
+  /* Preallocate a bunch of cells so that we can make sure that no garbage
+     collection (and, thus, nested calls to `finalize_guarded ()') occurs
+     while executing the following loop.  This is quite inefficient (call to
+     `scm_length ()') but that shouldn't be a problem in most cases.  */
+  cell_pool = scm_make_list (scm_length (guardian_list), SCM_UNSPECIFIED);
+
+  /* Tell each guardian interested in OBJ that OBJ is no longer
+     reachable.  */
+  for (;
+       guardian_list != SCM_EOL;
+       guardian_list = SCM_CDR (guardian_list))
     {
-      SCM pair;
+      SCM zombies;
+      t_guardian *g;
 
-      for (pair = g->zombies.head;
-          !scm_is_eq (pair, g->zombies.tail);
-          pair = SCM_CDR (pair))
+      if (SCM_WEAK_PAIR_CAR_DELETED_P (guardian_list))
        {
-         if (!SCM_GC_MARK_P (pair))
-           {
-             scm_gc_mark (SCM_CAR (pair));
-             SCM_SET_GC_MARK (pair);
-             again = 1;
-           }
+         /* The guardian itself vanished in the meantime.  */
+#ifdef DEBUG_GUARDIANS
+         printf ("  guardian for %p vanished\n", ptr);
+#endif
+         continue;
        }
-      SCM_SET_GC_MARK (pair);
+
+      g = GUARDIAN_DATA (SCM_CAR (guardian_list));
+      if (g->live == 0)
+       abort ();
+
+      /* Get a fresh cell from CELL_POOL.  */
+      zombies = cell_pool;
+      cell_pool = SCM_CDR (cell_pool);
+
+      /* Compute and update G's zombie list.  */
+      SCM_SETCAR (zombies, SCM_PACK (obj));
+      SCM_SETCDR (zombies, g->zombies);
+      g->zombies = zombies;
+
+      g->live--;
+      g->zombies = zombies;
     }
-  return again;
-}
 
-static size_t
-guardian_free (SCM ptr)
-{
-  scm_gc_free (GUARDIAN_DATA (ptr), sizeof (t_guardian), "guardian");
-  return 0;
-}
+  if (proxied_finalizer != SCM_BOOL_F)
+    {
+      /* Re-register the finalizer that was in place before we installed this
+        one.  */
+      GC_finalization_proc finalizer, prev_finalizer;
+      GC_PTR finalizer_data, prev_finalizer_data;
 
-static int
-guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
-  t_guardian *g = GUARDIAN_DATA (guardian);
-  
-  scm_puts ("#<guardian ", port);
-  scm_uintprint ((scm_t_bits) g, 16, port);
+      finalizer = (GC_finalization_proc) SCM2PTR (SCM_CAR (proxied_finalizer));
+      finalizer_data = SCM2PTR (SCM_CDR (proxied_finalizer));
 
-  scm_puts (" (reachable: ", port);
-  scm_display (scm_length (SCM_CDR (g->live.head)), port);
-  scm_puts (" unreachable: ", port);
-  scm_display (scm_length (SCM_CDR (g->zombies.head)), port);
-  scm_puts (")", port);
+      if (finalizer == NULL)
+       abort ();
 
-  scm_puts (">", port);
+      GC_REGISTER_FINALIZER_NO_ORDER (ptr, finalizer, finalizer_data,
+                                     &prev_finalizer, &prev_finalizer_data);
 
-  return 1;
+#ifdef DEBUG_GUARDIANS
+      printf ("  reinstalled proxied finalizer %p for %p\n", finalizer, ptr);
+#endif
+    }
+
+#ifdef DEBUG_GUARDIANS
+  printf ("end of finalize (%p)\n", ptr);
+#endif
 }
 
+/* Add OBJ as a guarded object of GUARDIAN.  */
 static void
 scm_i_guard (SCM guardian, SCM obj)
 {
   t_guardian *g = GUARDIAN_DATA (guardian);
-  
-  if (!SCM_IMP (obj))
+
+  if (SCM_NIMP (obj))
     {
-      SCM z;
-      z = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
-      TCONC_IN (g->live, obj, z);
+      /* Register a finalizer and pass a pair as the ``client data''
+        argument.  The pair contains in its car `#f' or a pair describing a
+        ``proxied'' finalizer (see below); its cdr contains a list of
+        guardians interested in OBJ.
+
+        A ``proxied'' finalizer is a finalizer that was registered for OBJ
+        before OBJ became guarded (e.g., a SMOB `free' function).  We are
+        assuming here that finalizers are only used internally, either at
+        the very beginning of an object's lifetime (e.g., see `SCM_NEWSMOB')
+        or by this function.  */
+      GC_finalization_proc prev_finalizer;
+      GC_PTR prev_data;
+      SCM guardians_for_obj, finalizer_data;
+
+      g->live++;
+
+      /* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be
+        collected before the objects it guards (see `guardians.test').  */
+      guardians_for_obj = scm_weak_car_pair (guardian, SCM_EOL);
+      finalizer_data = scm_cons (SCM_BOOL_F, guardians_for_obj);
+
+      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalize_guarded,
+                                     SCM2PTR (finalizer_data),
+                                     &prev_finalizer, &prev_data);
+
+      if (prev_finalizer == finalize_guarded)
+       {
+         /* OBJ is already guarded by another guardian: add GUARDIAN to its
+            list of guardians.  */
+         SCM prev_guardian_list, prev_finalizer_data;
+
+         if (prev_data == NULL)
+           abort ();
+
+         prev_finalizer_data = PTR2SCM (prev_data);
+         if (!scm_is_pair (prev_finalizer_data))
+           abort ();
+
+         prev_guardian_list = SCM_CDR (prev_finalizer_data);
+         SCM_SETCDR (guardians_for_obj, prev_guardian_list);
+
+         /* Also copy information about proxied finalizers.  */
+         SCM_SETCAR (finalizer_data, SCM_CAR (prev_finalizer_data));
+       }
+      else if (prev_finalizer != NULL)
+       {
+         /* There was already a finalizer registered for OBJ so we will
+            ``proxy'' it, i.e., record it so that we can re-register it once
+            `finalize_guarded ()' has finished.  */
+         SCM proxied_finalizer;
+
+         proxied_finalizer = scm_cons (PTR2SCM (prev_finalizer),
+                                       PTR2SCM (prev_data));
+         SCM_SETCAR (finalizer_data, proxied_finalizer);
+       }
     }
 }
 
@@ -240,8 +257,12 @@ scm_i_get_one_zombie (SCM guardian)
   t_guardian *g = GUARDIAN_DATA (guardian);
   SCM res = SCM_BOOL_F;
 
-  if (!TCONC_EMPTYP (g->zombies))
-    TCONC_OUT (g->zombies, res);
+  if (g->zombies != SCM_EOL)
+    {
+      /* Note: We return zombies in reverse order.  */
+      res = SCM_CAR (g->zombies);
+      g->zombies = SCM_CDR (g->zombies);
+    }
 
   return res;
 }
@@ -318,13 +339,11 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
 #define FUNC_NAME s_scm_make_guardian
 {
   t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian");
-  SCM z1 = scm_cons (SCM_BOOL_F, SCM_EOL);
-  SCM z2 = scm_cons (SCM_BOOL_F, SCM_EOL);
   SCM z;
 
   /* A tconc starts out with one tail pair. */
-  g->live.head = g->live.tail = z1;
-  g->zombies.head = g->zombies.tail = z2;
+  g->live = 0;
+  g->zombies = SCM_EOL;
 
   g->next = NULL;
 
@@ -337,9 +356,11 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
 void
 scm_init_guardians ()
 {
+  /* We use unordered finalization `a la Java.  */
+  GC_java_finalization = 1;
+
   tc16_guardian = scm_make_smob_type ("guardian", 0);
-  scm_set_smob_mark (tc16_guardian, guardian_mark);
-  scm_set_smob_free (tc16_guardian, guardian_free);
+
   scm_set_smob_print (tc16_guardian, guardian_print);
 #if ENABLE_DEPRECATED
   scm_set_smob_apply (tc16_guardian, guardian_apply, 0, 2, 0);
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index e3a6c43..5c03d28 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -34,6 +34,8 @@
 
 #include "libguile/validate.h"
 #include "libguile/hashtab.h"
+
+
 
 
 /* NOTES
@@ -82,8 +84,99 @@ static unsigned long hashtable_size[] = {
 
 static char *s_hashtable = "hashtable";
 
-SCM weak_hashtables = SCM_EOL;
 
+
+/* Helper functions and macros to deal with weak pairs.
+
+   Weak pairs need to be accessed very carefully since their components can
+   be nullified by the GC when the object they refer to becomes unreachable.
+   Hence the macros and functions below that detect such weak pairs within
+   buckets and remove them.  */
+
+
+/* Return a ``usable'' version of ALIST, an alist of weak pairs.  By
+   ``usable'', we mean that it contains only valid Scheme objects.  On
+   return, REMOVED_ITEMS is set to the number of pairs that have been
+   deleted.  */
+static SCM
+scm_fixup_weak_alist (SCM alist, size_t *removed_items)
+{
+  SCM result;
+  SCM prev = SCM_EOL;
+
+  *removed_items = 0;
+  for (result = alist;
+       scm_is_pair (alist);
+       prev = alist, alist = SCM_CDR (alist))
+    {
+      SCM pair = SCM_CAR (alist);
+
+      if (scm_is_pair (pair))
+       {
+         if (SCM_WEAK_PAIR_DELETED_P (pair))
+           {
+             /* Remove from ALIST weak pair PAIR whose car/cdr has been
+                nullified by the GC.  */
+             if (prev == SCM_EOL)
+               result = SCM_CDR (alist);
+             else
+               SCM_SETCDR (prev, SCM_CDR (alist));
+
+             (*removed_items)++;
+             continue;
+           }
+       }
+    }
+
+  return result;
+}
+
+
+/* Helper macros.  */
+
+/* Return true if OBJ is either a weak hash table or a weak alist vector (as
+   defined in `weaks.[ch]').
+   FIXME: We should eventually keep only weah hash tables.  Actually, the
+   procs in `weaks.c' already no longer return vectors.  */
+/* XXX: We assume that if OBJ is a vector, then it's a _weak_ alist vector.  */
+#define IS_WEAK_THING(_obj)                                    \
+  ((SCM_HASHTABLE_P (table) && (SCM_HASHTABLE_WEAK_P (table))) \
+   || (SCM_I_IS_VECTOR (table)))
+
+
+
+/* Fixup BUCKET, an alist part of weak hash table OBJ.  BUCKETS is the full
+   bucket vector for OBJ and IDX is the index of BUCKET within this
+   vector.  See also `scm_internal_hash_fold ()'.  */
+#define START_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket, _hashfn)        
     \
+do                                                                          \
+  {                                                                         \
+    size_t _removed;                                                        \
+                                                                            \
+    /* Disable the GC so that BUCKET remains valid until ASSOC_FN has       \
+       returned.  */                                                        \
+    /* FIXME: We could maybe trigger a rehash here depending on whether        
     \
+       `scm_fixup_weak_alist ()' noticed some change.  */                   \
+    GC_disable ();                                                          \
+    (_bucket) = scm_fixup_weak_alist ((_bucket), &_removed);                \
+    SCM_SIMPLE_VECTOR_SET ((_buckets), (_idx), (_bucket));                  \
+                                                                            \
+    if ((_removed) && (SCM_HASHTABLE_P (_obj)))                                
     \
+      {                                                                        
     \
+       SCM_SET_HASHTABLE_N_ITEMS ((_obj),                                   \
+                                  SCM_HASHTABLE_N_ITEMS (_obj) - _removed); \
+       scm_i_rehash ((_obj), (_hashfn),                                     \
+                     NULL, "START_WEAK_BUCKET_FIXUP");                      \
+      }                                                                        
     \
+  }                                                                         \
+while (0)
+
+/* Terminate a weak bucket fixup phase.  */
+#define END_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket, _hashfn)  \
+  do { GC_enable (); } while (0)
+
+
+
 static SCM
 make_hash_table (int flags, unsigned long k, const char *func_name) 
 {
@@ -93,24 +186,22 @@ make_hash_table (int flags, unsigned long k, const char 
*func_name)
   while (i < HASHTABLE_SIZE_N && n > hashtable_size[i])
     ++i;
   n = hashtable_size[i];
-  if (flags)
-    vector = scm_i_allocate_weak_vector (flags, scm_from_int (n), SCM_EOL);
-  else
-    vector = scm_c_make_vector (n, SCM_EOL);
-  t = scm_gc_malloc (sizeof (*t), s_hashtable);
+
+  /* In both cases, i.e., regardless of whether we are creating a weak hash
+     table, we return a non-weak vector.  This is because the vector itself
+     is not weak in the case of a weak hash table: the alist pairs are.  */
+  vector = scm_c_make_vector (n, SCM_EOL);
+
+  t = scm_gc_malloc_pointerless (sizeof (*t), s_hashtable);
   t->min_size_index = t->size_index = i;
   t->n_items = 0;
   t->lower = 0;
   t->upper = 9 * n / 10;
   t->flags = flags;
   t->hash_fn = NULL;
-  if (flags)
-    {
-      SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, weak_hashtables);
-      weak_hashtables = table;
-    }
-  else
-    SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, SCM_EOL);
+
+  SCM_NEWSMOB2 (table, scm_tc16_hashtable, vector, t);
+
   return table;
 }
 
@@ -157,13 +248,8 @@ scm_i_rehash (SCM table,
     SCM_HASHTABLE (table)->lower = new_size / 4;
   SCM_HASHTABLE (table)->upper = 9 * new_size / 10;
   buckets = SCM_HASHTABLE_VECTOR (table);
-  
-  if (SCM_HASHTABLE_WEAK_P (table))
-    new_buckets = scm_i_allocate_weak_vector (SCM_HASHTABLE_FLAGS (table),
-                                             scm_from_ulong (new_size),
-                                             SCM_EOL);
-  else
-    new_buckets = scm_c_make_vector (new_size, SCM_EOL);
+
+  new_buckets = scm_c_make_vector (new_size, SCM_EOL);
 
   /* When this is a weak hashtable, running the GC might change it.
      We need to cope with this while rehashing its elements.  We do
@@ -186,9 +272,15 @@ scm_i_rehash (SCM table,
       while (scm_is_pair (ls))
        {
          unsigned long h;
+
          cell = ls;
          handle = SCM_CAR (cell);
          ls = SCM_CDR (ls);
+
+         if (SCM_WEAK_PAIR_DELETED_P (handle))
+           /* HANDLE is a nullified weak pair: skip it.  */
+           continue;
+
          h = hash_fn (SCM_CAR (handle), new_size, closure);
          if (h >= new_size)
            scm_out_of_range (func_name, scm_from_ulong (h));
@@ -219,79 +311,6 @@ hashtable_print (SCM exp, SCM port, scm_print_state 
*pstate SCM_UNUSED)
   return 1;
 }
 
-/* keep track of hash tables that need to shrink after scan */
-static SCM to_rehash = SCM_EOL;
-
-/* scan hash tables and update hash tables item count */
-void
-scm_i_scan_weak_hashtables ()
-{
-  SCM *next = &weak_hashtables;
-  SCM h = *next;
-  while (!scm_is_null (h))
-    {
-      if (!SCM_GC_MARK_P (h))
-       *next = h = SCM_HASHTABLE_NEXT (h);
-      else
-       {
-         SCM vec = SCM_HASHTABLE_VECTOR (h);
-         size_t delta = SCM_I_WVECT_DELTA (vec);
-         SCM_I_SET_WVECT_DELTA (vec, 0);
-         SCM_SET_HASHTABLE_N_ITEMS (h, SCM_HASHTABLE_N_ITEMS (h) - delta);
-
-         if (SCM_HASHTABLE_N_ITEMS (h) < SCM_HASHTABLE_LOWER (h))
-           {
-             SCM tmp = SCM_HASHTABLE_NEXT (h);
-             /* temporarily move table from weak_hashtables to to_rehash */
-             SCM_SET_HASHTABLE_NEXT (h, to_rehash);
-             to_rehash = h;
-             *next = h = tmp;
-           }
-         else
-           {
-             next = SCM_HASHTABLE_NEXTLOC (h);
-             h = SCM_HASHTABLE_NEXT (h);
-           }
-       }
-    }
-}
-
-static void *
-rehash_after_gc (void *dummy1 SCM_UNUSED,
-                void *dummy2 SCM_UNUSED,
-                void *dummy3 SCM_UNUSED)
-{
-  if (!scm_is_null (to_rehash))
-    {
-      SCM first = to_rehash, last, h;
-      /* important to clear to_rehash here so that we don't get stuck
-        in an infinite loop if scm_i_rehash causes GC */
-      to_rehash = SCM_EOL;
-      h = first;
-      do
-       {
-         /* Rehash only when we have a hash_fn.
-          */
-         if (SCM_HASHTABLE (h)->hash_fn)
-           scm_i_rehash (h, SCM_HASHTABLE (h)->hash_fn, NULL,
-                         "rehash_after_gc");
-         last = h;
-         h = SCM_HASHTABLE_NEXT (h);
-       } while (!scm_is_null (h));
-      /* move tables back to weak_hashtables */
-      SCM_SET_HASHTABLE_NEXT (last, weak_hashtables);
-      weak_hashtables = first;
-    }
-  return 0;
-}
-
-static size_t
-hashtable_free (SCM obj)
-{
-  scm_gc_free (SCM_HASHTABLE (obj), sizeof (scm_t_hashtable), s_hashtable);
-  return 0;
-}
-
 
 SCM
 scm_c_make_hash_table (unsigned long k)
@@ -415,19 +434,34 @@ SCM
 scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM 
(*assoc_fn)(), void * closure)
 #define FUNC_NAME "scm_hash_fn_get_handle"
 {
+  int weak = 0;
   unsigned long k;
-  SCM h;
+  SCM buckets, alist, h;
 
   if (SCM_HASHTABLE_P (table))
-    table = SCM_HASHTABLE_VECTOR (table);
+    buckets = SCM_HASHTABLE_VECTOR (table);
   else
-    SCM_VALIDATE_VECTOR (1, table);
-  if (SCM_SIMPLE_VECTOR_LENGTH (table) == 0)
+    {
+      SCM_VALIDATE_VECTOR (1, table);
+      buckets = table;
+    }
+
+  if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0)
     return SCM_BOOL_F;
-  k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (table), closure);
-  if (k >= SCM_SIMPLE_VECTOR_LENGTH (table))
+  k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure);
+  if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range ("hash_fn_get_handle", scm_from_ulong (k));
-  h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (table, k), closure);
+
+  weak = IS_WEAK_THING (table);
+  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
+
+  if (weak)
+    START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+
+  h = assoc_fn (obj, alist, closure);
+  if (weak)
+    END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+
   return h;
 }
 #undef FUNC_NAME
@@ -438,8 +472,9 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, 
unsigned long (*hash_
                              SCM (*assoc_fn)(), void * closure)
 #define FUNC_NAME "scm_hash_fn_create_handle_x"
 {
+  int weak = 0;
   unsigned long k;
-  SCM buckets, it;
+  SCM buckets, alist, it;
 
   if (SCM_HASHTABLE_P (table))
     buckets = SCM_HASHTABLE_VECTOR (table);
@@ -455,7 +490,16 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, 
unsigned long (*hash_
   k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure);
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range ("hash_fn_create_handle_x", scm_from_ulong (k));
-  it = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
+
+  weak = IS_WEAK_THING (table);
+  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
+  if (weak)
+    START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+
+  it = assoc_fn (obj, alist, closure);
+  if (weak)
+    END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+
   if (scm_is_pair (it))
     return it;
   else if (scm_is_true (it))
@@ -468,7 +512,25 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, 
unsigned long (*hash_
         again since the hashtable might have been rehashed.  This
         necessitates a new hash value as well.
       */
-      SCM new_bucket = scm_acons (obj, init, SCM_EOL);
+      SCM handle, new_bucket;
+
+      if ((SCM_HASHTABLE_P (table)) && (SCM_HASHTABLE_WEAK_P (table)))
+       {
+         /* FIXME: We don't support weak alist vectors.  */
+         /* Use a weak cell.  */
+         if (SCM_HASHTABLE_DOUBLY_WEAK_P (table))
+           handle = scm_doubly_weak_pair (obj, init);
+         else if (SCM_HASHTABLE_WEAK_KEY_P (table))
+           handle = scm_weak_car_pair (obj, init);
+         else
+           handle = scm_weak_cdr_pair (obj, init);
+       }
+      else
+       /* Use a regular, non-weak cell.  */
+       handle = scm_cons (obj, init);
+
+      new_bucket = scm_cons (handle, SCM_EOL);
+
       if (!scm_is_eq (table, buckets)
          && !scm_is_eq (SCM_HASHTABLE_VECTOR (table), buckets))
        {
@@ -523,14 +585,15 @@ scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned 
long (*hash_fn)(),
 }
 
 
-SCM 
+SCM
 scm_hash_fn_remove_x (SCM table, SCM obj,
                      unsigned long (*hash_fn)(),
                      SCM (*assoc_fn)(),
                       void *closure)
 {
+  int weak = 0;
   unsigned long k;
-  SCM buckets, h;
+  SCM buckets, alist, h;
 
   if (SCM_HASHTABLE_P (table))
     buckets = SCM_HASHTABLE_VECTOR (table);
@@ -546,7 +609,16 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
   k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure);
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range ("hash_fn_remove_x", scm_from_ulong (k));
-  h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
+
+  weak = IS_WEAK_THING (table);
+  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
+  if (weak)
+    START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+
+  h = assoc_fn (obj, alist, closure);
+  if (weak)
+    END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+
   if (scm_is_true (h))
     {
       SCM_SIMPLE_VECTOR_SET 
@@ -921,21 +993,47 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM 
init, SCM table)
   if (SCM_HASHTABLE_P (table))
     buckets = SCM_HASHTABLE_VECTOR (table);
   else
+    /* Weak alist vector.  */
     buckets = table;
   
   n = SCM_SIMPLE_VECTOR_LENGTH (buckets);
   for (i = 0; i < n; ++i)
     {
-      SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle;
-      while (!scm_is_null (ls))
+      SCM prev, ls;
+
+      for (prev = SCM_BOOL_F, ls = SCM_SIMPLE_VECTOR_REF (buckets, i);
+          !scm_is_null (ls);
+          prev = ls, ls = SCM_CDR (ls))
        {
+         SCM handle;
+
          if (!scm_is_pair (ls))
            scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
+
          handle = SCM_CAR (ls);
          if (!scm_is_pair (handle))
            scm_wrong_type_arg (s_scm_hash_fold, SCM_ARG3, buckets);
+
+         if (IS_WEAK_THING (table))
+           {
+             if (SCM_WEAK_PAIR_DELETED_P (handle))
+               {
+                 /* We hit a weak pair whose car/cdr has become
+                    unreachable: unlink it from the bucket.  */
+                 if (prev != SCM_BOOL_F)
+                   SCM_SETCDR (prev, SCM_CDR (ls));
+                 else
+                   SCM_SIMPLE_VECTOR_SET (buckets, i, SCM_CDR (ls));
+
+                 if (SCM_HASHTABLE_P (table))
+                   /* Update the item count.  */
+                   SCM_HASHTABLE_DECREMENT (table);
+
+                 continue;
+               }
+           }
+
          result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
-         ls = SCM_CDR (ls);
        }
     }
 
@@ -1070,11 +1168,9 @@ SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 
0, 0,
 void
 scm_hashtab_prehistory ()
 {
+  /* Initialize the hashtab SMOB type.  */
   scm_tc16_hashtable = scm_make_smob_type (s_hashtable, 0);
-  scm_set_smob_mark (scm_tc16_hashtable, scm_markcdr);
   scm_set_smob_print (scm_tc16_hashtable, hashtable_print);
-  scm_set_smob_free (scm_tc16_hashtable, hashtable_free);
-  scm_c_hook_add (&scm_after_gc_c_hook, rehash_after_gc, 0, 0);
 }
 
 void
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 13100f0..8f8ebf9 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -40,9 +40,6 @@ SCM_API scm_t_bits scm_tc16_hashtable;
 #define SCM_HASHTABLE_VECTOR(h)  SCM_SMOB_OBJECT (h)
 #define SCM_SET_HASHTABLE_VECTOR(x, v) SCM_SET_SMOB_OBJECT ((x), (v))
 #define SCM_HASHTABLE(x)          ((scm_t_hashtable *) SCM_SMOB_DATA_2 (x))
-#define SCM_HASHTABLE_NEXT(x)     SCM_SMOB_OBJECT_3 (x)
-#define SCM_HASHTABLE_NEXTLOC(x)   SCM_SMOB_OBJECT_3_LOC (x)
-#define SCM_SET_HASHTABLE_NEXT(x, n) SCM_SET_SMOB_OBJECT_3 ((x), (n))
 #define SCM_HASHTABLE_FLAGS(x)    (SCM_HASHTABLE (x)->flags)
 #define SCM_HASHTABLE_WEAK_KEY_P(x) \
   (SCM_HASHTABLE_FLAGS (x) & SCM_HASHTABLEF_WEAK_CAR)
@@ -99,7 +96,6 @@ SCM_API SCM scm_doubly_weak_hash_table_p (SCM h);
 
 SCM_INTERNAL void scm_i_rehash (SCM table, unsigned long (*hash_fn)(),
                                void *closure, const char *func_name);
-SCM_INTERNAL void scm_i_scan_weak_hashtables (void);
 
 SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long 
(*hash_fn) (), SCM (*assoc_fn) (), void * closure);
 SCM_API SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, 
unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
diff --git a/libguile/hooks.c b/libguile/hooks.c
index d6b8981..c6541fa 100644
--- a/libguile/hooks.c
+++ b/libguile/hooks.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008, 2009 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
@@ -43,6 +43,9 @@
  * using C level hooks.
  */
 
+/* Hint for `scm_gc_malloc ()' and friends.  */
+static const char hook_entry_gc_hint[] = "hook entry";
+
 void
 scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
 {
@@ -57,8 +60,10 @@ scm_c_hook_add (scm_t_c_hook *hook,
                void *fn_data, 
                int appendp)
 {
-  scm_t_c_hook_entry *entry = scm_malloc (sizeof (scm_t_c_hook_entry));
+  scm_t_c_hook_entry *entry;
   scm_t_c_hook_entry **loc = &hook->first;
+
+  entry = scm_gc_malloc (sizeof (scm_t_c_hook_entry), hook_entry_gc_hint);
   if (appendp)
     while (*loc)
       loc = &(*loc)->next;
@@ -78,9 +83,7 @@ scm_c_hook_remove (scm_t_c_hook *hook,
     {
       if ((*loc)->func == func && (*loc)->data == fn_data)
        {
-         scm_t_c_hook_entry *entry = *loc;
          *loc = (*loc)->next;
-         free (entry);
          return;
        }
       loc = &(*loc)->next;
@@ -294,7 +297,6 @@ void
 scm_init_hooks ()
 {
   scm_tc16_hook = scm_make_smob_type ("hook", 0);
-  scm_set_smob_mark (scm_tc16_hook, scm_markcdr);
   scm_set_smob_print (scm_tc16_hook, hook_print);
 #include "libguile/hooks.x"
 }
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 7dcfa5a..fd15227 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2006, 2007, 2008, 2009 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
@@ -230,26 +230,6 @@ SCM_SMOB_FREE (scm_tc16_locale_smob_type, 
smob_locale_free, locale)
   return 0;
 }
 
-#ifndef USE_GNU_LOCALE_API
-static SCM
-smob_locale_mark (SCM locale)
-{
-  register SCM dependency;
-
-  if (!scm_is_eq (locale, SCM_VARIABLE_REF (scm_global_locale)))
-    {
-      scm_t_locale c_locale;
-
-      c_locale = (scm_t_locale) SCM_SMOB_DATA (locale);
-      dependency = (c_locale->base_locale);
-    }
-  else
-    dependency = SCM_BOOL_F;
-
-  return dependency;
-}
-#endif
-
 
 static void inline scm_locale_error (const char *, int) SCM_NORETURN;
 
@@ -1722,10 +1702,6 @@ scm_init_i18n ()
 
 #include "libguile/i18n.x"
 
-#ifndef USE_GNU_LOCALE_API
-  scm_set_smob_mark (scm_tc16_locale_smob_type, smob_locale_mark);
-#endif
-
   /* Initialize the global locale object with a special `locale' SMOB.  */
   SCM_NEWSMOB (global_locale_smob, scm_tc16_locale_smob_type, NULL);
   SCM_VARIABLE_SET (scm_global_locale, global_locale_smob);
diff --git a/libguile/init.c b/libguile/init.c
index da3bc0a..940d515 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -440,7 +440,9 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_ports_prehistory ();
   scm_smob_prehistory ();
   scm_fluids_prehistory ();
-  scm_hashtab_prehistory ();   /* requires storage_prehistory */
+  scm_weaks_prehistory ();
+  scm_hashtab_prehistory ();   /* requires storage_prehistory, and
+                                  weaks_prehistory */
 #ifdef GUILE_DEBUG_MALLOC
   scm_debug_malloc_prehistory ();
 #endif
diff --git a/libguile/inline.h b/libguile/inline.h
index 574bbfc..4943169 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -78,9 +78,15 @@
    "inline.c", when `inline' is not supported at all or when "extern inline"
    is used.  */
 
+#include "libguile/boehm-gc.h"
+
+
 SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
+SCM_API SCM scm_immutable_cell (scm_t_bits car, scm_t_bits cdr);
 SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
                             scm_t_bits ccr, scm_t_bits cdr);
+SCM_API SCM scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
+                                      scm_t_bits ccr, scm_t_bits cdr);
 
 SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
 SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM 
val);
@@ -107,64 +113,82 @@ extern unsigned scm_newcell_count;
 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 SCM_C_EXTERN_INLINE
 #endif
+
 SCM
 scm_cell (scm_t_bits car, scm_t_bits cdr)
 {
-  SCM z;
-  SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist);
+  SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC (sizeof (scm_t_cell))));
 
-  if (scm_is_null (*freelist))
-    z = scm_gc_for_newcell (&scm_i_master_freelist, freelist);
-  else
-    {
-      z = *freelist;
-      *freelist = SCM_FREE_CELL_CDR (*freelist);
-    }
+  /* Initialize the type slot last so that the cell is ignored by the GC
+     until it is completely initialized.  This is only relevant when the GC
+     can actually run during this code, which it can't since the GC only runs
+     when all other threads are stopped.  */
+  SCM_GC_SET_CELL_WORD (cell, 1, cdr);
+  SCM_GC_SET_CELL_WORD (cell, 0, car);
 
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-    if (scm_debug_cell_accesses_p)
-      {
-       if (SCM_GC_MARK_P (z))
-         {
-           fprintf(stderr, "scm_cell tried to allocate a marked cell.\n");
-           abort();
-         }
-       else if (SCM_GC_CELL_WORD(z, 0) != scm_tc_free_cell)
-         {
-           fprintf(stderr, "cell from freelist is not a free cell.\n");
-           abort();
-         }
-      }
-
-#if (SCM_DEBUG_MARKING_API == 0)
-    /*
-      Always set mark. Otherwise cells that are alloced before
-      scm_debug_cell_accesses_p is toggled seem invalid.
-    */
-    SCM_SET_GC_MARK (z);
-#endif /* SCM_DEBUG_MARKING_API */
-    
-    /*
-      TODO: figure out if this use of mark bits is valid with
-      threading. What if another thread is doing GC at this point
-      ... ?
-     */
+  return cell;
+}
+
+#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
+SCM_C_EXTERN_INLINE
+#endif
+SCM
+scm_immutable_cell (scm_t_bits car, scm_t_bits cdr)
+{
+  SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (sizeof 
(scm_t_cell))));
+
+  /* Initialize the type slot last so that the cell is ignored by the GC
+     until it is completely initialized.  This is only relevant when the GC
+     can actually run during this code, which it can't since the GC only runs
+     when all other threads are stopped.  */
+  SCM_GC_SET_CELL_WORD (cell, 1, cdr);
+  SCM_GC_SET_CELL_WORD (cell, 0, car);
+
+  GC_END_STUBBORN_CHANGE ((void *) cell);
+
+  return cell;
+}
+
+#ifndef SCM_INLINE_C_INCLUDING_INLINE_H
+SCM_C_EXTERN_INLINE
 #endif
+SCM
+scm_double_cell (scm_t_bits car, scm_t_bits cbr,
+                scm_t_bits ccr, scm_t_bits cdr)
+{
+  SCM z;
 
-  
+  z = SCM_PACK ((scm_t_bits) (GC_MALLOC (2 * sizeof (scm_t_cell))));
   /* Initialize the type slot last so that the cell is ignored by the
      GC until it is completely initialized.  This is only relevant
      when the GC can actually run during this code, which it can't
      since the GC only runs when all other threads are stopped.
   */
-  SCM_GC_SET_CELL_WORD (z, 1, cdr);
+  SCM_GC_SET_CELL_WORD (z, 1, cbr);
+  SCM_GC_SET_CELL_WORD (z, 2, ccr);
+  SCM_GC_SET_CELL_WORD (z, 3, cdr);
   SCM_GC_SET_CELL_WORD (z, 0, car);
 
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-  if (scm_expensive_debug_cell_accesses_p )
-    scm_i_expensive_validation_check (z);
+  /* When this function is inlined, it's possible that the last
+     SCM_GC_SET_CELL_WORD above will be adjacent to a following
+     initialization of z.  E.g., it occurred in scm_make_real.  GCC
+     from around version 3 (e.g., certainly 3.2) began taking
+     advantage of strict C aliasing rules which say that it's OK to
+     interchange the initialization above and the one below when the
+     pointer types appear to differ sufficiently.  We don't want that,
+     of course.  GCC allows this behaviour to be disabled with the
+     -fno-strict-aliasing option, but would also need to be supplied
+     by Guile users.  Instead, the following statements prevent the
+     reordering.
+   */
+#ifdef __GNUC__
+  __asm__ volatile ("" : : : "memory");
+#else
+  /* portable version, just in case any other compiler does the same
+     thing.  */
+  scm_remember_upto_here_1 (z);
 #endif
-  
+
   return z;
 }
 
@@ -172,20 +196,12 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
 SCM_C_EXTERN_INLINE
 #endif
 SCM
-scm_double_cell (scm_t_bits car, scm_t_bits cbr,
-                scm_t_bits ccr, scm_t_bits cdr)
+scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
+                          scm_t_bits ccr, scm_t_bits cdr)
 {
   SCM z;
-  SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist2);
-
-  if (scm_is_null (*freelist))
-    z = scm_gc_for_newcell (&scm_i_master_freelist2, freelist);
-  else
-    {
-      z = *freelist;
-      *freelist = SCM_FREE_CELL_CDR (*freelist);
-    }
 
+  z = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (2 * sizeof (scm_t_cell))));
   /* Initialize the type slot last so that the cell is ignored by the
      GC until it is completely initialized.  This is only relevant
      when the GC can actually run during this code, which it can't
@@ -196,22 +212,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
   SCM_GC_SET_CELL_WORD (z, 3, cdr);
   SCM_GC_SET_CELL_WORD (z, 0, car);
 
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-  if (scm_debug_cell_accesses_p)
-    {
-      if (SCM_GC_MARK_P (z))
-       {
-         fprintf(stderr,
-                 "scm_double_cell tried to allocate a marked cell.\n");
-         abort();
-       }
-    }
-#if (SCM_DEBUG_MARKING_API == 0)
-  /* see above. */
-  SCM_SET_GC_MARK (z);
-#endif /* SCM_DEBUG_MARKING_API */
-  
-#endif
+  GC_END_STUBBORN_CHANGE ((void *) z);
 
   /* When this function is inlined, it's possible that the last
      SCM_GC_SET_CELL_WORD above will be adjacent to a following
diff --git a/libguile/keywords.c b/libguile/keywords.c
index ee4c3ff..c415ccb 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -115,7 +115,6 @@ void
 scm_init_keywords ()
 {
   scm_tc16_keyword = scm_make_smob_type ("keyword", 0);
-  scm_set_smob_mark (scm_tc16_keyword, scm_markcdr);
   scm_set_smob_print (scm_tc16_keyword, keyword_print);
 
   scm_keyword_obarray = scm_c_make_hash_table (0);
diff --git a/libguile/load.c b/libguile/load.c
index 41db90c..f2c06f0 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2009 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008, 2009 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
@@ -71,7 +71,7 @@ static SCM *scm_loc_load_hook;
 
 /* The current reader (a fluid).  */
 static SCM the_reader = SCM_BOOL_F;
-static size_t the_reader_fluid_num = 0;
+
 
 SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, 
            (SCM filename),
@@ -113,7 +113,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
 
        /* Lookup and use the current reader to read the next
           expression. */
-       reader = SCM_FAST_FLUID_REF (the_reader_fluid_num);
+       reader = scm_fluid_ref (the_reader);
        if (reader == SCM_BOOL_F)
          form = scm_read (port);
        else
@@ -819,8 +819,7 @@ scm_init_load ()
     = SCM_VARIABLE_LOC (scm_c_define ("%load-should-autocompile", SCM_BOOL_F));
 
   the_reader = scm_make_fluid ();
-  the_reader_fluid_num = SCM_FLUID_NUM (the_reader);
-  SCM_FAST_FLUID_SET_X (the_reader_fluid_num, SCM_BOOL_F);
+  scm_fluid_set_x (the_reader, SCM_BOOL_F);
   scm_c_define("current-reader", the_reader);
 
   init_build_info ();
diff --git a/libguile/macros.c b/libguile/macros.c
index a6a4c3e..3e0942c 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008 Free 
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003, 2006, 2008, 2009 
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
@@ -98,16 +98,6 @@ macro_print (SCM macro, SCM port, scm_print_state *pstate)
 }
 
 static SCM
-macro_mark (SCM macro)
-{
-  if (SCM_MACRO_IS_EXTENDED (macro))
-    { scm_gc_mark (SCM_SMOB_OBJECT_2 (macro));
-      scm_gc_mark (SCM_SMOB_OBJECT_3 (macro));
-    }
-  return SCM_SMOB_OBJECT (macro);
-}
-
-static SCM
 makmac (SCM code, scm_t_bits flags)
 {
   SCM z;
@@ -339,7 +329,6 @@ void
 scm_init_macros ()
 {
   scm_tc16_macro = scm_make_smob_type ("macro", 0);
-  scm_set_smob_mark (scm_tc16_macro, macro_mark);
   scm_set_smob_print (scm_tc16_macro, macro_print);
 #include "libguile/macros.x"
 }
diff --git a/libguile/mallocs.c b/libguile/mallocs.c
index 296b312..6a366ae 100644
--- a/libguile/mallocs.c
+++ b/libguile/mallocs.c
@@ -42,14 +42,6 @@
 scm_t_bits scm_tc16_malloc;
 
 
-static size_t
-malloc_free (SCM ptr)
-{
-  if (SCM_MALLOCDATA (ptr))
-    free (SCM_MALLOCDATA (ptr));
-  return 0;
-}
-
 
 static int
 malloc_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -72,11 +64,10 @@ scm_malloc_obj (size_t n)
 
 
 
-void 
+void
 scm_init_mallocs ()
 {
   scm_tc16_malloc = scm_make_smob_type ("malloc", 0);
-  scm_set_smob_free (scm_tc16_malloc, malloc_free);
   scm_set_smob_print (scm_tc16_malloc, malloc_print);
 }
 
diff --git a/libguile/modules.c b/libguile/modules.c
index ecd136d..deae23a 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -256,7 +256,13 @@ scm_lookup_closure_module (SCM proc)
     return SCM_PACK (SCM_SMOB_DATA (proc));
   else
     {
-      SCM mod = scm_procedure_property (proc, sym_module);
+      SCM mod;
+
+      /* FIXME: The `module' property is no longer set.  See
+        `set-module-eval-closure!' in `boot-9.scm'.  */
+      abort ();
+
+      mod = scm_procedure_property (proc, sym_module);
       if (scm_is_false (mod))
        mod = the_root_module ();
       return mod;
@@ -821,8 +827,18 @@ SCM_DEFINE (scm_module_reverse_lookup, 
"module-reverse-lookup", 2, 0, 0,
       while (!scm_is_null (ls))
        {
          handle = SCM_CAR (ls);
-         if (SCM_CDR (handle) == variable)
-           return SCM_CAR (handle);
+
+         if (SCM_CAR (handle) == SCM_PACK (NULL))
+           {
+             /* FIXME: We hit a weak pair whose car has become unreachable.
+                We should remove the pair in question or something.  */
+           }
+         else
+           {
+             if (SCM_CDR (handle) == variable)
+               return SCM_CAR (handle);
+           }
+
          ls = SCM_CDR (ls);
        }
     }
@@ -882,7 +898,6 @@ scm_init_modules ()
   module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
                                            SCM_UNDEFINED);
   scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0);
-  scm_set_smob_mark (scm_tc16_eval_closure, scm_markcdr);
   scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0);
 
   the_module = scm_permanent_object (scm_make_fluid ());
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 5812576..20fda02 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -5364,8 +5364,9 @@ scm_c_make_rectangular (double re, double im)
   else
     {
       SCM z;
-      SCM_NEWSMOB (z, scm_tc16_complex, scm_gc_malloc (sizeof (scm_t_complex),
-                                                      "complex"));
+      SCM_NEWSMOB (z, scm_tc16_complex,
+                  scm_gc_malloc_pointerless (sizeof (scm_t_complex),
+                                             "complex"));
       SCM_COMPLEX_REAL (z) = re;
       SCM_COMPLEX_IMAG (z) = im;
       return z;
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 5466ecc..be34232 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -135,12 +135,6 @@ scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 
*ptr)
 }
 #undef FUNC_NAME
 
-static SCM
-objcode_mark (SCM obj)
-{
-  return SCM_SMOB_OBJECT_2 (obj);
-}
-
 
 /*
  * Scheme interface
@@ -235,8 +229,8 @@ SCM_DEFINE (scm_objcode_to_bytecode, "objcode->bytecode", 
1, 0, 0,
   SCM_VALIDATE_OBJCODE (1, objcode);
 
   len = sizeof(struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
-  /* FIXME:  Is `gc_malloc' ok here? */
-  u8vector = scm_gc_malloc (len, "objcode-u8vector");
+
+  u8vector = scm_malloc (len);
   memcpy (u8vector, SCM_OBJCODE_DATA (objcode), len);
 
   return scm_take_u8vector (u8vector, len);
@@ -264,7 +258,6 @@ void
 scm_bootstrap_objcodes (void)
 {
   scm_tc16_objcode = scm_make_smob_type ("objcode", 0);
-  scm_set_smob_mark (scm_tc16_objcode, objcode_mark);
   scm_c_register_extension ("libguile", "scm_init_objcodes",
                             (scm_t_extension_init_func)scm_init_objcodes, 
NULL);
 }
diff --git a/libguile/objects.c b/libguile/objects.c
index e82fb9d..f686c3a 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -359,7 +359,6 @@ scm_init_objects ()
   scm_c_define ("<operator-class>", ot);
   scm_metaclass_operator = ot;
   SCM_SET_CLASS_FLAGS (et, SCM_CLASSF_OPERATOR | SCM_CLASSF_ENTITY);
-  SCM_SET_CLASS_DESTRUCTOR (et, scm_struct_free_entity);
   scm_c_define ("<entity>", et);
 
 #include "libguile/objects.x"
diff --git a/libguile/ports.c b/libguile/ports.c
index 35046dd..58c7cd0 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -34,6 +34,8 @@
 #include <unistr.h>
 #include <striconveh.h>
 
+#include <assert.h>
+
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/eval.h"
@@ -60,10 +62,6 @@
 #include <string.h>
 #endif
 
-#ifdef HAVE_MALLOC_H
-#include <malloc.h>
-#endif
-
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
@@ -144,9 +142,11 @@ scm_make_port_type (char *name,
   if (SCM_I_MAX_PORT_TYPE_COUNT - 1 <= scm_numptob)
     goto ptoberr;
   SCM_CRITICAL_SECTION_START;
-  SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs,
-                                      (1 + scm_numptob)
-                                      * sizeof (scm_t_ptob_descriptor)));
+  tmp = (char *) scm_gc_realloc ((char *) scm_ptobs,
+                                scm_numptob * sizeof (scm_t_ptob_descriptor),
+                                (1 + scm_numptob)
+                                * sizeof (scm_t_ptob_descriptor),
+                                "port-type");
   if (tmp)
     {
       scm_ptobs = (scm_t_ptob_descriptor *) tmp;
@@ -509,8 +509,69 @@ SCM scm_i_port_weak_hash;
 
 scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
-/* This function is not and should not be thread safe. */
+
+/* Port finalization.  */
+
+
+static void finalize_port (GC_PTR, GC_PTR);
+
+/* Register a finalizer for PORT, if needed by its port type.  */
+static SCM_C_INLINE_KEYWORD void
+register_finalizer_for_port (SCM port)
+{
+  long port_type;
+
+  port_type = SCM_TC2PTOBNUM (SCM_CELL_TYPE (port));
+  if (scm_ptobs[port_type].free)
+    {
+      GC_finalization_proc prev_finalizer;
+      GC_PTR prev_finalization_data;
+
+      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (port), finalize_port, 0,
+                                     &prev_finalizer,
+                                     &prev_finalization_data);
+    }
+}
+
+/* Finalize the object (a port) pointed to by PTR.  */
+static void
+finalize_port (GC_PTR ptr, GC_PTR data)
+{
+  long port_type;
+  SCM port = PTR2SCM (ptr);
+
+  if (!SCM_PORTP (port))
+    abort ();
+
+  if (SCM_OPENP (port))
+    {
+      if (SCM_REVEALED (port) > 0)
+       /* Keep "revealed" ports alive and re-register a finalizer.  */
+       register_finalizer_for_port (port);
+      else
+       {
+         port_type = SCM_TC2PTOBNUM (SCM_CELL_TYPE (port));
+         if (port_type >= scm_numptob)
+           abort ();
 
+         if (scm_ptobs[port_type].free)
+           /* Yes, I really do mean `.free' rather than `.close'.  `.close'
+              is for explicit `close-port' by user.  */
+           scm_ptobs[port_type].free (port);
+
+         SCM_SETSTREAM (port, 0);
+         SCM_CLR_PORT_OPEN_FLAG (port);
+
+         scm_gc_ports_collected++;
+       }
+    }
+}
+
+
+
+
+
+/* This function is not and should not be thread safe. */
 SCM
 scm_new_port_table_entry (scm_t_bits tag)
 #define FUNC_NAME "scm_new_port_table_entry"
@@ -540,6 +601,10 @@ scm_new_port_table_entry (scm_t_bits tag)
 
   scm_hashq_set_x (scm_i_port_weak_hash, z, SCM_BOOL_F);
 
+  /* For each new port, register a finalizer so that it port type's free
+     function can be invoked eventually.  */
+  register_finalizer_for_port (z);
+
   return z;
 }
 #undef FUNC_NAME
@@ -1393,10 +1458,11 @@ scm_c_write (SCM port, const void *ptr, size_t size)
 }
 #undef FUNC_NAME
 
-void 
+void
 scm_flush (SCM port)
 {
   long i = SCM_PTOBNUM (port);
+  assert (i >= 0);
   (scm_ptobs[i].flush) (port);
 }
 
@@ -1438,6 +1504,8 @@ scm_unget_byte (int c, SCM port)
        {
          size_t new_size = pt->read_buf_size * 2;
          unsigned char *tmp = (unsigned char *)
+           /* XXX: Can we use `GC_REALLOC' with `GC_MALLOC_ATOMIC'-allocated
+              data?  (Ludo)  */
            scm_gc_realloc (pt->putback_buf, pt->read_buf_size, new_size,
                            "putback buffer");
 
@@ -1465,8 +1533,8 @@ scm_unget_byte (int c, SCM port)
       if (pt->putback_buf == NULL)
        {
          pt->putback_buf
-           = (unsigned char *) scm_gc_malloc (SCM_INITIAL_PUTBACK_BUF_SIZE,
-                                              "putback buffer");
+           = (unsigned char *) scm_gc_malloc_pointerless
+           (SCM_INITIAL_PUTBACK_BUF_SIZE, "putback buffer");
          pt->putback_buf_size = SCM_INITIAL_PUTBACK_BUF_SIZE;
        }
 
@@ -2216,7 +2284,7 @@ void
 scm_ports_prehistory ()
 {
   scm_numptob = 0;
-  scm_ptobs = (scm_t_ptob_descriptor *) scm_malloc (sizeof 
(scm_t_ptob_descriptor));
+  scm_ptobs = NULL;
 }
 
 
diff --git a/libguile/ports.h b/libguile/ports.h
index c75f17d..0f46e7f 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -201,7 +201,6 @@ typedef struct scm_t_ptob_descriptor
 
 SCM_API scm_t_ptob_descriptor *scm_ptobs;
 SCM_API long scm_numptob;
-SCM_INTERNAL long scm_i_port_table_room;
 
 
 
diff --git a/libguile/posix.c b/libguile/posix.c
index 09d53f2..7546953 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 
2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 
2006, 2007, 2008, 2009 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
@@ -1105,12 +1105,6 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_TCSETPGRP */
 
-static void
-free_string_pointers (void *data)
-{
-  scm_i_free_string_pointers ((char **)data);
-}
-
 SCM_DEFINE (scm_execl, "execl", 1, 0, 1, 
             (SCM filename, SCM args),
            "Executes the file named by @var{path} as a new process image.\n"
@@ -1133,8 +1127,6 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
   scm_dynwind_free (exec_file);
 
   exec_argv = scm_i_allocate_string_pointers (args);
-  scm_dynwind_unwind_handler (free_string_pointers, exec_argv, 
-                           SCM_F_WIND_EXPLICITLY);
 
   execv (exec_file,
 #ifdef __MINGW32__
@@ -1169,8 +1161,6 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
   scm_dynwind_free (exec_file);
 
   exec_argv = scm_i_allocate_string_pointers (args);
-  scm_dynwind_unwind_handler (free_string_pointers, exec_argv, 
-                           SCM_F_WIND_EXPLICITLY);
 
   execvp (exec_file,
 #ifdef __MINGW32__
@@ -1209,12 +1199,7 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
   scm_dynwind_free (exec_file);
 
   exec_argv = scm_i_allocate_string_pointers (args);
-  scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
-                           SCM_F_WIND_EXPLICITLY);
-
   exec_env = scm_i_allocate_string_pointers (env);
-  scm_dynwind_unwind_handler (free_string_pointers, exec_env,
-                           SCM_F_WIND_EXPLICITLY);
 
   execve (exec_file,
 #ifdef __MINGW32__
@@ -1298,19 +1283,7 @@ SCM_DEFINE (scm_environ, "environ", 0, 1, 0,
     return scm_makfromstrs (-1, environ);
   else
     {
-      char **new_environ;
-
-      new_environ = scm_i_allocate_string_pointers (env);
-      /* Free the old environment, except when called for the first
-       * time.
-       */
-      {
-       static int first = 1;
-       if (!first)
-         scm_i_free_string_pointers (environ);
-       first = 0;
-      }
-      environ = new_environ;
+      environ = scm_i_allocate_string_pointers (env);
       return SCM_UNSPECIFIED;
     }
 }
diff --git a/libguile/print.c b/libguile/print.c
index 23e48e3..1dc97c2 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -752,6 +752,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
            scm_puts ("#w(", port);
          goto common_vector_printer;
 
+       case scm_tc7_bytevector:
+         scm_i_print_bytevector (exp, port, pstate);
+         break;
        case scm_tc7_vector:
          ENTER_NESTED_DATA (pstate, exp, circref);
          scm_puts ("#(", port);
@@ -766,16 +769,30 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                last = pstate->length - 1;
                cutp = 1;
              }
-           for (i = 0; i < last; ++i)
+           if (SCM_I_WVECTP (exp))
              {
-               /* CHECK_INTS; */
-               scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
-               scm_putc (' ', port);
+               /* Elements of weak vectors may not be accessed via the
+                  `SIMPLE_VECTOR_REF ()' macro.  */
+               for (i = 0; i < last; ++i)
+                 {
+                   scm_iprin1 (scm_c_vector_ref (exp, i),
+                               port, pstate);
+                   scm_putc (' ', port);
+                 }
              }
+           else
+             {
+               for (i = 0; i < last; ++i)
+                 {
+                   scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
+                   scm_putc (' ', port);
+                 }
+             }
+
            if (i == last)
              {
                /* CHECK_INTS; */
-               scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate);
+               scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate);
              }
            if (cutp)
              scm_puts (" ...", port);
@@ -922,7 +939,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port)
 {
   scm_puts ("#<unknown-", port);
   scm_puts (hdr, port);
-  if (scm_in_heap_p (ptr))
+  if (1) /* (scm_in_heap_p (ptr)) */ /* FIXME */
     {
       scm_puts (" (0x", port);
       scm_uintprint (SCM_CELL_WORD_0 (ptr), 16, port);
@@ -1313,7 +1330,6 @@ scm_init_print ()
 
   /* Don't want to bind a wrapper class in GOOPS, so pass 0 as arg1. */
   scm_tc16_port_with_ps = scm_make_smob_type (0, 0);
-  scm_set_smob_mark (scm_tc16_port_with_ps, scm_markcdr);
   scm_set_smob_print (scm_tc16_port_with_ps, port_with_ps_print);
 
 #include "libguile/print.x"
diff --git a/libguile/private-gc.h b/libguile/private-gc.h
index ac22de5..42514c1 100644
--- a/libguile/private-gc.h
+++ b/libguile/private-gc.h
@@ -19,8 +19,8 @@
  * 02110-1301 USA
  */
 
-#ifndef PRIVATE_GC
-#define PRIVATE_GC
+#ifndef SCM_PRIVATE_GC
+#define SCM_PRIVATE_GC
 
 #include  "_scm.h"
 
@@ -32,119 +32,19 @@
  * Each heap cell is 8 bytes on a 32 bit machine and 16 bytes on a
  * 64 bit machine.  The units of the _SIZE parameters are bytes.
  * Cons pairs and object headers occupy one heap cell.
- *
- * SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap
- * is needed.
- */
-
-
-/*
- * Heap size 45000 and 40% min yield gives quick startup and no extra
- * heap allocation.  Having higher values on min yield may lead to
- * large heaps, especially if code behaviour is varying its
- * maximum consumption between different freelists.
  */
 
-/*
-  These values used to be global C variables. However, they're also
-  available through the environment, and having a double interface is
-  confusing. Now they're #defines --hwn.
- */
 
-#define SCM_DEFAULT_INIT_HEAP_SIZE_1  256*1024
-#define SCM_DEFAULT_MIN_YIELD_1 40
 #define SCM_DEFAULT_INIT_HEAP_SIZE_2 32*1024
 
-/*
-  How many cells to collect during one sweep call. This is the pool
-  size of each thread.
- */
-#define DEFAULT_SWEEP_AMOUNT 512
-
-/* 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
- */
-#define SCM_DEFAULT_MIN_YIELD_2 40
-
-#define SCM_DEFAULT_MAX_SEGMENT_SIZE  (20*1024*1024L)
-
-#define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_SIZEOF_CARD)
-#define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell))
-
 #define SCM_DOUBLECELL_ALIGNED_P(x)  (((2 * sizeof (scm_t_cell) - 1) & 
SCM_UNPACK (x)) == 0)
 
 
-#define SCM_GC_CARD_BVEC_SIZE_IN_LONGS \
-    ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LONG_BITS - 1) / SCM_C_BVEC_LONG_BITS)
-#define SCM_GC_IN_CARD_HEADERP(x) \
-  (scm_t_cell *) (x) <  SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS
-
-int scm_getenv_int (const char *var, int def);
+SCM_INTERNAL int scm_getenv_int (const char *var, int def);
 
 
 typedef enum { return_on_error, abort_on_error } policy_on_error;
 
-/* gc-freelist */
-
-/*
-  FREELIST:
-
-  A struct holding GC statistics on a particular type of cells.
-
-  Counts in cells are mainly for heap statistics, and for
-  double-cells, they are still measured in single-cell units.
-*/
-typedef struct scm_t_cell_type_statistics {
-  /*
-    heap segment where the last cell was allocated 
-  */
-  int heap_segment_idx;
-
-  /* defines min_yield as fraction of total heap size
-   */
-  float min_yield_fraction;
-  
-  /* number of cells per object on this list */
-  int span;
-
-  /* number of collected cells during last GC. */
-  unsigned long collected;
-
-  unsigned long swept;
-  
-  /*
-    Total number of cells in heap segments belonging to this list.
-   */
-  unsigned long heap_total_cells;
-} scm_t_cell_type_statistics;
-
-
-/* Sweep statistics.  */
-typedef struct scm_sweep_statistics
-{
-  /* Number of cells "swept", i.e., visited during the sweep operation.  */
-  unsigned swept;
-
-  /* Number of cells collected during the sweep operation.  This number must
-     always be lower than or equal to SWEPT.  */
-  unsigned collected;
-} scm_t_sweep_statistics;
-
-SCM_INTERNAL scm_t_sweep_statistics scm_i_gc_sweep_stats;
-
-
-extern scm_t_cell_type_statistics scm_i_master_freelist;
-extern scm_t_cell_type_statistics scm_i_master_freelist2;
-
-SCM_INTERNAL
-void scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist,
-                            scm_t_sweep_statistics sweep_stats,
-                            scm_t_sweep_statistics sweep_stats_1);
-SCM_INTERNAL
-void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist);
-SCM_INTERNAL float
-scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist);
-
 
 #define SCM_MAX(A, B) ((A) > (B) ? (A) : (B))
 #define SCM_MIN(A, B) ((A) < (B) ? (A) : (B))
@@ -161,129 +61,6 @@ scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * 
freelist);
 */
 #define CELL_P(x)  ((SCM_UNPACK(x) & (sizeof(scm_t_cell)-1)) == scm_tc3_cons)
 
-/*
-  gc-mark
- */
-
-/* Non-zero while in the mark phase.  */
-SCM_INTERNAL int scm_i_marking;
-
-SCM_INTERNAL void scm_mark_all (void);
-
-/*
-gc-segment:
-*/
-
-/*
-
- Cells are stored in a heap-segment: it is a contiguous chunk of
- memory, that associated with one freelist. 
-*/
-typedef struct scm_t_heap_segment
-{
-  /*
-    {lower, upper} bounds of the segment
-
-    The upper bound is also the start of the mark space.
-  */
-  scm_t_cell *bounds[2];
-
-  /*
-    If we ever decide to give it back, we could do it with this ptr.
-
-    Note that giving back memory is not very useful; as long we don't
-    touch a chunk of memory, the virtual memory system will keep it
-    swapped out. We could simply forget about a block.
-
-    (not that we do that, but anyway.) 
-   */
-  void *malloced;
-
-  scm_t_cell *next_free_card;
-  
-  /* address of the head-of-freelist pointer for this segment's cells.
-     All segments usually point to the same one, scm_i_freelist.  */
-  scm_t_cell_type_statistics *freelist;
-  
-  /* number of cells per object in this segment */
-  int span;
-
-  /*
-    Is this the first time that the cells are accessed? 
-   */
-  int first_time;
-} scm_t_heap_segment;
-
-/*
-  A table of segment records is kept that records the upper and
-  lower extents of the segment;  this is used during the conservative
-  phase of gc to identify probably gc roots (because they point
-  into valid segments at reasonable offsets).
-*/
-extern scm_t_heap_segment ** scm_i_heap_segment_table;
-extern size_t scm_i_heap_segment_table_size;
-
-
-SCM_INTERNAL int scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,
-                                          scm_t_heap_segment*);
-SCM_INTERNAL int scm_i_sweep_card (scm_t_cell *card, SCM *free_list,
-                                  scm_t_heap_segment *);
-SCM_INTERNAL int scm_i_card_marked_count (scm_t_cell *card, int span);
-SCM_INTERNAL void scm_i_card_statistics (scm_t_cell *p, SCM hashtab,
-                                        scm_t_heap_segment *seg);
 SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */
 
-SCM_INTERNAL int scm_i_initialize_heap_segment_data (scm_t_heap_segment *seg,
-                                                    size_t requested);
-
-SCM_INTERNAL int scm_i_segment_cells_per_card (scm_t_heap_segment *seg);
-SCM_INTERNAL int scm_i_segment_card_number (scm_t_heap_segment *seg,
-                                           scm_t_cell *card);
-SCM_INTERNAL int scm_i_segment_card_count (scm_t_heap_segment *seg);
-SCM_INTERNAL int scm_i_segment_cell_count (scm_t_heap_segment *seg);
-SCM_INTERNAL int scm_i_heap_segment_marked_count (scm_t_heap_segment *seg);
-  
-SCM_INTERNAL void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg);
-SCM_INTERNAL scm_t_heap_segment *
-scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*);
-SCM_INTERNAL SCM scm_i_sweep_for_freelist (scm_t_cell_type_statistics *seg);
-SCM_INTERNAL SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg,
-                                        scm_t_sweep_statistics *sweep_stats,
-                                        int threshold);
-SCM_INTERNAL void scm_i_sweep_segment (scm_t_heap_segment *seg,
-                                      scm_t_sweep_statistics *sweep_stats);
-
-SCM_INTERNAL void scm_i_heap_segment_statistics (scm_t_heap_segment *seg,
-                                                SCM tab);
-
-
-SCM_INTERNAL int scm_i_insert_segment (scm_t_heap_segment *seg);
-SCM_INTERNAL int scm_i_find_heap_segment_containing_object (SCM obj);
-SCM_INTERNAL int scm_i_get_new_heap_segment (scm_t_cell_type_statistics 
*freelist,
-                                            size_t length, 
-                                            policy_on_error);
-SCM_INTERNAL int scm_i_marked_count (void);
-SCM_INTERNAL void scm_i_clear_mark_space (void);
-SCM_INTERNAL void scm_i_sweep_segments (void);
-SCM_INTERNAL SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl,
-                                           scm_t_sweep_statistics 
*sweep_stats);
-SCM_INTERNAL void scm_i_reset_segments (void);
-SCM_INTERNAL void scm_i_sweep_all_segments (char const *reason,
-                                           scm_t_sweep_statistics 
*sweep_stats);
-SCM_INTERNAL SCM scm_i_all_segments_statistics (SCM hashtab);
-SCM_INTERNAL unsigned long *scm_i_segment_table_info(int *size);
-
-SCM_INTERNAL long int scm_i_deprecated_memory_return;
-SCM_INTERNAL long int scm_i_find_heap_calls;
-SCM_INTERNAL long int scm_i_last_marked_cell_count;
-
-/*
-  global init funcs.
- */
-void scm_gc_init_malloc (void);
-void scm_gc_init_freelist (void);
-void scm_gc_init_segments (void);
-void scm_gc_init_mark (void);
-
-
 #endif
diff --git a/libguile/procs.c b/libguile/procs.c
index 815e29f..40d6231 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -70,15 +70,6 @@ scm_c_define_subr (const char *name, long type, SCM (*fcn) 
())
   return subr;
 }
 
-/* This function isn't currently used since subrs are never freed. */
-/* *fixme* Need mutex here. */
-void
-scm_free_subr_entry (SCM subr)
-{
-  scm_gc_free (SCM_SUBR_META_INFO (subr), 2 * sizeof (SCM),
-              "subr meta-info");
-}
-
 SCM
 scm_c_make_subr_with_generic (const char *name, 
                              long type, SCM (*fcn) (), SCM *gf)
diff --git a/libguile/procs.h b/libguile/procs.h
index ed4ac20..469b735 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -34,7 +34,6 @@
 #define SCM_SUBR_META_INFO(x)  ((SCM *) SCM_CELL_WORD_3 (x))
 #define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0])
 #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
-#define SCM_SET_SUBRF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
 #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x))
 #define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
 #define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x))
@@ -51,10 +50,7 @@
 #define SCM_CLOSURE_BODY(x) SCM_CDR (SCM_CODE (x))
 #define SCM_PROCPROPS(x) SCM_CDR (SCM_CLOSCAR (x))
 #define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p)
-#define SCM_SETCODE(x, e) (SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (scm_cons ((e), 
SCM_EOL)) \
-                           + scm_tc3_closure))
 #define SCM_ENV(x) SCM_CELL_OBJECT_1 (x)
-#define SCM_SETENV(x, e) SCM_SET_CELL_OBJECT_1 ((x), (e))
 #define SCM_TOP_LEVEL(ENV)  (scm_is_null (ENV) || (scm_is_true 
(scm_procedure_p (SCM_CAR (ENV)))))
 
 /* Procedure-with-setter
@@ -108,10 +104,6 @@
 #define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj)
 #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
 
-
-
-
-SCM_API void scm_free_subr_entry (SCM subr);
 SCM_API SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)());
 SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type,
                                          SCM (*fcn)(), SCM *gf);
diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h
index d5d838b..4f72a42 100644
--- a/libguile/pthread-threads.h
+++ b/libguile/pthread-threads.h
@@ -29,6 +29,9 @@
 #include <pthread.h>
 #include <sched.h>
 
+/* `libgc' intercepts pthread calls by defining wrapping macros.  */
+#include "libguile/boehm-gc.h"
+
 /* Threads 
 */
 #define scm_i_pthread_t                     pthread_t
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index e3aa99e..6ad320a 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -104,13 +104,6 @@ make_bip (SCM bv)
   return port;
 }
 
-static SCM
-bip_mark (SCM port)
-{
-  /* Mark the underlying bytevector.  */
-  return (SCM_PACK (SCM_STREAM (port)));
-}
-
 static int
 bip_fill_input (SCM port)
 {
@@ -176,7 +169,6 @@ initialize_bytevector_input_ports (void)
     scm_make_port_type ("r6rs-bytevector-input-port", bip_fill_input,
                        NULL);
 
-  scm_set_port_mark (bytevector_input_port_type, bip_mark);
   scm_set_port_seek (bytevector_input_port_type, bip_seek);
 }
 
@@ -207,16 +199,6 @@ SCM_DEFINE (scm_open_bytevector_input_port,
 #define SCM_CBP_CLOSE_PROC(_port)                              \
   SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 3)
 
-static SCM
-cbp_mark (SCM port)
-{
-  /* Mark the underlying method and object vector.  */
-  if (SCM_OPENP (port))
-    return SCM_PACK (SCM_STREAM (port));
-  else
-    return SCM_BOOL_F;
-}
-
 static scm_t_off
 cbp_seek (SCM port, scm_t_off offset, int whence)
 #define FUNC_NAME "cbp_seek"
@@ -421,7 +403,6 @@ initialize_custom_binary_input_ports (void)
     scm_make_port_type ("r6rs-custom-binary-input-port",
                        cbip_fill_input, NULL);
 
-  scm_set_port_mark (custom_binary_input_port_type, cbp_mark);
   scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
   scm_set_port_close (custom_binary_input_port_type, cbp_close);
 }
@@ -581,7 +562,7 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 
1, 0, 0,
   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 
   c_len = 4096;
-  c_bv = (char *) scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+  c_bv = (char *) scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
   c_total = 0;
 
   do
@@ -645,7 +626,7 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 
1, 0, 0,
   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
 
   c_len = c_count = 4096;
-  c_bv = (char *) scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+  c_bv = (char *) scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
   c_total = c_read = 0;
 
   do
@@ -817,7 +798,7 @@ bop_buffer_grow (scm_t_bop_buffer *buf, size_t min_size)
     new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
                              new_size, SCM_GC_BOP);
   else
-    new_buf = scm_gc_malloc (new_size, SCM_GC_BOP);
+    new_buf = scm_gc_malloc_pointerless (new_size, SCM_GC_BOP);
 
   buf->buffer = new_buf;
   buf->total_len = new_size;
@@ -852,23 +833,6 @@ make_bop (void)
   return (scm_values (scm_list_2 (port, bop_proc)));
 }
 
-static size_t
-bop_free (SCM port)
-{
-  /* The port itself is necessarily freed _after_ the bop proc, since the bop
-     proc holds a reference to it.  Thus we can safely free the internal
-     buffer when the bop becomes unreferenced.  */
-  scm_t_bop_buffer *buf;
-
-  buf = SCM_BOP_BUFFER (port);
-  if (buf->buffer)
-    scm_gc_free (buf->buffer, buf->total_len, SCM_GC_BOP);
-
-  scm_gc_free (buf, sizeof (* buf), SCM_GC_BOP);
-
-  return 0;
-}
-
 /* Write SIZE octets from DATA to PORT.  */
 static void
 bop_write (SCM port, const void *data, size_t size)
@@ -952,14 +916,6 @@ SCM_SMOB_APPLY (bytevector_output_port_procedure,
   return bv;
 }
 
-SCM_SMOB_MARK (bytevector_output_port_procedure, bop_proc_mark,
-              bop_proc)
-{
-  /* Mark the port associated with BOP_PROC.  */
-  return (SCM_PACK (SCM_SMOB_DATA (bop_proc)));
-}
-
-
 SCM_DEFINE (scm_open_bytevector_output_port,
            "open-bytevector-output-port", 0, 1, 0,
            (SCM transcoder),
@@ -983,7 +939,6 @@ initialize_bytevector_output_ports (void)
                        NULL, bop_write);
 
   scm_set_port_seek (bytevector_output_port_type, bop_seek);
-  scm_set_port_free (bytevector_output_port_type, bop_free);
 }
 
 
@@ -1102,7 +1057,6 @@ initialize_custom_binary_output_ports (void)
     scm_make_port_type ("r6rs-custom-binary-output-port",
                        NULL, cbop_write);
 
-  scm_set_port_mark (custom_binary_output_port_type, cbp_mark);
   scm_set_port_seek (custom_binary_output_port_type, cbp_seek);
   scm_set_port_close (custom_binary_output_port_type, cbp_close);
 }
diff --git a/libguile/random.c b/libguile/random.c
index 32c770a..281d43a 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -144,7 +144,10 @@ scm_i_init_rstate (scm_t_i_rstate *state, const char 
*seed, int n)
 scm_t_i_rstate *
 scm_i_copy_rstate (scm_t_i_rstate *state)
 {
-  scm_t_rstate *new_state = scm_malloc (scm_the_rng.rstate_size);
+  scm_t_rstate *new_state;
+
+  new_state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
+                                        "random-state");
   return memcpy (new_state, state, scm_the_rng.rstate_size);
 }
 
@@ -156,7 +159,10 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
 scm_t_rstate *
 scm_c_make_rstate (const char *seed, int n)
 {
-  scm_t_rstate *state = scm_malloc (scm_the_rng.rstate_size);
+  scm_t_rstate *state;
+
+  state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
+                                    "random-state");
   state->reserved0 = 0;
   scm_the_rng.init_rstate (state, seed, n);
   return state;
@@ -316,12 +322,6 @@ make_rstate (scm_t_rstate *state)
   SCM_RETURN_NEWSMOB (scm_tc16_rstate, state);
 }
 
-static size_t
-rstate_free (SCM rstate)
-{
-  free (SCM_RSTATE (rstate));
-  return 0;
-}
 
 /*
  * Scheme level interface.
@@ -597,7 +597,6 @@ scm_init_random ()
   scm_the_rng = rng;
   
   scm_tc16_rstate = scm_make_smob_type ("random-state", 0);
-  scm_set_smob_free (scm_tc16_rstate, rstate_free);
 
   for (m = 1; m <= 0x100; m <<= 1)
     for (i = m >> 1; i < m; ++i)
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index a95cfb8..6259f28 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -173,7 +173,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
       flag = SCM_CDR (flag);
     }
 
-  rx = scm_gc_malloc (sizeof(regex_t), "regex");
+  rx = scm_gc_malloc_pointerless (sizeof (regex_t), "regex");
   c_pat = scm_to_locale_string (pat);
   status = regcomp (rx, c_pat,
                    /* Make sure they're not passing REG_NOSUB;
diff --git a/libguile/root.h b/libguile/root.h
index cbf710d..676a7b4 100644
--- a/libguile/root.h
+++ b/libguile/root.h
@@ -36,13 +36,11 @@
 #define scm_keyword_obarray scm_sys_protects[4]
 #define scm_stand_in_procs scm_sys_protects[5]
 #define scm_object_whash scm_sys_protects[6]
-#define scm_permobjs scm_sys_protects[7]
-#define scm_asyncs scm_sys_protects[8]
-#define scm_protects scm_sys_protects[9]
-#define scm_properties_whash scm_sys_protects[10]
-#define scm_gc_registered_roots scm_sys_protects[11]
-#define scm_source_whash scm_sys_protects[12]
-#define SCM_NUM_PROTECTS 13
+#define scm_asyncs scm_sys_protects[7]
+#define scm_protects scm_sys_protects[8]
+#define scm_properties_whash scm_sys_protects[9]
+#define scm_source_whash scm_sys_protects[10]
+#define SCM_NUM_PROTECTS 11
 
 SCM_API SCM scm_sys_protects[];
 
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index f4772b7..d9b36c5 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 
2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 
2008, 2009 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
@@ -148,32 +148,6 @@ take_signal (int signum)
 #endif
 }
 
-typedef struct {
-  ssize_t res;
-  int fd;
-  char *buf;
-  size_t n;
-} read_without_guile_data;
-
-static void *
-do_read_without_guile (void *raw_data)
-{
-  read_without_guile_data *data = (read_without_guile_data *)raw_data;
-  data->res = read (data->fd, data->buf, data->n);
-  return NULL;
-}
-
-static ssize_t
-read_without_guile (int fd, char *buf, size_t n)
-{
-  read_without_guile_data data;
-  data.fd = fd;
-  data.buf = buf;
-  data.n = n;
-  scm_without_guile (do_read_without_guile, &data);
-  return data.res;
-}
-
 static SCM
 signal_delivery_thread (void *data)
 {
@@ -187,7 +161,7 @@ signal_delivery_thread (void *data)
 
   while (1)
     {
-      n = read_without_guile (signal_pipe[0], &sigbyte, 1);
+      n = read (signal_pipe[0], &sigbyte, 1);
       sig = sigbyte;
       if (n == 1 && sig >= 0 && sig < NSIG)
        {
diff --git a/libguile/simpos.c b/libguile/simpos.c
index 60a5922..41af233 100644
--- a/libguile/simpos.c
+++ b/libguile/simpos.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004 Free Software
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2009 Free Software
  * Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -89,11 +89,6 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
 #ifdef HAVE_SYSTEM
 #ifdef HAVE_WAITPID
 
-static void
-free_string_pointers (void *data)
-{
-  scm_i_free_string_pointers ((char **)data);
-}
 
 SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
            (SCM args),
@@ -128,12 +123,8 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
       int pid;
       char **execargv;
 
-      scm_dynwind_begin (0);
-
       /* allocate before fork */
       execargv = scm_i_allocate_string_pointers (args);
-      scm_dynwind_unwind_handler (free_string_pointers, execargv,
-                                 SCM_F_WIND_EXPLICITLY);
 
       /* make sure the child can't kill us (as per normal system call) */
       sig_ign = scm_from_long ((unsigned long) SIG_IGN);
@@ -149,7 +140,6 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
           execvp (execargv[0], execargv);
           SCM_SYSERROR;
           /* not reached.  */
-         scm_dynwind_end ();
           return SCM_BOOL_F;
         }
       else
@@ -166,7 +156,6 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
           scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
           scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
 
-         scm_dynwind_end ();
           return scm_from_int (status);
         }
     }
diff --git a/libguile/smob.c b/libguile/smob.c
index 2d7a970..86bb22f 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -38,6 +38,10 @@
 
 #include "libguile/smob.h"
 
+#include "libguile/boehm-gc.h"
+#include <gc/gc_mark.h>
+
+
 
 
 /* scm_smobs scm_numsmob
@@ -458,40 +462,163 @@ scm_set_smob_apply (scm_t_bits tc, SCM (*apply) (),
 SCM
 scm_make_smob (scm_t_bits tc)
 {
-  long n = SCM_TC2SMOBNUM (tc);
+  scm_t_bits n = SCM_TC2SMOBNUM (tc);
   size_t size = scm_smobs[n].size;
   scm_t_bits data = (size > 0
                     ? (scm_t_bits) scm_gc_malloc (size, SCM_SMOBNAME (n))
                     : 0);
-  return scm_cell (tc, data);
+
+  SCM_RETURN_NEWSMOB (tc, data);
 }
 
+
 
-/* {Initialization for the type of free cells}
- */
+/* Marking SMOBs using user-supplied mark procedures.  */
+
+
+/* The GC kind used for SMOB types that provide a custom mark procedure.  */
+static int smob_gc_kind;
+
+
+/* The generic SMOB mark procedure that gets called for SMOBs allocated with
+   `scm_i_new_smob_with_mark_proc ()'.  */
+static struct GC_ms_entry *
+smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
+          struct GC_ms_entry *mark_stack_limit, GC_word env)
+{
+  register SCM cell;
+  register scm_t_bits tc, smobnum;
+
+  cell = PTR2SCM (addr);
+
+  if (SCM_TYP7 (cell) != scm_tc7_smob)
+    /* It is likely that the GC passed us a pointer to a free-list element
+       which we must ignore (see warning in `gc/gc_mark.h').  */
+    return mark_stack_ptr;
+
+  tc = SCM_CELL_WORD_0 (cell);
+  smobnum = SCM_TC2SMOBNUM (tc);
+
+  if (smobnum >= scm_numsmob)
+    /* The first word looks corrupt.  */
+    abort ();
+
+  mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_1 (cell)),
+                                    mark_stack_ptr,
+                                    mark_stack_limit, NULL);
+  mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_2 (cell)),
+                                    mark_stack_ptr,
+                                    mark_stack_limit, NULL);
+  mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_3 (cell)),
+                                    mark_stack_ptr,
+                                    mark_stack_limit, NULL);
+
+  if (scm_smobs[smobnum].mark)
+    {
+      SCM obj;
+
+      SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
+      SCM_I_CURRENT_THREAD->current_mark_stack_limit = mark_stack_limit;
+
+      /* Invoke the SMOB's mark procedure, which will in turn invoke
+        `scm_gc_mark ()', which may modify `current_mark_stack_ptr'.  */
+      obj = scm_smobs[smobnum].mark (cell);
+
+      mark_stack_ptr = SCM_I_CURRENT_THREAD->current_mark_stack_ptr;
+
+      if (SCM_NIMP (obj))
+       /* Mark the returned object.  */
+       mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (obj),
+                                          mark_stack_ptr,
+                                          mark_stack_limit, NULL);
+
+      SCM_I_CURRENT_THREAD->current_mark_stack_limit = NULL;
+      SCM_I_CURRENT_THREAD->current_mark_stack_ptr = NULL;
+    }
+
+  return mark_stack_ptr;
 
-static int
-free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
-  char buf[100];
-  sprintf (buf, "#<freed cell %p; GC missed a reference>",
-          (void *) SCM_UNPACK (exp));
-  scm_puts (buf, port);
-  
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-  if (scm_debug_cell_accesses_p)
-    abort();
+}
+
+/* Mark object O.  We assume that this function is only called during the
+   mark phase, i.e., from within `smob_mark ()' or one of its
+   descendents.  */
+void
+scm_gc_mark (SCM o)
+{
+#define CURRENT_MARK_PTR                                                \
+  ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_ptr))
+#define CURRENT_MARK_LIMIT                                                \
+  ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
+
+  if (SCM_NIMP (o))
+    {
+      /* At this point, the `current_mark_*' fields of the current thread
+        must be defined (they are set in `smob_mark ()').  */
+      register struct GC_ms_entry *mark_stack_ptr;
+
+      if (!CURRENT_MARK_PTR)
+       /* The function was not called from a mark procedure.  */
+       abort ();
+
+      mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (o),
+                                        CURRENT_MARK_PTR, CURRENT_MARK_LIMIT,
+                                        NULL);
+      SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
+    }
+#undef CURRENT_MARK_PTR
+#undef CURRENT_MARK_LIMIT
+}
+
+/* Return a SMOB with typecode TC.  The SMOB type corresponding to TC may
+   provide a custom mark procedure and it will be honored.  */
+SCM
+scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits data1,
+                              scm_t_bits data2, scm_t_bits data3)
+{
+  /* Return a double cell.  */
+  SCM cell = SCM_PACK (GC_generic_malloc (2 * sizeof (scm_t_cell),
+                                         smob_gc_kind));
+
+  SCM_SET_CELL_WORD_3 (cell, data3);
+  SCM_SET_CELL_WORD_2 (cell, data2);
+  SCM_SET_CELL_WORD_1 (cell, data1);
+  SCM_SET_CELL_WORD_0 (cell, tc);
+
+  return cell;
+}
+
+
+/* Finalize SMOB by calling its SMOB type's free function, if any.  */
+void
+scm_i_finalize_smob (GC_PTR ptr, GC_PTR data)
+{
+  SCM smob;
+  size_t (* free_smob) (SCM);
+
+  smob = PTR2SCM (ptr);
+#if 0
+  printf ("finalizing SMOB %p (smobnum: %u)\n",
+         ptr, SCM_SMOBNUM (smob));
 #endif
-  
 
-  return 1;
+  free_smob = scm_smobs[SCM_SMOBNUM (smob)].free;
+  if (free_smob)
+    free_smob (smob);
 }
 
+
 void
 scm_smob_prehistory ()
 {
   long i;
-  scm_t_bits tc;
+
+  smob_gc_kind = GC_new_kind (GC_new_free_list (),
+                             GC_MAKE_PROC (GC_new_proc (smob_mark), 0),
+                             0,
+                             /* Clear new objects.  As of version 7.1, libgc
+                                doesn't seem to support passing 0 here.  */
+                             1);
 
   scm_numsmob = 0;
   for (i = 0; i < MAX_SMOB_COUNT; ++i)
@@ -509,10 +636,6 @@ scm_smob_prehistory ()
       scm_smobs[i].apply_3    = 0;
       scm_smobs[i].gsubr_type = 0;
     }
-
-  /* WARNING: This scm_make_smob_type call must be done first.  */
-  tc = scm_make_smob_type ("free", 0);
-  scm_set_smob_print (tc, free_print);
 }
 
 /*
diff --git a/libguile/smob.h b/libguile/smob.h
index b712f86..d435bac 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -26,6 +26,9 @@
 #include "libguile/__scm.h"
 #include "libguile/print.h"
 
+#include "libguile/boehm-gc.h"
+
+
 
 /* This is the internal representation of a smob type */
 
@@ -45,40 +48,77 @@ typedef struct scm_smob_descriptor
   int gsubr_type; /* Used in procprop.c */
 } scm_smob_descriptor;
 
-
-
-#define SCM_NEWSMOB(z, tc, data) \
-do { \
-  z = scm_cell ((tc), (scm_t_bits) (data)); \
-} while (0)
 
-#define SCM_RETURN_NEWSMOB(tc, data) \
-  do { SCM __SCM_smob_answer; \
-       SCM_NEWSMOB (__SCM_smob_answer, (tc), (data)); \
-       return __SCM_smob_answer; \
+
+SCM_API SCM scm_i_new_smob_with_mark_proc (scm_t_bits tc,
+                                          scm_t_bits, scm_t_bits, scm_t_bits);
+
+
+
+#define SCM_NEWSMOB(z, tc, data)                                         \
+do                                                                       \
+  {                                                                      \
+    register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc);                        
  \
+    z = (scm_smobs[_smobnum].mark                                        \
+        ? scm_i_new_smob_with_mark_proc ((tc), (scm_t_bits)(data),       \
+                                         0, 0)                           \
+        : scm_cell (tc, (scm_t_bits)(data)));                            \
+    if (scm_smobs[_smobnum].free)                                        \
+      {                                                                        
  \
+       GC_finalization_proc _prev_finalizer;                             \
+       GC_PTR _prev_finalizer_data;                                      \
+                                                                         \
+       GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
+                                       NULL,                             \
+                                       &_prev_finalizer,                 \
+                                       &_prev_finalizer_data);           \
+      }                                                                        
  \
+  }                                                                      \
+while (0)
+
+#define SCM_RETURN_NEWSMOB(tc, data)                   \
+  do { SCM __SCM_smob_answer;                          \
+       SCM_NEWSMOB (__SCM_smob_answer, (tc), (data));  \
+       return __SCM_smob_answer;                       \
   } while (0)
 
-#define SCM_NEWSMOB2(z, tc, data1, data2) \
-do { \
-  z = scm_double_cell ((tc), (scm_t_bits)(data1), (scm_t_bits)(data2), 0); \
-} while (0)
+#define SCM_NEWSMOB2(z, tc, data1, data2)      \
+  SCM_NEWSMOB3 (z, tc, data1, data2, 0)
 
-#define SCM_RETURN_NEWSMOB2(tc, data1, data2) \
-  do { SCM __SCM_smob_answer; \
-       SCM_NEWSMOB2 (__SCM_smob_answer, (tc), (data1), (data2)); \
-       return __SCM_smob_answer; \
+#define SCM_RETURN_NEWSMOB2(tc, data1, data2)                          \
+  do { SCM __SCM_smob_answer;                                          \
+       SCM_NEWSMOB2 (__SCM_smob_answer, (tc), (data1), (data2));       \
+       return __SCM_smob_answer;                                       \
   } while (0)
 
-#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
-do { \
-  z = scm_double_cell ((tc), (scm_t_bits)(data1), \
-                       (scm_t_bits)(data2), (scm_t_bits)(data3)); \
-} while (0)
-
-#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
-  do { SCM __SCM_smob_answer; \
-       SCM_NEWSMOB3 (__SCM_smob_answer, (tc), (data1), (data2), (data3)); \
-       return __SCM_smob_answer; \
+#define SCM_NEWSMOB3(z, tc, data1, data2, data3)                         \
+do                                                                       \
+  {                                                                      \
+    register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc);                        
  \
+    z = (scm_smobs[_smobnum].mark                                        \
+        ? scm_i_new_smob_with_mark_proc (tc, (scm_t_bits)(data1),        \
+                                         (scm_t_bits)(data2),            \
+                                         (scm_t_bits)(data3))            \
+        : scm_double_cell ((tc), (scm_t_bits)(data1),                    \
+                           (scm_t_bits)(data2),                          \
+                           (scm_t_bits)(data3)));                        \
+    if (scm_smobs[_smobnum].free)                                        \
+      {                                                                        
  \
+       GC_finalization_proc _prev_finalizer;                             \
+       GC_PTR _prev_finalizer_data;                                      \
+                                                                         \
+       GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
+                                       NULL,                             \
+                                       &_prev_finalizer,                 \
+                                       &_prev_finalizer_data);           \
+      }                                                                        
  \
+  }                                                                      \
+while (0)
+
+#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3)                       \
+  do { SCM __SCM_smob_answer;                                              \
+       SCM_NEWSMOB3 (__SCM_smob_answer, (tc), (data1), (data2), (data3));   \
+       return __SCM_smob_answer;                                           \
   } while (0)
 
 
@@ -120,6 +160,7 @@ SCM_API long scm_numsmob;
 SCM_API scm_smob_descriptor scm_smobs[];
 
 SCM_API void scm_i_set_smob_flags (SCM x, scm_t_bits data);
+SCM_API void scm_i_finalize_smob (GC_PTR obj, GC_PTR data);
 
 
 
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index 8fa0393..77430bd 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -34,6 +34,7 @@
 #include "libguile/ports.h"
 #include "libguile/root.h"
 #include "libguile/weaks.h"
+#include "libguile/gc.h"
 
 #include "libguile/validate.h"
 #include "libguile/srcprop.h"
@@ -97,13 +98,6 @@ static SCM scm_srcprops_to_alist (SCM obj);
 
 scm_t_bits scm_tc16_srcprops;
 
-static SCM
-srcprops_mark (SCM obj)
-{
-  scm_gc_mark (SRCPROPCOPY (obj));
-  return SRCPROPALIST (obj);
-}
-
 static int
 srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
 {
@@ -393,7 +387,6 @@ void
 scm_init_srcprop ()
 {
   scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0);
-  scm_set_smob_mark (scm_tc16_srcprops, srcprops_mark);
   scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
 
   scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047));
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index 5751bbe..76e776c 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -621,32 +621,6 @@ charset_print (SCM charset, SCM port, scm_print_state 
*pstate SCM_UNUSED)
   return 1;
 }
 
-
-/* Smob free hook for character sets. */
-static size_t
-charset_free (SCM charset)
-{
-  scm_t_char_set *cs;
-  size_t len = 0;
-
-  cs = SCM_CHARSET_DATA (charset);
-  if (cs != NULL)
-    len = cs->len;
-  if (len > 0)
-    scm_gc_free (cs->ranges, sizeof (scm_t_char_range) * len,
-                 "character-set");
-
-  cs->ranges = NULL;
-  cs->len = 0;
-
-  scm_gc_free (cs, sizeof (scm_t_char_set), "character-set");
-
-  scm_remember_upto_here_1 (charset);
-
-  return 0;
-}
-
-
 /* Smob print hook for character sets cursors.  */
 static int
 charset_cursor_print (SCM cursor, SCM port,
@@ -669,19 +643,6 @@ charset_cursor_print (SCM cursor, SCM port,
   return 1;
 }
 
-/* Smob free hook for character sets. */
-static size_t
-charset_cursor_free (SCM charset)
-{
-  scm_t_char_set_cursor *cur;
-
-  cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (charset);
-  scm_gc_free (cur, sizeof (scm_t_char_set_cursor), "charset-cursor");
-  scm_remember_upto_here_1 (charset);
-
-  return 0;
-}
-
 
 /* Create a new, empty character set.  */
 static SCM
@@ -2112,11 +2073,9 @@ void
 scm_init_srfi_14 (void)
 {
   scm_tc16_charset = scm_make_smob_type ("character-set", 0);
-  scm_set_smob_free (scm_tc16_charset, charset_free);
   scm_set_smob_print (scm_tc16_charset, charset_print);
 
   scm_tc16_charset_cursor = scm_make_smob_type ("char-set-cursor", 0);
-  scm_set_smob_free (scm_tc16_charset_cursor, charset_cursor_free);
   scm_set_smob_print (scm_tc16_charset_cursor, charset_cursor_print);
 
   scm_char_set_upper_case =
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index 67894b3..3024143 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -28,6 +28,7 @@
 
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
+#include "libguile/boehm-gc.h"
 #include "libguile/srfi-4.h"
 #include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
@@ -250,34 +251,6 @@ uvec_equalp (SCM a, SCM b)
   return result;
 }
 
-/* Mark hook.  Only used when U64 and S64 are implemented as SCMs. */
-
-#if SCM_HAVE_T_INT64 == 0
-static SCM
-uvec_mark (SCM uvec)
-{
-  if (SCM_UVEC_TYPE (uvec) == SCM_UVEC_U64
-      || SCM_UVEC_TYPE (uvec) == SCM_UVEC_S64)
-    {
-      SCM *ptr = (SCM *)SCM_UVEC_BASE (uvec);
-      size_t len = SCM_UVEC_LENGTH (uvec), i;
-      for (i = 0; i < len; i++)
-       scm_gc_mark (*ptr++);
-    }
-  return SCM_BOOL_F;
-}
-#endif
-
-/* Smob free hook for uniform numeric vectors. */
-static size_t
-uvec_free (SCM uvec)
-{
-  int type = SCM_UVEC_TYPE (uvec);
-  scm_gc_free (SCM_UVEC_BASE (uvec),
-              SCM_UVEC_LENGTH (uvec) * uvec_sizes[type],
-              uvec_names[type]);
-  return 0;
-}
 
 /* ================================================================ */
 /* Utility procedures.                                              */
@@ -309,6 +282,14 @@ uvec_assert (int type, SCM obj)
     scm_wrong_type_arg_msg (NULL, 0, obj, uvec_names[type]);
 }
 
+/* Invoke free(3) on DATA, a user-provided buffer passed to one of the
+   `scm_take_' functions.  */
+static void
+free_user_data (GC_PTR data, GC_PTR unused)
+{
+  free (data);
+}
+
 static SCM
 take_uvec (int type, void *base, size_t len)
 {
@@ -911,10 +892,6 @@ scm_init_srfi_4 (void)
 {
   scm_tc16_uvec = scm_make_smob_type ("uvec", 0);
   scm_set_smob_equalp (scm_tc16_uvec, uvec_equalp);
-#if SCM_HAVE_T_INT64 == 0
-  scm_set_smob_mark (scm_tc16_uvec, uvec_mark);
-#endif
-  scm_set_smob_free (scm_tc16_uvec, uvec_free);
   scm_set_smob_print (scm_tc16_uvec, uvec_print);
 
 #if SCM_HAVE_T_INT64 == 0
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index cecd6c6..098752e 100644
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -126,8 +126,16 @@ SCM_DEFINE (F(scm_list_to_,TAG,vector), 
"list->"S(TAG)"vector", 1, 0, 0,
 SCM
 F(scm_take_,TAG,vector) (CTYPE *data, size_t n)
 {
-  scm_gc_register_collectable_memory ((void *)data, n*uvec_sizes[TYPE],
-                                     uvec_names[TYPE]);
+  /* The manual says "Return a new uniform numeric vector [...] that uses the
+     memory pointed to by DATA".  We *have* to use DATA as the underlying
+     storage; thus we must register a finalizer to eventually free(3) it.  */
+  GC_finalization_proc prev_finalizer;
+  GC_PTR prev_finalization_data;
+
+  GC_REGISTER_FINALIZER_NO_ORDER (data, free_user_data, 0,
+                                 &prev_finalizer,
+                                 &prev_finalization_data);
+
   return take_uvec (TYPE, data, n);
 }
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 5784a03..c7f09db 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -37,7 +37,6 @@
 #include "libguile/generalized-vectors.h"
 #include "libguile/deprecation.h"
 #include "libguile/validate.h"
-#include "libguile/dynwind.h"
 
 
 
@@ -62,49 +61,32 @@
  * cow-strings, but it failed randomly with more than 10 threads, say.
  * I couldn't figure out what went wrong, so I used the conservative
  * approach implemented below.
- * 
- * A stringbuf needs to know its length, but only so that it can be
- * reported when the stringbuf is freed.
- *
- * There are 3 storage strategies for stringbufs: inline, outline, and
- * wide.
  *
- * Inline strings are small 8-bit strings stored within the double
- * cell itself.  Outline strings are larger 8-bit strings with GC
- * allocated storage.  Wide strings are 32-bit strings with allocated
- * storage.
- *
- * There was little value in making wide string inlineable, since
- * there is only room for three inlined 32-bit characters.  Thus wide
- * stringbufs are never inlined.
+ * There are 2 storage strategies for stringbufs: 8-bit and wide.  8-bit
+ * strings are ISO-8859-1-encoded strings; wide strings are 32-bit (UCS-4)
+ * strings.
  */
 
+/* The size in words of the stringbuf header (type tag + size).  */
+#define STRINGBUF_HEADER_SIZE   2U
+
+#define STRINGBUF_HEADER_BYTES  (STRINGBUF_HEADER_SIZE * sizeof (SCM))
+
 #define STRINGBUF_F_SHARED      0x100
-#define STRINGBUF_F_INLINE      0x200
 #define STRINGBUF_F_WIDE        0x400 /* If true, strings have UCS-4
                                          encoding.  Otherwise, strings
                                          are Latin-1.  */
 
 #define STRINGBUF_TAG           scm_tc7_stringbuf
 #define STRINGBUF_SHARED(buf)   (SCM_CELL_WORD_0(buf) & STRINGBUF_F_SHARED)
-#define STRINGBUF_INLINE(buf)   (SCM_CELL_WORD_0(buf) & STRINGBUF_F_INLINE)
 #define STRINGBUF_WIDE(buf)     (SCM_CELL_WORD_0(buf) & STRINGBUF_F_WIDE)
 
-#define STRINGBUF_OUTLINE_CHARS(buf)   ((unsigned char *) SCM_CELL_WORD_1(buf))
-#define STRINGBUF_OUTLINE_LENGTH(buf)  (SCM_CELL_WORD_2(buf))
-#define STRINGBUF_INLINE_CHARS(buf)    ((unsigned char *) 
SCM_CELL_OBJECT_LOC(buf,1))
-#define STRINGBUF_INLINE_LENGTH(buf)   (((size_t)SCM_CELL_WORD_0(buf))>>16)
-
-#define STRINGBUF_CHARS(buf)  (STRINGBUF_INLINE (buf) \
-                               ? STRINGBUF_INLINE_CHARS (buf) \
-                               : STRINGBUF_OUTLINE_CHARS (buf))
+#define STRINGBUF_CHARS(buf)    ((unsigned char *)                     \
+                                 SCM_CELL_OBJECT_LOC (buf,             \
+                                                     STRINGBUF_HEADER_SIZE))
+#define STRINGBUF_LENGTH(buf)   (SCM_CELL_WORD_1 (buf))
 
-#define STRINGBUF_WIDE_CHARS(buf) ((scm_t_wchar *) SCM_CELL_WORD_1(buf))
-#define STRINGBUF_LENGTH(buf) (STRINGBUF_INLINE (buf) \
-                               ? STRINGBUF_INLINE_LENGTH (buf) \
-                               : STRINGBUF_OUTLINE_LENGTH (buf))
-
-#define STRINGBUF_MAX_INLINE_LEN (3*sizeof(scm_t_bits))
+#define STRINGBUF_WIDE_CHARS(buf) ((scm_t_wchar *) STRINGBUF_CHARS (buf))
 
 #define SET_STRINGBUF_SHARED(buf) \
   (SCM_SET_CELL_WORD_0 ((buf), SCM_CELL_WORD_0 (buf) | STRINGBUF_F_SHARED))
@@ -125,6 +107,8 @@ make_stringbuf (size_t len)
      can be dropped.
   */
 
+  SCM buf;
+
 #if SCM_STRING_LENGTH_HISTOGRAM
   if (len < 1000)
     lenhist[len]++;
@@ -132,18 +116,15 @@ make_stringbuf (size_t len)
     lenhist[1000]++;
 #endif
 
-  if (len <= STRINGBUF_MAX_INLINE_LEN-1)
-    {
-      return scm_double_cell (STRINGBUF_TAG | STRINGBUF_F_INLINE | (len << 16),
-                             0, 0, 0);
-    }
-  else
-    {
-      char *mem = scm_gc_malloc (len+1, "string");
-      mem[len] = '\0';
-      return scm_double_cell (STRINGBUF_TAG, (scm_t_bits) mem,
-                             (scm_t_bits) len, (scm_t_bits) 0);
-    }
+  buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1,
+                                           "string"));
+
+  SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG);
+  SCM_SET_CELL_WORD_1 (buf, (scm_t_bits) len);
+
+  STRINGBUF_CHARS (buf)[len] = 0;
+
+  return buf;
 }
 
 /* Make a stringbuf with space for LEN 32-bit UCS-4-encoded
@@ -151,7 +132,9 @@ make_stringbuf (size_t len)
 static SCM
 make_wide_stringbuf (size_t len)
 {
-  scm_t_wchar *mem;
+  SCM buf;
+  size_t raw_len;
+
 #if SCM_STRING_LENGTH_HISTOGRAM
   if (len < 1000)
     lenhist[len]++;
@@ -159,121 +142,82 @@ make_wide_stringbuf (size_t len)
     lenhist[1000]++;
 #endif
 
-  mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string");
-  mem[len] = 0;
-  return scm_double_cell (STRINGBUF_TAG | STRINGBUF_F_WIDE, (scm_t_bits) mem,
-                          (scm_t_bits) len, (scm_t_bits) 0);
-}
+  raw_len = (len + 1) * sizeof (scm_t_wchar);
+  buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len,
+                                           "string"));
 
-/* Return a new stringbuf whose underlying storage consists of the LEN+1
-   octets pointed to by STR (the last octet is zero).  */
-SCM
-scm_i_take_stringbufn (char *str, size_t len)
-{
-  scm_gc_register_collectable_memory (str, len + 1, "stringbuf");
+  SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG | STRINGBUF_F_WIDE);
+  SCM_SET_CELL_WORD_1 (buf, (scm_t_bits) len);
 
-  return scm_double_cell (STRINGBUF_TAG, (scm_t_bits) str,
-                         (scm_t_bits) len, (scm_t_bits) 0);
-}
-
-SCM
-scm_i_stringbuf_mark (SCM buf)
-{
-  return SCM_BOOL_F;
-}
-
-void
-scm_i_stringbuf_free (SCM buf)
-{
-  if (!STRINGBUF_INLINE (buf))
-    {
-      if (!STRINGBUF_WIDE (buf))
-        scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf),
-                     STRINGBUF_OUTLINE_LENGTH (buf) + 1, "string");
-      else
-        scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf),
-                     sizeof (scm_t_wchar) * (STRINGBUF_OUTLINE_LENGTH (buf) 
-                                             + 1), "string");
-    }
+  STRINGBUF_WIDE_CHARS (buf)[len] = 0;
 
+  return buf;
 }
 
-/* Convert a stringbuf containing 8-bit Latin-1-encoded characters to
-   one containing 32-bit UCS-4-encoded characters.  */
-static void
-widen_stringbuf (SCM buf)
+/* Return a UCS-4-encoded stringbuf containing the (possibly Latin-1-encoded)
+   characters from BUF.  */
+static SCM
+wide_stringbuf (SCM buf)
 {
-  size_t i, len;
-  scm_t_wchar *mem;
+  SCM new_buf;
 
   if (STRINGBUF_WIDE (buf))
-    return;
-
-  if (STRINGBUF_INLINE (buf))
+    new_buf = buf;
+  else
     {
-      len = STRINGBUF_INLINE_LENGTH (buf);
+      size_t i, len;
+      scm_t_wchar *mem;
 
-      mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string");
-      for (i = 0; i < len; i++)
-        mem[i] =
-          (scm_t_wchar) STRINGBUF_INLINE_CHARS (buf)[i];
-      mem[len] = 0;
+      len = STRINGBUF_LENGTH (buf);
 
-      SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) ^ STRINGBUF_F_INLINE);
-      SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) | STRINGBUF_F_WIDE);
-      SCM_SET_CELL_WORD_1 (buf, mem);
-      SCM_SET_CELL_WORD_2 (buf, len);
-    }
-  else
-    {
-      len = STRINGBUF_OUTLINE_LENGTH (buf);
+      new_buf = make_wide_stringbuf (len);
 
-      mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string");
+      mem = STRINGBUF_WIDE_CHARS (new_buf);
       for (i = 0; i < len; i++)
-        mem[i] =
-          (scm_t_wchar) STRINGBUF_OUTLINE_CHARS (buf)[i];
+       mem[i] = (scm_t_wchar) STRINGBUF_CHARS (buf)[i];
       mem[len] = 0;
-
-      scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf), len + 1, "string");
-
-      SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) | STRINGBUF_F_WIDE);
-      SCM_SET_CELL_WORD_1 (buf, mem);
-      SCM_SET_CELL_WORD_2 (buf, len);
     }
+
+  return new_buf;
 }
 
-/* Convert a stringbuf of 32-bit UCS-4-encoded characters to one
-   containing 8-bit Latin-1-encoded characters, if possible.  */
-static void
+/* Return a Latin-1-encoded stringbuf containing the (possibly UCS-4-encoded)
+   characters from BUF, if possible.  */
+static SCM
 narrow_stringbuf (SCM buf)
 {
-  size_t i, len;
-  scm_t_wchar *wmem;
-  char *mem;
+  SCM new_buf;
 
   if (!STRINGBUF_WIDE (buf))
-    return;
+    new_buf = buf;
+  else
+    {
+      size_t i, len;
+      scm_t_wchar *wmem;
+      unsigned char *mem;
 
-  len = STRINGBUF_OUTLINE_LENGTH (buf);
-  i = 0;
-  wmem = STRINGBUF_WIDE_CHARS (buf);
-  while (i < len)
-    if (wmem[i++] > 0xFF)
-      return;
+      len = STRINGBUF_LENGTH (buf);
+      wmem = STRINGBUF_WIDE_CHARS (buf);
 
-  mem = scm_gc_malloc (sizeof (char) * (len + 1), "string");
-  for (i = 0; i < len; i++)
-    mem[i] = (unsigned char) wmem[i];
+      for (i = 0; i < len; i++)
+       if (wmem[i] > 0xFF)
+         /* BUF cannot be narrowed.  */
+         return buf;
 
-  scm_gc_free (wmem, sizeof (scm_t_wchar) * (len + 1), "string");
+      new_buf = make_stringbuf (len);
 
-  SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) ^ STRINGBUF_F_WIDE);
-  SCM_SET_CELL_WORD_1 (buf, mem);
-  SCM_SET_CELL_WORD_2 (buf, len);
+      mem = STRINGBUF_CHARS (new_buf);
+      for (i = 0; i < len; i++)
+       mem[i] = (unsigned char) wmem[i];
+      mem[len] = 0;
+    }
+
+  return new_buf;
 }
 
 scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
+
 /* Copy-on-write strings.
  */
 
@@ -458,20 +402,7 @@ scm_c_substring_shared (SCM str, size_t start, size_t end)
   return scm_i_substring_shared (str, start, end);
 }
 
-SCM
-scm_i_string_mark (SCM str)
-{
-  if (IS_SH_STRING (str))
-    return SH_STRING_STRING (str);
-  else
-    return STRING_STRINGBUF (str);
-}
-
-void
-scm_i_string_free (SCM str)
-{
-}
-
+
 /* Internal accessors
  */
 
@@ -499,7 +430,7 @@ scm_i_is_narrow_string (SCM str)
 int
 scm_i_try_narrow_string (SCM str)
 {
-  narrow_stringbuf (STRING_STRINGBUF (str));
+  SET_STRING_STRINGBUF (str, narrow_stringbuf (STRING_STRINGBUF (str)));
 
   return scm_i_is_narrow_string (str);
 }
@@ -573,11 +504,18 @@ scm_i_string_start_writing (SCM orig_str)
                    (scm_t_uint32 *) (STRINGBUF_WIDE_CHARS (buf) 
                                      + STRING_START (str)), len);
         }
-      scm_i_thread_put_to_sleep ();
+
       SET_STRING_STRINGBUF (str, new_buf);
       start -= STRING_START (str);
+
+      /* FIXME: The following operations are not atomic, so other threads
+        looking at STR may see an inconsistent state.  Nevertheless it can't
+        hurt much since (i) accessing STR while it is being mutated can't
+        yield a crash, and (ii) concurrent accesses to STR should be
+        protected by a mutex at the application level.  The latter may not
+        apply when STR != ORIG_STR, though.  */
       SET_STRING_START (str, 0);
-      scm_i_thread_wake_up ();
+      SET_STRING_STRINGBUF (str, new_buf);
 
       buf = new_buf;
 
@@ -694,7 +632,7 @@ void
 scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
 {
   if (chr > 0xFF && scm_i_is_narrow_string (str))
-    widen_stringbuf (STRING_STRINGBUF (str));
+    SET_STRING_STRINGBUF (str, wide_stringbuf (STRING_STRINGBUF (str)));
 
   if (scm_i_is_narrow_string (str))
     {
@@ -708,6 +646,7 @@ scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
     }
 }
 
+
 /* Symbols.
 
    Basic symbol creation and accessing is done here, the rest is in
@@ -769,20 +708,8 @@ scm_i_c_make_symbol (const char *name, size_t len,
   SCM buf = make_stringbuf (len);
   memcpy (STRINGBUF_CHARS (buf), name, len);
 
-  return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf),
-                         (scm_t_bits) hash, SCM_UNPACK (props));
-}
-
-/* Return a new symbol that uses the LEN bytes pointed to by NAME as its
-   underlying storage.  */
-SCM
-scm_i_c_take_symbol (char *name, size_t len,
-                    scm_t_bits flags, unsigned long hash, SCM props)
-{
-  SCM buf = scm_i_take_stringbufn (name, len);
-
-  return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf),
-                         (scm_t_bits) hash, SCM_UNPACK (props));
+  return scm_immutable_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf),
+                                   (scm_t_bits) hash, SCM_UNPACK (props));
 }
 
 /* Returns the number of characters in SYM.  This may be different
@@ -845,18 +772,6 @@ scm_i_symbol_wide_chars (SCM sym)
 }
 
 SCM
-scm_i_symbol_mark (SCM sym)
-{
-  scm_gc_mark (SYMBOL_STRINGBUF (sym));
-  return SCM_CELL_OBJECT_3 (sym);
-}
-
-void
-scm_i_symbol_free (SCM sym)
-{
-}
-
-SCM
 scm_i_symbol_substring (SCM sym, size_t start, size_t end)
 {
   SCM buf = SYMBOL_STRINGBUF (sym);
@@ -901,9 +816,6 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, 
(SCM str),
             "The number of characters in this stringbuf\n"
             "@item stringbuf-shared\n"
             "@code{#t} if this stringbuf is shared\n"
-            "@item stringbuf-inline\n"
-            "@code{#t} if this stringbuf's characters are stored in the\n"
-            "cell itself, or @code{#f} if they were allocated in memory\n"
             "@item stringbuf-wide\n"
             "@code{#t} if this stringbuf's characters are stored in a\n"
             "32-bit buffer, or @code{#f} if they are stored in an 8-bit\n"
@@ -911,7 +823,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, 
(SCM str),
             "@end table")
 #define FUNC_NAME s_scm_sys_string_dump
 {
-  SCM e1, e2, e3, e4, e5, e6, e7, e8, e9, e10;
+  SCM e1, e2, e3, e4, e5, e6, e7, e8, e9;
   SCM buf;
   SCM_VALIDATE_STRING (1, str);
 
@@ -971,20 +883,14 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, 
(SCM str),
   else
     e8 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"), 
                    SCM_BOOL_F);
-  if (STRINGBUF_INLINE (buf))
-    e9 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"), 
-                   SCM_BOOL_T);
-  else
-    e9 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"), 
-                   SCM_BOOL_F);
   if (STRINGBUF_WIDE (buf))
-    e10 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
-                    SCM_BOOL_T);
+    e9 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+                  SCM_BOOL_T);
   else
-    e10 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
-                    SCM_BOOL_F);
+    e9 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+                  SCM_BOOL_F);
 
-  return scm_list_n (e1, e2, e3, e4, e5, e6, e7, e8, e9, e10, SCM_UNDEFINED);
+  return scm_list_n (e1, e2, e3, e4, e5, e6, e7, e8, e9, SCM_UNDEFINED);
 }
 #undef FUNC_NAME
 
@@ -1004,9 +910,6 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, 
(SCM sym),
             "The number of characters in this stringbuf\n"
             "@item stringbuf-shared\n"
             "@code{#t} if this stringbuf is shared\n"
-            "@item stringbuf-inline\n"
-            "@code{#t} if this stringbuf's characters are stored in the\n"
-            "cell itself, or @code{#f} if they were allocated in memory\n"
             "@item stringbuf-wide\n"
             "@code{#t} if this stringbuf's characters are stored in a\n"
             "32-bit buffer, or @code{#f} if they are stored in an 8-bit\n"
@@ -1014,7 +917,7 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, 
(SCM sym),
             "@end table")
 #define FUNC_NAME s_scm_sys_symbol_dump
 {
-  SCM e1, e2, e3, e4, e5, e6, e7, e8;
+  SCM e1, e2, e3, e4, e5, e6, e7;
   SCM buf;
   SCM_VALIDATE_SYMBOL (1, sym);
   e1 = scm_cons (scm_from_locale_symbol ("symbol"),
@@ -1053,19 +956,13 @@ SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 
0, (SCM sym),
   else
     e6 = scm_cons (scm_from_locale_symbol ("stringbuf-shared"), 
                    SCM_BOOL_F);
-  if (STRINGBUF_INLINE (buf))
-    e7 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"), 
-                   SCM_BOOL_T);
-  else
-    e7 = scm_cons (scm_from_locale_symbol ("stringbuf-inline"), 
-                   SCM_BOOL_F);
   if (STRINGBUF_WIDE (buf))
-    e8 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+    e7 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
                     SCM_BOOL_T);
   else
-    e8 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
+    e7 = scm_cons (scm_from_locale_symbol ("stringbuf-wide"),
                     SCM_BOOL_F);
-  return scm_list_n (e1, e2, e3, e4, e5, e6, e7, e8, SCM_UNDEFINED);
+  return scm_list_n (e1, e2, e3, e4, e5, e6, e7, SCM_UNDEFINED);
 
 }
 #undef FUNC_NAME
@@ -1600,25 +1497,17 @@ scm_i_from_utf8_string (const scm_t_uint8 *str)
 
 /* Create a new scheme string from the C string STR.  The memory of
    STR may be used directly as storage for the new string.  */
+/* FIXME: GC-wise, the only way to use the memory area pointed to by STR
+   would be to register a finalizer to eventually free(3) STR, which isn't
+   worth it.  Should we just deprecate the `scm_take_' functions?  */
 SCM
 scm_take_locale_stringn (char *str, size_t len)
 {
-  SCM buf, res;
+  SCM res;
 
-  if (len == (size_t) -1)
-    len = strlen (str);
-  else
-    {
-      /* Ensure STR is null terminated.  A realloc for 1 extra byte should
-         often be satisfied from the alignment padding after the block, with
-         no actual data movement.  */
-      str = scm_realloc (str, len + 1);
-      str[len] = '\0';
-    }
+  res = scm_from_locale_stringn (str, len);
+  free (str);
 
-  buf = scm_i_take_stringbufn (str, len);
-  res = scm_double_cell (STRING_TAG,
-                         SCM_UNPACK (buf), (scm_t_bits) 0, (scm_t_bits) len);
   return res;
 }
 
@@ -1855,6 +1744,7 @@ scm_makfromstrs (int argc, char **argv)
 
 char **
 scm_i_allocate_string_pointers (SCM list)
+#define FUNC_NAME "scm_i_allocate_string_pointers"
 {
   char **result;
   int len = scm_ilength (list);
@@ -1863,34 +1753,31 @@ scm_i_allocate_string_pointers (SCM list)
   if (len < 0)
     scm_wrong_type_arg_msg (NULL, 0, list, "proper list");
 
-  scm_dynwind_begin (0);
-
-  result = (char **) scm_malloc ((len + 1) * sizeof (char *));
+  result = scm_gc_malloc ((len + 1) * sizeof (char *),
+                         "string pointers");
   result[len] = NULL;
-  scm_dynwind_unwind_handler (free, result, 0);
 
   /* The list might be have been modified in another thread, so
      we check LIST before each access.
    */
   for (i = 0; i < len && scm_is_pair (list); i++)
     {
-      result[i] = scm_to_locale_string (SCM_CAR (list));
+      SCM str;
+      size_t len;
+
+      str = SCM_CAR (list);
+      len = scm_c_string_length (str);
+
+      result[i] = scm_gc_malloc_pointerless (len + 1, "string pointers");
+      memcpy (result[i], scm_i_string_chars (str), len);
+      result[i][len] = '\0';
+
       list = SCM_CDR (list);
     }
 
-  scm_dynwind_end ();
   return result;
 }
-
-void
-scm_i_free_string_pointers (char **pointers)
-{
-  int i;
-  
-  for (i = 0; pointers[i]; i++)
-    free (pointers[i]);
-  free (pointers);
-}
+#undef FUNC_NAME
 
 void
 scm_i_get_substring_spec (size_t len,
diff --git a/libguile/strings.h b/libguile/strings.h
index c9c267e..8a32918 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -168,9 +168,6 @@ SCM_INTERNAL SCM scm_i_make_symbol (SCM name, scm_t_bits 
flags,
 SCM_INTERNAL SCM
 scm_i_c_make_symbol (const char *name, size_t len,
                     scm_t_bits flags, unsigned long hash, SCM props);
-SCM_INTERNAL SCM
-scm_i_c_take_symbol (char *name, size_t len,
-                    scm_t_bits flags, unsigned long hash, SCM props);
 SCM_INTERNAL const char *scm_i_symbol_chars (SCM sym);
 SCM_INTERNAL const scm_t_wchar *scm_i_symbol_wide_chars (SCM sym);
 SCM_INTERNAL size_t scm_i_symbol_length (SCM sym);
@@ -179,23 +176,12 @@ SCM_INTERNAL int scm_i_try_narrow_string (SCM str);
 SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end);
 SCM_INTERNAL scm_t_wchar scm_i_symbol_ref (SCM sym, size_t x);
 
-/* internal GC functions. */
-
-SCM_INTERNAL SCM scm_i_string_mark (SCM str);
-SCM_INTERNAL SCM scm_i_stringbuf_mark (SCM buf);
-SCM_INTERNAL SCM scm_i_symbol_mark (SCM buf);
-SCM_INTERNAL void scm_i_string_free (SCM str);
-SCM_INTERNAL void scm_i_stringbuf_free (SCM buf);
-SCM_INTERNAL void scm_i_symbol_free (SCM sym);
-
 /* internal utility functions. */
 
 SCM_INTERNAL char **scm_i_allocate_string_pointers (SCM list);
-SCM_INTERNAL void scm_i_free_string_pointers (char **pointers);
 SCM_INTERNAL void scm_i_get_substring_spec (size_t len,
                                            SCM start, size_t *cstart,
                                            SCM end, size_t *cend);
-SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len);
 
 /* Debugging functions */
 
diff --git a/libguile/struct.c b/libguile/struct.c
index f78a812..b7e72a7 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007 Free 
Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 
2009 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
@@ -41,6 +41,8 @@
 #include <string.h>
 #endif
 
+#include "libguile/boehm-gc.h"
+
 
 
 static SCM required_vtable_fields = SCM_BOOL_F;
@@ -307,97 +309,53 @@ scm_alloc_struct (int n_words, int n_extra, const char 
*what)
   p = (scm_t_bits *) (((scm_t_bits) p + 7) & ~7);
 
   /* Initialize a few fields as described above.  */
-  p[scm_struct_i_free] = (scm_t_bits) scm_struct_free_standard;
+  p[scm_struct_i_free] = (scm_t_bits) 0;
   p[scm_struct_i_ptr] = (scm_t_bits) block;
   p[scm_struct_i_n_words] = n_words;
   p[scm_struct_i_flags] = 0;
 
+  /* Since `SCM' objects will record either P or P + SCM_TC3_STRUCT, we need
+     to register them as valid displacements.  Fortunately, only a handful of
+     N_EXTRA values are used in core Guile.  */
+  GC_REGISTER_DISPLACEMENT ((char *)p - (char *)block);
+  GC_REGISTER_DISPLACEMENT ((char *)p - (char *)block + scm_tc3_struct);
+
   return p;
 }
 
-void
-scm_struct_free_0 (scm_t_bits * vtable SCM_UNUSED,
-                  scm_t_bits * data SCM_UNUSED)
-{
-}
+
+/* Finalization.  */
 
-void
-scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data)
-{
-  size_t n = vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK;
-  scm_gc_free (data, n, "struct");
-}
 
-void
-scm_struct_free_standard (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data)
+/* Invoke the finalizer of the struct pointed to by PTR.  */
+static void
+struct_finalizer_trampoline (GC_PTR ptr, GC_PTR unused_data)
 {
-  size_t n = (data[scm_struct_i_n_words] + scm_struct_n_extra_words)
-            * sizeof (scm_t_bits) + 7;
-  scm_gc_free ((void *) data[scm_struct_i_ptr], n, "heavy struct");
-}
+  SCM obj = PTR2SCM (ptr);
 
-void
-scm_struct_free_entity (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data)
-{
-  size_t n = (data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words)
-            * sizeof (scm_t_bits) + 7;
-  scm_gc_free ((void *) data[scm_struct_i_ptr], n, "entity struct");
-}
+  /* XXX - use less explicit code. */
+  scm_t_bits word0 = SCM_CELL_WORD_0 (obj) - scm_tc3_struct;
+  scm_t_bits *vtable_data = (scm_t_bits *) word0;
+  scm_t_bits *data = SCM_STRUCT_DATA (obj);
+  scm_t_struct_free free_struct_data
+    = ((scm_t_struct_free) vtable_data[scm_struct_i_free]);
 
-static void *
-scm_struct_gc_init (void *dummy1 SCM_UNUSED,
-                   void *dummy2 SCM_UNUSED,
-                   void *dummy3 SCM_UNUSED)
-{
-  scm_i_structs_to_free = SCM_EOL;
-  return 0;
-}
+  SCM_SET_CELL_TYPE (obj, scm_tc3_struct);
 
-static void *
-scm_free_structs (void *dummy1 SCM_UNUSED,
-                 void *dummy2 SCM_UNUSED,
-                 void *dummy3 SCM_UNUSED)
-{
-  SCM newchain = scm_i_structs_to_free;
-  do
-    {
-      /* Mark vtables in GC chain.  GC mark set means delay freeing. */
-      SCM chain = newchain;
-      while (!scm_is_null (chain))
-       {
-         SCM vtable = SCM_STRUCT_VTABLE (chain);
-         if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain)
-           SCM_SET_STRUCT_MARK (vtable);
-         chain = SCM_STRUCT_GC_CHAIN (chain);
-       }
-      /* Free unmarked structs.  */
-      chain = newchain;
-      newchain = SCM_EOL;
-      while (!scm_is_null (chain))
-       {
-         SCM obj = chain;
-         chain = SCM_STRUCT_GC_CHAIN (chain);
-         if (SCM_STRUCT_MARK_P (obj))
-           {
-             SCM_CLEAR_STRUCT_MARK (obj);
-             SCM_SET_STRUCT_GC_CHAIN (obj, newchain);
-             newchain = obj;
-           }
-         else
-           {
-             scm_t_bits * vtable_data = SCM_STRUCT_VTABLE_DATA (obj);
-             scm_t_bits * data = SCM_STRUCT_DATA (obj);
-             scm_t_struct_free free_struct_data
-               = ((scm_t_struct_free) vtable_data[scm_struct_i_free]);
-             SCM_SET_CELL_TYPE (obj, scm_tc_free_cell);
-             free_struct_data (vtable_data, data);
-           }
-       }
-    }
-  while (!scm_is_null (newchain));
-  return 0;
+#if 0
+  /* A sanity check.  However, this check can fail if the free function
+     changed between the `make-struct' time and now.  */
+  if (free_struct_data != (scm_t_struct_free)unused_data)
+    abort ();
+#endif
+
+  if (free_struct_data)
+    free_struct_data (vtable_data, data);
 }
 
+
+
+
 SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, 
             (SCM vtable, SCM tail_array_size, SCM init),
            "Create a new structure.\n\n"
@@ -424,13 +382,15 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
   SCM layout;
   size_t basic_size;
   size_t tail_elts;
-  scm_t_bits * data;
+  scm_t_bits *data, *c_vtable;
   SCM handle;
 
   SCM_VALIDATE_VTABLE (1, vtable);
   SCM_VALIDATE_REST_ARGUMENT (init);
 
-  layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
+  c_vtable = SCM_STRUCT_DATA (vtable);
+
+  layout = SCM_PACK (c_vtable [scm_vtable_index_layout]);
   basic_size = scm_i_symbol_length (layout) / 2;
   tail_elts = scm_to_size_t (tail_array_size);
 
@@ -460,7 +420,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
      need for a lock on the section below, as it does not access or update
      any globals, so the critical section has been removed. */
 
-  if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
+  if (c_vtable[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
     {
       data = scm_alloc_struct (basic_size + tail_elts,
                               scm_struct_entity_n_extra_words,
@@ -472,10 +432,25 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
     data = scm_alloc_struct (basic_size + tail_elts,
                             scm_struct_n_extra_words,
                             "struct");
-  handle = scm_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (vtable))
+  handle = scm_double_cell ((((scm_t_bits) c_vtable)
                             + scm_tc3_struct),
                            (scm_t_bits) data, 0, 0);
 
+  if (c_vtable[scm_struct_i_free])
+    {
+      /* Register a finalizer for the newly created instance.  */
+      GC_finalization_proc prev_finalizer;
+      GC_PTR prev_finalizer_data;
+      scm_t_struct_free free_struct =
+       (scm_t_struct_free)c_vtable[scm_struct_i_free];
+
+      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (handle),
+                                     struct_finalizer_trampoline,
+                                     free_struct,
+                                     &prev_finalizer,
+                                     &prev_finalizer_data);
+    }
+
   scm_struct_init (handle, layout, data, tail_elts, init);
 
   return handle;
@@ -892,11 +867,7 @@ scm_print_struct (SCM exp, SCM port, scm_print_state 
*pstate)
 void
 scm_struct_prehistory ()
 {
-  scm_i_structs_to_free = SCM_EOL;
-  scm_c_hook_add (&scm_before_sweep_c_hook, scm_struct_gc_init, 0, 0);
-  /* With lazy sweep GC, the point at which the entire heap is swept
-     is just before the mark phase. */
-  scm_c_hook_add (&scm_before_mark_c_hook, scm_free_structs, 0, 0);
+  /* Empty.  */
 }
 
 void
diff --git a/libguile/struct.h b/libguile/struct.h
index d53e59d..12069b4 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -81,24 +81,10 @@ SCM_API SCM scm_struct_table;
 #define SCM_STRUCT_GC_CHAIN(X) SCM_CELL_OBJECT_3 (X)
 #define SCM_SET_STRUCT_GC_CHAIN(X, Y) SCM_SET_CELL_OBJECT_3 (X, Y)
 
-/* For clearing structs. We can't use the regular GC mark bits, as
-   meddling with them at random times would mess up the invariants of
-   the garbage collector.
- */
-#define SCM_STRUCT_MARK_P(X) SCM_CELL_WORD_2 (X)
-#define SCM_SET_STRUCT_MARK(X) SCM_SET_CELL_WORD_2 (X, 0x1)
-#define SCM_CLEAR_STRUCT_MARK(X) SCM_SET_CELL_WORD_2 (X, 0x0)
-
-SCM_INTERNAL SCM scm_i_structs_to_free;
-
 
 
 SCM_API scm_t_bits * scm_alloc_struct (int n_words, int n_extra,
                                       const char *what);
-SCM_API void scm_struct_free_0 (scm_t_bits * vtable, scm_t_bits * data);
-SCM_API void scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data);
-SCM_API void scm_struct_free_standard (scm_t_bits * vtable, scm_t_bits * data);
-SCM_API void scm_struct_free_entity (scm_t_bits * vtable, scm_t_bits * data);
 SCM_API SCM scm_make_struct_layout (SCM fields);
 SCM_API SCM scm_struct_p (SCM x);
 SCM_API SCM scm_struct_vtable_p (SCM x);
diff --git a/libguile/symbols.c b/libguile/symbols.c
index a932016..c77749f 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -92,15 +92,43 @@ static SCM
 lookup_interned_symbol (SCM name, unsigned long raw_hash)
 {
   /* Try to find the symbol in the symbols table */
-  SCM l;
-  size_t len = scm_i_string_length (name);
+  SCM result = SCM_BOOL_F;
+  SCM bucket, elt, previous_elt;
+  size_t len;
   unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
 
-  for (l = SCM_HASHTABLE_BUCKET (symbols, hash);
-       !scm_is_null (l);
-       l = SCM_CDR (l))
+  len = scm_i_string_length (name);
+  bucket = SCM_HASHTABLE_BUCKET (symbols, hash);
+
+  for (elt = bucket, previous_elt = SCM_BOOL_F;
+       !scm_is_null (elt);
+       previous_elt = elt, elt = SCM_CDR (elt))
     {
-      SCM sym = SCM_CAAR (l);
+      SCM pair, sym;
+
+      pair = SCM_CAR (elt);
+      if (!scm_is_pair (pair))
+       abort ();
+
+      if (SCM_WEAK_PAIR_CAR_DELETED_P (pair))
+       {
+         /* PAIR is a weak pair whose key got nullified: remove it from
+            BUCKET.  */
+         /* FIXME: Since this is done lazily, i.e., only when a new symbol
+            is to be inserted in a bucket containing deleted symbols, the
+            number of items in the hash table may remain erroneous for some
+            time, thus precluding proper rehashing.  */
+         if (previous_elt != SCM_BOOL_F)
+           SCM_SETCDR (previous_elt, SCM_CDR (elt));
+         else
+           bucket = SCM_CDR (elt);
+
+         SCM_HASHTABLE_DECREMENT (symbols);
+         continue;
+       }
+
+      sym = SCM_CAR (pair);
+
       if (scm_i_symbol_hash (sym) == raw_hash
          && scm_i_symbol_length (sym) == len)
        {
@@ -131,13 +159,19 @@ lookup_interned_symbol (SCM name, unsigned long raw_hash)
                 }
             }
 
-         return sym;
+         /* We found it.  */
+         result = sym;
+         break;
        }
     next_symbol:
       ;
     }
 
-  return SCM_BOOL_F;
+  if (SCM_HASHTABLE_N_ITEMS (symbols) < SCM_HASHTABLE_LOWER (symbols))
+    /* We removed many symbols in this pass so trigger a rehashing.  */
+    scm_i_rehash (symbols, scm_i_hash_symbol, 0, "lookup_interned_symbol");
+
+  return result;
 }
 
 /* Intern SYMBOL, an uninterned symbol.  */
@@ -413,7 +447,6 @@ void
 scm_symbols_prehistory ()
 {
   symbols = scm_make_weak_key_hash_table (scm_from_int (2139));
-  scm_permanent_object (symbols);
 }
 
 
diff --git a/libguile/tags.h b/libguile/tags.h
index 9a11df5..9a52093 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -374,10 +374,6 @@ typedef unsigned long scm_t_bits;
  * tc16 (for tc7==scm_tc7_smob):
  *   The largest part of the space of smob types is not subdivided in a
  *   predefined way, since smobs can be added arbitrarily by user C code.
- *   However, while Guile also defines a number of smob types throughout,
- *   there is one smob type, namely scm_tc_free_cell, for which Guile assumes
- *   that it is declared first and thus gets a known-in-advance tc16-code.
- *   The reason of requiring a fixed tc16-code for this type is performance.
  */
 
 
@@ -438,6 +434,7 @@ typedef unsigned long scm_t_bits;
 #define scm_tc7_string         21
 #define scm_tc7_number         23
 #define scm_tc7_stringbuf       39
+#define scm_tc7_bytevector     77
 
 /* Many of the following should be turned
  * into structs or smobs.  We need back some
@@ -452,7 +449,6 @@ typedef unsigned long scm_t_bits;
 #define scm_tc7_unused_5       53
 #define scm_tc7_unused_6       55
 #define scm_tc7_unused_7       71
-#define scm_tc7_unused_8       77
 
 #define scm_tc7_dsubr          61
 #define scm_tc7_gsubr          63
@@ -484,12 +480,6 @@ typedef unsigned long scm_t_bits;
 #define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag))
 
 
-/* Here is the first smob subtype.  */
-
-/* scm_tc_free_cell is the 0th smob type.  We place this in free cells to tell
- * the conservative marker not to trace it.  */
-#define scm_tc_free_cell       (scm_tc7_smob + 0 * 256L)
-
 
 
 /* {Immediate Values}
diff --git a/libguile/threads.c b/libguile/threads.c
index e468f2f..f440bf5 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 
2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 
2007, 2008, 2009 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
@@ -22,6 +22,7 @@
 # include <config.h>
 #endif
 
+#include "libguile/boehm-gc.h"
 #include "libguile/_scm.h"
 
 #if HAVE_UNISTD_H
@@ -162,20 +163,6 @@ dequeue (SCM q)
 
 /*** Thread smob routines */
 
-static SCM
-thread_mark (SCM obj)
-{
-  scm_i_thread *t = SCM_I_THREAD_DATA (obj);
-  scm_gc_mark (t->result);
-  scm_gc_mark (t->cleanup_handler);
-  scm_gc_mark (t->join_queue);
-  scm_gc_mark (t->mutexes);
-  scm_gc_mark (t->dynwinds);
-  scm_gc_mark (t->active_asyncs);
-  scm_gc_mark (t->continuation_root);
-  scm_gc_mark (t->vm);
-  return t->dynamic_state;
-}
 
 static int
 thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -394,12 +381,6 @@ static void
 resume (scm_i_thread *t)
 {
   t->top = NULL;
-  if (t->clear_freelists_p)
-    {
-      *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
-      *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
-      t->clear_freelists_p = 0;
-    }
 }
 
 typedef void* scm_t_guile_ticket;
@@ -410,8 +391,6 @@ scm_enter_guile (scm_t_guile_ticket ticket)
   scm_i_thread *t = (scm_i_thread *)ticket;
   if (t)
     {
-      scm_i_pthread_mutex_lock (&t->heap_mutex);
-      t->heap_mutex_locked_by_self = 1;
       resume (t);
     }
 }
@@ -433,11 +412,6 @@ static scm_t_guile_ticket
 scm_leave_guile ()
 {
   scm_i_thread *t = suspend ();
-  if (t->heap_mutex_locked_by_self)
-    {
-      t->heap_mutex_locked_by_self = 0;
-      scm_i_pthread_mutex_unlock (&t->heap_mutex);
-    }
   return (scm_t_guile_ticket) t;
 }
 
@@ -452,7 +426,7 @@ static SCM scm_i_default_dynamic_state;
 static void
 guilify_self_1 (SCM_STACKITEM *base)
 {
-  scm_i_thread *t = malloc (sizeof (scm_i_thread));
+  scm_i_thread *t = scm_gc_malloc (sizeof (scm_i_thread), "thread");
 
   t->pthread = scm_i_pthread_self ();
   t->handle = SCM_BOOL_F;
@@ -497,24 +471,15 @@ guilify_self_1 (SCM_STACKITEM *base)
        currently have type `void'.  */
     abort ();
 
-  scm_i_pthread_mutex_init (&t->heap_mutex, NULL);
-  t->heap_mutex_locked_by_self = 0;
   scm_i_pthread_mutex_init (&t->admin_mutex, NULL);
-  t->clear_freelists_p = 0;
-  t->gc_running_p = 0;
+  t->current_mark_stack_ptr = NULL;
+  t->current_mark_stack_limit = NULL;
   t->canceled = 0;
   t->exited = 0;
-
-  t->freelist = SCM_EOL;
-  t->freelist2 = SCM_EOL;
-  SCM_SET_FREELIST_LOC (scm_i_freelist, &t->freelist);
-  SCM_SET_FREELIST_LOC (scm_i_freelist2, &t->freelist2);
+  t->guile_mode = 0;
 
   scm_i_pthread_setspecific (scm_i_thread_key, t);
 
-  scm_i_pthread_mutex_lock (&t->heap_mutex);
-  t->heap_mutex_locked_by_self = 1;
-
   scm_i_pthread_mutex_lock (&thread_admin_mutex);
   t->next_thread = all_threads;
   all_threads = t;
@@ -529,8 +494,10 @@ guilify_self_2 (SCM parent)
 {
   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 
+  t->guile_mode = 1;
+
   SCM_NEWSMOB (t->handle, scm_tc16_thread, t);
-  scm_gc_register_collectable_memory (t, sizeof (scm_i_thread), "thread");
+
   t->continuation_root = scm_cons (t->handle, SCM_EOL);
   t->continuation_base = t->base;
   t->vm = SCM_BOOL_F;
@@ -633,7 +600,11 @@ on_thread_exit (void *v)
 
   /* Unblocking the joining threads needs to happen in guile mode
      since the queue is a SCM data structure.  */
-  scm_with_guile (do_thread_exit, v);
+
+  /* Note: Since `do_thread_exit ()' uses allocates memory via `libgc', we
+     assume the GC is usable at this point, and notably that thread-local
+     storage (TLS) hasn't been deallocated yet.  */
+  do_thread_exit (v);
 
   /* Removing ourself from the list of all threads needs to happen in
      non-guile mode since all SCM values on our stack become
@@ -664,7 +635,7 @@ static scm_i_pthread_once_t init_thread_key_once = 
SCM_I_PTHREAD_ONCE_INIT;
 static void
 init_thread_key (void)
 {
-  scm_i_pthread_key_create (&scm_i_thread_key, on_thread_exit);
+  scm_i_pthread_key_create (&scm_i_thread_key, NULL);
 }
 
 /* Perform any initializations necessary to bring the current thread
@@ -765,7 +736,7 @@ get_thread_stack_base ()
 
 #ifndef PTHREAD_ATTR_GETSTACK_WORKS
   if ((void *)&attr < start || (void *)&attr >= end)
-    return scm_get_stack_base ();
+    return (SCM_STACKITEM *) GC_stackbottom;
   else
 #endif
     {
@@ -797,7 +768,7 @@ get_thread_stack_base ()
 static SCM_STACKITEM *
 get_thread_stack_base ()
 {
-  return scm_get_stack_base ();
+  return (SCM_STACKITEM *) GC_stackbottom;
 }
 
 #endif /* pthread methods of get_thread_stack_base */
@@ -809,7 +780,7 @@ get_thread_stack_base ()
 static SCM_STACKITEM *
 get_thread_stack_base ()
 {
-  return scm_get_stack_base ();
+  return (SCM_STACKITEM *) GC_stackbottom;
 }
 
 #endif /* !SCM_USE_PTHREAD_THREADS */
@@ -836,6 +807,7 @@ SCM_UNUSED static void
 scm_leave_guile_cleanup (void *x)
 {
   scm_leave_guile ();
+  on_thread_exit (SCM_I_CURRENT_THREAD);
 }
 
 void *
@@ -859,17 +831,61 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void 
*data, SCM parent)
   return res;
 }
 
+
+/*** Non-guile mode.  */
+
+#if (defined HAVE_GC_DO_BLOCKING) && (!defined HAVE_DECL_GC_DO_BLOCKING)
+
+/* This declaration is missing from the public headers of GC 7.1.  */
+extern void GC_do_blocking (void (*) (void *), void *);
+
+#endif
+
+#ifdef HAVE_GC_DO_BLOCKING
+struct without_guile_arg
+{
+  void * (*function) (void *);
+  void    *data;
+  void    *result;
+};
+
+static void
+without_guile_trampoline (void *closure)
+{
+  struct without_guile_arg *arg;
+
+  SCM_I_CURRENT_THREAD->guile_mode = 0;
+
+  arg = (struct without_guile_arg *) closure;
+  arg->result = arg->function (arg->data);
+
+  SCM_I_CURRENT_THREAD->guile_mode = 1;
+}
+#endif
+
 void *
 scm_without_guile (void *(*func)(void *), void *data)
 {
-  void *res;
-  scm_t_guile_ticket t;
-  t = scm_leave_guile ();
-  res = func (data);
-  scm_enter_guile (t);
-  return res;
+  void *result;
+
+#ifdef HAVE_GC_DO_BLOCKING
+  if (SCM_I_CURRENT_THREAD->guile_mode)
+    {
+      struct without_guile_arg arg;
+
+      arg.function = func;
+      arg.data = data;
+      GC_do_blocking (without_guile_trampoline, &arg);
+      result = arg.result;
+    }
+  else
+#endif
+    result = func (data);
+
+  return result;
 }
 
+
 /*** Thread creation */
 
 typedef struct {
@@ -900,6 +916,9 @@ really_launch (void *d)
   else
     t->result = scm_catch (SCM_BOOL_T, thunk, handler);
 
+  /* Trigger a call to `on_thread_exit ()'.  */
+  pthread_exit (NULL);
+
   return 0;
 }
 
@@ -1190,13 +1209,6 @@ SCM_DEFINE (scm_thread_p, "thread?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-static SCM
-fat_mutex_mark (SCM mx)
-{
-  fat_mutex *m = SCM_MUTEX_DATA (mx);
-  scm_gc_mark (m->owner);
-  return m->waiting;
-}
 
 static size_t
 fat_mutex_free (SCM mx)
@@ -1609,13 +1621,6 @@ SCM_DEFINE (scm_mutex_locked_p, "mutex-locked?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-static SCM
-fat_cond_mark (SCM cv)
-{
-  fat_cond *c = SCM_CONDVAR_DATA (cv);
-  return c->waiting;
-}
-
 static size_t
 fat_cond_free (SCM mx)
 {
@@ -1742,32 +1747,37 @@ SCM_DEFINE (scm_condition_variable_p, 
"condition-variable?", 1, 0, 0,
 # define SCM_MARK_BACKING_STORE()
 #endif
 
-void
-scm_threads_mark_stacks (void)
+
+
+/*** Select */
+
+struct select_args
 {
-  scm_i_thread *t;
-  for (t = all_threads; t; t = t->next_thread)
-    {
-      /* Check that thread has indeed been suspended.
-       */
-      assert (t->top);
+  int             nfds;
+  SELECT_TYPE    *read_fds;
+  SELECT_TYPE    *write_fds;
+  SELECT_TYPE    *except_fds;
+  struct timeval *timeout;
 
-      scm_gc_mark (t->handle);
+  int             result;
+  int             errno_value;
+};
 
-#if SCM_STACK_GROWS_UP
-      scm_mark_locations (t->base, t->top - t->base);
-#else
-      scm_mark_locations (t->top, t->base - t->top);
-#endif
-      scm_mark_locations ((void *) &t->regs,
-                         ((size_t) sizeof(t->regs)
-                          / sizeof (SCM_STACKITEM)));
-    }
+static void *
+do_std_select (void *args)
+{
+  struct select_args *select_args;
 
-  SCM_MARK_BACKING_STORE ();
-}
+  select_args = (struct select_args *) args;
 
-/*** Select */
+  select_args->result =
+    select (select_args->nfds,
+           select_args->read_fds, select_args->write_fds,
+           select_args->except_fds, select_args->timeout);
+  select_args->errno_value = errno;
+
+  return NULL;
+}
 
 int
 scm_std_select (int nfds,
@@ -1779,7 +1789,7 @@ scm_std_select (int nfds,
   fd_set my_readfds;
   int res, eno, wakeup_fd;
   scm_i_thread *t = SCM_I_CURRENT_THREAD;
-  scm_t_guile_ticket ticket;
+  struct select_args args;
 
   if (readfds == NULL)
     {
@@ -1791,15 +1801,23 @@ scm_std_select (int nfds,
     SCM_TICK;
 
   wakeup_fd = t->sleep_pipe[0];
-  ticket = scm_leave_guile ();
   FD_SET (wakeup_fd, readfds);
   if (wakeup_fd >= nfds)
     nfds = wakeup_fd+1;
-  res = select (nfds, readfds, writefds, exceptfds, timeout);
-  t->sleep_fd = -1;
-  eno = errno;
-  scm_enter_guile (ticket);
 
+  args.nfds = nfds;
+  args.read_fds = readfds;
+  args.write_fds = writefds;
+  args.except_fds = exceptfds;
+  args.timeout = timeout;
+
+  /* Explicitly cooperate with the GC.  */
+  scm_without_guile (do_std_select, &args);
+
+  res = args.result;
+  eno = args.errno_value;
+
+  t->sleep_fd = -1;
   scm_i_reset_sleep (t);
 
   if (res > 0 && FD_ISSET (wakeup_fd, readfds))
@@ -1823,18 +1841,17 @@ scm_std_select (int nfds,
 
 #if SCM_USE_PTHREAD_THREADS
 
+/* It seems reasonable to not run procedures related to mutex and condition
+   variables within `GC_do_blocking ()' since, (i) the GC can operate even
+   without it, and (ii) the only potential gain would be GC latency.  See
+   
http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/2245/focus=2251
+   for a discussion of the pros and cons.  */
+
 int
 scm_pthread_mutex_lock (scm_i_pthread_mutex_t *mutex)
 {
-  if (scm_i_pthread_mutex_trylock (mutex) == 0)
-    return 0;
-  else
-    {
-      scm_t_guile_ticket t = scm_leave_guile ();
-      int res = scm_i_pthread_mutex_lock (mutex);
-      scm_enter_guile (t);
-      return res;
-    }
+  int res = scm_i_pthread_mutex_lock (mutex);
+  return res;
 }
 
 static void
@@ -1966,68 +1983,8 @@ scm_c_thread_exited_p (SCM thread)
 #undef FUNC_NAME
 
 static scm_i_pthread_cond_t wake_up_cond;
-int scm_i_thread_go_to_sleep;
 static int threads_initialized_p = 0;
 
-void
-scm_i_thread_put_to_sleep ()
-{
-  if (threads_initialized_p)
-    {
-      scm_i_thread *t;
-
-      scm_leave_guile ();
-      scm_i_pthread_mutex_lock (&thread_admin_mutex);
-
-      /* Signal all threads to go to sleep
-       */
-      scm_i_thread_go_to_sleep = 1;
-      for (t = all_threads; t; t = t->next_thread)
-       scm_i_pthread_mutex_lock (&t->heap_mutex);
-      scm_i_thread_go_to_sleep = 0;
-    }
-}
-
-void
-scm_i_thread_invalidate_freelists ()
-{
-  /* thread_admin_mutex is already locked. */
-
-  scm_i_thread *t;
-  for (t = all_threads; t; t = t->next_thread)
-    if (t != SCM_I_CURRENT_THREAD)
-      t->clear_freelists_p = 1;
-}
-
-void
-scm_i_thread_wake_up ()
-{
-  if (threads_initialized_p)
-    {
-      scm_i_thread *t;
-
-      scm_i_pthread_cond_broadcast (&wake_up_cond);
-      for (t = all_threads; t; t = t->next_thread)
-       scm_i_pthread_mutex_unlock (&t->heap_mutex);
-      scm_i_pthread_mutex_unlock (&thread_admin_mutex);
-      scm_enter_guile ((scm_t_guile_ticket) SCM_I_CURRENT_THREAD);
-    }
-}
-
-void
-scm_i_thread_sleep_for_gc ()
-{
-  scm_i_thread *t = suspend ();
-
-  /* Don't put t->heap_mutex in t->held_mutex here, because if the
-     thread is cancelled during the cond wait, the thread's cleanup
-     function (scm_leave_guile_cleanup) will handle unlocking the
-     heap_mutex, so we don't need to do that again in on_thread_exit.
-  */
-  scm_i_pthread_cond_wait (&wake_up_cond, &t->heap_mutex);
-
-  resume (t);
-}
 
 /* This mutex is used by SCM_CRITICAL_SECTION_START/END.
  */
@@ -2047,7 +2004,6 @@ scm_dynwind_critical_section (SCM mutex)
 
 /*** Initialization */
 
-scm_i_pthread_key_t scm_i_freelist, scm_i_freelist2;
 scm_i_pthread_mutex_t scm_i_misc_mutex;
 
 #if SCM_USE_PTHREAD_THREADS
@@ -2067,8 +2023,6 @@ scm_threads_prehistory (SCM_STACKITEM *base)
                            scm_i_pthread_mutexattr_recursive);
   scm_i_pthread_mutex_init (&scm_i_misc_mutex, NULL);
   scm_i_pthread_cond_init (&wake_up_cond, NULL);
-  scm_i_pthread_key_create (&scm_i_freelist, NULL);
-  scm_i_pthread_key_create (&scm_i_freelist2, NULL);
 
   guilify_self_1 (base);
 }
@@ -2081,18 +2035,15 @@ void
 scm_init_threads ()
 {
   scm_tc16_thread = scm_make_smob_type ("thread", sizeof (scm_i_thread));
-  scm_set_smob_mark (scm_tc16_thread, thread_mark);
   scm_set_smob_print (scm_tc16_thread, thread_print);
-  scm_set_smob_free (scm_tc16_thread, thread_free);
+  scm_set_smob_free (scm_tc16_thread, thread_free); /* XXX: Could be removed */
 
   scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (fat_mutex));
-  scm_set_smob_mark (scm_tc16_mutex, fat_mutex_mark);
   scm_set_smob_print (scm_tc16_mutex, fat_mutex_print);
   scm_set_smob_free (scm_tc16_mutex, fat_mutex_free);
 
   scm_tc16_condvar = scm_make_smob_type ("condition-variable",
                                         sizeof (fat_cond));
-  scm_set_smob_mark (scm_tc16_condvar, fat_cond_mark);
   scm_set_smob_print (scm_tc16_condvar, fat_cond_print);
   scm_set_smob_free (scm_tc16_condvar, fat_cond_free);
 
@@ -2117,6 +2068,49 @@ scm_init_thread_procs ()
 #include "libguile/threads.x"
 }
 
+
+/* IA64-specific things.  */
+
+#ifdef __ia64__
+# ifdef __hpux
+#  include <sys/param.h>
+#  include <sys/pstat.h>
+void *
+scm_ia64_register_backing_store_base (void)
+{
+  struct pst_vm_status vm_status;
+  int i = 0;
+  while (pstat_getprocvm (&vm_status, sizeof (vm_status), 0, i++) == 1)
+    if (vm_status.pst_type == PS_RSESTACK)
+      return (void *) vm_status.pst_vaddr;
+  abort ();
+}
+void *
+scm_ia64_ar_bsp (const void *ctx)
+{
+  uint64_t bsp;
+  __uc_get_ar_bsp (ctx, &bsp);
+  return (void *) bsp;
+}
+# endif /* hpux */
+# ifdef linux
+#  include <ucontext.h>
+void *
+scm_ia64_register_backing_store_base (void)
+{
+  extern void *__libc_ia64_register_backing_store_base;
+  return __libc_ia64_register_backing_store_base;
+}
+void *
+scm_ia64_ar_bsp (const void *opaque)
+{
+  const ucontext_t *ctx = opaque;
+  return (void *) ctx->uc_mcontext.sc_ar_bsp;
+}
+# endif /* linux */
+#endif /* __ia64__ */
+
+
 /*
   Local Variables:
   c-file-style: "gnu"
diff --git a/libguile/threads.h b/libguile/threads.h
index 9a1b6f0..55102df 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -63,30 +63,18 @@ typedef struct scm_i_thread {
   int canceled;
   int exited;
 
+  /* Boolean indicating whether the thread is in guile mode.  */
+  int guile_mode;
+
   SCM sleep_object;
   scm_i_pthread_mutex_t *sleep_mutex;
   scm_i_pthread_cond_t sleep_cond;
   int sleep_fd, sleep_pipe[2];
 
-  /* This mutex represents this threads right to access the heap.
-     That right can temporarily be taken away by the GC.
-  */
-  scm_i_pthread_mutex_t heap_mutex;
-
-  /* Boolean tracking whether the above mutex is currently locked by
-     this thread.  This is equivalent to whether or not the thread is
-     in "Guile mode".  This field doesn't need any protection because
-     it is only ever set or tested by the owning thread.
-  */
-  int heap_mutex_locked_by_self;
-
-  /* The freelists of this thread.  Each thread has its own lists so
-     that they can all allocate concurrently.
-  */
-  SCM freelist, freelist2;
-  int clear_freelists_p; /* set if GC was done while thread was asleep */
-  int gc_running_p;      /* non-zero while this thread does GC or a
-                           sweep. */
+  /* Information about the Boehm-GC mark stack during the mark phase.  This
+     is used by `scm_gc_mark ()'.  */
+  void *current_mark_stack_ptr;
+  void *current_mark_stack_limit;
 
   /* Other thread local things.
    */
@@ -151,26 +139,16 @@ SCM_INTERNAL void *scm_i_with_guile_and_parent (void 
*(*func)(void *),
                                                void *data, SCM parent);
 
 
-extern int scm_i_thread_go_to_sleep;
-
-SCM_INTERNAL void scm_i_thread_put_to_sleep (void);
-SCM_INTERNAL void scm_i_thread_wake_up (void);
-SCM_INTERNAL void scm_i_thread_invalidate_freelists (void);
-void scm_i_thread_sleep_for_gc (void);
+void scm_threads_prehistory (SCM_STACKITEM *);
+void scm_threads_init_first_thread (void);
 
-SCM_INTERNAL void scm_threads_prehistory (SCM_STACKITEM *);
-SCM_INTERNAL void scm_threads_init_first_thread (void);
-SCM_INTERNAL void scm_threads_mark_stacks (void);
 SCM_INTERNAL void scm_init_threads (void);
 SCM_INTERNAL void scm_init_thread_procs (void);
 SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
 
 
 #define SCM_THREAD_SWITCHING_CODE \
-do { \
-  if (scm_i_thread_go_to_sleep) \
-    scm_i_thread_sleep_for_gc (); \
-} while (0)
+  do { } while (0)
 
 SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
 SCM_API SCM scm_yield (void);
diff --git a/libguile/validate.h b/libguile/validate.h
index b48bec7..8c79469 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -151,8 +151,9 @@
     cvar = scm_to_bool (flag); \
   } while (0)
 
-#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj)            \
-  SCM_VALIDATE_SMOB ((_pos), (_obj), bytevector)
+#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj)                    \
+  SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos),    \
+                  FUNC_NAME, "bytevector")
 
 #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, 
"character")
 
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 89b822a..190e3e3 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -41,6 +41,9 @@
 #include "libguile/dynwind.h"
 #include "libguile/deprecation.h"
 
+#include "libguile/boehm-gc.h"
+
+
 
 
 #define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8)
@@ -68,6 +71,11 @@ const SCM *
 scm_vector_elements (SCM vec, scm_t_array_handle *h,
                     size_t *lenp, ssize_t *incp)
 {
+  if (SCM_I_WVECTP (vec))
+    /* FIXME: We should check each (weak) element of the vector for NULL and
+       convert it to SCM_BOOL_F.  */
+    abort ();
+
   scm_generalized_vector_get_handle (vec, h);
   if (lenp)
     {
@@ -82,6 +90,11 @@ SCM *
 scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
                              size_t *lenp, ssize_t *incp)
 {
+  if (SCM_I_WVECTP (vec))
+    /* FIXME: We should check each (weak) element of the vector for NULL and
+       convert it to SCM_BOOL_F.  */
+    abort ();
+
   scm_generalized_vector_get_handle (vec, h);
   if (lenp)
     {
@@ -199,9 +212,17 @@ scm_c_vector_ref (SCM v, size_t k)
 {
   if (SCM_I_IS_VECTOR (v))
     {
+      register SCM elt;
+
       if (k >= SCM_I_VECTOR_LENGTH (v))
-       scm_out_of_range (NULL, scm_from_size_t (k)); 
-      return (SCM_I_VECTOR_ELTS(v))[k];
+       scm_out_of_range (NULL, scm_from_size_t (k));
+      elt = (SCM_I_VECTOR_ELTS(v))[k];
+
+      if ((elt == SCM_PACK (NULL)) && SCM_I_WVECTP (v))
+       /* ELT was a weak pointer and got nullified by the GC.  */
+       return SCM_BOOL_F;
+
+      return elt;
     }
   else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
     {
@@ -209,10 +230,18 @@ scm_c_vector_ref (SCM v, size_t k)
       SCM vv = SCM_I_ARRAY_V (v);
       if (SCM_I_IS_VECTOR (vv))
        {
+         register SCM elt;
+
          if (k >= dim->ubnd - dim->lbnd + 1)
            scm_out_of_range (NULL, scm_from_size_t (k));
          k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
-         return (SCM_I_VECTOR_ELTS (vv))[k];
+         elt = (SCM_I_VECTOR_ELTS (vv))[k];
+
+         if ((elt == SCM_PACK (NULL)) && (SCM_I_WVECTP (vv)))
+           /* ELT was a weak pointer and got nullified by the GC.  */
+           return SCM_BOOL_F;
+
+         return elt;
        }
       scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
     }
@@ -250,6 +279,12 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
       if (k >= SCM_I_VECTOR_LENGTH (v))
        scm_out_of_range (NULL, scm_from_size_t (k)); 
       (SCM_I_VECTOR_WELTS(v))[k] = obj;
+      if (SCM_I_WVECTP (v))
+       {
+         /* Make it a weak pointer.  */
+         GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (v))[k]);
+         GC_GENERAL_REGISTER_DISAPPEARING_LINK (link, obj);
+       }
     }
   else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
     {
@@ -261,6 +296,13 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
            scm_out_of_range (NULL, scm_from_size_t (k));
          k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
          (SCM_I_VECTOR_WELTS (vv))[k] = obj;
+
+         if (SCM_I_WVECTP (vv))
+           {
+             /* Make it a weak pointer.  */
+             GC_PTR link = (GC_PTR) & ((SCM_I_VECTOR_WELTS (vv))[k]);
+             GC_GENERAL_REGISTER_DISAPPEARING_LINK (link, obj);
+           }
        }
       else
        scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
@@ -313,7 +355,7 @@ scm_c_make_vector (size_t k, SCM fill)
   else
     base = NULL;
 
-  v = scm_cell ((k << 8) | scm_tc7_vector, (scm_t_bits) base);
+  v = scm_immutable_cell ((k << 8) | scm_tc7_vector, (scm_t_bits) base);
   scm_remember_upto_here_1 (fill);
 
   return v;
@@ -349,43 +391,85 @@ scm_i_vector_free (SCM vec)
               "vector");
 }
 
-/* Allocate memory for a weak vector on behalf of the caller.  The allocated
- * vector will be of the given weak vector subtype.  It will contain size
- * elements which are initialized with the 'fill' object, or, if 'fill' is
- * undefined, with an unspecified object.
- */
-SCM
-scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill)
+
+/* Weak vectors.  */
+
+
+/* Initialize RET as a weak vector of type TYPE of SIZE elements pointed to
+   by BASE.  */
+#define MAKE_WEAK_VECTOR(_ret, _type, _size, _base)            \
+  (_ret) = scm_double_cell ((_size << 8) | scm_tc7_wvect,      \
+                           (scm_t_bits) (_base),               \
+                           (_type),                            \
+                           SCM_UNPACK (SCM_EOL));
+
+
+/* Allocate memory for the elements of a weak vector on behalf of the
+   caller.  */
+static SCM *
+allocate_weak_vector (scm_t_bits type, size_t c_size)
 {
-  size_t c_size;
   SCM *base;
-  SCM v;
+
+  if (c_size > 0)
+    /* The base itself should not be scanned for pointers otherwise those
+       pointers will always be reachable.  */
+    base = scm_gc_malloc_pointerless (c_size * sizeof (SCM), "weak vector");
+  else
+    base = NULL;
+
+  return base;
+}
+
+/* Return a new weak vector.  The allocated vector will be of the given weak
+   vector subtype.  It will contain SIZE elements which are initialized with
+   the FILL object, or, if FILL is undefined, with an unspecified object.  */
+SCM
+scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill)
+{
+  SCM wv, *base;
+  size_t c_size, j;
+
+  if (SCM_UNBNDP (fill))
+    fill = SCM_UNSPECIFIED;
 
   c_size = scm_to_unsigned_integer (size, 0, VECTOR_MAX_LENGTH);
+  base = allocate_weak_vector (type, c_size);
 
-  if (c_size > 0)
+  for (j = 0; j != c_size; ++j)
+    base[j] = fill;
+
+  MAKE_WEAK_VECTOR (wv, type, c_size, base);
+
+  return wv;
+}
+
+/* Return a new weak vector with type TYPE and whose content are taken from
+   list LST.  */
+SCM
+scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst)
+{
+  SCM wv, *base, *elt;
+  long c_size;
+
+  c_size = scm_ilength (lst);
+  SCM_ASSERT (c_size >= 0, lst, SCM_ARG2, "scm_i_make_weak_vector_from_list");
+
+  base = allocate_weak_vector (type, (size_t)c_size);
+  for (elt = base;
+       scm_is_pair (lst);
+       lst = SCM_CDR (lst), elt++)
     {
-      size_t j;
-      
-      if (SCM_UNBNDP (fill))
-       fill = SCM_UNSPECIFIED;
-      
-      base = scm_gc_malloc (c_size * sizeof (SCM), "weak vector");
-      for (j = 0; j != c_size; ++j)
-       base[j] = fill;
+      *elt = SCM_CAR (lst);
     }
-  else
-    base = NULL;
 
-  v = scm_double_cell ((c_size << 8) | scm_tc7_wvect,
-                      (scm_t_bits) base,
-                      type,
-                      SCM_UNPACK (SCM_EOL));
-  scm_remember_upto_here_1 (fill);
+  MAKE_WEAK_VECTOR (wv, type, (size_t)c_size, base);
 
-  return v;
+  return wv;
 }
 
+
+
 SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, 
            (SCM v),
            "Return a newly allocated list composed of the elements of 
@var{v}.\n"
diff --git a/libguile/vectors.h b/libguile/vectors.h
index bc5b41c..0e2cb6e 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -85,7 +85,8 @@ SCM_INTERNAL SCM  scm_i_vector_equal_p (SCM x, SCM y);
 #define SCM_I_WVECT_GC_CHAIN(x)         (SCM_CELL_OBJECT_3 (x))
 #define SCM_I_SET_WVECT_GC_CHAIN(x, o)  (SCM_SET_CELL_OBJECT_3 ((x), (o)))
 
-SCM_INTERNAL SCM scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM 
fill);
+SCM_INTERNAL SCM scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill);
+SCM_INTERNAL SCM scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst);
 
 SCM_INTERNAL void scm_init_vectors (void);
 
diff --git a/libguile/version.c b/libguile/version.c
index 3d5dc19..db1bc9f 100644
--- a/libguile/version.c
+++ b/libguile/version.c
@@ -87,19 +87,7 @@ SCM_DEFINE (scm_version, "version", 0, 0, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_version
 {
-
-  char version_str[3 * 4 + 3];
-
-#if SCM_MAJOR_VERSION > 9999 \
-    || SCM_MINOR_VERSION > 9999 \
-    || SCM_MICRO_VERSION > 9999
-# error version string may overflow buffer
-#endif
-  sprintf (version_str, "%d.%d.%d",
-           SCM_MAJOR_VERSION,
-           SCM_MINOR_VERSION,
-           SCM_MICRO_VERSION);
-  return scm_from_locale_string (version_str);
+  return scm_from_locale_string (PACKAGE_VERSION);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 36d4d28..3c1bbf6 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -252,7 +252,7 @@
 #endif
 
 #define CHECK_OVERFLOW()                       \
-  if (sp > stack_limit)                                \
+  if (sp >= stack_limit)                       \
     goto vm_error_stack_overflow
 
 #define CHECK_UNDERFLOW()                       \
diff --git a/libguile/vm.c b/libguile/vm.c
index 660f25c..95aaa4f 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -23,6 +23,11 @@
 #include <stdlib.h>
 #include <alloca.h>
 #include <string.h>
+#include <assert.h>
+
+#include "libguile/boehm-gc.h"
+#include <gc/gc_mark.h>
+
 #include "_scm.h"
 #include "vm-bootstrap.h"
 #include "frames.h"
@@ -56,6 +61,13 @@
 #define VM_ENABLE_ASSERTIONS
 #endif
 
+/* When defined, arrange so that the GC doesn't scan the VM stack beyond its
+   current SP.  This should help avoid excess data retention.  See
+   
http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/3001
+   for a discussion.  */
+#define VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+
 
 /*
  * VM Continuation
@@ -63,56 +75,6 @@
 
 scm_t_bits scm_tc16_vm_cont;
 
-static void
-vm_mark_stack (SCM *base, scm_t_ptrdiff size, SCM *fp, scm_t_ptrdiff reloc)
-{
-  SCM *sp, *mark;
-  sp = base + size - 1;
-
-  while (sp > base && fp) 
-    {
-      mark = SCM_FRAME_LOWER_ADDRESS (fp) + 3;
-
-      for (; sp >= mark; sp--)
-        if (SCM_NIMP (*sp)) 
-          {
-            if (scm_in_heap_p (*sp))
-              scm_gc_mark (*sp);
-            /* this can happen for open frames */
-            /* else fprintf (stderr, "BADNESS: crap on the stack: %p\n", *sp); 
*/
-          }
-      
-
-      /* skip ra, mvra */
-      sp -= 2;
-
-      /* update fp from the dynamic link */
-      fp = (SCM*)*sp-- + reloc;
-    }
-}
-
-static SCM
-vm_cont_mark (SCM obj)
-{
-  struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj);
-
-  if (p->stack_size)
-    vm_mark_stack (p->stack_base, p->stack_size, p->fp + p->reloc, p->reloc);
-
-  return SCM_BOOL_F;
-}
-
-static size_t
-vm_cont_free (SCM obj)
-{
-  struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj);
-
-  scm_gc_free (p->stack_base, p->stack_size * sizeof (SCM), "stack-base");
-  scm_gc_free (p, sizeof (*p), "vm-cont");
-
-  return 0;
-}
-
 static SCM
 capture_vm_cont (struct scm_vm *vp)
 {
@@ -228,8 +190,7 @@ really_make_boot_program (long nargs)
     abort ();
   text[1] = (scm_t_uint8)nargs;
 
-  bp = scm_gc_malloc (sizeof (struct scm_objcode) + sizeof (text),
-                      "make-u8vector");
+  bp = scm_malloc (sizeof (struct scm_objcode) + sizeof (text));
   memcpy (bp->base, text, sizeof (text));
   bp->nargs = 0;
   bp->nrest = 0;
@@ -330,6 +291,13 @@ static const scm_t_vm_engine vm_engines[] =
 
 scm_t_bits scm_tc16_vm;
 
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+
+/* The GC "kind" for the VM stack.  */
+static int vm_stack_gc_kind;
+
+#endif
+
 static SCM
 make_vm (void)
 #define FUNC_NAME "make_vm"
@@ -342,12 +310,25 @@ make_vm (void)
   struct scm_vm *vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
 
   vp->stack_size  = VM_DEFAULT_STACK_SIZE;
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+  vp->stack_base = GC_generic_malloc (vp->stack_size * sizeof (SCM),
+                                     vm_stack_gc_kind);
+
+  /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack
+     top is.  */
+  *vp->stack_base = PTR2SCM (vp);
+  vp->stack_base++;
+  vp->stack_size--;
+#else
   vp->stack_base  = scm_gc_malloc (vp->stack_size * sizeof (SCM),
                                   "stack-base");
+#endif
+
 #ifdef VM_ENABLE_STACK_NULLING
   memset (vp->stack_base, 0, vp->stack_size * sizeof (SCM));
 #endif
-  vp->stack_limit = vp->stack_base + vp->stack_size - 3;
+  vp->stack_limit = vp->stack_base + vp->stack_size;
   vp->ip         = NULL;
   vp->sp         = vp->stack_base - 1;
   vp->fp         = NULL;
@@ -362,41 +343,36 @@ make_vm (void)
 }
 #undef FUNC_NAME
 
-static SCM
-vm_mark (SCM obj)
-{
-  int i;
-  struct scm_vm *vp = SCM_VM_DATA (obj);
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
 
-#ifdef VM_ENABLE_STACK_NULLING
-  if (vp->sp >= vp->stack_base)
-    if (!vp->sp[0] || vp->sp[1])
-      abort ();
-#endif
+/* Mark the VM stack region between its base and its current top.  */
+static struct GC_ms_entry *
+vm_stack_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
+              struct GC_ms_entry *mark_stack_limit, GC_word env)
+{
+  GC_word *word;
+  const struct scm_vm *vm;
 
-  /* mark the stack, precisely */
-  vm_mark_stack (vp->stack_base, vp->sp + 1 - vp->stack_base, vp->fp, 0);
+  /* The first word of the VM stack should contain a pointer to the
+     corresponding VM.  */
+  vm = * ((struct scm_vm **) addr);
 
-  /* mark other objects  */
-  for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
-    scm_gc_mark (vp->hooks[i]);
+  if ((SCM *) addr != vm->stack_base - 1
+      || vm->stack_limit - vm->stack_base != vm->stack_size)
+    /* ADDR must be a pointer to a free-list element, which we must ignore
+       (see warning in <gc/gc_mark.h>).  */
+    return mark_stack_ptr;
 
-  scm_gc_mark (vp->trace_frame);
+  for (word = (GC_word *) vm->stack_base; word <= (GC_word *) vm->sp; word++)
+    mark_stack_ptr = GC_MARK_AND_PUSH ((* (GC_word **) word),
+                                      mark_stack_ptr, mark_stack_limit,
+                                      NULL);
 
-  return vp->options;
+  return mark_stack_ptr;
 }
 
-static size_t
-vm_free (SCM obj)
-{
-  struct scm_vm *vp = SCM_VM_DATA (obj);
+#endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
 
-  scm_gc_free (vp->stack_base, vp->stack_size * sizeof (SCM),
-              "stack-base");
-  scm_gc_free (vp, sizeof (struct scm_vm), "vm");
-
-  return 0;
-}
 
 SCM
 scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
@@ -664,12 +640,8 @@ scm_bootstrap_vm (void)
   scm_bootstrap_programs ();
 
   scm_tc16_vm_cont = scm_make_smob_type ("vm-cont", 0);
-  scm_set_smob_mark (scm_tc16_vm_cont, vm_cont_mark);
-  scm_set_smob_free (scm_tc16_vm_cont, vm_cont_free);
 
   scm_tc16_vm = scm_make_smob_type ("vm", 0);
-  scm_set_smob_mark (scm_tc16_vm, vm_mark);
-  scm_set_smob_free (scm_tc16_vm, vm_free);
   scm_set_smob_apply (scm_tc16_vm, scm_vm_apply, 1, 0, 1);
 
   scm_c_define ("load-compiled",
@@ -684,6 +656,14 @@ scm_bootstrap_vm (void)
                             (scm_t_extension_init_func)scm_init_vm, NULL);
 
   strappage = 1;
+
+#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
+  vm_stack_gc_kind =
+    GC_new_kind (GC_new_free_list (),
+                GC_MAKE_PROC (GC_new_proc (vm_stack_mark), 0),
+                0, 1);
+
+#endif
 }
 
 void
diff --git a/libguile/weaks.c b/libguile/weaks.c
index 64aa536..92fb305 100644
--- a/libguile/weaks.c
+++ b/libguile/weaks.c
@@ -32,6 +32,92 @@
 #include "libguile/validate.h"
 #include "libguile/weaks.h"
 
+#include "libguile/boehm-gc.h"
+#include <gc/gc_typed.h>
+
+
+
+/* Weak pairs for use in weak alist vectors and weak hash tables.
+
+   We have weal-car pairs, weak-cdr pairs, and doubly weak pairs.  In weak
+   pairs, the weak component(s) are not scanned for pointers and are
+   registered as disapperaring links; therefore, the weak component may be
+   set to NULL by the garbage collector when no other reference to that word
+   exist.  Thus, users should only access weak pairs via the
+   `SCM_WEAK_PAIR_C[AD]R ()' macros.  See also `scm_fixup_weak_alist ()' in
+   `hashtab.c'.  */
+
+/* Type descriptors for weak-c[ad]r pairs.  */
+static GC_descr wcar_pair_descr, wcdr_pair_descr;
+
+
+SCM
+scm_weak_car_pair (SCM car, SCM cdr)
+{
+  scm_t_cell *cell;
+
+  cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
+                                                  wcar_pair_descr);
+
+  cell->word_0 = car;
+  cell->word_1 = cdr;
+
+  if (SCM_NIMP (car))
+    {
+      /* Weak car cells make sense iff the car is non-immediate.  */
+      GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
+                                            (GC_PTR)SCM_UNPACK (car));
+    }
+
+  return (SCM_PACK (cell));
+}
+
+SCM
+scm_weak_cdr_pair (SCM car, SCM cdr)
+{
+  scm_t_cell *cell;
+
+  cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
+                                                  wcdr_pair_descr);
+
+  cell->word_0 = car;
+  cell->word_1 = cdr;
+
+  if (SCM_NIMP (cdr))
+    {
+      /* Weak cdr cells make sense iff the cdr is non-immediate.  */
+      GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
+                                            (GC_PTR)SCM_UNPACK (cdr));
+    }
+
+  return (SCM_PACK (cell));
+}
+
+SCM
+scm_doubly_weak_pair (SCM car, SCM cdr)
+{
+  /* Doubly weak cells shall not be scanned at all for pointers.  */
+  scm_t_cell *cell = (scm_t_cell *)scm_gc_malloc_pointerless (sizeof (*cell),
+                                                             "weak cell");
+
+  cell->word_0 = car;
+  cell->word_1 = cdr;
+
+  if (SCM_NIMP (car))
+    {
+      GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
+                                            (GC_PTR)SCM_UNPACK (car));
+    }
+  if (SCM_NIMP (cdr))
+    {
+      GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
+                                            (GC_PTR)SCM_UNPACK (cdr));
+    }
+
+  return (SCM_PACK (cell));
+}
+
+
 
 
 /* 1. The current hash table implementation in hashtab.c uses weak alist
@@ -56,7 +142,7 @@ SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 
0,
            "empty list.")
 #define FUNC_NAME s_scm_make_weak_vector
 {
-  return scm_i_allocate_weak_vector (0, size, fill);
+  return scm_i_make_weak_vector (0, size, fill);
 }
 #undef FUNC_NAME
 
@@ -72,26 +158,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
            "the same way @code{list->vector} would.")
 #define FUNC_NAME s_scm_weak_vector
 {
-  scm_t_array_handle handle;
-  SCM res, *data;
-  long i;
-
-  i = scm_ilength (l);
-  SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME);
-
-  res = scm_make_weak_vector (scm_from_int (i), SCM_UNSPECIFIED);
-  data = scm_vector_writable_elements (res, &handle, NULL, NULL);
-
-  while (scm_is_pair (l) && i > 0)
-    {
-      *data++ = SCM_CAR (l);
-      l = SCM_CDR (l);
-      i--;
-    }
-
-  scm_array_handle_release (&handle);
-
-  return res;
+  return scm_i_make_weak_vector_from_list (0, l);
 }
 #undef FUNC_NAME
 
@@ -107,6 +174,16 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
 #undef FUNC_NAME
 
 
+/* Weak alist vectors, i.e., vectors of alists.
+
+   The alist vector themselves are _not_ weak.  The `car' (or `cdr', or both)
+   of the pairs within it are weak.  See `hashtab.c' for details.  */
+
+
+/* FIXME: We used to have two implementations of weak hash tables: the one in
+   here and the one in `hashtab.c'.  The difference is that weak alist
+   vectors could be used as vectors while (weak) hash tables can't.  We need
+   to unify that.  */
 
 SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 
1, 0, 
            (SCM size),
@@ -120,8 +197,7 @@ SCM_DEFINE (scm_make_weak_key_alist_vector, 
"make-weak-key-alist-vector", 0, 1,
            "would modify regular hash tables. (@pxref{Hash Tables})")
 #define FUNC_NAME s_scm_make_weak_key_alist_vector
 {
-  return scm_i_allocate_weak_vector
-    (1, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL);
+  return scm_make_weak_key_hash_table (size);
 }
 #undef FUNC_NAME
 
@@ -132,8 +208,7 @@ SCM_DEFINE (scm_make_weak_value_alist_vector, 
"make-weak-value-alist-vector", 0,
            "(@pxref{Hash Tables})")
 #define FUNC_NAME s_scm_make_weak_value_alist_vector
 {
-  return scm_i_allocate_weak_vector
-    (2, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL);
+  return scm_make_weak_value_hash_table (size);
 }
 #undef FUNC_NAME
 
@@ -144,8 +219,7 @@ SCM_DEFINE (scm_make_doubly_weak_alist_vector, 
"make-doubly-weak-alist-vector",
            "buckets.  (@pxref{Hash Tables})")
 #define FUNC_NAME s_scm_make_doubly_weak_alist_vector
 {
-  return scm_i_allocate_weak_vector
-    (3, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL);
+  return scm_make_doubly_weak_hash_table (size);
 }
 #undef FUNC_NAME
 
@@ -183,180 +257,9 @@ SCM_DEFINE (scm_doubly_weak_alist_vector_p, 
"doubly-weak-alist-vector?", 1, 0, 0
 }
 #undef FUNC_NAME
 
-#define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x))
-
-static SCM weak_vectors;
-
-void
-scm_i_init_weak_vectors_for_gc ()
-{
-  weak_vectors = SCM_EOL;
-}
 
-void
-scm_i_mark_weak_vector (SCM w)
-{
-  SCM_I_SET_WVECT_GC_CHAIN (w, weak_vectors);
-  weak_vectors = w;
-}
-
-static int
-scm_i_mark_weak_vector_non_weaks (SCM w)
-{
-  int again = 0;
-
-  if (SCM_IS_WHVEC_ANY (w))
-    {
-      SCM *ptr;
-      long n = SCM_I_WVECT_LENGTH (w);
-      long j;
-      int weak_keys = SCM_IS_WHVEC (w) || SCM_IS_WHVEC_B (w);
-      int weak_values = SCM_IS_WHVEC_V (w) || SCM_IS_WHVEC_B (w);
-
-      ptr = SCM_I_WVECT_GC_WVELTS (w);
-
-      for (j = 0; j < n; ++j)
-       {
-         SCM alist, slow_alist;
-         int slow_toggle = 0;
-
-         /* We do not set the mark bits of the alist spine cells here
-            since we do not want to ever create the situation where a
-            marked cell references an unmarked cell (except in
-            scm_gc_mark, where the referenced cells will be marked
-            immediately).  Thus, we can not use mark bits to stop us
-            from looping indefinitely over a cyclic alist.  Instead,
-            we use the standard tortoise and hare trick to catch
-            cycles.  The fast walker does the work, and stops when it
-            catches the slow walker to ensure that the whole cycle
-            has been worked on.
-         */
-
-         alist = slow_alist = ptr[j];
-
-         while (scm_is_pair (alist))
-           {
-             SCM elt = SCM_CAR (alist);
-
-             if (UNMARKED_CELL_P (elt))
-               {
-                 if (scm_is_pair (elt))
-                   {
-                     SCM key = SCM_CAR (elt);
-                     SCM value = SCM_CDR (elt);
-                 
-                     if (!((weak_keys && UNMARKED_CELL_P (key))
-                           || (weak_values && UNMARKED_CELL_P (value))))
-                       {
-                         /* The item should be kept.  We need to mark it
-                            recursively.
-                         */ 
-                         scm_gc_mark (elt);
-                         again = 1;
-                       }
-                   }
-                 else
-                   {
-                     /* A non-pair cell element.  This should not
-                        appear in a real alist, but when it does, we
-                        need to keep it.
-                     */
-                     scm_gc_mark (elt);
-                     again = 1;
-                   }
-               }
-
-             alist = SCM_CDR (alist);
-
-             if (slow_toggle && scm_is_pair (slow_alist))
-               {
-                 slow_alist = SCM_CDR (slow_alist);
-                 slow_toggle = !slow_toggle;
-                 if (scm_is_eq (slow_alist, alist))
-                   break;
-               }
-           }
-         if (!scm_is_pair (alist))
-           scm_gc_mark (alist);
-       }
-    }
-
-  return again;
-}
-
-int
-scm_i_mark_weak_vectors_non_weaks ()
-{
-  int again = 0;
-  SCM w = weak_vectors;
-  while (!scm_is_null (w))
-    {
-      if (scm_i_mark_weak_vector_non_weaks (w))
-       again = 1;
-      w = SCM_I_WVECT_GC_CHAIN (w);
-    }
-  return again;
-}
-
-static void
-scm_i_remove_weaks (SCM w)
-{
-  SCM *ptr = SCM_I_WVECT_GC_WVELTS (w);
-  size_t n = SCM_I_WVECT_LENGTH (w);
-  size_t i;
-
-  if (!SCM_IS_WHVEC_ANY (w))
-    {
-      for (i = 0; i < n; ++i)
-       if (UNMARKED_CELL_P (ptr[i]))
-         ptr[i] = SCM_BOOL_F;
-    }
-  else
-    {
-      size_t delta = 0;
-
-      for (i = 0; i < n; ++i)
-       {
-         SCM alist, *fixup;
-
-         fixup = ptr + i;
-         alist = *fixup;
-         while (scm_is_pair (alist) && !SCM_GC_MARK_P (alist))
-           {
-             if (UNMARKED_CELL_P (SCM_CAR (alist)))
-               {
-                 *fixup = SCM_CDR (alist);
-                 delta++;
-               }
-             else
-               {
-                 SCM_SET_GC_MARK (alist);
-                 fixup = SCM_CDRLOC (alist);
-               }
-             alist = *fixup;
-           }
-       }
-#if 0
-      if (delta)
-       fprintf (stderr, "vector %p, delta %d\n", w, delta);
-#endif
-      SCM_I_SET_WVECT_DELTA (w, delta);
-    }
-}
-
-void
-scm_i_remove_weaks_from_weak_vectors ()
-{
-  SCM w = weak_vectors;
-  while (!scm_is_null (w))
-    {
-      scm_i_remove_weaks (w);
-      w = SCM_I_WVECT_GC_CHAIN (w);
-    }
-}
 
 
-
 SCM
 scm_init_weaks_builtins ()
 {
@@ -365,6 +268,27 @@ scm_init_weaks_builtins ()
 }
 
 void
+scm_weaks_prehistory ()
+{
+  /* Initialize weak pairs.  */
+  GC_word wcar_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
+  GC_word wcdr_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
+
+  /* In a weak-car pair, only the second word must be scanned for
+     pointers.  */
+  GC_set_bit (wcar_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_1));
+  wcar_pair_descr = GC_make_descriptor (wcar_pair_bitmap,
+                                       GC_WORD_LEN (scm_t_cell));
+
+  /* Conversely, in a weak-cdr pair, only the first word must be scanned for
+     pointers.  */
+  GC_set_bit (wcdr_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_0));
+  wcdr_pair_descr = GC_make_descriptor (wcdr_pair_bitmap,
+                                       GC_WORD_LEN (scm_t_cell));
+
+}
+
+void
 scm_init_weaks ()
 {
   scm_c_define_gsubr ("%init-weaks-builtins", 0, 0, 0,
diff --git a/libguile/weaks.h b/libguile/weaks.h
index 46afd83..908e276 100644
--- a/libguile/weaks.h
+++ b/libguile/weaks.h
@@ -53,6 +53,34 @@
 #define SCM_IS_WHVEC_ANY(X)       (SCM_I_WVECT_TYPE (X) != 0)
 
 
+/* Weak pairs.  */
+
+SCM_API SCM scm_weak_car_pair (SCM car, SCM cdr);
+SCM_API SCM scm_weak_cdr_pair (SCM car, SCM cdr);
+SCM_API SCM scm_doubly_weak_pair (SCM car, SCM cdr);
+
+/* Testing the weak component(s) of a cell for reachability.  */
+#define SCM_WEAK_PAIR_WORD_DELETED_P(_cell, _word)             \
+  (SCM_CELL_OBJECT ((_cell), (_word)) == SCM_PACK (NULL))
+#define SCM_WEAK_PAIR_CAR_DELETED_P(_cell)     \
+  (SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), 0))
+#define SCM_WEAK_PAIR_CDR_DELETED_P(_cell)     \
+  (SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), 1))
+
+#define SCM_WEAK_PAIR_DELETED_P(_cell)         \
+  ((SCM_WEAK_PAIR_CAR_DELETED_P (_cell))       \
+   || (SCM_WEAK_PAIR_CDR_DELETED_P (_cell)))
+
+/* Accessing the components of a weak cell.  */
+#define SCM_WEAK_PAIR_WORD(_cell, _word)               \
+  ((SCM_WEAK_PAIR_WORD_DELETED_P ((_cell), (_word)))   \
+   ? SCM_BOOL_F : SCM_CAR (pair))
+#define SCM_WEAK_PAIR_CAR(_cell)  (SCM_WEAK_PAIR_WORD ((_cell), 0))
+#define SCM_WEAK_PAIR_CDR(_cell)  (SCM_WEAK_PAIR_WORD ((_cell), 1))
+
+
+
+/* Weak vectors and weak hash tables.  */
 
 SCM_API SCM scm_make_weak_vector (SCM k, SCM fill);
 SCM_API SCM scm_weak_vector (SCM l);
@@ -64,6 +92,7 @@ SCM_API SCM scm_weak_key_alist_vector_p (SCM x);
 SCM_API SCM scm_weak_value_alist_vector_p (SCM x);
 SCM_API SCM scm_doubly_weak_alist_vector_p (SCM x);
 SCM_INTERNAL SCM scm_init_weaks_builtins (void);
+SCM_INTERNAL void scm_weaks_prehistory (void);
 SCM_INTERNAL void scm_init_weaks (void);
 
 SCM_INTERNAL void scm_i_init_weak_vectors_for_gc (void);
diff --git a/m4/count-one-bits.m4 b/m4/count-one-bits.m4
deleted file mode 100644
index 8d1410a..0000000
--- a/m4/count-one-bits.m4
+++ /dev/null
@@ -1,12 +0,0 @@
-# count-one-bits.m4 serial 1
-dnl Copyright (C) 2007 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-AC_DEFUN([gl_COUNT_ONE_BITS],
-[
-  dnl We don't need (and can't compile) count_one_bits_ll
-  dnl unless the type 'unsigned long long int' exists.
-  AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT])
-])
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index 930cce6..b3a6d99 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -15,7 +15,7 @@
 
 
 # Specification in the form of a command-line invocation:
-#   gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 
--doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool 
--macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap canonicalize-lgpl 
count-one-bits environ extensions flock fpieee full-read full-write havelib 
iconv_open-utf lib-symbol-versions lib-symbol-visibility libunistring putenv 
stdlib strcase strftime striconveh string verify vsnprintf
+#   gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 
--doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool 
--macro-prefix=gl --no-vc-files alloca-opt autobuild byteswap canonicalize-lgpl 
environ extensions flock fpieee full-read full-write havelib iconv_open-utf 
lib-symbol-versions lib-symbol-visibility libunistring putenv stdlib strcase 
strftime striconveh string verify vsnprintf
 
 # Specification in the form of a few gnulib-tool.m4 macro invocations:
 gl_LOCAL_DIR([])
@@ -24,7 +24,6 @@ gl_MODULES([
   autobuild
   byteswap
   canonicalize-lgpl
-  count-one-bits
   environ
   extensions
   flock
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 00b3f3f..1acdd40 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -48,7 +48,6 @@ AC_DEFUN([gl_INIT],
   gl_BYTESWAP
   gl_CANONICALIZE_LGPL
   gl_MODULE_INDICATOR([canonicalize-lgpl])
-  gl_COUNT_ONE_BITS
   gl_ENVIRON
   gl_UNISTD_MODULE_INDICATOR([environ])
   gl_HEADER_ERRNO_H
@@ -259,7 +258,6 @@ AC_DEFUN([gl_FILE_LIST], [
   lib/canonicalize-lgpl.c
   lib/canonicalize.h
   lib/config.charset
-  lib/count-one-bits.h
   lib/errno.in.h
   lib/float+.h
   lib/float.in.h
@@ -344,7 +342,6 @@ AC_DEFUN([gl_FILE_LIST], [
   m4/byteswap.m4
   m4/canonicalize-lgpl.m4
   m4/codeset.m4
-  m4/count-one-bits.m4
   m4/eealloc.m4
   m4/environ.m4
   m4/errno_h.m4
diff --git a/meta/guile-2.0-uninstalled.pc.in b/meta/guile-2.0-uninstalled.pc.in
index 50d337f..6e687ea 100644
--- a/meta/guile-2.0-uninstalled.pc.in
+++ b/meta/guile-2.0-uninstalled.pc.in
@@ -5,4 +5,4 @@ Name: GNU Guile (uninstalled)
 Description: GNU's Ubiquitous Intelligent Language for Extension (uninstalled)
 Version: @GUILE_VERSION@
 Libs: -L${builddir}/libguile -lguile @GUILE_LIBS@
-Cflags: -I${srcdir} -I${builddir} @GUILE_CFLAGS@
+Cflags: -I${srcdir} -I${builddir} @GUILE_CFLAGS@ @BDW_GC_CFLAGS@
diff --git a/meta/guile-2.0.pc.in b/meta/guile-2.0.pc.in
index 1b43cbc..5cacaaa 100644
--- a/meta/guile-2.0.pc.in
+++ b/meta/guile-2.0.pc.in
@@ -13,4 +13,4 @@ Name: GNU Guile
 Description: GNU's Ubiquitous Intelligent Language for Extension
 Version: @GUILE_VERSION@
 Libs: -L${libdir} -lguile @GUILE_LIBS@
-Cflags: -I${includedir} @GUILE_CFLAGS@
+Cflags: -I${includedir} @GUILE_CFLAGS@ @BDW_GC_CFLAGS@
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a3a1e03..21e3506 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2009
+;;;; Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
 ;;;; Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -1418,7 +1418,17 @@
       ;; Make it possible to lookup the module from the environment.
       ;; This implementation is correct since an eval closure can belong
       ;; to maximally one module.
-      (set-procedure-property! closure 'module module))))
+
+      ;; XXX: The following line introduces a circular reference that
+      ;; precludes garbage collection of modules with the current weak hash
+      ;; table semantics (see
+      ;; 
http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/2465
+      ;; for details).  Since it doesn't appear to be used (only in
+      ;; `scm_lookup_closure_module ()', which has 1 caller), we just comment
+      ;; it out.
+
+      ;(set-procedure-property! closure 'module module)
+      )))
 
 
 
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 7bfef16..476d6e6 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -32,7 +32,6 @@ SCM_TESTS = tests/alist.test                  \
            tests/common-list.test              \
            tests/continuations.test            \
            tests/elisp.test                    \
-           tests/environments.test             \
            tests/eval.test                     \
            tests/exceptions.test               \
            tests/filesys.test                  \
diff --git a/test-suite/standalone/.gitignore b/test-suite/standalone/.gitignore
index 9dadde6..1943936 100644
--- a/test-suite/standalone/.gitignore
+++ b/test-suite/standalone/.gitignore
@@ -10,3 +10,4 @@
 /test-scm-c-read
 /test-fast-slot-ref
 /test-scm-take-locale-symbol
+/test-scm-take-u8vector
diff --git a/test-suite/standalone/Makefile.am 
b/test-suite/standalone/Makefile.am
index 488eb14..1b0d9d6 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -129,6 +129,13 @@ test_scm_take_locale_symbol_LDADD = 
${top_builddir}/libguile/libguile.la
 check_PROGRAMS += test-scm-take-locale-symbol
 TESTS += test-scm-take-locale-symbol
 
+# test-scm-take-u8vector
+test_scm_take_u8vector_SOURCES = test-scm-take-u8vector.c
+test_scm_take_u8vector_CFLAGS = ${test_cflags}
+test_scm_take_u8vector_LDADD = ${top_builddir}/libguile/libguile.la
+check_PROGRAMS += test-scm-take-u8vector
+TESTS += test-scm-take-u8vector
+
 # test-extensions
 noinst_LTLIBRARIES += libtest-extensions.la
 libtest_extensions_la_SOURCES = test-extensions-lib.c
diff --git a/test-suite/standalone/test-scm-take-locale-symbol.c 
b/test-suite/standalone/test-scm-take-u8vector.c
similarity index 61%
copy from test-suite/standalone/test-scm-take-locale-symbol.c
copy to test-suite/standalone/test-scm-take-u8vector.c
index 808068f..fff3af4 100644
--- a/test-suite/standalone/test-scm-take-locale-symbol.c
+++ b/test-suite/standalone/test-scm-take-u8vector.c
@@ -16,8 +16,9 @@
  * 02110-1301 USA
  */
 
-/* Exercise `scm_take_locale_symbol ()', making sure it returns an interned
-   symbol.  See https://savannah.gnu.org/bugs/index.php?25865 .  */
+/* Make sure `scm_take_u8vector ()' returns a u8vector that actually uses the
+   provided storage.  */
+
 
 #ifdef HAVE_CONFIG_H
 # include <config.h>
@@ -26,31 +27,31 @@
 #include <libguile.h>
 
 #include <stdlib.h>
-#include <string.h>
 
 
 static void *
 do_test (void *result)
 {
-  SCM taken_sym, sym;
+#define LEN 123
+  SCM u8v;
+  scm_t_uint8 *data;
+  scm_t_array_handle handle;
 
-  taken_sym = scm_take_locale_symbol (strdup ("some random symbol"));
-  sym = scm_from_locale_symbol ("some random symbol");
+  data = scm_malloc (LEN);
+  u8v = scm_take_u8vector (data, LEN);
 
-  if (scm_is_true (scm_symbol_p (sym))
-      && scm_is_true (scm_symbol_p (taken_sym))
+  scm_array_get_handle (u8v, &handle);
 
-      /* Relying solely on `scm_symbol_interned_p ()' is insufficient since
-        it doesn't reflect the actual state of the symbol hashtable, hence
-        the additional `scm_is_eq' test.  */
-      && scm_is_true (scm_symbol_interned_p (sym))
-      && scm_is_true (scm_symbol_interned_p (taken_sym))
-      && scm_is_eq (taken_sym, sym))
+  if (scm_array_handle_u8_writable_elements (&handle) == data
+      && scm_array_handle_u8_elements (&handle) == data)
     * (int *) result = EXIT_SUCCESS;
   else
     * (int *) result = EXIT_FAILURE;
 
+  scm_array_handle_release (&handle);
+
   return NULL;
+#undef LEN
 }
 
 int
diff --git a/test-suite/tests/bytevectors.test 
b/test-suite/tests/bytevectors.test
index 8b336bb..1009fb0 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -565,6 +565,9 @@
     (equal? (with-input-from-string "#vu8(0 255 127 128)" read)
             (u8-list->bytevector '(0 255 127 128))))
 
+  (pass-if "self-evaluating?"
+    (self-evaluating? (make-bytevector 1)))
+
   (pass-if "self-evaluating"
     (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read)
                   (current-module))
diff --git a/test-suite/tests/environments.test 
b/test-suite/tests/environments.nottest
similarity index 99%
rename from test-suite/tests/environments.test
rename to test-suite/tests/environments.nottest
index 61ced35..90ef80f 100644
--- a/test-suite/tests/environments.test
+++ b/test-suite/tests/environments.nottest
@@ -15,7 +15,8 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
-(use-modules (ice-9 documentation))
+(use-modules (ice-9 documentation)
+            (test-suite lib))
 
 ;;; environments are currently commented out of libguile, so these
 ;;; tests must be commented out also. - NJ 2006-11-02.
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index 5c485ab..063dad6 100644
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -1,5 +1,5 @@
 ;;;; gc.test --- test guile's garbage collection    -*- scheme -*-
-;;;; Copyright (C) 2000, 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008 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
@@ -59,12 +59,10 @@
 
 (with-test-prefix "gc"
   (pass-if "Unused modules are removed"
-          (let*
-              ((dummy (gc))
-               (last-count (cdr (assoc
-                                 "eval-closure" (gc-live-object-stats)))))
+          (let* ((guard (make-guardian))
+                  (total 1000))
 
-            (for-each (lambda (x) (make-module)) (iota 1000))
+            (for-each (lambda (x) (guard (make-module))) (iota total))
 
             ;; XXX: This hack aims to clean up the stack to make sure we
             ;; don't leave a reference to one of the modules we created.  It
@@ -76,5 +74,8 @@
 
             (gc)
             (gc) ;; twice: have to kill the weak vectors.
-            (= last-count (cdr (assoc "eval-closure" (gc-live-object-stats)))))
-          ))
+             (= (length (filter (lambda (x)
+                                  (eq? x #t))
+                                (map (lambda (x) (and (guard) #t))
+                                     (iota total))))
+                total))))
diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test
index b675f02..470de45 100644
--- a/test-suite/tests/guardians.test
+++ b/test-suite/tests/guardians.test
@@ -18,8 +18,18 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
 ;;; These tests make some questionable assumptions.
+;;;
 ;;; - They assume that a GC will find all dead objects, so they
 ;;;   will become flaky if we have a generational GC.
+;;;
+;;; - More generally, when a weakly referenced object doesn't disappear as
+;;;   expected, it's hard to tell whether that's because of a guardian bug of
+;;;   because a reference to it is being held somewhere, e.g., one some part
+;;;   of the stack that hasn't been overwritten.  Thus, most tests cannot
+;;;   fail, they can just throw `unresolved'.  We try hard to clear
+;;;   references that may have been left on the stacks (see "clear refs left
+;;;   on the stack" lines).
+;;;
 ;;; - They assume that objects won't be saved by the guardian until
 ;;;   they explicitly invoke GC --- in other words, they assume that GC
 ;;;   won't happen too often.
@@ -41,11 +51,18 @@
 (gc)
 
 ;;; Who guards the guardian?
+
+;;; Note: We use strings rather than symbols because symbols are usually
+;;; ``interned'', i.e., kept in a weakly-keyed hash table, thus making them
+;;; inappropriate for the tests below.  Furthermore, we use `string-copy' in
+;;; order to make sure that no string is kept around in the interpreter
+;;; unwillingly (e.g., in the source-property weak hash table).
+
 (gc)
 (define g2 (make-guardian))
-(g2 (list 'g2-garbage))
+(g2 (list (string-copy "g2-garbage")))
 (define g3 (make-guardian))
-(g3 (list 'g3-garbage))
+(g3 (list (string-copy "g3-garbage")))
 (g3 g2)
 (pass-if "g2-garbage not collected yet" (equal? (g2) #f))
 (pass-if "g3-garbage not collected yet" (equal? (g3) #f))
@@ -59,15 +76,37 @@
       (if saved
          (begin
            (cond
-            ((equal? saved '(g3-garbage)) (set! seen-g3-garbage #t))
+            ((equal? saved (list (string-copy "g3-garbage")))
+             (set! seen-g3-garbage #t))
             ((procedure? saved) (set! seen-g2 saved))
-            (else (pk saved) (set! seen-something-else #t)))
+            (else (pk 'junk saved) (set! seen-something-else #t)))
            (loop)))))
   (pass-if "g3-garbage saved" (or seen-g3-garbage (throw 'unresolved)))
   (pass-if "g2-saved" (or (procedure? seen-g2) (throw 'unresolved)))
   (pass-if "nothing else saved" (not seen-something-else))
+
+  ;; FIXME: The following test fails because the guardian for `g2-garbage'
+  ;; disappared from the weak-car guardian list of `g2-garbage' right before
+  ;; `g2-garbage' was finalized (in `finalize_guarded ()').  Sample session
+  ;; (compiled with `-DDEBUG_GUARDIANS'):
+  ;;
+  ;; guile> (define g (make-guardian))
+  ;; guile> (let ((g2 (make-guardian)))
+  ;;          (format #t "g2 = ~x~%" (object-address g2))
+  ;;          (g2 (string-copy "foo"))
+  ;;          (g g2))
+  ;; g2 = 81fde18
+  ;; guile> (gc)
+  ;; finalizing guarded 0x827f6a0 (1 guardians)
+  ;;   guardian for 0x827f6a0 vanished
+  ;; end of finalize (0x827f6a0)
+  ;; finalizing guarded 0x81fde18 (1 guardians)
+  ;; end of finalize (0x81fde18)
+
   (pass-if "g2-garbage saved" (or (and (procedure? seen-g2)
-                                      (equal? (seen-g2) '(g2-garbage)))
+                                      (equal? (seen-g2)
+                                              (list (string-copy
+                                                     "g2-garbage"))))
                                  (throw 'unresolved))))
 
 (with-test-prefix "standard guardian functionality"
@@ -107,6 +146,7 @@
       (let ((g (make-guardian)))
        (gc)
        (g (cons #f #f))
+        (cons 'clear 'stack)  ;; clear refs left on the stack
        (if (not (eq? (g) #f))
            (throw 'unresolved)
            (begin
@@ -120,6 +160,7 @@
        (gc)
        (g (cons #f #f))
        (g (cons #t #t))
+        (cons 'clear 'stack)  ;; clear refs left on the stack
        (if (not (eq? (g) #f))
            (throw 'unresolved)
            (begin
@@ -134,6 +175,7 @@
       (let ((g (make-guardian)))
        (gc)
        (g (cons #f #f))
+        (cons 'clear 'stack)  ;; clear refs left on the stack
        (if (not (eq? (g) #f))
            (throw 'unresolved)
            (begin
@@ -167,7 +209,8 @@
        (gc)
        (let ((p (cons #f #f)))
          (g p)
-         (vector-set! v 0 p))
+         (vector-set! v 0 p)
+          (set! p #f))           ;; clear refs left on the stack
        (if (not (eq? (g) #f))
            (throw 'unresolved)
            (begin
@@ -182,7 +225,8 @@
        (gc)
        (let ((p (cons #f #f)))
          (g p)
-         (vector-set! v 0 p))
+         (vector-set! v 0 p)
+          (set! p #f))        ;; clear refs left on the stack
        (begin
          (gc)
          (if (not (equal? (g) (cons #f #f)))
@@ -196,7 +240,11 @@
 
     (pass-if "element of guarded weak vector gets collected"
       (let ((g (make-guardian))
-           (v (weak-vector (cons #f #f))))
+           (v (weak-vector #f)))
+        ;; Note: We don't pass `(cons #f #f)' as an argument to `weak-vector'
+        ;; otherwise references to it are likely to be left on the stack.
+        (vector-set! v 0 (cons #f #f))
+
        (g v)
        (gc)
        (if (equal? (vector-ref v 0) (cons #f #f))
@@ -240,7 +288,8 @@
         (gc)
         (let ((p (cons #f #f)))
           (g p)
-          (g p))
+          (g p)
+           (set! p #f))       ;; clear refs left on the stack
         (if (not (eq? (g) #f))
             (throw 'unresolved)
             (begin
@@ -255,7 +304,8 @@
         (gc)
         (let ((p (cons #f #f)))
           (g p)
-          (h p))
+          (h p)
+           (set! p #f))         ;; clear refs left on the stack
         (if (not (eq? (g) #f))
             (throw 'unresolved)
             (begin
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index 3f24537..c78fe55 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -63,26 +63,6 @@
     (let ((s (substring/read-only "zyx" 0)))
       (assq-ref (%string-dump s) 'read-only)))
 
-  (pass-if "null strings are inlined"
-    (let ((s ""))
-      (assq-ref (%string-dump s) 'stringbuf-inline)))
-
-  (pass-if "short Latin-1 encoded strings are inlined"
-    (let ((s "m"))
-      (assq-ref (%string-dump s) 'stringbuf-inline)))
-
-  (pass-if "long Latin-1 encoded strings are not inlined"
-    (let ((s "0123456789012345678901234567890123456789"))
-      (not (assq-ref (%string-dump s) 'stringbuf-inline))))
-
-  (pass-if "short UCS-4 encoded strings are not inlined"
-    (let ((s "\u0100"))
-      (not (assq-ref (%string-dump s) 'stringbuf-inline))))
-
-  (pass-if "long UCS-4 encoded strings are not inlined"
-    (let ((s "\u010012345678901234567890123456789"))
-      (not (assq-ref (%string-dump s) 'stringbuf-inline))))
-
   (pass-if "new Latin-1 encoded strings are not shared"
     (let ((s "abc"))
       (not (assq-ref (%string-dump s) 'stringbuf-shared))))
diff --git a/test-suite/tests/symbols.test b/test-suite/tests/symbols.test
index b6dbb9d..c87aa21 100644
--- a/test-suite/tests/symbols.test
+++ b/test-suite/tests/symbols.test
@@ -49,25 +49,6 @@
       (string=? (symbol->string s) 
                 (assq-ref (%symbol-dump s) 'stringbuf-chars))))
 
-  (pass-if "the null symbol is inlined"
-    (let ((s '#{}#))
-      (assq-ref (%symbol-dump s) 'stringbuf-inline)))
-
-  (pass-if "short Latin-1-encoded symbols are inlined"
-    (let ((s 'm))
-      (assq-ref (%symbol-dump s) 'stringbuf-inline)))
-
-  (pass-if "long Latin-1-encoded symbols are not inlined"
-    (let ((s 'x0123456789012345678901234567890123456789))
-      (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
-
-  (pass-if "short UCS-4-encoded symbols are not inlined"
-    (let ((s (string->symbol "\u0100")))
-      (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
-
-  (pass-if "long UCS-4-encoded symbols are not inlined"
-    (let ((s (string->symbol "\u010012345678901234567890123456789")))
-      (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
 
   (with-test-prefix "hashes"
   


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]