guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, boehm-demers-weiser-gc, updated. relea


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, boehm-demers-weiser-gc, updated. release_1-9-2-275-gd6097d1
Date: Sun, 30 Aug 2009 23:15:54 +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=d6097d1d63a269ce960c47f81902aaaf26d46a64

The branch, boehm-demers-weiser-gc has been updated
       via  d6097d1d63a269ce960c47f81902aaaf26d46a64 (commit)
       via  760fb97d1f5ae2fc745cbe6b6af3d8fe0023ebbd (commit)
       via  7af531508c5931261ff8957708642cac67bf86a5 (commit)
       via  ce3ed0125fcfb9ad09da815f133a2320102d164c (commit)
       via  8736ef70acf603447cfcf697d44b8a46e8e53191 (commit)
       via  d5ecf5797dade3882db816bd0a325568e3610ade (commit)
       via  d0434ddf2522265b7e023ca84c8b3b4773f2459c (commit)
       via  a27173cf78a03758317dfe5571380ed3347fa242 (commit)
       via  1505848425bf149f864ea106bce71447f739012d (commit)
       via  639bf3e507959ca53fef713306eb33f1074f1588 (commit)
       via  cdc4f3db09727cc1613f7a2fd2335efa10a9d53f (commit)
       via  c0d316cce78b317b68dc3dc590256ef832721a2b (commit)
       via  ba5f8bf4b1ff19871222d832a446c5e54da64b93 (commit)
       via  248ee86a0bd9d1481dff4d76508bbc7595a04314 (commit)
       via  fa316af70ff11767d9a8eb971d9e0b888152a15c (commit)
       via  026ed23911032ed8880af97d993315615b9f5b07 (commit)
       via  930ddd34c32b2cad49ffb254951e3cac50c1b341 (commit)
       via  f49dbcadf3829fe6ca2e4815c2af772360d454e8 (commit)
       via  3bcf189ba0d903e42935154c499ad60e1bf9cb3b (commit)
       via  71a5964c110bea93ac926331547c25bdff67ce23 (commit)
       via  a66480374ed6dfc2d012c6df39c1382ba87ed9d0 (commit)
       via  4769c9db2c7949ede3b637d5e64d90519a4932e0 (commit)
       via  5a70cf0a6c318be6faf5c063128e14a492c7b06b (commit)
       via  023cd5ba587a874ccb85daa312cdcec613b28b96 (commit)
       via  c6a1380bde978194ee5c533246285f6af4bbb554 (commit)
       via  108e18b18abc066b2709a09283751e9138ccc935 (commit)
       via  889975e51accb80491af76fc5db980aeb3edd342 (commit)
       via  9db8cf1634ca9a91cb88b2532f7b87f2502b4abd (commit)
       via  587a33556fdef90025c1b7d4d172af649c8ebba8 (commit)
       via  27646f414e9350c2bf9f35982082bcabfb475c5d (commit)
       via  806f1ded951f92cdd3ed243daad5d97754568480 (commit)
       via  c15d8e6ab9bf991ca55038fa895993bbb4c1efaa (commit)
       via  a4dbe1ac3dacf365263023c4fe1cd6ffb4a894b7 (commit)
       via  d5ed380ec83a2f42cacc40697717679bf03e6857 (commit)
       via  1b872adf2e7d2a1e3e92f869e77f7810d4356e35 (commit)
       via  67a967348acc662c7d0a9844504c0d017619be99 (commit)
       via  916f175fb40cd20ee48f808b21d7a6a32d12dd17 (commit)
       via  5f5f251895818a8dec3acfc3832012088d07a7ee (commit)
       via  cdf8f9e6328ff86c1828a16540a607c46f76963a (commit)
       via  3f47e5262103a01476c9df5275d23f4364cb4266 (commit)
       via  e23106d53eb03d7cb4962282396269176ea7482e (commit)
       via  90305ce9e429f0381ff79427e71287fdafd4d201 (commit)
       via  832bbc95a239bdd1f07133be2377d485c3f43034 (commit)
       via  43d5626ce7b51c6f9c06b3a5fe513003778402c8 (commit)
       via  68a30f5730e73b9792565c3c99b5724752472a85 (commit)
       via  0193377d24db3ec57ea9be488069a4b86878e6e6 (commit)
       via  7f5946427e457b5588b1a5103dc4652bd9a99392 (commit)
       via  1549532ccb4eb13143bbce43ab6fdc80e6bbfb37 (commit)
       via  7a5ab3693ca5be77f1014130eff3bb3cf483e8be (commit)
       via  afe5e6baa76796b1467890fd55416a7f304bed5c (commit)
       via  2fb924f64f6cf47a9b4d6e8a22433ac2c5739379 (commit)
       via  cdde57b2f11a6c28518aebed234b98ce5bd7131f (commit)
       via  12136c7148485e1a32cc1c59797289f46706fd45 (commit)
       via  32aa2111591bb4a98124646d26d92d17d1b6dc6d (commit)
       via  7ea9a0a764f7219deb4eb3bd85b60e9d8368aca5 (commit)
       via  8274228f79ac2b2371b83d0e88b648c18d2e6103 (commit)
       via  b7946e9ec6cfb9d2d50d9f4e8cbf2532924b0a5b (commit)
       via  03e6c1659623d1aac4121730c1e453c626042c47 (commit)
       via  d94be25f72d217a484b4f4c9b742c610fc9e501c (commit)
       via  609edba7eaa2bb30df90a09541a48d97ab4a3bf8 (commit)
       via  48a0fe4d6bd105bcf959752df4ac8704c9bb218a (commit)
       via  53a468dd8c2d8a6552b1b7ed4025414fc219d21d (commit)
       via  f846bd1a8f0e0d366fb8bb6944598641bc3dd246 (commit)
       via  1441e6dbd756c2e78abfe13b0b9af261fcecfc05 (commit)
       via  1b9ac4580c9405b7e665cbf8c88b85fe73627e9f (commit)
       via  06b961904de0c3007763b0e5bd21cc9f8afebe76 (commit)
       via  2759c092d0fe200dd5abee9b1e8a7f5123e25e5d (commit)
       via  9aa27c1a30c222ab668d8d6fc7aa7ad815282594 (commit)
       via  f8ba2bb9117d75c93503fe3dde9054f5ff92c51c (commit)
       via  1c7b216f848fd454db15881709ed766323cdeed3 (commit)
       via  2a0db0e326137cbf3b462376872c1d9f06c2bd52 (commit)
       via  6234ff203d640f56bc5d160d9fe882b0f02b1401 (commit)
       via  f59cf9981a84515b56359c5af56d7e787ad4d474 (commit)
       via  8ef6962953d8377ce2157f4edd5ba469169728ba (commit)
       via  3dd11c9b130f54895efced104043022ea4609879 (commit)
       via  7f171dbfa04ee80ae5486e5eab637dce9c1d640a (commit)
       via  9591a2b016c5c11d2cd92ff0d43cd511f28bc07f (commit)
       via  3d8e6eb82e2c1f83338d938a9fd10b68ca6c473a (commit)
       via  8d9cb14e61b1487f3666cabc98fbf7d329e329d6 (commit)
       via  aba0dff5f7ee451b44af771f8ab09b750ce15f74 (commit)
       via  f618f4363dc0a2ba96178fddf364b357e49600b2 (commit)
       via  9e7ec8d16cd7f25c77ad35461bd7256c118ec3e1 (commit)
       via  cdb86258999b06a9a61215596d691a76ea6c6130 (commit)
       via  326b551b75bbf7943474d6f897a01aac568a55b9 (commit)
       via  d4a9d8759c4dfd918ea10a50741b28b92c512b00 (commit)
       via  e946b0b9553a862d8bbc2ef6bdc5195dc6d7ad47 (commit)
       via  0ac8a9aeab94f59b83532dc4f8595ed72eb4d9e0 (commit)
       via  769be03f337b5f9f0360609e417eeb9ad6f34117 (commit)
       via  5e328915a166720037892f17bb7fe1572bc04ba1 (commit)
       via  11b4e1a59c2b012aeabbf3cf96c849ee4f4edcb3 (commit)
       via  45867c2ace30469cbc40431756ed144762806d8d (commit)
       via  650ecada5e96d79b7ad6f2437ee5fecb8b87d5fa (commit)
       via  22b5f518f6e72e97ebcce6396876035e05aaff85 (commit)
       via  d99832a24b02175cf155a117ecf3ccb32ac548bf (commit)
       via  eb12b40182d3a52ab873c2d2d2b877e245272c0d (commit)
       via  ce2612cd886f10392161fca4daca84b903e5cefb (commit)
       via  1021bb7a8de9483aaebde15d5830b36a91b5621b (commit)
       via  31c73458db49f8cc68934a1070349f82246a75b9 (commit)
       via  a7c5a2e5fdceed46db674f533fa203962030c1b6 (commit)
       via  cd43fdc5b7a7c851ee0f2b4e96a1f394fb50d869 (commit)
       via  e286c973fcd63c0930d9302cc5f1a280b9b22615 (commit)
       via  f332089ed43761440a2a8c272ee61a709b38cc24 (commit)
       via  ac8ed3db31769d7ede5e75fba1697e8dde55fae4 (commit)
       via  943a0a8759504c4a367c1904bef4a8afbc6208dd (commit)
       via  f45eccffa73c043466a4cc0f5037132ee5795eee (commit)
       via  476b894c71b436f3befb8af46b899aaf244763e2 (commit)
       via  f332e9571703ddcd27c51ebe3c847459c2a649b7 (commit)
       via  1030b45049f564f4abd459abd8e59db34c7867cc (commit)
       via  66b9d7d304a349d5bb4f763a47143f09da58d97f (commit)
       via  2a610be59412a9d633a373c6f6ec4d4794c40fd8 (commit)
       via  2fa901a51f62da8a01112aefbf687530f4bff160 (commit)
       via  cf396142405d9076cc20eca9bf53376e80359a56 (commit)
       via  c53c0893a3bad3312230003707f71c2f441460d4 (commit)
       via  5d1b3b2db9349b615baac313ae5a111fa68573ac (commit)
       via  b6149d8d9f35c8091a31b12fb3aeecee0e3a470c (commit)
       via  a4a0d399c877cb802cdaf2c48713d3377a412c4f (commit)
       via  4b126598445c4f12c0aebca2adfaa45f3edd86ab (commit)
       via  86d88a223c64276e7cd9b4503e7e2ecca5aae320 (commit)
       via  8a40db3714628f88b138017835d448231257d13b (commit)
       via  57692c07427cb2b3f193df2e998e30cf7616e567 (commit)
       via  c0c8dc84eacc41cc81d43b24d8caf7e927b09150 (commit)
       via  72553cb0ce71d38c46c336ce48c151919a83ba60 (commit)
       via  a9408365f9e34cdedef0cbaa6af1124a1e978ee9 (commit)
       via  2cbe132f07aebf1a4db8227670d871e4da3f9202 (commit)
       via  1a2285752e1c16c167d84b23f9e8fe86319c51e2 (commit)
       via  8b0872202395e5f35064eaf6ac6b56977de6dff2 (commit)
      from  f86f3b5b113b4cb383c531150b13bef9b2789221 (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 d6097d1d63a269ce960c47f81902aaaf26d46a64
Author: Ludovic Courtès <address@hidden>
Date:   Fri Aug 28 21:08:07 2009 +0200

    Add `BDW_GC_CFLAGS' to the `.pc' files.
    
    This is needed because <gc/gc.h> is included in public headers (via
    <libguile/boehm-gc.h>.
    
    * meta/guile-2.0-uninstalled.pc.in (Cflags): Add address@hidden'.
    
    * meta/guile-2.0.pc.in (Cflags): Likewise.

commit 760fb97d1f5ae2fc745cbe6b6af3d8fe0023ebbd
Author: Ludovic Courtès <address@hidden>
Date:   Fri Aug 28 20:25:49 2009 +0200

    Remove deprecated variables/macros from the GC headers.
    
    * libguile/deprecated.c (scm_mtrigger, scm_mallocated,
      scm_max_segment_size): New global variables, from gc.c.
      (scm_map_free_list,
      scm_gc_set_debug_check_freelist_x)[GUILE_DEBUG_FREELIST]: New stubs.
    
    * libguile/deprecated.h (scm_mallocated, scm_mtrigger,
      scm_max_segment_size): New declarations.
      (scm_map_free_list,
      scm_gc_set_debug_check_freelist_x)[GUILE_DEBUG_FREELIST]: New
      declarations.
    
    * libguile/gc-malloc.c (scm_i_minyield_malloc): Remove.
      (scm_gc_init_malloc): Remove references to `scm_i_minyield_malloc' and
      `scm_mtrigger'.
    
    * libguile/gc.c (scm_mtrigger, scm_mallocated): Remove.
      (scm_init_storage): Remove reference to `SCM_HEAP_SEG_SIZE'.
    
    * libguile/gc.h (scm_max_segment_size, SCM_SET_FREELIST_LOC,
      SCM_FREELIST_LOC, scm_i_master_freelist, scm_i_master_freelist2,
      scm_mallocated, scm_mtrigger): Remove.
      (scm_map_free_list,
      scm_gc_set_debug_check_freelist_x)[SCM_ENABLE_DEPRECATED &&
      GUILE_DEBUG_FREELIST]: Remove.
    
    * libguile/private-gc.h (SCM_DEFAULT_INIT_HEAP_SIZE_1,
      SCM_DEFAULT_MIN_YIELD_1, SCM_DEFAULT_MIN_YIELD_2,
      DEFAULT_SWEEP_AMOUNT, SCM_DEFAULT_MAX_SEGMENT_SIZE,
      SCM_MIN_HEAP_SEG_SIZE, SCM_HEAP_SEG_SIZE,
      SCM_GC_CARD_BVEC_SIZE_IN_LONGS, SCM_GC_IN_CARD_HEADERP): Remove.
      (scm_getenv_int): Made internal.
      (scm_i_marking, scm_mark_all, scm_i_deprecated_memory_return,
      scm_i_find_heap_calls, scm_gc_init_malloc, scm_gc_init_freelist,
      scm_gc_init_segments, scm_gc_init_mark): Remove declarations.
    
    * libguile/gc-segment-table.c: Remove, finally.

commit 7af531508c5931261ff8957708642cac67bf86a5
Merge: f86f3b5b113b4cb383c531150b13bef9b2789221 
ce3ed0125fcfb9ad09da815f133a2320102d164c
Author: Ludovic Courtès <address@hidden>
Date:   Fri Aug 28 19:01:19 2009 +0200

    Merge branch 'master' into boehm-demers-weiser-gc
    
    Conflicts:
        libguile/Makefile.am
        libguile/bytevectors.c
        libguile/gc-card.c
        libguile/gc-mark.c
        libguile/programs.c
        libguile/srcprop.c
        libguile/srfi-14.c
        libguile/symbols.c
        libguile/threads.c
        libguile/unif.c
        libguile/vm.c

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

Summary of changes:
 .gitignore                                         |    5 +-
 AUTHORS                                            |   29 +-
 Makefile.am                                        |    3 +
 NEWS                                               |  157 +-
 README                                             |    5 +-
 THANKS                                             |    4 +
 acinclude.m4                                       |   69 +
 benchmark-suite/benchmarks/chars.bm                |   57 +
 benchmark-suite/benchmarks/srfi-13.bm              |  310 +
 check-guile.in                                     |    2 +-
 configure.ac                                       |   14 +-
 doc/Makefile.am                                    |    2 +-
 doc/README                                         |    4 -
 doc/goops/Makefile.am                              |   29 -
 doc/ref/.gitignore                                 |    1 +
 .../ChangeLog-2008 => ref/ChangeLog-goops-2008}    |    0
 doc/ref/Makefile.am                                |   13 +-
 doc/ref/api-compound.texi                          |   37 +-
 doc/ref/api-control.texi                           |   28 +
 doc/ref/api-data.texi                              |   25 +-
 doc/ref/api-debug.texi                             |   66 +-
 doc/ref/api-io.texi                                |   16 +-
 doc/ref/api-modules.texi                           |   46 +-
 doc/ref/api-options.texi                           |   15 +-
 doc/ref/api-scheduling.texi                        |   63 +-
 doc/ref/autoconf.texi                              |   17 +-
 doc/ref/compiler.texi                              |    3 +-
 doc/ref/effective-version.texi.in                  |    1 +
 doc/ref/expect.texi                                |   16 +-
 doc/{goops => ref}/goops-tutorial.texi             |  392 +-
 doc/{goops => ref}/goops.texi                      |  391 +-
 doc/ref/guile.texi                                 |   17 +-
 doc/{goops => ref}/hierarchy.eps                   |    0
 doc/{goops => ref}/hierarchy.pdf                   |    0
 doc/{goops => ref}/hierarchy.png                   |  Bin 6251 -> 6251 bytes
 doc/{goops => ref}/hierarchy.txt                   |    0
 doc/ref/intro.texi                                 |   18 +-
 doc/ref/libguile-extensions.texi                   |    4 +-
 doc/ref/libguile-linking.texi                      |    3 +-
 doc/ref/libguile-smobs.texi                        |   26 +-
 doc/{goops => ref}/mop.text                        |    0
 doc/ref/posix.texi                                 |    4 +-
 doc/ref/preface.texi                               |   24 +-
 doc/ref/scheme-debugging.texi                      |   12 +-
 doc/ref/scheme-ideas.texi                          |    6 +-
 doc/ref/scsh.texi                                  |    4 +-
 doc/ref/slib.texi                                  |   13 +-
 doc/ref/tools.texi                                 |    6 +-
 doc/ref/vm.texi                                    |  132 +-
 emacs/gds-faq.txt                                  |  225 +
 emacs/gds-scheme.el                                |   17 +-
 emacs/gds-server.el                                |   19 +-
 emacs/gds-test.el                                  |  166 +
 emacs/gds-test.sh                                  |    2 +
 emacs/gds-test.stdin                               |    1 +
 emacs/gds-tutorial.txt                             |  223 +
 emacs/gds.el                                       |   27 +-
 guile-readline/Makefile.am                         |   37 +-
 guile-readline/autogen.sh                          |    8 -
 guile-readline/configure.ac                        |   88 -
 guile-readline/ice-9/Makefile.am                   |   28 -
 guile-readline/readline.c                          |    8 +-
 lang/elisp/interface.scm                           |    5 +-
 libguile.h                                         |    9 +-
 libguile/Makefile.am                               |  475 ++-
 libguile/__scm.h                                   |   24 +-
 libguile/_scm.h                                    |    2 +-
 libguile/array-handle.c                            |  162 +
 libguile/array-handle.h                            |  129 +
 libguile/{ramap.c => array-map.c}                  |   25 +-
 libguile/{ramap.h => array-map.h}                  |   10 +-
 libguile/arrays.c                                  | 1156 ++++
 libguile/arrays.h                                  |   91 +
 libguile/bitvectors.c                              |  910 +++
 libguile/bitvectors.h                              |   81 +
 libguile/bytevectors.c                             |  322 +-
 libguile/bytevectors.h                             |   16 +-
 libguile/chars.c                                   |   10 +-
 libguile/chars.h                                   |   18 +-
 libguile/continuations.c                           |    6 +-
 libguile/continuations.h                           |    2 +-
 libguile/conv-uinteger.i.c                         |   25 +-
 libguile/convert.c                                 |  147 -
 libguile/convert.h                                 |   51 -
 libguile/convert.i.c                               |  171 -
 libguile/debug.c                                   |    1 +
 libguile/deprecated.c                              |   63 +-
 libguile/deprecated.h                              |   20 +
 libguile/discouraged.c                             |    2 +-
 libguile/eq.c                                      |    6 +-
 libguile/error.c                                   |   13 +
 libguile/error.h                                   |    2 +
 libguile/eval.c                                    |    6 +-
 libguile/eval.i.c                                  |   29 +-
 libguile/evalext.c                                 |    1 +
 libguile/extensions.c                              |    5 +-
 libguile/filesys.c                                 |   60 +-
 libguile/fports.c                                  |    4 +-
 libguile/frames.c                                  |    8 +-
 libguile/frames.h                                  |   40 +-
 libguile/gc-malloc.c                               |   23 +-
 libguile/gc-segment-table.c                        |  300 -
 libguile/gc.c                                      |   11 +-
 libguile/gc.h                                      |   22 -
 libguile/generalized-arrays.c                      |  276 +
 libguile/generalized-arrays.h                      |   63 +
 libguile/generalized-vectors.c                     |  201 +
 libguile/generalized-vectors.h                     |   61 +
 libguile/goops.c                                   |   66 +-
 libguile/hash.c                                    |   17 +-
 libguile/hash.h                                    |    1 +
 libguile/init.c                                    |   27 +-
 libguile/inline.h                                  |   42 +-
 libguile/load.c                                    |   32 +-
 libguile/load.h                                    |    1 +
 libguile/numbers.c                                 |  125 +-
 libguile/numbers.h                                 |    7 +-
 libguile/ports.c                                   |  582 ++-
 libguile/ports.h                                   |   20 +-
 libguile/posix.c                                   |   46 +-
 libguile/posix.h                                   |    1 +
 libguile/print.c                                   |  175 +-
 libguile/print.h                                   |    4 +-
 libguile/private-gc.h                              |   67 +-
 libguile/procprop.c                                |    6 +
 libguile/procs.c                                   |    9 +
 libguile/programs.c                                |   59 +-
 libguile/programs.h                                |   18 +-
 libguile/random.c                                  |    5 +-
 libguile/rdelim.c                                  |    6 +-
 libguile/read.c                                    |  392 +-
 libguile/read.h                                    |    2 +
 libguile/socket.c                                  |   36 +-
 libguile/sort.c                                    |    6 +-
 libguile/srcprop.c                                 |  135 +-
 libguile/srcprop.h                                 |    2 -
 libguile/srfi-13.c                                 | 1508 ++---
 libguile/srfi-14.c                                 | 1477 +++--
 libguile/srfi-14.h                                 |   34 +-
 libguile/srfi-14.i.c                               | 7150 ++++++++++++++++++++
 libguile/srfi-4.c                                  |  329 +-
 libguile/srfi-4.h                                  |   31 +-
 libguile/srfi-4.i.c                                |   15 +-
 libguile/stime.c                                   |   50 +-
 libguile/strings.c                                 |  388 +-
 libguile/strings.h                                 |    7 +-
 libguile/strports.c                                |  139 +-
 libguile/strports.h                                |    6 +
 libguile/struct.c                                  |   76 +-
 libguile/symbols.c                                 |  110 +-
 libguile/tags.h                                    |    2 +-
 libguile/threads.c                                 |    6 +-
 libguile/threads.h                                 |    2 +-
 libguile/throw.c                                   |   19 +-
 libguile/unidata_to_charset.pl                     |  399 ++
 libguile/unif.c                                    | 3006 --------
 libguile/unif.h                                    |  198 -
 libguile/uniform.c                                 |  254 +
 libguile/uniform.h                                 |   77 +
 libguile/vectors.c                                 |  153 +-
 libguile/vectors.h                                 |   17 +-
 libguile/vm-engine.c                               |   31 +-
 libguile/vm-engine.h                               |   29 +-
 libguile/vm-i-system.c                             |  429 +-
 libguile/vm.c                                      |    1 -
 libguile/vm.h                                      |    6 +-
 meta/Makefile.am                                   |    2 +-
 meta/gdb-uninstalled-guile.in                      |    4 +-
 meta/guile-2.0-uninstalled.pc.in                   |    2 +-
 meta/guile-2.0.pc.in                               |    2 +-
 meta/guile.in                                      |    4 +-
 module/Makefile.am                                 |    2 +-
 module/ice-9/boot-9.scm                            |   71 +-
 module/ice-9/debugger.scm                          |   19 +
 module/ice-9/debugger/command-loop.scm             |   11 +
 module/ice-9/debugger/commands.scm                 |   55 +-
 module/ice-9/debugging/breakpoints.scm             |    1 -
 .../ice-9/debugging/ice-9-debugger-extensions.scm  |  172 -
 module/ice-9/debugging/trace.scm                   |    5 +-
 module/ice-9/debugging/traps.scm                   |   35 +-
 module/ice-9/deprecated.scm                        |   12 +-
 module/ice-9/gds-client.scm                        |   50 +-
 module/ice-9/gds-server.scm                        |   53 +-
 module/ice-9/lineio.scm                            |    2 +-
 module/language/assembly/compile-bytecode.scm      |    2 +-
 module/language/glil/compile-assembly.scm          |    8 +-
 module/language/tree-il/compile-glil.scm           |    6 +
 module/srfi/srfi-4/gnu.scm                         |   52 +
 module/system/base/compile.scm                     |    7 +-
 test-suite/lib.scm                                 |   23 +
 test-suite/standalone/Makefile.am                  |   15 +-
 test-suite/tests/dynamic-scope.test                |   16 +-
 test-suite/tests/encoding-escapes.test             |  140 +
 test-suite/tests/encoding-iso88591.test            |  139 +
 test-suite/tests/encoding-iso88597.test            |  139 +
 test-suite/tests/encoding-utf8.test                |  108 +
 test-suite/tests/numbers.test                      |    1 +
 test-suite/tests/ports.test                        |    3 +
 test-suite/tests/procprop.test                     |    4 +-
 test-suite/tests/r6rs-ports.test                   |    3 +
 test-suite/tests/srcprop.test                      |   42 +-
 test-suite/tests/srfi-13.test                      |   56 +-
 test-suite/tests/srfi-14.test                      |  317 +-
 test-suite/tests/strings.test                      |    4 +
 test-suite/tests/symbols.test                      |   39 +-
 test-suite/tests/syntax.test                       |   46 +-
 test-suite/tests/time.test                         |    5 +
 test-suite/tests/tree-il.test                      |   10 +-
 test-suite/tests/unif.test                         |    4 +-
 testsuite/run-vm-tests.scm                         |    3 +-
 210 files changed, 18824 insertions(+), 8710 deletions(-)
 create mode 100644 benchmark-suite/benchmarks/chars.bm
 create mode 100644 benchmark-suite/benchmarks/srfi-13.bm
 delete mode 100644 doc/goops/Makefile.am
 rename doc/{goops/ChangeLog-2008 => ref/ChangeLog-goops-2008} (100%)
 create mode 100644 doc/ref/effective-version.texi.in
 rename doc/{goops => ref}/goops-tutorial.texi (75%)
 rename doc/{goops => ref}/goops.texi (93%)
 rename doc/{goops => ref}/hierarchy.eps (100%)
 rename doc/{goops => ref}/hierarchy.pdf (100%)
 rename doc/{goops => ref}/hierarchy.png (100%)
 rename doc/{goops => ref}/hierarchy.txt (100%)
 rename doc/{goops => ref}/mop.text (100%)
 create mode 100755 emacs/gds-faq.txt
 create mode 100644 emacs/gds-test.el
 create mode 100755 emacs/gds-test.sh
 create mode 100644 emacs/gds-test.stdin
 create mode 100755 emacs/gds-tutorial.txt
 delete mode 100755 guile-readline/autogen.sh
 delete mode 100644 guile-readline/configure.ac
 delete mode 100644 guile-readline/ice-9/Makefile.am
 create mode 100644 libguile/array-handle.c
 create mode 100644 libguile/array-handle.h
 rename libguile/{ramap.c => array-map.c} (98%)
 rename libguile/{ramap.h => array-map.h} (90%)
 create mode 100644 libguile/arrays.c
 create mode 100644 libguile/arrays.h
 create mode 100644 libguile/bitvectors.c
 create mode 100644 libguile/bitvectors.h
 delete mode 100644 libguile/convert.c
 delete mode 100644 libguile/convert.h
 delete mode 100644 libguile/convert.i.c
 delete mode 100644 libguile/gc-segment-table.c
 create mode 100644 libguile/generalized-arrays.c
 create mode 100644 libguile/generalized-arrays.h
 create mode 100644 libguile/generalized-vectors.c
 create mode 100644 libguile/generalized-vectors.h
 create mode 100644 libguile/srfi-14.i.c
 create mode 100755 libguile/unidata_to_charset.pl
 delete mode 100644 libguile/unif.c
 delete mode 100644 libguile/unif.h
 create mode 100644 libguile/uniform.c
 create mode 100644 libguile/uniform.h
 create mode 100644 module/srfi/srfi-4/gnu.scm
 create mode 100644 test-suite/tests/encoding-escapes.test
 create mode 100644 test-suite/tests/encoding-iso88591.test
 create mode 100644 test-suite/tests/encoding-iso88597.test
 create mode 100644 test-suite/tests/encoding-utf8.test

diff --git a/.gitignore b/.gitignore
index 2a7e694..8754b48 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,7 +12,6 @@ config.guess
 config.status
 config.log
 config.h
-guile-readline-config.h
 *.doc
 *.x
 *.lo
@@ -65,8 +64,6 @@ pre-inst-guile-env
 stamp-h1
 guile-procedures.txt
 guile-config/guile-config
-guile-readline/guile-readline-config.h
-guile-readline/guile-readline-config.h.in
 *.go
 TAGS
 /meta/guile-2.0.pc
@@ -75,6 +72,8 @@ gdb-pre-inst-guile
 cscope.out
 cscope.files
 *.log
+gds-test.debug
+gds-test.transcript
 INSTALL
 *.aux
 *.cp
diff --git a/AUTHORS b/AUTHORS
index ed2adba..b8f605e 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -206,8 +206,34 @@ In the subdirectory doc, changes to:
 Many changes throughout.
 
 Neil Jerram:
+In the subdirectory emacs, wrote:
+    gds.el              gds-scheme.el           gds-server.el
+    gds-test.el         gds-test.sh            gds-test.stdin
+    gds-tutorial.txt   gds-faq.txt
 In the subdirectory ice-9, wrote:
-    buffered-input.scm
+    buffered-input.scm gds-client.scm      gds-server.scm
+In the subdirectory ice-9/debugging, wrote:
+    example-fns.scm     ice-9-debugger-extensions.scm
+    steps.scm          trace.scm           traps.scm
+    trc.scm
+In the subdirectory lang/elisp, wrote:
+    base.scm           example.el          interface.scm
+    transform.scm      variables.scm
+In the subdirectory lang/elisp/internals, wrote:
+    evaluation.scm      format.scm         fset.scm
+    lambda.scm         load.scm            null.scm
+    set.scm            signal.scm          time.scm
+    trace.scm
+In the subdirectory lang/elisp/primitives, wrote:
+    buffers.scm                char-table.scm      features.scm
+    fns.scm            format.scm          guile.scm
+    keymaps.scm                lists.scm           load.scm
+    match.scm          numbers.scm         pure.scm
+    read.scm           signal.scm          strings.scm
+    symprop.scm                syntax.scm          system.scm
+    time.scm
+In the subdirectory srfi, wrote:
+    srfi-34.scm
 In the subdirectory doc, wrote:
     deprecated.texi   goops.texi    scheme-ideas.texi
     scheme-reading.texi
@@ -227,6 +253,7 @@ In the subdirectory doc, changes to:
     scm.texi        scripts.texi    script-getopt.texi
 In the subdirectory doc/maint, wrote:
     docstring.el
+Many other changes throughout.
 
 Thien-Thi Nguyen:
 In the top-level directory, wrote:
diff --git a/Makefile.am b/Makefile.am
index 4562ddd..80231bb 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -42,6 +42,9 @@ DISTCLEANFILES = check-guile.log
 
 dist-hook: gen-ChangeLog
 
+clean-local:
+       rm -rf cache/
+
 gen_start_rev = 61db429e251bfd2f75cb4632972e0238056eb24b
 .PHONY: gen-ChangeLog
 gen-ChangeLog:
diff --git a/NEWS b/NEWS
index 3534120..0f2d693 100644
--- a/NEWS
+++ b/NEWS
@@ -8,100 +8,25 @@ Please send Guile bug reports to address@hidden
 (During the 1.9 series, we will keep an incremental NEWS for the latest
 prerelease, and a full NEWS corresponding to 1.8 -> 2.0.)
 
-Changes in 1.9.2 (since the 1.9.1 prerelease):
+Changes in 1.9.3 (since the 1.9.2 prerelease):
 
-** VM speed improvements
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
 
-Closures now copy the free variables that they need into a flat vector
-instead of capturing all heap-allocated variables. This speeds up access
-to free variables, avoids unnecessary garbage retention, and allows all
-variables to be allocated on the stack.
+These functions have been deprecated since early 2005.
 
-Variables which are `set!' are now allocated on the stack, but in
-"boxes". This allows a more uniform local variable allocation
-discipline, and allows faster access to these variables.
+** scm_array_p has one argument, not two
 
-The VM has new special-case operations, `add1' and `sub1'.
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
 
-** VM robustness improvements
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
 
-The maximum number of live local variables has been increased from 256
-to 65535.
-
-The default VM stack size is 64 kilo-words, up from 16 kilo-words. This
-allows more programs to execute in the default stack space. In the
-future we will probably implement extensible stacks via overflow
-handlers.
-
-Some lingering cases in which the VM could perform unaligned accesses
-have been fixed.
-
-The address range for relative jumps has been expanded from 16-bit
-addresses to 19-bit addresses via 8-byte alignment of jump targets. This
-will probably change to a 24-bit byte-addressable strategy before Guile
-2.0.
-
-** Compiler optimizations
-
-Procedures bound by `letrec' are no longer allocated on the heap,
-subject to a few constraints. In many cases, procedures bound by
-`letrec' and `let' can be rendered inline to their parent function, with
-loop detection for mutually tail-recursive procedures.
-
-Unreferenced variables are now optimized away.
-
-** Compiler robustness
-
-Guile may now warn about unused lexically-bound variables. Pass
-`-Wunused-variable' to `guile-tools compile', or `#:warnings
-(unused-variable)' within the #:opts argument to the `compile' procedure
-from `(system base compile)'.
-
-** Incomplete support for Unicode characters and strings
-
-Preliminary support for Unicode has landed. Characters may be entered in
-octal format via e.g. `#\454', or created via (integer->char 300). A hex
-external representation will probably be introduced at some point.
-
-Internally, strings are now represented either in the `latin-1'
-encoding, one byte per character, or in UTF-32, with four bytes per
-character. Strings manage their own allocation, switching if needed.
-
-Currently no locale conversion is performed. Extended characters may be
-written in a string using the hexadecimal escapes `\xXX', `\uXXXX', or
-`\UXXXXXX', for 8-bit, 16-bit, or 24-bit codepoints, respectively.
-
-This support is obviously incomplete. Many C functions have not yet been
-updated to deal with the new representations. Users are advised to wait
-for the next release for more serious use of Unicode strings.
-
-** `defined?' may accept a module as its second argument
-
-Previously it only accepted internal structures from the evaluator.
-
-** `let-values' is now implemented with a hygienic macro
-
-This could have implications discussed below in the NEWS entry titled,
-"Lexical bindings introduced by hygienic macros may not be referenced by
-nonhygienic macros".
-
-** Global variables `scm_charnames' and `scm_charnums' are removed
-
-These variables contained the names of control characters and were
-used when writing characters.  While these were global, they were
-never intended to be public API.  They have been replaced with private
-functions.
-
-** EBCDIC support is removed
-
-There was an EBCDIC compile flag that altered some of the character
-processing.  It appeared that full EBCDIC support was never completed
-and was unmaintained.
-
-** Packaging changes
-
-Guile now provides `guile-2.0.pc' (used by pkg-config) instead of
-`guile-1.8.pc'.
+Instead, use make-typed-array, list->typed-array, or array-type,
+respectively.
 
 ** And of course, the usual collection of bugfixes
  
@@ -555,6 +480,35 @@ This decision may be revisited before the 2.0 release. 
Feedback welcome
 to address@hidden (subscription required) or address@hidden (no
 subscription required).
 
+** Unicode characters
+
+Unicode characters may be entered in octal format via e.g. `#\454', or
+created via (integer->char 300). A hex external representation will
+probably be introduced at some point.
+
+** Unicode strings
+
+Internally, strings are now represented either in the `latin-1'
+encoding, one byte per character, or in UTF-32, with four bytes per
+character. Strings manage their own allocation, switching if needed.
+
+Currently no locale conversion is performed. Extended characters may be
+written in a string using the hexadecimal escapes `\xXX', `\uXXXX', or
+`\UXXXXXX', for 8-bit, 16-bit, or 24-bit codepoints, respectively.
+
+** Global variables `scm_charnames' and `scm_charnums' are removed
+
+These variables contained the names of control characters and were
+used when writing characters.  While these were global, they were
+never intended to be public API.  They have been replaced with private
+functions.
+
+** EBCDIC support is removed
+
+There was an EBCDIC compile flag that altered some of the character
+processing.  It appeared that full EBCDIC support was never completed
+and was unmaintained.
+
 ** New macro type: syncase-macro
 
 XXX Need to decide whether to document this for 2.0, probably should:
@@ -588,6 +542,10 @@ These are analogous to %load-path and %load-extensions.
 
 `(make-promise (lambda () foo))' is equivalent to `(delay foo)'.
 
+** `defined?' may accept a module as its second argument
+
+Previously it only accepted internal structures from the evaluator.
+
 ** New entry into %guile-build-info: `ccachedir'
 
 ** Fix bug in `module-bound?'.
@@ -601,6 +559,12 @@ the variable. This was an error, and was fixed.
 As syntax-case is available by default, importing `(ice-9 syncase)' has
 no effect, and will trigger a deprecation warning.
 
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
+
+Instead, use make-typed-array, list->typed-array, or array-type,
+respectively.
+
 * Changes to the C interface
 
 ** The GH interface (deprecated in version 1.6, 2001) was removed.
@@ -629,6 +593,18 @@ definition depends on the application's value for 
`_FILE_OFFSET_BITS'.
 
 ** The `long_long' C type, deprecated in 1.8, has been removed
 
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
+
+These functions have been deprecated since early 2005.
+
+** scm_array_p has one argument, not two
+
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
+
 * Changes to the distribution
 
 ** Guile's license is now LGPLv3+
@@ -656,8 +632,8 @@ to /usr/lib/guile/1.9/ccache. These files are 
architecture-specific.
 
 ** New dependency: GNU libunistring.
 
-See http://www.gnu.org/software/libunistring/. We hope to merge in
-Unicode support in the next prerelease.
+See http://www.gnu.org/software/libunistring/, for more information. Our
+unicode support uses routines from libunistring.
 
 
 
@@ -666,6 +642,7 @@ Changes in 1.8.8 (since 1.8.7)
 * Bugs fixed
 
 ** Fix possible buffer overruns when parsing numbers
+** Avoid clash with system setjmp/longjmp on IA64
 
 
 Changes in 1.8.7 (since 1.8.6)
diff --git a/README b/README
index 1f71b8a..bea40de 100644
--- a/README
+++ b/README
@@ -299,9 +299,8 @@ Guile Documentation 
==================================================
 
 If you've never used Scheme before, then the Guile Tutorial
 (guile-tut.info) is a good starting point.  The Guile Reference Manual
-(guile.info) is the primary documentation for Guile.  The Goops object
-system is documented separately (goops.info).  A copy of the R5RS
-Scheme specification is included too (r5rs.info).
+(guile.info) is the primary documentation for Guile.  A copy of the
+R5RS Scheme specification is included too (r5rs.info).
 
 Info format versions of this documentation are installed as part of
 the normal build process.  The texinfo sources are under the doc
diff --git a/THANKS b/THANKS
index e458a76..9012109 100644
--- a/THANKS
+++ b/THANKS
@@ -30,6 +30,7 @@ For fixes or providing information which led to a fix:
             Rob Browning
          Adrian Bunk
         Michael Carmack
+              R Clayton
         Stephen Compall
           Brian Crowder
     Christopher Cramer
@@ -52,6 +53,7 @@ For fixes or providing information which led to a fix:
          Roland Haeder
           Sven Hartrumpf
           Eric Hanchrow
+          Judy Hawkins
             Sam Hocevar
        Patrick Horgan
            Ales Hvezda
@@ -94,6 +96,7 @@ For fixes or providing information which led to a fix:
          Werner Scheinast
           Bill Schottstaedt
          Frank Schwidom
+    John Steele Scott
          Thiemo Seufer
           Scott Shedden
            Alex Shinn
@@ -114,6 +117,7 @@ For fixes or providing information which led to a fix:
        Andreas Vögele
         Michael Talbot-Wilson
         Michael Tuexen
+         Thomas Wawrzinek
         Mark H. Weaver
             Jon Wilson
            Andy Wingo
diff --git a/acinclude.m4 b/acinclude.m4
index 345e323..5629263 100644
--- a/acinclude.m4
+++ b/acinclude.m4
@@ -1,3 +1,5 @@
+dnl -*- Autoconf -*-
+
 dnl  On the NeXT, #including <utime.h> doesn't give you a definition for
 dnl  struct utime, unless you #define _POSIX_SOURCE.
 
@@ -308,3 +310,70 @@ else
 fi
 AC_LANG_RESTORE
 ])dnl ACX_PTHREAD
+
+dnl GUILE_READLINE
+dnl
+dnl Check all the things needed by `guile-readline', the Readline
+dnl bindings.
+AC_DEFUN([GUILE_READLINE], [
+  for termlib in ncurses curses termcap terminfo termlib ; do
+     AC_CHECK_LIB(${termlib}, [tgoto],
+       [READLINE_LIBS="-l${termlib} $READLINE_LIBS"; break])
+  done
+
+  AC_LIB_LINKFLAGS([readline])
+
+  if test "x$LTLIBREADLINE" = "x"; then
+    AC_MSG_WARN([GNU Readline was not found on your system.])
+  else
+    rl_save_LIBS="$LIBS"
+    LIBS="$LIBREADLINE $READLINE_LIBS $LIBS"
+
+    AC_CHECK_FUNCS([siginterrupt rl_clear_signals rl_cleanup_after_signal])
+
+    dnl Check for modern readline naming
+    AC_CHECK_FUNCS([rl_filename_completion_function])
+
+    dnl Check for rl_get_keymap.  We only use this for deciding whether to
+    dnl install paren matching on the Guile command line (when using
+    dnl readline for input), so it's completely optional.
+    AC_CHECK_FUNCS([rl_get_keymap])
+
+    AC_CACHE_CHECK([for rl_getc_function pointer in readline],
+                    ac_cv_var_rl_getc_function,
+                    [AC_TRY_LINK([
+    #include <stdio.h>
+    #include <readline/readline.h>],
+                                 [printf ("%ld", (long) rl_getc_function)],
+                                 [ac_cv_var_rl_getc_function=yes],
+                                 [ac_cv_var_rl_getc_function=no])])
+    if test "${ac_cv_var_rl_getc_function}" = "yes"; then
+      AC_DEFINE([HAVE_RL_GETC_FUNCTION], 1,
+       [Define if your readline library has the rl_getc_function variable.])
+    fi
+
+    if test $ac_cv_var_rl_getc_function = no; then
+      AC_MSG_WARN([*** GNU Readline is too old on your system.])
+      AC_MSG_WARN([*** You need readline version 2.1 or later.])
+      LTLIBREADLINE=""
+      LIBREADLINE=""
+    fi
+
+    LIBS="$rl_save_LIBS"
+
+    READLINE_LIBS="$LTLIBREADLINE $READLINE_LIBS"
+  fi
+
+  AM_CONDITIONAL([HAVE_READLINE], [test "x$LTLIBREADLINE" != "x"])
+
+  AC_CHECK_FUNCS([strdup])
+
+  AC_SUBST([READLINE_LIBS])
+
+  . $srcdir/guile-readline/LIBGUILEREADLINE-VERSION
+  AC_SUBST(LIBGUILEREADLINE_MAJOR)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_CURRENT)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_REVISION)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_AGE)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE)
+])
diff --git a/benchmark-suite/benchmarks/chars.bm 
b/benchmark-suite/benchmarks/chars.bm
new file mode 100644
index 0000000..dc6ad94
--- /dev/null
+++ b/benchmark-suite/benchmarks/chars.bm
@@ -0,0 +1,57 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; chars.bm
+;;;
+;;; Copyright (C) 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
+;;; as published by the Free Software Foundation; either version 3, 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 software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks chars)
+  :use-module (benchmark-suite lib))
+
+
+(with-benchmark-prefix "chars"
+                       
+  (benchmark "char" 1000000
+     #\a)
+
+  (benchmark "octal" 1000000
+     #\123)
+
+  (benchmark "char? eq" 1000000
+    (char? #\a))
+
+  (benchmark "char=?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char<?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char-ci=?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char-ci<? " 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char->integer" 1000000
+    (char->integer #\a))
+
+  (benchmark "char-alphabetic?" 1000000
+    (char-upcase #\a))
+
+  (benchmark "char-numeric?" 1000000
+    (char-upcase #\a)))
+
diff --git a/benchmark-suite/benchmarks/srfi-13.bm 
b/benchmark-suite/benchmarks/srfi-13.bm
new file mode 100644
index 0000000..e648e2a
--- /dev/null
+++ b/benchmark-suite/benchmarks/srfi-13.bm
@@ -0,0 +1,310 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; srfi-13.bm
+;;;
+;;; Copyright (C) 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
+;;; as published by the Free Software Foundation; either version 3, 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 software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks strings)
+  :use-module (benchmark-suite lib))
+
+(seed->random-state 1)
+
+(define short-string "Hi")
+(define medium-string 
+"ARMA virumque cano, Troiae qui primus ab oris
+Italiam, fato profugus, Laviniaque venit")
+(define long-string
+  (string-tabulate 
+   (lambda (n) (integer->char (+ 32 (random 90)))) 
+   1000))
+
+(define short-chlist (string->list short-string))
+(define medium-chlist (string->list medium-string))
+(define long-chlist (string->list long-string))
+
+(define str1 (string-copy short-string))
+(define str2 (string-copy medium-string))
+(define str3 (string-copy long-string))
+
+
+(with-benchmark-prefix "strings"
+
+  (with-benchmark-prefix "predicates"
+
+    (benchmark "string?" 1190000
+      (string? short-string)
+      (string? medium-string)
+      (string? long-string))
+
+    (benchmark "null?" 969000
+      (string-null? short-string)
+      (string-null? medium-string)
+      (string-null? long-string))
+    
+    (benchmark "any" 94000
+      (string-any #\a short-string)
+      (string-any #\a medium-string)
+      (string-any #\a long-string))
+
+    (benchmark "every" 94000
+      (string-every #\a short-string)
+      (string-every #\a medium-string)
+      (string-every #\a long-string)))
+
+  (with-benchmark-prefix "constructors"
+
+    (benchmark "string" 5000
+      (apply string short-chlist)         
+      (apply string medium-chlist)
+      (apply string long-chlist))
+
+    (benchmark "list->" 4500
+      (list->string short-chlist)
+      (list->string medium-chlist)
+      (list->string long-chlist))
+
+    (benchmark "reverse-list->" 5000
+      (reverse-list->string short-chlist)
+      (reverse-list->string medium-chlist)
+      (reverse-list->string long-chlist))
+
+    (benchmark "make" 22000
+      (make-string 250 #\x))
+
+    (benchmark "tabulate" 17000
+      (string-tabulate integer->char 250))
+
+    (benchmark "join" 5500
+      (string-join (list short-string medium-string long-string) "|" 'suffix)))
+
+  (with-benchmark-prefix "list/string"
+    (benchmark "->list" 7300
+      (string->list short-string)
+      (string->list medium-string)
+      (string->list long-string))
+
+    (benchmark "split" 60000
+      (string-split short-string #\a)
+      (string-split medium-string #\a)
+      (string-split long-string #\a)))
+
+  (with-benchmark-prefix "selection"
+
+    (benchmark "ref" 660
+      (let loop ((k 0))
+        (if (< k (string-length short-string))
+            (begin
+              (string-ref short-string k)
+              (loop (+ k 1)))))
+      (let loop ((k 0))
+        (if (< k (string-length medium-string))
+            (begin
+              (string-ref medium-string k)
+              (loop (+ k 1)))))
+      (let loop ((k 0))
+        (if (< k (string-length long-string))
+            (begin
+              (string-ref long-string k)
+              (loop (+ k 1))))))
+
+    (benchmark "copy" 1100
+      (string-copy short-string)
+      (string-copy medium-string)
+      (string-copy long-string)
+      (substring/copy short-string 0 1)
+      (substring/copy medium-string 10 20)
+      (substring/copy long-string 100 200))
+
+    (benchmark "pad" 6800
+      (string-pad short-string 100)
+      (string-pad medium-string 100)
+      (string-pad long-string 100))
+
+    (benchmark "trim trim-right trim-both" 60000
+      (string-trim short-string char-alphabetic?)
+      (string-trim medium-string char-alphabetic?)
+      (string-trim long-string char-alphabetic?)
+      (string-trim-right short-string char-alphabetic?)
+      (string-trim-right medium-string char-alphabetic?)
+      (string-trim-right long-string char-alphabetic?)
+      (string-trim-both short-string char-alphabetic?)
+      (string-trim-both medium-string char-alphabetic?)
+      (string-trim-both long-string char-alphabetic?)))
+
+  (with-benchmark-prefix "modification"
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "set!" 3000
+      (let loop ((k 1))
+        (if (< k (string-length short-string))
+            (begin
+              (string-set! str1 k #\x)
+              (loop (+ k 1)))))
+      (let loop ((k 20))
+        (if (< k (string-length medium-string))
+            (begin
+              (string-set! str2 k #\x)
+              (loop (+ k 1)))))
+      (let loop ((k 900))
+        (if (< k (string-length long-string))
+            (begin
+              (string-set! str3 k #\x)
+              (loop (+ k 1))))))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "sub-move!" 230000
+      (substring-move! short-string 0 2 str2 10)
+      (substring-move! medium-string 10 20 str3 20))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "fill!" 230000
+      (string-fill! str1 #\y 0 1)
+      (string-fill! str2 #\y 10 20)
+      (string-fill! str3 #\y 20 30))
+
+  (with-benchmark-prefix "comparison"
+
+    (benchmark "compare compare-ci" 140000
+      (string-compare short-string medium-string string<? string=? string>?)  
+      (string-compare long-string medium-string string<? string=? string>?)
+      (string-compare-ci short-string medium-string string<? string=? 
string>?)  
+      (string-compare-ci long-string medium-string string<? string=? string>?))
+  
+    (benchmark "hash hash-ci" 1000
+      (string-hash short-string)
+      (string-hash medium-string)
+      (string-hash long-string)
+      (string-hash-ci short-string)
+      (string-hash-ci medium-string)
+      (string-hash-ci long-string))))
+  
+  (with-benchmark-prefix "searching" 20000
+
+    (benchmark "prefix-length suffix-length" 270
+      (string-prefix-length short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-length long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-length short-string
+                            (string-append medium-string short-string))
+      (string-suffix-length long-string
+                            (string-append medium-string long-string))
+      (string-prefix-length-ci short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-length-ci long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-length-ci short-string
+                            (string-append medium-string short-string))
+      (string-suffix-length-ci long-string
+                            (string-append medium-string long-string)))
+
+    (benchmark "prefix? suffix?" 270
+      (string-prefix? short-string 
+                            (string-append short-string medium-string))
+      (string-prefix? long-string 
+                            (string-append long-string medium-string))
+      (string-suffix? short-string
+                            (string-append medium-string short-string))
+      (string-suffix? long-string
+                            (string-append medium-string long-string))
+      (string-prefix-ci? short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-ci? long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-ci? short-string
+                            (string-append medium-string short-string))
+      (string-suffix-ci? long-string
+                            (string-append medium-string long-string)))
+
+    (benchmark "index index-right rindex" 100000
+      (string-index short-string #\T)
+      (string-index medium-string #\T)
+      (string-index long-string #\T)
+      (string-index-right short-string #\T)
+      (string-index-right medium-string #\T)
+      (string-index-right long-string #\T)
+      (string-rindex short-string #\T)
+      (string-rindex medium-string #\T)
+      (string-rindex long-string #\T))
+
+    (benchmark "skip skip-right?" 100000
+      (string-skip short-string char-alphabetic?)
+      (string-skip medium-string char-alphabetic?)
+      (string-skip long-string char-alphabetic?)
+      (string-skip-right short-string char-alphabetic?)
+      (string-skip-right medium-string char-alphabetic?)
+      (string-skip-right long-string char-alphabetic?))
+
+    (benchmark "count" 10000
+      (string-count short-string char-alphabetic?)
+      (string-count medium-string char-alphabetic?)
+      (string-count long-string char-alphabetic?))
+    
+    (benchmark "contains contains-ci" 34000
+      (string-contains short-string short-string)
+      (string-contains medium-string (substring medium-string 10 15))
+      (string-contains long-string (substring long-string 100 130))
+      (string-contains-ci short-string short-string)
+      (string-contains-ci medium-string (substring medium-string 10 15))
+      (string-contains-ci long-string (substring long-string 100 130)))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "upcase downcase upcase! downcase!" 600
+      (string-upcase short-string)
+      (string-upcase medium-string)
+      (string-upcase long-string)
+      (string-downcase short-string)
+      (string-downcase medium-string)
+      (string-downcase long-string)
+      (string-upcase! str1 0 1)
+      (string-upcase! str2 10 20)
+      (string-upcase! str3 100 130)
+      (string-downcase! str1 0 1)
+      (string-downcase! str2 10 20)
+      (string-downcase! str3 100 130)))
+
+  (with-benchmark-prefix "readers"
+
+    (benchmark "read token, method 1" 1200
+      (let ((buf (make-string 512)))
+        (let loop ((i 0))
+          (if (< i 512)
+              (begin 
+                (string-set! buf i #\x)
+                (loop (+ i 1)))
+              buf))))
+
+    (benchmark "read token, method 2" 1200
+      (let ((lst '()))   
+        (let loop ((i 0))
+          (set! lst (append! lst (list #\x)))
+          (if (< i 512)
+              (loop (+ i 1))
+              (list->string lst)))))))
diff --git a/check-guile.in b/check-guile.in
index 3162fa6..dde51b3 100644
--- a/check-guile.in
+++ b/check-guile.in
@@ -41,7 +41,7 @@ if [ ! -f guile-procedures.txt ] ; then
 fi
 
 exec $guile \
-    -e main -s "$TEST_SUITE_DIR/guile-test" \
+    --no-autocompile -e main -s "$TEST_SUITE_DIR/guile-test" \
     --test-suite "$TEST_SUITE_DIR/tests" \
     --log-file check-guile.log "$@"
 
diff --git a/configure.ac b/configure.ac
index 697ffd1..0e878a2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -52,14 +52,6 @@ AC_CONFIG_HEADERS([config.h])
 AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/)
 
 #--------------------------------------------------------------------
-#
-# Independent Subdirectories
-#
-#--------------------------------------------------------------------
-
-AC_CONFIG_SUBDIRS(guile-readline)
-
-#--------------------------------------------------------------------
 
 AC_LANG([C])
 
@@ -1456,6 +1448,9 @@ LIBLOBJS="`echo ${LIB@&address@hidden | sed 's,\.[[^.]]* 
,.lo ,g;s,\.[[^.]]*$,.lo,'`"
 EXTRA_DOT_DOC_FILES="`echo ${LIB@&address@hidden | sed 's,\.[[^.]]* ,.doc 
,g;s,\.[[^.]]*$,.doc,'`"
 EXTRA_DOT_X_FILES="`echo ${LIB@&address@hidden | sed 's,\.[[^.]]* ,.x 
,g;s,\.[[^.]]*$,.x,'`"
 
+# GNU Readline bindings.
+GUILE_READLINE
+
 AC_SUBST(GUILE_MAJOR_VERSION)
 AC_SUBST(GUILE_MINOR_VERSION)
 AC_SUBST(GUILE_MICRO_VERSION)
@@ -1542,7 +1537,6 @@ AC_CONFIG_FILES([
   lib/Makefile
   benchmark-suite/Makefile
   doc/Makefile
-  doc/goops/Makefile
   doc/r5rs/Makefile
   doc/ref/Makefile
   doc/tutorial/Makefile
@@ -1551,6 +1545,7 @@ AC_CONFIG_FILES([
   lang/Makefile
   libguile/Makefile
   srfi/Makefile
+  guile-readline/Makefile
   test-suite/Makefile
   test-suite/standalone/Makefile
   meta/Makefile
@@ -1578,6 +1573,7 @@ AC_CONFIG_FILES([test-suite/standalone/test-use-srfi],
                 [chmod +x test-suite/standalone/test-use-srfi])
 AC_CONFIG_FILES([test-suite/standalone/test-fast-slot-ref],
                 [chmod +x test-suite/standalone/test-fast-slot-ref])
+AC_CONFIG_FILES([doc/ref/effective-version.texi])
 
 AC_OUTPUT
 
diff --git a/doc/Makefile.am b/doc/Makefile.am
index 0a6b14e..06f55a7 100644
--- a/doc/Makefile.am
+++ b/doc/Makefile.am
@@ -21,7 +21,7 @@
 
 AUTOMAKE_OPTIONS = gnu
 
-SUBDIRS = ref tutorial goops r5rs
+SUBDIRS = ref tutorial r5rs
 
 dist_man1_MANS = guile.1
 
diff --git a/doc/README b/doc/README
index 3ecd329..18862a6 100644
--- a/doc/README
+++ b/doc/README
@@ -8,10 +8,6 @@ The documentation consists of the following manuals.
 - The Guile Reference Manual (guile.texi) contains (or is intended to
   contain) reference documentation on all aspects of Guile.
 
-- The GOOPS Manual (goops.texi) contains both tutorial-style and
-  reference documentation for using GOOPS, Guile's Object Oriented
-  Programming System.
-
 - The Revised^5 Report on the Algorithmic Language Scheme (r5rs.texi).
 
 Please be aware that this is all very much work in progress (apart
diff --git a/doc/goops/Makefile.am b/doc/goops/Makefile.am
deleted file mode 100644
index 49bfb29..0000000
--- a/doc/goops/Makefile.am
+++ /dev/null
@@ -1,29 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##     Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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, or
-##   (at your option) any later version.
-##
-##   GUILE 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 GUILE; see the file COPYING.LESSER.  If not,
-##   write to the Free Software Foundation, Inc., 51 Franklin Street,
-##   Fifth Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-info_TEXINFOS = goops.texi
-
-goops_TEXINFOS = goops-tutorial.texi \
-  hierarchy.eps hierarchy.png hierarchy.txt hierarchy.pdf
-
-EXTRA_DIST = ChangeLog-2008
diff --git a/doc/ref/.gitignore b/doc/ref/.gitignore
index fc69e31..c76e2e4 100644
--- a/doc/ref/.gitignore
+++ b/doc/ref/.gitignore
@@ -1,2 +1,3 @@
 autoconf-macros.texi
 lib-version.texi
+effective-version.texi
diff --git a/doc/goops/ChangeLog-2008 b/doc/ref/ChangeLog-goops-2008
similarity index 100%
rename from doc/goops/ChangeLog-2008
rename to doc/ref/ChangeLog-goops-2008
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index abf42ed..2f218a5 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -78,11 +78,20 @@ guile_TEXINFOS = preface.texi                       \
                 libguile-linking.texi          \
                 libguile-extensions.texi       \
                 api-init.texi                  \
-                mod-getopt-long.texi
+                mod-getopt-long.texi           \
+                goops.texi                     \
+                goops-tutorial.texi            \
+                effective-version.texi
 
 ETAGS_ARGS = $(info_TEXINFOS) $(guile_TEXINFOS)
 
-EXTRA_DIST = ChangeLog-2008
+PICTURES = hierarchy.eps \
+          hierarchy.pdf \
+          hierarchy.png \
+          hierarchy.txt \
+          mop.text
+
+EXTRA_DIST = ChangeLog-2008 $(PICTURES)
 
 include $(top_srcdir)/am/pre-inst-guile
 
diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 7eccb86..059390b 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1344,9 +1344,9 @@ otherwise.
 @deftypefn  {C Function} SCM scm_take_u8vector (const scm_t_uint8 *data, 
size_t len)
 @deftypefnx {C Function} SCM scm_take_s8vector (const scm_t_int8 *data, size_t 
len)
 @deftypefnx {C Function} SCM scm_take_u16vector (const scm_t_uint16 *data, 
size_t len)
address@hidden {C Function} SCM scm_take_s168vector (const scm_t_int16 *data, 
size_t len)
address@hidden {C Function} SCM scm_take_s16vector (const scm_t_int16 *data, 
size_t len)
 @deftypefnx {C Function} SCM scm_take_u32vector (const scm_t_uint32 *data, 
size_t len)
address@hidden {C Function} SCM scm_take_s328vector (const scm_t_int32 *data, 
size_t len)
address@hidden {C Function} SCM scm_take_s32vector (const scm_t_int32 *data, 
size_t len)
 @deftypefnx {C Function} SCM scm_take_u64vector (const scm_t_uint64 *data, 
size_t len)
 @deftypefnx {C Function} SCM scm_take_s64vector (const scm_t_int64 *data, 
size_t len)
 @deftypefnx {C Function} SCM scm_take_f32vector (const float *data, size_t len)
@@ -2001,13 +2001,24 @@ enclosed array is unspecified.
 For example,
 
 @lisp
-(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1)
+(enclose-array '#3(((a b c)
+                    (d e f))
+                   ((1 2 3)
+                    (4 5 6)))
+               1)
 @result{}
-#<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) #1(3 6))>
-
-(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0)
+#<enclosed-array (#1(a d) #1(b e) #1(c f))
+                 (#1(1 4) #1(2 5) #1(3 6))>
+
+(enclose-array '#3(((a b c)
+                    (d e f))
+                   ((1 2 3)
+                    (4 5 6)))
+               1 0)
 @result{}
-#<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 6))>
+#<enclosed-array #2((a 1) (d 4))
+                 #2((b 2) (e 5))
+                 #2((c 3) (f 6))>
 @end lisp
 @end deffn
 
@@ -3083,8 +3094,10 @@ which can be changed.
                          (color ball)
                          (owner ball)))
                ball-color))
-(define (color ball) (struct-ref (struct-vtable ball) vtable-offset-user))
-(define (owner ball) (struct-ref ball 0))
+(define (color ball)
+  (struct-ref (struct-vtable ball) vtable-offset-user))
+(define (owner ball)
+  (struct-ref ball 0))
 
 (define red (make-ball-type 'red))
 (define green (make-ball-type 'green))
@@ -3460,7 +3473,8 @@ whole is not a proper list:
 (assoc "mary" '((1 . 2) ("key" . "door") . "open sesame"))
 @result{}
 ERROR: In procedure assoc in expression (assoc "mary" (quote #)):
-ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 
2) ("key" . "door") . "open sesame")
+ERROR: Wrong type argument in position 2 (expecting
+   association list): ((1 . 2) ("key" . "door") . "open sesame")
 
 (sloppy-assoc "mary" '((1 . 2) ("key" . "door") . "open sesame"))
 @result{}
@@ -3474,7 +3488,8 @@ Secondly, if one of the entries in the specified alist is 
not a pair:
 (assoc 2 '((1 . 1) 2 (3 . 9)))
 @result{}
 ERROR: In procedure assoc in expression (assoc 2 (quote #)):
-ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 
1) 2 (3 . 9))
+ERROR: Wrong type argument in position 2 (expecting
+   association list): ((1 . 1) 2 (3 . 9))
 
 (sloppy-assoc 2 '((1 . 1) 2 (3 . 9)))
 @result{}
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index ed6411f..e7614d1 100644
--- a/doc/ref/api-control.texi
+++ b/doc/ref/api-control.texi
@@ -22,6 +22,7 @@ flow of Scheme affects C code.
 * Error Reporting::             Procedures for signaling errors.
 * Dynamic Wind::                Dealing with non-local entrance/exit.
 * Handling Errors::             How to handle errors in C code.
+* Continuation Barriers::       Protection from non-local control flow.
 @end menu
 
 @node begin
@@ -1501,6 +1502,33 @@ which is the name of the procedure incorrectly invoked.
 @end deftypefn
 
 
address@hidden Continuation Barriers
address@hidden Continuation Barriers
+
+The non-local flow of control caused by continuations might sometimes
+not be wanted.  You can use @code{with-continuation-barrier} etc to
+errect fences that continuations can not pass.
+
address@hidden {Scheme Procedure} with-continuation-barrier proc
address@hidden {C Function} scm_with_continuation_barrier (proc)
+Call @var{proc} and return its result.  Do not allow the invocation of
+continuations that would leave or enter the dynamic extent of the call
+to @code{with-continuation-barrier}.  Such an attempt causes an error
+to be signaled.
+
+Throws (such as errors) that are not caught from within @var{proc} are
+caught by @code{with-continuation-barrier}.  In that case, a short
+message is printed to the current error port and @code{#f} is returned.
+
+Thus, @code{with-continuation-barrier} returns exactly once.
address@hidden deffn
+
address@hidden {C Function} {void *} scm_c_with_continuation_barrier (void 
*(*func) (void *), void *data)
+Like @code{scm_with_continuation_barrier} but call @var{func} on
address@hidden  When an error is caught, @code{NULL} is returned.
address@hidden deftypefn
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 6e1a67a..0fd4ee1 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -3477,9 +3477,9 @@ allocated string.
 @deffnx {C Function} scm_string_concatenate_reverse (ls, final_string, end)
 Without optional arguments, this procedure is equivalent to
 
address@hidden
address@hidden
 (string-concatenate (reverse ls))
address@hidden smalllisp
address@hidden lisp
 
 If the optional argument @var{final_string} is specified, it is
 consed onto the beginning to @var{ls} before performing the
@@ -3535,11 +3535,12 @@ For example, to change characters to alternately upper 
and lower case,
 
 @example
 (define str (string-copy "studly"))
-(string-for-each-index (lambda (i)
-                         (string-set! str i
-                           ((if (even? i) char-upcase char-downcase)
-                            (string-ref str i))))
-                       str)
+(string-for-each-index
+    (lambda (i)
+      (string-set! str i
+        ((if (even? i) char-upcase char-downcase)
+         (string-ref str i))))
+    str)
 str @result{} "StUdLy"
 @end example
 @end deffn
@@ -4447,7 +4448,8 @@ Or matching a @sc{yyyymmdd} format date such as 
@samp{20020828} and
 re-ordering and hyphenating the fields.
 
 @lisp
-(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
+(define date-regex
+   "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
 (define s "Date 20020429 12am.")
 (regexp-substitute #f (string-match date-regex s)
                    'pre 2 "-" 3 "-" 1 'post " (" 0 ")")
@@ -4507,7 +4509,8 @@ example the following is the date example from
 @code{string-match} call.
 
 @lisp
-(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
+(define date-regex 
+   "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
 (define s "Date 20020429 12am.")
 (regexp-substitute/global #f date-regex s
                           'pre 2 "-" 3 "-" 1 'post " (" 0 ")")
@@ -5502,7 +5505,7 @@ the @code{read-set!} procedure documented in @ref{User 
level options
 interfaces} and @ref{Reader options}.  Note that the @code{prefix} and
 @code{postfix} syntax are mutually exclusive.
 
address@hidden
address@hidden
 (read-set! keywords 'prefix)
 
 #:type
@@ -5534,7 +5537,7 @@ type:
 ERROR: In expression :type:
 ERROR: Unbound variable: :type
 ABORT: (unbound-variable)
address@hidden smalllisp
address@hidden lisp
 
 @node Keyword Procedures
 @subsubsection Keyword Procedures
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index 7886366..c29bfdf 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -283,9 +283,9 @@ runs a script non-interactively.
 The following procedures can be used to access and set the source
 properties of read expressions.
 
address@hidden {Scheme Procedure} set-source-properties! obj plist
address@hidden {C Function} scm_set_source_properties_x (obj, plist)
-Install the association list @var{plist} as the source property
address@hidden {Scheme Procedure} set-source-properties! obj alist
address@hidden {C Function} scm_set_source_properties_x (obj, alist)
+Install the association list @var{alist} as the source property
 list for @var{obj}.
 @end deffn
 
@@ -302,12 +302,12 @@ Return the source property association list of @var{obj}.
 
 @deffn {Scheme Procedure} source-property obj key
 @deffnx {C Function} scm_source_property (obj, key)
-Return the source property specified by @var{key} from
address@hidden's source property list.
+Return the property specified by @var{key} from @var{obj}'s source
+properties.
 @end deffn
 
 In practice there are only two ways that you should use the ability to
-set an expression's source breakpoints.
+set an expression's source properties.
 
 @itemize
 @item
@@ -330,9 +330,9 @@ involved in a backtrace or error report.
 
 If you are looking for a way to attach arbitrary information to an
 expression other than these properties, you should use
address@hidden instead (@pxref{Object Properties}), because
-that will avoid bloating the source property hash table, which is really
-only intended for the specific purposes described in this section.
address@hidden instead (@pxref{Object Properties}).  That
+will avoid bloating the source property hash table, which is really
+only intended for the debugging purposes just described.
 
 
 @node Decoding Memoized Source Expressions
@@ -1708,7 +1708,7 @@ facilities just described.
 A good way to explore in detail what a Scheme procedure does is to set
 a trap on it and then single step through what it does.  To do this,
 make and install a @code{<procedure-trap>} with the @code{debug-trap}
-behaviour from @code{(ice-9 debugging ice-9-debugger-extensions)}.
+behaviour from @code{(ice-9 debugger)}.
 
 The following sample session illustrates this.  It assumes that the
 file @file{matrix.scm} defines a procedure @code{mkmatrix}, which is
@@ -1718,7 +1718,6 @@ calls @code{mkmatrix}.
 @lisp
 $ /usr/bin/guile -q
 guile> (use-modules (ice-9 debugger)
-                    (ice-9 debugging ice-9-debugger-extensions)
                     (ice-9 debugging traps))
 guile> (load "matrix.scm")
 guile> (install-trap (make <procedure-trap>
@@ -1732,16 +1731,16 @@ Frame 2 at matrix.scm:8:3
         [mkmatrix]
 debug> next
 Frame 3 at matrix.scm:4:3
-        (let ((x 1)) (quote this-is-a-matric))
+        (let ((x 1)) (quote hi!))
 debug> info frame
 Stack frame: 3
 This frame is an evaluation.
 The expression being evaluated is:
 matrix.scm:4:3:
-  (let ((x 1)) (quote this-is-a-matric))
+  (let ((x 1)) (quote hi!))
 debug> next
 Frame 3 at matrix.scm:5:21
-        (quote this-is-a-matric)
+        (quote hi!)
 debug> bt
 In unknown file:
    ?: 0* [primitive-eval (do-main 4)]
@@ -1750,18 +1749,17 @@ In standard input:
 In matrix.scm:
    8: 2  [mkmatrix]
    ...
-   5: 3  (quote this-is-a-matric)
+   5: 3  (quote hi!)
 debug> quit
-this-is-a-matric
+hi!
 guile> 
 @end lisp
 
 Or you can use Guile's Emacs interface (GDS), by using the module
 @code{(ice-9 gds-client)} instead of @code{(ice-9 debugger)} and
address@hidden(ice-9 debugging ice-9-debugger-extensions)}, and changing
address@hidden to @code{gds-debug-trap}.  Then the stack and
-corresponding source locations are displayed in Emacs instead of on
-the Guile command line.
+changing @code{debug-trap} to @code{gds-debug-trap}.  Then the stack and
+corresponding source locations are displayed in Emacs instead of on the
+Guile command line.
 
 
 @node Profiling or Tracing a Procedure's Code
@@ -1813,7 +1811,7 @@ guile> (do-main 4)
 |  5: (memq sym bindings)
 |  5: [memq let (debug)]
 |  5: =>#f
-|  2: (letrec ((yy 23)) (let ((x 1)) (quote this-is-a-matric)))
+|  2: (letrec ((yy 23)) (let ((x 1)) (quote hi!)))
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  4: (and (memq sym bindings) (let ...))
@@ -1832,7 +1830,7 @@ guile> (do-main 4)
 |  5: (memq sym bindings)
 |  5: [memq let (debug)]
 |  5: =>#f
-|  2: (let ((x 1)) (quote this-is-a-matric))
+|  2: (let ((x 1)) (quote hi!))
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  4: (and (memq sym bindings) (let ...))
@@ -1841,15 +1839,15 @@ guile> (do-main 4)
 |  5: =>#f
 |  2: [let (let # #) (# # #)]
 |  2: [let (let # #) (# # #)]
-|  2: =>(#@@let* (x 1) #@@let (quote this-is-a-matric))
-this-is-a-matric
+|  2: =>(#@@let* (x 1) #@@let (quote hi!))
+hi!
 guile> (do-main 4)
 |  2: [mkmatrix]
-|  2: (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric)))
-|  2: (let* ((x 1)) (quote this-is-a-matric))
-|  2: (quote this-is-a-matric)
-|  2: =>this-is-a-matric
-this-is-a-matric
+|  2: (letrec ((yy 23)) (let* ((x 1)) (quote hi!)))
+|  2: (let* ((x 1)) (quote hi!))
+|  2: (quote hi!)
+|  2: =>hi!
+hi!
 guile> 
 @end lisp
 
@@ -1881,11 +1879,11 @@ each trace line instead of the stack depth.
 guile> (set-trace-layout "|~16@@a: ~a\n" trace/source trace/info)
 guile> (do-main 4)
 |  matrix.scm:7:2: [mkmatrix]
-|                : (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric)))
-|  matrix.scm:3:2: (let* ((x 1)) (quote this-is-a-matric))
-|  matrix.scm:4:4: (quote this-is-a-matric)
-|  matrix.scm:4:4: =>this-is-a-matric
-this-is-a-matric
+|                : (letrec ((yy 23)) (let* ((x 1)) (quote hi!)))
+|  matrix.scm:3:2: (let* ((x 1)) (quote hi!))
+|  matrix.scm:4:4: (quote hi!)
+|  matrix.scm:4:4: =>hi!
+hi!
 guile> 
 @end lisp
 
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index b0b5741..96cd147 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -424,9 +424,9 @@ the current size, but this is not mandatory in the POSIX 
standard.
 
 The delimited-I/O module can be accessed with:
 
address@hidden
address@hidden
 (use-modules (ice-9 rdelim))
address@hidden smalllisp
address@hidden lisp
 
 It can be used to read or write lines of text, or read text delimited by
 a specified set of characters.  It's similar to the @code{(scsh rdelim)}
@@ -536,9 +536,9 @@ delimiter may be either a newline or the @var{eof-object}; 
if
 
 The Block-string-I/O module can be accessed with:
 
address@hidden
address@hidden
 (use-modules (ice-9 rw))
address@hidden smalllisp
address@hidden lisp
 
 It currently contains procedures that help to implement the
 @code{(scsh rw)} module in guile-scsh.
@@ -795,17 +795,17 @@ current interfaces.
 @rnindex open-input-file
 @deffn {Scheme Procedure} open-input-file filename
 Open @var{filename} for input.  Equivalent to
address@hidden
address@hidden
 (open-file @var{filename} "r")
address@hidden smalllisp
address@hidden lisp
 @end deffn
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename
 Open @var{filename} for output.  Equivalent to
address@hidden
address@hidden
 (open-file @var{filename} "w")
address@hidden smalllisp
address@hidden lisp
 @end deffn
 
 @deffn {Scheme Procedure} call-with-input-file filename proc
diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 9aeb08a..1c9ab23 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -60,15 +60,15 @@ Library files in SLIB @emph{provide} a feature, and when 
user programs
 For example, the file @file{random.scm} in the SLIB package contains the
 line
 
address@hidden
address@hidden
 (provide 'random)
address@hidden smalllisp
address@hidden lisp
 
 so to use its procedures, a user would type
 
address@hidden
address@hidden
 (require 'random)
address@hidden smalllisp
address@hidden lisp
 
 and they would magically become available, @emph{but still have the same
 names!}  So this method is nice, but not as good as a full-featured
@@ -99,9 +99,9 @@ i.e., passed as the second argument to @code{eval}.
 Note: the following two procedures are available only when the 
 @code{(ice-9 r5rs)} module is loaded:
 
address@hidden
address@hidden
 (use-modules (ice-9 r5rs))
address@hidden smalllisp
address@hidden lisp
 
 @deffn {Scheme Procedure} scheme-report-environment version
 @deffnx {Scheme Procedure} null-environment version
@@ -224,9 +224,9 @@ An @dfn{interface specification} has one of two forms.  The 
first
 variation is simply to name the module, in which case its public
 interface is the one accessed.  For example:
 
address@hidden
address@hidden
 (use-modules (ice-9 popen))
address@hidden smalllisp
address@hidden lisp
 
 Here, the interface specification is @code{(ice-9 popen)}, and the
 result is that the current module now has access to @code{open-pipe},
@@ -241,11 +241,11 @@ module to be accessed, but also selects bindings from it 
and renames
 them to suit the current module's needs.  For example:
 
 @cindex binding renamer
address@hidden
address@hidden
 (use-modules ((ice-9 popen)
-              :select ((open-pipe . pipe-open) close-pipe)
-              :renamer (symbol-prefix-proc 'unixy:)))
address@hidden smalllisp
+              #:select ((open-pipe . pipe-open) close-pipe)
+              #:renamer (symbol-prefix-proc 'unixy:)))
address@hidden lisp
 
 Here, the interface specification is more complex than before, and the
 result is that a custom interface with only two bindings is created and
@@ -270,10 +270,10 @@ You can also directly refer to bindings in a module by 
using the
 open-pipe)}.  Thus an alternative to the complete @code{use-modules}
 statement would be
 
address@hidden
address@hidden
 (define unixy:pipe-open (@@ (ice-9 popen) open-pipe))
 (define unixy:close-pipe (@@ (ice-9 popen) close-pipe))
address@hidden smalllisp
address@hidden lisp
 
 There is also @code{@@@@}, which can be used like @code{@@}, but does
 not check whether the variable that is being accessed is actually
@@ -307,9 +307,9 @@ whose public interface is found and used.
 @var{spec} can also be of the form:
 
 @cindex binding renamer
address@hidden
address@hidden
  (MODULE-NAME [:select SELECTION] [:renamer RENAMER])
address@hidden smalllisp
address@hidden lisp
 
 in which case a custom interface is newly created and used.
 @var{module-name} is a list of symbols, as above; @var{selection} is a
@@ -373,9 +373,9 @@ by using @code{define-public} or @code{export} (both 
documented below).
 @var{module-name} is of the form @code{(hierarchy file)}.  One
 example of this is
 
address@hidden
address@hidden
 (define-module (ice-9 popen))
address@hidden smalllisp
address@hidden lisp
 
 @code{define-module} makes this module available to Guile programs under
 the given @var{module-name}.
@@ -541,9 +541,9 @@ duplication to the next handler in @var{list}.
 The default duplicate binding resolution policy is given by the
 @code{default-duplicate-binding-handler} procedure, and is
 
address@hidden
address@hidden
 (replace warn-override-core warn last)
address@hidden smalllisp
address@hidden lisp
 
 @item #:no-backtrace
 @cindex no backtrace
@@ -758,7 +758,7 @@ Record definition with @code{define-record-type} 
(@pxref{SRFI-9}).
 Read hash extension @code{#,()} (@pxref{SRFI-10}).
 
 @item (srfi srfi-11)
-Multiple-value handling with @code{let-values} and @code{let-values*}
+Multiple-value handling with @code{let-values} and @code{let*-values}
 (@pxref{SRFI-11}).
 
 @item (srfi srfi-13)
@@ -1138,12 +1138,12 @@ gcc -shared -o libbessel.so -fPIC bessel.c
 
 Now fire up Guile:
 
address@hidden
address@hidden
 (define bessel-lib (dynamic-link "./libbessel.so"))
 (dynamic-call "init_math_bessel" bessel-lib)
 (j0 2)
 @result{} 0.223890779141236
address@hidden smalllisp
address@hidden lisp
 
 The filename @file{./libbessel.so} should be pointing to the shared
 library produced with the @code{gcc} command above, of course.  The
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index 20e32c5..f7d0962 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -82,10 +82,11 @@ general are stored.  On Unix-like systems, this is usually
 @deffnx {C Function} scm_sys_library_dir ()
 Return the name of the directory where the Guile Scheme files that
 belong to the core Guile installation (as opposed to files from a 3rd
-party package) are installed.  On Unix-like systems, this is usually
+party package) are installed.  On Unix-like systems this is usually
 @file{/usr/local/share/guile/<GUILE_EFFECTIVE_VERSION>} or
address@hidden/usr/share/guile/<GUILE_EFFECTIVE_VERSION>}, for example:
address@hidden/usr/local/share/guile/1.6}.
address@hidden/usr/share/guile/<GUILE_EFFECTIVE_VERSION>};
+
address@hidden for example @file{/usr/local/share/guile/1.6}.
 @end deffn
 
 @deffn {Scheme Procedure} %site-dir
@@ -503,9 +504,9 @@ Guile is case-sensitive by default.
 
 To make Guile case insensitive, you can type
 
address@hidden
address@hidden
 (read-enable 'case-insensitive)
address@hidden smalllisp
address@hidden lisp
 
 @node Printing options
 @subsubsection Printing options
@@ -680,7 +681,8 @@ the maximum stack size, use @code{debug-set!}, for example:
 @lisp
 (debug-set! stack 200000)
 @result{}
-(show-file-name #t stack 200000 debug backtrace depth 20 maxdepth 1000 frames 
3 indent 10 width 79 procnames cheap)
+(show-file-name #t stack 200000 debug backtrace depth 20
+   maxdepth 1000 frames 3 indent 10 width 79 procnames cheap)
 
 (non-tail-recursive-factorial 500)
 @result{}
@@ -717,7 +719,6 @@ backtrace.  Need to give a better example, possibly putting 
debugging
 option examples in a separate session.]
 @end enumerate
 
-
 @smalllisp
 guile> (define abc "hello")
 guile> abc
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index 3b62286..5213696 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -8,14 +8,9 @@
 @node Scheduling
 @section Threads, Mutexes, Asyncs and Dynamic Roots
 
-[FIXME: This is pasted in from Tom Lord's original guile.texi chapter
-plus the Cygnus programmer's manual; it should be *very* carefully
-reviewed and largely reorganized.]
-
 @menu
 * Arbiters::                    Synchronization primitives.
 * Asyncs::                      Asynchronous procedure invocation.
-* Continuation Barriers::       Protection from non-local control flow.
 * Threads::                     Multiple threads of execution.
 * Mutexes and Condition Variables:: Synchronization primitives.
 * Blocking::                    How to block properly in guile mode.
@@ -47,7 +42,6 @@ process synchronization.
 
 @deffn {Scheme Procedure} try-arbiter arb
 @deffnx {C Function} scm_try_arbiter (arb)
address@hidden {C Function} scm_try_arbiter (arb)
 If @var{arb} is unlocked, then lock it and return @code{#t}.
 If @var{arb} is already locked, then do nothing and return
 @code{#f}.
@@ -70,7 +64,7 @@ release it, but that's not required, any thread can release 
it.
 @cindex user asyncs
 @cindex system asyncs
 
-Asyncs are a means of deferring the excution of Scheme code until it is
+Asyncs are a means of deferring the execution of Scheme code until it is
 safe to do so.
 
 Guile provides two kinds of asyncs that share the basic concept but are
@@ -132,43 +126,42 @@ This procedure is not safe to be called from signal 
handlers.  Use
 signal handlers.
 @end deffn
 
address@hidden  FIXME: The use of @deffnx for scm_c_call_with_blocked_asyncs and
address@hidden  scm_c_call_with_unblocked_asyncs puts "void" into the function
address@hidden  index.  Would prefer to use @deftypefnx if makeinfo allowed 
that,
address@hidden  or a @deftypefn with an empty return type argument if it didn't
address@hidden  introduce an extra space.
-
 @deffn {Scheme Procedure} call-with-blocked-asyncs proc
 @deffnx {C Function} scm_call_with_blocked_asyncs (proc)
address@hidden {C Function} {void *} scm_c_call_with_blocked_asyncs (void * 
(*proc) (void *data), void *data)
address@hidden scm_c_call_with_blocked_asyncs
 Call @var{proc} and block the execution of system asyncs by one level
 for the current thread while it is running.  Return the value returned
 by @var{proc}.  For the first two variants, call @var{proc} with no
 arguments; for the third, call it with @var{data}.
 @end deffn
 
address@hidden {C Function} {void *} scm_c_call_with_blocked_asyncs (void * 
(*proc) (void *data), void *data)
+The same but with a C function @var{proc} instead of a Scheme thunk.
address@hidden deftypefn
+
 @deffn {Scheme Procedure} call-with-unblocked-asyncs proc
 @deffnx {C Function} scm_call_with_unblocked_asyncs (proc)
address@hidden {C Function} {void *} scm_c_call_with_unblocked_asyncs (void 
*(*p) (void *d), void *d)
address@hidden scm_c_call_with_unblocked_asyncs
 Call @var{proc} and unblock the execution of system asyncs by one
 level for the current thread while it is running.  Return the value
 returned by @var{proc}.  For the first two variants, call @var{proc}
 with no arguments; for the third, call it with @var{data}.
 @end deffn
 
address@hidden {C Function} {void *} scm_c_call_with_unblocked_asyncs (void 
*(*proc) (void *data), void *data)
+The same but with a C function @var{proc} instead of a Scheme thunk.
address@hidden deftypefn
+
 @deftypefn {C Function} void scm_dynwind_block_asyncs ()
-This function must be used inside a pair of calls to
+During the current dynwind context, increase the blocking of asyncs by
+one level.  This function must be used inside a pair of calls to
 @code{scm_dynwind_begin} and @code{scm_dynwind_end} (@pxref{Dynamic
-Wind}).  During the dynwind context, asyncs are blocked by one level.
+Wind}).
 @end deftypefn
 
 @deftypefn {C Function} void scm_dynwind_unblock_asyncs ()
-This function must be used inside a pair of calls to
+During the current dynwind context, decrease the blocking of asyncs by
+one level.  This function must be used inside a pair of calls to
 @code{scm_dynwind_begin} and @code{scm_dynwind_end} (@pxref{Dynamic
-Wind}).  During the dynwind context, asyncs are unblocked by one
-level.
+Wind}).
 @end deftypefn
 
 @node User asyncs
@@ -197,32 +190,6 @@ Mark the user async @var{a} for future execution.
 Execute all thunks from the marked asyncs of the list @var{list_of_a}.
 @end deffn
 
address@hidden Continuation Barriers
address@hidden Continuation Barriers
-
-The non-local flow of control caused by continuations might sometimes
-not be wanted.  You can use @code{with-continuation-barrier} etc to
-errect fences that continuations can not pass.
-
address@hidden {Scheme Procedure} with-continuation-barrier proc
address@hidden {C Function} scm_with_continuation_barrier (proc)
-Call @var{proc} and return its result.  Do not allow the invocation of
-continuations that would leave or enter the dynamic extent of the call
-to @code{with-continuation-barrier}.  Such an attempt causes an error
-to be signaled.
-
-Throws (such as errors) that are not caught from within @var{proc} are
-caught by @code{with-continuation-barrier}.  In that case, a short
-message is printed to the current error port and @code{#f} is returned.
-
-Thus, @code{with-continuation-barrier} returns exactly once.
address@hidden deffn
-
address@hidden {C Function} {void *} scm_c_with_continuation_barrier (void 
*(*func) (void *), void *data)
-Like @code{scm_with_continuation_barrier} but call @var{func} on
address@hidden  When an error is caught, @code{NULL} is returned.
address@hidden deftypefn
-
 @node Threads
 @subsection Threads
 @cindex threads
diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi
index ba5800f..ae807c2 100644
--- a/doc/ref/autoconf.texi
+++ b/doc/ref/autoconf.texi
@@ -48,19 +48,18 @@ checks.
 @cindex pkg-config
 @cindex autoconf
 
-GNU Guile provides a @dfn{pkg-config} description file, installed as
address@hidden@var{prefix}/lib/pkgconfig/guile-2.0.pc}, which contains all the
-information necessary to compile and link C applications that use Guile.
-The @code{pkg-config} program is able to read this file and provide this
-information to application programmers; it can be obtained at
address@hidden://pkg-config.freedesktop.org/}.
+GNU Guile provides a @dfn{pkg-config} description file, which contains
+all the information necessary to compile and link C applications that
+use Guile.  The @code{pkg-config} program is able to read this file
+and provide this information to application programmers; it can be
+obtained at @url{http://pkg-config.freedesktop.org/}.
 
 The following command lines give respectively the C compilation and link
 flags needed to build Guile-using programs:
 
 @example
-pkg-config guile-2.0 --cflags
-pkg-config guile-2.0 --libs
+pkg-config address@hidden --cflags
+pkg-config address@hidden --libs
 @end example
 
 To ease use of pkg-config with Autoconf, pkg-config comes with a
@@ -71,7 +70,7 @@ accordingly, or prints an error and exits if Guile was not 
found:
 @findex PKG_CHECK_MODULES
 
 @example
-PKG_CHECK_MODULES([GUILE], [guile-2.0])
+PKG_CHECK_MODULES([GUILE], address@hidden)
 @end example
 
 Guile comes with additional Autoconf macros providing more information,
diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi
index 0aea4e7..d749fc1 100644
--- a/doc/ref/compiler.texi
+++ b/doc/ref/compiler.texi
@@ -536,7 +536,8 @@ be wrapped in a thunk that declares the arity of the 
expression:
 
 @example
 scheme@@(guile-user)> ,language glil
-Guile Lowlevel Intermediate Language (GLIL) interpreter 0.3 on Guile 1.9.0
+Guile Lowlevel Intermediate Language (GLIL) interpreter 0.3 on
+   Guile 1.9.0
 Copyright (C) 2001-2008 Free Software Foundation, Inc.
 
 Enter `,help' for help.
diff --git a/doc/ref/effective-version.texi.in 
b/doc/ref/effective-version.texi.in
new file mode 100644
index 0000000..80b56b7
--- /dev/null
+++ b/doc/ref/effective-version.texi.in
@@ -0,0 +1 @@
address@hidden EFFECTIVE-VERSION @GUILE_EFFECTIVE_VERSION@
diff --git a/doc/ref/expect.texi b/doc/ref/expect.texi
index 05c7669..71e9a38 100644
--- a/doc/ref/expect.texi
+++ b/doc/ref/expect.texi
@@ -10,9 +10,9 @@
 
 The macros in this section are made available with:
 
address@hidden
address@hidden
 (use-modules (ice-9 expect))
address@hidden smalllisp
address@hidden lisp
 
 @code{expect} is a macro for selecting actions based on the output from
 a port.  The name comes from a tool of similar functionality by Don Libes.
@@ -30,14 +30,14 @@ which is matched against each of the patterns.  When a
 pattern matches, the remaining expression(s) in
 the clause are evaluated and the value of the last is returned.  For example:
 
address@hidden
address@hidden
 (with-input-from-file "/etc/passwd"
   (lambda ()
     (expect-strings
       ("^nobody" (display "Got a nobody user.\n")
                  (display "That's no problem.\n"))
       ("^daemon" (display "Got a daemon user.\n")))))
address@hidden smalllisp
address@hidden lisp
 
 The regular expression is compiled with the @code{REG_NEWLINE} flag, so
 that the ^ and $ anchors will match at any newline, not just at the start
@@ -54,13 +54,13 @@ The symbol @code{=>} can be used to indicate that the 
expression is a
 procedure which will accept the result of a successful regular expression
 match.  E.g.,
 
address@hidden
address@hidden
 ("^daemon" => write)
 ("^d(aemon)" => (lambda args (for-each write args)))
 ("^da(em)on" => (lambda (all sub)
                   (write all) (newline)
                   (write sub) (newline)))
address@hidden smalllisp
address@hidden lisp
 
 The order of the substrings corresponds to the order in which the
 opening brackets occur.
@@ -135,12 +135,12 @@ expression.
 In the following example, a string will only be matched at the beginning
 of the file:
 
address@hidden
address@hidden
 (let ((expect-port (open-input-file "/etc/passwd")))
   (expect
      ((lambda (s eof?) (string=? s "fnord!"))
         (display "Got a nobody user!\n"))))
address@hidden smalllisp
address@hidden lisp
 
 The control variables described for @code{expect-strings} also
 influence the behaviour of @code{expect}, with the exception of 
diff --git a/doc/goops/goops-tutorial.texi b/doc/ref/goops-tutorial.texi
similarity index 75%
rename from doc/goops/goops-tutorial.texi
rename to doc/ref/goops-tutorial.texi
index 11155df..600be77 100644
--- a/doc/goops/goops-tutorial.texi
+++ b/doc/ref/goops-tutorial.texi
@@ -1,3 +1,9 @@
address@hidden -*-texinfo-*-
address@hidden This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  2008, 2009
address@hidden   Free Software Foundation, Inc.
address@hidden See the file guile.texi for copying conditions.
+
 @c Original attribution:
 
 @c
@@ -24,19 +30,33 @@
 @c Guile
 @c @end macro
 
-This is chapter was originally written by Erick Gallesio as an appendix
-for the STk reference manual, and subsequently adapted to @goops{}.
+This section introduces the @goops{} package in more detail.  It was
+originally written by Erick Gallesio as an appendix for the STk
+reference manual, and subsequently adapted to @goops{}.
+
+The procedures and syntax described in this tutorial are provided by
+Guile modules that may need to be imported before being available.
+The main @goops{} module is imported by evaluating:
+
address@hidden
+(use-modules (oop goops))
address@hidden lisp
address@hidden (oop goops)
address@hidden main module
address@hidden loading
address@hidden preparing
 
 @menu
 * Copyright::
-* Intro::                
-* Class definition and instantiation::  
+* Class definition::  
+* Instance creation and slot access::  
+* Slot description::            
 * Inheritance::                 
 * Generic functions::           
 @end menu
 
address@hidden Copyright, Intro, Tutorial, Tutorial
address@hidden Copyright
address@hidden Copyright
address@hidden Copyright
 
 Original attribution:
 
@@ -52,52 +72,13 @@ required for any of the authorized uses.
 This software is provided ``AS IS'' without express or implied
 warranty.
 
-Adapted for use in Guile with the authors permission
-
address@hidden Intro, Class definition and instantiation, Copyright, Tutorial
address@hidden Introduction
-
address@hidden is the object oriented extension to @guile{}. Its
-implementation is derived from @w{STk-3.99.3} by Erick Gallesio and
-version 1.3 of the Gregor Kiczales @cite{Tiny-Clos}.  It is very close
-to CLOS, the Common Lisp Object System (@cite{CLtL2}) but is adapted for
-the Scheme language.
-
-Briefly stated, the @goops{} extension gives the user a full object
-oriented system with multiple inheritance and generic functions with
-multi-method dispatch.  Furthermore, the implementation relies on a true
-meta object protocol, in the spirit of the one defined for CLOS
-(@cite{Gregor Kiczales: A Metaobject Protocol}).
-
-The purpose of this tutorial is to introduce briefly the @goops{}
-package and in no case will it replace the @goops{} reference manual
-(which needs to be urgently written now@ @dots{}).
+Adapted for use in Guile with the author's permission
 
-Note that the operations described in this tutorial resides in modules
-that may need to be imported before being available.  The main module is
-imported by evaluating:
-
address@hidden
-(use-modules (oop goops))
address@hidden lisp
address@hidden (oop goops)
address@hidden main module
address@hidden loading
address@hidden preparing
-
address@hidden Class definition and instantiation, Inheritance, Intro, Tutorial
address@hidden Class definition and instantiation
-
address@hidden
-* Class definition::            
address@hidden menu
-
address@hidden Class definition,  , Class definition and instantiation, Class 
definition and instantiation
address@hidden Class definition
 @subsection Class definition
 
-A new class is defined with the @address@hidden't
-forget to import the @code{(oop goops)} module} macro. The syntax of
address@hidden is close to CLOS @code{defclass}:
+A new class is defined with the @code{define-class} macro. The syntax
+of @code{define-class} is close to CLOS @code{defclass}:
 
 @findex define-class
 @cindex class
@@ -107,105 +88,36 @@ forget to import the @code{(oop goops)} module} macro. 
The syntax of
    @var{class-option} @dots{})
 @end lisp
 
-Class options will not be discussed in this tutorial.  The list of
address@hidden specifies which classes to inherit properties from
address@hidden (see @ref{Inheritance} for more details).  A
address@hidden gives the name of a slot and, eventually, some
-``properties'' of this slot (such as its initial value, the function
-which permit to access its value, @dots{}). Slot descriptions will be
-discussed in @ref{Slot description}.
address@hidden is the class being defined.  The list of
address@hidden specifies which existing classes, if any, to
+inherit slots and properties from.  Each @var{slot-description} gives
+the name of a slot and optionally some ``properties'' of this slot;
+for example its initial value, the name of a function which will
+access its value, and so on.  Slot descriptions and inheritance are
+discussed more below.  For class options, see @ref{Class Options}.
 @cindex slot
 
-As an example, let us define a type for representation of complex
-numbers in terms of real numbers. This can be done with the following
-class definition:
+As an example, let us define a type for representing a complex number
+in terms of two real address@hidden course Guile already
+provides complex numbers, and @code{<complex>} is in fact a predefined
+class in GOOPS; but the definition here is still useful as an
+example.}  This can be done with the following class definition:
 
 @lisp
-(define-class  <complex> (<number>)
+(define-class <my-complex> (<number>)
    r i)
 @end lisp
 
-This binds the variable @code{<complex>address@hidden@code{<complex>} is in
-fact a builtin class in GOOPS.  Because of this, GOOPS will create a new
-class.  The old class will still serve as the type for Guile's native
-complex numbers.} to a new class whose instances contain two
-slots. These slots are called @code{r} an @code{i} and we suppose here
-that they contain respectively the real part and the imaginary part of a
-complex number. Note that this class inherits from @code{<number>} which
-is a pre-defined class.  (@code{<number>} is the direct super class of
-the pre-defined class @code{<complex>} which, in turn, is the super
-class of @code{<real>} which is the super of
address@hidden<integer>}.)@footnote{With the new definition of @code{<complex>},
-a @code{<real>} is not a @code{<complex>} since @code{<real>} inherits
-from @code{ <number>} rather than @code{<complex>}. In practice,
-inheritance could be modified @emph{a posteriori}, if needed. However,
-this necessitates some knowledge of the meta object protocol and it will
-not be shown in this document}.
-
address@hidden Inheritance, Generic functions, Class definition and 
instantiation, Tutorial
address@hidden Inheritance
address@hidden \label{inheritance}
-
address@hidden
-* Class hierarchy and inheritance of slots::  
-* Instance creation and slot access::  
-* Slot description::            
-* Class precedence list::       
address@hidden menu
-
address@hidden Class hierarchy and inheritance of slots, Instance creation and 
slot access, Inheritance, Inheritance
address@hidden Class hierarchy and inheritance of slots
-Inheritance is specified upon class definition. As said in the
-introduction, @goops{} supports multiple inheritance.  Here are some
-class definitions:
-
address@hidden
-(define-class A () a)
-(define-class B () b)
-(define-class C () c)
-(define-class D (A B) d a)
-(define-class E (A C) e c)
-(define-class F (D E) f)
address@hidden lisp
-
address@hidden, @code{B}, @code{C} have a null list of super classes. In this
-case, the system will replace it by the list which only contains
address@hidden<object>}, the root of all the classes defined by
address@hidden @code{D}, @code{E}, @code{F} use multiple
-inheritance: each class inherits from two previously defined classes.
-Those class definitions define a hierarchy which is shown in Figure@ 1.
-In this figure, the class @code{<top>} is also shown; this class is the
-super class of all Scheme objects. In particular, @code{<top>} is the
-super class of all standard Scheme types.
-
address@hidden
address@hidden
address@hidden
address@hidden @emph{Fig 1: A class hierarchy}
address@hidden
address@hidden(@code{<complex>} which is the direct subclass of @code{<number>}
-and the direct superclass of @code{<real>} has been omitted in this
-figure.)}
address@hidden iftex
address@hidden group
address@hidden example
-
-The set of slots of a given class is calculated by taking the union of the
-slots of all its super class. For instance, each instance of the class
-D, defined before will have three slots (@code{a}, @code{b} and
address@hidden). The slots of a class can be obtained by the @code{class-slots}
-primitive.  For instance,
-
address@hidden
-(class-slots A) @result{} ((a))
-(class-slots E) @result{} ((a) (e) (c))
-(class-slots F) @result{} ((e) (c) (b) (d) (a) (f))
address@hidden used to be ((d) (a) (b) (c) (f))
address@hidden lisp
-
address@hidden: } The order of slots is not significant.
+This binds the variable @code{<my-complex>} to a new class whose
+instances will contain two slots.  These slots are called @code{r} and
address@hidden and will hold the real and imaginary parts of a complex
+number. Note that this class inherits from @code{<number>}, which is a
+predefined address@hidden@code{<number>} is the direct superclass of
+the predefined class @code{<complex>}; @code{<complex>} is the
+superclass of @code{<real>}, and @code{<real>} is the superclass of
address@hidden<integer>}.}
 
address@hidden Instance creation and slot access, Slot description, Class 
hierarchy and inheritance of slots, Inheritance
address@hidden Instance creation and slot access
 @subsection Instance creation and slot access
 
 Creation of an instance of a previously defined
@@ -218,16 +130,16 @@ slots of the newly created instance. For instance, the 
following form
 @findex make
 @cindex instance
 @lisp
-(define c (make <complex>))
+(define c (make <my-complex>))
 @end lisp
 
-will create a new @code{<complex>} object and will bind it to the @code{c}
address@hidden
+will create a new @code{<my-complex>} object and will bind it to the @code{c}
 Scheme variable.
 
 Accessing the slots of the new complex number can be done with the
address@hidden and the @code{slot-set!}  primitives. @code{Slot-set!}
-primitive permits to set the value of an object slot and @code{slot-ref}
-permits to get its value.
address@hidden and the @code{slot-set!}  primitives. @code{slot-set!}
+sets the value of an object slot and @code{slot-ref} retrieves it.
 
 @findex slot-set!
 @findex slot-ref
@@ -250,52 +162,60 @@ First load the module @code{(oop goops describe)}:
 @code{(use-modules (oop goops describe))}
 @end example
 
-The expression
address@hidden
+Then the expression
 
address@hidden
address@hidden
 (describe c)
address@hidden smalllisp
address@hidden lisp
 
-will now print the following information on the standard output:
address@hidden
+will print the following information on the standard output:
 
address@hidden
-#<<complex> 401d8638> is an instance of class <complex>
address@hidden
+#<<my-complex> 401d8638> is an instance of class <my-complex>
 Slots are: 
      r = 10
      i = 3
address@hidden lisp
address@hidden smalllisp
 
address@hidden Slot description, Class precedence list, Instance creation and 
slot access, Inheritance
address@hidden Slot description
 @subsection Slot description
 @c \label{slot-description}
 
-When specifying a slot, a set of options can be given to the
-system. Each option is specified with a keyword. The list of authorized
-keywords is given below:
+When specifying a slot (in a @code{(define-class @dots{})} form),
+various options can be specified in addition to the slot's name.  Each
+option is specified by a keyword.  The list of authorized keywords is
+given below:
 
 @cindex keyword
 @itemize @bullet
 @item
address@hidden:init-value} permits to supply a default value for the slot. This
-default value is obtained by evaluating the form given after the
address@hidden:init-form} in the global environment, at class definition time.
address@hidden:init-value} permits to supply a constant default value for the
+slot.  The value is obtained by evaluating the form given after the
address@hidden:init-value} at class definition time.
 @cindex default slot value
 @findex #:init-value
address@hidden top level environment
+
address@hidden
address@hidden:init-form} specifies a form that, when evaluated, will return
+an initial value for the slot.  The form is evaluated each time that
+an instance of the class is created, in the lexical environment of the
+containing @code{define-class} expression.
address@hidden default slot value
address@hidden #:init-form
 
 @item
 @code{#:init-thunk} permits to supply a thunk that will provide a
-default value for the slot. The value is obtained by evaluating the
-thunk a instance creation time.
address@hidden CHECKME: in the global environment?
+default value for the slot.  The value is obtained by invoking the
+thunk at instance creation time.
 @findex default slot value
 @findex #:init-thunk
address@hidden top level environment
 
 @item
address@hidden:init-keyword} permits to specify the keyword for initializing a
-slot. The init-keyword may be provided during instance creation (i.e. in
-the @code{make} optional parameter list). Specifying such a keyword
address@hidden:init-keyword} permits to specify a keyword for initializing the
+slot.  The init-keyword may be provided during instance creation (i.e. in
+the @code{make} optional parameter list).  Specifying such a keyword
 during instance initialization will supersede the default slot
 initialization possibly given with @code{#:init-form}.
 @findex #:init-keyword
@@ -361,11 +281,11 @@ and @code{#:slot-set!} options. See the example below.
 @end itemize
 @end itemize
 
-To illustrate slot description, we shall redefine the @code{<complex>} class 
+To illustrate slot description, we shall redefine the @code{<my-complex>} 
class 
 seen before. A definition could be:
 
 @lisp
-(define-class <complex> (<number>) 
+(define-class <my-complex> (<number>) 
    (r #:init-value 0 #:getter get-r #:setter set-r! #:init-keyword #:r)
    (i #:init-value 0 #:getter get-i #:setter set-i! #:init-keyword #:i))
 @end lisp
@@ -378,11 +298,11 @@ functions @code{get-r} and @code{set-r!} (resp. 
@code{get-i} and
 the @code{r} (resp. @code{i}) slot.
 
 @lisp
-(define c1 (make <complex> #:r 1 #:i 2))
+(define c1 (make <my-complex> #:r 1 #:i 2))
 (get-r c1) @result{} 1
 (set-r! c1 12)
 (get-r c1) @result{} 12
-(define c2 (make <complex> #:r 2))
+(define c2 (make <my-complex> #:r 2))
 (get-r c2) @result{} 2
 (get-i c2) @result{} 0
 @end lisp
@@ -390,12 +310,12 @@ the @code{r} (resp. @code{i}) slot.
 Accessors provide an uniform access for reading and writing an object
 slot.  Writing a slot is done with an extended form of @code{set!}
 which is close to the Common Lisp @code{setf} macro. So, another
-definition of the previous @code{<complex>} class, using the
+definition of the previous @code{<my-complex>} class, using the
 @code{#:accessor} option, could be:
 
 @findex set!
 @lisp
-(define-class <complex> (<number>) 
+(define-class <my-complex> (<number>) 
    (r #:init-value 0 #:accessor real-part #:init-keyword #:r)
    (i #:init-value 0 #:accessor imag-part #:init-keyword #:i))
 @end lisp
@@ -416,13 +336,13 @@ coordinates as well as with polar coordinates. One 
solution could be to
 have a definition of complex numbers which uses one particular
 representation and some conversion functions to pass from one
 representation to the other.  A better solution uses virtual slots. A
-complete definition of the @code{<complex>} class using virtual slots is
+complete definition of the @code{<my-complex>} class using virtual slots is
 given in Figure@ 2.
 
 @example
 @group
 @lisp
-(define-class <complex> (<number>)
+(define-class <my-complex> (<number>)
    ;; True slots use rectangular coordinates
    (r #:init-value 0 #:accessor real-part #:init-keyword #:r)
    (i #:init-value 0 #:accessor imag-part #:init-keyword #:i)
@@ -446,7 +366,7 @@ given in Figure@ 2.
                       (slot-set! o 'i (* m (sin a)))))))
 
 @end lisp
address@hidden @emph{Fig 2: A @code{<complex>} number class definition using 
virtual slots}
address@hidden @emph{Fig 2: A @code{<my-complex>} number class definition using 
virtual slots}
 @end group
 @end example
 
@@ -480,20 +400,21 @@ A more complete example is given below:
 
 @example
 @group
address@hidden
-(define c (make <complex> #:r 12 #:i 20))
address@hidden
+(define c (make <my-complex> #:r 12 #:i 20))
 (real-part c) @result{} 12
 (angle c) @result{} 1.03037682652431
 (slot-set! c 'i 10)
 (set! (real-part c) 1)
-(describe c) @result{}
-          #<<complex> 401e9b58> is an instance of class <complex>
-          Slots are: 
-               r = 1
-               i = 10
-               m = 10.0498756211209
-               a = 1.47112767430373
address@hidden lisp
+(describe c)
address@hidden
+#<<my-complex> 401e9b58> is an instance of class <my-complex>
+Slots are: 
+     r = 1
+     i = 10
+     m = 10.0498756211209
+     a = 1.47112767430373
address@hidden smalllisp
 @end group
 @end example
 
@@ -503,14 +424,75 @@ Scheme primitives.
 
 @lisp
 (define make-rectangular 
-   (lambda (x y) (make <complex> #:r x #:i y)))
+   (lambda (x y) (make <my-complex> #:r x #:i y)))
 
 (define make-polar
-   (lambda (x y) (make <complex> #:magn x #:angle y)))
+   (lambda (x y) (make <my-complex> #:magn x #:angle y)))
address@hidden lisp
+
address@hidden Inheritance
address@hidden Inheritance
address@hidden \label{inheritance}
+
address@hidden
+* Class hierarchy and inheritance of slots::  
+* Class precedence list::       
address@hidden menu
+
address@hidden Class hierarchy and inheritance of slots
address@hidden Class hierarchy and inheritance of slots
+Inheritance is specified upon class definition. As said in the
+introduction, @goops{} supports multiple inheritance.  Here are some
+class definitions:
+
address@hidden
+(define-class A () a)
+(define-class B () b)
+(define-class C () c)
+(define-class D (A B) d a)
+(define-class E (A C) e c)
+(define-class F (D E) f)
 @end lisp
 
address@hidden Class precedence list,  , Slot description, Inheritance
address@hidden Class precedence list
address@hidden, @code{B}, @code{C} have a null list of super classes. In this
+case, the system will replace it by the list which only contains
address@hidden<object>}, the root of all the classes defined by
address@hidden @code{D}, @code{E}, @code{F} use multiple
+inheritance: each class inherits from two previously defined classes.
+Those class definitions define a hierarchy which is shown in Figure@ 1.
+In this figure, the class @code{<top>} is also shown; this class is the
+super class of all Scheme objects. In particular, @code{<top>} is the
+super class of all standard Scheme types.
+
address@hidden
address@hidden
address@hidden
address@hidden @emph{Fig 1: A class hierarchy}
address@hidden
address@hidden(@code{<complex>} which is the direct subclass of @code{<number>}
+and the direct superclass of @code{<real>} has been omitted in this
+figure.)}
address@hidden iftex
address@hidden group
address@hidden example
+
+The set of slots of a given class is calculated by taking the union of the
+slots of all its super class. For instance, each instance of the class
+D, defined before will have three slots (@code{a}, @code{b} and
address@hidden). The slots of a class can be obtained by the @code{class-slots}
+primitive.  For instance,
+
address@hidden
+(class-slots A) @result{} ((a))
+(class-slots E) @result{} ((a) (e) (c))
+(class-slots F) @result{} ((e) (c) (b) (d) (a) (f))
address@hidden used to be ((d) (a) (b) (c) (f))
address@hidden lisp
+
address@hidden: } The order of slots is not significant.
+
address@hidden Class precedence list
address@hidden Class precedence list
 
 A class may have more than one superclass.  @footnote{This section is an
 adaptation of Jeff Dalton's (J.Dalton@@ed.ac.uk) @cite{Brief
@@ -587,8 +569,8 @@ However, this result is not too much readable; using the 
function
 (map class-name (class-precedence-list B)) @result{} (B <object> <top>) 
 @end lisp
 
address@hidden Generic functions,  , Inheritance, Tutorial
address@hidden Generic functions
address@hidden Generic functions
address@hidden Generic functions
 
 @menu
 * Generic functions and methods::  
@@ -596,8 +578,8 @@ However, this result is not too much readable; using the 
function
 * Example::                     
 @end menu
 
address@hidden Generic functions and methods, Next-method, Generic functions, 
Generic functions
address@hidden Generic functions and methods
address@hidden Generic functions and methods
address@hidden Generic functions and methods
 
 @c \label{gf-n-methods}
 Neither @goops{} nor CLOS use the message mechanism for methods as most
@@ -687,8 +669,8 @@ In this case,
 (G 'a 1)  @result{} top-number
 @end lisp
 
address@hidden Next-method, Example, Generic functions and methods, Generic 
functions
address@hidden Next-method
address@hidden Next-method
address@hidden Next-method
 
 When you call a generic function, with a particular set of arguments,
 GOOPS builds a list of all the methods that are applicable to those
@@ -737,16 +719,16 @@ Number is in range
 lead to an infinite recursion, but this consideration is just the same
 as in Scheme code in general.)
 
address@hidden Example,  , Next-method, Generic functions
address@hidden Example
address@hidden Example
address@hidden Example
 
-In this section we shall continue to define operations on the @code{<complex>}
+In this section we shall continue to define operations on the 
@code{<my-complex>}
 class defined in Figure@ 2. Suppose that we want to use it to implement 
 complex numbers completely. For instance a definition for the addition of 
 two complexes could be
 
 @lisp
-(define-method (new-+ (a <complex>) (b <complex>))
+(define-method (new-+ (a <my-complex>) (b <my-complex>))
   (make-rectangular (+ (real-part a) (real-part b))
                     (+ (imag-part a) (imag-part b))))
 @end lisp
@@ -758,7 +740,7 @@ addition we can do:
 (define-generic new-+)
 
 (let ((+ +))
-  (define-method (new-+ (a <complex>) (b <complex>))
+  (define-method (new-+ (a <my-complex>) (b <my-complex>))
     (make-rectangular (+ (real-part a) (real-part b))
                       (+ (imag-part a) (imag-part b)))))
 @end lisp
@@ -778,13 +760,13 @@ Figure@ 3.
 
   (define-method (new-+ (a <real>) (b <real>)) (+ a b))
 
-  (define-method (new-+ (a <real>) (b <complex>)) 
+  (define-method (new-+ (a <real>) (b <my-complex>)) 
     (make-rectangular (+ a (real-part b)) (imag-part b)))
 
-  (define-method (new-+ (a <complex>) (b <real>))
+  (define-method (new-+ (a <my-complex>) (b <real>))
     (make-rectangular (+ (real-part a) b) (imag-part a)))
 
-  (define-method (new-+ (a <complex>) (b <complex>))
+  (define-method (new-+ (a <my-complex>) (b <my-complex>))
     (make-rectangular (+ (real-part a) (real-part b))
                       (+ (imag-part a) (imag-part b))))
 
@@ -823,7 +805,7 @@ To terminate our implementation (integration?) of  complex 
numbers, we can
 redefine standard Scheme predicates in the following manner:
 
 @lisp
-(define-method (complex? c <complex>) #t)
+(define-method (complex? c <my-complex>) #t)
 (define-method (complex? c)           #f)
 
 (define-method (number? n <number>) #t)
diff --git a/doc/goops/goops.texi b/doc/ref/goops.texi
similarity index 93%
rename from doc/goops/goops.texi
rename to doc/ref/goops.texi
index d6d8e59..c0a828f 100644
--- a/doc/goops/goops.texi
+++ b/doc/ref/goops.texi
@@ -1,19 +1,8 @@
-\input texinfo
 @c -*-texinfo-*-
address@hidden %**start of header
address@hidden goops.info
address@hidden Goops Manual
address@hidden goops
address@hidden odd
address@hidden 0
address@hidden %**end of header
-
address@hidden VERSION 0.3
-
address@hidden The Algorithmic Language Scheme
address@hidden
-* GOOPS: (goops).               The GOOPS reference manual.
address@hidden direntry
address@hidden This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C)  2008, 2009
address@hidden   Free Software Foundation, Inc.
address@hidden See the file guile.texi for copying conditions.
 
 @macro goops
 GOOPS
@@ -23,77 +12,8 @@ GOOPS
 Guile
 @end macro
 
address@hidden
-This file documents GOOPS, an object oriented extension for Guile.
-
-Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation
-
-Permission is granted to make and distribute verbatim copies of
-this manual provided the copyright notice and this permission notice
-are preserved on all copies.
-
address@hidden ifinfo
-
address@hidden  This title page illustrates only one of the
address@hidden  two methods of forming a title page.
-
address@hidden
address@hidden Goops Manual
address@hidden For use with GOOPS @value{VERSION}
-
address@hidden AUTHORS
-
address@hidden The GOOPS tutorial was written by Christian Lynbech and Mikael
address@hidden Djurfeldt, who also wrote GOOPS itself.  The GOOPS reference 
manual
address@hidden and MOP documentation were written by Neil Jerram and reviewed by
address@hidden Mikael Djurfeldt.
-
address@hidden Christian Lynbech
address@hidden @email{chl@@tbit.dk}
address@hidden
address@hidden Mikael Djurfeldt
address@hidden @email{djurfeldt@@nada.kth.se}
address@hidden
address@hidden Neil Jerram
address@hidden @email{neil@@ossau.uklinux.net}
-
address@hidden  The following two commands
address@hidden  start the copyright page.
address@hidden
address@hidden 0pt plus 1filll
-Copyright @copyright{} 1999, 2006 Free Software Foundation
-
-Permission is granted to make and distribute verbatim copies of
-this manual provided the copyright notice and this permission notice
-are preserved on all copies.
-
address@hidden titlepage
-
address@hidden Top, Introduction, (dir), (dir)
-
address@hidden
-* Introduction::
-* Getting Started::
-* Reference Manual::
-* MOP Specification::
-
-* Tutorial::
-
-* Concept Index::
-* Function and Variable Index::
address@hidden menu
-
address@hidden
address@hidden Preliminaries
address@hidden iftex
-
address@hidden Introduction, Getting Started, Top, Top
address@hidden
address@hidden Introduction
address@hidden iftex
address@hidden
address@hidden Introduction
address@hidden ifnottex
address@hidden GOOPS
address@hidden GOOPS
 
 @goops{} is the object oriented extension to @guile{}. Its
 implementation is derived from @w{STk-3.99.3} by Erick Gallesio and
@@ -109,71 +29,58 @@ multi-method dispatch.  Furthermore, the implementation 
relies on a true
 meta object protocol, in the spirit of the one defined for CLOS
 (@cite{Gregor Kiczales: A Metaobject Protocol}).
 
address@hidden Getting Started, Reference Manual, Introduction, Top
address@hidden
address@hidden Getting Started
address@hidden iftex
address@hidden
address@hidden Getting Started
address@hidden ifnottex
-
 @menu
-* Running GOOPS::
-
-Examples of some basic GOOPS functionality.
-
-* Methods::
-* User-defined types::
-* Asking for the type of an object::
-
-See further in the GOOPS tutorial available in this distribution in
-info (goops.info) and texinfo format.
+* Quick Start::
+* Tutorial::
+* Reference Manual::
+* MOP Specification::
 @end menu
 
address@hidden Running GOOPS, Methods, Getting Started, Getting Started
address@hidden Running GOOPS
-
address@hidden
address@hidden
-Type
-
address@hidden
-guile-oops
address@hidden smalllisp
address@hidden Quick Start
address@hidden Quick Start
 
-You should now be at the Guile prompt ("guile> ").
+To give an immediate flavour of what GOOPS can do, here is a very
+brief introduction to its main operations.
 
address@hidden
-Type
+To start using GOOPS, load the @code{(oop goops)} module:
 
address@hidden
address@hidden
 (use-modules (oop goops))
address@hidden smalllisp
-
-to load GOOPS.  (If your system supports dynamic loading, you
-should be able to do this not only from `guile-oops' but from an
-arbitrary Guile interpreter.)
address@hidden enumerate
address@hidden lisp
 
 We're now ready to try some basic GOOPS functionality.
 
address@hidden Methods, User-defined types, Running GOOPS, Getting Started
address@hidden
+* Methods::
+* User-defined types::
+* Asking for the type of an object::
address@hidden menu
+
address@hidden Methods
 @subsection Methods
 
address@hidden
address@hidden
+A GOOPS method is like a Scheme procedure except that it is
+specialized for a particular set of argument types.
+
address@hidden
 (define-method (+ (x <string>) (y <string>))
   (string-append x y))
 
-(+ 1 2) --> 3
-(+ "abc" "de") --> "abcde"
address@hidden group
address@hidden smalllisp
+(+ "abc" "de") @result{} "abcde"
address@hidden lisp
 
address@hidden User-defined types, Asking for the type of an object, Methods, 
Getting Started
+If @code{+} is used with arguments that do not match the method's
+types, Guile falls back to using the normal Scheme @code{+} procedure.
+
address@hidden
+(+ 1 2) @result{} 3
address@hidden lisp
+
+
address@hidden User-defined types
 @subsection User-defined types
 
address@hidden
address@hidden
 (define-class <2D-vector> ()
   (x #:init-value 0 #:accessor x-component #:init-keyword #:x)
   (y #:init-value 0 #:accessor y-component #:init-keyword #:y))
@@ -182,12 +89,11 @@ We're now ready to try some basic GOOPS functionality.
 (use-modules (ice-9 format))
 
 (define-method (write (obj <2D-vector>) port)
-  (display (format #f "<~S, ~S>" (x-component obj) (y-component obj))
-           port))
+  (format port "<~S, ~S>" (x-component obj) (y-component obj)))
 
 (define v (make <2D-vector> #:x 3 #:y 4))
 
-v --> <3, 4>
+v @result{} <3, 4>
 @end group
 
 @group
@@ -196,24 +102,28 @@ v --> <3, 4>
         #:x (+ (x-component x) (x-component y))
         #:y (+ (y-component x) (y-component y))))
 
-(+ v v) --> <6, 8>
+(+ v v) @result{} <6, 8>
 @end group
address@hidden smalllisp
address@hidden lisp
 
address@hidden Asking for the type of an object, , User-defined types, Getting 
Started
address@hidden Asking for the type of an object
 @subsection Types
 
 @example
-(class-of v) --> #<<class> <2D-vector> 40241ac0>
-<2D-vector>  --> #<<class> <2D-vector> 40241ac0>
-(class-of 1) --> #<<class> <integer> 401b2a98>
-<integer>    --> #<<class> <integer> 401b2a98>
+(class-of v) @result{} #<<class> <2D-vector> 40241ac0>
+<2D-vector>  @result{} #<<class> <2D-vector> 40241ac0>
+(class-of 1) @result{} #<<class> <integer> 401b2a98>
+<integer>    @result{} #<<class> <integer> 401b2a98>
 
-(is-a? v <2D-vector>) --> #t
+(is-a? v <2D-vector>) @result{} #t
 @end example
 
address@hidden Reference Manual, MOP Specification, Getting Started, Top
address@hidden Reference Manual
address@hidden Tutorial
address@hidden Tutorial
address@hidden goops-tutorial.texi
+
address@hidden Reference Manual
address@hidden Reference Manual
 
 This chapter is the GOOPS reference manual.  It aims to describe all the
 syntax, procedures, options and associated concepts that a typical
@@ -241,7 +151,7 @@ For a detailed specification of the GOOPS metaobject 
protocol, see
 @end menu
 
 @node Introductory Remarks
address@hidden Introductory Remarks
address@hidden Introductory Remarks
 
 GOOPS is an object-oriented programming system based on a ``metaobject
 protocol'' derived from the ones used in CLOS (the Common Lisp Object
@@ -261,19 +171,19 @@ GOOPS' power, by customizing the behaviour of GOOPS 
itself.
 
 Each of the following sections of the reference manual is arranged
 such that the most basic usage is introduced first, and then subsequent
-subsections discuss the related internal functions and metaobject
+subsubsections discuss the related internal functions and metaobject
 protocols, finishing with a description of how to customize that area of
 functionality.
 
 These introductory remarks continue with a few words about metaobjects
 and the MOP.  Readers who do not want to be bothered yet with the MOP
-and customization could safely skip this subsection on a first reading,
-and should correspondingly skip subsequent subsections that are
+and customization could safely skip this subsubsection on a first reading,
+and should correspondingly skip subsequent subsubsections that are
 concerned with internals and customization.
 
 In general, this reference manual assumes familiarity with standard
 object oriented concepts and terminology.  However, some of the terms
-used in GOOPS are less well known, so the Terminology subsection
+used in GOOPS are less well known, so the Terminology subsubsection
 provides definitions for these terms.
 
 @menu
@@ -282,7 +192,7 @@ provides definitions for these terms.
 @end menu
 
 @node Metaobjects and the Metaobject Protocol
address@hidden Metaobjects and the Metaobject Protocol
address@hidden Metaobjects and the Metaobject Protocol
 
 The conceptual building blocks of GOOPS are classes, slot definitions,
 instances, generic functions and methods.  A class is a grouping of
@@ -377,7 +287,7 @@ Each subsequent section of the reference manual covers a 
particular area
 of GOOPS functionality, and describes the generic functions that are
 relevant for customization of that area.
 
-We conclude this subsection by emphasizing a point that may seem
+We conclude this subsubsection by emphasizing a point that may seem
 obvious, but contrasts with the corresponding situation in some other
 MOP implementations, such as CLOS.  The point is simply that an
 identifier which represents a GOOPS class or generic function is a
@@ -392,7 +302,7 @@ class names), but it is worth noting that GOOPS conforms 
fully to this
 Schemely principle.
 
 @node Terminology
address@hidden Terminology
address@hidden Terminology
 
 It is assumed that the reader is already familiar with standard object
 orientation concepts such as classes, objects/instances,
@@ -403,14 +313,7 @@ This section explains some of the less well known concepts 
and
 terminology that GOOPS uses, which are assumed by the following sections
 of the reference manual.
 
address@hidden
-* Metaclass::
-* Class Precedence List::
-* Accessor::
address@hidden menu
-
address@hidden Metaclass
address@hidden Metaclass
address@hidden Metaclass
 
 A @dfn{metaclass} is the class of an object which represents a GOOPS
 class.  Put more succinctly, a metaclass is a class's class.
@@ -517,8 +420,7 @@ The metaclass of @code{<my-metaclass>} is @code{<class>}.
 @code{<class>}.
 @end itemize
 
address@hidden Class Precedence List
address@hidden Class Precedence List
address@hidden Class Precedence List
 
 The @dfn{class precedence list} of a class is the list of all direct and
 indirect superclasses of that class, including the class itself.
@@ -548,8 +450,7 @@ precedence list}.
 ``Class precedence list'' is often abbreviated, in documentation and
 Scheme variable names, to @dfn{cpl}.
 
address@hidden Accessor
address@hidden Accessor
address@hidden Accessor
 
 An @dfn{accessor} is a generic function with both reference and setter
 methods.
@@ -583,7 +484,7 @@ be invoked using the generalized @code{set!} syntax, as in:
 @end example
 
 @node Defining New Classes
address@hidden Defining New Classes
address@hidden Defining New Classes
 
 [ *fixme* Somewhere in this manual there needs to be an introductory
 discussion about GOOPS classes, generic functions and methods, covering
@@ -622,7 +523,7 @@ the discussion there. ]
 @end menu
 
 @node Basic Class Definition
address@hidden Basic Class Definition
address@hidden Basic Class Definition
 
 New classes are defined using the @code{define-class} syntax, with
 arguments that specify the classes that the new class should inherit
@@ -651,7 +552,7 @@ keywords and corresponding values.
 @end deffn
 
 The standard GOOPS class and slot options are described in the following
-subsections: see @ref{Class Options} and @ref{Slot Options}.
+subsubsections: see @ref{Class Options} and @ref{Slot Options}.
 
 Example 1.  Define a class that combines two pre-existing classes by
 inheritance but adds no new slots.
@@ -681,13 +582,13 @@ customized via an application-defined metaclass.
 @end example
 
 @node Class Options
address@hidden Class Options
address@hidden Class Options
 
 @deffn {class option} #:metaclass metaclass
 The @code{#:metaclass} class option specifies the metaclass of the class
 being defined.  @var{metaclass} must be a class that inherits from
 @code{<class>}.  For an introduction to the use of metaclasses, see
address@hidden and the Metaobject Protocol} and @ref{Metaclass}.
address@hidden and the Metaobject Protocol} and @ref{Terminology}.
 
 If the @code{#:metaclass} option is absent, GOOPS reuses or constructs a
 metaclass for the new class by calling @code{ensure-metaclass}
@@ -714,7 +615,7 @@ environment defaults to the top-level environment in which 
the
 @end deffn
 
 @node Slot Options
address@hidden Slot Options
address@hidden Slot Options
 
 @deffn {slot option} #:allocation allocation
 The @code{#:allocation} option tells GOOPS how to allocate storage for
@@ -917,7 +818,7 @@ classes.
 @end deffn
 
 @node Class Definition Internals
address@hidden Class Definition Internals
address@hidden Class Definition Internals
 
 Implementation notes: @code{define-class} expands to an expression which
 
@@ -1030,7 +931,7 @@ class object, are described in @ref{Customizing Instance 
Creation},
 which covers the creation and initialization of instances in general.
 
 @node Customizing Class Definition
address@hidden Customizing Class Definition
address@hidden Customizing Class Definition
 
 During the initialization of a new class, GOOPS calls a number of generic
 functions with the newly allocated class instance as the first
@@ -1124,7 +1025,8 @@ allocation to do this.
 
 (let ((batch-allocation-count 0)
       (batch-get-n-set #f))
-  (define-method (compute-get-n-set (class <batched-allocation-metaclass>) s)
+  (define-method (compute-get-n-set
+                     (class <batched-allocation-metaclass>) s)
     (case (slot-definition-allocation s)
       ((#:batched)
        ;; If we've already used the same slot storage for 10 instances,
@@ -1165,7 +1067,7 @@ typically it would perform additional class 
initialization steps before
 and/or after calling @code{(next-method)} for the standard behaviour.
 
 @node STKlos Compatibility
address@hidden STKlos Compatibility
address@hidden STKlos Compatibility
 
 If the STKlos compatibility module is loaded, @code{define-class} is
 overwritten by a STKlos-specific definition; the standard GOOPS
@@ -1178,7 +1080,7 @@ definition of @code{define-class} remains available in
 @end deffn
 
 @node Creating Instances
address@hidden Creating Instances
address@hidden Creating Instances
 
 @menu
 * Basic Instance Creation::
@@ -1186,7 +1088,7 @@ definition of @code{define-class} remains available in
 @end menu
 
 @node Basic Instance Creation
address@hidden Basic Instance Creation
address@hidden Basic Instance Creation
 
 To create a new instance of any GOOPS class, use the generic function
 @code{make} or @code{make-instance}, passing the required class and any
@@ -1223,7 +1125,7 @@ instance's class.  Any unprocessed keyword value pairs 
are ignored.
 @end deffn
 
 @node Customizing Instance Creation
address@hidden Customizing Instance Creation
address@hidden Customizing Instance Creation
 
 @code{make} itself is a generic function.  Hence the @code{make}
 invocation itself can be customized in the case where the new instance's
@@ -1290,7 +1192,7 @@ and closures in the slot definitions, it is neater to 
write an
 and initializes all the dependent slot values according to the results.
 
 @node Accessing Slots
address@hidden Accessing Slots
address@hidden Accessing Slots
 
 The definition of a slot contains at the very least a slot name, and may
 also contain various slot options, including getter, setter and/or
@@ -1298,7 +1200,7 @@ accessor functions for the slot.
 
 It is always possible to access slots by name, using the various
 ``slot-ref'' and ``slot-set!'' procedures described in the following
-subsections.  For example,
+subsubsections.  For example,
 
 @example
 (define-class <my-class> ()      ;; Define a class with slots
@@ -1354,7 +1256,7 @@ closures, see @ref{Customizing Class Definition,, 
compute-get-n-set}.)
 @end menu
 
 @node Instance Slots
address@hidden Instance Slots
address@hidden Instance Slots
 
 Any slot, regardless of its allocation, can be queried, referenced and
 set using the following four primitive procedures.
@@ -1451,7 +1353,7 @@ slot-missing}).
 @end deffn
 
 @node Class Slots
address@hidden Class Slots
address@hidden Class Slots
 
 Slots whose allocation is per-class rather than per-instance can be
 referenced and set without needing to specify any particular instance.
@@ -1479,7 +1381,7 @@ function with arguments @var{class} and @var{slot-name}.
 @end deffn
 
 @node Handling Slot Access Errors
address@hidden Handling Slot Access Errors
address@hidden Handling Slot Access Errors
 
 GOOPS calls one of the following generic functions when a ``slot-ref''
 or ``slot-set!'' call specifies a non-existent slot name, or tries to
@@ -1510,7 +1412,7 @@ message.
 @end deffn
 
 @node Creating Generic Functions
address@hidden Creating Generic Functions
address@hidden Creating Generic Functions
 
 A generic function is a collection of methods, with rules for
 determining which of the methods should be applied for any given
@@ -1526,7 +1428,7 @@ GOOPS represents generic functions as metaobjects of the 
class
 @end menu
 
 @node Basic Generic Function Creation
address@hidden Basic Generic Function Creation
address@hidden Basic Generic Function Creation
 
 The following forms may be used to bind a variable to a generic
 function.  Depending on that variable's pre-existing value, the generic
@@ -1586,20 +1488,20 @@ This can be resolved automagically with the duplicates 
handler
 @code{merge-generics} which gives the module system license to merge
 all generic functions sharing a common name:
 
address@hidden
address@hidden
 (define-module (math 2D-vectors)
-  :use-module (oop goops)
-  :export (x y ...))
+  #:use-module (oop goops)
+  #:export (x y ...))
                  
 (define-module (math 3D-vectors)
-  :use-module (oop goops)
-  :export (x y z ...))
+  #:use-module (oop goops)
+  #:export (x y z ...))
 
 (define-module (my-module)
-  :use-module (math 2D-vectors)
-  :use-module (math 3D-vectors)
-  :duplicates merge-generics)
address@hidden smalllisp
+  #:use-module (math 2D-vectors)
+  #:use-module (math 3D-vectors)
+  #:duplicates merge-generics)
address@hidden lisp
 
 The generic function @code{x} in @code{(my-module)} will now share
 methods with @code{x} in both imported modules.
@@ -1629,14 +1531,14 @@ Sharing is dynamic, so that adding new methods to a 
descendant implies
 adding it to the ancestor.
 
 If duplicates checking is desired in the above example, the following
-form of the @code{:duplicates} option can be used instead:
+form of the @code{#:duplicates} option can be used instead:
 
address@hidden
-  :duplicates (merge-generics check)
address@hidden smalllisp
address@hidden
+  #:duplicates (merge-generics check)
address@hidden lisp
 
 @node Generic Function Internals
address@hidden Generic Function Internals
address@hidden Generic Function Internals
 
 @code{define-generic} calls @code{ensure-generic} to upgrade a
 pre-existing procedure value, or @code{make} with metaclass
@@ -1705,7 +1607,7 @@ accessor, passing the setter generic function as the 
value of the
 @code{#:setter} keyword.
 
 @node Extending Guiles Primitives
address@hidden Extending Guile's Primitives
address@hidden Extending Guile's Primitives
 
 When GOOPS is loaded, many of Guile's primitive procedures can be
 extended by giving them a generic function definition that operates
@@ -1752,7 +1654,7 @@ integrated into the core of Guile.  Consequently, the
 procedures described in this section may disappear as well.
 
 @node Adding Methods to Generic Functions
address@hidden Adding Methods to Generic Functions
address@hidden Adding Methods to Generic Functions
 
 @menu
 * Basic Method Definition::
@@ -1760,7 +1662,7 @@ procedures described in this section may disappear as 
well.
 @end menu
 
 @node Basic Method Definition
address@hidden Basic Method Definition
address@hidden Basic Method Definition
 
 To add a method to a generic function, use the @code{define-method} form.
 
@@ -1819,7 +1721,7 @@ invocation error handling, and generic function 
invocation in general,
 see @ref{Invoking Generic Functions}.
 
 @node Method Definition Internals
address@hidden Method Definition Internals
address@hidden Method Definition Internals
 
 @code{define-method}
 
@@ -1906,7 +1808,7 @@ function.
 @end deffn
 
 @node Invoking Generic Functions
address@hidden Invoking Generic Functions
address@hidden Invoking Generic Functions
 
 When a variable with a generic function definition appears as the first
 element of a list that is being evaluated, the Guile evaluator tries
@@ -1928,7 +1830,7 @@ may be applied subsequently if a method that is being 
applied calls
 @end menu
 
 @node Determining Which Methods to Apply
address@hidden Determining Which Methods to Apply
address@hidden Determining Which Methods to Apply
 
 [ *fixme*  Sorry - this is the area of GOOPS that I understand least of
 all, so I'm afraid I have to pass on this section.  Would some other
@@ -1959,7 +1861,7 @@ kind person consider filling it in? ]
 @end deffn
 
 @node Handling Invocation Errors
address@hidden Handling Invocation Errors
address@hidden Handling Invocation Errors
 
 @deffn generic no-method
 @deffnx method no-method (gf <generic>) args
@@ -1987,7 +1889,7 @@ default method calls @code{goops-error} with an 
appropriate message.
 @end deffn
 
 @node Redefining a Class
address@hidden Redefining a Class
address@hidden Redefining a Class
 
 Suppose that a class @code{<my-class>} is defined using @code{define-class}
 (@pxref{Basic Class Definition,, define-class}), with slots that have
@@ -2002,7 +1904,7 @@ make}).  What then happens if @code{<my-class>} is 
redefined by calling
 @end menu
 
 @node Default Class Redefinition Behaviour
address@hidden Default Class Redefinition Behaviour
address@hidden Default Class Redefinition Behaviour
 
 GOOPS' default answer to this question is as follows.
 
@@ -2055,7 +1957,7 @@ Also bear in mind that, like most of GOOPS' default 
behaviour, it can
 be address@hidden
 
 @node Customizing Class Redefinition
address@hidden Customizing Class Redefinition
address@hidden Customizing Class Redefinition
 
 When @code{define-class} notices that a class is being redefined,
 it constructs the new class metaobject as usual, and then invokes the
@@ -2092,7 +1994,8 @@ is specialized for this metaclass:
 @example
 (define-class <can-be-nameless> (<class>))
 
-(define-method (class-redefinition (old <can-be-nameless>) (new <class>))
+(define-method (class-redefinition (old <can-be-nameless>)
+                                   (new <class>))
   new)
 @end example
 
@@ -2119,7 +2022,7 @@ generic functions, and so address@hidden  The detailed 
protocol for all of these
 is described in @ref{MOP Specification}.
 
 @node Changing the Class of an Instance
address@hidden Changing the Class of an Instance
address@hidden Changing the Class of an Instance
 
 You can change the class of an existing instance by invoking the
 generic function @code{change-class} with two arguments: the instance
@@ -2158,7 +2061,7 @@ invokes the @code{change-class} generic function for each 
existing
 instance of the redefined class.
 
 @node Introspection
address@hidden Introspection
address@hidden Introspection
 
 @dfn{Introspection}, also known as @dfn{reflection}, is the name given
 to the ability to obtain information dynamically about GOOPS metaobjects.
@@ -2197,7 +2100,7 @@ GOOPS equivalents --- to be obtained dynamically, at run 
time.
 @end menu
 
 @node Classes
address@hidden Classes
address@hidden Classes
 
 @deffn {primitive procedure} class-name class
 Return the name of class @var{class}.
@@ -2257,7 +2160,7 @@ Return a list of all methods that use @var{class} or a 
subclass of
 @end deffn
 
 @node Slots
address@hidden Slots
address@hidden Slots
 
 @deffn procedure class-slot-definition class slot-name
 Return the slot definition for the slot named @var{slot-name} in class
@@ -2338,7 +2241,7 @@ see @ref{Slot Options,, init-value}.
 @end deffn
 
 @node Instances
address@hidden Instances
address@hidden Instances
 
 @deffn {primitive procedure} class-of value
 Return the GOOPS class of any Scheme @var{value}.
@@ -2359,7 +2262,7 @@ Implementation notes: @code{is-a?} uses @code{class-of} 
and
 @var{object}.
 
 @node Generic Functions
address@hidden Generic Functions
address@hidden Generic Functions
 
 @deffn {primitive procedure} generic-function-name gf
 Return the name of generic function @var{gf}.
@@ -2371,7 +2274,7 @@ This is the value of the @var{gf} metaobject's 
@code{methods} slot.
 @end deffn
 
 @node Generic Function Methods
address@hidden Generic Function Methods
address@hidden Generic Function Methods
 
 @deffn {primitive procedure} method-generic-function method
 Return the generic function that @var{method} belongs to.
@@ -2409,18 +2312,18 @@ Return an expression that prints to show the definition 
of method
 @end deffn
 
 @node Miscellaneous Functions
address@hidden Miscellaneous Functions
address@hidden Miscellaneous Functions
 
 @menu
 * Administrative Functions::
-* Error Handling::
+* GOOPS Error Handling::
 * Object Comparisons::
 * Cloning Objects::
 * Write and Display::
 @end menu
 
 @node Administrative Functions
address@hidden Administration Functions
address@hidden Administration Functions
 
 This section describes administrative, non-technical GOOPS functions.
 
@@ -2428,8 +2331,8 @@ This section describes administrative, non-technical 
GOOPS functions.
 Return the current GOOPS version as a string, for example ``0.2''.
 @end deffn
 
address@hidden Error Handling
address@hidden Error Handling
address@hidden GOOPS Error Handling
address@hidden Error Handling
 
 The procedure @code{goops-error} is called to raise an appropriate error
 by the default methods of the following generic functions:
@@ -2464,7 +2367,7 @@ as done by @code{scm-error}.
 @end deffn
 
 @node Object Comparisons
address@hidden Object Comparisons
address@hidden Object Comparisons
 
 @deffn generic eqv?
 @deffnx method eqv? ((x <top>) (y <top>))
@@ -2493,7 +2396,7 @@ and the Guile reference manual.
 @end deffn
 
 @node Cloning Objects
address@hidden Cloning Objects
address@hidden Cloning Objects
 
 @deffn generic shallow-clone
 @deffnx method shallow-clone (self <object>)
@@ -2514,7 +2417,7 @@ or by reference.
 @end deffn
 
 @node Write and Display
address@hidden Write and Display
address@hidden Write and Display
 
 @deffn {primitive generic} write object port
 @deffnx {primitive generic} display object port
@@ -2542,8 +2445,8 @@ methods - instances of the class @code{<method>}.
 as the Guile primitive @code{write} and @code{display} functions.
 @end deffn
 
address@hidden MOP Specification, Tutorial, Reference Manual, Top
address@hidden MOP Specification
address@hidden MOP Specification
address@hidden MOP Specification
 
 For an introduction to metaobjects and the metaobject protocol,
 see @ref{Metaobjects and the Metaobject Protocol}.
@@ -2598,7 +2501,7 @@ what the caller expects to get as the applied method's 
return value.
 @end menu
 
 @node Class Definition
address@hidden Class Definition
address@hidden Class Definition
 
 @code{define-class} (syntax)
 
@@ -2731,7 +2634,7 @@ or @code{#:accessor} option.
 @end itemize
 
 @node Instance Creation
address@hidden Instance Creation
address@hidden Instance Creation
 
 @code{make <class> . @var{initargs}} (method)
 
@@ -2752,13 +2655,13 @@ return value is ignored.
 @end itemize
 
 @node Class Redefinition
address@hidden Class Redefinition
address@hidden Class Redefinition
 
 The default @code{class-redefinition} method, specialized for classes
 with the default metaclass @code{<class>}, has the following internal
 protocol.
 
address@hidden @var{(old <class>)} @var{(new <class>)}}
address@hidden (@var{old <class>}) (@var{new <class>})}
 (method)
 
 @itemize @bullet
@@ -2797,7 +2700,7 @@ to the modified instance, and initializes new slots, as 
described in
 generic function invocation that can be used to customize the instance
 update algorithm.
 
address@hidden @var{(old-instance <object>)} @var{(new <class>)}} (method)
address@hidden (@var{old-instance <object>}) (@var{new <class>})} (method)
 
 @itemize @bullet
 @item
@@ -2814,7 +2717,7 @@ nothing.
 @end itemize
 
 @node Method Definition
address@hidden Method Definition
address@hidden Method Definition
 
 @code{define-method} (syntax)
 
@@ -2842,7 +2745,7 @@ theoretically handle adding methods to further types of 
target.
 @end itemize
 
 @node Generic Function Invocation
address@hidden Generic Function Invocation
address@hidden Generic Function Invocation
 
 [ *fixme* Description required here. ]
 
@@ -2885,21 +2788,3 @@ theoretically handle adding methods to further types of 
target.
 @item
 @code{no-next-method}
 @end itemize
-
address@hidden Tutorial, Concept Index, MOP Specification, Top
address@hidden Tutorial
address@hidden goops-tutorial.texi
-
address@hidden     Concept Index, Function and Variable Index, Tutorial, Top
address@hidden Concept Index
-
address@hidden cp
-
address@hidden Function and Variable Index,  , Concept Index, Top
address@hidden Function and Variable Index
-
address@hidden fn
-
address@hidden
address@hidden
address@hidden
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index a675899..332be36 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -4,22 +4,21 @@
 @setfilename guile.info
 @settitle Guile Reference Manual
 @set guile
address@hidden MANUAL-EDITION 1.1
address@hidden MANUAL-REVISION 1
 @c %**end of header
 @include version.texi
 @include lib-version.texi
address@hidden effective-version.texi
 
 @copying
-This reference manual documents Guile, GNU's Ubiquitous Intelligent
-Language for Extensions.  This is edition @value{MANUAL-EDITION}
-corresponding to Guile @value{VERSION}.
+This manual documents Guile version @value{VERSION}.
 
-Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005 Free
+Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2009 Free
 Software Foundation.
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with the
+any later version published by the Free Software Foundation; with
 no Invariant Sections, with the Front-Cover Texts being ``A GNU
 Manual,'' and with the Back-Cover Text ``You are free to copy and
 modify this GNU Manual.''.  A copy of the license is included in the
@@ -137,7 +136,7 @@ x
 @sp 10
 @comment The title is printed in a large font.
 @title Guile Reference Manual
address@hidden Edition @value{MANUAL-EDITION}, for use with Guile 
@value{VERSION}
address@hidden Edition @value{EDITION}, revision @value{MANUAL-REVISION}, for 
use with Guile @value{VERSION}
 @c @subtitle $Id: guile.texi,v 1.49 2008-03-19 22:51:23 ossau Exp $
 
 @c See preface.texi for the list of authors
@@ -177,6 +176,8 @@ x
 
 * Guile Modules::
 
+* GOOPS::
+
 * Guile Implementation::
 
 * Autoconf Support::
@@ -365,6 +366,8 @@ available through both Scheme and C interfaces.
 @include scsh.texi
 @include scheme-debugging.texi
 
address@hidden goops.texi
+
 @node Guile Implementation
 @chapter Guile Implementation
 
diff --git a/doc/goops/hierarchy.eps b/doc/ref/hierarchy.eps
similarity index 100%
rename from doc/goops/hierarchy.eps
rename to doc/ref/hierarchy.eps
diff --git a/doc/goops/hierarchy.pdf b/doc/ref/hierarchy.pdf
similarity index 100%
rename from doc/goops/hierarchy.pdf
rename to doc/ref/hierarchy.pdf
diff --git a/doc/goops/hierarchy.png b/doc/ref/hierarchy.png
similarity index 100%
rename from doc/goops/hierarchy.png
rename to doc/ref/hierarchy.png
diff --git a/doc/goops/hierarchy.txt b/doc/ref/hierarchy.txt
similarity index 100%
rename from doc/goops/hierarchy.txt
rename to doc/ref/hierarchy.txt
diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi
index b0c4c12..7e248e0 100644
--- a/doc/ref/intro.texi
+++ b/doc/ref/intro.texi
@@ -80,6 +80,7 @@ To unbundle Guile use the instruction
 zcat address@hidden | tar xvf -
 @end example
 
address@hidden
 which will create a directory called @address@hidden with
 all the sources.  You can look at the file @file{INSTALL} for detailed
 instructions on how to build and install Guile, but you should be able
@@ -93,7 +94,7 @@ make install
 @end example
 
 This will install the Guile executable @file{guile}, the Guile library
address@hidden and various associated header files and support
address@hidden and various associated header files and support
 libraries. It will also install the Guile tutorial and reference
 manual.
 
@@ -101,14 +102,14 @@ manual.
 
 Since this manual frequently refers to the Scheme ``standard'', also
 known as R5RS, or the
address@hidden
address@hidden
 ``Revised$^5$ Report on the Algorithmic Language Scheme'',
address@hidden iftex
address@hidden tex
 @ifnottex
 ``Revised^5 Report on the Algorithmic Language Scheme'',
 @end ifnottex
-we have included the report in the Guile distribution;
address@hidden, , Introduction, r5rs, Revised(5) Report on the Algorithmic
+we have included the report in the Guile distribution; see
address@hidden, , Introduction, r5rs, Revised(5) Report on the Algorithmic
 Language Scheme}.
 This will also be installed in your info directory.
 
@@ -471,11 +472,12 @@ You can get the version number by invoking the command
 @example
 $ guile --version
 Guile 1.9.0
-Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 
2007, 2008, 2009 Free Software Foundation
+Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004,
+2005, 2006, 2007, 2008, 2009 Free Software Foundation
 Guile may be distributed under the terms of the GNU Lesser General
 Public Licence.  For details, see the files `COPYING.LESSER' and
-`COPYING', which are included in the Guile distribution.  There is no
-warranty, to the extent permitted by law.
+`COPYING', which are included in the Guile distribution.  There is
+no warranty, to the extent permitted by law.
 @end example
 
 @item
diff --git a/doc/ref/libguile-extensions.texi b/doc/ref/libguile-extensions.texi
index 77762b5..78871c6 100644
--- a/doc/ref/libguile-extensions.texi
+++ b/doc/ref/libguile-extensions.texi
@@ -94,11 +94,11 @@ we are going to call the function @code{init_bessel} which 
will make
 @file{.so} when invoking @code{load-extension}.  The right extension for
 the host platform will be provided automatically.
 
address@hidden
address@hidden
 (load-extension "libguile-bessel" "init_bessel")
 (j0 2)
 @result{} 0.223890779141236
address@hidden smalllisp
address@hidden lisp
 
 For this to work, @code{load-extension} must be able to find
 @file{libguile-bessel}, of course.  It will look in the places that
diff --git a/doc/ref/libguile-linking.texi b/doc/ref/libguile-linking.texi
index 8869c46..72b59bb 100644
--- a/doc/ref/libguile-linking.texi
+++ b/doc/ref/libguile-linking.texi
@@ -173,7 +173,8 @@ creating ./config.status
 creating Makefile
 $ make
 gcc -c -I/usr/local/include simple-guile.c
-gcc simple-guile.o -L/usr/local/lib -lguile -lqthreads -lpthread -lm -o 
simple-guile
+gcc simple-guile.o -L/usr/local/lib -lguile -lqthreads -lpthread -lm
+  -o simple-guile
 $ ./simple-guile
 guile> (+ 1 2 3)
 6
diff --git a/doc/ref/libguile-smobs.texi b/doc/ref/libguile-smobs.texi
index 09b5446..738809d 100644
--- a/doc/ref/libguile-smobs.texi
+++ b/doc/ref/libguile-smobs.texi
@@ -28,7 +28,7 @@ datatypes described here.)
 
 @menu
 * Describing a New Type::       
-* Creating Instances::          
+* Creating Smob Instances::          
 * Type checking::                
 * Garbage Collecting Smobs::    
 * Garbage Collecting Simple Smobs::  
@@ -132,8 +132,8 @@ init_image_type (void)
 @end example
 
 
address@hidden Creating Instances
address@hidden Creating Instances
address@hidden Creating Smob Instances
address@hidden Creating Smob Instances
 
 Normally, smobs can have one @emph{immediate} word of data.  This word
 stores either a pointer to an additional memory block that holds the
@@ -211,7 +211,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
 
   /* Step 1: Allocate the memory block.
    */
-  image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
+  image = (struct image *)
+     scm_gc_malloc (sizeof (struct image), "image");
 
   /* Step 2: Initialize it with straight code.
    */
@@ -228,7 +229,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
   /* Step 4: Finish the initialization.
    */
   image->name = name;
-  image->pixels = scm_gc_malloc (width * height, "image pixels");
+  image->pixels =
+     scm_gc_malloc (width * height, "image pixels");
 
   return smob;
 @}
@@ -404,7 +406,9 @@ free_image (SCM image_smob)
 @{
   struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
 
-  scm_gc_free (image->pixels, image->width * image->height, "image pixels");
+  scm_gc_free (image->pixels,
+               image->width * image->height,
+               "image pixels");
   scm_gc_free (image, sizeof (struct image), "image");
 
   return 0;
@@ -583,7 +587,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
 
   /* Step 1: Allocate the memory block.
    */
-  image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
+  image = (struct image *)
+     scm_gc_malloc (sizeof (struct image), "image");
 
   /* Step 2: Initialize it with straight code.
    */
@@ -600,7 +605,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
   /* Step 4: Finish the initialization.
    */
   image->name = name;
-  image->pixels = scm_gc_malloc (width * height, "image pixels");
+  image->pixels =
+     scm_gc_malloc (width * height, "image pixels");
 
   return smob;
 @}
@@ -642,7 +648,9 @@ free_image (SCM image_smob)
 @{
   struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
 
-  scm_gc_free (image->pixels, image->width * image->height, "image pixels");
+  scm_gc_free (image->pixels,
+               image->width * image->height,
+               "image pixels");
   scm_gc_free (image, sizeof (struct image), "image");
 
   return 0;
diff --git a/doc/goops/mop.text b/doc/ref/mop.text
similarity index 100%
rename from doc/goops/mop.text
rename to doc/ref/mop.text
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 2d64919..d568af2 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2072,9 +2072,9 @@ The following procedures are similar to the @code{popen} 
and
 @code{pclose} system routines.  The code is in a separate ``popen''
 module:
 
address@hidden
address@hidden
 (use-modules (ice-9 popen))
address@hidden smalllisp
address@hidden lisp
 
 @findex popen
 @deffn {Scheme Procedure} open-pipe command mode
diff --git a/doc/ref/preface.texi b/doc/ref/preface.texi
index 7fa8581..8552d38 100644
--- a/doc/ref/preface.texi
+++ b/doc/ref/preface.texi
@@ -7,12 +7,9 @@
 @node Preface
 @chapter Preface
 
-This reference manual documents Guile, GNU's Ubiquitous Intelligent
-Language for Extensions.  It describes how to use Guile in many useful
-and interesting ways.
-
-This is edition @value{MANUAL-EDITION} of the reference manual, and
-corresponds to Guile version @value{VERSION}.
+This manual documents version @value{VERSION} of Guile, GNU's
+Ubiquitous Intelligent Language for Extensions.  It describes how to
+use Guile in many useful and interesting ways.
 
 @menu
 * Manual Layout::               
@@ -25,7 +22,7 @@ corresponds to Guile version @value{VERSION}.
 @node Manual Layout
 @section Layout of this Manual
 
-The manual is divided into five chapters.
+The manual is divided into the following chapters.
 
 @table @strong
 @item Chapter 1: Introduction to Guile
@@ -38,7 +35,7 @@ the later parts of the manual.  This part also explains how 
to obtain
 and install new versions of Guile, and how to report bugs effectively.
 
 @item Chapter 2: Programming in Scheme
-This part provides an overview over programming in Scheme with Guile.
+This part provides an overview of programming in Scheme with Guile.
 It covers how to invoke the @code{guile} program from the command-line
 and how to write scripts in Scheme.  It also gives an introduction
 into the basic ideas of Scheme itself and to the various extensions
@@ -61,6 +58,10 @@ Describes some important modules, distributed as part of the 
Guile
 distribution, that extend the functionality provided by the Guile
 Scheme core.
 
address@hidden Chapter 6: GOOPS
+Describes GOOPS, an object oriented extension to Guile that provides
+classes, multiple inheritance and generic functions.
+
 @end table
 
 
@@ -72,7 +73,7 @@ We use some conventions in this manual.
 @itemize @bullet
 
 @item
-For some procedures, notably type predicates, we use @dfn{iff} to mean
+For some procedures, notably type predicates, we use ``iff'' to mean
 ``if and only if''.  The construct is usually something like: `Return
 @var{val} iff @var{condition}', where @var{val} is usually
 address@hidden'' or address@hidden''.  This typically means that
@@ -144,6 +145,9 @@ filling out a lot of the documentation of Scheme data 
types, control
 mechanisms and procedures.  In addition, he wrote the documentation
 for Guile's SRFI modules and modules associated with the Guile REPL.
 
+The chapter on GOOPS was written by Christian Lynbech, Mikael
+Djurfeldt and Neil Jerram.
+
 @node Guile License
 @section The Guile License
 @cindex copying
@@ -179,7 +183,7 @@ C code linking to the Guile readline module is subject to 
the terms of
 that module.  Basically such code must be published on Free terms.
 
 Scheme level code written to be run by Guile (but not derived from
-Guile itself) is not resticted in any way, and may be published on any
+Guile itself) is not restricted in any way, and may be published on any
 terms.  We encourage authors to publish on Free terms.
 
 You must be aware there is no warranty whatsoever for Guile.  This is
diff --git a/doc/ref/scheme-debugging.texi b/doc/ref/scheme-debugging.texi
index 0751126..bcd9f2d 100644
--- a/doc/ref/scheme-debugging.texi
+++ b/doc/ref/scheme-debugging.texi
@@ -14,9 +14,9 @@ call to that procedure is reported to the user during a 
program run.
 The idea is that you can mark a collection of procedures for tracing,
 and Guile will subsequently print out a line of the form
 
address@hidden
address@hidden
 |  |  address@hidden @var{args} @dots{}]
address@hidden smalllisp
address@hidden lisp
 
 whenever a marked procedure is about to be applied to its arguments.
 This can help a programmer determine whether a function is being called
@@ -27,7 +27,7 @@ how the traced applications are or are not tail recursive 
with respect
 to each other.  Thus, a trace of a non-tail recursive factorial
 implementation looks like this:
 
address@hidden
address@hidden
 [fact1 4]
 |  [fact1 3]
 |  |  [fact1 2]
@@ -38,11 +38,11 @@ implementation looks like this:
 |  |  2
 |  6
 24
address@hidden smalllisp
address@hidden lisp
 
 While a typical tail recursive implementation would look more like this:
 
address@hidden
address@hidden
 [fact2 4]
 [facti 1 4]
 [facti 4 3]
@@ -50,7 +50,7 @@ While a typical tail recursive implementation would look more 
like this:
 [facti 24 1]
 [facti 24 0]
 24
address@hidden smalllisp
address@hidden lisp
 
 @deffn {Scheme Procedure} trace procedure
 Enable tracing for @code{procedure}.  While a program is being run,
diff --git a/doc/ref/scheme-ideas.texi b/doc/ref/scheme-ideas.texi
index 38b105b..55093cf 100644
--- a/doc/ref/scheme-ideas.texi
+++ b/doc/ref/scheme-ideas.texi
@@ -390,7 +390,11 @@ this:
 
 @noindent
 This is a valid procedure invocation expression, and its result is the
-string @code{"Name=FSF:Address=Cambridge"}.
+string:
+
address@hidden
+"Name=FSF:Address=Cambridge"
address@hidden lisp
 
 It is more common, though, to store the procedure value in a variable ---
 
diff --git a/doc/ref/scsh.texi b/doc/ref/scsh.texi
index 0f869ec..b1af1a4 100644
--- a/doc/ref/scsh.texi
+++ b/doc/ref/scsh.texi
@@ -19,8 +19,8 @@ For information about scsh see
 
 The closest emulation of scsh can be obtained by running:
 
address@hidden
address@hidden
 (load-from-path "scsh/init")
address@hidden smalllisp
address@hidden lisp
 
 See the USAGE file supplied with guile-scsh for more details.
diff --git a/doc/ref/slib.texi b/doc/ref/slib.texi
index fc8f919..d3357c9 100644
--- a/doc/ref/slib.texi
+++ b/doc/ref/slib.texi
@@ -4,7 +4,6 @@
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
address@hidden
 @node SLIB
 @section SLIB
 @cindex SLIB
@@ -12,9 +11,9 @@
 Before the SLIB facilities can be used, the following Scheme expression
 must be executed:
 
address@hidden
address@hidden
 (use-modules (ice-9 slib))
address@hidden smalllisp
address@hidden lisp
 
 @findex require
 @code{require} can then be used in the usual way (@pxref{Require,,,
@@ -64,7 +63,7 @@ Alternatively, you can create a symlink in the Guile 
directory to SLIB,
 e.g.:
 
 @example
-ln -s /usr/local/lib/slib /usr/local/share/guile/1.8/slib
+ln -s /usr/local/lib/slib /usr/local/share/guile/@value{EFFECTIVE-VERSION}/slib
 @end example
 
 @item
@@ -78,7 +77,7 @@ guile> (quit)
 @end example
 
 The catalog data should now be in
address@hidden/usr/local/share/guile/1.8/slibcat}.
address@hidden/usr/local/share/guile/@value{EFFECTIVE-VERSION}/slibcat}.
 
 If instead you get an error such as:
 
@@ -104,11 +103,11 @@ It is usually installed as an extra package in SLIB.
 
 You can use Guile's interface to SLIB to invoke Jacal:
 
address@hidden
address@hidden
 (use-modules (ice-9 slib))
 (slib:load "math")
 (math)
address@hidden smalllisp
address@hidden lisp
 
 @noindent
 For complete documentation on Jacal, please read the Jacal manual.  If
diff --git a/doc/ref/tools.texi b/doc/ref/tools.texi
index f2116dd..8b0d3a3 100644
--- a/doc/ref/tools.texi
+++ b/doc/ref/tools.texi
@@ -232,8 +232,8 @@ is a expression suitable for initializing a new variable.
 For procedures, you can use @code{SCM_DEFINE} for most purposes.  Use
 @code{SCM_PROC} along with @code{SCM_REGISTER_PROC} when you don't
 want to be bothered with docstrings.  Use @code{SCM_GPROC} for generic
-functions (@pxref{Creating Generic Functions,,, goops, GOOPS}).  All
-procedures are declared with return type @code{SCM}.
+functions (@pxref{Creating Generic Functions}).  All procedures are
+declared with return type @code{SCM}.
 
 For everything else, use the appropriate macro (@code{SCM_SYMBOL} for
 symbols, and so on).  Without "_GLOBAL_", the declarations are
@@ -364,7 +364,7 @@ of the form:
 
 @example
 (define-module (scripts PROGRAM)
-  :export (PROGRAM))
+  #:export (PROGRAM))
 @end example
 
 Feel free to export other definitions useful in the module context.
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 59798d8..43b2655 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -159,17 +159,19 @@ The structure of the fixed part of an application frame 
is as follows:
 
 @example
              Stack
-   |                  | <- fp + bp->nargs + bp->nlocs + 3
-   +------------------+    = SCM_FRAME_UPPER_ADDRESS (fp)
-   | Return address   |
-   | MV return address|
-   | Dynamic link     | <- fp + bp->nargs + bp->nlocs
-   | Local variable 1 |    = SCM_FRAME_DATA_ADDRESS (fp)
+   | ...              |
+   | Intermed. val. 0 | <- fp + bp->nargs + bp->nlocs = 
SCM_FRAME_UPPER_ADDRESS (fp)
+   +==================+
+   | Local variable 1 |
    | Local variable 0 | <- fp + bp->nargs
    | Argument 1       |
    | Argument 0       | <- fp
    | Program          | <- fp - 1
-   +------------------+    = SCM_FRAME_LOWER_ADDRESS (fp)
+   +------------------+    
+   | Return address   |
+   | MV return address|
+   | Dynamic link     | <- fp - 4 = SCM_FRAME_DATA_ADDRESS (fp) = 
SCM_FRAME_LOWER_ADDRESS (fp)
+   +==================+
    |                  |
 @end example
 
@@ -306,19 +308,19 @@ scheme@@(guile-user)> (define (foo a) (lambda (b) (list 
foo a b)))
 scheme@@(guile-user)> ,x foo
 Disassembly of #<program foo (a)>:
 
-   0    (object-ref 1)                  ;; #<program b7e478b0 at <unknown 
port>:0:16 (b)>
-   2    (local-ref 0)                   ;; `a' (arg)
-   4    (vector 0 1)                    ;; 1 element
+   0    (object-ref 1)          ;; #<program b7e478b0 at <unknown port>:0:16 
(b)>
+   2    (local-ref 0)           ;; `a' (arg)
+   4    (vector 0 1)            ;; 1 element
    7    (make-closure)                  
    8    (return)                        
 
 ----------------------------------------
 Disassembly of #<program b7e478b0 at <unknown port>:0:16 (b)>:
 
-   0    (toplevel-ref 1)                ;; `foo'
-   2    (free-ref 0)                    ;; (closure variable)
-   4    (local-ref 0)                   ;; `b' (arg)
-   6    (list 0 3)                      ;; 3 elements         at (unknown 
file):0:28
+   0    (toplevel-ref 1)        ;; `foo'
+   2    (free-ref 0)            ;; (closure variable)
+   4    (local-ref 0)           ;; `b' (arg)
+   6    (list 0 3)              ;; 3 elements         at (unknown file):0:28
    9    (return)                        
 @end smallexample
 
@@ -649,32 +651,30 @@ closures.
 @node Procedural Instructions
 @subsubsection Procedural Instructions
 
address@hidden Instruction return
-Free the program's frame, returning the top value from the stack to
-the current continuation. (The stack should have exactly one value on
-it.)
-
-Specifically, the @code{sp} is decremented to one below the current
address@hidden, the @code{ip} is reset to the current return address, the
address@hidden is reset to the value of the current dynamic link, and then
-the top item on the stack (formerly the procedure being applied) is
-set to the returned value.
address@hidden Instructions new-frame
+Push a new frame on the stack, reserving space for the dynamic link,
+return address, and the multiple-values return address. The frame
+pointer is not yet updated, because the frame is not yet active -- it
+has to be patched by a @code{call} instruction to get the return
+address.
 @end deffn
 
 @deffn Instruction call nargs
 Call the procedure located at @code{sp[-nargs]} with the @var{nargs}
 arguments located from @code{sp[-nargs + 1]} to @code{sp[0]}.
 
-For compiled procedures, this instruction sets up a new stack frame,
-as described in @ref{Stack Layout}, and then dispatches to the first
-instruction in the called procedure, relying on the called procedure
-to return one value to the newly-created continuation. Because the new
-frame pointer will point to sp[-nargs + 1], the arguments don't have
-to be shuffled around -- they are already in place.
+This instruction requires that a new frame be pushed on the stack
+before the procedure, via @code{new-frame}. @xref{Stack Layout}, for
+more information. It patches up that frame with the current @code{ip}
+as the return address, then dispatches to the first instruction in the
+called procedure, relying on the called procedure to return one value
+to the newly-created continuation. Because the new frame pointer will
+point to sp[-nargs + 1], the arguments don't have to be shuffled
+around -- they are already in place.
 
 For non-compiled procedures (continuations, primitives, and
-interpreted procedures), @code{call} will pop the procedure and
-arguments off the stack, and push the result of calling
+interpreted procedures), @code{call} will pop the frame, procedure,
+and arguments off the stack, and push the result of calling
 @code{scm_apply}.
 @end deffn
 
@@ -682,10 +682,10 @@ arguments off the stack, and push the result of calling
 Like @code{call}, but reusing the current continuation. This
 instruction implements tail calls as required by RnRS.
 
-For compiled procedures, that means that @code{goto/args} reuses the
-current frame instead of building a new one. The @code{goto/*}
-instruction family is named as it is because tail calls are equivalent
-to @code{goto}, along with relabeled variables.
+For compiled procedures, that means that @code{goto/args} simply
+shuffles down the procedure and arguments to the current stack frame.
+The @code{goto/*} instruction family is named as it is because tail
+calls are equivalent to @code{goto}, along with relabeled variables.
 
 For non-VM procedures, the result is the same, but the current VM
 invocation remains on the C stack. True tail calls are not currently
@@ -708,15 +708,6 @@ These instructions are used in the implementation of 
multiple value
 returns, where the actual number of values is pushed on the stack.
 @end deffn
 
address@hidden Instruction call/cc
address@hidden Instruction goto/cc
-Capture the current continuation, and then call (or tail-call) the
-procedure on the top of the stack, with the continuation as the
-argument.
-
-Both the VM continuation and the C continuation are captured.
address@hidden deffn
-
 @deffn Instruction mv-call nargs offset
 Like @code{call}, except that a multiple-value continuation is created
 in addition to a single-value continuation.
@@ -729,6 +720,18 @@ the stack to be the number of values, and below that values
 themselves, pushed separately.
 @end deffn
 
address@hidden Instruction return
+Free the program's frame, returning the top value from the stack to
+the current continuation. (The stack should have exactly one value on
+it.)
+
+Specifically, the @code{sp} is decremented to one below the current
address@hidden, the @code{ip} is reset to the current return address, the
address@hidden is reset to the value of the current dynamic link, and then
+the top item on the stack (formerly the procedure being applied) is
+set to the returned value.
address@hidden deffn
+
 @deffn Instruction return/values nvalues
 Return the top @var{nvalues} to the current continuation.
 
@@ -763,6 +766,19 @@ be 1 (to indicate that one of the bindings was a rest 
argument).
 Signals an error if there is an insufficient number of values.
 @end deffn
 
address@hidden Instruction call/cc
address@hidden Instruction goto/cc
+Capture the current continuation, and then call (or tail-call) the
+procedure on the top of the stack, with the continuation as the
+argument.
+
address@hidden/cc} does not require a @code{new-frame} to be pushed on the
+stack, as @code{call} does, because it needs to capture the stack
+before the frame is pushed.
+
+Both the VM continuation and the C continuation are captured.
address@hidden deffn
+
 @node Data Control Instructions
 @subsubsection Data Control Instructions
 
@@ -838,32 +854,6 @@ popping off those values and pushing on the resulting 
vector. @var{n}
 is a two-byte value, like in @code{vector}.
 @end deffn
 
address@hidden Instruction mark
-Pushes a special value onto the stack that other stack instructions
-like @code{list-mark} can use.
address@hidden deffn
-
address@hidden Instruction list-mark
-Create a list from values from the stack, as in @code{list}, but
-instead of knowing beforehand how many there will be, keep going until
-we see a @code{mark} value.
address@hidden deffn
-
address@hidden Instruction cons-mark
-As the scheme procedure @code{cons*} is to the scheme procedure
address@hidden, so the instruction @code{cons-mark} is to the instruction
address@hidden
address@hidden deffn
-
address@hidden Instruction vector-mark
-Like @code{list-mark}, but makes a vector instead of a list.
address@hidden deffn
-
address@hidden Instruction list-break
-The opposite of @code{list}: pops a value, which should be a list, and
-pushes its elements on the stack.
address@hidden deffn
-
 @node Miscellaneous Instructions
 @subsubsection Miscellaneous Instructions
 
diff --git a/emacs/gds-faq.txt b/emacs/gds-faq.txt
new file mode 100755
index 0000000..b60a2c9
--- /dev/null
+++ b/emacs/gds-faq.txt
@@ -0,0 +1,225 @@
+
+* Installation
+
+** How do I install guile-debugging?
+
+After unpacking the .tar.gz file, run the usual sequence of commands:
+
+$ ./configure
+$ make
+$ sudo make install
+
+Then you need to make sure that the directory where guile-debugging's
+Scheme files were installed is included in your Guile's load path.
+(The sequence above will usually install guile-debugging under
+/usr/local, and /usr/local is not in Guile's load path by default,
+unless Guile itself was installed under /usr/local.)  You can discover
+your Guile's default load path by typing
+
+$ guile -q -c '(begin (write %load-path) (newline))'
+
+There are two ways to add guile-debugging's installation directory to
+Guile's load path, if it isn't already there.
+
+1. Edit or create the `init.scm' file, which Guile reads on startup,
+   so that it includes a line like this:
+
+   (set! %load-path (cons "/usr/local/share/guile" %load-path))
+
+   but with "/usr/local" replaced by the prefix that you installed
+   guile-debugging under, if not /usr/local.
+
+   The init.scm file must be installed (if it does not already exist
+   there) in one of the directories in Guile's default load-path.
+
+2. Add this line to your .emacs file:
+
+   (setq gds-scheme-directory "/usr/local/share/guile")
+
+   before the `require' or `load' line that loads GDS, but with
+   "/usr/local" replaced by the prefix that you installed
+   guile-debugging under, if not /usr/local.
+
+Finally, if you want guile-debugging's GDS interface to be loaded
+automatically whenever you run Emacs, add this line to your .emacs:
+
+(require 'gds)
+
+* Troubleshooting
+
+** "error in process filter" when starting Emacs (or loading GDS)
+
+This is caused by an internal error in GDS's Scheme code, for which a
+backtrace will have appeared in the gds-debug buffer, so please switch
+to the gds-debug buffer and see what it says there.
+
+The most common cause is a load path problem: Guile cannot find GDS's
+Scheme code because it is not in the known load path.  In this case
+you should see the error message "no code for module" somewhere in the
+backtrace.  If you see this, please try the remedies described in `How
+do I install guile-debugging?' above, then restart Emacs and see if
+the problem has been cured.
+
+If you don't see "no code for module", or if the described remedies
+don't fix the problem, please send the contents of the gds-debug
+buffer to me at <address@hidden>, so I can debug the problem.
+
+If you don't see a backtrace at all in the gds-debug buffer, try the
+next item ...
+
+** "error in process filter" at some other time
+
+This is caused by an internal error somewhere in GDS's Emacs Lisp
+code.  If possible, please
+
+- switch on the `debug-on-error' option (M-x set-variable RET
+  debug-on-error RET t RET)
+
+- do whatever you were doing so that the same error happens again
+
+- send the Emacs Lisp stack trace which pops up to me at
+  <address@hidden>.
+
+If that doesn't work, please just mail me with as much detail as
+possible of what you were doing when the error occurred.
+
+* GDS Features
+
+** How do I inspect variable values?
+
+Type `e' followed by the name of the variable, then <RET>.  This
+works whenever GDS is displaying a stack for an error at at a
+breakpoint.  (You can actually `e' to evaluate any expression in the
+local environment of the selected stack frame; inspecting variables is
+the special case of this where the expression is only a variable name.)
+
+If GDS is displaying the associated source code in the window above or
+below the stack, you can see the values of any variables in the
+highlighted code just by hovering your mouse over them.
+
+** How do I change a variable's value?
+
+Type `e' and then `(set! VARNAME NEWVAL)', where VARNAME is the name
+of the variable you want to set and NEWVAL is an expression which
+Guile can evaluate to get the new value.  This works whenever GDS is
+displaying a stack for an error at at a breakpoint.  The setting will
+take effect in the local environment of the selected stack frame.
+
+** How do I change the expression that Guile is about to evaluate?
+
+Type `t' followed by the expression that you want Guile to evaluate
+instead, then <RET>.
+
+Then type one of the commands that tells Guile to continue execution.
+
+(Tweaking expressions, as described here, is only supported by the
+latest CVS version of Guile.  The GDS stack display tells you when
+tweaking is possible by adding "(tweakable)" to the first line of the
+stack window.)
+
+** How do I return a value from the current stack frame different to what the 
evaluator has calculated?
+
+You have to be at the normal exit of the relevant frame first, so if
+GDS is not already showing you the normally calculated return value,
+type `o' to finish the evaluation of the selected frame.
+
+Then type `t' followed by the value you want to return, and <RET>.
+The value that you type can be any expression, but note that it will
+not be evaluated before being returned; for example if you type `(+ 2
+3)', the return value will be a three-element list, not 5.
+
+Finally type one of the commands that tells Guile to continue
+execution.
+
+(Tweaking return values, as described here, is only supported by the
+latest CVS version of Guile.  The GDS stack display tells you when
+tweaking is possible by adding "(tweakable)" to the first line of the
+stack window.)
+
+** How do I step over a line of code?
+
+Scheme isn't organized by lines, so it doesn't really make sense to
+think of stepping over lines.  Instead please see the next entry on
+stepping over expressions.
+
+** How do I step over an expression?
+
+It depends what you mean by "step over".  If you mean that you want
+Guile to evaluate that expression normally, but then show you its
+return value, type `o', which does exactly that.
+
+If you mean that you want to skip the evaluation of that expression
+(for example because it has side effects that you don't want to
+happen), use `t' to change the expression to something else which
+Guile will evaluate instead.
+
+There has to be a substitute expression so Guile can calculate a value
+to return to the calling frame.  If you know at a particular point
+that the return value is not important, you can type `t #f <RET>' or
+`t 0 <RET>'.
+
+See `How do I change the expression that Guile is about to evaluate?'
+above for more on using `t'.
+
+** How do I move up and down the call stack?
+
+Type `u' to move up and `d' to move down.  "Up" in GDS means to a more
+"inner" frame, and "down" means to a more "outer" frame.
+
+** How do I run until the next breakpoint?
+
+Type `g' (for "go").
+
+** How do I run until the end of the selected stack frame?
+
+Type `o'.
+
+** How do I set a breakpoint?
+
+First identify the code that you want to set the breakpoint in, and
+what kind of breakpoint you want.  To set a breakpoint on entry to a
+top level procedure, move the cursor to anywhere in the procedure
+definition, and make sure that the region/mark is inactive.  To set a
+breakpoint on a particular expression (or sequence of expressions) set
+point and mark so that the region covers the opening parentheses of
+all the target expressions.
+
+Then type ...
+
+  `C-c C-b d' for a `debug' breakpoint, which means that GDS will
+  display the stack when the breakpoint is hit
+
+  `C-c C-b t' for a `trace' breakpoint, which means that the start and
+  end of the relevant procedure or expression(s) will be traced to the
+  *GDS Trace* buffer
+
+  `C-c C-b T' for a `trace-subtree' breakpoint, which means that every
+  evaluation step involved in the evaluation of the relevant procedure
+  or expression(s) will be traced to the *GDS Trace* buffer.
+
+You can also type `C-x <SPC>', which does the same as one of the
+above, depending on the value of `gds-default-breakpoint-type'.
+
+** How do I clear a breakpoint?
+
+Select a region containing the breakpoints that you want to clear, and
+type `C-c C-b <DEL>'.
+
+** How do I trace calls to a particular procedure or evaluations of a 
particular expression?
+
+In GDS this means setting a breakpoint whose type is `trace' or
+`trace-subtree'.  See `How do I set a breakpoint?' above.
+
+* Development
+
+** How can I follow or contribute to guile-debugging's development?
+
+guile-debugging is hosted at http://gna.org, so please see the project
+page there.  Feel free to raise bugs, tasks containing patches or
+feature requests, and so on.  You can also write directly to me by
+email: <address@hidden>.
+
+
+Local Variables:
+mode: outline
+End:
diff --git a/emacs/gds-scheme.el b/emacs/gds-scheme.el
index 54c75a7..bb605c3 100755
--- a/emacs/gds-scheme.el
+++ b/emacs/gds-scheme.el
@@ -206,23 +206,28 @@ Emacs to display an error or trap so that the user can 
debug it."
                               "-q"
                               "--debug"
                               "-c"
-                              code))
-         (client nil))
+                              code)))
     ;; Note that this process can be killed automatically on Emacs
     ;; exit.
     (process-kill-without-query proc)
     ;; Set up a process filter to catch the new client's number.
     (set-process-filter proc
                         (lambda (proc string)
-                          (setq client (string-to-number string))
                           (if (process-buffer proc)
                               (with-current-buffer (process-buffer proc)
-                                (insert string)))))
+                                (insert string)
+                               (or gds-client
+                                   (save-excursion
+                                     (goto-char (point-min))
+                                     (setq gds-client
+                                           (condition-case nil
+                                               (read (current-buffer))
+                                             (error nil)))))))))
     ;; Accept output from the new process until we have its number.
-    (while (not client)
+    (while (not (with-current-buffer (process-buffer proc) gds-client))
       (accept-process-output proc))
     ;; Return the new process's client number.
-    client))
+    (with-current-buffer (process-buffer proc) gds-client)))
 
 ;;;; Evaluating code.
 
diff --git a/emacs/gds-server.el b/emacs/gds-server.el
index d4fe997..9cfcd3a 100644
--- a/emacs/gds-server.el
+++ b/emacs/gds-server.el
@@ -43,25 +43,24 @@
   :group 'gds
   :type '(choice (const :tag "nil" nil) directory))
 
-(defun gds-start-server (procname port-or-path protocol-handler &optional 
bufname)
-  "Start a GDS server process called PROCNAME, listening on TCP port
-or Unix domain socket PORT-OR-PATH.  PROTOCOL-HANDLER should be a
-function that accepts and processes one protocol form.  Optional arg
-BUFNAME specifies the name of the buffer that is used for process
-output; if not specified the buffer name is the same as the process
-name."
-  (with-current-buffer (get-buffer-create (or bufname procname))
+(defun gds-start-server (procname unix-socket-name tcp-port protocol-handler)
+  "Start a GDS server process called PROCNAME, listening on Unix
+domain socket UNIX-SOCKET-NAME and TCP port number TCP-PORT.
+PROTOCOL-HANDLER should be a function that accepts and processes
+one protocol form."
+  (with-current-buffer (get-buffer-create procname)
     (erase-buffer)
     (let* ((code (format "(begin
                             %s
                             (use-modules (ice-9 gds-server))
-                            (run-server %S))"
+                            (run-server %S %S))"
                         (if gds-scheme-directory
                             (concat "(set! %load-path (cons "
                                     (format "%S" gds-scheme-directory)
                                     " %load-path))")
                           "")
-                         port-or-path))
+                         unix-socket-name
+                        tcp-port))
            (process-connection-type nil) ; use a pipe
            (proc (start-process procname
                                 (current-buffer)
diff --git a/emacs/gds-test.el b/emacs/gds-test.el
new file mode 100644
index 0000000..dfd4f6c
--- /dev/null
+++ b/emacs/gds-test.el
@@ -0,0 +1,166 @@
+
+;; Test utility code.
+(defun gds-test-execute-keys (keys &optional keys2)
+  (execute-kbd-macro (apply 'vector (listify-key-sequence keys))))
+
+(defvar gds-test-expecting nil)
+
+(defun gds-test-protocol-hook (form)
+  (message "[protocol: %s]" (car form))
+  (if (eq (car form) gds-test-expecting)
+      (setq gds-test-expecting nil)))
+
+(defun gds-test-expect-protocol (proc &optional timeout)
+  (message "[expect: %s]" proc)
+  (setq gds-test-expecting proc)
+  (while gds-test-expecting
+    (or (accept-process-output gds-debug-server (or timeout 5))
+       (error "Timed out after %ds waiting for %s" (or timeout 5) proc))))
+
+(defun gds-test-check-buffer (name &rest strings)
+  (let ((buf (or (get-buffer name) (error "No %s buffer" name))))
+    (save-excursion
+      (set-buffer buf)
+      (goto-char (point-min))
+      (while strings
+       (search-forward (car strings))
+       (setq strings (cdr strings))))))
+
+(defun TEST (desc)
+  (message "TEST: %s" desc))
+
+;; Make sure we take GDS elisp code from this code tree.
+(setq load-path (cons (concat default-directory "emacs/") load-path))
+
+;; Protect the tests so we can do some cleanups in case of error.
+(unwind-protect
+    (progn
+
+      ;; Visit the tutorial.
+      (find-file "gds-tutorial.txt")
+
+      (TEST "Load up GDS.")
+      (search-forward "(require 'gds)")
+      (setq load-path (cons (concat default-directory "emacs/") load-path))
+      (gds-test-execute-keys "\C-x\C-e")
+
+      ;; Install our testing hook.
+      (add-hook 'gds-protocol-hook 'gds-test-protocol-hook)
+
+      (TEST "Help.")
+      (search-forward "(list-ref")
+      (backward-char 2)
+      (gds-test-execute-keys "\C-hg\C-m")
+      (gds-test-expect-protocol 'eval-results 10)
+      (gds-test-check-buffer "*Guile Help*"
+                            "help list-ref"
+                            "is a primitive procedure in the (guile) module")
+
+      (TEST "Completion.")
+      (re-search-forward "^with-output-to-s")
+      (gds-test-execute-keys "\e\C-i")
+      (beginning-of-line)
+      (or (looking-at "with-output-to-string")
+         (error "Expected completion `with-output-to-string' failed"))
+
+      (TEST "Eval defun.")
+      (search-forward "(display z)")
+      (gds-test-execute-keys "\e\C-x")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+                            "(let ((x 1) (y 2))"
+                            "Arctangent is: 0.46"
+                            "=> 0.46")
+
+      (TEST "Multiple values.")
+      (search-forward "(values 'a ")
+      (gds-test-execute-keys "\e\C-x")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+                            "(values 'a"
+                            "hello world"
+                            "=> a"
+                            "=> b"
+                            "=> c")
+
+      (TEST "Eval region with multiple expressions.")
+      (search-forward "(display \"Arctangent is: \")")
+      (beginning-of-line)
+      (push-mark nil nil t)
+      (forward-line 3)
+      (gds-test-execute-keys "\C-c\C-r")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+                            "(display \"Arctangent is"
+                            "Arctangent is:"
+                            "=> no (or unspecified) value"
+                            "ERROR: Unbound variable: z"
+                            "=> error-in-evaluation"
+                            "Evaluating expression 3"
+                            "=> no (or unspecified) value")
+
+      (TEST "Eval syntactically unbalanced region.")
+      (search-forward "(let ((z (atan x y)))")
+      (beginning-of-line)
+      (push-mark nil nil t)
+      (forward-line 4)
+      (gds-test-execute-keys "\C-c\C-r")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+                            "(let ((z (atan"
+                            "Reading expressions to evaluate"
+                            "ERROR"
+                            "end of file"
+                            "=> error-in-read")
+
+      (TEST "Stepping through an evaluation.")
+      (search-forward "(for-each (lambda (x)")
+      (forward-line 1)
+      (push-mark nil nil t)
+      (forward-line 1)
+      (gds-test-execute-keys "\C-u\e\C-x")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys " ")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "g")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+                            "(for-each (lambda"
+                            "Evaluating in current module"
+                            "3 cubed is 27"
+                            "=> no (or unspecified) value")
+
+      ;; Done.
+      (message "====================================")
+      (message "gds-test.el completed without errors")
+      (message "====================================")
+      
+      )
+
+  (switch-to-buffer "gds-debug")
+  (write-region (point-min) (point-max) "gds-test.debug")
+
+  (switch-to-buffer "*GDS Transcript*")
+  (write-region (point-min) (point-max) "gds-test.transcript")
+
+  )
diff --git a/emacs/gds-test.sh b/emacs/gds-test.sh
new file mode 100755
index 0000000..2f8ddff
--- /dev/null
+++ b/emacs/gds-test.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+GUILE_LOAD_PATH=$(pwd) emacs --batch --no-site-file -q -l gds-test.el < 
gds-test.stdin
diff --git a/emacs/gds-test.stdin b/emacs/gds-test.stdin
new file mode 100644
index 0000000..8b13789
--- /dev/null
+++ b/emacs/gds-test.stdin
@@ -0,0 +1 @@
+
diff --git a/emacs/gds-tutorial.txt b/emacs/gds-tutorial.txt
new file mode 100755
index 0000000..4254803
--- /dev/null
+++ b/emacs/gds-tutorial.txt
@@ -0,0 +1,223 @@
+
+;; Welcome to the GDS tutorial!
+
+;; This tutorial teaches the use of GDS by leading you through a set
+;; of examples where you actually use GDS, in Emacs, along the way.
+;; To get maximum benefit, therefore, you should be reading this
+;; tutorial in Emacs.
+
+;; ** GDS setup
+
+;; The first thing to do, if you haven't already, is to load the GDS
+;; library into Emacs.  The Emacs Lisp expression for this is:
+
+(require 'gds)
+
+;; So, if you don't already have this in your .emacs, either add it
+;; and then restart Emacs, or evaluate it just for this Emacs session
+;; by moving the cursor to just after the closing parenthesis and
+;; typing `C-x C-e'.
+
+;; (Note that if you _have_ already loaded GDS, and you type `C-x C-e'
+;; after this expression, you will see a *Guile Evaluation* window
+;; telling you that the evaluation failed because `require' is
+;; unbound.  Don't worry; this is not a problem, and the rest of the
+;; tutorial should still work just fine.)
+
+;; ** Help
+
+;; GDS makes it easy to access the Guile help system when working on a
+;; Scheme program in Emacs.  For example, suppose that you are writing
+;; code that uses list-ref, and need to remind yourself about
+;; list-ref's arguments ...
+
+(define (penultimate l)
+  (list-ref
+
+;; Just place the cursor on the word "list-ref" and type `C-h g RET'.
+;; Try it now!
+
+;; If GDS is working correctly, a window should have popped up above
+;; or below showing the Guile help for list-ref.
+
+;; You can also do an "apropos" search through Guile's help.  If you
+;; couldn't remember the name list-ref, for example, you could search
+;; for anything matching "list" by typing `C-h C-g' and entering
+;; "list" at the minibuffer prompt.  Try doing this now: you should
+;; see a longish list of Guile definitions whose names include "list".
+;; As usual in Emacs, you can use `M-PageUp' and `M-PageDown' to
+;; conveniently scroll the other window without having to select it.
+
+;; The functions called by `C-h g' and `C-h C-g' are gds-help-symbol
+;; and gds-apropos.  They both look up the symbol or word at point by
+;; default, but that default can be overidden by typing something else
+;; at the minibuffer prompt.
+
+;; ** Completion
+
+;; As you are typing Scheme code, you can ask GDS to complete the
+;; symbol before point for you, by typing `ESC TAB'.  GDS selects
+;; possible completions by matching the text so far against all
+;; definitions in the Guile environment.  (This may be contrasted with
+;; the "dabbrev" completion performed by `M-/', which selects possible
+;; completions from the contents of Emacs buffers.  So, if you are
+;; trying to complete "with-ou", to get "with-output-to-string", for
+;; example, `ESC TAB' will always work, because with-output-to-string
+;; is always defined in Guile's default environment, whereas `M-/'
+;; will only work if one of Emacs's buffers happens to contain the
+;; full name "with-output-to-string".)
+
+;; To illustrate the idea, here are some partial names that you can
+;; try completing.  For each one, move the cursor to the end of the
+;; line and type `ESC TAB' to try to complete it.
+
+list-
+with-ou
+with-output-to-s
+mkst
+
+;; (If you are not familiar with any of the completed definitions,
+;; feel free to use `C-h g' to find out about them!)
+
+;; ** Evaluation
+
+;; GDS provides several ways for you to evaluate Scheme code from
+;; within Emacs.
+
+;; Just like in Emacs Lisp, a single expression in a buffer can be
+;; evaluated using `C-x C-e' or `C-M-x'.  For `C-x C-e', the
+;; expression is that which ends immediately before point (so that it
+;; is useful for evaluating something just after you have typed it).
+;; For `C-M-x', the expression is the "top level defun" around point;
+;; this means the balanced chunk of code around point whose opening
+;; parenthesis is in column 0.
+
+;; Take this code fragment as an example:
+
+(let ((x 1) (y 2))
+  (let ((z (atan x y)))
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+    z))
+
+;; If you move the cursor to the end of the (display z) line and type
+;; `C-x C-e', the code evaluated is just "(display z)", which normally
+;; produces an error, because z is not defined in the usual Guile
+;; environment.  If, however, you type `C-M-x' with the cursor in the
+;; same place, the code evaluated is the whole "(let ((x 1) (y 2))
+;; ...)" kaboodle, because that is the most recent expression before
+;; point that starts in column 0.
+
+;; Try these now.  The Guile Evaluation window should pop up again,
+;; and show you:
+;; - the expression that was evaluated (probably abbreviated)
+;; - the module that it was evaluated in
+;; - anything that the code wrote to its standard output
+;; - the return value(s) of the evaluation.
+;; Following the convention of the Emacs Lisp and Guile manuals,
+;; return values are indicated by the symbol "=>".
+
+;; To see what happens when an expression has multiple return values,
+;; try evaluating this one:
+
+(values 'a (begin (display "hello world\n") 'b) 'c)
+
+;; You can also evaluate a region of a buffer using `C-c C-r'.  If the
+;; code in the region consists of multiple expressions, GDS evaluates
+;; them sequentially.  For example, try selecting the following three
+;; lines and typing `C-c C-r'.
+
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+
+;; If the code in the region evaluated isn't syntactically balanced,
+;; GDS will indicate a read error, for example for this code:
+
+  (let ((z (atan x y)))
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+
+;; Finally, if you want to evaluate something quickly that is not in a
+;; buffer, you can use `C-c C-e' and type the code to evaluate at the
+;; minibuffer prompt.  The results are popped up in the same way as
+;; for code from a buffer.
+
+;; ** Breakpoints
+
+;; Before evaluating Scheme code from an Emacs buffer, you may want to
+;; set some breakpoints in it.  With GDS you can set breakpoints in
+;; Scheme code by typing `C-x SPC'.
+;;
+;; To see how this works, select the second line of the following code
+;; (the `(format ...)' line) and type `C-x SPC'.
+
+(for-each (lambda (x)
+           (format #t "~A cubed is ~A\n" x (* x x x)))
+         (iota 6))
+
+;; The two opening parentheses in that line should now be highlighted
+;; in red, to show that breakpoints have been set at the start of the
+;; `(format ...)' and `(* x x x)' expressions.  Then evaluate the
+;; whole for-each expression by typing `C-M-x' ...
+;;
+;; In the upper half of your Emacs, a buffer appears showing you the
+;; Scheme stack.
+;;
+;; In the lower half, the `(format ...)' expression is highlighted.
+;;
+;; What has happened is that Guile started evaluating the for-each
+;; code, but then hit the breakpoint that you set on the start of the
+;; format expression.  Guile therefore pauses the evaluation at that
+;; point and passes the stack (which encapsulates everything that is
+;; interesting about the state of Guile at that point) to GDS.  You
+;; can then explore the stack and decide how to tell Guile to
+;; continue.
+;;
+;; - If you move your mouse over any of the identifiers in the
+;;   highlighted code, a help echo (or tooltip) will appear to tell
+;;   you that identifier's current value.  (Note though that this only
+;;   works when the stack buffer is selected.  So if you have switched
+;;   to this buffer in order to scroll down and read these lines, you
+;;   will need to switch back to the stack buffer before trying this
+;;   out.)
+;;
+;; - In the stack buffer, the "=>" on the left shows you that the top
+;;   frame is currently selected.  You can move up and down the stack
+;;   by pressing the up and down arrows (or `u' and `d').  As you do
+;;   this, GDS will change the highlight in the lower window to show
+;;   the code that corresponds to the selected stack frame.
+;;
+;; - You can evaluate an arbitrary expression in the local environment
+;;   of the selected stack frame by typing `e' followed by the
+;;   expression.
+;;
+;; - You can show various bits of information about the selected frame
+;;   by typing `I', `A' and `S'.  Feel free to try these now, to see
+;;   what they do.
+;;
+;; You also have control over the continuing evaluation of this code.
+;; Here are some of the things you can do - please try them as you
+;; read.
+;;
+;; - `g' tells Guile to continue execution normally.  In this case
+;;   that means that evaluation will continue until it hits the next
+;;   breakpoint, which is on the `(* x x x)' expression.
+;;
+;; - `SPC' tells Guile to continue until the next significant event in
+;;   the same source file as the selected frame.  A "significant
+;;   event" means either beginning to evaluate an expression in the
+;;   relevant file, or completing such an evaluation, in which case
+;;   GDS tells you the value that it is returning.  Pressing `SPC'
+;;   repeatedly is a nice way to step through all the details of the
+;;   code in a given file, but stepping over calls that involve code
+;;   from other files.
+;;
+;; - `o' tells Guile to continue execution until the selected stack
+;;   frame completes, and then to show its return value.
+
+;; Local Variables:
+;; mode: scheme
+;; End:
diff --git a/emacs/gds.el b/emacs/gds.el
index a9450d0..991ba75 100644
--- a/emacs/gds.el
+++ b/emacs/gds.el
@@ -36,10 +36,11 @@
 ;; The subprocess object for the debug server.
 (defvar gds-debug-server nil)
 
-(defvar gds-socket-type-alist '((tcp . 8333)
-                               (unix . "/tmp/.gds_socket"))
-  "Maps each of the possible socket types that the GDS server can
-listen on to the path that it should bind to for each one.")
+(defvar gds-unix-socket-name (format "/tmp/.gds-socket-%d" (emacs-pid))
+  "Name of the Unix domain socket that GDS will listen on.")
+
+(defvar gds-tcp-port 8333
+  "The TCP port number that GDS will listen on.")
 
 (defun gds-run-debug-server ()
   "Start (or restart, if already running) the GDS debug server process."
@@ -47,10 +48,14 @@ listen on to the path that it should bind to for each one.")
   (if gds-debug-server (gds-kill-debug-server))
   (setq gds-debug-server
         (gds-start-server "gds-debug"
-                         (cdr (assq gds-server-socket-type
-                                    gds-socket-type-alist))
+                         gds-unix-socket-name
+                         gds-tcp-port
                          'gds-debug-protocol))
-  (process-kill-without-query gds-debug-server))
+  (process-kill-without-query gds-debug-server)
+  ;; Add the Unix socket name to the environment, so that Guile
+  ;; clients started from within this Emacs will be able to use it,
+  ;; and thereby ensure that they connect to the GDS in this Emacs.
+  (setenv "GDS_UNIX_SOCKET_NAME" gds-unix-socket-name))
 
 (defun gds-kill-debug-server ()
   "Kill the GDS debug server process."
@@ -137,7 +142,13 @@ listen on to the path that it should bind to for each 
one.")
 
 ;;;; Debugger protocol
 
+(defcustom gds-protocol-hook nil
+  "Hook called on receipt of a protocol form from the GDS client."
+  :type 'hook
+  :group 'gds)
+
 (defun gds-debug-protocol (client form)
+  (run-hook-with-args 'gds-protocol-hook form)
   (or (eq client '*)
       (let ((proc (car form)))
         (cond ((eq proc 'name)
@@ -610,7 +621,7 @@ you would add an element to this alist to transform
   :group 'gds)
 
 (defcustom gds-server-socket-type 'tcp
-  "What kind of socket the GDS server should listen on."
+  "This option is now obsolete and has no effect."
   :group 'gds
   :type '(choice (const :tag "TCP" tcp)
                 (const :tag "Unix" unix)))
diff --git a/guile-readline/Makefile.am b/guile-readline/Makefile.am
index 9df82bc..efdcd75 100644
--- a/guile-readline/Makefile.am
+++ b/guile-readline/Makefile.am
@@ -1,6 +1,6 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##     Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006, 2007, 2008 Free 
Software Foundation, Inc.
+##     Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006, 2007, 2008, 2009 Free 
Software Foundation, Inc.
 ##
 ##   This file is part of guile-readline.
 ##
@@ -19,15 +19,24 @@
 ##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 ##   Floor, Boston, MA 02110-1301 USA
 
-SUBDIRS = ice-9
-
 ## Prevent automake from adding extra -I options
 DEFS = @DEFS@ @EXTRA_DEFS@
+
+if HAVE_READLINE
+
+# `ice-9' subdirectory.
+ice9dir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
+nobase_ice9_DATA = ice-9/readline.scm
+EXTRA_DIST = $(nobase_ice9_DATA)
+
+
 ## Check for headers in $(srcdir)/.., so that #include
 ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're
 ## building.  Also look for Gnulib headers in `lib'.
-INCLUDES = -I. -I.. -I$(srcdir)/..                     \
-          -I$(top_srcdir)/lib -I$(top_builddir)/lib
+AM_CPPFLAGS = -I. -I.. -I$(srcdir)/..                  \
+             -I$(top_srcdir)/lib -I$(top_builddir)/lib
+
+AM_CFLAGS = $(GCC_CFLAGS)
 
 GUILE_SNARF = ../libguile/guile-snarf
 
@@ -35,25 +44,33 @@ lib_LTLIBRARIES = address@hidden@.la
 
 address@hidden@_la_SOURCES = readline.c
 address@hidden@_la_LIBADD =    \
-   ../libguile/libguile.la ../lib/libgnu.la
address@hidden@_la_LDFLAGS = -version-info @LIBGUILEREADLINE_INTERFACE@ 
-export-dynamic -no-undefined
+  $(READLINE_LIBS)                                     \
+  ../libguile/libguile.la ../lib/libgnu.la
+
address@hidden@_la_LDFLAGS =    \
+  -version-info @LIBGUILEREADLINE_INTERFACE@ -export-dynamic   \
+  -no-undefined
 
 
 BUILT_SOURCES = readline.x
 
 pkginclude_HEADERS = readline.h
 
-snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
 SUFFIXES = .x
 .c.x:
        $(GUILE_SNARF) -o $@ $< $(snarfcppopts)
 
-EXTRA_DIST = LIBGUILEREADLINE-VERSION ChangeLog-2008
+EXTRA_DIST += LIBGUILEREADLINE-VERSION ChangeLog-2008
 
-MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+ETAGS_ARGS =                                                   \
+  $(nobase_ice9_DATA)                                          \
+  $(address@hidden@_la_SOURCES)
 
 CLEANFILES = *.x
 
+endif HAVE_READLINE
+
 dist-hook:
        (temp="/tmp/mangle-deps.$$$$"; \
         trap "rm -f $$temp" 0 1 2 15; \
diff --git a/guile-readline/autogen.sh b/guile-readline/autogen.sh
deleted file mode 100755
index 76149ba..0000000
--- a/guile-readline/autogen.sh
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/sh
-
-[ -f readline-activator.scm ] || {
-  echo "autogen.sh: run this command only in the guile-readline directory."
-  exit 1
-}
-
-autoreconf -i --force
diff --git a/guile-readline/configure.ac b/guile-readline/configure.ac
deleted file mode 100644
index f24fc94..0000000
--- a/guile-readline/configure.ac
+++ /dev/null
@@ -1,88 +0,0 @@
-AC_PREREQ(2.50)
-
-dnl Don't use "echo -n", which is not portable (e.g., not available on
-dnl MacOS X).  Instead, use `patsubst' to remove the newline.
-AC_INIT(guile-readline,
-        patsubst(m4_esyscmd(. ../GUILE-VERSION && echo ${GUILE_VERSION}), [
-]),
-       address@hidden)
-
-AC_CONFIG_AUX_DIR([../build-aux])
-AC_CONFIG_SRCDIR(readline.c)
-AM_CONFIG_HEADER([guile-readline-config.h])
-AM_INIT_AUTOMAKE([foreign no-define])
-
-. $srcdir/../GUILE-VERSION
-
-AC_PROG_INSTALL
-AC_PROG_CC
-AM_PROG_CC_STDC
-AC_LIBTOOL_WIN32_DLL
-AC_PROG_LIBTOOL
-
-dnl
-dnl Check for Winsock and other functionality on Win32 (*not* CygWin)
-dnl
-AC_CYGWIN
-AC_MINGW32
-EXTRA_DEFS=""
-if test "$MINGW32" = "yes" ; then
-    if test $enable_shared = yes ; then
-      EXTRA_DEFS="-DSCM_IMPORT"
-    fi
-fi
-AC_SUBST(EXTRA_DEFS)
-
-for termlib in ncurses curses termcap terminfo termlib ; do
-   AC_CHECK_LIB(${termlib}, tgoto,
-                [LIBS="-l${termlib} $LIBS"; break])
-done
-
-AC_LIB_LINKFLAGS(readline)
-AC_CHECK_LIB(readline, readline)
-if test $ac_cv_lib_readline_readline = no; then
-  AC_MSG_WARN([libreadline was not found on your system.])
-fi
-
-AC_CHECK_FUNCS(siginterrupt rl_clear_signals rl_cleanup_after_signal)
-
-dnl Check for modern readline naming
-AC_CHECK_FUNCS(rl_filename_completion_function)
-
-dnl Check for rl_get_keymap.  We only use this for deciding whether to
-dnl install paren matching on the Guile command line (when using
-dnl readline for input), so it's completely optional.
-AC_CHECK_FUNCS(rl_get_keymap)
-
-AC_CACHE_CHECK([for rl_getc_function pointer in readline],
-                ac_cv_var_rl_getc_function,
-                [AC_TRY_LINK([
-#include <stdio.h>
-#include <readline/readline.h>],
-                             [printf ("%ld", (long) rl_getc_function)],
-                             [ac_cv_var_rl_getc_function=yes],
-                             [ac_cv_var_rl_getc_function=no])])
-if test "${ac_cv_var_rl_getc_function}" = "yes"; then
-  AC_DEFINE(HAVE_RL_GETC_FUNCTION, 1,
-    [Define if your readline library has the rl_getc_function variable.])
-fi
-
-if test $ac_cv_lib_readline_readline = yes \
-        -a $ac_cv_var_rl_getc_function = no; then
-  AC_MSG_WARN([*** libreadline is too old on your system.])
-  AC_MSG_WARN([*** You need readline version 2.1 or later.])
-fi
-
-AC_CHECK_FUNCS(strdup)
-
-. $srcdir/LIBGUILEREADLINE-VERSION
-AC_SUBST(LIBGUILEREADLINE_MAJOR)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_CURRENT)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_REVISION)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_AGE)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE)
-
-AC_SUBST(GUILE_EFFECTIVE_VERSION)
-
-AC_CONFIG_FILES(Makefile ice-9/Makefile)
-AC_OUTPUT
diff --git a/guile-readline/ice-9/Makefile.am b/guile-readline/ice-9/Makefile.am
deleted file mode 100644
index ffa767e..0000000
--- a/guile-readline/ice-9/Makefile.am
+++ /dev/null
@@ -1,28 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##     Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free 
Software Foundation, Inc.
-##
-##   This file is part of guile-readline.
-##
-##   guile-readline is free software; you can redistribute it and/or
-##   modify it under the terms of the GNU General Public License as
-##   published by the Free Software Foundation; either version 3, or
-##   (at your option) any later version.
-##
-##   guile-readline is distributed in the hope that it will be useful,
-##   but WITHOUT ANY WARRANTY; without even the implied warranty of
-##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-##   General Public License for more details.
-##
-##   You should have received a copy of the GNU General Public License
-##   along with guile-readline; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-# Guile's `pkgdatadir'.
-guile_pdd = $(datadir)/guile
-
-ice9dir = $(guile_pdd)/$(GUILE_EFFECTIVE_VERSION)/ice-9
-ice9_DATA = readline.scm
-ETAGS_ARGS = $(ice9_DATA)
-EXTRA_DIST = $(ice9_DATA)
diff --git a/guile-readline/readline.c b/guile-readline/readline.c
index 7f86ceb..cbf4051 100644
--- a/guile-readline/readline.c
+++ b/guile-readline/readline.c
@@ -1,6 +1,6 @@
 /* readline.c --- line editing support for Guile */
 
-/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008 Free 
Software Foundation, Inc.
+/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 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 General Public License as published by
@@ -21,9 +21,9 @@
 
 
 
-
-/* Include private, configure generated header (i.e. config.h). */
-#include "guile-readline-config.h"
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
 
 #ifdef HAVE_RL_GETC_FUNCTION
 #include "libguile.h"
diff --git a/lang/elisp/interface.scm b/lang/elisp/interface.scm
index fcd748f..31864cc 100644
--- a/lang/elisp/interface.scm
+++ b/lang/elisp/interface.scm
@@ -20,7 +20,10 @@
 
 (define (eval-elisp x)
   "Evaluate the Elisp expression @var{x}."
-  (eval x the-elisp-module))
+  (save-module-excursion 
+   (lambda ()
+     (set-current-module the-elisp-module)
+     (primitive-eval x))))
 
 (define (translate-elisp x)
   "Translate the Elisp expression @var{x} to equivalent Scheme code."
diff --git a/libguile.h b/libguile.h
index 7b5649b..74674d5 100644
--- a/libguile.h
+++ b/libguile.h
@@ -31,8 +31,12 @@ extern "C" {
 #include "libguile/__scm.h"
 #include "libguile/alist.h"
 #include "libguile/arbiters.h"
+#include "libguile/array-handle.h"
+#include "libguile/array-map.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/boolean.h"
+#include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
@@ -50,6 +54,8 @@ extern "C" {
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/guardians.h"
@@ -78,7 +84,6 @@ extern "C" {
 #include "libguile/properties.h"
 #include "libguile/procs.h"
 #include "libguile/r6rs-ports.h"
-#include "libguile/ramap.h"
 #include "libguile/random.h"
 #include "libguile/read.h"
 #include "libguile/root.h"
@@ -101,7 +106,7 @@ extern "C" {
 #include "libguile/symbols.h"
 #include "libguile/tags.h"
 #include "libguile/throw.h"
-#include "libguile/unif.h"
+#include "libguile/uniform.h"
 #include "libguile/validate.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index f000f83..046ce21 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -105,26 +105,103 @@ guile_LDFLAGS = $(GUILE_CFLAGS)
 
 libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 
-libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
-    bytevectors.c chars.c continuations.c                              \
-    convert.c debug.c deprecation.c                                    \
-    deprecated.c discouraged.c dynwind.c eq.c error.c  \
-    eval.c evalext.c extensions.c feature.c fluids.c fports.c          \
-    futures.c gc.c gc-malloc.c                                         \
-    gdbint.c gettext.c goops.c gsubr.c                                 \
-    guardians.c hash.c hashtab.c hooks.c init.c inline.c               \
-    ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c         \
-    modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c  \
-    print.c procprop.c procs.c properties.c                            \
-    r6rs-ports.c random.c rdelim.c read.c                              \
-    root.c rw.c scmsigs.c script.c simpos.c smob.c sort.c srcprop.c    \
-    stackchk.c stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c \
-    strorder.c strports.c struct.c symbols.c threads.c null-threads.c  \
-    throw.c values.c variable.c vectors.c version.c vports.c weaks.c   \
-    ramap.c unif.c
-
-# vm-related sources
-libguile_la_SOURCES += frames.c instructions.c objcodes.c programs.c vm.c
+libguile_la_SOURCES =                          \
+       alist.c                                 \
+       arbiters.c                              \
+       array-handle.c                          \
+       array-map.c                             \
+       arrays.c                                \
+       async.c                                 \
+       backtrace.c                             \
+       boolean.c                               \
+       bitvectors.c                            \
+       bytevectors.c                           \
+       chars.c                                 \
+       continuations.c                         \
+       debug.c                                 \
+       deprecated.c                            \
+       deprecation.c                           \
+       discouraged.c                           \
+       dynwind.c                               \
+       eq.c                                    \
+       error.c                                 \
+       eval.c                                  \
+       evalext.c                               \
+       extensions.c                            \
+       feature.c                               \
+       fluids.c                                \
+       fports.c                                \
+       frames.c                                \
+       futures.c                               \
+       gc-malloc.c                             \
+       gc.c                                    \
+       gdbint.c                                \
+       gettext.c                               \
+       generalized-arrays.c                    \
+       generalized-vectors.c                   \
+       goops.c                                 \
+       gsubr.c                                 \
+       guardians.c                             \
+       hash.c                                  \
+       hashtab.c                               \
+       hooks.c                                 \
+       init.c                                  \
+       inline.c                                \
+       instructions.c                          \
+       ioext.c                                 \
+       keywords.c                              \
+       lang.c                                  \
+       list.c                                  \
+       load.c                                  \
+       macros.c                                \
+       mallocs.c                               \
+       modules.c                               \
+       null-threads.c                          \
+       numbers.c                               \
+       objcodes.c                              \
+       objects.c                               \
+       objprop.c                               \
+       options.c                               \
+       pairs.c                                 \
+       ports.c                                 \
+       print.c                                 \
+       procprop.c                              \
+       procs.c                                 \
+       programs.c                              \
+       properties.c                            \
+       r6rs-ports.c                            \
+       random.c                                \
+       rdelim.c                                \
+       read.c                                  \
+       root.c                                  \
+       rw.c                                    \
+       scmsigs.c                               \
+       script.c                                \
+       simpos.c                                \
+       smob.c                                  \
+       sort.c                                  \
+       srcprop.c                               \
+       srfi-13.c                               \
+       srfi-14.c                               \
+       srfi-4.c                                \
+       stackchk.c                              \
+       stacks.c                                \
+       stime.c                                 \
+       strings.c                               \
+       strorder.c                              \
+       strports.c                              \
+       struct.c                                \
+       symbols.c                               \
+       threads.c                               \
+       throw.c                                 \
+       uniform.c                               \
+       values.c                                \
+       variable.c                              \
+       vectors.c                               \
+       version.c                               \
+       vm.c                                    \
+       vports.c                                \
+       weaks.c
 
 address@hidden@_la_SOURCES = i18n.c
 address@hidden@_la_CFLAGS =    \
@@ -135,46 +212,194 @@ address@hidden@_la_LDFLAGS =     \
    -module -L$(builddir) -lguile                               \
    -version-info @LIBGUILE_I18N_INTERFACE@
 
-DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x         \
-    bytevectors.x chars.x                                              \
-    continuations.x debug.x deprecation.x deprecated.x discouraged.x   \
-    dynl.x dynwind.x environments.x eq.x error.x eval.x evalext.x      \
-    extensions.x feature.x fluids.x fports.x futures.x gc.x            \
-    gettext.x goops.x gsubr.x guardians.x                              \
-    hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x   \
-    list.x load.x macros.x mallocs.x modules.x numbers.x objects.x     \
-    objprop.x options.x pairs.x ports.x print.x procprop.x procs.x     \
-    properties.x r6rs-ports.x random.x rdelim.x                                
\
-    read.x root.x rw.x scmsigs.x                                       \
-    script.x simpos.x smob.x sort.x srcprop.x stackchk.x stacks.x      \
-    stime.x strings.x srfi-4.x srfi-13.x srfi-14.x strorder.x          \
-    strports.x struct.x symbols.x threads.x throw.x values.x           \
-    variable.x vectors.x version.x vports.x weaks.x ramap.x unif.x
+DOT_X_FILES =                                  \
+       alist.x                                 \
+       arbiters.x                              \
+       array-handle.x                          \
+       array-map.x                             \
+       arrays.x                                \
+       async.x                                 \
+       backtrace.x                             \
+       boolean.x                               \
+       bitvectors.x                            \
+       bytevectors.x                           \
+       chars.x                                 \
+       continuations.x                         \
+       debug.x                                 \
+       deprecated.x                            \
+       deprecation.x                           \
+       discouraged.x                           \
+       dynl.x                                  \
+       dynwind.x                               \
+       eq.x                                    \
+       error.x                                 \
+       eval.x                                  \
+       evalext.x                               \
+       extensions.x                            \
+       feature.x                               \
+       fluids.x                                \
+       fports.x                                \
+       futures.x                               \
+       gc-malloc.x                             \
+       gc.x                                    \
+       gettext.x                               \
+       generalized-arrays.x                    \
+       generalized-vectors.x                   \
+       goops.x                                 \
+       gsubr.x                                 \
+       guardians.x                             \
+       hash.x                                  \
+       hashtab.x                               \
+       hooks.x                                 \
+       i18n.x                                  \
+       init.x                                  \
+       ioext.x                                 \
+       keywords.x                              \
+       lang.x                                  \
+       list.x                                  \
+       load.x                                  \
+       macros.x                                \
+       mallocs.x                               \
+       modules.x                               \
+       numbers.x                               \
+       objects.x                               \
+       objprop.x                               \
+       options.x                               \
+       pairs.x                                 \
+       ports.x                                 \
+       print.x                                 \
+       procprop.x                              \
+       procs.x                                 \
+       properties.x                            \
+       r6rs-ports.x                            \
+       random.x                                \
+       rdelim.x                                \
+       read.x                                  \
+       root.x                                  \
+       rw.x                                    \
+       scmsigs.x                               \
+       script.x                                \
+       simpos.x                                \
+       smob.x                                  \
+       sort.x                                  \
+       srcprop.x                               \
+       srfi-13.x                               \
+       srfi-14.x                               \
+       srfi-4.x                                \
+       stackchk.x                              \
+       stacks.x                                \
+       stime.x                                 \
+       strings.x                               \
+       strorder.x                              \
+       strports.x                              \
+       struct.x                                \
+       symbols.x                               \
+       threads.x                               \
+       throw.x                                 \
+       uniform.x                               \
+       values.x                                \
+       variable.x                              \
+       vectors.x                               \
+       version.x                               \
+       vports.x                                \
+       weaks.x
 
 # vm-related snarfs
 DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x
 
 EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
 
-DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc         \
-    boolean.doc bytevectors.doc chars.doc                              \
-    continuations.doc debug.doc deprecation.doc                                
\
-    deprecated.doc discouraged.doc dynl.doc dynwind.doc                        
\
-    eq.doc error.doc eval.doc evalext.doc              \
-    extensions.doc feature.doc fluids.doc fports.doc futures.doc       \
-    gc.doc goops.doc gsubr.doc                                         \
-    gc-malloc.doc gettext.doc guardians.doc hash.doc hashtab.doc       \
-    hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc                
\
-    list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc   \
-    objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc  \
-    procprop.doc procs.doc properties.doc r6rs-ports.doc               \
-    random.doc rdelim.doc                                              \
-    read.doc root.doc rw.doc scmsigs.doc script.doc simpos.doc         \
-    smob.doc sort.doc srcprop.doc stackchk.doc stacks.doc stime.doc    \
-    strings.doc srfi-4.doc srfi-13.doc srfi-14.doc strorder.doc                
\
-    strports.doc struct.doc symbols.doc threads.doc throw.doc          \
-    values.doc variable.doc vectors.doc version.doc vports.doc         \
-    weaks.doc ramap.doc unif.doc
+DOT_DOC_FILES =                                \
+       alist.doc                               \
+       arbiters.doc                            \
+       array-handle.doc                        \
+       array-map.doc                           \
+       arrays.doc                              \
+       async.doc                               \
+       backtrace.doc                           \
+       boolean.doc                             \
+       bitvectors.doc                          \
+       bytevectors.doc                         \
+       chars.doc                               \
+       continuations.doc                       \
+       debug.doc                               \
+       deprecated.doc                          \
+       deprecation.doc                         \
+       discouraged.doc                         \
+       dynl.doc                                \
+       dynwind.doc                             \
+       eq.doc                                  \
+       error.doc                               \
+       eval.doc                                \
+       evalext.doc                             \
+       extensions.doc                          \
+       feature.doc                             \
+       fluids.doc                              \
+       fports.doc                              \
+       futures.doc                             \
+       gc-malloc.doc                           \
+       gc.doc                                  \
+       gettext.doc                             \
+       generalized-arrays.doc                  \
+       generalized-vectors.doc                 \
+       goops.doc                               \
+       gsubr.doc                               \
+       guardians.doc                           \
+       hash.doc                                \
+       hashtab.doc                             \
+       hooks.doc                               \
+       i18n.doc                                \
+       init.doc                                \
+       ioext.doc                               \
+       keywords.doc                            \
+       lang.doc                                \
+       list.doc                                \
+       load.doc                                \
+       macros.doc                              \
+       mallocs.doc                             \
+       modules.doc                             \
+       numbers.doc                             \
+       objects.doc                             \
+       objprop.doc                             \
+       options.doc                             \
+       pairs.doc                               \
+       ports.doc                               \
+       print.doc                               \
+       procprop.doc                            \
+       procs.doc                               \
+       properties.doc                          \
+       r6rs-ports.doc                          \
+       random.doc                              \
+       rdelim.doc                              \
+       read.doc                                \
+       root.doc                                \
+       rw.doc                                  \
+       scmsigs.doc                             \
+       script.doc                              \
+       simpos.doc                              \
+       smob.doc                                \
+       sort.doc                                \
+       srcprop.doc                             \
+       srfi-13.doc                             \
+       srfi-14.doc                             \
+       srfi-4.doc                              \
+       stackchk.doc                            \
+       stacks.doc                              \
+       stime.doc                               \
+       strings.doc                             \
+       strorder.doc                            \
+       strports.doc                            \
+       struct.doc                              \
+       symbols.doc                             \
+       threads.doc                             \
+       throw.doc                               \
+       uniform.doc                             \
+       values.doc                              \
+       variable.doc                            \
+       vectors.doc                             \
+       version.doc                             \
+       vports.doc                              \
+       weaks.doc
 
 EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
 
@@ -205,10 +430,9 @@ install-exec-hook:
 ## compile, since they are #included.  So instead we list them here.
 ## Perhaps we can deal with them normally once the merge seems to be
 ## working.
-noinst_HEADERS = convert.i.c                                   \
-                 conv-integer.i.c conv-uinteger.i.c            \
+noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c            \
                  eval.i.c ieee-754.h                           \
-                 srfi-4.i.c                                    \
+                 srfi-4.i.c srfi-14.i.c                                \
                  quicksort.i.c                                  \
                  win32-uname.h win32-dirent.h win32-socket.h   \
                 private-gc.h private-options.h
@@ -232,28 +456,119 @@ pkginclude_HEADERS =
 
 # These are headers visible as <libguile/mumble.h>.
 modincludedir = $(includedir)/libguile
-modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h    \
-    boehm-gc.h bytevectors.h                                           \
-    boolean.h chars.h continuations.h convert.h debug.h debug-malloc.h \
-    deprecation.h deprecated.h discouraged.h dynl.h dynwind.h          \
-    eq.h error.h eval.h evalext.h extensions.h         \
-    feature.h filesys.h fluids.h fports.h futures.h gc.h               \
-    gdb_interface.h gdbint.h gettext.h goops.h                         \
-    gsubr.h guardians.h hash.h                                         \
-    hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h         \
-    keywords.h lang.h list.h load.h macros.h mallocs.h modules.h       \
-    net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h   \
-    posix.h r6rs-ports.h regex-posix.h print.h                         \
-    procprop.h procs.h properties.h                                    \
-    random.h ramap.h rdelim.h read.h root.h rw.h scmsigs.h validate.h  \
-    script.h simpos.h smob.h snarf.h socket.h sort.h srcprop.h         \
-    stackchk.h stacks.h stime.h strings.h srfi-4.h srfi-13.h srfi-14.h \
-    strorder.h strports.h struct.h symbols.h tags.h threads.h          \
-    pthread-threads.h null-threads.h throw.h unif.h values.h           \
-    variable.h vectors.h vports.h weaks.h
-
-modinclude_HEADERS += vm-bootstrap.h frames.h instructions.h objcodes.h        
\
-    programs.h vm.h vm-engine.h vm-expand.h
+modinclude_HEADERS =                           \
+       __scm.h                                 \
+       alist.h                                 \
+       arbiters.h                              \
+       array-handle.h                          \
+       array-map.h                             \
+       arrays.h                                \
+       async.h                                 \
+       backtrace.h                             \
+       boolean.h                               \
+       bitvectors.h                            \
+       bytevectors.h                           \
+       chars.h                                 \
+       continuations.h                         \
+       debug-malloc.h                          \
+       debug.h                                 \
+       deprecated.h                            \
+       deprecation.h                           \
+       discouraged.h                           \
+       dynl.h                                  \
+       dynwind.h                               \
+       eq.h                                    \
+       error.h                                 \
+       eval.h                                  \
+       evalext.h                               \
+       extensions.h                            \
+       feature.h                               \
+       filesys.h                               \
+       fluids.h                                \
+       fports.h                                \
+       frames.h                                \
+       futures.h                               \
+       gc.h                                    \
+       gdb_interface.h                         \
+       gdbint.h                                \
+       gettext.h                               \
+       generalized-arrays.h                    \
+       generalized-vectors.h                   \
+       goops.h                                 \
+       gsubr.h                                 \
+       guardians.h                             \
+       hash.h                                  \
+       hashtab.h                               \
+       hooks.h                                 \
+       i18n.h                                  \
+       init.h                                  \
+       inline.h                                \
+       instructions.h                          \
+       ioext.h                                 \
+       iselect.h                               \
+       keywords.h                              \
+       lang.h                                  \
+       list.h                                  \
+       load.h                                  \
+       macros.h                                \
+       mallocs.h                               \
+       modules.h                               \
+       net_db.h                                \
+       null-threads.h                          \
+       numbers.h                               \
+       objcodes.h                              \
+       objects.h                               \
+       objprop.h                               \
+       options.h                               \
+       pairs.h                                 \
+       ports.h                                 \
+       posix.h                                 \
+       print.h                                 \
+       procprop.h                              \
+       procs.h                                 \
+       programs.h                              \
+       properties.h                            \
+       pthread-threads.h                       \
+       r6rs-ports.h                            \
+       random.h                                \
+       rdelim.h                                \
+       read.h                                  \
+       regex-posix.h                           \
+       root.h                                  \
+       rw.h                                    \
+       scmsigs.h                               \
+       script.h                                \
+       simpos.h                                \
+       smob.h                                  \
+       snarf.h                                 \
+       socket.h                                \
+       sort.h                                  \
+       srcprop.h                               \
+       srfi-13.h                               \
+       srfi-14.h                               \
+       srfi-4.h                                \
+       stackchk.h                              \
+       stacks.h                                \
+       stime.h                                 \
+       strings.h                               \
+       strorder.h                              \
+       strports.h                              \
+       struct.h                                \
+       symbols.h                               \
+       tags.h                                  \
+       threads.h                               \
+       throw.h                                 \
+       validate.h                              \
+       uniform.h                               \
+       values.h                                \
+       variable.h                              \
+       vectors.h                               \
+       vm-bootstrap.h                          \
+       vm-engine.h                             \
+       vm-expand.h                             \
+       vm.h                                    \
+       vports.h                                \
+       weaks.h
 
 nodist_modinclude_HEADERS = version.h scmconfig.h
 
@@ -268,7 +583,7 @@ EXTRA_DIST = ChangeLog-scm ChangeLog-threads                
\
     cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c                   \
     cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk                  \
     c-tokenize.lex version.h.in                                                
\
-    scmconfig.h.top libgettext.h libguile.map
+    scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map
 #    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
 #    guile-procedures.txt guile.texi
 
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 29b371d..791150d 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -423,19 +423,28 @@
     typedef struct {
       ucontext_t ctx;
       int fresh;
-    } jmp_buf;
-#   define setjmp(JB)                                  \
+    } scm_i_jmp_buf;
+#   define SCM_I_SETJMP(JB)                            \
       ( (JB).fresh = 1,                                        \
         getcontext (&((JB).ctx)),                      \
         ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
-#   define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
-    void scm_ia64_longjmp (jmp_buf *, int);
+#   define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
+    void scm_ia64_longjmp (scm_i_jmp_buf *, int);
 #  else                        /* ndef __ia64__ */
 #   include <setjmp.h>
 #  endif                       /* ndef __ia64__ */
 # endif                                /* ndef _CRAY1 */
 #endif                         /* ndef vms */
 
+/* For any platform where SCM_I_SETJMP hasn't been defined in some
+   special way above, map SCM_I_SETJMP, SCM_I_LONGJMP and
+   scm_i_jmp_buf to setjmp, longjmp and jmp_buf. */
+#ifndef SCM_I_SETJMP
+#define scm_i_jmp_buf jmp_buf
+#define SCM_I_SETJMP setjmp
+#define SCM_I_LONGJMP longjmp
+#endif
+
 /* James Clark came up with this neat one instruction fix for
  * continuations on the SPARC.  It flushes the register windows so
  * that all the state of the process is contained in the stack.
@@ -556,6 +565,13 @@ SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
   return (SCM_UNPACK (gf)                                      \
          ? scm_call_generic_1 ((gf), (a1))                     \
          : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED))
+
+/* This form is for dispatching a subroutine.  */
+#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos)                         \
+  return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr)))                      \
+         ? scm_call_generic_1 ((*SCM_SUBR_GENERIC (subr)), (a1))       \
+         : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), 
SCM_UNSPECIFIED))
+
 #define SCM_GASSERT1(cond, gf, a1, pos, subr)          \
   if (SCM_UNLIKELY (!(cond)))                  \
     SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 627c51e..8a9a211 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -172,7 +172,7 @@
 
 /* Major and minor versions must be single characters. */
 #define SCM_OBJCODE_MAJOR_VERSION 0
-#define SCM_OBJCODE_MINOR_VERSION B
+#define SCM_OBJCODE_MINOR_VERSION D
 #define SCM_OBJCODE_MAJOR_VERSION_STRING        \
   SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
 #define SCM_OBJCODE_MINOR_VERSION_STRING        \
diff --git a/libguile/array-handle.c b/libguile/array-handle.c
new file mode 100644
index 0000000..cd5a466
--- /dev/null
+++ b/libguile/array-handle.c
@@ -0,0 +1,162 @@
+/* Copyright (C) 1995,1996,1997,1998,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 "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+
+
+SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
+
+
+#define ARRAY_IMPLS_N_STATIC_ALLOC 7
+static scm_t_array_implementation array_impls[ARRAY_IMPLS_N_STATIC_ALLOC];
+static int num_array_impls_registered = 0;
+
+
+void
+scm_i_register_array_implementation (scm_t_array_implementation *impl)
+{
+  if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC)
+    /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */
+    abort ();
+  else
+    array_impls[num_array_impls_registered++] = *impl;
+}
+
+scm_t_array_implementation*
+scm_i_array_implementation_for_obj (SCM obj)
+{
+  int i;
+  for (i = 0; i < num_array_impls_registered; i++)
+    if (SCM_NIMP (obj)
+        && (SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag)
+      return &array_impls[i];
+  return NULL;
+}
+
+void
+scm_array_get_handle (SCM array, scm_t_array_handle *h)
+{
+  scm_t_array_implementation *impl = scm_i_array_implementation_for_obj 
(array);
+  if (!impl)
+    scm_wrong_type_arg_msg (NULL, 0, array, "array");
+  h->array = array;
+  h->impl = impl;
+  h->base = 0;
+  h->ndims = 0;
+  h->dims = NULL;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
+                                                   something... */
+  h->elements = NULL;
+  h->writable_elements = NULL;
+  h->impl->get_handle (array, h);
+}
+
+ssize_t
+scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
+{
+  scm_t_array_dim *s = scm_array_handle_dims (h);
+  ssize_t pos = 0, i;
+  size_t k = scm_array_handle_rank (h);
+  
+  while (k > 0 && scm_is_pair (indices))
+    {
+      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
+      pos += (i - s->lbnd) * s->inc;
+      k--;
+      s++;
+      indices = SCM_CDR (indices);
+    }
+  if (k > 0 || !scm_is_null (indices))
+    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
+                   scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
+  return pos;
+}
+
+SCM
+scm_array_handle_element_type (scm_t_array_handle *h)
+{
+  if (h->element_type < 0 || h->element_type > SCM_ARRAY_ELEMENT_TYPE_LAST)
+    abort (); /* guile programming error */
+  return scm_i_array_element_types[h->element_type];
+}
+
+void
+scm_array_handle_release (scm_t_array_handle *h)
+{
+  /* Nothing to do here until arrays need to be reserved for real.
+   */
+}
+
+const SCM *
+scm_array_handle_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((const SCM*)h->elements) + h->base;
+}
+
+SCM *
+scm_array_handle_writable_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((SCM*)h->elements) + h->base;
+}
+
+void
+scm_init_array_handle (void)
+{
+#define DEFINE_ARRAY_TYPE(tag, TAG)                             \
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG]   \
+    = (scm_permanent_object (scm_from_locale_symbol (#tag)))
+  
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_SCM] = SCM_BOOL_T;
+  DEFINE_ARRAY_TYPE (a, CHAR);
+  DEFINE_ARRAY_TYPE (b, BIT);
+  DEFINE_ARRAY_TYPE (vu8, VU8);
+  DEFINE_ARRAY_TYPE (u8, U8);
+  DEFINE_ARRAY_TYPE (s8, S8);
+  DEFINE_ARRAY_TYPE (u16, U16);
+  DEFINE_ARRAY_TYPE (s16, S16);
+  DEFINE_ARRAY_TYPE (u32, U32);
+  DEFINE_ARRAY_TYPE (s32, S32);
+  DEFINE_ARRAY_TYPE (u64, U64);
+  DEFINE_ARRAY_TYPE (s64, S64);
+  DEFINE_ARRAY_TYPE (f32, F32);
+  DEFINE_ARRAY_TYPE (f64, F64);
+  DEFINE_ARRAY_TYPE (c32, C32);
+  DEFINE_ARRAY_TYPE (c64, C64);
+
+#include "libguile/array-handle.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/array-handle.h b/libguile/array-handle.h
new file mode 100644
index 0000000..caf9cef
--- /dev/null
+++ b/libguile/array-handle.h
@@ -0,0 +1,129 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_HANDLE_H
+#define SCM_ARRAY_HANDLE_H
+
+/* Copyright (C) 1995,1996,1997,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
+ * 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
+ */
+
+
+
+#include "libguile/__scm.h"
+
+
+
+struct scm_t_array_handle;
+
+typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, size_t);
+typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, size_t, SCM);
+
+typedef struct
+{
+  scm_t_bits tag;
+  scm_t_bits mask;
+  scm_i_t_array_ref vref;
+  scm_i_t_array_set vset;
+  void (*get_handle)(SCM, struct scm_t_array_handle*);
+} scm_t_array_implementation;
+  
+#define SCM_ARRAY_IMPLEMENTATION(tag_,mask_,vref_,vset_,handle_) \
+  SCM_SNARF_INIT ({                                                     \
+      scm_t_array_implementation impl;                                  \
+      impl.tag = tag_; impl.mask = mask_;                               \
+      impl.vref = vref_; impl.vset = vset_;                             \
+      impl.get_handle = handle_;                                        \
+      scm_i_register_array_implementation (&impl);                      \
+  })
+  
+
+SCM_INTERNAL void scm_i_register_array_implementation 
(scm_t_array_implementation *impl);
+SCM_INTERNAL scm_t_array_implementation* scm_i_array_implementation_for_obj 
(SCM obj);
+
+
+
+
+typedef struct scm_t_array_dim
+{
+  ssize_t lbnd;
+  ssize_t ubnd;
+  ssize_t inc;
+} scm_t_array_dim;
+
+typedef enum {    
+  SCM_ARRAY_ELEMENT_TYPE_SCM = 0, /* SCM values */
+  SCM_ARRAY_ELEMENT_TYPE_CHAR = 1, /* characters */
+  SCM_ARRAY_ELEMENT_TYPE_BIT = 2, /* packed numeric values */
+  SCM_ARRAY_ELEMENT_TYPE_VU8 = 3,
+  SCM_ARRAY_ELEMENT_TYPE_U8 = 4,
+  SCM_ARRAY_ELEMENT_TYPE_S8 = 5,
+  SCM_ARRAY_ELEMENT_TYPE_U16 = 6,
+  SCM_ARRAY_ELEMENT_TYPE_S16 = 7,
+  SCM_ARRAY_ELEMENT_TYPE_U32 = 8,
+  SCM_ARRAY_ELEMENT_TYPE_S32 = 9,
+  SCM_ARRAY_ELEMENT_TYPE_U64 = 10,
+  SCM_ARRAY_ELEMENT_TYPE_S64 = 11,
+  SCM_ARRAY_ELEMENT_TYPE_F32 = 12,
+  SCM_ARRAY_ELEMENT_TYPE_F64 = 13,
+  SCM_ARRAY_ELEMENT_TYPE_C32 = 14,
+  SCM_ARRAY_ELEMENT_TYPE_C64 = 15,
+  SCM_ARRAY_ELEMENT_TYPE_LAST = 15,
+} scm_t_array_element_type;
+
+SCM_INTERNAL SCM scm_i_array_element_types[];
+
+
+typedef struct scm_t_array_handle {
+  SCM array;
+  scm_t_array_implementation *impl;
+  /* `Base' is an offset into elements or writable_elements, corresponding to
+     the first element in the array. It would be nicer just to adjust the
+     elements/writable_elements pointer, but we can't because that element 
might
+     not even be byte-addressable, as is the case with bitvectors. A nicer
+     solution would be, well, nice.
+   */
+  size_t base;
+  size_t ndims; /* ndims == the rank of the array */
+  scm_t_array_dim *dims;
+  scm_t_array_dim dim0;
+  scm_t_array_element_type element_type;
+  const void *elements;
+  void *writable_elements;
+} scm_t_array_handle;
+
+#define scm_array_handle_rank(h) ((h)->ndims)
+#define scm_array_handle_dims(h) ((h)->dims)
+
+SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
+SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
+SCM_API SCM scm_array_handle_element_type (scm_t_array_handle *h);
+SCM_API void scm_array_handle_release (scm_t_array_handle *h);
+SCM_API const SCM* scm_array_handle_elements (scm_t_array_handle *h);
+SCM_API SCM* scm_array_handle_writable_elements (scm_t_array_handle *h);
+
+/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
+
+SCM_INTERNAL void scm_init_array_handle (void);
+
+
+#endif  /* SCM_ARRAY_HANDLE_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/ramap.c b/libguile/array-map.c
similarity index 98%
rename from libguile/ramap.c
rename to libguile/array-map.c
index e141c18..fb9ceea 100644
--- a/libguile/ramap.c
+++ b/libguile/array-map.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008 Free Software 
Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001,2004,2005, 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
@@ -17,10 +17,6 @@
  */
 
 
-/*
-  HWN:FIXME::
-  Someone should rename this to arraymap.c; that would reflect the
-  contents better.  */
 
 
 
@@ -31,7 +27,7 @@
 
 #include "libguile/_scm.h"
 #include "libguile/strings.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/smob.h"
 #include "libguile/chars.h"
 #include "libguile/eq.h"
@@ -39,11 +35,14 @@
 #include "libguile/feature.h"
 #include "libguile/root.h"
 #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"
 
 #include "libguile/validate.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 
 
 typedef struct
@@ -223,7 +222,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
       if (!SCM_I_ARRAYP (vra0))
        {
          size_t length = scm_c_generalized_vector_length (vra0);
-         vra1 = scm_i_make_ra (1, 0);
+         vra1 = scm_i_make_array (1);
          SCM_I_ARRAY_BASE (vra1) = 0;
          SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
          SCM_I_ARRAY_DIMS (vra1)->ubnd = length - 1;
@@ -236,7 +235,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
       for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
        {
          ra1 = SCM_CAR (z);
-         vra1 = scm_i_make_ra (1, 0);
+         vra1 = scm_i_make_array (1);
          SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
          SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
          if (!SCM_I_ARRAYP (ra1))
@@ -259,7 +258,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
       return (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra));
     case 1:
     gencase:                   /* Have to loop over all dimensions. */
-    vra0 = scm_i_make_ra (1, 0);
+      vra0 = scm_i_make_array (1);
     if (SCM_I_ARRAYP (ra0))
       {
        kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
@@ -294,7 +293,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, 
const char *what)
     for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
       {
        ra1 = SCM_CAR (z);
-       vra1 = scm_i_make_ra (1, 0);
+       vra1 = scm_i_make_array (1);
        SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
        SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
        if (SCM_I_ARRAYP (ra1))
@@ -1222,13 +1221,13 @@ init_raprocs (ra_iproc *subra)
 
 
 void
-scm_init_ramap ()
+scm_init_array_map (void)
 {
   init_raprocs (ra_rpsubrs);
   init_raprocs (ra_asubrs);
   scm_c_define_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p);
   scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_raequal;
-#include "libguile/ramap.x"
+#include "libguile/array-map.x"
   scm_add_feature (s_scm_array_for_each);
 }
 
diff --git a/libguile/ramap.h b/libguile/array-map.h
similarity index 90%
rename from libguile/ramap.h
rename to libguile/array-map.h
index d6cb191..a198099 100644
--- a/libguile/ramap.h
+++ b/libguile/array-map.h
@@ -1,9 +1,9 @@
 /* classes: h_files */
 
-#ifndef SCM_RAMAP_H
-#define SCM_RAMAP_H
+#ifndef SCM_ARRAY_MAP_H
+#define SCM_ARRAY_MAP_H
 
-/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000, 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
@@ -48,9 +48,9 @@ SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra);
 SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc);
 SCM_API SCM scm_raequal (SCM ra0, SCM ra1);
 SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1);
-SCM_INTERNAL void scm_init_ramap (void);
+SCM_INTERNAL void scm_init_array_map (void);
 
-#endif  /* SCM_RAMAP_H */
+#endif  /* SCM_ARRAY_MAP_H */
 
 /*
   Local Variables:
diff --git a/libguile/arrays.c b/libguile/arrays.c
new file mode 100644
index 0000000..2be9ec3
--- /dev/null
+++ b/libguile/arrays.c
@@ -0,0 +1,1156 @@
+/* Copyright (C) 1995,1996,1997,1998,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 "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/eq.h"
+#include "libguile/chars.h"
+#include "libguile/eval.h"
+#include "libguile/fports.h"
+#include "libguile/smob.h"
+#include "libguile/feature.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/srfi-13.h"
+#include "libguile/srfi-4.h"
+#include "libguile/vectors.h"
+#include "libguile/bitvectors.h"
+#include "libguile/bytevectors.h"
+#include "libguile/list.h"
+#include "libguile/dynwind.h"
+#include "libguile/read.h"
+
+#include "libguile/validate.h"
+#include "libguile/arrays.h"
+#include "libguile/array-map.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/uniform.h"
+
+
+scm_t_bits scm_i_tc16_array;
+#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | 
SCM_I_ARRAY_FLAG_CONTIGUOUS))
+#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
+  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~SCM_I_ARRAY_FLAG_CONTIGUOUS))
+
+
+SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
+           (SCM ra),
+           "Return the root vector of a shared array.")
+#define FUNC_NAME s_scm_shared_array_root
+{
+  if (SCM_I_ARRAYP (ra))
+    return SCM_I_ARRAY_V (ra);
+  else if (scm_is_generalized_vector (ra))
+    return ra;
+  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
+           (SCM ra),
+           "Return the root vector index of the first element in the array.")
+#define FUNC_NAME s_scm_shared_array_offset
+{
+  scm_t_array_handle handle;
+  SCM res;
+
+  scm_array_get_handle (ra, &handle);
+  res = scm_from_size_t (handle.base);
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, 
+           (SCM ra),
+           "For each dimension, return the distance between elements in the 
root vector.")
+#define FUNC_NAME s_scm_shared_array_increments
+{
+  scm_t_array_handle handle;
+  SCM res = SCM_EOL;
+  size_t k;
+  scm_t_array_dim *s;
+
+  scm_array_get_handle (ra, &handle);
+  k = scm_array_handle_rank (&handle);
+  s = scm_array_handle_dims (&handle);
+  while (k--)
+    res = scm_cons (scm_from_ssize_t (s[k].inc), res);
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+SCM 
+scm_i_make_array (int ndim)
+{
+  SCM ra;
+  SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_i_tc16_array,
+              scm_gc_malloc ((sizeof (scm_i_t_array) +
+                             ndim * sizeof (scm_t_array_dim)),
+                            "array"));
+  SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
+  return ra;
+}
+
+static char s_bad_spec[] = "Bad scm_array dimension";
+
+
+/* Increments will still need to be set. */
+
+static SCM 
+scm_i_shap2ra (SCM args)
+{
+  scm_t_array_dim *s;
+  SCM ra, spec, sp;
+  int ndim = scm_ilength (args);
+  if (ndim < 0)
+    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+
+  ra = scm_i_make_array (ndim);
+  SCM_I_ARRAY_BASE (ra) = 0;
+  s = SCM_I_ARRAY_DIMS (ra);
+  for (; !scm_is_null (args); s++, args = SCM_CDR (args))
+    {
+      spec = SCM_CAR (args);
+      if (scm_is_integer (spec))
+       {
+         if (scm_to_long (spec) < 0)
+           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+         s->lbnd = 0;
+         s->ubnd = scm_to_long (spec) - 1;
+         s->inc = 1;
+       }
+      else
+       {
+         if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
+           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+         s->lbnd = scm_to_long (SCM_CAR (spec));
+         sp = SCM_CDR (spec);
+         if (!scm_is_pair (sp) 
+             || !scm_is_integer (SCM_CAR (sp))
+             || !scm_is_null (SCM_CDR (sp)))
+           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
+         s->ubnd = scm_to_long (SCM_CAR (sp));
+         s->inc = 1;
+       }
+    }
+  return ra;
+}
+
+SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
+           (SCM type, SCM fill, SCM bounds),
+           "Create and return an array of type @var{type}.")
+#define FUNC_NAME s_scm_make_typed_array
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  SCM ra;
+  
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+
+  if (scm_is_eq (fill, SCM_UNSPECIFIED))
+    fill = SCM_UNDEFINED;
+
+  SCM_I_ARRAY_V (ra) =
+    scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM
+scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
+                                 size_t byte_len)
+#define FUNC_NAME "scm_from_contiguous_typed_array"
+{
+  size_t k, rlen = 1;
+  scm_t_array_dim *s;
+  SCM ra;
+  scm_t_array_handle h;
+  void *base;
+  size_t sz;
+  
+  ra = scm_i_shap2ra (bounds);
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+  s = SCM_I_ARRAY_DIMS (ra);
+  k = SCM_I_ARRAY_NDIM (ra);
+
+  while (k--)
+    {
+      s[k].inc = rlen;
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
+      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
+    }
+  SCM_I_ARRAY_V (ra) =
+    scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED);
+
+
+  scm_array_get_handle (ra, &h);
+  base = scm_array_handle_uniform_writable_elements (&h);
+  sz = scm_array_handle_uniform_element_size (&h);
+  scm_array_handle_release (&h);
+
+  if (byte_len % sz)
+    SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL);
+  if (byte_len / sz != rlen)
+    SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
+
+  memcpy (base, bytes, byte_len);
+
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+      return SCM_I_ARRAY_V (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
+           (SCM fill, SCM bounds),
+           "Create and return an array.")
+#define FUNC_NAME s_scm_make_array
+{
+  return scm_make_typed_array (SCM_BOOL_T, fill, bounds);
+}
+#undef FUNC_NAME
+
+static void 
+scm_i_ra_set_contp (SCM ra)
+{
+  size_t k = SCM_I_ARRAY_NDIM (ra);
+  if (k)
+    {
+      long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
+      while (k--)
+       {
+         if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
+           {
+             SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
+             return;
+           }
+         inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd 
+                 - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
+       }
+    }
+  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
+}
+
+
+SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
+           (SCM oldra, SCM mapfunc, SCM dims),
+           "@code{make-shared-array} can be used to create shared subarrays of 
other\n"
+           "arrays.  The @var{mapper} is a function that translates 
coordinates in\n"
+           "the new array into coordinates in the old array.  A @var{mapper} 
must be\n"
+           "linear, and its range must stay within the bounds of the old 
array, but\n"
+           "it can be otherwise arbitrary.  A simple example:\n"
+           "@lisp\n"
+           "(define fred (make-array #f 8 8))\n"
+           "(define freds-diagonal\n"
+           "  (make-shared-array fred (lambda (i) (list i i)) 8))\n"
+           "(array-set! freds-diagonal 'foo 3)\n"
+           "(array-ref fred 3 3) @result{} foo\n"
+           "(define freds-center\n"
+           "  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 
2))\n"
+           "(array-ref freds-center 0 0) @result{} foo\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_make_shared_array
+{
+  scm_t_array_handle old_handle;
+  SCM ra;
+  SCM inds, indptr;
+  SCM imap;
+  size_t k;
+  ssize_t i;
+  long old_base, old_min, new_min, old_max, new_max;
+  scm_t_array_dim *s;
+
+  SCM_VALIDATE_REST_ARGUMENT (dims);
+  SCM_VALIDATE_PROC (2, mapfunc);
+  ra = scm_i_shap2ra (dims);
+
+  scm_array_get_handle (oldra, &old_handle);
+
+  if (SCM_I_ARRAYP (oldra))
+    {
+      SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
+      old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
+      s = scm_array_handle_dims (&old_handle);
+      k = scm_array_handle_rank (&old_handle);
+      while (k--)
+       {
+         if (s[k].inc > 0)
+           old_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+         else
+           old_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+       }
+    }
+  else
+    {
+      SCM_I_ARRAY_V (ra) = oldra;
+      old_base = old_min = 0;
+      old_max = scm_c_generalized_vector_length (oldra) - 1;
+    }
+
+  inds = SCM_EOL;
+  s = SCM_I_ARRAY_DIMS (ra);
+  for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
+    {
+      inds = scm_cons (scm_from_long (s[k].lbnd), inds);
+      if (s[k].ubnd < s[k].lbnd)
+       {
+         if (1 == SCM_I_ARRAY_NDIM (ra))
+           ra = scm_make_generalized_vector (scm_array_type (ra),
+                                              SCM_INUM0, SCM_UNDEFINED);
+         else
+           SCM_I_ARRAY_V (ra) =
+              scm_make_generalized_vector (scm_array_type (ra),
+                                           SCM_INUM0, SCM_UNDEFINED);
+         scm_array_handle_release (&old_handle);
+         return ra;
+       }
+    }
+
+  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
+  i = scm_array_handle_pos (&old_handle, imap);
+  SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
+  indptr = inds;
+  k = SCM_I_ARRAY_NDIM (ra);
+  while (k--)
+    {
+      if (s[k].ubnd > s[k].lbnd)
+       {
+         SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
+         imap = scm_apply_0 (mapfunc, scm_reverse (inds));
+         s[k].inc = scm_array_handle_pos (&old_handle, imap) - i;
+         i += s[k].inc;
+         if (s[k].inc > 0)
+           new_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+         else
+           new_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
+       }
+      else
+       s[k].inc = new_max - new_min + 1;       /* contiguous by default */
+      indptr = SCM_CDR (indptr);
+    }
+
+  scm_array_handle_release (&old_handle);
+
+  if (old_min > new_min || old_max < new_max)
+    SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
+  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
+    {
+      SCM v = SCM_I_ARRAY_V (ra);
+      size_t length = scm_c_generalized_vector_length (v);
+      if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
+       return v;
+      if (s->ubnd < s->lbnd)
+       return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0,
+                                            SCM_UNDEFINED);
+    }
+  scm_i_ra_set_contp (ra);
+  return ra;
+}
+#undef FUNC_NAME
+
+
+/* args are RA . DIMS */
+SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
+           (SCM ra, SCM args),
+           "Return an array sharing contents with @var{array}, but with\n"
+           "dimensions arranged in a different order.  There must be one\n"
+           "@var{dim} argument for each dimension of @var{array}.\n"
+           "@var{dim0}, @var{dim1}, @dots{} should be integers between 0\n"
+           "and the rank of the array to be returned.  Each integer in that\n"
+           "range must appear at least once in the argument list.\n"
+           "\n"
+           "The values of @var{dim0}, @var{dim1}, @dots{} correspond to\n"
+           "dimensions in the array to be returned, their positions in the\n"
+           "argument list to dimensions of @var{array}.  Several @var{dim}s\n"
+           "may have the same value, in which case the returned array will\n"
+           "have smaller rank than @var{array}.\n"
+           "\n"
+           "@lisp\n"
+           "(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n"
+           "(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)\n"
+           "(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) 
@result{}\n"
+           "                #2((a 4) (b 5) (c 6))\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_transpose_array
+{
+  SCM res, vargs;
+  scm_t_array_dim *s, *r;
+  int ndim, i, k;
+
+  SCM_VALIDATE_REST_ARGUMENT (args);
+  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
+
+  if (scm_is_generalized_vector (ra))
+    {
+      /* Make sure that we are called with a single zero as
+        arguments. 
+      */
+      if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
+       SCM_WRONG_NUM_ARGS ();
+      SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
+      SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
+      return ra;
+    }
+
+  if (SCM_I_ARRAYP (ra))
+    {
+      vargs = scm_vector (args);
+      if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
+       SCM_WRONG_NUM_ARGS ();
+      ndim = 0;
+      for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
+       {
+         i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
+                                    0, SCM_I_ARRAY_NDIM(ra));
+         if (ndim < i)
+           ndim = i;
+       }
+      ndim++;
+      res = scm_i_make_array (ndim);
+      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
+      SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
+      for (k = ndim; k--;)
+       {
+         SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
+         SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
+       }
+      for (k = SCM_I_ARRAY_NDIM (ra); k--;)
+       {
+         i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
+         s = &(SCM_I_ARRAY_DIMS (ra)[k]);
+         r = &(SCM_I_ARRAY_DIMS (res)[i]);
+         if (r->ubnd < r->lbnd)
+           {
+             r->lbnd = s->lbnd;
+             r->ubnd = s->ubnd;
+             r->inc = s->inc;
+             ndim--;
+           }
+         else
+           {
+             if (r->ubnd > s->ubnd)
+               r->ubnd = s->ubnd;
+             if (r->lbnd < s->lbnd)
+               {
+                 SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
+                 r->lbnd = s->lbnd;
+               }
+             r->inc += s->inc;
+           }
+       }
+      if (ndim > 0)
+       SCM_MISC_ERROR ("bad argument list", SCM_EOL);
+      scm_i_ra_set_contp (res);
+      return res;
+    }
+
+  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+}
+#undef FUNC_NAME
+
+/* attempts to unroll an array into a one-dimensional array.
+   returns the unrolled array or #f if it can't be done.  */
+  /* if strict is not SCM_UNDEFINED, return #f if returned array
+                    wouldn't have contiguous elements.  */
+SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
+           (SCM ra, SCM strict),
+           "If @var{array} may be @dfn{unrolled} into a one dimensional shared 
array\n"
+           "without changing their order (last subscript changing fastest), 
then\n"
+           "@code{array-contents} returns that shared array, otherwise it 
returns\n"
+           "@code{#f}.  All arrays made by @var{make-array} and\n"
+           "@var{make-uniform-array} may be unrolled, some arrays made by\n"
+           "@var{make-shared-array} may not be.\n\n"
+           "If the optional argument @var{strict} is provided, a shared array 
will\n"
+           "be returned only if its elements are stored internally contiguous 
in\n"
+           "memory.")
+#define FUNC_NAME s_scm_array_contents
+{
+  SCM sra;
+
+  if (scm_is_generalized_vector (ra))
+    return ra;
+
+  if (SCM_I_ARRAYP (ra))
+    {
+      size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
+      if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
+       return SCM_BOOL_F;
+      for (k = 0; k < ndim; k++)
+       len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 
1;
+      if (!SCM_UNBNDP (strict) && scm_is_true (strict))
+       {
+         if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
+           return SCM_BOOL_F;
+         if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
+           {
+             if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
+                 SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
+                 len % SCM_LONG_BIT)
+               return SCM_BOOL_F;
+           }
+       }
+      
+      {
+       SCM v = SCM_I_ARRAY_V (ra);
+       size_t length = scm_c_generalized_vector_length (v);
+       if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS 
(ra)->inc)
+         return v;
+      }
+      
+      sra = scm_i_make_array (1);
+      SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
+      SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
+      SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
+      SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
+      SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 
1].inc : 1);
+      return sra;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+}
+#undef FUNC_NAME
+
+
+SCM 
+scm_ra2contig (SCM ra, int copy)
+{
+  SCM ret;
+  long inc = 1;
+  size_t k, len = 1;
+  for (k = SCM_I_ARRAY_NDIM (ra); k--;)
+    len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+  k = SCM_I_ARRAY_NDIM (ra);
+  if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 
1].inc)))
+    {
+      if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
+       return ra;
+      if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
+          0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
+          0 == len % SCM_LONG_BIT))
+       return ra;
+    }
+  ret = scm_i_make_array (k);
+  SCM_I_ARRAY_BASE (ret) = 0;
+  while (k--)
+    {
+      SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+      SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
+      SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
+      inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
+    }
+  SCM_I_ARRAY_V (ret) = scm_make_generalized_vector (scm_array_type (ra),
+                                                     scm_from_long (inc),
+                                                     SCM_UNDEFINED);
+  if (copy)
+    scm_array_copy_x (ra, ret);
+  return ret;
+}
+
+
+
+SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
+           (SCM ura, SCM port_or_fd, SCM start, SCM end),
+           "@deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] 
[start] [end]\n"
+           "Attempt to read all elements of @var{ura}, in lexicographic order, 
as\n"
+           "binary objects from @var{port-or-fdes}.\n"
+           "If an end of file is encountered,\n"
+           "the objects up to that point are put into @var{ura}\n"
+           "(starting at the beginning) and the remainder of the array is\n"
+           "unchanged.\n\n"
+           "The optional arguments @var{start} and @var{end} allow\n"
+           "a specified region of a vector (or linearized array) to be read,\n"
+           "leaving the remainder of the vector unchanged.\n\n"
+           "@code{uniform-array-read!} returns the number of objects read.\n"
+           "@var{port-or-fdes} may be omitted, in which case it defaults to 
the value\n"
+           "returned by @code{(current-input-port)}.")
+#define FUNC_NAME s_scm_uniform_array_read_x
+{
+  if (SCM_UNBNDP (port_or_fd))
+    port_or_fd = scm_current_input_port ();
+
+  if (scm_is_uniform_vector (ura))
+    {
+      return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
+    }
+  else if (SCM_I_ARRAYP (ura))
+    {
+      size_t base, vlen, cstart, cend;
+      SCM cra, ans;
+      
+      cra = scm_ra2contig (ura, 0);
+      base = SCM_I_ARRAY_BASE (cra);
+      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
+
+      cstart = 0;
+      cend = vlen;
+      if (!SCM_UNBNDP (start))
+       {
+         cstart = scm_to_unsigned_integer (start, 0, vlen);
+         if (!SCM_UNBNDP (end))
+           cend = scm_to_unsigned_integer (end, cstart, vlen);
+       }
+
+      ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
+                                      scm_from_size_t (base + cstart),
+                                      scm_from_size_t (base + cend));
+
+      if (!scm_is_eq (cra, ura))
+       scm_array_copy_x (cra, ura);
+      return ans;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
+           (SCM ura, SCM port_or_fd, SCM start, SCM end),
+           "Writes all elements of @var{ura} as binary objects to\n"
+           "@var{port-or-fdes}.\n\n"
+           "The optional arguments @var{start}\n"
+           "and @var{end} allow\n"
+           "a specified region of a vector (or linearized array) to be 
written.\n\n"
+           "The number of objects actually written is returned.\n"
+           "@var{port-or-fdes} may be\n"
+           "omitted, in which case it defaults to the value returned by\n"
+           "@code{(current-output-port)}.")
+#define FUNC_NAME s_scm_uniform_array_write
+{
+  if (SCM_UNBNDP (port_or_fd))
+    port_or_fd = scm_current_output_port ();
+
+  if (scm_is_uniform_vector (ura))
+    {
+      return scm_uniform_vector_write (ura, port_or_fd, start, end);
+    }
+  else if (SCM_I_ARRAYP (ura))
+    {
+      size_t base, vlen, cstart, cend;
+      SCM cra, ans;
+      
+      cra = scm_ra2contig (ura, 1);
+      base = SCM_I_ARRAY_BASE (cra);
+      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
+       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
+
+      cstart = 0;
+      cend = vlen;
+      if (!SCM_UNBNDP (start))
+       {
+         cstart = scm_to_unsigned_integer (start, 0, vlen);
+         if (!SCM_UNBNDP (end))
+           cend = scm_to_unsigned_integer (end, cstart, vlen);
+       }
+
+      ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
+                                     scm_from_size_t (base + cstart),
+                                     scm_from_size_t (base + cend));
+
+      return ans;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
+}
+#undef FUNC_NAME
+
+
+static void
+list_to_array (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
+{
+  if (k == scm_array_handle_rank (handle))
+    scm_array_handle_set (handle, pos, lst);
+  else
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (handle) + k;
+      ssize_t inc = dim->inc;
+      size_t len = 1 + dim->ubnd - dim->lbnd, n;
+      char *errmsg = NULL;
+
+      n = len;
+      while (n > 0 && scm_is_pair (lst))
+       {
+         list_to_array (SCM_CAR (lst), handle, pos, k + 1);
+         pos += inc;
+         lst = SCM_CDR (lst);
+         n -= 1;
+       }
+      if (n != 0)
+       errmsg = "too few elements for array dimension ~a, need ~a";
+      if (!scm_is_null (lst))
+       errmsg = "too many elements for array dimension ~a, want ~a";
+      if (errmsg)
+       scm_misc_error (NULL, errmsg, scm_list_2 (scm_from_ulong (k),
+                                                 scm_from_size_t (len)));
+    }
+}
+  
+
+SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
+           (SCM type, SCM shape, SCM lst),
+           "Return an array of the type @var{type}\n"
+           "with elements the same as those of @var{lst}.\n"
+           "\n"
+           "The argument @var{shape} determines the number of dimensions\n"
+           "of the array and their shape.  It is either an exact integer,\n"
+           "giving the\n"
+           "number of dimensions directly, or a list whose length\n"
+           "specifies the number of dimensions and each element specified\n"
+           "the lower and optionally the upper bound of the corresponding\n"
+           "dimension.\n"
+           "When the element is list of two elements, these elements\n"
+           "give the lower and upper bounds.  When it is an exact\n"
+           "integer, it gives only the lower bound.")
+#define FUNC_NAME s_scm_list_to_typed_array
+{
+  SCM row;
+  SCM ra;
+  scm_t_array_handle handle;
+
+  row = lst;
+  if (scm_is_integer (shape))
+    {
+      size_t k = scm_to_size_t (shape);
+      shape = SCM_EOL;
+      while (k-- > 0)
+       {
+         shape = scm_cons (scm_length (row), shape);
+         if (k > 0 && !scm_is_null (row))
+           row = scm_car (row);
+       }
+    }
+  else
+    {
+      SCM shape_spec = shape;
+      shape = SCM_EOL;
+      while (1)
+       {
+         SCM spec = scm_car (shape_spec);
+         if (scm_is_pair (spec))
+           shape = scm_cons (spec, shape);
+         else
+           shape = scm_cons (scm_list_2 (spec,
+                                         scm_sum (scm_sum (spec,
+                                                           scm_length (row)),
+                                                  scm_from_int (-1))),
+                             shape);
+         shape_spec = scm_cdr (shape_spec);
+         if (scm_is_pair (shape_spec))
+           {
+             if (!scm_is_null (row))
+               row = scm_car (row);
+           }
+         else
+           break;
+       }
+    }
+
+  ra = scm_make_typed_array (type, SCM_UNSPECIFIED,
+                            scm_reverse_x (shape, SCM_EOL));
+
+  scm_array_get_handle (ra, &handle);
+  list_to_array (lst, &handle, 0, 0);
+  scm_array_handle_release (&handle);
+
+  return ra;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_list_to_array, "list->array", 2, 0, 0,
+           (SCM ndim, SCM lst),
+           "Return an array with elements the same as those of @var{lst}.")
+#define FUNC_NAME s_scm_list_to_array
+{
+  return scm_list_to_typed_array (SCM_BOOL_T, ndim, lst);
+}
+#undef FUNC_NAME
+
+/* Print dimension DIM of ARRAY.
+ */
+
+static int
+scm_i_print_array_dimension (scm_t_array_handle *h, int dim, int pos,
+                            SCM port, scm_print_state *pstate)
+{
+  if (dim == h->ndims)
+    scm_iprin1 (scm_array_handle_ref (h, pos), port, pstate);
+  else
+    {
+      ssize_t i;
+      scm_putc ('(', port);
+      for (i = h->dims[dim].lbnd; i <= h->dims[dim].ubnd;
+           i++, pos += h->dims[dim].inc)
+        {
+          scm_i_print_array_dimension (h, dim+1, pos, port, pstate);
+          if (i < h->dims[dim].ubnd)
+            scm_putc (' ', port);
+        }
+      scm_putc (')', port);
+    }
+  return 1;
+}
+
+/* Print an array.
+*/
+
+static int
+scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
+{
+  scm_t_array_handle h;
+  long i;
+  int print_lbnds = 0, zero_size = 0, print_lens = 0;
+
+  scm_array_get_handle (array, &h);
+
+  scm_putc ('#', port);
+  if (h.ndims != 1 || h.dims[0].lbnd != 0)
+    scm_intprint (h.ndims, 10, port);
+  if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_write (scm_array_handle_element_type (&h), port);
+  
+  for (i = 0; i < h.ndims; i++)
+    {
+      if (h.dims[i].lbnd != 0)
+       print_lbnds = 1;
+      if (h.dims[i].ubnd - h.dims[i].lbnd + 1 == 0)
+       zero_size = 1;
+      else if (zero_size)
+       print_lens = 1;
+    }
+
+  if (print_lbnds || print_lens)
+    for (i = 0; i < h.ndims; i++)
+      {
+       if (print_lbnds)
+         {
+           scm_putc ('@', port);
+           scm_intprint (h.dims[i].lbnd, 10, port);
+         }
+       if (print_lens)
+         {
+           scm_putc (':', port);
+           scm_intprint (h.dims[i].ubnd - h.dims[i].lbnd + 1,
+                         10, port);
+         }
+      }
+
+  if (h.ndims == 0)
+    {
+      /* Rank zero arrays, which are really just scalars, are printed
+        specially.  The consequent way would be to print them as
+
+            #0 OBJ
+
+         where OBJ is the printed representation of the scalar, but we
+         print them instead as
+
+            #0(OBJ)
+
+         to make them look less strange.
+
+        Just printing them as
+
+            OBJ
+
+         would be correct in a way as well, but zero rank arrays are
+         not really the same as Scheme values since they are boxed and
+         can be modified with array-set!, say.
+      */
+      scm_putc ('(', port);
+      scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+      scm_putc (')', port);
+      return 1;
+    }
+  else
+    return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+}
+
+/* Read an array.  This function can also read vectors and uniform
+   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
+   handled here.
+
+   C is the first character read after the '#'.
+*/
+
+static SCM
+tag_to_type (const char *tag, SCM port)
+{
+  if (*tag == '\0')
+    return SCM_BOOL_T;
+  else
+    return scm_from_locale_symbol (tag);
+}
+
+static int
+read_decimal_integer (SCM port, int c, ssize_t *resp)
+{
+  ssize_t sign = 1;
+  ssize_t res = 0;
+  int got_it = 0;
+
+  if (c == '-')
+    {
+      sign = -1;
+      c = scm_getc (port);
+    }
+
+  while ('0' <= c && c <= '9')
+    {
+      res = 10*res + c-'0';
+      got_it = 1;
+      c = scm_getc (port);
+    }
+
+  if (got_it)
+    *resp = sign * res;
+  return c;
+}
+
+SCM
+scm_i_read_array (SCM port, int c)
+{
+  ssize_t rank;
+  int got_rank;
+  char tag[80];
+  int tag_len;
+
+  SCM shape = SCM_BOOL_F, elements;
+
+  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
+     the array code can not deal with zero-length dimensions yet, and
+     we want to allow zero-length vectors, of course.
+  */
+  if (c == '(')
+    {
+      scm_ungetc (c, port);
+      return scm_vector (scm_read (port));
+    }
+
+  /* Disambiguate between '#f' and uniform floating point vectors.
+   */
+  if (c == 'f')
+    {
+      c = scm_getc (port);
+      if (c != '3' && c != '6')
+       {
+         if (c != EOF)
+           scm_ungetc (c, port);
+         return SCM_BOOL_F;
+       }
+      rank = 1;
+      got_rank = 1;
+      tag[0] = 'f';
+      tag_len = 1;
+      goto continue_reading_tag;
+    }
+
+  /* Read rank. 
+   */
+  rank = 1;
+  c = read_decimal_integer (port, c, &rank);
+  if (rank < 0)
+    scm_i_input_error (NULL, port, "array rank must be non-negative",
+                      SCM_EOL);
+
+  /* Read tag. 
+   */
+  tag_len = 0;
+ continue_reading_tag:
+  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
+    {
+      tag[tag_len++] = c;
+      c = scm_getc (port);
+    }
+  tag[tag_len] = '\0';
+  
+  /* Read shape. 
+   */
+  if (c == '@' || c == ':')
+    {
+      shape = SCM_EOL;
+      
+      do
+       {
+         ssize_t lbnd = 0, len = 0;
+         SCM s;
+
+         if (c == '@')
+           {
+             c = scm_getc (port);
+             c = read_decimal_integer (port, c, &lbnd);
+           }
+         
+         s = scm_from_ssize_t (lbnd);
+
+         if (c == ':')
+           {
+             c = scm_getc (port);
+             c = read_decimal_integer (port, c, &len);
+             if (len < 0)
+               scm_i_input_error (NULL, port,
+                                  "array length must be non-negative",
+                                  SCM_EOL);
+
+             s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
+           }
+
+         shape = scm_cons (s, shape);
+       } while (c == '@' || c == ':');
+
+      shape = scm_reverse_x (shape, SCM_EOL);
+    }
+
+  /* Read nested lists of elements.
+   */
+  if (c != '(')
+    scm_i_input_error (NULL, port,
+                      "missing '(' in vector or array literal",
+                      SCM_EOL);
+  scm_ungetc (c, port);
+  elements = scm_read (port);
+
+  if (scm_is_false (shape))
+    shape = scm_from_ssize_t (rank);
+  else if (scm_ilength (shape) != rank)
+    scm_i_input_error 
+      (NULL, port,
+       "the number of shape specifications must match the array rank",
+       SCM_EOL);
+
+  /* Handle special print syntax of rank zero arrays; see
+     scm_i_print_array for a rationale.
+  */
+  if (rank == 0)
+    {
+      if (!scm_is_pair (elements))
+       scm_i_input_error (NULL, port,
+                          "too few elements in array literal, need 1",
+                          SCM_EOL);
+      if (!scm_is_null (SCM_CDR (elements)))
+       scm_i_input_error (NULL, port,
+                          "too many elements in array literal, want 1",
+                          SCM_EOL);
+      elements = SCM_CAR (elements);
+    }
+
+  /* Construct array. 
+   */
+  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
+}
+
+
+static SCM
+array_mark (SCM ptr)
+{
+  return SCM_I_ARRAY_V (ptr);
+}
+
+static size_t
+array_free (SCM ptr)
+{
+  scm_gc_free (SCM_I_ARRAY_MEM (ptr),
+              (sizeof (scm_i_t_array) 
+               + SCM_I_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
+              "array");
+  return 0;
+}
+
+static SCM
+array_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_generalized_vector_ref (SCM_I_ARRAY_V (h->array), pos);
+}
+
+static void
+array_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_generalized_vector_set_x (SCM_I_ARRAY_V (h->array), pos, val);
+}
+
+/* FIXME: should be handle for vect? maybe not, because of dims */
+static void
+array_get_handle (SCM array, scm_t_array_handle *h)
+{
+  scm_t_array_handle vh;
+  scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
+  h->element_type = vh.element_type;
+  h->elements = vh.elements;
+  h->writable_elements = vh.writable_elements;
+  scm_array_handle_release (&vh);
+
+  h->dims = SCM_I_ARRAY_DIMS (array);
+  h->ndims = SCM_I_ARRAY_NDIM (array);
+  h->base = SCM_I_ARRAY_BASE (array);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_i_tc16_array, 0xffff,
+                          array_handle_ref, array_handle_set,
+                          array_get_handle);
+
+void
+scm_init_arrays ()
+{
+  scm_i_tc16_array = scm_make_smob_type ("array", 0);
+  scm_set_smob_mark (scm_i_tc16_array, array_mark);
+  scm_set_smob_free (scm_i_tc16_array, array_free);
+  scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
+  scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
+
+  scm_add_feature ("array");
+
+#include "libguile/arrays.x"
+
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/arrays.h b/libguile/arrays.h
new file mode 100644
index 0000000..35e5471
--- /dev/null
+++ b/libguile/arrays.h
@@ -0,0 +1,91 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_H
+#define SCM_ARRAY_H
+
+/* Copyright (C) 1995,1996,1997,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
+ * 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/print.h"
+
+
+
+/* Multidimensional arrays. Woo hoo!
+   Also see ....
+ */
+
+
+/** Arrays */
+
+SCM_API SCM scm_make_array (SCM fill, SCM bounds);
+SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
+SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
+                                             const void *bytes,
+                                             size_t byte_len);
+SCM_API SCM scm_shared_array_root (SCM ra);
+SCM_API SCM scm_shared_array_offset (SCM ra);
+SCM_API SCM scm_shared_array_increments (SCM ra);
+SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
+SCM_API SCM scm_transpose_array (SCM ra, SCM args);
+SCM_API SCM scm_array_contents (SCM ra, SCM strict);
+SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
+                                     SCM start, SCM end);
+SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
+                                    SCM start, SCM end);
+SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
+SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
+
+SCM_API SCM scm_ra2contig (SCM ra, int copy);
+
+/* internal. */
+
+typedef struct scm_i_t_array
+{
+  SCM v;  /* the contents of the array, e.g., a vector or uniform vector.  */
+  unsigned long base;
+} scm_i_t_array;
+
+SCM_API scm_t_bits scm_i_tc16_array;
+
+#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
+
+#define SCM_I_ARRAYP(a)            SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
+#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
+#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
+
+#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
+#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
+#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
+#define SCM_I_ARRAY_DIMS(a) \
+  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
+
+SCM_INTERNAL SCM scm_i_make_array (int ndim);
+SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
+
+SCM_INTERNAL void scm_init_arrays (void);
+
+#endif  /* SCM_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
new file mode 100644
index 0000000..f1d8473
--- /dev/null
+++ b/libguile/bitvectors.c
@@ -0,0 +1,910 @@
+/* Copyright (C) 1995,1996,1997,1998,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 <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/smob.h"
+#include "libguile/strings.h"
+#include "libguile/array-handle.h"
+#include "libguile/bitvectors.h"
+#include "libguile/arrays.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/srfi-4.h"
+
+/* Bit vectors. Would be nice if they were implemented on top of bytevectors,
+ * but alack, all we have is this crufty C.
+ */
+
+static scm_t_bits scm_tc16_bitvector;
+
+#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
+#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
+#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
+
+static size_t
+bitvector_free (SCM vec)
+{
+  scm_gc_free (BITVECTOR_BITS (vec),
+              sizeof (scm_t_uint32) * ((BITVECTOR_LENGTH (vec)+31)/32),
+              "bitvector");
+  return 0;
+}
+
+static int
+bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
+  size_t i, j;
+
+  scm_puts ("#*", port);
+  for (i = 0; i < word_len; i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
+       scm_putc ((bits[i] & mask)? '1' : '0', port);
+    }
+    
+  return 1;
+}
+
+static SCM
+bitvector_equalp (SCM vec1, SCM vec2)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec1);
+  size_t word_len = (bit_len + 31) / 32;
+  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
+  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
+  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
+
+  /* compare lengths */
+  if (BITVECTOR_LENGTH (vec2) != bit_len)
+    return SCM_BOOL_F;
+  /* avoid underflow in word_len-1 below. */
+  if (bit_len == 0)
+    return SCM_BOOL_T;
+  /* compare full words */
+  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
+    return SCM_BOOL_F;
+  /* compare partial last words */
+  if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
+    return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
+int
+scm_is_bitvector (SCM vec)
+{
+  return IS_BITVECTOR (vec);
+}
+
+SCM_DEFINE (scm_bitvector_p, "bitvector?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} when @var{obj} is a bitvector, else\n"
+           "return @code{#f}.")
+#define FUNC_NAME s_scm_bitvector_p
+{
+  return scm_from_bool (scm_is_bitvector (obj));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_bitvector (size_t len, SCM fill)
+{
+  size_t word_len = (len + 31) / 32;
+  scm_t_uint32 *bits;
+  SCM res;
+
+  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
+                       "bitvector");
+  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
+
+  if (!SCM_UNBNDP (fill))
+    scm_bitvector_fill_x (res, fill);
+      
+  return res;
+}
+
+SCM_DEFINE (scm_make_bitvector, "make-bitvector", 1, 1, 0,
+           (SCM len, SCM fill),
+           "Create a new bitvector of length @var{len} and\n"
+           "optionally initialize all elements to @var{fill}.")
+#define FUNC_NAME s_scm_make_bitvector
+{
+  return scm_c_make_bitvector (scm_to_size_t (len), fill);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
+           (SCM bits),
+           "Create a new bitvector with the arguments as elements.")
+#define FUNC_NAME s_scm_bitvector
+{
+  return scm_list_to_bitvector (bits);
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_bitvector_length (SCM vec)
+{
+  scm_assert_smob_type (scm_tc16_bitvector, vec);
+  return BITVECTOR_LENGTH (vec);
+}
+
+SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
+           (SCM vec),
+           "Return the length of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_length
+{
+  return scm_from_size_t (scm_c_bitvector_length (vec));
+}
+#undef FUNC_NAME
+
+const scm_t_uint32 *
+scm_array_handle_bit_elements (scm_t_array_handle *h)
+{
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+scm_t_uint32 *
+scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
+{
+  SCM vec = h->array;
+  if (SCM_I_ARRAYP (vec))
+    vec = SCM_I_ARRAY_V (vec);
+  if (IS_BITVECTOR (vec))
+    return BITVECTOR_BITS (vec) + h->base/32;
+  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
+}
+
+size_t
+scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
+{
+  return h->base % 32;
+}
+
+const scm_t_uint32 *
+scm_bitvector_elements (SCM vec,
+                       scm_t_array_handle *h,
+                       size_t *offp,
+                       size_t *lenp,
+                       ssize_t *incp)
+{
+  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
+}
+
+
+scm_t_uint32 *
+scm_bitvector_writable_elements (SCM vec,
+                                scm_t_array_handle *h,
+                                size_t *offp,
+                                size_t *lenp,
+                                ssize_t *incp)
+{
+  scm_generalized_vector_get_handle (vec, h);
+  if (offp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *offp = scm_array_handle_bit_elements_offset (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+SCM
+scm_c_bitvector_ref (SCM vec, size_t idx)
+{
+  scm_t_array_handle handle;
+  const scm_t_uint32 *bits;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+    }
+  else
+    {
+      SCM res;
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+      scm_array_handle_release (&handle);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
+           (SCM vec, SCM idx),
+           "Return the element at index @var{idx} of the bitvector\n"
+           "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_ref
+{
+  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+{
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits, mask;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+    }
+  else
+    {
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+       scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+    }
+
+  mask = 1L << (idx%32);
+  if (scm_is_true (val))
+    bits[idx/32] |= mask;
+  else
+    bits[idx/32] &= ~mask;
+
+  if (!IS_BITVECTOR (vec))
+      scm_array_handle_release (&handle);
+}
+
+SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
+           (SCM vec, SCM idx, SCM val),
+           "Set the element at index @var{idx} of the bitvector\n"
+           "@var{vec} when @var{val} is true, else clear it.")
+#define FUNC_NAME s_scm_bitvector_set_x
+{
+  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
+           (SCM vec, SCM val),
+           "Set all elements of the bitvector\n"
+           "@var{vec} when @var{val} is true, else clear them.")
+#define FUNC_NAME s_scm_bitvector_fill_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+                                         &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+
+      if (scm_is_true (val))
+       {
+         memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
+         bits[word_len-1] |= last_mask;
+       }
+      else
+       {
+         memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
+         bits[word_len-1] &= ~last_mask;
+       }
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       scm_array_handle_set (&handle, i*inc, val);
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
+           (SCM list),
+           "Return a new bitvector initialized with the elements\n"
+           "of @var{list}.")
+#define FUNC_NAME s_scm_list_to_bitvector
+{
+  size_t bit_len = scm_to_size_t (scm_length (list));
+  SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
+                                                       NULL, NULL, NULL);
+  size_t i, j;
+
+  for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      bits[i] = 0;
+      for (j = 0; j < 32 && j < bit_len;
+          j++, mask <<= 1, list = SCM_CDR (list))
+       if (scm_is_true (SCM_CAR (list)))
+         bits[i] |= mask;
+    }
+
+  scm_array_handle_release (&handle);
+
+  return vec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
+           (SCM vec),
+           "Return a new list initialized with the elements\n"
+           "of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_to_list
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  SCM res = SCM_EOL;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+                                         &off, &len, &inc);
+
+  if (off == 0 && inc == 1)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      size_t i, j;
+
+      for (i = 0; i < word_len; i++, len -= 32)
+       {
+         scm_t_uint32 mask = 1;
+         for (j = 0; j < 32 && j < len; j++, mask <<= 1)
+           res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
+       }
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
+    }
+
+  scm_array_handle_release (&handle);
+  
+  return scm_reverse_x (res, SCM_EOL);
+}
+#undef FUNC_NAME
+
+/* From mmix-arith.w by Knuth.
+
+  Here's a fun way to count the number of bits in a tetrabyte.
+
+  [This classical trick is called the ``Gillies--Miller method for
+  sideways addition'' in {\sl The Preparation of Programs for an
+  Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
+  edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
+  the tricks used here were suggested by Balbir Singh, Peter
+  Rossmanith, and Stefan Schwoon.]
+*/
+
+static size_t
+count_ones (scm_t_uint32 x)
+{
+  x=x-((x>>1)&0x55555555);
+  x=(x&0x33333333)+((x>>2)&0x33333333);
+  x=(x+(x>>4))&0x0f0f0f0f;
+  x=x+(x>>8);
+  return (x+(x>>16)) & 0xff;
+}
+
+SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
+           (SCM b, SCM bitvector),
+           "Return the number of occurrences of the boolean @var{b} in\n"
+           "@var{bitvector}.")
+#define FUNC_NAME s_scm_bit_count
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  int bit = scm_to_bool (b);
+  size_t count = 0;
+
+  bits = scm_bitvector_writable_elements (bitvector, &handle,
+                                         &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+       count += count_ones (bits[i]);
+      count += count_ones (bits[i] & last_mask);
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
+         count++;
+    }
+  
+  scm_array_handle_release (&handle);
+
+  return scm_from_size_t (bit? count : len-count);
+}
+#undef FUNC_NAME
+
+/* returns 32 for x == 0. 
+*/
+static size_t
+find_first_one (scm_t_uint32 x)
+{
+  size_t pos = 0;
+  /* do a binary search in x. */
+  if ((x & 0xFFFF) == 0)
+    x >>= 16, pos += 16;
+  if ((x & 0xFF) == 0)
+    x >>= 8, pos += 8;
+  if ((x & 0xF) == 0)
+    x >>= 4, pos += 4;
+  if ((x & 0x3) == 0)
+    x >>= 2, pos += 2;
+  if ((x & 0x1) == 0)
+    pos += 1;
+  return pos;
+}
+
+SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
+           (SCM item, SCM v, SCM k),
+           "Return the index of the first occurrance of @var{item} in bit\n"
+           "vector @var{v}, starting from @var{k}.  If there is no\n"
+           "@var{item} entry between @var{k} and the end of\n"
+           "@var{bitvector}, then return @code{#f}.  For example,\n"
+           "\n"
+           "@example\n"
+           "(bit-position #t #*000101 0)  @result{} 3\n"
+           "(bit-position #f #*0001111 3) @result{} #f\n"
+           "@end example")
+#define FUNC_NAME s_scm_bit_position
+{
+  scm_t_array_handle handle;
+  size_t off, len, first_bit;
+  ssize_t inc;
+  const scm_t_uint32 *bits;
+  int bit = scm_to_bool (item);
+  SCM res = SCM_BOOL_F;
+  
+  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
+  first_bit = scm_to_unsigned_integer (k, 0, len);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t i, word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t first_word = first_bit / 32;
+      scm_t_uint32 first_mask =
+       ((scm_t_uint32)-1) << (first_bit - 32*first_word);
+      scm_t_uint32 w;
+      
+      for (i = first_word; i < word_len; i++)
+       {
+         w = (bit? bits[i] : ~bits[i]);
+         if (i == first_word)
+           w &= first_mask;
+         if (i == word_len-1)
+           w &= last_mask;
+         if (w)
+           {
+             res = scm_from_size_t (32*i + find_first_one (w));
+             break;
+           }
+       }
+    }
+  else
+    {
+      size_t i;
+      for (i = first_bit; i < len; i++)
+       {
+         SCM elt = scm_array_handle_ref (&handle, i*inc);
+         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+           {
+             res = scm_from_size_t (i);
+             break;
+           }
+       }
+    }
+
+  scm_array_handle_release (&handle);
+
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
+           (SCM v, SCM kv, SCM obj),
+           "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
+           "selecting the entries to change.  The return value is\n"
+           "unspecified.\n"
+           "\n"
+           "If @var{kv} is a bit vector, then those entries where it has\n"
+           "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
+           "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
+           "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
+           "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
+           "\n"
+           "@example\n"
+           "(define bv #*01000010)\n"
+           "(bit-set*! bv #*10010001 #t)\n"
+           "bv\n"
+           "@result{} #*11010011\n"
+           "@end example\n"
+           "\n"
+           "If @var{kv} is a u32vector, then its elements are\n"
+           "indices into @var{v} which are set to @var{obj}.\n"
+           "\n"
+           "@example\n"
+           "(define bv #*01000010)\n"
+           "(bit-set*! bv #u32(5 2 7) #t)\n"
+           "bv\n"
+           "@result{} #*01100111\n"
+           "@end example")
+#define FUNC_NAME s_scm_bit_set_star_x
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  scm_t_uint32 *v_bits;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_writable_elements (v, &v_handle,
+                                           &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+                                       &kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+       scm_misc_error (NULL,
+                       "bit vectors must have equal length",
+                       SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+       {
+         size_t word_len = (kv_len + 31) / 32;
+         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+         size_t i;
+ 
+         if (bit == 0)
+           {
+             for (i = 0; i < word_len-1; i++)
+               v_bits[i] &= ~kv_bits[i];
+             v_bits[i] &= ~(kv_bits[i] & last_mask);
+           }
+         else
+           {
+             for (i = 0; i < word_len-1; i++)
+               v_bits[i] |= kv_bits[i];
+             v_bits[i] |= kv_bits[i] & last_mask;
+           }
+       }
+      else
+       {
+         size_t i;
+         for (i = 0; i < kv_len; i++)
+           if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
+             scm_array_handle_set (&v_handle, i*v_inc, obj);
+       }
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+       scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
+           (SCM v, SCM kv, SCM obj),
+           "Return a count of how many entries in bit vector @var{v} are\n"
+           "equal to @var{obj}, with @var{kv} selecting the entries to\n"
+           "consider.\n"
+           "\n"
+           "If @var{kv} is a bit vector, then those entries where it has\n"
+           "@code{#t} are the ones in @var{v} which are considered.\n"
+           "@var{kv} and @var{v} must be the same length.\n"
+           "\n"
+           "If @var{kv} is a u32vector, then it contains\n"
+           "the indexes in @var{v} to consider.\n"
+           "\n"
+           "For example,\n"
+           "\n"
+           "@example\n"
+           "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
+           "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
+           "@end example")
+#define FUNC_NAME s_scm_bit_count_star
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  const scm_t_uint32 *v_bits;
+  size_t count = 0;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_elements (v, &v_handle,
+                                  &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+                                       &kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+       scm_misc_error (NULL,
+                       "bit vectors must have equal length",
+                       SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+       {
+         size_t i, word_len = (kv_len + 31) / 32;
+         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+         scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
+
+         for (i = 0; i < word_len-1; i++)
+           count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
+         count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
+       }
+      else
+       {
+         size_t i;
+         for (i = 0; i < kv_len; i++)
+           if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
+             {
+               SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
+               if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+                 count++;
+             }
+       }
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+       {
+         SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
+         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+           count++;
+       }
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return scm_from_size_t (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, 
+           (SCM v),
+           "Modify the bit vector @var{v} by replacing each element with\n"
+           "its negation.")
+#define FUNC_NAME s_scm_bit_invert_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
+  
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+       bits[i] = ~bits[i];
+      bits[i] = bits[i] ^ last_mask;
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+       scm_array_handle_set (&handle, i*inc,
+                             scm_not (scm_array_handle_ref (&handle, i*inc)));
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM
+scm_istr2bve (SCM str)
+{
+  scm_t_array_handle handle;
+  size_t len = scm_i_string_length (str);
+  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
+  SCM res = vec;
+
+  scm_t_uint32 mask;
+  size_t k, j;
+  const char *c_str;
+  scm_t_uint32 *data;
+
+  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
+  c_str = scm_i_string_chars (str);
+
+  for (k = 0; k < (len + 31) / 32; k++)
+    {
+      data[k] = 0L;
+      j = len - k * 32;
+      if (j > 32)
+       j = 32;
+      for (mask = 1L; j--; mask <<= 1)
+       switch (*c_str++)
+         {
+         case '0':
+           break;
+         case '1':
+           data[k] |= mask;
+           break;
+         default:
+           res = SCM_BOOL_F;
+           goto exit;
+         }
+    }
+  
+ exit:
+  scm_array_handle_release (&handle);
+  scm_remember_upto_here_1 (str);
+  return res;
+}
+
+/* FIXME: h->array should be h->vector */
+static SCM
+bitvector_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_bitvector_ref (h->array, pos);
+}
+
+static void
+bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_bitvector_set_x (h->array, pos, val);
+}
+
+static void
+bitvector_get_handle (SCM bv, scm_t_array_handle *h)
+{
+  h->array = bv;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = BITVECTOR_LENGTH (bv) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_BIT;
+  h->elements = h->writable_elements = BITVECTOR_BITS (bv);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc16_bitvector, 0xffff,
+                          bitvector_handle_ref, bitvector_handle_set,
+                          bitvector_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector);
+
+void
+scm_init_bitvectors ()
+{
+  scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
+  scm_set_smob_free (scm_tc16_bitvector, bitvector_free);
+  scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
+  scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
+
+#include "libguile/bitvectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/bitvectors.h b/libguile/bitvectors.h
new file mode 100644
index 0000000..b6cf383
--- /dev/null
+++ b/libguile/bitvectors.h
@@ -0,0 +1,81 @@
+/* classes: h_files */
+
+#ifndef SCM_BITVECTORS_H
+#define SCM_BITVECTORS_H
+
+/* Copyright (C) 1995,1996,1997,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
+ * 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Bitvectors. Exciting stuff, maybe!
+ */
+
+
+/** Bit vectors */
+
+SCM_API SCM scm_bitvector_p (SCM vec);
+SCM_API SCM scm_bitvector (SCM bits);
+SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
+SCM_API SCM scm_bitvector_length (SCM vec);
+SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx);
+SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
+SCM_API SCM scm_list_to_bitvector (SCM list);
+SCM_API SCM scm_bitvector_to_list (SCM vec);
+SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
+
+SCM_API SCM scm_bit_count (SCM item, SCM seq);
+SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
+SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_invert_x (SCM v);
+SCM_API SCM scm_istr2bve (SCM str);
+
+SCM_API int scm_is_bitvector (SCM obj);
+SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
+SCM_API size_t scm_c_bitvector_length (SCM vec);
+SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
+SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
+SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle 
*h);
+SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements 
(scm_t_array_handle *h);
+SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
+SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
+                                                   scm_t_array_handle *h,
+                                                   size_t *offp,
+                                                   size_t *lenp,
+                                                   ssize_t *incp);
+SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
+                                                      scm_t_array_handle *h,
+                                                      size_t *offp,
+                                                      size_t *lenp,
+                                                      ssize_t *incp);
+
+SCM_INTERNAL void scm_init_bitvectors (void);
+
+#endif  /* SCM_BITVECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 5b79a14..b2e5ec9 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -31,7 +31,9 @@
 #include "libguile/strings.h"
 #include "libguile/validate.h"
 #include "libguile/ieee-754.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
+#include "libguile/array-handle.h"
+#include "libguile/uniform.h"
 #include "libguile/srfi-4.h"
 
 #include <byteswap.h>
@@ -175,48 +177,99 @@
 
 scm_t_bits scm_tc16_bytevector;
 
-#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)   \
+#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) \
+#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))
+#define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
+  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var)                        \
+  SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)
 
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
 
 static inline SCM
-make_bytevector_from_buffer (size_t len, signed char *contents)
+make_bytevector_from_buffer (size_t len, void *contents,
+                             scm_t_array_element_type element_type)
 {
-  /* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD.  */
-  SCM_RETURN_NEWSMOB2 (scm_tc16_bytevector, len, contents);
+  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);
+  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);
+        }
+    }
+  SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+  return ret;
 }
 
 static inline SCM
-make_bytevector (size_t len)
+make_bytevector (size_t len, scm_t_array_element_type element_type)
 {
-  SCM bv;
+  size_t c_len;
 
-  if (SCM_UNLIKELY (len == 0))
-    bv = scm_null_bytevector;
+  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 ();
+
+  c_len = len * (scm_i_array_element_type_sizes[element_type]/8);
+  if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+    {
+      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
     {
-      signed char *contents = NULL;
-
-      if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
-       contents = (signed char *)
-         scm_gc_malloc_pointerless (len, SCM_GC_BYTEVECTOR);
-
-      bv = make_bytevector_from_buffer (len, contents);
+      void *buf = scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
+      return make_bytevector_from_buffer (len, buf, element_type);
     }
-
-  return bv;
 }
 
 /* Return a new bytevector of size LEN octets.  */
 SCM
 scm_c_make_bytevector (size_t len)
 {
-  return (make_bytevector (len));
+  return make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
+
+/* Return a new bytevector of size LEN elements.  */
+SCM
+scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
+{
+  return make_bytevector (len, element_type);
 }
 
 /* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
@@ -224,22 +277,14 @@ scm_c_make_bytevector (size_t len)
 SCM
 scm_c_take_bytevector (signed char *contents, size_t len)
 {
-  SCM bv;
-
-  if (SCM_UNLIKELY (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len)))
-    {
-      /* Copy CONTENTS into an "in-line" buffer, then free CONTENTS.  */
-      signed char *c_bv;
-
-      bv = make_bytevector (len);
-      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
-      memcpy (c_bv, contents, len);
-      scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
-    }
-  else
-    bv = make_bytevector_from_buffer (len, contents);
+  return make_bytevector_from_buffer (len, contents, 
SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
 
-  return bv;
+SCM
+scm_c_take_typed_bytevector (signed char *contents, size_t len,
+                             scm_t_array_element_type element_type)
+{
+  return make_bytevector_from_buffer (len, contents, element_type);
 }
 
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
@@ -247,6 +292,10 @@ scm_c_take_bytevector (signed char *contents, size_t len)
 SCM
 scm_i_shrink_bytevector (SCM bv, size_t c_new_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;
@@ -260,6 +309,7 @@ scm_i_shrink_bytevector (SCM bv, size_t 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);
@@ -272,6 +322,8 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
          SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
        }
     }
+  else
+    SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
 
   return bv;
 }
@@ -330,38 +382,30 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 
value)
 }
 #undef FUNC_NAME
 
-/* This procedure is used by `scm_c_generalized_vector_set_x ()'.  */
-void
-scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
-#define FUNC_NAME "scm_i_bytevector_generalized_set_x"
-{
-  scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
-}
-#undef FUNC_NAME
+
+
+
 
 static int
-print_bytevector (SCM bv, SCM port, scm_print_state *pstate)
+print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  unsigned c_len, i;
-  unsigned char *c_bv;
-
-  c_len = SCM_BYTEVECTOR_LENGTH (bv);
-  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  ssize_t ubnd, inc, i;
+  scm_t_array_handle h;
+  
+  scm_array_get_handle (bv, &h);
 
-  scm_puts ("#vu8(", port);
-  for (i = 0; i < c_len; i++)
+  scm_putc ('#', port);
+  scm_write (scm_array_handle_element_type (&h), port);
+  scm_putc ('(', port);
+  for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
+       i <= ubnd; i += inc)
     {
       if (i > 0)
        scm_putc (' ', port);
-
-      scm_uintprint (c_bv[i], 10, port);
+      scm_write (scm_array_handle_ref (&h, i), port);
     }
-
   scm_putc (')', port);
 
-  /* Make GCC think we use it.  */
-  scm_remember_upto_here ((SCM) pstate);
-
   return 1;
 }
 
@@ -430,7 +474,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
       c_fill = (signed char) value;
     }
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   if (fill != SCM_UNDEFINED)
     {
       unsigned i;
@@ -556,7 +600,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
   c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
 
-  copy = make_bytevector (c_len);
+  copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
   c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
   memcpy (c_copy, c_bv, c_len);
 
@@ -586,7 +630,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, 
"uniform-array->bytevector",
   len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
   sz = scm_array_handle_uniform_element_size (&h);
 
-  ret = make_bytevector (len * sz);
+  ret = make_bytevector (len * sz, SCM_ARRAY_ELEMENT_TYPE_VU8);
   memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
 
   scm_array_handle_release (&h);
@@ -675,7 +719,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, 
"u8-list->bytevector", 1, 0, 0,
 
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
@@ -1112,7 +1156,7 @@ SCM_DEFINE (scm_bytevector_to_uint_list, 
"bytevector->uint-list",
   if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))   \
     scm_out_of_range (FUNC_NAME, size);                                        
\
                                                                        \
-  bv = make_bytevector (c_len * c_size);                               \
+  bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8);     \
   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);                                
\
                                                                        \
   for (c_bv_ptr = c_bv;                                                        
\
@@ -1611,6 +1655,12 @@ double_from_foreign_endianness (const union 
scm_ieee754_double *source)
    _c_type ## _to_foreign_endianness
 
 
+/* FIXME: SCM_VALIDATE_REAL rejects integers, etc. grrr */
+#define VALIDATE_REAL(pos, v) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_true (scm_rational_p (v)), v, pos, FUNC_NAME, 
"real"); \
+  } while (0)
+
 /* Templace getters and setters.  */
 
 #define IEEE754_ACCESSOR_PROLOGUE(_type)                       \
@@ -1647,7 +1697,7 @@ double_from_foreign_endianness (const union 
scm_ieee754_double *source)
   _type c_value;                                               \
                                                                \
   IEEE754_ACCESSOR_PROLOGUE (_type);                           \
-  SCM_VALIDATE_REAL (3, value);                                        \
+  VALIDATE_REAL (3, value);                                    \
   SCM_VALIDATE_SYMBOL (4, endianness);                         \
   c_value = IEEE754_FROM_SCM (_type) (value);                  \
                                                                \
@@ -1667,7 +1717,7 @@ double_from_foreign_endianness (const union 
scm_ieee754_double *source)
   _type c_value;                                       \
                                                        \
   IEEE754_ACCESSOR_PROLOGUE (_type);                   \
-  SCM_VALIDATE_REAL (3, value);                                \
+  VALIDATE_REAL (3, value);                            \
   c_value = IEEE754_FROM_SCM (_type) (value);          \
                                                        \
   memcpy (&c_bv[c_index], &c_value, sizeof (c_value)); \
@@ -1883,7 +1933,8 @@ utf_encoding_name (char *name, size_t utf_width, SCM 
endianness)
       scm_dynwind_begin (0);                                           \
       scm_dynwind_free (c_utf);                                                
\
                                                                        \
-      utf = make_bytevector (c_utf_len);                               \
+      utf = make_bytevector (c_utf_len,                                        
\
+                             SCM_ARRAY_ELEMENT_TYPE_VU8);              \
       memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,                    \
              c_utf_len);                                               \
                                                                        \
@@ -1928,7 +1979,8 @@ SCM_DEFINE (scm_string_to_utf8, "string->utf8",
       scm_dynwind_begin (0);
       scm_dynwind_free (c_utf);
 
-      utf = make_bytevector (UTF_STRLEN (8, 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));
 
@@ -2059,6 +2111,127 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
 
 
 
+/* Bytevectors as generalized vectors & arrays.  */
+
+
+static SCM
+bytevector_ref_c32 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const float *contents = (const float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
+}
+
+static SCM
+bytevector_ref_c64 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const double *contents = (const double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/16], contents[i/16 + 1]);
+}
+
+typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
+
+const scm_t_bytevector_ref_fn bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 
1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_ref, /* VU8 */
+  scm_bytevector_u8_ref, /* U8 */
+  scm_bytevector_s8_ref,
+  scm_bytevector_u16_native_ref,
+  scm_bytevector_s16_native_ref,
+  scm_bytevector_u32_native_ref,
+  scm_bytevector_s32_native_ref,
+  scm_bytevector_u64_native_ref,
+  scm_bytevector_s64_native_ref,
+  scm_bytevector_ieee_single_native_ref,
+  scm_bytevector_ieee_double_native_ref,
+  bytevector_ref_c32,
+  bytevector_ref_c64
+};
+
+static SCM
+bv_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  SCM byte_index;
+  scm_t_bytevector_ref_fn ref_fn;
+  
+  ref_fn = bytevector_ref_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  return ref_fn (h->array, byte_index);
+}
+
+static SCM
+bytevector_set_c32 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  float *contents = (float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/8] = scm_c_real_part (val);
+  contents[i/8 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
+bytevector_set_c64 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  double *contents = (double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/16] = scm_c_real_part (val);
+  contents[i/16 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM);
+
+const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 
1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_set_x, /* VU8 */
+  scm_bytevector_u8_set_x, /* U8 */
+  scm_bytevector_s8_set_x,
+  scm_bytevector_u16_native_set_x,
+  scm_bytevector_s16_native_set_x,
+  scm_bytevector_u32_native_set_x,
+  scm_bytevector_s32_native_set_x,
+  scm_bytevector_u64_native_set_x,
+  scm_bytevector_s64_native_set_x,
+  scm_bytevector_ieee_single_native_set_x,
+  scm_bytevector_ieee_double_native_set_x,
+  bytevector_set_c32,
+  bytevector_set_c64
+};
+
+static void
+bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
+{
+  SCM byte_index;
+  scm_t_bytevector_set_fn set_fn;
+  
+  set_fn = bytevector_set_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  set_fn (h->array, byte_index, val);
+}
+
+static void
+bytevector_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v);
+  h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v);
+}
+
+
 /* Initialization.  */
 
 void
@@ -2072,7 +2245,8 @@ scm_bootstrap_bytevectors (void)
   scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
 
   scm_null_bytevector =
-    scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+    scm_gc_protect_object
+    (make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8));
 
 #ifdef WORDS_BIGENDIAN
   scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol 
("big"));
@@ -2083,6 +2257,20 @@ scm_bootstrap_bytevectors (void)
   scm_c_register_extension ("libguile", "scm_init_bytevectors",
                            (scm_t_extension_init_func) scm_init_bytevectors,
                            NULL);
+
+  {
+    scm_t_array_implementation impl;
+    
+    impl.tag = scm_tc16_bytevector;
+    impl.mask = 0xffff;
+    impl.vref = bv_handle_ref;
+    impl.vset = bv_handle_set_x;
+    impl.get_handle = bytevector_get_handle;
+    scm_i_register_array_implementation (&impl);
+    scm_i_register_vector_constructor
+      (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
+       scm_make_bytevector);
+  }
 }
 
 void
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index cb27262..e29fe6d 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -116,17 +116,21 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
    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)                  \
+#define SCM_BYTEVECTOR_P(_bv)                   \
   SCM_SMOB_PREDICATE (scm_tc16_bytevector, _bv)
-#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
-#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)        \
-  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
-#define SCM_BYTEVECTOR_INLINE_P(_bv)                                \
-  (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (SCM_BYTEVECTOR_LENGTH (_bv)))
+#define SCM_F_BYTEVECTOR_INLINE 0x1
+#define SCM_BYTEVECTOR_INLINE_P(_bv)            \
+  (SCM_SMOB_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv)       \
+  (SCM_SMOB_FLAGS (_bv) >> 8)
 
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
 
+SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, 
scm_t_array_element_type);
+SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
+                                              scm_t_array_element_type);
+
 SCM_INTERNAL void scm_bootstrap_bytevectors (void);
 SCM_INTERNAL void scm_init_bytevectors (void);
 
diff --git a/libguile/chars.c b/libguile/chars.c
index 552a2d9..c7cb09c 100644
--- a/libguile/chars.c
+++ b/libguile/chars.c
@@ -296,20 +296,14 @@ TODO: change name  to scm_i_.. ? --hwn
 scm_t_wchar
 scm_c_upcase (scm_t_wchar c)
 {
-  if (c > 255)
-    return c;
-
-  return toupper ((int) c);
+  return uc_toupper ((int) c);
 }
 
 
 scm_t_wchar
 scm_c_downcase (scm_t_wchar c)
 {
-  if (c > 255)
-    return c;
-
-  return tolower ((int) c);
+  return uc_tolower ((int) c);
 }
 
 
diff --git a/libguile/chars.h b/libguile/chars.h
index 51adc21..85b1673 100644
--- a/libguile/chars.h
+++ b/libguile/chars.h
@@ -24,7 +24,11 @@
 
 
 #include "libguile/__scm.h"
-#include "libguile/numbers.h"
+
+#ifndef SCM_T_WCHAR_DEFINED
+typedef scm_t_int32 scm_t_wchar;
+#define SCM_T_WCHAR_DEFINED
+#endif /* SCM_T_WCHAR_DEFINED */
 
 
 /* Immediate Characters
@@ -32,9 +36,15 @@
 #define SCM_CHARP(x) (SCM_ITAG8(x) == scm_tc8_char)
 #define SCM_CHAR(x) ((scm_t_wchar)SCM_ITAG8_DATA(x))
 
-#define SCM_MAKE_CHAR(x)                                               \
-  ((scm_t_int32) (x) < 0                                               \
-   ? SCM_MAKE_ITAG8 ((scm_t_bits) (unsigned char) (x), scm_tc8_char)   \
+/* SCM_MAKE_CHAR maps signed chars (-128 to 127) and unsigned chars (0
+   to 255) to Latin-1 codepoints (0 to 255) while allowing higher
+   codepoints (256 to 1114111) to pass through unchanged.
+
+   This macro evaluates x twice, which may lead to side effects if not
+   used properly. */
+#define SCM_MAKE_CHAR(x)                                                \
+  ((x) <= 1                                                             \
+   ? SCM_MAKE_ITAG8 ((scm_t_bits) (unsigned char) (x), scm_tc8_char)    \
    : SCM_MAKE_ITAG8 ((scm_t_bits) (x), scm_tc8_char))
 
 #define SCM_CODEPOINT_MAX (0x10ffff)
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 1957d75..aa1fb33 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -95,7 +95,7 @@ scm_make_continuation (int *first)
 
   SCM_NEWSMOB (cont, scm_tc16_continuation, continuation);
 
-  *first = !setjmp (continuation->jmpbuf);
+  *first = !SCM_I_SETJMP (continuation->jmpbuf);
   if (*first)
     {
 #ifdef __ia64__
@@ -193,12 +193,12 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM 
val,
   scm_i_set_last_debug_frame (continuation->dframe);
 
   continuation->throw_value = val;
-  longjmp (continuation->jmpbuf, 1);
+  SCM_I_LONGJMP (continuation->jmpbuf, 1);
 }
 
 #ifdef __ia64__
 void
-scm_ia64_longjmp (jmp_buf *JB, int VAL)
+scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
 {
   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 
diff --git a/libguile/continuations.h b/libguile/continuations.h
index 08eec8f..82cf178 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -44,7 +44,7 @@ SCM_API scm_t_bits scm_tc16_continuation;
 typedef struct 
 {
   SCM throw_value;
-  jmp_buf jmpbuf;
+  scm_i_jmp_buf jmpbuf;
   SCM dynenv;
 #ifdef __ia64__
   void *backing_store;
diff --git a/libguile/conv-uinteger.i.c b/libguile/conv-uinteger.i.c
index ff0d280..52f49f7 100644
--- a/libguile/conv-uinteger.i.c
+++ b/libguile/conv-uinteger.i.c
@@ -53,10 +53,17 @@ SCM_TO_TYPE_PROTO (SCM val)
 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
              return n;
 #else
-             if (n >= TYPE_MIN && n <= TYPE_MAX)
-               return n;
-             else
-               goto out_of_range;
+
+#if TYPE_MIN == 0 
+              if (n <= TYPE_MAX)
+                return n;
+#else /* TYPE_MIN != 0 */
+              if (n >= TYPE_MIN && n <= TYPE_MAX)
+                return n;
+#endif /* TYPE_MIN != 0 */
+              else
+                goto out_of_range;
+
 #endif
            }
          else
@@ -76,10 +83,16 @@ SCM_TO_TYPE_PROTO (SCM val)
          
          mpz_export (&n, &count, 1, sizeof (TYPE), 0, 0, SCM_I_BIG_MPZ (val));
 
+#if TYPE_MIN == 0
+         if (n <= TYPE_MAX)
+           return n;
+#else /* TYPE_MIN != 0 */
          if (n >= TYPE_MIN && n <= TYPE_MAX)
            return n;
-         else
-           goto out_of_range;
+#endif /* TYPE_MIN != 0 */
+          else
+            goto out_of_range;
+
        }
     }
   else
diff --git a/libguile/convert.c b/libguile/convert.c
deleted file mode 100644
index d87d724..0000000
--- a/libguile/convert.c
+++ /dev/null
@@ -1,147 +0,0 @@
-/* Copyright (C) 2002, 2006 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 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 "libguile/_scm.h"
-#include "libguile/validate.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/pairs.h"
-#include "libguile/unif.h"
-#include "libguile/srfi-4.h"
-
-#include "libguile/convert.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-
-/* char *scm_c_scm2chars (SCM obj, char *dst);
-   SCM   scm_c_chars2scm (const char *src, long n);
-   SCM   scm_c_chars2byvect (const char *src, long n);
-*/
-
-#define CTYPE            char
-#define FROM_CTYPE       scm_from_char
-#define SCM2CTYPES       scm_c_scm2chars
-#define CTYPES2SCM       scm_c_chars2scm
-#define CTYPES2UVECT     scm_c_chars2byvect
-#if CHAR_MIN == 0
-/* 'char' is unsigned. */
-#define UVEC_TAG         u8
-#define UVEC_CTYPE       scm_t_uint8
-#else
-/* 'char' is signed. */
-#define UVEC_TAG         s8
-#define UVEC_CTYPE       scm_t_int8
-#endif
-#include "libguile/convert.i.c"
-
-/* short *scm_c_scm2shorts (SCM obj, short *dst);
-   SCM scm_c_shorts2scm (const short *src, long n);
-   SCM scm_c_shorts2svect (const short *src, long n);
-*/
-
-#define CTYPE            short
-#define FROM_CTYPE       scm_from_short
-#define SCM2CTYPES       scm_c_scm2shorts
-#define CTYPES2SCM       scm_c_shorts2scm
-#define CTYPES2UVECT     scm_c_shorts2svect
-#define UVEC_TAG         s16
-#define UVEC_CTYPE       scm_t_int16
-#include "libguile/convert.i.c"
-
-/* int *scm_c_scm2ints (SCM obj, int *dst);
-   SCM scm_c_ints2scm (const int *src, long n);
-   SCM scm_c_ints2ivect (const int *src, long n);
-   SCM scm_c_uints2uvect (const unsigned int *src, long n);
-*/
-
-#define CTYPE            int
-#define FROM_CTYPE       scm_from_int
-#define SCM2CTYPES       scm_c_scm2ints
-#define CTYPES2SCM       scm_c_ints2scm
-#define CTYPES2UVECT     scm_c_ints2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_uints2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* long *scm_c_scm2longs (SCM obj, long *dst);
-   SCM scm_c_longs2scm (const long *src, long n);
-   SCM scm_c_longs2ivect (const long *src, long n);
-   SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-*/
-
-#define CTYPE            long
-#define FROM_CTYPE       scm_from_long
-#define SCM2CTYPES       scm_c_scm2longs
-#define CTYPES2SCM       scm_c_longs2scm
-#define CTYPES2UVECT     scm_c_longs2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_ulongs2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* float *scm_c_scm2floats (SCM obj, float *dst);
-   SCM scm_c_floats2scm (const float *src, long n);
-   SCM scm_c_floats2fvect (const float *src, long n);
-*/
-
-#define CTYPE            float
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2floats
-#define CTYPES2SCM       scm_c_floats2scm
-#define CTYPES2UVECT     scm_c_floats2fvect
-#define UVEC_TAG         f32
-#define UVEC_CTYPE       float
-#include "libguile/convert.i.c"
-
-/* double *scm_c_scm2doubles (SCM obj, double *dst);
-   SCM scm_c_doubles2scm (const double *src, long n);
-   SCM scm_c_doubles2dvect (const double *src, long n);
-*/
-
-#define CTYPE            double
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2doubles
-#define CTYPES2SCM       scm_c_doubles2scm
-#define CTYPES2UVECT     scm_c_doubles2dvect
-#define UVEC_TAG         f64
-#define UVEC_CTYPE       double
-#include "libguile/convert.i.c"
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/convert.h b/libguile/convert.h
deleted file mode 100644
index 6ce7c22..0000000
--- a/libguile/convert.h
+++ /dev/null
@@ -1,51 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_CONVERT_H
-#define SCM_CONVERT_H
-
-/* Copyright (C) 2002, 2006 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 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
- */
-
-
-
-#include "libguile/__scm.h"
-
-SCM_API char *scm_c_scm2chars (SCM obj, char *dst);
-SCM_API short *scm_c_scm2shorts (SCM obj, short *dst);
-SCM_API int *scm_c_scm2ints (SCM obj, int *dst);
-SCM_API long *scm_c_scm2longs (SCM obj, long *dst);
-SCM_API float *scm_c_scm2floats (SCM obj, float *dst);
-SCM_API double *scm_c_scm2doubles (SCM obj, double *dst);
-
-SCM_API SCM scm_c_chars2scm (const char *src, long n);
-SCM_API SCM scm_c_shorts2scm (const short *src, long n);
-SCM_API SCM scm_c_ints2scm (const int *src, long n);
-SCM_API SCM scm_c_longs2scm (const long *src, long n);
-SCM_API SCM scm_c_floats2scm (const float *src, long n);
-SCM_API SCM scm_c_doubles2scm (const double *src, long n);
-
-SCM_API SCM scm_c_chars2byvect (const char *src, long n);
-SCM_API SCM scm_c_shorts2svect (const short *src, long n);
-SCM_API SCM scm_c_ints2ivect (const int *src, long n);
-SCM_API SCM scm_c_uints2uvect (const unsigned int *src, long n);
-SCM_API SCM scm_c_longs2ivect (const long *src, long n);
-SCM_API SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-SCM_API SCM scm_c_floats2fvect (const float *src, long n);
-SCM_API SCM scm_c_doubles2dvect (const double *src, long n);
-
-#endif /* SCM_CONVERT_H */
diff --git a/libguile/convert.i.c b/libguile/convert.i.c
deleted file mode 100644
index 4e73bf9..0000000
--- a/libguile/convert.i.c
+++ /dev/null
@@ -1,171 +0,0 @@
-/* this file is #include'd (x times) by convert.c */
-
-/* You need to define the following macros before including this
-   template.  They are undefined at the end of this file to give a
-   clean slate for the next inclusion.
-
-   - CTYPE
-
-   The type of an element of the C array, for example 'char'.
-
-   - FROM_CTYPE
-
-   The function that converts a CTYPE to a SCM, for example
-   scm_from_char.
-
-   - UVEC_TAG
-
-   The tag of a suitable uniform vector that can hold the CTYPE, for
-   example 's8'.
-
-   - UVEC_CTYPE
-
-   The C type of an element of the uniform vector, for example
-   scm_t_int8.
-
-   - SCM2CTYPES
-
-   The name of the 'SCM-to-C' function, for example scm_c_scm2chars.
-
-   - CTYPES2SCM
-
-   The name of the 'C-to-SCM' function, for example, scm_c_chars2scm.
-
-   - CTYPES2UVECT
-
-   The name of the 'C-to-uniform-vector' function, for example
-   scm_c_chars2byvect.  It will create a uniform vector of kind
-   UVEC_TAG.
-
-   - CTYPES2UVECT_2
-
-   The name of a second 'C-to-uniform-vector' function.  Leave
-   undefined if you want only one such function.
-
-   - CTYPE_2
-   - UVEC_TAG_2
-   - UVEC_CTYPE_2
-
-   The tag and C type of the second kind of uniform vector, for use
-   with the function described above.
-
-*/
-
-/* The first level does not expand macros in the arguments. */
-#define paste(a1,a2,a3)   a1##a2##a3
-#define stringify(a)      #a
-
-/* But the second level does. */
-#define F(pre,T,suf)   paste(pre,T,suf)
-#define S(T)           stringify(T)
-
-/* Convert a vector, list or uniform vector into a C array.  If the
-   result array in argument 2 is NULL, malloc() a new one.
-*/
-
-CTYPE *
-SCM2CTYPES (SCM obj, CTYPE *data)
-{
-  scm_t_array_handle handle;
-  size_t i, len;
-  ssize_t inc;
-  const UVEC_CTYPE *uvec_elements;
-
-  obj = F(scm_any_to_,UVEC_TAG,vector) (obj);
-  uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj, &handle, &len, &inc);
-
-  if (data == NULL)
-    data = scm_malloc (len * sizeof (CTYPE));
-  for (i = 0; i < len; i++, uvec_elements += inc)
-    data[i] = uvec_elements[i];
-
-  scm_array_handle_release (&handle);
-
-  return data;
-}
-
-/* Converts a C array into a vector. */
-
-SCM
-CTYPES2SCM (const CTYPE *data, long n)
-{
-  long i;
-  SCM v;
-  
-  v = scm_c_make_vector (n, SCM_UNSPECIFIED);
-
-  for (i = 0; i < n; i++)
-    SCM_SIMPLE_VECTOR_SET (v, i, FROM_CTYPE (data[i]));
-
-  return v;
-}
-
-/* Converts a C array into a uniform vector. */
-
-SCM
-CTYPES2UVECT (const CTYPE *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec, &handle,
-                                                            NULL, NULL);
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#ifdef CTYPE2UVECT_2
-
-SCM
-CTYPES2UVECT_2 (const CTYPE_2 *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE_2 *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG_2,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG_2,vector_writable_elements) (uvec, &handle,
-                                                              NULL, NULL);
-
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#endif
-
-#undef paste
-#undef stringify
-#undef F
-#undef S
-
-#undef CTYPE
-#undef FROM_CTYPE
-#undef UVEC_TAG
-#undef UVEC_CTYPE
-#undef SCM2CTYPES
-#undef CTYPES2SCM
-#undef CTYPES2UVECT
-#ifdef CTYPES2UVECT_2
-#undef CTYPES2UVECT_2
-#undef CTYPE_2
-#undef UVEC_TAG_2
-#undef UVEC_CTYPE_2
-#endif
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/debug.c b/libguile/debug.c
index a214332..5b42ddd 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -363,6 +363,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 
0,
     if (!SCM_SMOB_DESCRIPTOR (proc).apply)
       break;
   case scm_tcs_subrs:
+  case scm_tc7_program:
   procprop:
     /* It would indeed be a nice thing if we supplied source even for
        built in procedures! */
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 57a2f06..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
@@ -34,6 +34,7 @@
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
 #include "libguile/modules.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/eval.h"
 #include "libguile/smob.h"
 #include "libguile/procprop.h"
@@ -749,17 +750,13 @@ scm_sym2ovcell (SCM sym, SCM obarray)
    return (SYMBOL . SCM_UNDEFINED).  */
 
 
-SCM 
-scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int 
softness)
+static SCM 
+intern_obarray_soft (SCM symbol, SCM obarray, unsigned int softness)
 {
-  SCM symbol = scm_from_locale_symboln (name, len);
   size_t raw_hash = scm_i_symbol_hash (symbol);
   size_t hash;
   SCM lsym;
 
-  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
-                                  "Use hashtables instead.");
-
   if (scm_is_false (obarray))
     {
       if (softness)
@@ -795,6 +792,18 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM 
obarray,unsigned int so
 }
 
 
+SCM 
+scm_intern_obarray_soft (const char *name, size_t len, SCM obarray,
+                         unsigned int softness)
+{
+  SCM symbol = scm_from_locale_symboln (name, len);
+
+  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
+                                  "Use hashtables instead.");
+
+  return intern_obarray_soft (symbol, obarray, softness);
+}
+  
 SCM
 scm_intern_obarray (const char *name,size_t len,SCM obarray)
 {
@@ -850,10 +859,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, 
"string->obarray-symbol", 2, 1, 0,
   else if (scm_is_eq (o, SCM_BOOL_T))
     o = SCM_BOOL_F;
     
-  vcell = scm_intern_obarray_soft (scm_i_string_chars (s),
-                                  scm_i_string_length (s),
-                                  o,
-                                  softness);
+  vcell = intern_obarray_soft (scm_string_to_symbol (s), o, softness);
   if (scm_is_false (vcell))
     return vcell;
   answer = SCM_CAR (vcell);
@@ -1070,7 +1076,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
 {
   char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
   char *name = buf;
-  int len, n_digits;
+  int n_digits;
+  size_t len;
 
   scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
                                   "Use `gensym' instead.");
@@ -1084,9 +1091,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
     {
       SCM_VALIDATE_STRING (1, prefix);
       len = scm_i_string_length (prefix);
-      if (len > MAX_PREFIX_LENGTH)
-       name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
-      strncpy (name, scm_i_string_chars (prefix), len);
+      name = scm_to_locale_stringn (prefix, &len);
+      name = scm_realloc (name, len + SCM_INTBUFLEN);
     }
 
   if (SCM_UNBNDP (obarray))
@@ -1108,7 +1114,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
                                         obarray,
                                         0);
     if (name != buf)
-      scm_must_free (name);
+      free (name);
     return SCM_CAR (vcell);
   }
 }
@@ -1309,7 +1315,7 @@ scm_i_arrayp (SCM a)
 {
   scm_c_issue_deprecation_warning
     ("SCM_ARRAYP is deprecated.  Use scm_is_array instead.");
-  return SCM_I_ARRAYP(a) || SCM_I_ENCLOSED_ARRAYP(a);
+  return SCM_I_ARRAYP(a);
 }
 
 size_t
@@ -1497,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 68eddb3..f428f7d 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -24,6 +24,7 @@
  */
 
 #include "libguile/__scm.h"
+#include "libguile/arrays.h"
 #include "libguile/strings.h"
 
 #if (SCM_ENABLE_DEPRECATED == 1)
@@ -582,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/discouraged.c b/libguile/discouraged.c
index 357cac8..2621428 100644
--- a/libguile/discouraged.c
+++ b/libguile/discouraged.c
@@ -265,7 +265,7 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, 
"make-keyword-from-dash-symbol",
   SCM dash_string, non_dash_symbol;
 
   SCM_ASSERT (scm_is_symbol (symbol)
-             && ('-' == scm_i_symbol_chars(symbol)[0]),
+             && (scm_i_symbol_ref (symbol, 0) == '-'),
              symbol, SCM_ARG1, FUNC_NAME);
 
   dash_string = scm_symbol_to_string (symbol);
diff --git a/libguile/eq.c b/libguile/eq.c
index 255c381..11dee27 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 2006 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2003, 2004, 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
@@ -22,13 +22,13 @@
 #endif
 
 #include "libguile/_scm.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/stackchk.h"
 #include "libguile/strorder.h"
 #include "libguile/async.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/vectors.h"
 
 #include "libguile/struct.h"
diff --git a/libguile/error.c b/libguile/error.c
index eb513a7..bcbcd9c 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -233,6 +233,19 @@ scm_wrong_type_arg (const char *subr, int pos, SCM 
bad_value)
 }
 
 void
+scm_i_wrong_type_arg_symbol (SCM symbol, int pos, SCM bad_value)
+{
+  scm_error_scm (scm_arg_type_key,
+                scm_symbol_to_string (symbol),
+                (pos == 0) ? scm_from_locale_string ("Wrong type: ~S")
+                : scm_from_locale_string ("Wrong type argument in position ~A: 
~S"),
+                (pos == 0) ? scm_list_1 (bad_value)
+                : scm_list_2 (scm_from_int (pos), bad_value),
+                scm_list_1 (bad_value));
+  scm_remember_upto_here_2 (symbol, bad_value);
+}
+
+void
 scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char 
*szMessage)
 {
   SCM msg = scm_from_locale_string (szMessage);
diff --git a/libguile/error.h b/libguile/error.h
index c777a7f..8cc68b7 100644
--- a/libguile/error.h
+++ b/libguile/error.h
@@ -53,6 +53,8 @@ SCM_API void scm_wrong_num_args (SCM proc) SCM_NORETURN;
 SCM_API void scm_error_num_args_subr (const char* subr) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg (const char *subr, int pos,
                                 SCM bad_value) SCM_NORETURN;
+SCM_INTERNAL void scm_i_wrong_type_arg_symbol (SCM symbol, int pos,
+                                              SCM bad_value) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos,
                                     SCM bad_value, const char *sz) 
SCM_NORETURN;
 SCM_API void scm_memory_error (const char *subr) SCM_NORETURN;
diff --git a/libguile/eval.c b/libguile/eval.c
index 445c61f..59db429 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3328,6 +3328,7 @@ scm_trampoline_0 (SCM proc)
     case scm_tc7_rpsubr:
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_0;
       break;
     default:
@@ -3380,8 +3381,7 @@ call_dsubr_1 (SCM proc, SCM arg1)
     {
       return (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double 
(arg1))));
     }
-  SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                     SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
+  SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
 }
 
 static SCM
@@ -3454,6 +3454,7 @@ scm_trampoline_1 (SCM proc)
     case scm_tc7_rpsubr:
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_1;
       break;
     default:
@@ -3548,6 +3549,7 @@ scm_trampoline_2 (SCM proc)
       break;
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_2;
       break;
     default:
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 99aa265..25abf6c 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -1132,6 +1132,8 @@ dispatch:
        RETURN (SCM_BOOL_T);
       case scm_tc7_asubr:
        RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED));
+      case scm_tc7_program:
+        RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
       case scm_tc7_smob:
        if (!SCM_SMOB_APPLICABLE_P (proc))
          goto badfun;
@@ -1236,13 +1238,13 @@ dispatch:
              {
                 RETURN (scm_from_double (SCM_DSUBRF (proc) 
(scm_i_fraction2double (arg1))));
              }
-           SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                                SCM_ARG1,
-                               scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
+           SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
          case scm_tc7_cxr:
            RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)));
          case scm_tc7_rpsubr:
            RETURN (SCM_BOOL_T);
+          case scm_tc7_program:
+            RETURN (scm_c_vm_run (scm_the_vm (), proc, &arg1, 1));
          case scm_tc7_asubr:
            RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED));
          case scm_tc7_lsubr:
@@ -1353,6 +1355,12 @@ dispatch:
          case scm_tc7_rpsubr:
          case scm_tc7_asubr:
            RETURN (SCM_SUBRF (proc) (arg1, arg2));
+          case scm_tc7_program:
+            { SCM args[2];
+              args[0] = arg1;
+              args[1] = arg2;
+              RETURN (scm_c_vm_run (scm_the_vm (), proc, args, 2));
+            }
          case scm_tc7_smob:
            if (!SCM_SMOB_APPLICABLE_P (proc))
              goto badfun;
@@ -1492,6 +1500,8 @@ dispatch:
                                    SCM_CDDR (debug.info->a.args)));
        case scm_tc7_gsubr:
          RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args));
+        case scm_tc7_program:
+          RETURN (scm_vm_apply (scm_the_vm (), proc, debug.info->a.args));
        case scm_tc7_pws:
          proc = SCM_PROCEDURE (proc);
          debug.info->a.proc = proc;
@@ -1563,6 +1573,11 @@ dispatch:
                                            scm_cons2 (arg1, arg2,
                                                       scm_ceval_args (x, env,
                                                                       proc))));
+        case scm_tc7_program:
+          RETURN (scm_vm_apply
+                  (scm_the_vm (), proc,
+                   scm_cons (arg1, scm_cons (arg2,
+                                             scm_ceval_args (x, env, proc)))));
        case scm_tc7_pws:
          proc = SCM_PROCEDURE (proc);
          if (!SCM_CLOSUREP (proc))
@@ -1764,8 +1779,7 @@ tail:
        {
          RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double 
(arg1))));
        }
-      SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                          SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
+      SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
     case scm_tc7_cxr:
       if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args)))
        scm_wrong_num_args (proc);
@@ -1798,6 +1812,11 @@ tail:
          args = SCM_CDR (args);
        }
       RETURN (arg1);
+    case scm_tc7_program:
+      if (SCM_UNBNDP (arg1))
+        RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
+      else
+        RETURN (scm_vm_apply (scm_the_vm (), proc, scm_cons (arg1, args)));
     case scm_tc7_rpsubr:
       if (scm_is_null (args))
        RETURN (SCM_BOOL_T);
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 19d8f2e..b1f185c 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -82,6 +82,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 
0,
        case scm_tc7_string:
        case scm_tc7_smob:
        case scm_tc7_pws:
+       case scm_tc7_program:
        case scm_tcs_subrs:
        case scm_tcs_struct:
          return SCM_BOOL_T;
diff --git a/libguile/extensions.c b/libguile/extensions.c
index 54351dd..d01e9c6 100644
--- a/libguile/extensions.c
+++ b/libguile/extensions.c
@@ -1,6 +1,6 @@
 /* extensions.c - registering and loading extensions.
  *
- * Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 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
@@ -41,7 +41,7 @@ typedef struct extension_t
   void *data;
 } extension_t;
 
-static extension_t *registered_extensions;
+static extension_t *registered_extensions = NULL;
 
 /* Register a LIB/INIT pair for use by `scm_load_extension'.  LIB is
    allowed to be NULL and then only INIT is used to identify the
@@ -157,7 +157,6 @@ SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
 void
 scm_init_extensions ()
 {
-  registered_extensions = NULL;
 #include "libguile/extensions.x"
 }
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index a2db699..c602f67 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1573,31 +1573,39 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
            "component, @code{.} is returned.")
 #define FUNC_NAME s_scm_dirname
 {
-  const char *s;
   long int i;
   unsigned long int len;
 
   SCM_VALIDATE_STRING (1, filename);
 
-  s = scm_i_string_chars (filename);
   len = scm_i_string_length (filename);
 
   i = len - 1;
 #ifdef __MINGW32__
-  while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
-  while (i >= 0 && (s[i] != '/' && s[i] != '\\')) --i;
-  while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+                   || scm_i_string_ref (filename, i) == '\\')) 
+    --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
+                   && scm_i_string_ref (filename, i) != '\\')) 
+    --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+                   || scm_i_string_ref (filename, i) == '\\')) 
+    --i;
 #else
-  while (i >= 0 && s[i] == '/') --i;
-  while (i >= 0 && s[i] != '/') --i;
-  while (i >= 0 && s[i] == '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/') 
+    --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) != '/') 
+    --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/') 
+    --i;
 #endif /* ndef __MINGW32__ */
   if (i < 0)
     {
 #ifdef __MINGW32__
-      if (len > 0 && (s[0] == '/' || s[0] == '\\'))
+      if (len > 0 && (scm_i_string_ref (filename, 0) == '/'
+                     || scm_i_string_ref (filename, 0) == '\\'))
 #else
-      if (len > 0 && s[0] == '/')
+      if (len > 0 && scm_i_string_ref (filename, 0) == '/')
 #endif /* ndef __MINGW32__ */
        return scm_c_substring (filename, 0, 1);
       else
@@ -1616,11 +1624,9 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
            "@var{basename}, it is removed also.")
 #define FUNC_NAME s_scm_basename
 {
-  const char *f, *s = 0;
   int i, j, len, end;
 
   SCM_VALIDATE_STRING (1, filename);
-  f = scm_i_string_chars (filename);
   len = scm_i_string_length (filename);
 
   if (SCM_UNBNDP (suffix))
@@ -1628,32 +1634,44 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
   else
     {
       SCM_VALIDATE_STRING (2, suffix);
-      s = scm_i_string_chars (suffix);
       j = scm_i_string_length (suffix) - 1;
     }
   i = len - 1;
 #ifdef __MINGW32__
-  while (i >= 0 && (f[i] == '/' || f[i] == '\\')) --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+                   || scm_i_string_ref (filename, i) ==  '\\'))
+    --i;
 #else
-  while (i >= 0 && f[i] == '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+    --i;
 #endif /* ndef __MINGW32__ */
   end = i;
-  while (i >= 0 && j >= 0 && f[i] == s[j]) --i, --j;
+  while (i >= 0 && j >= 0 
+        && (scm_i_string_ref (filename, i)
+            == scm_i_string_ref (suffix, j)))
+    {
+      --i;
+      --j;
+    }
   if (j == -1)
     end = i;
 #ifdef __MINGW32__
-  while (i >= 0 && f[i] != '/' && f[i] != '\\') --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
+                   && scm_i_string_ref (filename, i) != '\\'))
+    --i;
 #else
-  while (i >= 0 && f[i] != '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) != '/')
+    --i;
 #endif /* ndef __MINGW32__ */
   if (i == end)
     {
 #ifdef __MINGW32__
-      if (len > 0 && (f[0] == '/' || f[0] == '\\'))
+      if (len > 0 && (scm_i_string_ref (filename, 0) ==  '/'
+                     || scm_i_string_ref (filename, 0) ==  '\\'))
 #else
-      if (len > 0 && f[0] == '/')
+      if (len > 0 && scm_i_string_ref (filename, 0) == '/')
 #endif /* ndef __MINGW32__ */
-       return scm_c_substring (filename, 0, 1);
+        return scm_c_substring (filename, 0, 1);
       else
        return scm_dot_string;
     }
diff --git a/libguile/fports.c b/libguile/fports.c
index 00a7278..5d37495 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -594,7 +594,7 @@ static void fport_flush (SCM port);
 
 /* fill a port's read-buffer with a single read.  returns the first
    char or EOF if end of file.  */
-static int
+static scm_t_wchar
 fport_fill_input (SCM port)
 {
   long count;
@@ -608,7 +608,7 @@ fport_fill_input (SCM port)
   if (count == -1)
     scm_syserror ("fport_fill_input");
   if (count == 0)
-    return EOF;
+    return (scm_t_wchar) EOF;
   else
     {
       pt->read_pos = pt->read_buf;
diff --git a/libguile/frames.c b/libguile/frames.c
index caa95f7..a6835fb 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -33,7 +33,7 @@ scm_t_bits scm_tc16_vm_frame;
 
 SCM
 scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
-                     scm_byte_t *ip, scm_t_ptrdiff offset)
+                     scm_t_uint8 *ip, scm_t_ptrdiff offset)
 {
   struct scm_vm_frame *p = scm_gc_malloc (sizeof (struct scm_vm_frame),
                                           "vmframe");
@@ -98,12 +98,12 @@ SCM_DEFINE (scm_vm_frame_arguments, "vm-frame-arguments", 
1, 0, 0,
   if (!bp->nargs)
     return SCM_EOL;
   else if (bp->nrest)
-    ret = fp[bp->nargs - 1];
+    ret = SCM_FRAME_VARIABLE (fp, bp->nargs - 1);
   else
-    ret = scm_cons (fp[bp->nargs - 1], SCM_EOL);
+    ret = scm_cons (SCM_FRAME_VARIABLE (fp, bp->nargs - 1), SCM_EOL);
   
   for (i = bp->nargs - 2; i >= 0; i--)
-    ret = scm_cons (fp[i], ret);
+    ret = scm_cons (SCM_FRAME_VARIABLE (fp, i), ret);
   
   return ret;
 }
diff --git a/libguile/frames.h b/libguile/frames.h
index 1b3153a..0165924 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -30,39 +30,46 @@
 /* VM Frame Layout
    ---------------
 
-   |                  | <- fp + bp->nargs + bp->nlocs + 3
-   +------------------+    = SCM_FRAME_UPPER_ADDRESS (fp)
-   | Return address   |
-   | MV return address|
-   | Dynamic link     | <- fp + bp->nargs + bp->blocs
-   | Local variable 1 |    = SCM_FRAME_DATA_ADDRESS (fp)
+   | ...              |
+   | Intermed. val. 0 | <- fp + bp->nargs + bp->nlocs = 
SCM_FRAME_UPPER_ADDRESS (fp)
+   +==================+
+   | Local variable 1 |
    | Local variable 0 | <- fp + bp->nargs
    | Argument 1       |
    | Argument 0       | <- fp
    | Program          | <- fp - 1
-   +------------------+    = SCM_FRAME_LOWER_ADDRESS (fp)
+   +------------------+    
+   | Return address   |
+   | MV return address|
+   | Dynamic link     | <- fp - 4 = SCM_FRAME_DATA_ADDRESS (fp) = 
SCM_FRAME_LOWER_ADDRESS (fp)
+   +==================+
    |                  |
 
    As can be inferred from this drawing, it is assumed that
    `sizeof (SCM *) == sizeof (SCM)', since pointers (the `link' parts) are
    assumed to be as long as SCM objects.  */
 
-#define SCM_FRAME_DATA_ADDRESS(fp)                             \
-  (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs       \
-      + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
-#define SCM_FRAME_UPPER_ADDRESS(fp)    (SCM_FRAME_DATA_ADDRESS (fp) + 3)
-#define SCM_FRAME_LOWER_ADDRESS(fp)    (fp - 1)
+#define SCM_FRAME_DATA_ADDRESS(fp)     (fp - 4)
+#define SCM_FRAME_UPPER_ADDRESS(fp)                             \
+  (fp                                                           \
+   + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs           \
+   + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
+#define SCM_FRAME_LOWER_ADDRESS(fp)    (fp - 4)
 
-#define SCM_FRAME_BYTE_CAST(x)         ((scm_byte_t *) SCM_UNPACK (x))
+#define SCM_FRAME_BYTE_CAST(x)         ((scm_t_uint8 *) SCM_UNPACK (x))
 #define SCM_FRAME_STACK_CAST(x)                ((SCM *) SCM_UNPACK (x))
 
 #define SCM_FRAME_RETURN_ADDRESS(fp)                           \
   (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
+#define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra)                   \
+  ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = (SCM)(ra);
 #define SCM_FRAME_MV_RETURN_ADDRESS(fp)                                \
   (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
+#define SCM_FRAME_SET_MV_RETURN_ADDRESS(fp, mvra)              \
+  ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(mvra);
 #define SCM_FRAME_DYNAMIC_LINK(fp)                             \
   (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0]))
-#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl)             \
+#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl)                     \
   ((SCM_FRAME_DATA_ADDRESS (fp)[0])) = (SCM)(dl);
 #define SCM_FRAME_VARIABLE(fp,i)       fp[i]
 #define SCM_FRAME_PROGRAM(fp)          fp[-1]
@@ -79,7 +86,7 @@ struct scm_vm_frame
   SCM stack_holder;
   SCM *fp;
   SCM *sp;
-  scm_byte_t *ip;
+  scm_t_uint8 *ip;
   scm_t_ptrdiff offset;
 };
 
@@ -92,9 +99,8 @@ struct scm_vm_frame
 #define SCM_VM_FRAME_OFFSET(f) SCM_VM_FRAME_DATA(f)->offset
 #define SCM_VALIDATE_VM_FRAME(p,x)     SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
 
-/* FIXME rename scm_byte_t */
 SCM_API SCM scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
-                                scm_byte_t *ip, scm_t_ptrdiff offset);
+                                 scm_t_uint8 *ip, scm_t_ptrdiff offset);
 SCM_API SCM scm_vm_frame_p (SCM obj);
 SCM_API SCM scm_vm_frame_program (SCM frame);
 SCM_API SCM scm_vm_frame_arguments (SCM frame);
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 19d6878..e48d2cf 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 
2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 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
@@ -37,7 +37,7 @@ extern unsigned long * 
__libc_ia64_register_backing_store_base;
 #include "libguile/stackchk.h"
 #include "libguile/struct.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
@@ -78,25 +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)
-{
-  scm_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 (scm_mtrigger < 0)
-    scm_mtrigger = SCM_DEFAULT_INIT_MALLOC_LIMIT;
-}
-
 
 
 /* Function for non-cell memory management.
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.c b/libguile/gc.c
index 84d5ba8..d3c53c7 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -40,7 +40,7 @@ extern unsigned long * 
__libc_ia64_register_backing_store_base;
 #include "libguile/stackchk.h"
 #include "libguile/struct.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
@@ -208,17 +208,10 @@ 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_mallocated = 0;
 unsigned long scm_gc_ports_collected = 0;
 
-
 static unsigned long protected_obj_count = 0;
 
 
@@ -673,8 +666,6 @@ scm_init_storage ()
   while (j)
     scm_sys_protects[--j] = SCM_BOOL_F;
 
-  j = SCM_HEAP_SEG_SIZE;
-
 #if 0
   /* We can't have a cleanup handler since we have no thread to run it
      in. */
diff --git a/libguile/gc.h b/libguile/gc.h
index 63b7c4e..40dab2f 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -152,17 +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 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_mallocated;
 SCM_API unsigned long scm_gc_ports_collected;
-SCM_API unsigned long scm_mtrigger;
 
 SCM_API SCM scm_after_gc_hook;
 
@@ -172,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)
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
new file mode 100644
index 0000000..6394405
--- /dev/null
+++ b/libguile/generalized-arrays.c
@@ -0,0 +1,276 @@
+/* Copyright (C) 1995,1996,1997,1998,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 "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+
+
+int
+scm_is_array (SCM obj)
+{
+  return scm_i_array_implementation_for_obj (obj) ? 1 : 0;
+}
+
+SCM_DEFINE (scm_array_p, "array?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
+           "not.")
+#define FUNC_NAME s_scm_array_p
+{
+  return scm_from_bool (scm_is_array (obj));
+}
+#undef FUNC_NAME
+
+int
+scm_is_typed_array (SCM obj, SCM type)
+{
+  int ret = 0;
+  if (scm_i_array_implementation_for_obj (obj))
+    {
+      scm_t_array_handle h;
+
+      scm_array_get_handle (obj, &h);
+      ret = scm_is_eq (scm_array_handle_element_type (&h), type);
+      scm_array_handle_release (&h);
+    }
+
+  return ret;
+}
+
+SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
+           (SCM obj, SCM type),
+           "Return @code{#t} if the @var{obj} is an array of type\n"
+           "@var{type}, and @code{#f} if not.")
+#define FUNC_NAME s_scm_typed_array_p
+{
+  return scm_from_bool (scm_is_typed_array (obj, type));
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_array_rank (SCM array)
+{
+  scm_t_array_handle handle;
+  size_t res;
+
+  scm_array_get_handle (array, &handle);
+  res = scm_array_handle_rank (&handle);
+  scm_array_handle_release (&handle);
+  return res;
+}
+
+SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
+           (SCM array),
+           "Return the number of dimensions of the array @var{array.}\n")
+#define FUNC_NAME s_scm_array_rank
+{
+  return scm_from_size_t (scm_c_array_rank (array));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
+           (SCM ra),
+           "@code{array-dimensions} is similar to @code{array-shape} but 
replaces\n"
+           "elements with a @code{0} minimum with one greater than the 
maximum. So:\n"
+           "@lisp\n"
+           "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 
5)\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_array_dimensions
+{
+  scm_t_array_handle handle;
+  scm_t_array_dim *s;
+  SCM res = SCM_EOL;
+  size_t k;
+      
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  k = scm_array_handle_rank (&handle);
+
+  while (k--)
+    res = scm_cons (s[k].lbnd
+                   ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
+                                scm_from_ssize_t (s[k].ubnd),
+                                SCM_EOL)
+                   : scm_from_ssize_t (1 + s[k].ubnd),
+                   res);
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+/* HACK*/
+#include "libguile/bytevectors.h"
+
+SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
+           (SCM ra),
+           "")
+#define FUNC_NAME s_scm_array_type
+{
+  scm_t_array_handle h;
+  SCM type;
+
+  /* a hack, until srfi-4 and bytevectors are reunited */
+  if (scm_is_bytevector (ra))
+    return scm_from_locale_symbol ("vu8");
+
+  scm_array_get_handle (ra, &h);
+  type = scm_array_handle_element_type (&h);
+  scm_array_handle_release (&h);
+  
+  return type;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
+           (SCM ra, SCM args),
+           "Return @code{#t} if its arguments would be acceptable to\n"
+           "@code{array-ref}.")
+#define FUNC_NAME s_scm_array_in_bounds_p
+{
+  SCM res = SCM_BOOL_T;
+  size_t k, ndim;
+  scm_t_array_dim *s;
+  scm_t_array_handle handle;
+
+  SCM_VALIDATE_REST_ARGUMENT (args);
+
+  scm_array_get_handle (ra, &handle);
+  s = scm_array_handle_dims (&handle);
+  ndim = scm_array_handle_rank (&handle);
+
+  for (k = 0; k < ndim; k++)
+    {
+      long ind;
+
+      if (!scm_is_pair (args))
+        SCM_WRONG_NUM_ARGS ();
+      ind = scm_to_long (SCM_CAR (args));
+      args = SCM_CDR (args);
+
+      if (ind < s[k].lbnd || ind > s[k].ubnd)
+        {
+          res = SCM_BOOL_F;
+          /* We do not stop the checking after finding a violation
+             since we want to validate the type-correctness and
+             number of arguments in any case.
+          */
+        }
+    }
+
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
+           (SCM v, SCM args),
+           "Return the element at the @code{(index1, index2)} element in\n"
+           "@var{array}.")
+#define FUNC_NAME s_scm_array_ref
+{
+  scm_t_array_handle handle;
+  SCM res;
+
+  scm_array_get_handle (v, &handle);
+  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
+  scm_array_handle_release (&handle);
+  return res;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
+           (SCM v, SCM obj, SCM args),
+           "Set the element at the @code{(index1, index2)} element in 
@var{array} to\n"
+           "@var{new-value}.  The value returned by array-set! is 
unspecified.")
+#define FUNC_NAME s_scm_array_set_x           
+{
+  scm_t_array_handle handle;
+
+  scm_array_get_handle (v, &handle);
+  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
+  scm_array_handle_release (&handle);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static SCM 
+array_to_list (scm_t_array_handle *h, size_t dim, unsigned long pos)
+{
+  if (dim == scm_array_handle_rank (h))
+    return scm_array_handle_ref (h, pos);
+  else
+    {
+      SCM res = SCM_EOL;
+      long inc;
+      size_t i, lbnd;
+
+      i = h->dims[dim].ubnd;
+      lbnd = h->dims[dim].lbnd;
+      inc = h->dims[dim].inc;
+      pos += (i - h->dims[dim].ubnd) * inc;
+
+      for (; i >= lbnd; i--, pos -= inc)
+        res = scm_cons (array_to_list (h, dim + 1, pos), res);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
+            (SCM array),
+           "FIXME description a list consisting of all the elements, in order, 
of\n"
+           "@var{array}.")
+#define FUNC_NAME s_scm_array_to_list
+{
+  scm_t_array_handle h;
+  SCM res;  
+  
+  scm_array_get_handle (array, &h);
+  res = array_to_list (&h, 0, 0);
+  scm_array_handle_release (&h);
+
+  return res;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_arrays ()
+{
+#include "libguile/generalized-arrays.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
new file mode 100644
index 0000000..cc7214e
--- /dev/null
+++ b/libguile/generalized-arrays.h
@@ -0,0 +1,63 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_ARRAYS_H
+#define SCM_GENERALIZED_ARRAYS_H
+
+/* Copyright (C) 1995,1996,1997,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
+ * 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* These functions operate on all kinds of arrays that Guile knows about.
+ */
+
+
+/** Arrays */
+
+SCM_API int scm_is_array (SCM obj);
+SCM_API SCM scm_array_p (SCM v);
+
+SCM_API int scm_is_typed_array (SCM obj, SCM type);
+SCM_API SCM scm_typed_array_p (SCM v, SCM type);
+
+SCM_API size_t scm_c_array_rank (SCM ra);
+SCM_API SCM scm_array_rank (SCM ra);
+
+SCM_API SCM scm_array_dimensions (SCM ra);
+SCM_API SCM scm_array_type (SCM ra);
+SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
+
+SCM_API SCM scm_array_ref (SCM v, SCM args);
+SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
+SCM_API SCM scm_array_to_list (SCM v);
+
+SCM_INTERNAL void scm_init_generalized_arrays (void);
+
+
+#endif  /* SCM_GENERALIZED_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
new file mode 100644
index 0000000..2d437a4
--- /dev/null
+++ b/libguile/generalized-vectors.c
@@ -0,0 +1,201 @@
+/* Copyright (C) 1995,1996,1997,1998,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 "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
+
+
+struct scm_t_vector_ctor
+{
+  SCM tag;
+  SCM (*ctor)(SCM, SCM);
+};
+
+#define VECTOR_CTORS_N_STATIC_ALLOC 20
+static struct scm_t_vector_ctor vector_ctors[VECTOR_CTORS_N_STATIC_ALLOC];
+static int num_vector_ctors_registered = 0;
+
+void
+scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM))
+{
+  if (num_vector_ctors_registered >= VECTOR_CTORS_N_STATIC_ALLOC)
+    /* need to increase VECTOR_CTORS_N_STATIC_ALLOC, buster */
+    abort ();
+  else
+    { 
+      vector_ctors[num_vector_ctors_registered].tag = type;
+      vector_ctors[num_vector_ctors_registered].ctor = ctor;
+      num_vector_ctors_registered++;
+    }
+}
+
+SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0,
+            (SCM type, SCM len, SCM fill),
+            "Make a generalized vector")
+#define FUNC_NAME s_scm_make_generalized_vector
+{
+  int i;
+  for (i = 0; i < num_vector_ctors_registered; i++)
+    if (vector_ctors[i].tag == type)
+      return vector_ctors[i].ctor(len, fill);
+  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "array type");
+}
+#undef FUNC_NAME
+
+int
+scm_is_generalized_vector (SCM obj)
+{
+  int ret = 0;
+  if (scm_is_array (obj))
+    {
+      scm_t_array_handle h;
+      scm_array_get_handle (obj, &h);
+      ret = scm_array_handle_rank (&h) == 1;
+      scm_array_handle_release (&h);
+    }
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} if @var{obj} is a vector, string,\n"
+           "bitvector, or uniform numeric vector.")
+#define FUNC_NAME s_scm_generalized_vector_p
+{
+  return scm_from_bool (scm_is_generalized_vector (obj));
+}
+#undef FUNC_NAME
+
+#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
+  scm_generalized_vector_get_handle (val, handle)
+   
+
+void
+scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
+{
+  scm_array_get_handle (vec, h);
+  if (scm_array_handle_rank (h) != 1)
+    {
+      scm_array_handle_release (h);
+      scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
+    }
+}
+
+size_t
+scm_c_generalized_vector_length (SCM v)
+{
+  scm_t_array_handle h;
+  size_t ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 
0,
+           (SCM v),
+           "Return the length of the generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_length
+{
+  return scm_from_size_t (scm_c_generalized_vector_length (v));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_generalized_vector_ref (SCM v, size_t idx)
+{
+  scm_t_array_handle h;
+  SCM ret;
+  scm_generalized_vector_get_handle (v, &h);
+  ret = h.impl->vref (&h, idx);
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
+           (SCM v, SCM idx),
+           "Return the element at index @var{idx} of the\n"
+           "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_ref
+{
+  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
+{
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  h.impl->vset (&h, idx, val);
+  scm_array_handle_release (&h);
+}
+
+SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
+           (SCM v, SCM idx, SCM val),
+           "Set the element at index @var{idx} of the\n"
+           "generalized vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_generalized_vector_set_x
+{
+  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 
0,
+           (SCM v),
+           "Return a new list whose elements are the elements of the\n"
+           "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_to_list
+{
+  SCM ret = SCM_EOL;
+  ssize_t pos, i = 0;
+  scm_t_array_handle h;
+  scm_generalized_vector_get_handle (v, &h);
+  // FIXME CHECKME
+  for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
+       i >= 0;
+       pos += h.dims[0].inc)
+    ret = scm_cons (h.impl->vref (&h, pos), ret);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+void
+scm_init_generalized_vectors ()
+{
+#include "libguile/generalized-vectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
new file mode 100644
index 0000000..71b58d2
--- /dev/null
+++ b/libguile/generalized-vectors.h
@@ -0,0 +1,61 @@
+/* classes: h_files */
+
+#ifndef SCM_GENERALIZED_VECTORS_H
+#define SCM_GENERALIZED_VECTORS_H
+
+/* Copyright (C) 1995,1996,1997,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
+ * 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Generalized vectors */
+
+SCM_API SCM scm_generalized_vector_p (SCM v);
+SCM_API SCM scm_generalized_vector_length (SCM v);
+SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
+SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
+SCM_API SCM scm_generalized_vector_to_list (SCM v);
+
+SCM_API int scm_is_generalized_vector (SCM obj);
+SCM_API size_t scm_c_generalized_vector_length (SCM v);
+SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
+SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API void scm_generalized_vector_get_handle (SCM vec,
+                                               scm_t_array_handle *h);
+
+SCM_API SCM scm_make_generalized_vector (SCM type, SCM len, SCM fill);
+SCM_INTERNAL void scm_i_register_vector_constructor (SCM type, SCM 
(*ctor)(SCM, SCM));
+
+#define SCM_VECTOR_IMPLEMENTATION(type, ctor)                   \
+  SCM_SNARF_INIT (scm_i_register_vector_constructor             \
+                  (scm_i_array_element_types[type], ctor))
+
+SCM_INTERNAL void scm_init_generalized_vectors (void);
+
+#endif  /* SCM_GENERALIZED_VECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/goops.c b/libguile/goops.c
index 25b9571..4616fa2 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -176,6 +176,8 @@ static SCM scm_unbound_p (SCM obj);
 static SCM scm_assert_bound (SCM value, SCM obj);
 static SCM scm_at_assert_bound_ref (SCM obj, SCM index);
 static SCM scm_sys_goops_loaded (void);
+static SCM scm_make_extended_class_from_symbol (SCM type_name_sym, 
+                                               int applicablep);
 
 /* This function is used for efficient type dispatch.  */
 SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
@@ -241,6 +243,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
          else
            return scm_class_procedure;
        case scm_tc7_gsubr:
+       case scm_tc7_program:
          return scm_class_procedure;
        case scm_tc7_pws:
          return scm_class_procedure_with_setter;
@@ -280,9 +283,9 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
              else
                {
                  SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
-                 SCM class = scm_make_extended_class (scm_is_true (name)
-                                                      ? scm_i_symbol_chars 
(name)
-                                                      : 0,
+                 SCM class = scm_make_extended_class_from_symbol (scm_is_true 
(name)
+                                                      ? name
+                                                      : scm_nullstr,
                                                       SCM_I_OPERATORP (x));
                  SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
                  return class;
@@ -1523,11 +1526,11 @@ wrap_init (SCM class, SCM *m, long n)
 {
   long i;
   scm_t_bits slayout = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
-  const char *layout = scm_i_symbol_chars (SCM_PACK (slayout));
+  SCM layout = SCM_PACK (slayout);
 
   /* Set all SCM-holding slots to unbound */
   for (i = 0; i < n; i++)
-    if (layout[i*2] == 'p')
+    if (scm_i_symbol_ref (layout, i*2) == 'p')
       m[i] = SCM_GOOPS_UNBOUND;
     else
       m[i] = 0;
@@ -2682,6 +2685,34 @@ make_class_from_template (char const *template, char 
const *type_name, SCM super
   return class;
 }
 
+static SCM
+make_class_from_symbol (SCM type_name_sym, SCM supers, int applicablep)
+{
+  SCM class, name;
+  if (type_name_sym != SCM_BOOL_F)
+    {
+      name = scm_string_append (scm_list_3 (scm_from_locale_string ("<"),
+                                           scm_symbol_to_string 
(type_name_sym),
+                                           scm_from_locale_string (">")));
+      name = scm_string_to_symbol (name);
+    }
+  else
+    name = SCM_GOOPS_UNBOUND;
+
+  class = scm_permanent_object (scm_basic_make_class (applicablep
+                                                     ? 
scm_class_procedure_class
+                                                     : scm_class_class,
+                                                     name,
+                                                     supers,
+                                                     SCM_EOL));
+
+  /* Only define name if doesn't already exist. */
+  if (!SCM_GOOPS_UNBOUNDP (name)
+      && scm_is_false (scm_module_variable (scm_module_goops, name)))
+    DEFVAR (name, class);
+  return class;
+}
+
 SCM
 scm_make_extended_class (char const *type_name, int applicablep)
 {
@@ -2693,6 +2724,16 @@ scm_make_extended_class (char const *type_name, int 
applicablep)
                                   applicablep);
 }
 
+static SCM
+scm_make_extended_class_from_symbol (SCM type_name_sym, int applicablep)
+{
+  return make_class_from_symbol (type_name_sym,
+                                scm_list_1 (applicablep
+                                            ? scm_class_applicable
+                                            : scm_class_top),
+                                applicablep);
+}
+
 void
 scm_i_inherit_applicable (SCM c)
 {
@@ -2785,11 +2826,16 @@ static SCM
 make_struct_class (void *closure SCM_UNUSED,
                   SCM vtable, SCM data, SCM prev SCM_UNUSED)
 {
-  if (scm_is_true (SCM_STRUCT_TABLE_NAME (data)))
-    SCM_SET_STRUCT_TABLE_CLASS (data,
-                               scm_make_extended_class
-                               (scm_i_symbol_chars (SCM_STRUCT_TABLE_NAME 
(data)),
-                                SCM_CLASS_FLAGS (vtable) & 
SCM_CLASSF_OPERATOR));
+  SCM sym = SCM_STRUCT_TABLE_NAME (data);
+  if (scm_is_true (sym))
+    {
+      int applicablep = SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR;
+
+      SCM_SET_STRUCT_TABLE_CLASS (data, 
+                                 scm_make_extended_class_from_symbol (sym, 
applicablep));
+    }
+
+  scm_remember_upto_here_2 (data, vtable);
   return SCM_UNSPECIFIED;
 }
 
diff --git a/libguile/hash.c b/libguile/hash.c
index d2fe177..e6e38ba 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -50,6 +50,20 @@ scm_string_hash (const unsigned char *str, size_t len)
   return h;
 }
 
+unsigned long 
+scm_i_string_hash (SCM str)
+{
+  size_t len = scm_i_string_length (str);
+  size_t i = 0;
+
+  unsigned long h = 0;
+  while (len-- > 0)
+    h = (unsigned long) scm_i_string_ref (str, i++) + h * 37;
+
+  scm_remember_upto_here_1 (str);
+  return h;
+}
+
 
 /* Dirk:FIXME:: why downcase for characters? (2x: scm_hasher, scm_ihashv) */
 /* Dirk:FIXME:: scm_hasher could be made static. */
@@ -115,8 +129,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
     case scm_tc7_string:
       {
        unsigned long hash =
-         scm_string_hash ((const unsigned char *) scm_i_string_chars (obj),
-                          scm_i_string_length (obj)) % n;
+         scm_i_string_hash (obj) % n;
        scm_remember_upto_here_1 (obj);
        return hash;
       }
diff --git a/libguile/hash.h b/libguile/hash.h
index 789595b..2ebc053 100644
--- a/libguile/hash.h
+++ b/libguile/hash.h
@@ -28,6 +28,7 @@
 
 
 SCM_API unsigned long scm_string_hash (const unsigned char *str, size_t len);
+SCM_INTERNAL unsigned long scm_i_string_hash (SCM str);
 SCM_API unsigned long scm_hasher (SCM obj, unsigned long n, size_t d);
 SCM_API unsigned long scm_ihashq (SCM obj, unsigned long n);
 SCM_API SCM scm_hashq (SCM obj, SCM n);
diff --git a/libguile/init.c b/libguile/init.c
index dbb1324..940d515 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -37,6 +37,7 @@
 #include "libguile/arbiters.h"
 #include "libguile/async.h"
 #include "libguile/backtrace.h"
+#include "libguile/bitvectors.h"
 #include "libguile/boolean.h"
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
@@ -62,6 +63,8 @@
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/hash.h"
@@ -92,7 +95,7 @@
 #include "libguile/procprop.h"
 #include "libguile/procs.h"
 #include "libguile/properties.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/random.h"
 #include "libguile/rdelim.h"
 #include "libguile/read.h"
@@ -115,7 +118,7 @@
 #include "libguile/struct.h"
 #include "libguile/symbols.h"
 #include "libguile/throw.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"
 #include "libguile/vectors.h"
@@ -125,6 +128,7 @@
 #include "libguile/weaks.h"
 #include "libguile/guardians.h"
 #include "libguile/extensions.h"
+#include "libguile/uniform.h"
 #include "libguile/srfi-4.h"
 #include "libguile/discouraged.h"
 #include "libguile/deprecated.h"
@@ -519,7 +523,19 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_sort ();
   scm_init_srcprop ();
   scm_init_stackchk ();
-  scm_init_strings ();
+
+  scm_init_array_handle ();
+  scm_init_generalized_arrays ();
+  scm_init_generalized_vectors ();
+  scm_init_vectors ();
+  scm_init_uniform ();
+  scm_init_bitvectors ();
+  scm_bootstrap_bytevectors ();
+  scm_init_srfi_4 ();
+  scm_init_arrays ();
+  scm_init_array_map ();
+
+  scm_init_strings ();  /* Requires array-handle */
   scm_init_struct ();   /* Requires strings */
   scm_init_stacks ();   /* Requires strings, struct */
   scm_init_symbols ();
@@ -533,7 +549,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_srfi_13 ();
   scm_init_srfi_14 ();
   scm_init_throw ();
-  scm_init_vectors ();
   scm_init_version ();
   scm_init_weaks ();
   scm_init_guardians ();
@@ -542,8 +557,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_evalext ();
   scm_init_debug ();   /* Requires macro smobs */
   scm_init_random ();
-  scm_init_ramap ();
-  scm_init_unif ();
   scm_init_simpos ();
   scm_init_load_path ();
   scm_init_standard_ports ();  /* Requires fports */
@@ -552,7 +565,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_lang ();
 #endif /* SCM_ENABLE_ELISP */
   scm_init_script ();
-  scm_init_srfi_4 ();
 
   scm_init_goops ();
 
@@ -576,7 +588,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_rw ();
   scm_init_extensions ();
 
-  scm_bootstrap_bytevectors ();
   scm_bootstrap_vm ();
 
   atexit (cleanup_for_exit);
diff --git a/libguile/inline.h b/libguile/inline.h
index 09ee142..4943169 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -3,7 +3,7 @@
 #ifndef SCM_INLINE_H
 #define SCM_INLINE_H
 
-/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, 
Inc.
+/* Copyright (C) 2001, 2002, 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
@@ -34,8 +34,9 @@
 #include "libguile/pairs.h"
 #include "libguile/gc.h"
 #include "libguile/threads.h"
-#include "libguile/unif.h"
+#include "libguile/array-handle.h"
 #include "libguile/ports.h"
+#include "libguile/numbers.h"
 #include "libguile/error.h"
 
 
@@ -92,7 +93,7 @@ SCM_API void scm_array_handle_set (scm_t_array_handle *h, 
ssize_t pos, SCM val);
 
 SCM_API int scm_is_pair (SCM x);
 
-SCM_API int scm_getc (SCM port);
+SCM_API int scm_get_byte_or_eof (SCM port);
 SCM_API void scm_putc (char c, SCM port);
 SCM_API void scm_puts (const char *str_data, SCM port);
 
@@ -242,7 +243,11 @@ SCM_C_EXTERN_INLINE
 SCM
 scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
 {
-  return h->ref (h, p);
+  if (SCM_UNLIKELY (p < 0 && -p > h->base))
+    /* catch overflow */
+    scm_out_of_range (NULL, scm_from_ssize_t (p));
+  /* perhaps should catch overflow here too */
+  return h->impl->vref (h, h->base + p);
 }
 
 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
@@ -251,7 +256,11 @@ SCM_C_EXTERN_INLINE
 void
 scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
 {
-  h->set (h, p, v);
+  if (SCM_UNLIKELY (p < 0 && -p > h->base))
+    /* catch overflow */
+    scm_out_of_range (NULL, scm_from_ssize_t (p));
+  /* perhaps should catch overflow here too */
+  h->impl->vset (h, h->base + p, v);
 }
 
 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
@@ -291,7 +300,7 @@ scm_is_pair (SCM x)
 SCM_C_EXTERN_INLINE
 #endif
 int
-scm_getc (SCM port)
+scm_get_byte_or_eof (SCM port)
 {
   int c;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
@@ -311,27 +320,6 @@ scm_getc (SCM port)
 
   c = *(pt->read_pos++);
 
-  switch (c)
-    {
-      case '\a':
-        break;
-      case '\b':
-        SCM_DECCOL (port);
-        break;
-      case '\n':
-        SCM_INCLINE (port);
-        break;
-      case '\r':
-        SCM_ZEROCOL (port);
-        break;
-      case '\t':
-        SCM_TABCOL (port);
-        break;
-      default:
-        SCM_INCCOL (port);
-        break;
-    }
-
   return c;
 }
 
diff --git a/libguile/load.c b/libguile/load.c
index 5056789..fa25b0f 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -85,6 +85,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
 #define FUNC_NAME s_scm_primitive_load
 {
   SCM hook = *scm_loc_load_hook;
+  char *encoding;
   SCM_VALIDATE_STRING (1, filename);
   if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
     SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
@@ -97,7 +98,15 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
     SCM port = scm_open_file (filename, scm_from_locale_string ("r"));
     scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
     scm_i_dynwind_current_load_port (port);
-
+    encoding = scm_scan_for_encoding (port);
+    if (encoding)
+      {
+       scm_i_set_port_encoding_x (port, encoding);
+       free (encoding);
+      }
+    else
+      /* The file has no encoding declaraed.  We'll presume Latin-1.  */
+      scm_i_set_port_encoding_x (port, NULL);
     while (1)
       {
        SCM reader, form;
@@ -257,7 +266,7 @@ scm_init_load_path ()
     "guile/ccache/" SCM_EFFECTIVE_VERSION "-" 
SCM_OBJCODE_MACHINE_VERSION_STRING
 
     if ((e = getenv ("XDG_CACHE_HOME")))
-      snprintf (cachedir, sizeof(cachedir), "%s" FALLBACK_DIR, e);
+      snprintf (cachedir, sizeof(cachedir), "%s/" FALLBACK_DIR, e);
     else if ((e = getenv ("HOME")))
       snprintf (cachedir, sizeof(cachedir), "%s/.cache/" FALLBACK_DIR, e);
 #ifdef HAVE_GETPWENT
@@ -639,13 +648,11 @@ autocompile_catch_handler (void *data, SCM tag, SCM 
throw_args)
   return SCM_BOOL_F;
 }
 
-static SCM
-scm_try_autocompile (SCM source)
+SCM_DEFINE (scm_sys_warn_autocompilation_enabled, 
"%warn-autocompilation-enabled", 0, 0, 0,
+           (void), "")
+#define FUNC_NAME s_scm_sys_warn_autocompilation_enabled
 {
   static int message_shown = 0;
-  
-  if (scm_is_false (*scm_loc_load_should_autocompile))
-    return SCM_BOOL_F;
 
   if (!message_shown)
     {
@@ -655,6 +662,17 @@ scm_try_autocompile (SCM source)
       message_shown = 1;
     }
 
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static SCM
+scm_try_autocompile (SCM source)
+{
+  if (scm_is_false (*scm_loc_load_should_autocompile))
+    return SCM_BOOL_F;
+
+  scm_sys_warn_autocompilation_enabled ();
   return scm_c_catch (SCM_BOOL_T,
                       do_try_autocompile,
                       SCM2PTR (source),
diff --git a/libguile/load.h b/libguile/load.h
index d5bc1b0..1a1a865 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -36,6 +36,7 @@ SCM_API SCM scm_search_path (SCM path, SCM filename, SCM 
exts, SCM require_exts)
 SCM_API SCM scm_sys_search_load_path (SCM filename);
 SCM_API SCM scm_primitive_load_path (SCM filename, SCM exception_on_not_found);
 SCM_API SCM scm_c_primitive_load_path (const char *filename);
+SCM_INTERNAL SCM scm_sys_warn_autocompilation_enabled (void);
 SCM_INTERNAL void scm_init_load_path (void);
 SCM_INTERNAL void scm_init_load (void);
 
diff --git a/libguile/numbers.c b/libguile/numbers.c
index ec40039..20fda02 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -46,8 +46,9 @@
 #endif
 
 #include <math.h>
-#include <ctype.h>
 #include <string.h>
+#include <unicase.h>
+#include <unictype.h>
 
 #if HAVE_COMPLEX_H
 #include <complex.h>
@@ -2437,7 +2438,7 @@ scm_i_print_fraction (SCM sexp, SCM port, scm_print_state 
*pstate SCM_UNUSED)
 {
   SCM str;
   str = scm_number_to_string (sexp, SCM_UNDEFINED);
-  scm_lfwrite (scm_i_string_chars (str), scm_i_string_length (str), port);
+  scm_lfwrite_str (str, port);
   scm_remember_upto_here_1 (str);
   return !0;
 }
@@ -2484,13 +2485,13 @@ enum t_exactness {NO_EXACTNESS, INEXACT, EXACT};
 /* R5RS, section 7.1.1, lexical structure of numbers: <uinteger R>. */
 
 /* In non ASCII-style encodings the following macro might not work. */
-#define XDIGIT2UINT(d)                                  \
-  (isdigit ((int) (unsigned char) d)                    \
-   ? (d) - '0'                                          \
-   : tolower ((int) (unsigned char) d) - 'a' + 10)
+#define XDIGIT2UINT(d)                                                  \
+  (uc_is_property_decimal_digit ((int) (unsigned char) d)               \
+   ? (d) - '0'                                                          \
+   : uc_tolower ((int) (unsigned char) d) - 'a' + 10)
 
 static SCM
-mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
+mem2uinteger (SCM mem, unsigned int *p_idx,
              unsigned int radix, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
@@ -2500,12 +2501,13 @@ mem2uinteger (const char* mem, size_t len, unsigned int 
*p_idx,
   unsigned int digit_value;
   SCM result;
   char c;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return SCM_BOOL_F;
 
-  c = mem[idx];
-  if (!isxdigit ((int) (unsigned char) c))
+  c = scm_i_string_ref (mem, idx);
+  if (!uc_is_property_ascii_hex_digit ((scm_t_uint32) c))
     return SCM_BOOL_F;
   digit_value = XDIGIT2UINT (c);
   if (digit_value >= radix)
@@ -2515,8 +2517,8 @@ mem2uinteger (const char* mem, size_t len, unsigned int 
*p_idx,
   result = SCM_I_MAKINUM (digit_value);
   while (idx != len)
     {
-      char c = mem[idx];
-      if (isxdigit ((int) (unsigned char) c))
+      scm_t_wchar c = scm_i_string_ref (mem, idx);
+      if (uc_is_property_ascii_hex_digit ((scm_t_uint32) c))
        {
          if (hash_seen)
            break;
@@ -2569,20 +2571,20 @@ mem2uinteger (const char* mem, size_t len, unsigned int 
*p_idx,
  * has already been seen in the digits before the point.
  */
 
-/* In non ASCII-style encodings the following macro might not work. */
-#define DIGIT2UINT(d) ((d) - '0')
+#define DIGIT2UINT(d) (uc_numeric_value(d).numerator)
 
 static SCM
-mem2decimal_from_point (SCM result, const char* mem, size_t len, 
+mem2decimal_from_point (SCM result, SCM mem, 
                        unsigned int *p_idx, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
   enum t_exactness x = *p_exactness;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return result;
 
-  if (mem[idx] == '.')
+  if (scm_i_string_ref (mem, idx) == '.')
     {
       scm_t_bits shift = 1;
       scm_t_bits add = 0;
@@ -2592,8 +2594,8 @@ mem2decimal_from_point (SCM result, const char* mem, 
size_t len,
       idx++;
       while (idx != len)
        {
-         char c = mem[idx];
-         if (isdigit ((int) (unsigned char) c))
+         scm_t_wchar c = scm_i_string_ref (mem, idx);
+         if (uc_is_property_decimal_digit ((scm_t_uint32) c))
            {
              if (x == INEXACT)
                return SCM_BOOL_F;
@@ -2643,13 +2645,13 @@ mem2decimal_from_point (SCM result, const char* mem, 
size_t len,
     {
       int sign = 1;
       unsigned int start;
-      char c;
+      scm_t_wchar c;
       int exponent;
       SCM e;
 
       /* R5RS, section 7.1.1, lexical structure of numbers: <suffix> */
 
-      switch (mem[idx])
+      switch (scm_i_string_ref (mem, idx))
        {
        case 'd': case 'D':
        case 'e': case 'E':
@@ -2661,7 +2663,7 @@ mem2decimal_from_point (SCM result, const char* mem, 
size_t len,
             return SCM_BOOL_F;
 
          start = idx;
-         c = mem[idx];
+         c = scm_i_string_ref (mem, idx);
          if (c == '-')
            {
              idx++;
@@ -2669,7 +2671,7 @@ mem2decimal_from_point (SCM result, const char* mem, 
size_t len,
                 return SCM_BOOL_F;
 
              sign = -1;
-             c = mem[idx];
+             c = scm_i_string_ref (mem, idx);
            }
          else if (c == '+')
            {
@@ -2678,20 +2680,20 @@ mem2decimal_from_point (SCM result, const char* mem, 
size_t len,
                 return SCM_BOOL_F;
 
              sign = 1;
-             c = mem[idx];
+             c = scm_i_string_ref (mem, idx);
            }
          else
            sign = 1;
 
-         if (!isdigit ((int) (unsigned char) c))
+         if (!uc_is_property_decimal_digit ((scm_t_uint32) c))
            return SCM_BOOL_F;
 
          idx++;
          exponent = DIGIT2UINT (c);
          while (idx != len)
            {
-             char c = mem[idx];
-             if (isdigit ((int) (unsigned char) c))
+             scm_t_wchar c = scm_i_string_ref (mem, idx);
+             if (uc_is_property_decimal_digit ((scm_t_uint32) c))
                {
                  idx++;
                  if (exponent <= SCM_MAXEXP)
@@ -2704,7 +2706,7 @@ mem2decimal_from_point (SCM result, const char* mem, 
size_t len,
          if (exponent > SCM_MAXEXP)
            {
              size_t exp_len = idx - start;
-             SCM exp_string = scm_from_locale_stringn (&mem[start], exp_len);
+             SCM exp_string = scm_i_substring_copy (mem, start, start + 
exp_len);
              SCM exp_num = scm_string_to_number (exp_string, SCM_UNDEFINED);
              scm_out_of_range ("string->number", exp_num);
            }
@@ -2736,11 +2738,12 @@ mem2decimal_from_point (SCM result, const char* mem, 
size_t len,
 /* R5RS, section 7.1.1, lexical structure of numbers: <ureal R> */
 
 static SCM
-mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
+mem2ureal (SCM mem, unsigned int *p_idx,
           unsigned int radix, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
   SCM result;
+  size_t len = scm_i_string_length (mem);
 
   /* Start off believing that the number will be exact.  This changes
      to INEXACT if we see a decimal point or a hash. */
@@ -2749,45 +2752,45 @@ mem2ureal (const char* mem, size_t len, unsigned int 
*p_idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  if (idx+5 <= len && !strncmp (mem+idx, "inf.0", 5))
+  if (idx+5 <= len && !scm_i_string_strcmp (mem, idx, "inf.0"))
     {
       *p_idx = idx+5;
       return scm_inf ();
     }
 
-  if (idx+4 < len && !strncmp (mem+idx, "nan.", 4))
+  if (idx+4 < len && !scm_i_string_strcmp (mem, idx, "nan."))
     {
       /* Cobble up the fractional part.  We might want to set the
         NaN's mantissa from it. */
       idx += 4;
-      mem2uinteger (mem, len, &idx, 10, &x);
+      mem2uinteger (mem, &idx, 10, &x);
       *p_idx = idx;
       return scm_nan ();
     }
 
-  if (mem[idx] == '.')
+  if (scm_i_string_ref (mem, idx) == '.')
     {
       if (radix != 10)
        return SCM_BOOL_F;
       else if (idx + 1 == len)
        return SCM_BOOL_F;
-      else if (!isdigit ((int) (unsigned char) mem[idx + 1]))
+      else if (!uc_is_property_decimal_digit ((scm_t_uint32) scm_i_string_ref 
(mem, idx+1)))
        return SCM_BOOL_F;
       else
-       result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem, len,
+       result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem,
                                         p_idx, &x);
     }
   else
     {
       SCM uinteger;
 
-      uinteger = mem2uinteger (mem, len, &idx, radix, &x);
+      uinteger = mem2uinteger (mem, &idx, radix, &x);
       if (scm_is_false (uinteger))
        return SCM_BOOL_F;
 
       if (idx == len)
        result = uinteger;
-      else if (mem[idx] == '/')
+      else if (scm_i_string_ref (mem, idx) == '/')
        {
          SCM divisor;
 
@@ -2795,7 +2798,7 @@ mem2ureal (const char* mem, size_t len, unsigned int 
*p_idx,
           if (idx == len)
             return SCM_BOOL_F;
 
-          divisor = mem2uinteger (mem, len, &idx, radix, &x);
+         divisor = mem2uinteger (mem, &idx, radix, &x);
          if (scm_is_false (divisor))
            return SCM_BOOL_F;
 
@@ -2804,7 +2807,7 @@ mem2ureal (const char* mem, size_t len, unsigned int 
*p_idx,
        }
       else if (radix == 10)
        {
-         result = mem2decimal_from_point (uinteger, mem, len, &idx, &x);
+         result = mem2decimal_from_point (uinteger, mem, &idx, &x);
          if (scm_is_false (result))
            return SCM_BOOL_F;
        }
@@ -2835,17 +2838,18 @@ mem2ureal (const char* mem, size_t len, unsigned int 
*p_idx,
 /* R5RS, section 7.1.1, lexical structure of numbers: <complex R> */
 
 static SCM
-mem2complex (const char* mem, size_t len, unsigned int idx,
+mem2complex (SCM mem, unsigned int idx,
             unsigned int radix, enum t_exactness *p_exactness)
 {
-  char c;
+  scm_t_wchar c;
   int sign = 0;
   SCM ureal;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return SCM_BOOL_F;
 
-  c = mem[idx];
+  c = scm_i_string_ref (mem, idx);
   if (c == '+')
     {
       idx++;
@@ -2860,7 +2864,7 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  ureal = mem2ureal (mem, len, &idx, radix, p_exactness);
+  ureal = mem2ureal (mem, &idx, radix, p_exactness);
   if (scm_is_false (ureal))
     {
       /* input must be either +i or -i */
@@ -2868,7 +2872,8 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
       if (sign == 0)
        return SCM_BOOL_F;
 
-      if (mem[idx] == 'i' || mem[idx] == 'I')
+      if (scm_i_string_ref (mem, idx) == 'i'
+         || scm_i_string_ref (mem, idx) == 'I')
        {
          idx++;
          if (idx != len)
@@ -2887,7 +2892,7 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
       if (idx == len)
        return ureal;
 
-      c = mem[idx];
+      c = scm_i_string_ref (mem, idx);
       switch (c)
        {
        case 'i': case 'I':
@@ -2912,7 +2917,7 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
              SCM angle;
              SCM result;
 
-             c = mem[idx];
+             c = scm_i_string_ref (mem, idx);
              if (c == '+')
                {
                  idx++;
@@ -2930,7 +2935,7 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
              else
                sign = 1;
 
-             angle = mem2ureal (mem, len, &idx, radix, p_exactness);
+             angle = mem2ureal (mem, &idx, radix, p_exactness);
              if (scm_is_false (angle))
                return SCM_BOOL_F;
              if (idx != len)
@@ -2952,7 +2957,7 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
          else
            {
              int sign = (c == '+') ? 1 : -1;
-             SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness);
+             SCM imag = mem2ureal (mem, &idx, radix, p_exactness);
 
              if (scm_is_false (imag))
                imag = SCM_I_MAKINUM (sign);
@@ -2961,7 +2966,8 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
 
              if (idx == len)
                return SCM_BOOL_F;
-             if (mem[idx] != 'i' && mem[idx] != 'I')
+             if (scm_i_string_ref (mem, idx) != 'i'
+                 && scm_i_string_ref (mem, idx) != 'I')
                return SCM_BOOL_F;
 
              idx++;
@@ -2982,19 +2988,19 @@ mem2complex (const char* mem, size_t len, unsigned int 
idx,
 enum t_radix {NO_RADIX=0, DUAL=2, OCT=8, DEC=10, HEX=16};
 
 SCM
-scm_c_locale_stringn_to_number (const char* mem, size_t len,
-                               unsigned int default_radix)
+scm_i_string_to_number (SCM mem, unsigned int default_radix)
 {
   unsigned int idx = 0;
   unsigned int radix = NO_RADIX;
   enum t_exactness forced_x = NO_EXACTNESS;
   enum t_exactness implicit_x = EXACT;
   SCM result;
+  size_t len = scm_i_string_length (mem);
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <prefix R> */
-  while (idx + 2 < len && mem[idx] == '#')
+  while (idx + 2 < len && scm_i_string_ref (mem, idx) == '#')
     {
-      switch (mem[idx + 1])
+      switch (scm_i_string_ref (mem, idx + 1))
        {
        case 'b': case 'B':
          if (radix != NO_RADIX)
@@ -3034,9 +3040,9 @@ scm_c_locale_stringn_to_number (const char* mem, size_t 
len,
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <complex R> */
   if (radix == NO_RADIX)
-    result = mem2complex (mem, len, idx, default_radix, &implicit_x);
+    result = mem2complex (mem, idx, default_radix, &implicit_x);
   else
-    result = mem2complex (mem, len, idx, (unsigned int) radix, &implicit_x);
+    result = mem2complex (mem, idx, (unsigned int) radix, &implicit_x);
 
   if (scm_is_false (result))
     return SCM_BOOL_F;
@@ -3067,6 +3073,15 @@ scm_c_locale_stringn_to_number (const char* mem, size_t 
len,
     }
 }
 
+SCM
+scm_c_locale_stringn_to_number (const char* mem, size_t len,
+                               unsigned int default_radix)
+{
+  SCM str = scm_from_locale_stringn (mem, len);
+
+  return scm_i_string_to_number (str, default_radix);
+}
+
 
 SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
             (SCM string, SCM radix),
@@ -3089,9 +3104,7 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 
0,
   else
     base = scm_to_unsigned_integer (radix, 2, INT_MAX);
 
-  answer = scm_c_locale_stringn_to_number (scm_i_string_chars (string),
-                                          scm_i_string_length (string),
-                                          base);
+  answer = scm_i_string_to_number (string, base);
   scm_remember_upto_here_1 (string);
   return answer;
 }
diff --git a/libguile/numbers.h b/libguile/numbers.h
index bb72d7a..9597afb 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -28,6 +28,11 @@
 #include "libguile/__scm.h"
 #include "libguile/print.h"
 
+#ifndef SCM_T_WCHAR_DEFINED
+typedef scm_t_int32 scm_t_wchar;
+#define SCM_T_WCHAR_DEFINED
+#endif /* SCM_T_WCHAR_DEFINED */
+
 #if SCM_HAVE_FLOATINGPOINT_H
 # include <floatingpoint.h>
 #endif
@@ -174,7 +179,6 @@ typedef struct scm_t_complex
   double imag;
 } scm_t_complex;
 
-typedef scm_t_int32 scm_t_wchar;
 
 
 
@@ -212,6 +216,7 @@ SCM_API int scm_print_complex (SCM sexp, SCM port, 
scm_print_state *pstate);
 SCM_API int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
 SCM_API SCM scm_c_locale_stringn_to_number (const char *mem, size_t len,
                                            unsigned int radix);
+SCM_INTERNAL SCM scm_i_string_to_number (SCM str, unsigned int radix);
 SCM_API SCM scm_string_to_number (SCM str, SCM radix);
 SCM_API SCM scm_bigequal (SCM x, SCM y);
 SCM_API SCM scm_real_equalp (SCM x, SCM y);
diff --git a/libguile/ports.c b/libguile/ports.c
index 2d0e26b..e3d2b0d 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -30,6 +30,9 @@
 #include <errno.h>
 #include <fcntl.h>  /* for chsize on mingw */
 #include <assert.h>
+#include <uniconv.h>
+#include <unistr.h>
+#include <striconveh.h>
 
 #include <assert.h>
 
@@ -53,6 +56,7 @@
 #include "libguile/vectors.h"
 #include "libguile/weaks.h"
 #include "libguile/fluids.h"
+#include "libguile/eq.h"
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -358,10 +362,10 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
 
 /* Standard ports --- current input, output, error, and more(!).  */
 
-static SCM cur_inport_fluid;
-static SCM cur_outport_fluid;
-static SCM cur_errport_fluid;
-static SCM cur_loadport_fluid;
+static SCM cur_inport_fluid = 0;
+static SCM cur_outport_fluid = 0;
+static SCM cur_errport_fluid = 0;
+static SCM cur_loadport_fluid = 0;
 
 SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0,
            (),
@@ -370,7 +374,10 @@ SCM_DEFINE (scm_current_input_port, "current-input-port", 
0, 0, 0,
            "returns the @dfn{standard input} in Unix and C terminology.")
 #define FUNC_NAME s_scm_current_input_port
 {
-  return scm_fluid_ref (cur_inport_fluid);
+  if (cur_inport_fluid)
+    return scm_fluid_ref (cur_inport_fluid);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -382,7 +389,10 @@ SCM_DEFINE (scm_current_output_port, 
"current-output-port", 0, 0, 0,
            "Unix and C terminology.")
 #define FUNC_NAME s_scm_current_output_port
 {
-  return scm_fluid_ref (cur_outport_fluid);
+  if (cur_outport_fluid)
+    return scm_fluid_ref (cur_outport_fluid);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -392,7 +402,10 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 
0, 0, 0,
            "@dfn{standard error} in Unix and C terminology).")
 #define FUNC_NAME s_scm_current_error_port
 {
-  return scm_fluid_ref (cur_errport_fluid);
+  if (cur_errport_fluid)
+    return scm_fluid_ref (cur_errport_fluid);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -570,10 +583,18 @@ scm_new_port_table_entry (scm_t_bits tag)
   
   SCM z = scm_cons (SCM_EOL, SCM_EOL);
   scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), 
"port");
+  const char *enc;
 
   entry->file_name = SCM_BOOL_F;
   entry->rw_active = SCM_PORT_NEITHER;
   entry->port = z;
+  /* Initialize this port with the thread's current default
+     encoding.  */
+  if ((enc = scm_i_get_port_encoding (SCM_BOOL_F)) == NULL)
+    entry->encoding = NULL;
+  else
+    entry->encoding = strdup (enc);
+  entry->ilseq_handler = scm_i_get_conversion_strategy (SCM_BOOL_F);
 
   SCM_SET_CELL_TYPE (z, tag);
   SCM_SETPTAB_ENTRY (z, entry);
@@ -614,6 +635,11 @@ scm_i_remove_port (SCM port)
   scm_t_port *p = SCM_PTAB_ENTRY (port);
   if (p->putback_buf)
     scm_gc_free (p->putback_buf, p->putback_buf_size, "putback buffer");
+  if (p->encoding)
+    {
+      free (p->encoding);
+      p->encoding = NULL;
+    }
   scm_gc_free (p, sizeof (scm_t_port), "port");
 
   SCM_SETPTAB_ENTRY (port, 0);
@@ -697,21 +723,22 @@ SCM_DEFINE (scm_set_port_revealed_x, 
"set-port-revealed!", 2, 0, 0,
  */
 
 static long
-scm_i_mode_bits_n (const char *modes, size_t n)
+scm_i_mode_bits_n (SCM modes)
 {
   return (SCM_OPN
-         | (memchr (modes, 'r', n) || memchr (modes, '+', n) ? SCM_RDNG : 0)
-         | (   memchr (modes, 'w', n)
-            || memchr (modes, 'a', n)
-            || memchr (modes, '+', n) ? SCM_WRTNG : 0)
-         | (memchr (modes, '0', n) ? SCM_BUF0 : 0)
-         | (memchr (modes, 'l', n) ? SCM_BUFLINE : 0));
+         | (scm_i_string_contains_char (modes, 'r') 
+            || scm_i_string_contains_char (modes, '+') ? SCM_RDNG : 0)
+         | (scm_i_string_contains_char (modes, 'w')
+            || scm_i_string_contains_char (modes, 'a')
+            || scm_i_string_contains_char (modes, '+') ? SCM_WRTNG : 0)
+         | (scm_i_string_contains_char (modes, '0') ? SCM_BUF0 : 0)
+         | (scm_i_string_contains_char (modes, 'l') ? SCM_BUFLINE : 0));
 }
 
 long
 scm_mode_bits (char *modes)
 {
-  return scm_i_mode_bits_n (modes, strlen (modes));
+  return scm_i_mode_bits (scm_from_locale_string (modes));
 }
 
 long
@@ -722,8 +749,7 @@ scm_i_mode_bits (SCM modes)
   if (!scm_is_string (modes))
     scm_wrong_type_arg_msg (NULL, 0, modes, "string");
 
-  bits = scm_i_mode_bits_n (scm_i_string_chars (modes),
-                           scm_i_string_length (modes));
+  bits = scm_i_mode_bits_n (modes);
   scm_remember_upto_here_1 (modes);
   return bits;
 }
@@ -994,7 +1020,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
            "characters are available, the end-of-file object is returned.")
 #define FUNC_NAME s_scm_read_char
 {
-  int c;
+  scm_t_wchar c;
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   SCM_VALIDATE_OPINPORT (1, port);
@@ -1005,6 +1031,133 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+#define SCM_MBCHAR_BUF_SIZE (4)
+
+/* Get one codepoint from a file, using the port's encoding.  */
+scm_t_wchar
+scm_getc (SCM port)
+{
+  int c;
+  unsigned int bufcount = 0;
+  char buf[SCM_MBCHAR_BUF_SIZE];
+  scm_t_wchar codepoint = 0;
+  scm_t_uint32 *u32;
+  size_t u32len;
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+  c = scm_get_byte_or_eof (port);
+  if (c == EOF)
+    return (scm_t_wchar) EOF;
+
+  buf[0] = c;
+  bufcount++;
+
+  if (pt->encoding == NULL)
+    { 
+      /* The encoding is Latin-1: bytes are characters.  */
+      codepoint = (unsigned char) buf[0];
+      goto success;
+    }
+
+  for (;;)
+    {
+      u32 = u32_conv_from_encoding (pt->encoding, 
+                                    (enum iconv_ilseq_handler) 
pt->ilseq_handler, 
+                                   buf, bufcount, NULL, NULL, &u32len);
+      if (u32 == NULL || u32len == 0)
+       {
+         if (errno == ENOMEM)
+           scm_memory_error ("Input decoding");
+          
+         /* Otherwise errno is EILSEQ or EINVAL, so perhaps more
+             bytes are needed.  Keep looping.  */
+       }
+      else 
+       {
+         /* Complete codepoint found. */
+         codepoint = u32[0];
+         free (u32);
+         goto success;
+       }
+
+      if (bufcount == SCM_MBCHAR_BUF_SIZE)
+       {
+         /* We've read several bytes and didn't find a good
+            codepoint.  Give up.  */
+         goto failure;
+       }
+
+      c = scm_get_byte_or_eof (port);
+
+      if (c == EOF)
+       {
+         /* EOF before a complete character was read.  Push it all
+            back and return EOF. */
+         while (bufcount > 0)
+           {
+             /* FIXME: this will probably cause errors in the port column. */
+             scm_unget_byte (buf[bufcount-1], port);
+             bufcount --;
+           }
+          return EOF;
+       }
+      
+      if (c == '\n')
+       {
+          /* It is always invalid to have EOL in the middle of a
+             multibyte character.  */
+         scm_unget_byte ('\n', port);
+         goto failure;
+       }
+       
+      buf[bufcount++] = c;
+    }
+
+ success:
+  switch (codepoint)
+    {
+    case '\a':
+      break;
+    case '\b':
+      SCM_DECCOL (port);
+      break;
+    case '\n':
+      SCM_INCLINE (port);
+        break;
+    case '\r':
+      SCM_ZEROCOL (port);
+      break;
+    case '\t':
+      SCM_TABCOL (port);
+      break;
+    default:
+      SCM_INCCOL (port);
+      break;
+    }
+
+  return codepoint;
+
+ failure:
+  {
+    char *err_buf;
+    SCM err_str = scm_i_make_string (bufcount, &err_buf);
+    memcpy (err_buf, buf, bufcount);
+
+    if (errno == EILSEQ)
+      scm_misc_error (NULL, "input encoding error for ~s: ~s",
+                     scm_list_2 (scm_from_locale_string 
(scm_i_get_port_encoding (port)),
+                                 err_str));
+    else
+      scm_misc_error (NULL, "input encoding error (invalid) for ~s: ~s\n", 
+                     scm_list_2 (scm_from_locale_string 
(scm_i_get_port_encoding (port)),
+                                 err_str));
+  }
+
+  /* Never gets here.  */
+  return 0;
+}
+
+
 /* this should only be called when the read buffer is empty.  it
    tries to refill the read buffer.  it returns the first char from
    the port, which is either EOF or *(pt->read_pos).  */
@@ -1088,8 +1241,11 @@ scm_lfwrite_substr (SCM str, size_t start, size_t end, 
SCM port)
     end = size;
   size = end - start;
 
+  /* Note that making a substring will likely take the
+     stringbuf_write_mutex.  So, one shouldn't use scm_lfwrite_substr
+     if the stringbuf write mutex may still be held elsewhere.  */
   buf = scm_to_stringn (scm_c_substring (str, start, end), &len,
-                       NULL, SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
+                       pt->encoding, pt->ilseq_handler);
   ptob->write (port, buf, len);
   free (buf);
 
@@ -1107,7 +1263,29 @@ scm_lfwrite_substr (SCM str, size_t start, size_t end, 
SCM port)
 void
 scm_lfwrite_str (SCM str, SCM port)
 {
-  scm_lfwrite_substr (str, 0, (size_t) (-1), port);
+  size_t i, size = scm_i_string_length (str);
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
+  scm_t_wchar p;
+  char *buf;
+  size_t len;
+
+  if (pt->rw_active == SCM_PORT_READ)
+    scm_end_input (port);
+
+  buf = scm_to_stringn (str, &len,
+                       pt->encoding, pt->ilseq_handler);
+  ptob->write (port, buf, len);
+  free (buf);
+
+  for (i = 0; i < size; i++)
+    {
+      p = scm_i_string_ref (str, i);
+      update_port_lf (p, port);
+    }
+
+  if (pt->rw_random)
+    pt->rw_active = SCM_PORT_WRITE;
 }
 
 /* scm_c_read
@@ -1298,8 +1476,8 @@ scm_end_input (SCM port)
 
 
 void 
-scm_ungetc (int c, SCM port)
-#define FUNC_NAME "scm_ungetc"
+scm_unget_byte (int c, SCM port)
+#define FUNC_NAME "scm_unget_byte"
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
@@ -1360,6 +1538,25 @@ scm_ungetc (int c, SCM port)
 
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_READ;
+}
+#undef FUNC_NAME
+
+void 
+scm_ungetc (scm_t_wchar c, SCM port)
+#define FUNC_NAME "scm_ungetc"
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_wchar *wbuf;
+  SCM str = scm_i_make_wide_string (1, &wbuf);
+  char *buf;
+  size_t len;
+  int i;
+
+  wbuf[0] = c;
+  buf = scm_to_stringn (str, &len, pt->encoding, pt->ilseq_handler);
+    
+  for (i = len - 1; i >= 0; i--)
+    scm_unget_byte (buf[i], port);
 
   if (c == '\n')
     {
@@ -1406,7 +1603,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
            "to @code{read-char} would have hung.")
 #define FUNC_NAME s_scm_peek_char
 {
-  int c, column;
+  scm_t_wchar c, column;
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   else
@@ -1452,13 +1649,17 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
            "@var{port} is not supplied, the current-input-port is used.")
 #define FUNC_NAME s_scm_unread_string
 {
+  int n;
   SCM_VALIDATE_STRING (1, str);
   if (SCM_UNBNDP (port))
     port = scm_current_input_port ();
   else
     SCM_VALIDATE_OPINPORT (2, port);
 
-  scm_ungets (scm_i_string_chars (str), scm_i_string_length (str), port);
+  n = scm_i_string_length (str);
+
+  while (n--)
+    scm_ungetc (scm_i_string_ref (str, n), port);
   
   return str;
 }
@@ -1713,6 +1914,328 @@ SCM_DEFINE (scm_set_port_filename_x, 
"set-port-filename!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+/* The default port encoding for this locale. New ports will have this
+   encoding.  If it is a string, that is the encoding.  If it #f, it
+   is in the native (Latin-1) encoding.  */
+SCM_GLOBAL_VARIABLE (scm_port_encoding_var, "%port-encoding");
+static int scm_port_encoding_init = 0;
+
+/* Return a C string representation of the current encoding.  */
+const char *
+scm_i_get_port_encoding (SCM port)
+{
+  SCM encoding;
+  
+  if (scm_is_false (port))
+    {
+      if (!scm_port_encoding_init)
+       return NULL;
+      else if (!scm_is_fluid (SCM_VARIABLE_REF (scm_port_encoding_var)))
+       return NULL;
+      else
+       {
+         encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_port_encoding_var));
+         if (!scm_is_string (encoding))
+           return NULL;
+         else
+           return scm_i_string_chars (encoding);
+       }
+    }
+  else
+    {
+      scm_t_port *pt;
+      pt = SCM_PTAB_ENTRY (port);
+      if (pt->encoding)
+       return pt->encoding;
+      else
+       return NULL;
+    }
+}
+
+/* Returns ENC is if is a recognized encoding.  If it isn't, it tries
+   to find an alias of ENC that is valid.  Otherwise, it returns
+   NULL.  */
+static const char *
+find_valid_encoding (const char *enc)
+{
+  int isvalid = 0;
+  const char str[] = " ";
+  scm_t_uint32 *u32;
+  size_t u32len;
+    
+  u32 = u32_conv_from_encoding (enc, iconveh_error, str, 1,
+                                NULL, NULL, &u32len);
+  isvalid = (u32 != NULL);
+  free (u32);
+    
+  if (isvalid)
+    return enc;
+
+  return NULL;
+}
+
+void
+scm_i_set_port_encoding_x (SCM port, const char *enc)
+{
+  const char *valid_enc;
+  scm_t_port *pt;
+
+  /* Null is shorthand for the native, Latin-1 encoding.  */
+  if (enc == NULL)
+    valid_enc = NULL;
+  else
+    {
+      valid_enc = find_valid_encoding (enc);
+      if (valid_enc == NULL)
+        {
+          SCM err;
+          err = scm_from_locale_string (enc);
+          scm_misc_error (NULL, "invalid or unknown character encoding ~s",
+                          scm_list_1 (err));
+        }
+    }
+
+  if (scm_is_false (port))
+    {
+      /* Set the default encoding for future ports.  */
+      if (!scm_port_encoding_init
+         || !scm_is_fluid (SCM_VARIABLE_REF (scm_port_encoding_var)))
+       scm_misc_error (NULL, "tried to set port encoding fluid before it is 
initialized",
+                       SCM_EOL);
+
+      if (valid_enc == NULL 
+          || !strcmp (valid_enc, "ASCII")
+          || !strcmp (valid_enc, "ANSI_X3.4-1968")
+          || !strcmp (valid_enc, "ISO-8859-1"))
+        scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), SCM_BOOL_F);
+      else
+        scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), 
+                         scm_from_locale_string (valid_enc));
+    }
+  else
+    {
+      /* Set the character encoding for this port.  */
+      pt = SCM_PTAB_ENTRY (port);
+      if (pt->encoding)
+       free (pt->encoding);
+      if (valid_enc == NULL)
+        pt->encoding = NULL;
+      else
+        pt->encoding = strdup (valid_enc);
+    }
+}
+
+SCM_DEFINE (scm_port_encoding, "port-encoding", 1, 0, 0,
+           (SCM port),
+           "Returns, as a string, the character encoding that @var{port}\n"
+           "uses to interpret its input and output.\n")
+#define FUNC_NAME s_scm_port_encoding
+{
+  scm_t_port *pt;
+  const char *enc;
+
+  SCM_VALIDATE_PORT (1, port);
+
+  pt = SCM_PTAB_ENTRY (port);
+  enc = scm_i_get_port_encoding (port);
+  if (enc)
+    return scm_from_locale_string (pt->encoding);
+  else
+    return scm_from_locale_string ("NONE");
+}
+#undef FUNC_NAME
+  
+SCM_DEFINE (scm_set_port_encoding_x, "set-port-encoding!", 2, 0, 0,
+           (SCM port, SCM enc),
+           "Sets the character encoding that will be used to interpret all\n"
+           "port I/O.  New ports are created with the encoding\n"
+           "appropriate for the current locale if @code{setlocale} has \n"
+           "been called or ISO-8859-1 otherwise\n"
+           "and this procedure can be used to modify that encoding.\n")
+
+#define FUNC_NAME s_scm_set_port_encoding_x
+{
+  char *enc_str;
+  const char *valid_enc_str;
+
+  SCM_VALIDATE_PORT (1, port);
+  SCM_VALIDATE_STRING (2, enc);
+
+  enc_str = scm_to_locale_string (enc);
+  valid_enc_str = find_valid_encoding (enc_str);
+  if (valid_enc_str == NULL)
+    {
+      free (enc_str);
+      scm_misc_error (FUNC_NAME, "invalid or unknown character encoding ~s",
+                     scm_list_1 (enc));
+    }
+  else
+    {
+      scm_i_set_port_encoding_x (port, valid_enc_str);
+      free (enc_str);
+    }
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+/* This determines how conversions handle unconvertible characters.  */
+SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
+static int scm_conversion_strategy_init = 0;
+
+scm_t_string_failed_conversion_handler
+scm_i_get_conversion_strategy (SCM port)
+{
+  SCM encoding;
+  
+  if (scm_is_false (port))
+    {
+      if (!scm_conversion_strategy_init
+         || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+       return SCM_FAILED_CONVERSION_QUESTION_MARK;
+      else
+       {
+         encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
+         if (scm_is_false (encoding))
+           return SCM_FAILED_CONVERSION_QUESTION_MARK;
+         else 
+           return (scm_t_string_failed_conversion_handler) scm_to_int 
(encoding);
+       }
+    }
+  else
+    {
+      scm_t_port *pt;
+      pt = SCM_PTAB_ENTRY (port);
+       return pt->ilseq_handler;
+    }
+      
+}
+
+void
+scm_i_set_conversion_strategy_x (SCM port, 
+                                scm_t_string_failed_conversion_handler handler)
+{
+  SCM strategy;
+  scm_t_port *pt;
+  
+  strategy = scm_from_int ((int) handler);
+  
+  if (scm_is_false (port))
+    {
+      /* Set the default encoding for future ports.  */
+      if (!scm_conversion_strategy
+         || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
+       scm_misc_error (NULL, "tried to set conversion strategy fluid before it 
is initialized",
+                       SCM_EOL);
+      scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
+    }
+  else
+    {
+      /* Set the character encoding for this port.  */
+      pt = SCM_PTAB_ENTRY (port);
+      pt->ilseq_handler = handler;
+    }
+}
+
+SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
+           1, 0, 0, (SCM port),
+           "Returns the behavior of the port when handling a character that\n"
+           "is not representable in the port's current encoding.\n"
+           "It returns the symbol @code{error} if unrepresentable characters\n"
+           "should cause exceptions, @code{substitute} if the port should\n"
+           "try to replace unrepresentable characters with question marks or\n"
+           "approximate characters, or @code{escape} if unrepresentable\n"
+           "characters should be converted to string escapes.\n"
+           "\n"
+           "If @var{port} is @code{#f}, then the current default behavior\n"
+           "will be returned.  New ports will have this default behavior\n"
+           "when they are created.\n")
+#define FUNC_NAME s_scm_port_conversion_strategy
+{
+  scm_t_string_failed_conversion_handler h;
+
+  SCM_VALIDATE_OPPORT (1, port);
+
+  if (!scm_is_false (port))
+    {
+      SCM_VALIDATE_OPPORT (1, port);
+    }
+
+  h = scm_i_get_conversion_strategy (port);
+  if (h == SCM_FAILED_CONVERSION_ERROR)
+    return scm_from_locale_symbol ("error");
+  else if (h == SCM_FAILED_CONVERSION_QUESTION_MARK)
+    return scm_from_locale_symbol ("substitute");
+  else if (h == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
+    return scm_from_locale_symbol ("escape");
+  else
+    abort ();
+
+  /* Never gets here. */
+  return SCM_UNDEFINED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_port_conversion_strategy_x, 
"set-port-conversion-strategy!",
+           2, 0, 0, 
+           (SCM port, SCM sym),
+           "Sets the behavior of the interpreter when outputting a character\n"
+           "that is not representable in the port's current encoding.\n"
+           "@var{sym} can be either @code{'error}, @code{'substitute}, or\n"
+           "@code{'escape}.  If it is @code{'error}, an error will be thrown\n"
+           "when an unconvertible character is encountered.  If it is\n"
+           "@code{'substitute}, then unconvertible characters will \n"
+           "be replaced with approximate characters, or with question marks\n"
+           "if no approximately correct character is available.\n"
+           "If it is @code{'escape},\n"
+           "it will appear as a hex escape when output.\n"
+           "\n"
+           "If @var{port} is an open port, the conversion error behavior\n"
+           "is set for that port.  If it is @code{#f}, it is set as the\n"
+           "default behavior for any future ports that get created in\n"
+           "this thread.\n")
+#define FUNC_NAME s_scm_set_port_conversion_strategy_x
+{
+  SCM err;
+  SCM qm;
+  SCM esc;
+
+  if (!scm_is_false (port))
+    {
+      SCM_VALIDATE_OPPORT (1, port);
+    }
+
+  err = scm_from_locale_symbol ("error");
+  if (scm_is_true (scm_eqv_p (sym, err)))
+    {
+      scm_i_set_conversion_strategy_x (port, SCM_FAILED_CONVERSION_ERROR);
+      return SCM_UNSPECIFIED;
+    }
+
+  qm = scm_from_locale_symbol ("substitute");
+  if (scm_is_true (scm_eqv_p (sym, qm)))
+    {
+      scm_i_set_conversion_strategy_x (port, 
+                                       SCM_FAILED_CONVERSION_QUESTION_MARK);
+      return SCM_UNSPECIFIED;
+    }
+
+  esc = scm_from_locale_symbol ("escape");
+  if (scm_is_true (scm_eqv_p (sym, esc)))
+    {
+      scm_i_set_conversion_strategy_x (port,
+                                       SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
+      return SCM_UNSPECIFIED;
+    }
+
+  SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
 void
 scm_print_port_mode (SCM exp, SCM port)
 {
@@ -1823,8 +2346,17 @@ scm_init_ports ()
   cur_loadport_fluid = scm_permanent_object (scm_make_fluid ());
 
   scm_i_port_weak_hash = scm_permanent_object (scm_make_weak_key_hash_table 
(SCM_I_MAKINUM(31)));
-  
 #include "libguile/ports.x"
+
+  SCM_VARIABLE_SET (scm_port_encoding_var, scm_make_fluid ());
+  scm_fluid_set_x (SCM_VARIABLE_REF (scm_port_encoding_var), SCM_BOOL_F);
+  scm_port_encoding_init = 1;
+  
+  SCM_VARIABLE_SET (scm_conversion_strategy, scm_make_fluid ());
+  scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), 
+                  scm_from_int ((int) SCM_FAILED_CONVERSION_QUESTION_MARK));
+  scm_conversion_strategy_init = 1;
+  
 }
 
 /*
diff --git a/libguile/ports.h b/libguile/ports.h
index bfe59ae..0f46e7f 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -28,7 +28,7 @@
 #include "libguile/print.h"
 #include "libguile/struct.h"
 #include "libguile/threads.h"
-
+#include "libguile/strings.h"
 
 
 
@@ -56,6 +56,10 @@ typedef struct
   long line_number;            /* debugging support.  */
   int column_number;           /* debugging support.  */
 
+  /* Character encoding support  */
+  char *encoding;
+  scm_t_string_failed_conversion_handler ilseq_handler;
+
   /* port buffers.  the buffer(s) are set up for all ports.  
      in the case of string ports, the buffer is the string itself.
      in the case of unbuffered file ports, the buffer is a
@@ -265,6 +269,7 @@ SCM_API SCM scm_eof_object_p (SCM x);
 SCM_API SCM scm_force_output (SCM port);
 SCM_API SCM scm_flush_all_ports (void);
 SCM_API SCM scm_read_char (SCM port);
+SCM_API scm_t_wchar scm_getc (SCM port);
 SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size);
 SCM_API void scm_c_write (SCM port, const void *buffer, size_t size);
 SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port);
@@ -274,7 +279,8 @@ SCM_INTERNAL void scm_lfwrite_substr (SCM str, size_t 
start, size_t end,
 SCM_API void scm_flush (SCM port);
 SCM_API void scm_end_input (SCM port);
 SCM_API int scm_fill_input (SCM port);
-SCM_API void scm_ungetc (int c, SCM port);
+SCM_INTERNAL void scm_unget_byte (int c, SCM port); 
+SCM_API void scm_ungetc (scm_t_wchar c, SCM port);
 SCM_API void scm_ungets (const char *s, int n, SCM port);
 SCM_API SCM scm_peek_char (SCM port);
 SCM_API SCM scm_unread_char (SCM cobj, SCM port);
@@ -287,6 +293,15 @@ SCM_API SCM scm_port_column (SCM port);
 SCM_API SCM scm_set_port_column_x (SCM port, SCM line);
 SCM_API SCM scm_port_filename (SCM port);
 SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename);
+SCM_INTERNAL const char *scm_i_get_port_encoding (SCM port);
+SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str);
+SCM_API SCM scm_port_encoding (SCM port);
+SCM_API SCM scm_set_port_encoding_x (SCM port, SCM encoding);
+SCM_INTERNAL scm_t_string_failed_conversion_handler 
scm_i_get_conversion_strategy (SCM port);
+SCM_INTERNAL void scm_i_set_conversion_strategy_x (SCM port, 
+                                                  
scm_t_string_failed_conversion_handler h);
+SCM_API SCM scm_port_conversion_strategy (SCM port);
+SCM_API SCM scm_set_port_conversion_strategy_x (SCM port, SCM behavior);
 SCM_API int scm_port_print (SCM exp, SCM port, scm_print_state *);
 SCM_API void scm_print_port_mode (SCM exp, SCM port);
 SCM_API void scm_ports_prehistory (void);
@@ -294,7 +309,6 @@ SCM_API SCM scm_void_port (char * mode_str);
 SCM_API SCM scm_sys_make_void_port (SCM mode);
 SCM_INTERNAL void scm_init_ports (void);
 
-
 #if SCM_ENABLE_DEPRECATED==1
 SCM_API scm_t_port * scm_add_to_port_table (SCM port);
 #endif
diff --git a/libguile/posix.c b/libguile/posix.c
index 8f29904..7546953 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -25,6 +25,7 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <errno.h>
+#include <uniconv.h>
 
 #include "libguile/_scm.h"
 #include "libguile/dynwind.h"
@@ -1501,12 +1502,17 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
            "Otherwise the specified locale category is set to the string\n"
            "@var{locale} and the new value is returned as a\n"
            "system-dependent string.  If @var{locale} is an empty string,\n"
-           "the locale will be set using environment variables.")
+           "the locale will be set using environment variables.\n"
+           "\n"
+           "When the locale is changed, the character encoding of the new\n"
+           "locale (UTF-8, ISO-8859-1, etc.) is used for the current\n"
+           "input, output, and error ports\n")
 #define FUNC_NAME s_scm_setlocale
 {
   int c_category;
   char *clocale;
   char *rv;
+  const char *enc;
 
   scm_dynwind_begin (0);
 
@@ -1535,15 +1541,47 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
       SCM_SYSERROR;
     }
 
-  /* Recompute the standard SRFI-14 character sets in a locale-dependent
-     (actually charset-dependent) way.  */
-  scm_srfi_14_compute_char_sets ();
+  enc = locale_charset ();
+  /* Set the default encoding for new ports.  */
+  scm_i_set_port_encoding_x (SCM_BOOL_F, enc);
+  /* Set the encoding for the stdio ports.  */
+  scm_i_set_port_encoding_x (scm_current_input_port (), enc);
+  scm_i_set_port_encoding_x (scm_current_output_port (), enc);
+  scm_i_set_port_encoding_x (scm_current_error_port (), enc);
 
   scm_dynwind_end ();
   return scm_from_locale_string (rv);
 }
 #undef FUNC_NAME
 #endif /* HAVE_SETLOCALE */
+SCM_DEFINE (scm_setbinary, "setbinary", 0, 0, 0,
+            (void),
+           "Sets the encoding for the current input, output, and error\n"
+           "ports to ISO-8859-1.  That character encoding allows\n"
+           "ports to operate on binary data.\n"
+           "\n"
+           "It also sets the default encoding for newly created ports\n"
+           "to ISO-8859-1.\n"
+            "\n"
+            "The previous default encoding for new ports is returned\n")
+#define FUNC_NAME s_scm_setbinary
+{
+  const char *enc = scm_i_get_port_encoding (SCM_BOOL_F);
+
+  /* Set the default encoding for new ports.  */
+  scm_i_set_port_encoding_x (SCM_BOOL_F, NULL);
+  /* Set the encoding for the stdio ports.  */
+  scm_i_set_port_encoding_x (scm_current_input_port (), NULL);
+  scm_i_set_port_encoding_x (scm_current_output_port (), NULL);
+  scm_i_set_port_encoding_x (scm_current_error_port (), NULL);
+
+  if (enc)
+    return scm_from_locale_string (enc);
+
+  return scm_from_locale_string ("ISO-8859-1");
+}
+#undef FUNC_NAME
+
 
 #ifdef HAVE_MKNOD
 SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
diff --git a/libguile/posix.h b/libguile/posix.h
index 4d05764..2d93300 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -74,6 +74,7 @@ SCM_API SCM scm_access (SCM path, SCM how);
 SCM_API SCM scm_getpid (void);
 SCM_API SCM scm_putenv (SCM str);
 SCM_API SCM scm_setlocale (SCM category, SCM locale);
+SCM_API SCM scm_setbinary (void);
 SCM_API SCM scm_mknod (SCM path, SCM type, SCM perms, SCM dev);
 SCM_API SCM scm_nice (SCM incr);
 SCM_API SCM scm_sync (void);
diff --git a/libguile/print.c b/libguile/print.c
index 7a4aaa3..c38eba7 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -35,7 +35,7 @@
 #include "libguile/procprop.h"
 #include "libguile/read.h"
 #include "libguile/weaks.h"
-#include "libguile/unif.h"
+#include "libguile/programs.h"
 #include "libguile/alist.h"
 #include "libguile/struct.h"
 #include "libguile/objects.h"
@@ -294,13 +294,12 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref)
 /* Print the name of a symbol. */
 
 static int
-quote_keywordish_symbol (const char *str, size_t len)
+quote_keywordish_symbol (SCM symbol)
 {
   SCM option;
 
-  /* LEN is guaranteed to be > 0.
-   */
-  if (str[0] != ':' && str[len-1] != ':')
+  if (scm_i_symbol_ref (symbol, 0) != ':'
+      && scm_i_symbol_ref (symbol, scm_i_symbol_length (symbol) - 1) !=  ':')
     return 0;
 
   option = SCM_PRINT_KEYWORD_STYLE;
@@ -312,7 +311,7 @@ quote_keywordish_symbol (const char *str, size_t len)
 }
 
 void
-scm_print_symbol_name (const char *str, size_t len, SCM port)
+scm_i_print_symbol_name (SCM str, SCM port)
 {
   /* This points to the first character that has not yet been written to the
    * port. */
@@ -333,18 +332,20 @@ scm_print_symbol_name (const char *str, size_t len, SCM 
port)
    * simpler and faster. */
   int maybe_weird = 0;
   size_t mw_pos = 0;
+  size_t len = scm_i_symbol_length (str);
+  scm_t_wchar str0 = scm_i_symbol_ref (str, 0);
 
-  if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ','
-      || quote_keywordish_symbol (str, len)
-      || (str[0] == '.' && len == 1)
-      || scm_is_true (scm_c_locale_stringn_to_number (str, len, 10)))
+  if (len == 0 || str0 == '\'' || str0 == '`' || str0 == ','
+      || quote_keywordish_symbol (str) 
+      || (str0 == '.' && len == 1)
+      || scm_is_true (scm_i_string_to_number (scm_symbol_to_string (str), 10)))
     {
       scm_lfwrite ("#{", 2, port);
       weird = 1;
     }
 
   for (end = pos; end < len; ++end)
-    switch (str[end])
+    switch (scm_i_symbol_ref (str, end))
       {
 #ifdef BRACKETS_AS_PARENS
       case '[':
@@ -369,11 +370,11 @@ scm_print_symbol_name (const char *str, size_t len, SCM 
port)
            weird = 1;
          }
        if (pos < end)
-         scm_lfwrite (str + pos, end - pos, port);
+         scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port);
        {
          char buf[2];
          buf[0] = '\\';
-         buf[1] = str[end];
+         buf[1] = (char) (unsigned char) scm_i_symbol_ref (str, end);
          scm_lfwrite (buf, 2, port);
        }
        pos = end + 1;
@@ -391,11 +392,18 @@ scm_print_symbol_name (const char *str, size_t len, SCM 
port)
        break;
       }
   if (pos < end)
-    scm_lfwrite (str + pos, end - pos, port);
+    scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port);
   if (weird)
     scm_lfwrite ("}#", 2, port);
 }
 
+void
+scm_print_symbol_name (const char *str, size_t len, SCM port)
+{
+  SCM symbol = scm_from_locale_symboln (str, len);
+  return scm_i_print_symbol_name (symbol, port);
+}
+
 /* Print generally.  Handles both write and display according to PSTATE.
  */
 SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write);
@@ -454,20 +462,50 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                                                          | UC_CATEGORY_MASK_S))
                 /* Print the character if is graphic character.  */
                 {
-                  if (i<256)
-                    /* Character is graphic.  Print it.  */
-                    scm_putc (i, port);
+                  scm_t_wchar *wbuf;
+                  SCM wstr = scm_i_make_wide_string (1, &wbuf);
+                  char *buf;
+                  size_t len;
+                  const char *enc;
+
+                  enc = scm_i_get_port_encoding (port);
+                  wbuf[0] = i;
+                  if (enc == NULL)
+                    {
+                      if (i <= 0xFF)
+                        /* Character is graphic and Latin-1.  Print it  */
+                        scm_lfwrite_str (wstr, port);
+                      else
+                        /* Character is graphic but unrepresentable in
+                           this port's encoding.  */
+                        scm_intprint (i, 8, port);
+                    }
                   else
-                    /* Character is graphic but unrepresentable in
-                       this port's encoding.  */
-                    scm_intprint (i, 8, port);
+                    {
+                      buf = u32_conv_to_encoding (enc, 
+                                                  iconveh_error,
+                                                  (scm_t_uint32 *) wbuf, 
+                                                  1,
+                                                  NULL,
+                                                  NULL, &len);
+                      if (buf != NULL)
+                        {
+                          /* Character is graphic.  Print it.  */
+                          scm_lfwrite_str (wstr, port);
+                          free (buf);
+                        }
+                      else
+                        /* Character is graphic but unrepresentable in
+                           this port's encoding.  */
+                        scm_intprint (i, 8, port);
+                    }
                 }
               else
                 /* Character is a non-graphical character.  */
                 scm_intprint (i, 8, port);
            }
          else
-           scm_putc (i, port);
+           scm_i_charprint (i, port);
        }
       else if (SCM_IFLAGP (exp)
               && ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof 
(char *))))
@@ -599,21 +637,32 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                       SCM wstr = scm_i_make_wide_string (1, &wbuf);
                       char *buf;
                       size_t len;
-
-                      wbuf[0] = ch;
-
-                      buf = u32_conv_to_encoding ("ISO-8859-1",
-                                                  iconveh_error,
-                                                  (scm_t_uint32 *) wbuf,
-                                                  1, NULL, NULL, &len);
-                      if (buf != NULL)
+                      
+                      if (scm_i_get_port_encoding (port))
                         {
-                          /* Character is graphic and representable in
-                             this encoding.  Print it.  */
-                          scm_lfwrite_str (wstr, port);
-                          free (buf);
-                          printed = 1;
+                          wstr = scm_i_make_wide_string (1, &wbuf);
+                          wbuf[0] = ch;
+                          buf = u32_conv_to_encoding (scm_i_get_port_encoding 
(port), 
+                                                      iconveh_error,
+                                                      (scm_t_uint32 *) wbuf, 
+                                                      1   ,
+                                                      NULL,
+                                                      NULL, &len);
+                          if (buf != NULL)
+                            {
+                              /* Character is graphic and representable in
+                                 this encoding.  Print it.  */
+                              scm_lfwrite_str (wstr, port);
+                              free (buf);
+                              printed = 1;
+                            }
                         }
+                      else
+                        if (ch <= 0xFF)
+                          {
+                            scm_putc (ch, port);
+                            printed = 1;
+                          }
                     }
 
                   if (!printed)
@@ -658,23 +707,19 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
               scm_remember_upto_here_1 (exp);
             }
           else
-            scm_lfwrite (scm_i_string_chars (exp), scm_i_string_length (exp),
-                         port);
+            scm_lfwrite_str (exp, port);
           scm_remember_upto_here_1 (exp);
           break;
        case scm_tc7_symbol:
          if (scm_i_symbol_is_interned (exp))
            {
-             scm_print_symbol_name (scm_i_symbol_chars (exp),
-                                    scm_i_symbol_length (exp), port);
+             scm_i_print_symbol_name (exp, port);
              scm_remember_upto_here_1 (exp);
            }
          else
            {
              scm_puts ("#<uninterned-symbol ", port);
-             scm_print_symbol_name (scm_i_symbol_chars (exp),
-                                    scm_i_symbol_length (exp),
-                                    port);
+             scm_i_print_symbol_name (exp, port);
              scm_putc (' ', port);
              scm_uintprint (SCM_UNPACK (exp), 16, port);
              scm_putc ('>', port);
@@ -683,6 +728,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
        case scm_tc7_variable:
          scm_i_variable_print (exp, port, pstate);
          break;
+       case scm_tc7_program:
+         scm_i_program_print (exp, port, pstate);
+         break;
        case scm_tc7_wvect:
          ENTER_NESTED_DATA (pstate, exp, circref);
          if (SCM_IS_WHVEC (exp))
@@ -737,14 +785,16 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
          EXIT_NESTED_DATA (pstate);
          break;
        case scm_tcs_subrs:
-         scm_puts (SCM_SUBR_GENERIC (exp)
-                   ? "#<primitive-generic "
-                   : "#<primitive-procedure ",
-                   port);
-         scm_puts (scm_i_symbol_chars (SCM_SUBR_NAME (exp)), port);
-         scm_putc ('>', port);
-         break;
-
+         {
+           SCM name = scm_symbol_to_string (SCM_SUBR_NAME (exp));
+           scm_puts (SCM_SUBR_GENERIC (exp)
+                     ? "#<primitive-generic "
+                     : "#<primitive-procedure ",
+                     port);
+           scm_lfwrite_str (name, port);
+           scm_putc ('>', port);
+           break;
+         }
        case scm_tc7_pws:
          scm_puts ("#<procedure-with-setter", port);
          {
@@ -839,7 +889,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
 /* Print a character.
  */
 void
-scm_i_charprint (scm_t_uint32 ch, SCM port)
+scm_i_charprint (scm_t_wchar ch, SCM port)
 {
   scm_t_wchar *wbuf;
   SCM wstr = scm_i_make_wide_string (1, &wbuf);
@@ -1061,9 +1111,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM port, answer = SCM_UNSPECIFIED;
   int fReturnString = 0;
   int writingp;
-  const char *start;
-  const char *end;
-  const char *p;
+  size_t start, p, end;
 
   if (scm_is_eq (destination, SCM_BOOL_T))
     {
@@ -1086,15 +1134,16 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM_VALIDATE_STRING (2, message);
   SCM_VALIDATE_REST_ARGUMENT (args);
 
-  start = scm_i_string_chars (message);
-  end = start + scm_i_string_length (message);
+  p = 0;
+  start = 0;
+  end = scm_i_string_length (message);
   for (p = start; p != end; ++p)
-    if (*p == '~')
+    if (scm_i_string_ref (message, p) == '~')
       {
        if (++p == end)
          break;
 
-       switch (*p) 
+       switch (scm_i_string_ref (message, p)) 
          {
          case 'A': case 'a':
            writingp = 0;
@@ -1103,33 +1152,33 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
            writingp = 1;
            break;
          case '~':
-           scm_lfwrite (start, p - start, port);
+           scm_lfwrite_substr (message, start, p, port);
            start = p + 1;
            continue;
          case '%':
-           scm_lfwrite (start, p - start - 1, port);
+           scm_lfwrite_substr (message, start, p - 1, port);
            scm_newline (port);
            start = p + 1;
            continue;
          default:
            SCM_MISC_ERROR ("FORMAT: Unsupported format option ~~~A - use 
(ice-9 format) instead",
-                           scm_list_1 (SCM_MAKE_CHAR (*p)));
+                           scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref 
(message, p))));
            
          }
 
 
        if (!scm_is_pair (args))
          SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
-                         scm_list_1 (SCM_MAKE_CHAR (*p)));
+                         scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref (message, 
p))));
                                        
-       scm_lfwrite (start, p - start - 1, port);
+       scm_lfwrite_substr (message, start, p - 1, port);
        /* we pass destination here */
        scm_prin1 (SCM_CAR (args), destination, writingp);
        args = SCM_CDR (args);
        start = p + 1;
       }
 
-  scm_lfwrite (start, p - start, port);
+  scm_lfwrite_substr (message, start, p, port);
   if (!scm_is_eq (args, SCM_EOL))
     SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments",
                    scm_list_1 (scm_length (args)));
diff --git a/libguile/print.h b/libguile/print.h
index 00648ef..ae2aaef 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -25,6 +25,7 @@
 
 #include "libguile/__scm.h"
 
+#include "libguile/chars.h" 
 #include "libguile/options.h"
 
 
@@ -77,11 +78,12 @@ SCM_API SCM scm_print_options (SCM setting);
 SCM_API SCM scm_make_print_state (void);
 SCM_API void scm_free_print_state (SCM print_state);
 SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state);
-SCM_INTERNAL void scm_i_charprint (scm_t_uint32 c, SCM port);
+SCM_INTERNAL void scm_i_charprint (scm_t_wchar c, SCM port);
 SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port);
 SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port);
 SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);
 SCM_API void scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, 
scm_print_state *pstate);
+SCM_INTERNAL void scm_i_print_symbol_name (SCM sym, SCM port);
 SCM_API void scm_print_symbol_name (const char *str, size_t len, SCM port);
 SCM_API void scm_prin1 (SCM exp, SCM port, int writingp);
 SCM_API void scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate);
diff --git a/libguile/private-gc.h b/libguile/private-gc.h
index 38d953f..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,54 +32,15 @@
  * 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;
@@ -100,28 +61,6 @@ typedef enum { return_on_error, abort_on_error } 
policy_on_error;
 */
 #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);
-
-extern long int scm_i_deprecated_memory_return;
-extern long int scm_i_find_heap_calls;
-
 SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */
 
-
-/*
-  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/procprop.c b/libguile/procprop.c
index df96eaa..5054291 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -33,6 +33,7 @@
 #include "libguile/root.h"
 #include "libguile/vectors.h"
 #include "libguile/hashtab.h"
+#include "libguile/programs.h"
 
 #include "libguile/validate.h"
 #include "libguile/procprop.h"
@@ -72,6 +73,11 @@ scm_i_procedure_arity (SCM proc)
     case scm_tc7_lsubr:
       r = 1;
       break;
+    case scm_tc7_program:
+      a += SCM_PROGRAM_DATA (proc)->nargs;
+      r = SCM_PROGRAM_DATA (proc)->nrest;
+      a -= r;
+      break;
     case scm_tc7_lsubr_2:
       a += 2;
       r = 1;
diff --git a/libguile/procs.c b/libguile/procs.c
index b67bfd9..40d6231 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -103,6 +103,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
       case scm_tcs_closures:
       case scm_tcs_subrs:
       case scm_tc7_pws:
+      case scm_tc7_program:
        return SCM_BOOL_T;
       case scm_tc7_smob:
        return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply);
@@ -142,6 +143,10 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
          return SCM_BOOL_T;
        case scm_tc7_gsubr:
          return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
+       case scm_tc7_program:
+         return scm_from_bool (SCM_PROGRAM_DATA (obj)->nargs == 0
+                                || (SCM_PROGRAM_DATA (obj)->nargs == 1
+                                    && SCM_PROGRAM_DATA (obj)->nrest));
        case scm_tc7_pws:
          obj = SCM_PROCEDURE (obj);
          goto again;
@@ -170,6 +175,8 @@ scm_subr_p (SCM obj)
   return 0;
 }
 
+SCM_SYMBOL (sym_documentation, "documentation");
+
 SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, 
            (SCM proc),
            "Return the documentation string associated with @code{proc}.  By\n"
@@ -181,6 +188,8 @@ SCM_DEFINE (scm_procedure_documentation, 
"procedure-documentation", 1, 0, 0,
   SCM code;
   SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
              proc, SCM_ARG1, FUNC_NAME);
+  if (SCM_PROGRAM_P (proc))
+    return scm_assq_ref (scm_program_properties (proc), sym_documentation);
   switch (SCM_TYP7 (proc))
     {
     case scm_tcs_closures:
diff --git a/libguile/programs.c b/libguile/programs.c
index d62a3a0..b2bf806 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -31,8 +31,6 @@
 #include "vm.h"
 
 
-scm_t_bits scm_tc16_program;
-
 static SCM write_program = SCM_BOOL_F;
 
 SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
@@ -50,39 +48,13 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
   else if (free_variables != SCM_BOOL_F)
     SCM_VALIDATE_VECTOR (3, free_variables);
 
-  SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_variables);
+  return scm_double_cell (scm_tc7_program, (scm_t_bits)objcode,
+                          (scm_t_bits)objtable, (scm_t_bits)free_variables);
 }
 #undef FUNC_NAME
 
-static SCM
-program_apply (SCM program, SCM args)
-{
-  return scm_vm_apply (scm_the_vm (), program, args);
-}
-
-static SCM
-program_apply_0 (SCM program)
-{
-  return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
-}
-
-static SCM
-program_apply_1 (SCM program, SCM a)
-{
-  return scm_c_vm_run (scm_the_vm (), program, &a, 1);
-}
-
-static SCM
-program_apply_2 (SCM program, SCM a, SCM b)
-{
-  SCM args[2];
-  args[0] = a;
-  args[1] = b;
-  return scm_c_vm_run (scm_the_vm (), program, args, 2);
-}
-
-static int
-program_print (SCM program, SCM port, scm_print_state *pstate)
+void
+scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
 {
   static int print_error = 0;
 
@@ -92,12 +64,17 @@ program_print (SCM program, SCM port, scm_print_state 
*pstate)
        scm_from_locale_symbol ("write-program"));
   
   if (SCM_FALSEP (write_program) || print_error)
-    return scm_smob_print (program, port, pstate);
-
-  print_error = 1;
-  scm_call_2 (SCM_VARIABLE_REF (write_program), program, port);
-  print_error = 0;
-  return 1;
+    {
+      scm_puts ("#<program ", port);
+      scm_uintprint (SCM_CELL_WORD_1 (program), 16, port);
+      scm_putc ('>', port);
+    }
+  else
+    {
+      print_error = 1;
+      scm_call_2 (SCM_VARIABLE_REF (write_program), program, port);
+      print_error = 0;
+    }
 }
 
 
@@ -309,12 +286,6 @@ SCM_DEFINE (scm_program_objcode, "program-objcode", 1, 0, 
0,
 void
 scm_bootstrap_programs (void)
 {
-  scm_tc16_program = scm_make_smob_type ("program", 0);
-  scm_set_smob_apply (scm_tc16_program, program_apply, 0, 0, 1);
-  scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_0 = program_apply_0;
-  scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_1 = program_apply_1;
-  scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_2 = program_apply_2;
-  scm_set_smob_print (scm_tc16_program, program_print);
   scm_c_register_extension ("libguile", "scm_init_programs",
                             (scm_t_extension_init_func)scm_init_programs, 
NULL);
 }
diff --git a/libguile/programs.h b/libguile/programs.h
index 040e8ea..d52631f 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -26,19 +26,15 @@
  * Programs
  */
 
-typedef unsigned char scm_byte_t;
+#define SCM_F_PROGRAM_IS_BOOT (1<<16)
 
-SCM_API scm_t_bits scm_tc16_program;
-
-#define SCM_F_PROGRAM_IS_BOOT (1<<0)
-
-#define SCM_PROGRAM_P(x)       (SCM_SMOB_PREDICATE (scm_tc16_program, x))
-#define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x))
-#define SCM_PROGRAM_OBJTABLE(x)        (SCM_SMOB_OBJECT_2 (x))
-#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_SMOB_OBJECT_3 (x))
+#define SCM_PROGRAM_P(x)       (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
+#define SCM_PROGRAM_OBJCODE(x) (SCM_CELL_OBJECT_1 (x))
+#define SCM_PROGRAM_OBJTABLE(x)        (SCM_CELL_OBJECT_2 (x))
+#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_3 (x))
 #define SCM_PROGRAM_DATA(x)    (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
 #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
-#define SCM_PROGRAM_IS_BOOT(x) (SCM_SMOB_FLAGS (x) & SCM_F_PROGRAM_IS_BOOT)
+#define SCM_PROGRAM_IS_BOOT(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_BOOT)
 
 SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_variables);
 
@@ -58,6 +54,8 @@ SCM_API SCM scm_program_objcode (SCM program);
 
 SCM_API SCM scm_c_program_source (SCM program, size_t ip);
 
+SCM_INTERNAL void scm_i_program_print (SCM program, SCM port,
+                                       scm_print_state *pstate);
 SCM_INTERNAL void scm_bootstrap_programs (void);
 SCM_INTERNAL void scm_init_programs (void);
 
diff --git a/libguile/random.c b/libguile/random.c
index 9f11dab..281d43a 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001, 2003, 2005, 2006 Free Software Foundation, 
Inc.
+/* Copyright (C) 1999,2000,2001, 2003, 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
@@ -33,9 +33,10 @@
 #include "libguile/numbers.h"
 #include "libguile/feature.h"
 #include "libguile/strings.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/srfi-4.h"
 #include "libguile/vectors.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
 #include "libguile/random.h"
diff --git a/libguile/rdelim.c b/libguile/rdelim.c
index 04a0944..1f46e5b 100644
--- a/libguile/rdelim.c
+++ b/libguile/rdelim.c
@@ -59,12 +59,10 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 
0,
   size_t j;
   size_t cstart;
   size_t cend;
-  int c;
-  const char *cdelims;
+  scm_t_wchar c;
   size_t num_delims;
 
   SCM_VALIDATE_STRING (1, delims);
-  cdelims = scm_i_string_chars (delims);
   num_delims = scm_i_string_length (delims);
 
   SCM_VALIDATE_STRING (2, str);
@@ -83,7 +81,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
       c = scm_getc (port);
       for (k = 0; k < num_delims; k++)
        {
-         if (cdelims[k] == c)
+         if (scm_i_string_ref (delims, k) == c)
            {
              if (scm_is_false (gobble))
                scm_ungetc (c, port);
diff --git a/libguile/read.c b/libguile/read.c
index 8efac67..d91c868 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -27,12 +27,15 @@
 #include <stdio.h>
 #include <ctype.h>
 #include <string.h>
+#include <unistd.h>
+#include <unicase.h>
 
 #include "libguile/_scm.h"
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/eval.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
+#include "libguile/bitvectors.h"
 #include "libguile/keywords.h"
 #include "libguile/alist.h"
 #include "libguile/srcprop.h"
@@ -177,11 +180,6 @@ static SCM *scm_read_hash_procedures;
   (((_chr) == 'e') || ((_chr) == 's') || ((_chr) == 'f')       \
    || ((_chr) == 'd') || ((_chr) == 'l'))
 
-/* An inlinable version of `scm_c_downcase ()'.  */
-#define CHAR_DOWNCASE(_chr)                            \
-  (((_chr) <= UCHAR_MAX) ? tolower ((int) (_chr)) : (_chr))
-
-
 /* Read an SCSH block comment.  */
 static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
 static SCM scm_read_commented_expression (int chr, SCM port);
@@ -189,41 +187,69 @@ static SCM scm_read_commented_expression (int chr, SCM 
port);
 /* Read from PORT until a delimiter (e.g., a whitespace) is read.  Return
    zero if the whole token fits in BUF, non-zero otherwise.  */
 static inline int
-read_token (SCM port, char *buf, size_t buf_size, size_t *read)
+read_token (SCM port, SCM buf, size_t *read)
 {
+  scm_t_wchar chr;
   *read = 0;
 
-  while (*read < buf_size)
+  buf = scm_i_string_start_writing (buf);
+  while (*read < scm_i_string_length (buf))
     {
-      int chr;
-
       chr = scm_getc (port);
-      chr = (SCM_CASE_INSENSITIVE_P ? CHAR_DOWNCASE (chr) : chr);
 
       if (chr == EOF)
-       return 0;
-      else if (CHAR_IS_DELIMITER (chr))
        {
-         scm_ungetc (chr, port);
+         scm_i_string_stop_writing ();
          return 0;
        }
-      else
+
+      chr = (SCM_CASE_INSENSITIVE_P ? uc_tolower (chr) : chr);
+
+      if (CHAR_IS_DELIMITER (chr))
        {
-         *buf = (char) chr;
-         buf++, (*read)++;
+         scm_i_string_stop_writing ();
+         scm_ungetc (chr, port);
+         return 0;
        }
+
+      scm_i_string_set_x (buf, *read, chr);
+      (*read)++;
     }
+  scm_i_string_stop_writing ();
 
   return 1;
 }
 
+static SCM
+read_complete_token (SCM port, size_t *read)
+{
+  SCM buffer, str = SCM_EOL;
+  size_t len;
+  int overflow;
+
+  buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL); 
+  overflow = read_token (port, buffer, read);
+  if (!overflow)
+    return scm_i_substring (buffer, 0, *read);
+
+  str = scm_string_copy (buffer);
+  do
+    {
+      overflow = read_token (port, buffer, &len);
+      str = scm_string_append (scm_list_2 (str, buffer));
+      *read += len;
+    }
+  while (overflow);
+
+  return scm_i_substring (str, 0, *read);
+}
 
 /* Skip whitespace from PORT and return the first non-whitespace character
    read.  Raise an error on end-of-file.  */
 static int
 flush_ws (SCM port, const char *eoferr)
 {
-  register int c;
+  register scm_t_wchar c;
   while (1)
     switch (c = scm_getc (port))
       {
@@ -292,7 +318,7 @@ static SCM recsexpr (SCM obj, long line, int column, SCM 
filename);
 
 
 static SCM
-scm_read_sexp (int chr, SCM port)
+scm_read_sexp (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_i_lreadparen"
 {
   register int c;
@@ -553,107 +579,52 @@ scm_read_string (int chr, SCM port)
 
 
 static SCM
-scm_read_number (int chr, SCM port)
+scm_read_number (scm_t_wchar chr, SCM port)
 {
-  SCM result, str = SCM_EOL;
-  char buffer[READER_BUFFER_SIZE];
+  SCM result;
+  SCM buffer;
   size_t read;
-  int overflow = 0;
 
   scm_ungetc (chr, port);
-  do
-    {
-      overflow = read_token (port, buffer, sizeof (buffer), &read);
-
-      if ((overflow) || (scm_is_pair (str)))
-       str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      /* The slow path.  */
-
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      result = scm_string_to_number (str, SCM_UNDEFINED);
-      if (!scm_is_true (result))
-       /* Return a symbol instead of a number.  */
-       result = scm_string_to_symbol (str);
-    }
-  else
-    {
-      result = scm_c_locale_stringn_to_number (buffer, read, 10);
-      if (!scm_is_true (result))
-       /* Return a symbol instead of a number.  */
-       result = scm_from_locale_symboln (buffer, read);
-    }
+  buffer = read_complete_token (port, &read);
+  result = scm_string_to_number (buffer, SCM_UNDEFINED);
+  if (!scm_is_true (result))
+    /* Return a symbol instead of a number.  */
+    result = scm_string_to_symbol (buffer);
 
   return result;
 }
 
 static SCM
-scm_read_mixed_case_symbol (int chr, SCM port)
+scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
 {
-  SCM result, str = SCM_EOL;
-  int overflow = 0, ends_with_colon = 0;
-  char buffer[READER_BUFFER_SIZE];
+  SCM result;
+  int ends_with_colon = 0;
+  SCM buffer;
   size_t read = 0;
   int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
 
   scm_ungetc (chr, port);
-  do
-    {
-      overflow = read_token (port, buffer, sizeof (buffer), &read);
-
-      if (read > 0)
-       ends_with_colon = (buffer[read - 1] == ':');
+  buffer = read_complete_token (port, &read);
+  if (read > 0)
+    ends_with_colon = scm_i_string_ref (buffer, read - 1) == ':';
 
-      if ((overflow) || (scm_is_pair (str)))
-       str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      size_t len;
-
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      len = scm_c_string_length (str);
-
-      /* Per SRFI-88, `:' alone is an identifier, not a keyword.  */
-      if (postfix && ends_with_colon && (len > 1))
-       {
-         /* Strip off colon.  */
-         str = scm_c_substring (str, 0, len-1);
-         result = scm_string_to_symbol (str);
-         result = scm_symbol_to_keyword (result);
-       }
-      else
-       result = scm_string_to_symbol (str);
-    }
+  if (postfix && ends_with_colon && (read > 1))
+    result = scm_symbol_to_keyword (scm_string_to_symbol (scm_i_substring 
(buffer, 0, read - 1)));
   else
-    {
-      /* For symbols smaller than `sizeof (buffer)', we don't need to recur
-        to Scheme strings.  Therefore, we only create one Scheme object (a
-        symbol) per symbol read.  */
-      if (postfix && ends_with_colon && (read > 1))
-       result = scm_from_locale_keywordn (buffer, read - 1);
-      else
-       result = scm_from_locale_symboln (buffer, read);
-    }
+    result = scm_string_to_symbol (buffer);
 
   return result;
 }
 
 static SCM
-scm_read_number_and_radix (int chr, SCM port)
+scm_read_number_and_radix (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
-  SCM result, str = SCM_EOL;
+  SCM result;
   size_t read;
-  char buffer[READER_BUFFER_SIZE];
+  SCM buffer = scm_i_make_string (READER_BUFFER_SIZE, NULL);
   unsigned int radix;
-  int overflow = 0;
 
   switch (chr)
     {
@@ -683,22 +654,8 @@ scm_read_number_and_radix (int chr, SCM port)
       radix = 10;
     }
 
-  do
-    {
-      overflow = read_token (port, buffer, sizeof (buffer), &read);
-
-      if ((overflow) || (scm_is_pair (str)))
-       str = scm_cons (scm_from_locale_stringn (buffer, read), str);
-    }
-  while (overflow);
-
-  if (scm_is_pair (str))
-    {
-      str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL));
-      result = scm_string_to_number (str, scm_from_uint (radix));
-    }
-  else
-    result = scm_c_locale_stringn_to_number (buffer, read, radix);
+  buffer = read_complete_token (port, &read);
+  result = scm_string_to_number (buffer, scm_from_uint (radix));
 
   if (scm_is_true (result))
     return result;
@@ -728,7 +685,7 @@ scm_read_quote (int chr, SCM port)
 
     case ',':
       {
-       int c;
+       scm_t_wchar c;
 
        c = scm_getc (port);
        if ('@' == c)
@@ -827,7 +784,10 @@ scm_read_semicolon_comment (int chr, SCM port)
 {
   int c;
 
-  for (c = scm_getc (port);
+  /* We use the get_byte here because there is no need to get the
+     locale correct with comment input. This presumes that newline
+     always represents itself no matter what the encoding is.  */
+  for (c = scm_get_byte_or_eof (port);
        (c != EOF) && (c != '\n');
        c = scm_getc (port));
 
@@ -855,14 +815,18 @@ scm_read_boolean (int chr, SCM port)
 }
 
 static SCM
-scm_read_character (int chr, SCM port)
+scm_read_character (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
-  SCM ch;
-  char charname[READER_CHAR_NAME_MAX_SIZE];
+  SCM charname = scm_i_make_string (READER_CHAR_NAME_MAX_SIZE, NULL);
   size_t charname_len;
+  scm_t_wchar cp;
+  int overflow;
+
+  overflow = read_token (port, charname, &charname_len);
+  charname = scm_c_substring (charname, 0, charname_len);
 
-  if (read_token (port, charname, sizeof (charname), &charname_len))
+  if (overflow)
     goto char_error;
 
   if (charname_len == 0)
@@ -877,28 +841,34 @@ scm_read_character (int chr, SCM port)
     }
 
   if (charname_len == 1)
-    return SCM_MAKE_CHAR (charname[0]);
+    return SCM_MAKE_CHAR (scm_i_string_ref (charname, 0));
 
-  if (*charname >= '0' && *charname < '8')
+  cp = scm_i_string_ref (charname, 0);
+  if (cp >= '0' && cp < '8')
     {
       /* Dirk:FIXME::  This type of character syntax is not R5RS
        * compliant.  Further, it should be verified that the constant
        * does only consist of octal digits.  Finally, it should be
        * checked whether the resulting fixnum is in the range of
        * characters.  */
-      SCM p = scm_c_locale_stringn_to_number (charname, charname_len, 8);
+      SCM p = scm_string_to_number (charname, scm_from_uint (8));
       if (SCM_I_INUMP (p))
        return SCM_MAKE_CHAR (SCM_I_INUM (p));
     }
 
-  ch = scm_i_charname_to_char (charname, charname_len);
-  if (scm_is_true (ch))
-    return ch;
+  /* The names of characters should never have non-Latin1
+     characters.  */
+  if (scm_i_is_narrow_string (charname)
+      || scm_i_try_narrow_string (charname))
+    { SCM ch = scm_i_charname_to_char (scm_i_string_chars (charname),
+                                       charname_len);
+      if (scm_is_true (ch))
+        return ch;
+    }
 
  char_error:
   scm_i_input_error (FUNC_NAME, port, "unknown character name ~a",
-                    scm_list_1 (scm_from_locale_stringn (charname,
-                                                         charname_len)));
+                    scm_list_1 (charname));
 
   return SCM_UNSPECIFIED;
 }
@@ -940,7 +910,7 @@ scm_read_srfi4_vector (int chr, SCM port)
 }
 
 static SCM
-scm_read_bytevector (int chr, SCM port)
+scm_read_bytevector (scm_t_wchar chr, SCM port)
 {
   chr = scm_getc (port);
   if (chr != 'u')
@@ -964,7 +934,7 @@ scm_read_bytevector (int chr, SCM port)
 }
 
 static SCM
-scm_read_guile_bit_vector (int chr, SCM port)
+scm_read_guile_bit_vector (scm_t_wchar chr, SCM port)
 {
   /* Read the `#*10101'-style read syntax for bit vectors in Guile.  This is
      terribly inefficient but who cares?  */
@@ -984,13 +954,17 @@ scm_read_guile_bit_vector (int chr, SCM port)
 }
 
 static inline SCM
-scm_read_scsh_block_comment (int chr, SCM port)
+scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
 {
   int bang_seen = 0;
 
+  /* We can use the get_byte here because there is no need to get the
+     locale correct when reading comments. This presumes that 
+     hash and exclamation points always represent themselves no
+     matter what the source encoding is.*/
   for (;;)
     {
-      int c = scm_getc (port);
+      int c = scm_get_byte_or_eof (port);
 
       if (c == EOF)
        scm_i_input_error ("skip_block_comment", port,
@@ -1008,9 +982,9 @@ scm_read_scsh_block_comment (int chr, SCM port)
 }
 
 static SCM
-scm_read_commented_expression (int chr, SCM port)
+scm_read_commented_expression (scm_t_wchar chr, SCM port)
 {
-  int c;
+  scm_t_wchar c;
   
   c = flush_ws (port, (char *) NULL);
   if (EOF == c)
@@ -1022,19 +996,18 @@ scm_read_commented_expression (int chr, SCM port)
 }
 
 static SCM
-scm_read_extended_symbol (int chr, SCM port)
+scm_read_extended_symbol (scm_t_wchar chr, SCM port)
 {
   /* Guile's extended symbol read syntax looks like this:
 
        #{This is all a symbol name}#
 
      So here, CHR is expected to be `{'.  */
-  SCM result;
   int saw_brace = 0, finished = 0;
   size_t len = 0;
-  char buf[1024];
+  SCM buf = scm_i_make_string (1024, NULL);
 
-  result = scm_c_make_string (0, SCM_MAKE_CHAR ('X'));
+  buf = scm_i_string_start_writing (buf);
 
   while ((chr = scm_getc (port)) != EOF)
     {
@@ -1048,32 +1021,30 @@ scm_read_extended_symbol (int chr, SCM port)
          else
            {
              saw_brace = 0;
-             buf[len++] = '}';
-             buf[len++] = chr;
+             scm_i_string_set_x (buf, len++, '}');
+             scm_i_string_set_x (buf, len++, chr);
            }
        }
       else if (chr == '}')
        saw_brace = 1;
       else
-       buf[len++] = chr;
+       scm_i_string_set_x (buf, len++, chr);
 
-      if (len >= sizeof (buf) - 2)
+      if (len >= scm_i_string_length (buf) - 2)
        {
-         scm_string_append (scm_list_2 (result,
-                                        scm_from_locale_stringn (buf, len)));
+         scm_i_string_stop_writing ();
+         SCM addy = scm_i_make_string (1024, NULL);
+         buf = scm_string_append (scm_list_2 (buf, addy));
          len = 0;
+         buf = scm_i_string_start_writing (buf);
        }
 
       if (finished)
        break;
     }
+  scm_i_string_stop_writing ();
 
-  if (len)
-    result = scm_string_append (scm_list_2
-                               (result,
-                                scm_from_locale_stringn (buf, len)));
-
-  return (scm_string_to_symbol (result));
+  return (scm_string_to_symbol (scm_c_substring (buf, 0, len)));
 }
 
 
@@ -1109,7 +1080,7 @@ scm_read_sharp_extension (int chr, SCM port)
 /* The reader for the sharp `#' character.  It basically dispatches reads
    among the above token readers.   */
 static SCM
-scm_read_sharp (int chr, SCM port)
+scm_read_sharp (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
@@ -1161,7 +1132,7 @@ scm_read_sharp (int chr, SCM port)
       {
        /* When next char is '(', it really is an old-style
           uniform array. */
-       int next_c = scm_getc (port);
+       scm_t_wchar next_c = scm_getc (port);
        if (next_c != EOF)
          scm_ungetc (next_c, port);
        if (next_c == '(')
@@ -1209,7 +1180,7 @@ scm_read_expression (SCM port)
 {
   while (1)
     {
-      register int chr;
+      register scm_t_wchar chr;
 
       chr = scm_getc (port);
 
@@ -1420,6 +1391,127 @@ scm_get_hash_procedure (int c)
     }
 }
 
+#define SCM_ENCODING_SEARCH_SIZE (500)
+
+/* Search the first few hundred characters of a file for
+   an emacs-like coding declaration.  */
+char *
+scm_scan_for_encoding (SCM port)
+{
+  char header[SCM_ENCODING_SEARCH_SIZE+1];
+  size_t bytes_read;
+  char *encoding = NULL;
+  int utf8_bom = 0;
+  char *pos;
+  int i;
+  int in_comment;
+
+  bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE);  
+  scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
+
+  if (bytes_read > 3 
+      && header[0] == '\xef' && header[1] == '\xbb' && header[2] == '\xbf')
+    utf8_bom = 1;
+
+  /* search past "coding[:=]" */
+  pos = header;
+  while (1)
+    {
+      if ((pos = strstr(pos, "coding")) == NULL)
+        return NULL;
+
+      pos += strlen("coding");
+      if (pos - header >= SCM_ENCODING_SEARCH_SIZE || 
+          (*pos == ':' || *pos == '='))
+        {
+          pos ++;
+          break;
+        }
+    }
+
+  /* skip spaces */
+  while (pos - header <= SCM_ENCODING_SEARCH_SIZE && 
+        (*pos == ' ' || *pos == '\t'))
+    pos ++;
+
+  /* grab the next token */
+  i = 0;
+  while (pos + i - header <= SCM_ENCODING_SEARCH_SIZE 
+        && (isalnum(pos[i]) || pos[i] == '_' || pos[i] == '-' || pos[i] == 
'.'))
+    i++;
+
+  if (i == 0)
+    return NULL;
+
+  encoding = scm_malloc (i+1);
+  memcpy (encoding, pos, i);
+  encoding[i] ='\0';
+  for (i = 0; i < strlen (encoding); i++)
+    encoding[i] = toupper ((int) encoding[i]);
+
+  /* push backwards to make sure we were in a comment */
+  in_comment = 0;
+  while (pos - i - header > 0)
+    {
+      if (*(pos - i) == '\n')
+       {
+         /* This wasn't in a semicolon comment. Check for a
+          hash-bang comment. */
+         char *beg = strstr (header, "#!");
+         char *end = strstr (header, "!#");
+         if (beg < pos && pos < end)
+           in_comment = 1;
+         break;
+       }
+      if (*(pos - i) == ';')
+       {
+         in_comment = 1;
+         break;
+       }
+      i ++;
+    }
+  if (!in_comment)
+    {
+      /* This wasn't in a comment */
+      free (encoding);
+      return NULL;
+    }
+  if (utf8_bom && strcmp(encoding, "UTF-8"))
+    scm_misc_error (NULL, 
+                   "the port input declares the encoding ~s but is encoded as 
UTF-8",
+                   scm_list_1 (scm_from_locale_string (encoding)));
+      
+  return encoding;
+}
+
+SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
+            (SCM port),
+            "Scans the port for an EMACS-like character coding declaration\n"
+            "near the top of the contents of a port with random-acessible 
contents.\n"
+            "The coding declaration is of the form\n"
+            "@code{coding: XXXXX} and must appear in a scheme comment.\n"
+            "\n"
+            "Returns a string containing the character encoding of the file\n"
+            "if a declaration was found, or @code{#f} otherwise.\n")
+#define FUNC_NAME s_scm_file_encoding
+{
+  char *enc;
+  SCM s_enc;
+  
+  enc = scm_scan_for_encoding (port);
+  if (enc == NULL)
+    return SCM_BOOL_F;
+  else
+    {
+      s_enc = scm_from_locale_string (enc);
+      free (enc);
+      return s_enc;
+    }
+  
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
 void
 scm_init_read ()
 {
diff --git a/libguile/read.h b/libguile/read.h
index 20d3f4b..7bc4a0b 100644
--- a/libguile/read.h
+++ b/libguile/read.h
@@ -56,6 +56,8 @@ SCM_API SCM scm_read_options (SCM setting);
 SCM_API SCM scm_read (SCM port);
 SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird);
 SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc);
+SCM_INTERNAL char *scm_scan_for_encoding (SCM port);
+SCM_API SCM scm_file_encoding (SCM port);
 
 SCM_INTERNAL void scm_i_input_error (const char *func, SCM port,
                                     const char *message, SCM arg)
diff --git a/libguile/socket.c b/libguile/socket.c
index 2e02e90..3a81ed9 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 
Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 
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
@@ -27,12 +27,13 @@
 #include <gmp.h>
 
 #include "libguile/_scm.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/feature.h"
 #include "libguile/fports.h"
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
 #include "libguile/dynwind.h"
+#include "libguile/srfi-13.h"
 
 #include "libguile/validate.h"
 #include "libguile/socket.h"
@@ -1414,6 +1415,8 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
            "protocols, if a packet larger than this limit is encountered\n"
            "then some data\n"
            "will be irrevocably lost.\n\n"
+           "The data is assumed to be binary, and there is no decoding of\n"
+           "of locale-encoded strings.\n\n"
            "The optional @var{flags} argument is a value or\n"
            "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
            "The value returned is the number of bytes read from the\n"
@@ -1428,6 +1431,7 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
   int flg;
   char *dest;
   size_t len;
+  SCM msg;
 
   SCM_VALIDATE_OPFPORT (1, sock);
   SCM_VALIDATE_STRING (2, buf);
@@ -1437,16 +1441,16 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
     flg = scm_to_int (flags);
   fd = SCM_FPORT_FDES (sock);
 
-  len =  scm_i_string_length (buf);
-  buf = scm_i_string_start_writing (buf);
-  dest = scm_i_string_writable_chars (buf);
+  len = scm_i_string_length (buf);
+  msg = scm_i_make_string (len, &dest);
   SCM_SYSCALL (rv = recv (fd, dest, len, flg));
-  scm_i_string_stop_writing ();
+  scm_string_copy_x (buf, scm_from_int (0), 
+                    msg, scm_from_int (0), scm_from_size_t (len));
 
   if (rv == -1)
     SCM_SYSERROR;
 
-  scm_remember_upto_here_1 (buf);
+  scm_remember_upto_here_2 (buf, msg);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1464,18 +1468,28 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
            "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
            "Note that the data is written directly to the socket\n"
            "file descriptor:\n"
-           "any unflushed buffered port data is ignored.")
+           "any unflushed buffered port data is ignored.\n\n"
+           "This operation is defined only for strings containing codepoints\n"
+           "zero to 255.")
 #define FUNC_NAME s_scm_send
 {
   int rv;
   int fd;
   int flg;
-  const char *src;
+  char *src;
   size_t len;
 
   sock = SCM_COERCE_OUTPORT (sock);
   SCM_VALIDATE_OPFPORT (1, sock);
   SCM_VALIDATE_STRING (2, message);
+  
+  /* If the string is wide, see if it can be coerced into
+     a narrow string.  */
+  if (!scm_i_is_narrow_string (message)
+      || scm_i_try_narrow_string (message))
+    SCM_MISC_ERROR ("the message string is not 8-bit: ~s", 
+                        scm_list_1 (message));
+
   if (SCM_UNBNDP (flags))
     flg = 0;
   else
@@ -1592,7 +1606,9 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
            "set to be non-blocking.\n"
            "Note that the data is written directly to the socket\n"
            "file descriptor:\n"
-           "any unflushed buffered port data is ignored.")
+           "any unflushed buffered port data is ignored.\n"
+           "This operation is defined only for strings containing codepoints\n"
+           "zero to 255.")
 #define FUNC_NAME s_scm_sendto
 {
   int rv;
diff --git a/libguile/sort.c b/libguile/sort.c
index 644526e..a9e4dda 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001,2002, 2004, 2006, 2007, 2008 Free Software 
Foundation, Inc.
+/* Copyright (C) 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
  * as published by the Free Software Foundation; either version 3 of
@@ -39,8 +39,8 @@
 
 #include "libguile/_scm.h"
 #include "libguile/eval.h"
-#include "libguile/unif.h"
-#include "libguile/ramap.h"
+#include "libguile/arrays.h"
+#include "libguile/array-map.h"
 #include "libguile/feature.h"
 #include "libguile/vectors.h"
 #include "libguile/lang.h"
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index 2cbf048..77430bd 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -69,7 +69,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
  * car = tag
  * cbr = pos
  * ccr = copy
- * cdr = plist 
+ * cdr = alist
  */
 
 #define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p)))
@@ -78,7 +78,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 #define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
 #define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
 #define SRCPROPCOPY(p) (SCM_CELL_OBJECT(p,2))
-#define SRCPROPPLIST(p) (SCM_CELL_OBJECT_3(p))
+#define SRCPROPALIST(p) (SCM_CELL_OBJECT_3(p))
 #define SETSRCPROPBRK(p) \
  (SCM_SET_SMOB_FLAGS ((p), \
                       SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK))
@@ -90,9 +90,11 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 #define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
 #define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
 #define SETSRCPROPCOPY(p, c) (SCM_SET_CELL_WORD(p, 2, c))
-#define SETSRCPROPPLIST(p, l) (SCM_SET_CELL_WORD(p, 3, l))
+#define SETSRCPROPALIST(p, l) (SCM_SET_CELL_WORD(p, 3, l))
 
 
+static SCM scm_srcprops_to_alist (SCM obj);
+
 
 scm_t_bits scm_tc16_srcprops;
 
@@ -102,7 +104,7 @@ srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
   int writingp = SCM_WRITINGP (pstate);
   scm_puts ("#<srcprops ", port);
   SCM_SET_WRITINGP (pstate, 1);
-  scm_iprin1 (scm_srcprops_to_plist (obj), port, pstate);
+  scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate);
   SCM_SET_WRITINGP (pstate, writingp);
   scm_putc ('>', port);
   return 1;
@@ -118,57 +120,57 @@ scm_c_source_property_breakpoint_p (SCM form)
 
 
 /*
- * We remember the last file name settings, so we can share that plist
+ * We remember the last file name settings, so we can share that alist
  * entry.  This works because scm_set_source_property_x does not use
- * assoc-set! for modifying the plist.
+ * assoc-set! for modifying the alist.
  *
  * This variable contains a protected cons, whose cdr is the cached
- * plist
+ * alist
  */
-static SCM scm_last_plist_filename;
+static SCM scm_last_alist_filename;
 
 SCM
-scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist)
+scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
 {
   if (!SCM_UNBNDP (filename))
     {
-      SCM old_plist = plist;
+      SCM old_alist = alist;
 
       /*
        have to extract the acons, and operate on that, for
        thread safety.
        */
-      SCM last_acons = SCM_CDR (scm_last_plist_filename);
-      if (old_plist == SCM_EOL
+      SCM last_acons = SCM_CDR (scm_last_alist_filename);
+      if (old_alist == SCM_EOL
          && SCM_CDAR (last_acons) == filename)
        {
-         plist = last_acons;
+         alist = last_acons;
        }
       else
        {
-         plist = scm_acons (scm_sym_filename, filename, plist);
-         if (old_plist == SCM_EOL)
-           SCM_SETCDR (scm_last_plist_filename, plist);
+         alist = scm_acons (scm_sym_filename, filename, alist);
+         if (old_alist == SCM_EOL)
+           SCM_SETCDR (scm_last_alist_filename, alist);
        }
     }
   
   SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
                       SRCPROPMAKPOS (line, col),
                       copy,
-                      plist);
+                      alist);
 }
 
 
-SCM
-scm_srcprops_to_plist (SCM obj)
+static SCM
+scm_srcprops_to_alist (SCM obj)
 {
-  SCM plist = SRCPROPPLIST (obj);
+  SCM alist = SRCPROPALIST (obj);
   if (!SCM_UNBNDP (SRCPROPCOPY (obj)))
-    plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist);
-  plist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), plist);
-  plist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), plist);
-  plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), 
plist);
-  return plist;
+    alist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), alist);
+  alist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), alist);
+  alist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), alist);
+  alist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), 
alist);
+  return alist;
 }
 
 SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, 
@@ -184,7 +186,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 
0, 0,
     SCM_WRONG_TYPE_ARG (1, obj);
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
   if (SRCPROPSP (p))
-    return scm_srcprops_to_plist (p);
+    return scm_srcprops_to_alist (p);
   else
     /* list from set-source-properties!, or SCM_EOL for not found */
     return p;
@@ -194,20 +196,83 @@ SCM_DEFINE (scm_source_properties, "source-properties", 
1, 0, 0,
 /* Perhaps this procedure should look through an alist
    and try to make a srcprops-object...? */
 SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
-            (SCM obj, SCM plist),
-           "Install the association list @var{plist} as the source property\n"
+            (SCM obj, SCM alist),
+           "Install the association list @var{alist} as the source property\n"
            "list for @var{obj}.")
 #define FUNC_NAME s_scm_set_source_properties_x
 {
   SCM handle;
+  long line = 0, col = 0;
+  SCM fname = SCM_UNDEFINED, copy = SCM_UNDEFINED, breakpoint = SCM_BOOL_F;
+  SCM others = SCM_EOL;
+  SCM *others_cdrloc = &others;
+  int need_srcprops = 0;
+  SCM tail, key;
+
   SCM_VALIDATE_NIM (1, obj);
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
   else if (!scm_is_pair (obj))
     SCM_WRONG_TYPE_ARG(1, obj);
-  handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist);
 
-  return plist;
+  tail = alist;
+  while (!scm_is_null (tail))
+    {
+      key = SCM_CAAR (tail);
+      if (scm_is_eq (key, scm_sym_line))
+       {
+         line = scm_to_long (SCM_CDAR (tail));
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_column))
+       {
+         col = scm_to_long (SCM_CDAR (tail));
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_filename))
+       {
+         fname = SCM_CDAR (tail);
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_copy))
+       {
+         copy = SCM_CDAR (tail);
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_breakpoint))
+       {
+         breakpoint = SCM_CDAR (tail);
+         need_srcprops = 1;
+       }
+      else
+       {
+         /* Do we allocate here, or clobber the caller's alist?
+
+            Source properties aren't supposed to be used for anything
+            except the special properties above, so the mainline case
+            is that we never execute this else branch, and hence it
+            doesn't matter much.
+
+            We choose allocation here, as that seems safer.
+         */
+         *others_cdrloc = scm_cons (scm_cons (key, SCM_CDAR (tail)),
+                                    SCM_EOL);
+         others_cdrloc = SCM_CDRLOC (*others_cdrloc);
+       }
+      tail = SCM_CDR (tail);
+    }
+  if (need_srcprops)
+    {
+      alist = scm_make_srcprops (line, col, fname, copy, others);
+      if (scm_is_true (breakpoint))
+       SETSRCPROPBRK (alist);
+    }
+  else
+    alist = others;
+
+  handle = scm_hashq_create_handle_x (scm_source_whash, obj, alist);
+  SCM_SETCDR (handle, alist);
+  return alist;
 }
 #undef FUNC_NAME
 
@@ -225,15 +290,15 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 
0,
     SCM_WRONG_TYPE_ARG (1, obj);
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
   if (!SRCPROPSP (p))
-    goto plist;
+    goto alist;
   if      (scm_is_eq (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK 
(p));
   else if (scm_is_eq (scm_sym_line,       key)) p = scm_from_int (SRCPROPLINE 
(p));
   else if (scm_is_eq (scm_sym_column,     key)) p = scm_from_int (SRCPROPCOL 
(p));
   else if (scm_is_eq (scm_sym_copy,       key)) p = SRCPROPCOPY (p);
   else
     {
-      p = SRCPROPPLIST (p);
-    plist:
+      p = SRCPROPALIST (p);
+    alist:
       p = scm_assoc (key, p);
       return (SCM_NIMP (p) ? SCM_CDR (p) : SCM_BOOL_F);
     }
@@ -309,7 +374,7 @@ SCM_DEFINE (scm_set_source_property_x, 
"set-source-property!", 3, 0, 0,
   else
     {
       if (SRCPROPSP (p))
-       SETSRCPROPPLIST (p, scm_acons (key, datum, SRCPROPPLIST (p)));
+       SETSRCPROPALIST (p, scm_acons (key, datum, SRCPROPALIST (p)));
       else
        SCM_WHASHSET (scm_source_whash, h, scm_acons (key, datum, p));
     }
@@ -327,7 +392,7 @@ scm_init_srcprop ()
   scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047));
   scm_c_define ("source-whash", scm_source_whash);
 
-  scm_last_plist_filename
+  scm_last_alist_filename
     = scm_permanent_object (scm_cons (SCM_EOL,
                                      scm_acons (SCM_EOL, SCM_EOL, SCM_EOL)));
 
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index 2a27e04..89063be 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -64,13 +64,11 @@ SCM_API SCM scm_sym_breakpoint;
 
 
 SCM_API int scm_c_source_property_breakpoint_p (SCM form);
-SCM_API SCM scm_srcprops_to_plist (SCM obj);
 SCM_API SCM scm_make_srcprops (long line, int col, SCM fname, SCM copy, SCM 
plist);
 SCM_API SCM scm_source_property (SCM obj, SCM key);
 SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
 SCM_API SCM scm_source_properties (SCM obj);
 SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props);
-SCM_API void scm_finish_srcprop (void);
 SCM_INTERNAL void scm_init_srcprop (void);
 
 #if SCM_ENABLE_DEPRECATED == 1
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 781fe68..4faa377 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -1,6 +1,6 @@
 /* srfi-13.c --- SRFI-13 procedures for Guile
  *
- * Copyright (C) 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2005, 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
@@ -24,41 +24,14 @@
 #endif
 
 #include <string.h>
-#include <ctype.h>
+#include <unicase.h>
+#include <unictype.h>
 
 #include "libguile.h"
 
 #include "libguile/srfi-13.h"
 #include "libguile/srfi-14.h"
 
-/* SCM_VALIDATE_SUBSTRING_SPEC_COPY is deprecated since it encourages
-   messing with the internal representation of strings.  We define our
-   own version since we use it so much and are messing with Guile
-   internals anyway.
-*/
-
-#define MY_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, c_str,        \
-                                        pos_start, start, c_start,  \
-                                        pos_end, end, c_end)        \
-  do {                                                              \
-    SCM_VALIDATE_STRING (pos_str, str);                             \
-    c_str = scm_i_string_chars (str);                               \
-    scm_i_get_substring_spec (scm_i_string_length (str),            \
-                             start, &c_start, end, &c_end);        \
-  } while (0)
-
-/* Expecting "unsigned char *c_str" */
-#define MY_VALIDATE_SUBSTRING_SPEC_UCOPY(pos_str, str, c_str,           \
-                                         pos_start, start, c_start,     \
-                                         pos_end, end, c_end)           \
-  do {                                                                  \
-    const char *signed_c_str;                                           \
-    MY_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, signed_c_str,         \
-                                    pos_start, start, c_start,          \
-                                    pos_end, end, c_end);               \
-    c_str = (unsigned char *) signed_c_str;                             \
-  } while (0)
-
 #define MY_VALIDATE_SUBSTRING_SPEC(pos_str, str,              \
                                    pos_start, start, c_start, \
                                    pos_end, end, c_end)       \
@@ -68,6 +41,18 @@
                              start, &c_start, end, &c_end);  \
   } while (0)
 
+#define MY_SUBF_VALIDATE_SUBSTRING_SPEC(fname, pos_str, str,            \
+                                       pos_start, start, c_start,      \
+                                       pos_end, end, c_end)            \
+  do {                                                                  \
+    SCM_ASSERT_TYPE (scm_is_string (str), str, pos_str, fname, "string"); \
+    scm_i_get_substring_spec (scm_i_string_length (str),                \
+                             start, &c_start, end, &c_end);            \
+  } while (0)
+
+#define REF_IN_CHARSET(s, i, cs)                                       \
+  (scm_is_true (scm_char_set_contains_p ((cs), SCM_MAKE_CHAR (scm_i_string_ref 
(s, i)))))
+
 SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
            (SCM str),
            "Return @code{#t} if @var{str}'s length is zero, and\n"
@@ -111,25 +96,28 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
 "@var{end}) then the return is @code{#f}.\n")
 #define FUNC_NAME s_scm_string_any
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM res = SCM_BOOL_F;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   if (SCM_CHARP (char_pred))
     {
-      res = (memchr (cstr+cstart, (int) SCM_CHAR (char_pred),
-                    cend-cstart) == NULL
-            ? SCM_BOOL_F : SCM_BOOL_T);
+      size_t i;
+      for (i = cstart; i < cend; i ++)
+       if (scm_i_string_ref (s, i) == SCM_CHAR (char_pred))
+         {
+           res = SCM_BOOL_T;
+           break;
+         }
     }
   else if (SCM_CHARSETP (char_pred))
     {
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (SCM_CHARSET_GET (char_pred, cstr[i]))
+        if (REF_IN_CHARSET (s, i, char_pred))
          {
            res = SCM_BOOL_T;
            break;
@@ -142,10 +130,10 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
 
       while (cstart < cend)
         {
-          res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+          res = pred_tramp (char_pred, 
+                            SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
           if (scm_is_true (res))
             break;
-         cstr = scm_i_string_chars (s);
           cstart++;
         }
     }
@@ -176,19 +164,17 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 
2, 0,
 "@var{end}) then the return is @code{#t}.\n")
 #define FUNC_NAME s_scm_string_every
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM res = SCM_BOOL_T;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (cstr[i] != cchr)
+        if (scm_i_string_ref (s, i) != SCM_CHAR (char_pred))
          {
            res = SCM_BOOL_F;
            break;
@@ -198,7 +184,7 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 
0,
     {
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (!SCM_CHARSET_GET (char_pred, cstr[i]))
+        if (!REF_IN_CHARSET (s, i, char_pred))
          {
            res = SCM_BOOL_F;
            break;
@@ -211,10 +197,10 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 
2, 0,
 
       while (cstart < cend)
         {
-          res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+          res = pred_tramp (char_pred, 
+                            SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
           if (scm_is_false (res))
             break;
-          cstr = scm_i_string_chars (s);
           cstart++;
         }
     }
@@ -236,28 +222,49 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 
0,
   size_t clen, i;
   SCM res;
   SCM ch;
-  char *p;
   scm_t_trampoline_1 proc_tramp;
 
   proc_tramp = scm_trampoline_1 (proc);
   SCM_ASSERT (proc_tramp, proc, SCM_ARG1, FUNC_NAME);
 
+  SCM_ASSERT_RANGE (2, len, scm_to_int (len) >= 0);
   clen = scm_to_size_t (len);
-  SCM_ASSERT_RANGE (2, len, clen >= 0);
 
-  res = scm_i_make_string (clen, &p);
-  i = 0;
-  while (i < clen)
-    {
-      /* The RES string remains untouched since nobody knows about it
-        yet. No need to refetch P.
-      */
-      ch = proc_tramp (proc, scm_from_size_t (i));
-      if (!SCM_CHARP (ch))
-       SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-      *p++ = SCM_CHAR (ch);
-      i++;
-    }
+  {
+    /* This function is more complicated than necessary for the sake
+       of speed.  */
+    scm_t_wchar *buf = scm_malloc (clen * sizeof (scm_t_wchar));
+    int wide = 0;
+    i = 0; 
+    while (i < clen)
+      {
+        ch = proc_tramp (proc, scm_from_size_t (i));
+        if (!SCM_CHARP (ch))
+          {
+            SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 
(proc));
+          }
+        if (SCM_CHAR (ch) > 255)
+          wide = 1;
+        buf[i] = SCM_CHAR (ch);
+        i++;
+      }
+    if (wide)
+      {
+        scm_t_wchar *wbuf = NULL;
+        res = scm_i_make_wide_string (clen, &wbuf);
+        memcpy (wbuf, buf, clen * sizeof (scm_t_wchar));
+        free (buf);
+      }
+    else
+      {
+        char *nbuf = NULL;
+        res = scm_i_make_string (clen, &nbuf);
+        for (i = 0; i < clen; i ++)
+          nbuf[i] = (unsigned char) buf[i];
+        free (buf);
+      }
+  }
+
   return res;
 }
 #undef FUNC_NAME
@@ -268,18 +275,34 @@ SCM_DEFINE (scm_substring_to_list, "string->list", 1, 2, 
0,
            "Convert the string @var{str} into a list of characters.")
 #define FUNC_NAME s_scm_substring_to_list
 {
-  const char *cstr;
   size_t cstart, cend;
+  int narrow;
   SCM result = SCM_EOL;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
-  while (cstart < cend)
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
+
+  /* This explicit narrow/wide logic (instead of just using
+     scm_i_string_ref) is for speed optimizaion.  */
+  narrow = scm_i_is_narrow_string (str);
+  if (narrow)
     {
-      cend--;
-      result = scm_cons (SCM_MAKE_CHAR (cstr[cend]), result);
-      cstr = scm_i_string_chars (str);
+      const char *buf = scm_i_string_chars (str);
+      while (cstart < cend)
+        {
+          cend--;
+          result = scm_cons (SCM_MAKE_CHAR (buf[cend]), result);
+        }
+    }
+  else
+    {
+      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+      while (cstart < cend)
+        {
+          cend--;
+          result = scm_cons (SCM_MAKE_CHAR (buf[cend]), result);
+        }
     }
   scm_remember_upto_here_1 (str);
   return result;
@@ -308,7 +331,7 @@ SCM_DEFINE (scm_reverse_list_to_string, 
"reverse-list->string", 1, 0, 0,
 #define FUNC_NAME s_scm_reverse_list_to_string
 {
   SCM result;
-  long i = scm_ilength (chrs);
+  long i = scm_ilength (chrs), j;
   char *data;
 
   if (i < 0)
@@ -316,18 +339,27 @@ SCM_DEFINE (scm_reverse_list_to_string, 
"reverse-list->string", 1, 0, 0,
   result = scm_i_make_string (i, &data);
 
   {
-    
-    data += i;
-    while (i > 0 && scm_is_pair (chrs))
+    SCM rest;
+    rest = chrs;
+    j = 0;
+    while (j < i && scm_is_pair (rest))
       {
-       SCM elt = SCM_CAR (chrs);
-
-       SCM_VALIDATE_CHAR (SCM_ARGn, elt);
-       data--;
-       *data = SCM_CHAR (elt);
-       chrs = SCM_CDR (chrs);
-       i--;
+        SCM elt = SCM_CAR (rest);
+        SCM_VALIDATE_CHAR (SCM_ARGn, elt);
+        j++;
+        rest = SCM_CDR (rest);
+      }
+    rest = chrs;
+    j = i;
+    result = scm_i_string_start_writing (result);
+    while (j > 0 && scm_is_pair (rest))
+      {
+        SCM elt = SCM_CAR (rest);
+        scm_i_string_set_x (result, j-1, SCM_CHAR (elt));
+        rest = SCM_CDR (rest);
+        j--;
       }
+    scm_i_string_stop_writing ();
   }
 
   return result;
@@ -340,18 +372,6 @@ SCM_SYMBOL (scm_sym_strict_infix, "strict-infix");
 SCM_SYMBOL (scm_sym_suffix, "suffix");
 SCM_SYMBOL (scm_sym_prefix, "prefix");
 
-static void
-append_string (char **sp, size_t *lp, SCM str)
-{
-  size_t len;
-  len = scm_c_string_length (str);
-  if (len > *lp)
-    len = *lp;
-  memcpy (*sp, scm_i_string_chars (str), len);
-  *lp -= len;
-  *sp += len;
-}
-
 SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
             (SCM ls, SCM delimiter, SCM grammar),
            "Append the string in the string list @var{ls}, using the string\n"
@@ -382,8 +402,6 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
   SCM result;
   int gram = GRAM_INFIX;
   size_t del_len = 0;
-  size_t len = 0;
-  char *p;
   long strings = scm_ilength (ls);
 
   /* Validate the string list.  */
@@ -397,7 +415,10 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
       del_len = 1;
     }
   else
-    del_len = scm_c_string_length (delimiter);
+    {
+      SCM_VALIDATE_STRING (2, delimiter);
+      del_len = scm_i_string_length (delimiter);
+    }
 
   /* Validate the grammar symbol and remember the grammar.  */
   if (SCM_UNBNDP (grammar))
@@ -413,33 +434,12 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
   else
     SCM_WRONG_TYPE_ARG (3, grammar);
 
-  /* Check grammar constraints and calculate the space required for
-     the delimiter(s).  */
-  switch (gram)
-    {
-    case GRAM_INFIX:
-      if (!scm_is_null (ls))
-       len = (strings > 0) ? ((strings - 1) * del_len) : 0;
-      break;
-    case GRAM_STRICT_INFIX:
-      if (strings == 0)
-       SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
-                       SCM_EOL);
-      len = (strings - 1) * del_len;
-      break;
-    default:
-      len = strings * del_len;
-      break;
-    }
-
-  tmp = ls;
-  while (scm_is_pair (tmp))
-    {
-      len += scm_c_string_length (SCM_CAR (tmp));
-      tmp = SCM_CDR (tmp);
-    }
+  /* Check grammar constraints.  */
+  if (strings == 0 && gram == GRAM_STRICT_INFIX)
+    SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
+                   SCM_EOL);
 
-  result = scm_i_make_string (len, &p);
+  result = scm_i_make_string (0, NULL);
 
   tmp = ls;
   switch (gram)
@@ -448,18 +448,18 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
     case GRAM_STRICT_INFIX:
       while (scm_is_pair (tmp))
        {
-         append_string (&p, &len, SCM_CAR (tmp));
+         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
          if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0)
-           append_string (&p, &len, delimiter);
+           result = scm_string_append (scm_list_2 (result, delimiter));
          tmp = SCM_CDR (tmp);
        }
       break;
     case GRAM_SUFFIX:
       while (scm_is_pair (tmp))
        {
-         append_string (&p, &len, SCM_CAR (tmp));
+         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
          if (del_len > 0)
-           append_string (&p, &len, delimiter);
+           result = scm_string_append (scm_list_2 (result, delimiter));
          tmp = SCM_CDR (tmp);
        }
       break;
@@ -467,8 +467,8 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
       while (scm_is_pair (tmp))
        {
          if (del_len > 0)
-           append_string (&p, &len, delimiter);
-         append_string (&p, &len, SCM_CAR (tmp));
+           result = scm_string_append (scm_list_2 (result, delimiter));
+         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
          tmp = SCM_CDR (tmp);
        }
       break;
@@ -508,20 +508,22 @@ SCM_DEFINE (scm_srfi13_substring_copy, "string-copy", 1, 
2, 0,
            "@var{str} which is copied.")
 #define FUNC_NAME s_scm_srfi13_substring_copy
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
-  return scm_c_substring_copy (str, cstart, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
+  return scm_i_substring_copy (str, cstart, cend);
 }
 #undef FUNC_NAME
 
 SCM 
 scm_string_copy (SCM str)
 {
-  return scm_c_substring (str, 0, scm_c_string_length (str));
+  if (!scm_is_string (str))
+    scm_wrong_type_arg ("scm_string_copy", 0, str);
+
+  return scm_i_substring (str, 0, scm_i_string_length (str));
 }
 
 SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
@@ -535,23 +537,24 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
            "string.")
 #define FUNC_NAME s_scm_string_copy_x
 {
-  const char *cstr;
-  char *ctarget;
-  size_t cstart, cend, ctstart, dummy, len;
+  size_t cstart, cend, ctstart, dummy, len, i;
   SCM sdummy = SCM_UNDEFINED;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, target,
                              2, tstart, ctstart,
                              2, sdummy, dummy);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-                                  4, start, cstart,
-                                  5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+                             4, start, cstart,
+                             5, end, cend);
   len = cend - cstart;
   SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
 
   target = scm_i_string_start_writing (target);
-  ctarget = scm_i_string_writable_chars (target);
-  memmove (ctarget + ctstart, cstr + cstart, len);
+  for (i = 0; i < cend - cstart; i++)
+    {
+      scm_i_string_set_x (target, ctstart + i, 
+                          scm_i_string_ref (s, cstart + i));
+    }
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (target);
 
@@ -622,7 +625,6 @@ SCM_DEFINE (scm_string_pad, "string-pad", 2, 3, 0,
            "string is longer than @var{len}, it is truncated on the right.")
 #define FUNC_NAME s_scm_string_pad
 {
-  char cchr;
   size_t cstart, cend, clen;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, s,
@@ -631,23 +633,19 @@ SCM_DEFINE (scm_string_pad, "string-pad", 2, 3, 0,
   clen = scm_to_size_t (len);
 
   if (SCM_UNBNDP (chr))
-    cchr = ' ';
+    chr = SCM_MAKE_CHAR (' ');
   else
     {
       SCM_VALIDATE_CHAR (3, chr);
-      cchr = SCM_CHAR (chr);
     }
   if (clen < (cend - cstart))
-    return scm_c_substring (s, cend - clen, cend);
+    return scm_i_substring (s, cend - clen, cend);
   else
     {
       SCM result;
-      char *dst;
-
-      result = scm_i_make_string (clen, &dst);
-      memset (dst, cchr, (clen - (cend - cstart)));
-      memmove (dst + clen - (cend - cstart),
-              scm_i_string_chars (s) + cstart, cend - cstart);
+      result = (scm_string_append 
+               (scm_list_2 (scm_c_make_string (clen - (cend - cstart), chr),
+                            scm_i_substring (s, cstart, cend))));
       return result;
     }
 }
@@ -662,7 +660,6 @@ SCM_DEFINE (scm_string_pad_right, "string-pad-right", 2, 3, 
0,
            "string is longer than @var{len}, it is truncated on the left.")
 #define FUNC_NAME s_scm_string_pad_right
 {
-  char cchr;
   size_t cstart, cend, clen;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, s,
@@ -671,22 +668,21 @@ SCM_DEFINE (scm_string_pad_right, "string-pad-right", 2, 
3, 0,
   clen = scm_to_size_t (len);
 
   if (SCM_UNBNDP (chr))
-    cchr = ' ';
+    chr = SCM_MAKE_CHAR (' ');
   else
     {
       SCM_VALIDATE_CHAR (3, chr);
-      cchr = SCM_CHAR (chr);
     }
   if (clen < (cend - cstart))
-    return scm_c_substring (s, cstart, cstart + clen);
+    return scm_i_substring (s, cstart, cstart + clen);
   else
     {
       SCM result;
-      char *dst;
 
-      result = scm_i_make_string (clen, &dst);
-      memset (dst + (cend - cstart), cchr, clen - (cend - cstart));
-      memmove (dst, scm_i_string_chars (s) + cstart, cend - cstart);
+      result = (scm_string_append 
+               (scm_list_2 (scm_i_substring (s, cstart, cend),
+                            scm_c_make_string (clen - (cend - cstart), chr))));
+
       return result;
     }
 }
@@ -715,27 +711,25 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
            "trimmed.")
 #define FUNC_NAME s_scm_string_trim
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cstart]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cstart)))
            break;
          cstart++;
        }
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (chr != cstr[cstart])
+         if (scm_i_string_ref (s, cstart) != SCM_CHAR (char_pred))
            break;
          cstart++;
        }
@@ -744,7 +738,7 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (!REF_IN_CHARSET (s, cstart, char_pred))
            break;
          cstart++;
        }
@@ -758,21 +752,20 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
            (SCM s, SCM char_pred, SCM start, SCM end),
-           "Trim @var{s} by skipping over all characters on the rightt\n"
+           "Trim @var{s} by skipping over all characters on the right\n"
            "that satisfy the parameter @var{char_pred}:\n"
            "\n"
            "@itemize @bullet\n"
@@ -793,27 +786,25 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 
1, 3, 0,
            "trimmed.")
 #define FUNC_NAME s_scm_string_trim_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cend - 1]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cend - 1)))
            break;
          cend--;
        }
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (chr != cstr[cend - 1])
+         if (scm_i_string_ref (s, cend - 1) != SCM_CHAR (char_pred))
            break;
          cend--;
        }
@@ -822,7 +813,7 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 
3, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cend - 1]))
+         if (!REF_IN_CHARSET (s, cend-1, char_pred))
            break;
          cend--;
        }
@@ -836,14 +827,13 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 
1, 3, 0,
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend 
- 1)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cend--;
        }
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
@@ -871,39 +861,37 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 
3, 0,
            "trimmed.")
 #define FUNC_NAME s_scm_string_trim_both
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cstart]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cstart)))
            break;
          cstart++;
        }
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cend - 1]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cend - 1)))
            break;
          cend--;
        }
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (chr != cstr[cstart])
+         if (scm_i_string_ref (s, cstart) != SCM_CHAR(char_pred))
            break;
          cstart++;
        }
       while (cstart < cend)
        {
-         if (chr != cstr[cend - 1])
+         if (scm_i_string_ref (s, cend - 1) != SCM_CHAR (char_pred))
            break;
          cend--;
        }
@@ -912,13 +900,13 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 
3, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (!REF_IN_CHARSET (s, cstart, char_pred))
            break;
          cstart++;
        }
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cend - 1]))
+         if (!REF_IN_CHARSET (s, cend-1, char_pred))
            break;
          cend--;
        }
@@ -932,24 +920,22 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 
3, 0,
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
       while (cstart < cend)
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend 
- 1)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cend--;
        }
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
@@ -960,9 +946,7 @@ SCM_DEFINE (scm_substring_fill_x, "string-fill!", 2, 2, 0,
            "returns an unspecified value.")
 #define FUNC_NAME s_scm_substring_fill_x
 {
-  char *cstr;
   size_t cstart, cend;
-  int c;
   size_t k;
 
   /* Older versions of Guile provided the function
@@ -984,14 +968,13 @@ SCM_DEFINE (scm_substring_fill_x, "string-fill!", 2, 2, 0,
   MY_VALIDATE_SUBSTRING_SPEC (1, str,
                              3, start, cstart,
                              4, end, cend);
-  SCM_VALIDATE_CHAR_COPY (2, chr, c);
+  SCM_VALIDATE_CHAR (2, chr);
+
 
   str = scm_i_string_start_writing (str);
-  cstr = scm_i_string_writable_chars (str);
   for (k = cstart; k < cend; k++)
-    cstr[k] = c;
+    scm_i_string_set_x (str, k, SCM_CHAR (chr));
   scm_i_string_stop_writing ();
-  scm_remember_upto_here_1 (str);
 
   return SCM_UNSPECIFIED;
 }
@@ -1013,28 +996,29 @@ SCM_DEFINE (scm_string_compare, "string-compare", 5, 4, 
0,
            "@var{i} is the first position that does not match.")
 #define FUNC_NAME s_scm_string_compare
 {
-  const unsigned char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   SCM proc;
 
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    6, start1, cstart1,
-                                    7, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    8, start2, cstart2,
-                                    9, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             6, start1, cstart1,
+                             7, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             8, start2, cstart2,
+                             9, end2, cend2);
   SCM_VALIDATE_PROC (3, proc_lt);
   SCM_VALIDATE_PROC (4, proc_eq);
   SCM_VALIDATE_PROC (5, proc_gt);
 
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] < cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+         < scm_i_string_ref (s2, cstart2))
        {
          proc = proc_lt;
          goto ret;
        }
-      else if (cstr1[cstart1] > cstr2[cstart2])
+      else if (scm_i_string_ref (s1, cstart1) 
+              > scm_i_string_ref (s2, cstart2))
        {
          proc = proc_gt;
          goto ret;
@@ -1063,33 +1047,33 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 
5, 4, 0,
            "equal to, or greater than @var{s2}.  The mismatch index is the\n"
            "largest index @var{i} such that for every 0 <= @var{j} <\n"
            "@var{i}, @address@hidden = @address@hidden -- that is,\n"
-           "@var{i} is the first position that does not match.  The\n"
-           "character comparison is done case-insensitively.")
+           "@var{i} is the first position where the lowercased letters \n"
+           "do not match.\n")
 #define FUNC_NAME s_scm_string_compare_ci
 {
-  const unsigned char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   SCM proc;
 
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    6, start1, cstart1,
-                                    7, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    8, start2, cstart2,
-                                    9, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             6, start1, cstart1,
+                             7, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             8, start2, cstart2,
+                             9, end2, cend2);
   SCM_VALIDATE_PROC (3, proc_lt);
   SCM_VALIDATE_PROC (4, proc_eq);
   SCM_VALIDATE_PROC (5, proc_gt);
 
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+         < uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
        {
          proc = proc_lt;
          goto ret;
        }
-      else if (scm_c_downcase (cstr1[cstart1]) 
-              > scm_c_downcase (cstr2[cstart2]))
+      else if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+              > uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
        {
          proc = proc_gt;
          goto ret;
@@ -1111,42 +1095,83 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 
5, 4, 0,
 }
 #undef FUNC_NAME
 
-
-SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
-           (SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2),
-           "Return @code{#f} if @var{s1} and @var{s2} are not equal, a true\n"
-           "value otherwise.")
-#define FUNC_NAME s_scm_string_eq
+/* This function compares two substrings, S1 from START1 to END1 and
+   S2 from START2 to END2, possibly case insensitively, and returns
+   one of the parameters LESSTHAN, GREATERTHAN, LONGER, SHORTER, or
+   EQUAL depending if S1 is less than S2, greater than S2, longer,
+   shorter, or equal. */
+static SCM
+compare_strings (const char *fname, int case_insensitive,
+                SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2,
+                SCM lessthan, SCM greaterthan, SCM longer, SCM shorter, SCM 
equal)
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
+  SCM ret;
+  scm_t_wchar a, b;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
+  MY_SUBF_VALIDATE_SUBSTRING_SPEC (fname, 1, s1,
                                   3, start1, cstart1,
                                   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
+  MY_SUBF_VALIDATE_SUBSTRING_SPEC (fname, 2, s2,
                                   5, start2, cstart2,
                                   6, end2, cend2);
 
-  if ((cend1 - cstart1) != (cend2 - cstart2))
-    goto false;
-
-  while (cstart1 < cend1)
+  while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto false;
+      if (case_insensitive)
+       {
+         a = uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)));
+         b = uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2)));
+       }
+      else
+       {
+         a = scm_i_string_ref (s1, cstart1);
+         b = scm_i_string_ref (s2, cstart2);
+       }
+      if (a < b)
+       {
+         ret = lessthan;
+         goto done;
+       }
+      else if (a > b)
+       {
+         ret = greaterthan;
+         goto done;
+       }
       cstart1++;
       cstart2++;
     }
-  
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
+  if (cstart1 < cend1)
+    {
+      ret = longer;
+      goto done;
+    }
+  else if (cstart2 < cend2)
+    {
+      ret = shorter;
+      goto done;
+    }
+  else
+    {
+      ret = equal;
+      goto done;
+    }
 
- false:
+ done:
   scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return ret;
+}
+
+
+SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
+           (SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2),
+           "Return @code{#f} if @var{s1} and @var{s2} are not equal, a true\n"
+           "value otherwise.")
+#define FUNC_NAME s_scm_string_eq
+{
+  return compare_strings (FUNC_NAME, 0, 
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1157,39 +1182,9 @@ SCM_DEFINE (scm_string_neq, "string<>", 2, 4, 0,
            "value otherwise.")
 #define FUNC_NAME s_scm_string_neq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1200,39 +1195,9 @@ SCM_DEFINE (scm_string_lt, "string<", 2, 4, 0,
            "true value otherwise.")
 #define FUNC_NAME s_scm_string_lt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1243,39 +1208,9 @@ SCM_DEFINE (scm_string_gt, "string>", 2, 4, 0,
            "true value otherwise.")
 #define FUNC_NAME s_scm_string_gt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1286,39 +1221,9 @@ SCM_DEFINE (scm_string_le, "string<=", 2, 4, 0,
            "value otherwise.")
 #define FUNC_NAME s_scm_string_le
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1329,39 +1234,9 @@ SCM_DEFINE (scm_string_ge, "string>=", 2, 4, 0,
            "otherwise.")
 #define FUNC_NAME s_scm_string_ge
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1373,39 +1248,9 @@ SCM_DEFINE (scm_string_ci_eq, "string-ci=", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_eq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1417,39 +1262,9 @@ SCM_DEFINE (scm_string_ci_neq, "string-ci<>", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_neq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1461,39 +1276,9 @@ SCM_DEFINE (scm_string_ci_lt, "string-ci<", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_lt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1505,39 +1290,9 @@ SCM_DEFINE (scm_string_ci_gt, "string-ci>", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_gt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1549,39 +1304,9 @@ SCM_DEFINE (scm_string_ci_le, "string-ci<=", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_le
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1593,39 +1318,9 @@ SCM_DEFINE (scm_string_ci_ge, "string-ci>=", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_ge
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1667,19 +1362,20 @@ SCM_DEFINE (scm_string_prefix_length, 
"string-prefix-length", 2, 4, 0,
            "strings.")
 #define FUNC_NAME s_scm_string_prefix_length
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
+  
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] != cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+          != scm_i_string_ref (s2, cstart2))
        goto ret;
       len++;
       cstart1++;
@@ -1699,19 +1395,19 @@ SCM_DEFINE (scm_string_prefix_length_ci, 
"string-prefix-length-ci", 2, 4, 0,
            "strings, ignoring character case.")
 #define FUNC_NAME s_scm_string_prefix_length_ci
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+         != uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
        goto ret;
       len++;
       cstart1++;
@@ -1731,21 +1427,21 @@ SCM_DEFINE (scm_string_suffix_length, 
"string-suffix-length", 2, 4, 0,
            "strings.")
 #define FUNC_NAME s_scm_string_suffix_length
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (cstr1[cend1] != cstr2[cend2])
+      if (scm_i_string_ref (s1, cend1) 
+         != scm_i_string_ref (s2, cend2))
        goto ret;
       len++;
     }
@@ -1763,21 +1459,21 @@ SCM_DEFINE (scm_string_suffix_length_ci, 
"string-suffix-length-ci", 2, 4, 0,
            "strings, ignoring character case.")
 #define FUNC_NAME s_scm_string_suffix_length_ci
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cend1)))
+         != uc_tolower (uc_toupper (scm_i_string_ref (s2, cend2))))
        goto ret;
       len++;
     }
@@ -1794,20 +1490,20 @@ SCM_DEFINE (scm_string_prefix_p, "string-prefix?", 2, 
4, 0,
            "Is @var{s1} a prefix of @var{s2}?")
 #define FUNC_NAME s_scm_string_prefix_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] != cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+          != scm_i_string_ref (s2, cstart2))
        goto ret;
       len++;
       cstart1++;
@@ -1826,20 +1522,21 @@ SCM_DEFINE (scm_string_prefix_ci_p, 
"string-prefix-ci?", 2, 4, 0,
            "Is @var{s1} a prefix of @var{s2}, ignoring character case?")
 #define FUNC_NAME s_scm_string_prefix_ci_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2]))
+      scm_t_wchar a = uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)));
+      scm_t_wchar b = uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2)));
+      if (a != b)
        goto ret;
       len++;
       cstart1++;
@@ -1858,22 +1555,22 @@ SCM_DEFINE (scm_string_suffix_p, "string-suffix?", 2, 
4, 0,
            "Is @var{s1} a suffix of @var{s2}?")
 #define FUNC_NAME s_scm_string_suffix_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (cstr1[cend1] != cstr2[cend2])
+      if (scm_i_string_ref (s1, cend1) 
+         != scm_i_string_ref (s2, cend2))
        goto ret;
       len++;
     }
@@ -1890,22 +1587,22 @@ SCM_DEFINE (scm_string_suffix_ci_p, 
"string-suffix-ci?", 2, 4, 0,
            "Is @var{s1} a suffix of @var{s2}, ignoring character case?")
 #define FUNC_NAME s_scm_string_suffix_ci_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cend1)))
+         != uc_tolower (uc_toupper (scm_i_string_ref (s2, cend2))))
        goto ret;
       len++;
     }
@@ -1934,18 +1631,16 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_index
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (cchr == cstr[cstart])
+         if (scm_i_string_ref (s, cstart) == SCM_CHAR (char_pred))
            goto found;
          cstart++;
        }
@@ -1954,7 +1649,7 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
     {
       while (cstart < cend)
        {
-         if (SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (REF_IN_CHARSET (s, cstart, char_pred))
            goto found;
          cstart++;
        }
@@ -1967,10 +1662,9 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
       while (cstart < cend)
        {
          SCM res;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_true (res))
            goto found;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
@@ -2001,19 +1695,17 @@ SCM_DEFINE (scm_string_index_right, 
"string-index-right", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_index_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
          cend--;
-         if (cchr == cstr[cend])
+         if (scm_i_string_ref (s, cend) == SCM_CHAR (char_pred))
            goto found;
        }
     }
@@ -2022,7 +1714,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 
2, 2, 0,
       while (cstart < cend)
        {
          cend--;
-         if (SCM_CHARSET_GET (char_pred, cstr[cend]))
+         if (REF_IN_CHARSET (s, cend, char_pred))
            goto found;
        }
     }
@@ -2035,10 +1727,9 @@ SCM_DEFINE (scm_string_index_right, 
"string-index-right", 2, 2, 0,
        {
          SCM res;
          cend--;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cend)));
          if (scm_is_true (res))
            goto found;
-         cstr = scm_i_string_chars (s);
        }
     }
 
@@ -2090,18 +1781,16 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_skip
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (cchr != cstr[cstart])
+         if (scm_i_string_ref (s, cstart) !=  SCM_CHAR (char_pred))
            goto found;
          cstart++;
        }
@@ -2110,7 +1799,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (!REF_IN_CHARSET (s, cstart, char_pred))
            goto found;
          cstart++;
        }
@@ -2123,10 +1812,9 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
       while (cstart < cend)
        {
          SCM res;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_false (res))
            goto found;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
@@ -2159,19 +1847,17 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 
2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_skip_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
          cend--;
-         if (cchr != cstr[cend])
+         if (scm_i_string_ref (s, cend) != SCM_CHAR (char_pred))
            goto found;
        }
     }
@@ -2180,7 +1866,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 
2, 2, 0,
       while (cstart < cend)
        {
          cend--;
-         if (!SCM_CHARSET_GET (char_pred, cstr[cend]))
+         if (!REF_IN_CHARSET (s, cend, char_pred))
            goto found;
        }
     }
@@ -2193,10 +1879,9 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 
2, 2, 0,
        {
          SCM res;
          cend--;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cend)));
          if (scm_is_false (res))
            goto found;
-         cstr = scm_i_string_chars (s);
        }
     }
 
@@ -2228,19 +1913,17 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_count
 {
-  const char *cstr;
   size_t cstart, cend;
   size_t count = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (cchr == cstr[cstart])
+         if (scm_i_string_ref (s, cstart) == SCM_CHAR(char_pred))
            count++;
          cstart++;
        }
@@ -2249,7 +1932,7 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
     {
       while (cstart < cend)
        {
-         if (SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (REF_IN_CHARSET (s, cstart, char_pred))
            count++;
          cstart++;
        }
@@ -2262,10 +1945,9 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
       while (cstart < cend)
        {
          SCM res;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_true (res))
            count++;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
@@ -2287,23 +1969,25 @@ SCM_DEFINE (scm_string_contains, "string-contains", 2, 
4, 0,
            "indicated substrings.")
 #define FUNC_NAME s_scm_string_contains
 {
-  const char *cs1, * cs2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len2, i, j;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cs1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cs2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len2 = cend2 - cstart2;
   if (cend1 - cstart1 >= len2)
     while (cstart1 <= cend1 - len2)
       {
        i = cstart1;
        j = cstart2;
-       while (i < cend1 && j < cend2 && cs1[i] == cs2[j])
+       while (i < cend1 
+              && j < cend2 
+              && (scm_i_string_ref (s1, i)
+                  == scm_i_string_ref (s2, j)))
          {
            i++;
            j++;
@@ -2334,24 +2018,25 @@ SCM_DEFINE (scm_string_contains_ci, 
"string-contains-ci", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_contains_ci
 {
-  const char *cs1, * cs2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len2, i, j;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cs1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cs2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len2 = cend2 - cstart2;
   if (cend1 - cstart1 >= len2)
     while (cstart1 <= cend1 - len2)
       {
        i = cstart1;
        j = cstart2;
-       while (i < cend1 && j < cend2 &&
-              scm_c_downcase (cs1[i]) == scm_c_downcase (cs2[j]))
+       while (i < cend1 
+              && j < cend2 
+              && (uc_tolower (uc_toupper (scm_i_string_ref (s1, i)))
+                  == uc_tolower (uc_toupper (scm_i_string_ref (s2, j)))))
          {
            i++;
            j++;
@@ -2370,18 +2055,15 @@ SCM_DEFINE (scm_string_contains_ci, 
"string-contains-ci", 2, 4, 0,
 #undef FUNC_NAME
 
 
-/* Helper function for the string uppercase conversion functions.
- * No argument checking is performed.  */
+/* Helper function for the string uppercase conversion functions. */
 static SCM
 string_upcase_x (SCM v, size_t start, size_t end)
 {
   size_t k;
-  char *dst;
 
   v = scm_i_string_start_writing (v);
-  dst = scm_i_string_writable_chars (v);
   for (k = start; k < end; ++k)
-    dst[k] = scm_c_upcase (dst[k]);
+    scm_i_string_set_x (v, k, uc_toupper (scm_i_string_ref (v, k)));
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (v);
 
@@ -2400,12 +2082,11 @@ SCM_DEFINE (scm_substring_upcase_x, "string-upcase!", 
1, 2, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_substring_upcase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_upcase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2421,12 +2102,11 @@ SCM_DEFINE (scm_substring_upcase, "string-upcase", 1, 
2, 0,
            "Upcase every character in @code{str}.")
 #define FUNC_NAME s_scm_substring_upcase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_upcase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2443,12 +2123,10 @@ static SCM
 string_downcase_x (SCM v, size_t start, size_t end)
 {
   size_t k;
-  char *dst;
 
   v = scm_i_string_start_writing (v);
-  dst = scm_i_string_writable_chars (v);
   for (k = start; k < end; ++k)
-    dst[k] = scm_c_downcase (dst[k]);
+    scm_i_string_set_x (v, k, uc_tolower (scm_i_string_ref (v, k)));
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (v);
 
@@ -2469,12 +2147,11 @@ SCM_DEFINE (scm_substring_downcase_x, 
"string-downcase!", 1, 2, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_substring_downcase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_downcase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2490,12 +2167,11 @@ SCM_DEFINE (scm_substring_downcase, "string-downcase", 
1, 2, 0,
            "Downcase every character in @var{str}.")
 #define FUNC_NAME s_scm_substring_downcase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_downcase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2511,24 +2187,24 @@ scm_string_downcase (SCM str)
 static SCM
 string_titlecase_x (SCM str, size_t start, size_t end)
 {
-  unsigned char *sz;
+  SCM ch;
   size_t i;
   int in_word = 0;
 
   str = scm_i_string_start_writing (str);
-  sz = (unsigned char *) scm_i_string_writable_chars (str);
   for(i = start; i < end;  i++)
     {
-      if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i]))))
+      ch = SCM_MAKE_CHAR (scm_i_string_ref (str, i));
+      if (scm_is_true (scm_char_alphabetic_p (ch)))
        {
          if (!in_word)
            {
-             sz[i] = scm_c_upcase(sz[i]);
+             scm_i_string_set_x (str, i, uc_toupper (SCM_CHAR (ch)));
              in_word = 1;
            }
          else
            {
-             sz[i] = scm_c_downcase(sz[i]);
+             scm_i_string_set_x (str, i, uc_tolower (SCM_CHAR (ch)));
            }
        }
       else
@@ -2547,12 +2223,11 @@ SCM_DEFINE (scm_string_titlecase_x, 
"string-titlecase!", 1, 2, 0,
            "@var{str}.")
 #define FUNC_NAME s_scm_string_titlecase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_titlecase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2563,12 +2238,11 @@ SCM_DEFINE (scm_string_titlecase, "string-titlecase", 
1, 2, 0,
            "Titlecase every first character in a word in @var{str}.")
 #define FUNC_NAME s_scm_string_titlecase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_titlecase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2605,22 +2279,24 @@ SCM_DEFINE (scm_string_capitalize, "string-capitalize", 
1, 0, 0,
 /* Reverse the portion of @var{str} between str[cstart] (including)
    and str[cend] excluding.  */
 static void
-string_reverse_x (char * str, size_t cstart, size_t cend)
+string_reverse_x (SCM str, size_t cstart, size_t cend)
 {
-  char tmp;
+  SCM tmp;
 
+  str = scm_i_string_start_writing (str);
   if (cend > 0)
     {
       cend--;
       while (cstart < cend)
        {
-         tmp = str[cstart];
-         str[cstart] = str[cend];
-         str[cend] = tmp;
+         tmp = SCM_MAKE_CHAR (scm_i_string_ref (str, cstart));
+         scm_i_string_set_x (str, cstart, scm_i_string_ref (str, cend));
+         scm_i_string_set_x (str, cend, SCM_CHAR (tmp));
          cstart++;
          cend--;
        }
     }
+  scm_i_string_stop_writing ();
 }
 
 
@@ -2631,19 +2307,14 @@ SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 
0,
            "operate on.")
 #define FUNC_NAME s_scm_string_reverse
 {
-  const char *cstr;
-  char *ctarget;
   size_t cstart, cend;
   SCM result;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   result = scm_string_copy (str);
-  result = scm_i_string_start_writing (result);
-  ctarget = scm_i_string_writable_chars (result);
-  string_reverse_x (ctarget, cstart, cend);
-  scm_i_string_stop_writing ();
+  string_reverse_x (result, cstart, cend);
   scm_remember_upto_here_1 (str);
   return result;
 }
@@ -2657,17 +2328,13 @@ SCM_DEFINE (scm_string_reverse_x, "string-reverse!", 1, 
2, 0,
            "operate on.  The return value is unspecified.")
 #define FUNC_NAME s_scm_string_reverse_x
 {
-  char *cstr;
   size_t cstart, cend;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, str,
                              2, start, cstart,
                              3, end, cend);
 
-  str = scm_i_string_start_writing (str);
-  cstr = scm_i_string_writable_chars (str);
-  string_reverse_x (cstr, cstart, cend);
-  scm_i_string_stop_writing ();
+  string_reverse_x (str, cstart, cend);
   scm_remember_upto_here_1 (str);
   return SCM_UNSPECIFIED;
 }
@@ -2693,7 +2360,9 @@ SCM_DEFINE (scm_string_append_shared, 
"string-append/shared", 0, 0, 1,
   for (l = rest; scm_is_pair (l); l = SCM_CDR (l))
     {
       s = SCM_CAR (l);
-      if (scm_c_string_length (s) != 0)
+      if (!scm_is_string (s))
+       scm_wrong_type_arg (FUNC_NAME, 0, s);
+      if (scm_i_string_length (s) != 0)
         {
           if (seen_nonempty)
             /* two or more non-empty strings, need full concat */
@@ -2780,7 +2449,7 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
            "string elements is not specified.")
 #define FUNC_NAME s_scm_string_map
 {
-  char *p;
+  size_t p;
   size_t cstart, cend;
   SCM result;
   scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
@@ -2789,15 +2458,20 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
   MY_VALIDATE_SUBSTRING_SPEC (2, s,
                              3, start, cstart,
                              4, end, cend);
-  result = scm_i_make_string (cend - cstart, &p);
+  result = scm_i_make_string (cend - cstart, NULL);
+  p = 0;
   while (cstart < cend)
     {
       SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
       cstart++;
-      *p++ = SCM_CHAR (ch);
+      result = scm_i_string_start_writing (result);
+      scm_i_string_set_x (result, p, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      p++;
     }
+  
   return result;
 }
 #undef FUNC_NAME
@@ -2823,7 +2497,9 @@ SCM_DEFINE (scm_string_map_x, "string-map!", 2, 2, 0,
       SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-      scm_c_string_set_x (s, cstart, ch);
+      s = scm_i_string_start_writing (s);
+      scm_i_string_set_x (s, cstart, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
       cstart++;
     }
   return SCM_UNSPECIFIED;
@@ -2839,20 +2515,17 @@ SCM_DEFINE (scm_string_fold, "string-fold", 3, 2, 0,
            "result of @var{kons}' application.")
 #define FUNC_NAME s_scm_string_fold
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
 
   SCM_VALIDATE_PROC (1, kons);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-                                  4, start, cstart,
-                                  5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+                             4, start, cstart,
+                             5, end, cend);
   result = knil;
   while (cstart < cend)
     {
-      unsigned int c = (unsigned char) cstr[cstart];
-      result = scm_call_2 (kons, SCM_MAKE_CHAR (c), result);
-      cstr = scm_i_string_chars (s);
+      result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)), 
result);
       cstart++;
     }
 
@@ -2870,20 +2543,17 @@ SCM_DEFINE (scm_string_fold_right, "string-fold-right", 
3, 2, 0,
            "result of @var{kons}' application.")
 #define FUNC_NAME s_scm_string_fold_right
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
 
   SCM_VALIDATE_PROC (1, kons);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-                                  4, start, cstart,
-                                  5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+                             4, start, cstart,
+                             5, end, cend);
   result = knil;
   while (cstart < cend)
     {
-      unsigned int c  = (unsigned char) cstr[cend - 1];
-      result = scm_call_2 (kons, SCM_MAKE_CHAR (c), result);
-      cstr = scm_i_string_chars (s);
+      result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cend-1)), 
result);
       cend--;
     }
 
@@ -2934,12 +2604,15 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0,
   while (scm_is_false (res))
     {
       SCM str;
-      char *ptr;
+      size_t i = 0;
       SCM ch = scm_call_1 (f, seed);
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
-      str = scm_i_make_string (1, &ptr);
-      *ptr = SCM_CHAR (ch);
+      str = scm_i_make_string (1, NULL);
+      str = scm_i_string_start_writing (str);
+      scm_i_string_set_x (str, i, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      i++;
 
       ans = scm_string_append (scm_list_2 (ans, str));
       seed = scm_call_1 (g, seed);
@@ -2997,12 +2670,15 @@ SCM_DEFINE (scm_string_unfold_right, 
"string-unfold-right", 4, 2, 0,
   while (scm_is_false (res))
     {
       SCM str;
-      char *ptr;
+      size_t i = 0;
       SCM ch = scm_call_1 (f, seed);
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
-      str = scm_i_make_string (1, &ptr);
-      *ptr = SCM_CHAR (ch);
+      str = scm_i_make_string (1, NULL);
+      str = scm_i_string_start_writing (str);
+      scm_i_string_set_x (str, i, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      i++;
 
       ans = scm_string_append (scm_list_2 (str, ans));
       seed = scm_call_1 (g, seed);
@@ -3096,8 +2772,7 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
            "defaults to @var{from} + (@var{end} - @var{start}).")
 #define FUNC_NAME s_scm_xsubstring
 {
-  const char *cs;
-  char *p;
+  size_t p;
   size_t cstart, cend;
   int cfrom, cto;
   SCM result;
@@ -3114,19 +2789,22 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
   if (cstart == cend && cfrom != cto)
     SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
 
-  result = scm_i_make_string (cto - cfrom, &p);
+  result = scm_i_make_string (cto - cfrom, NULL);
+  result = scm_i_string_start_writing (result);
 
-  cs = scm_i_string_chars (s);
+  p = 0;
   while (cfrom < cto)
     {
       size_t t = ((cfrom < 0) ? -cfrom : cfrom) % (cend - cstart);
       if (cfrom < 0)
-       *p = cs[(cend - cstart) - t];
+       scm_i_string_set_x (result, p, 
+                            scm_i_string_ref (s, (cend - cstart) - t));
       else
-       *p = cs[t];
+       scm_i_string_set_x (result, p, scm_i_string_ref (s, t));
       cfrom++;
       p++;
     }
+  scm_i_string_stop_writing ();
 
   scm_remember_upto_here_1 (s);
   return result;
@@ -3143,8 +2821,7 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 0,
            "cannot copy a string on top of itself.")
 #define FUNC_NAME s_scm_string_xcopy_x
 {
-  char *p;
-  const char *cs;
+  size_t p;
   size_t ctstart, cstart, cend;
   int csfrom, csto;
   SCM dummy = SCM_UNDEFINED;
@@ -3166,16 +2843,15 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 
0,
   SCM_ASSERT_RANGE (1, tstart,
                    ctstart + (csto - csfrom) <= scm_i_string_length (target));
 
+  p = 0;
   target = scm_i_string_start_writing (target);
-  p = scm_i_string_writable_chars (target) + ctstart;
-  cs = scm_i_string_chars (s);
   while (csfrom < csto)
     {
       size_t t = ((csfrom < 0) ? -csfrom : csfrom) % (cend - cstart);
       if (csfrom < 0)
-       *p = cs[(cend - cstart) - t];
+       scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, (cend - 
cstart) - t));
       else
-       *p = cs[t];
+       scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, t));
       csfrom++;
       p++;
     }
@@ -3194,8 +2870,6 @@ SCM_DEFINE (scm_string_replace, "string-replace", 2, 4, 0,
            "@var{start2} @dots{} @var{end2} from @var{s2}.")
 #define FUNC_NAME s_scm_string_replace
 {
-  const char *cstr1, *cstr2;
-  char *p;
   size_t cstart1, cend1, cstart2, cend2;
   SCM result;
 
@@ -3205,16 +2879,10 @@ SCM_DEFINE (scm_string_replace, "string-replace", 2, 4, 
0,
   MY_VALIDATE_SUBSTRING_SPEC (2, s2,
                              5, start2, cstart2,
                              6, end2, cend2);
-  result = scm_i_make_string ((cstart1 + cend2 - cstart2
-                               + scm_i_string_length (s1) - cend1), &p);
-  cstr1 = scm_i_string_chars (s1);
-  cstr2 = scm_i_string_chars (s2);
-  memmove (p, cstr1, cstart1 * sizeof (char));
-  memmove (p + cstart1, cstr2 + cstart2, (cend2 - cstart2) * sizeof (char));
-  memmove (p + cstart1 + (cend2 - cstart2),
-          cstr1 + cend1,
-          (scm_i_string_length (s1) - cend1) * sizeof (char));
-  scm_remember_upto_here_2 (s1, s2);
+  return (scm_string_append 
+         (scm_list_3 (scm_i_substring (s1, 0, cstart1),
+                      scm_i_substring (s2, cstart2, cend2),
+                      scm_i_substring (s1, cend1, scm_i_string_length (s1)))));
   return result;
 }
 #undef FUNC_NAME
@@ -3231,13 +2899,12 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 
3, 0,
            "of @var{s}.")
 #define FUNC_NAME s_scm_string_tokenize
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result = SCM_EOL;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   if (SCM_UNBNDP (token_set))
     token_set = scm_char_set_graphic;
@@ -3250,7 +2917,7 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 3, 
0,
        {
          while (cstart < cend)
            {
-             if (SCM_CHARSET_GET (token_set, cstr[cend - 1]))
+             if (REF_IN_CHARSET (s, cend-1, token_set))
                break;
              cend--;
            }
@@ -3259,12 +2926,11 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 
3, 0,
          idx = cend;
          while (cstart < cend)
            {
-             if (!SCM_CHARSET_GET (token_set, cstr[cend - 1]))
+             if (!REF_IN_CHARSET (s, cend-1, token_set))
                break;
              cend--;
            }
-         result = scm_cons (scm_c_substring (s, cend, idx), result);
-         cstr = scm_i_string_chars (s);
+         result = scm_cons (scm_i_substring (s, cend, idx), result);
        }
     }
   else
@@ -3298,27 +2964,45 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
 #define FUNC_NAME s_scm_string_split
 {
   long idx, last_idx;
-  const char * p;
-  char ch;
+  int narrow;
   SCM res = SCM_EOL;
 
   SCM_VALIDATE_STRING (1, str);
   SCM_VALIDATE_CHAR (2, chr);
-
+  
+  /* This is explicit wide/narrow logic (instead of using
+     scm_i_string_ref) is a speed optimization.  */
   idx = scm_i_string_length (str);
-  p = scm_i_string_chars (str);
-  ch = SCM_CHAR (chr);
-  while (idx >= 0)
-    {
-      last_idx = idx;
-      while (idx > 0 && p[idx - 1] != ch)
-       idx--;
-      if (idx >= 0)
-       {
-         res = scm_cons (scm_c_substring (str, idx, last_idx), res);
-         p = scm_i_string_chars (str);
-         idx--;
-       }
+  narrow = scm_i_is_narrow_string (str);
+  if (narrow)
+    {
+      const char *buf = scm_i_string_chars (str);
+      while (idx >= 0)
+        {
+          last_idx = idx;
+          while (idx > 0 && buf[idx-1] != (char) SCM_CHAR(chr))
+            idx--;
+          if (idx >= 0)
+            {
+              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+              idx--;
+            }
+        }
+    }
+  else
+    {
+      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+      while (idx >= 0)
+        {
+          last_idx = idx;
+          while (idx > 0 && buf[idx-1] != SCM_CHAR(chr))
+            idx--;
+          if (idx >= 0)
+            {
+              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+              idx--;
+            }
+        }
     }
   scm_remember_upto_here_1 (str);
   return res;
@@ -3337,14 +3021,13 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
            "membership.")
 #define FUNC_NAME s_scm_string_filter
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
   size_t idx;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   /* The explicit loops below stripping leading and trailing non-matches
      mean we can return a substring if those are the only deletions, making
@@ -3353,22 +3036,19 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
   if (SCM_CHARP (char_pred))
     {
       size_t count;
-      char chr;
-
-      chr = SCM_CHAR (char_pred);
 
       /* strip leading non-matches by incrementing cstart */
-      while (cstart < cend && cstr[cstart] != chr)
+      while (cstart < cend && scm_i_string_ref (s, cstart) != SCM_CHAR 
(char_pred))
         cstart++;
 
       /* strip trailing non-matches by decrementing cend */
-      while (cend > cstart && cstr[cend-1] != chr)
+      while (cend > cstart && scm_i_string_ref (s, cend-1) != SCM_CHAR 
(char_pred))
         cend--;
 
       /* count chars to keep */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (cstr[idx] == chr)
+        if (scm_i_string_ref (s, idx) == SCM_CHAR (char_pred))
           count++;
 
       if (count == cend - cstart)
@@ -3386,17 +3066,17 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
       size_t count;
 
       /* strip leading non-matches by incrementing cstart */
-      while (cstart < cend && ! SCM_CHARSET_GET (char_pred, cstr[cstart]))
+      while (cstart < cend && ! REF_IN_CHARSET (s, cstart, char_pred))
         cstart++;
 
       /* strip trailing non-matches by decrementing cend */
-      while (cend > cstart && ! SCM_CHARSET_GET (char_pred, cstr[cend-1]))
+      while (cend > cstart && ! REF_IN_CHARSET (s, cend-1, char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (SCM_CHARSET_GET (char_pred, cstr[idx]))
+        if (REF_IN_CHARSET (s, idx, char_pred))
           count++;
 
       /* if whole of start to end kept then return substring */
@@ -3404,21 +3084,23 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
         goto result_substring;
       else
         {
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
+          size_t dst = 0;
+          result = scm_i_make_string (count, NULL);
+         result = scm_i_string_start_writing (result);
 
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (SCM_CHARSET_GET (char_pred, cstr[idx]))
+              if (REF_IN_CHARSET (s, idx, char_pred))
                 {
-                  *dst++ = cstr[idx];
+                 scm_i_string_set_x (result, dst, scm_i_string_ref (s, idx));
+                 dst ++;
                   count--;
                 }
             }
+         scm_i_string_stop_writing ();
         }
     }
   else
@@ -3431,11 +3113,10 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
       while (idx < cend)
        {
          SCM res, ch;
-         ch = SCM_MAKE_CHAR (cstr[idx]);
+         ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
          res = pred_tramp (char_pred, ch);
          if (scm_is_true (res))
            ls = scm_cons (ch, ls);
-         cstr = scm_i_string_chars (s);
          idx++;
        }
       result = scm_reverse_list_to_string (ls);
@@ -3457,14 +3138,13 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
            "membership.")
 #define FUNC_NAME s_scm_string_delete
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
   size_t idx;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   /* The explicit loops below stripping leading and trailing matches mean we
      can return a substring if those are the only deletions, making
@@ -3473,22 +3153,19 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
   if (SCM_CHARP (char_pred))
     {
       size_t count;
-      char chr;
-
-      chr = SCM_CHAR (char_pred);
 
       /* strip leading matches by incrementing cstart */
-      while (cstart < cend && cstr[cstart] == chr)
+      while (cstart < cend && scm_i_string_ref (s, cstart) == 
SCM_CHAR(char_pred))
         cstart++;
 
       /* strip trailing matches by decrementing cend */
-      while (cend > cstart && cstr[cend-1] == chr)
+      while (cend > cstart && scm_i_string_ref (s, cend-1) == SCM_CHAR 
(char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (cstr[idx] != chr)
+        if (scm_i_string_ref (s, idx) != SCM_CHAR (char_pred))
           count++;
 
       if (count == cend - cstart)
@@ -3500,22 +3177,24 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
         }
       else
         {
+         int i = 0;
           /* new string for retained portion */
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
-
+          result = scm_i_make_string (count, NULL); 
+          result = scm_i_string_start_writing (result);
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (cstr[idx] != chr)
+             scm_t_wchar c = scm_i_string_ref (s, idx);
+              if (c != SCM_CHAR (char_pred))
                 {
-                  *dst++ = cstr[idx];
+                  scm_i_string_set_x (result, i, c);
+                 i++;
                   count--;
                 }
             }
+         scm_i_string_stop_writing ();
         }
     }
   else if (SCM_CHARSETP (char_pred))
@@ -3523,39 +3202,41 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
       size_t count;
 
       /* strip leading matches by incrementing cstart */
-      while (cstart < cend && SCM_CHARSET_GET (char_pred, cstr[cstart]))
+      while (cstart < cend && REF_IN_CHARSET (s, cstart, char_pred))
         cstart++;
 
       /* strip trailing matches by decrementing cend */
-      while (cend > cstart && SCM_CHARSET_GET (char_pred, cstr[cend-1]))
+      while (cend > cstart && REF_IN_CHARSET (s, cend-1, char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
+        if (!REF_IN_CHARSET (s, idx, char_pred))
           count++;
 
       if (count == cend - cstart)
         goto result_substring;
       else
         {
+         size_t i = 0;
           /* new string for retained portion */
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
+          result = scm_i_make_string (count, NULL);
+         result = scm_i_string_start_writing (result);
 
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
+              if (!REF_IN_CHARSET (s, idx, char_pred))
                 {
-                  *dst++ = cstr[idx];
+                 scm_i_string_set_x (result, i, scm_i_string_ref (s, idx));
+                 i++;
                   count--;
                 }
             }
+         scm_i_string_stop_writing ();
         }
     }
   else
@@ -3567,11 +3248,10 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
       idx = cstart;
       while (idx < cend)
        {
-         SCM res, ch = SCM_MAKE_CHAR (cstr[idx]);
+         SCM res, ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
          res = pred_tramp (char_pred, ch);
          if (scm_is_false (res))
            ls = scm_cons (ch, ls);
-         cstr = scm_i_string_chars (s);
          idx++;
        }
       result = scm_reverse_list_to_string (ls);
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index 0d614f6..7c00131 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -24,59 +24,511 @@
 
 
 #include <string.h>
-#include <ctype.h>
+#include <unictype.h>
 
 #include "libguile.h"
 #include "libguile/srfi-14.h"
+#include "libguile/strings.h"
 
+/* Include the pre-computed standard charset data.  */
+#include "libguile/srfi-14.i.c"
 
-#define SCM_CHARSET_SET(cs, idx)                               \
-  (((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] |= \
-    (1L << ((idx) % SCM_BITS_PER_LONG)))
+#define SCM_CHARSET_DATA(charset) ((scm_t_char_set *) SCM_SMOB_DATA (charset))
 
-#define SCM_CHARSET_UNSET(cs, idx)                             \
-  (((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] &= \
-    (~(1L << ((idx) % SCM_BITS_PER_LONG))))
-
-#define BYTES_PER_CHARSET (SCM_CHARSET_SIZE / 8)
-#define LONGS_PER_CHARSET (SCM_CHARSET_SIZE / SCM_BITS_PER_LONG)
+#define SCM_CHARSET_SET(cs, idx)                        \
+  scm_i_charset_set (SCM_CHARSET_DATA (cs), idx)
 
+#define SCM_CHARSET_UNSET(cs, idx)                      \
+  scm_i_charset_unset (SCM_CHARSET_DATA (cs), idx)
 
 /* Smob type code for character sets.  */
 int scm_tc16_charset = 0;
+int scm_tc16_charset_cursor = 0;
+
+/* True if N exists in charset CS.  */
+int
+scm_i_charset_get (scm_t_char_set *cs, scm_t_wchar n)
+{
+  size_t i;
+
+  i = 0;
+  while (i < cs->len)
+    {
+      if (cs->ranges[i].lo <= n && n <= cs->ranges[i].hi)
+        return 1;
+      i++;
+    }
+
+  return 0;
+}
+
+/* Put N into charset CS.  */
+void
+scm_i_charset_set (scm_t_char_set *cs, scm_t_wchar n)
+{
+  size_t i;
+  size_t len;
+
+  len = cs->len;
+
+  i = 0;
+  while (i < len)
+    {
+      /* Already in this range  */
+      if (cs->ranges[i].lo <= n && n <= cs->ranges[i].hi)
+        {
+          return;
+        }
+
+      if (n == cs->ranges[i].lo - 1)
+        {
+          /* This char is one below the current range. */
+          if (i > 0 && cs->ranges[i - 1].hi + 1 == n)
+            {
+              /* It is also one above the previous range, so combine them.  */
+              cs->ranges[i - 1].hi = cs->ranges[i].hi;
+              if (i < len - 1)
+                memmove (cs->ranges + i, cs->ranges + (i + 1),
+                         sizeof (scm_t_char_range) * (len - i - 1));
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+          else
+            {
+              /* Expand the range down by one.  */
+              cs->ranges[i].lo = n;
+              return;
+            }
+        }
+      else if (n == cs->ranges[i].hi + 1)
+        {
+          /* This char is one above the current range.  */
+          if (i < len - 1 && cs->ranges[i + 1].lo - 1 == n)
+            {
+              /* It is also one below the next range, so combine them.  */
+              cs->ranges[i].hi = cs->ranges[i + 1].hi;
+              if (i < len - 2)
+                memmove (cs->ranges + (i + 1), cs->ranges + (i + 2),
+                         sizeof (scm_t_char_range) * (len - i - 2));
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+          else
+            {
+              /* Expand the range up by one.  */
+              cs->ranges[i].hi = n;
+              return;
+            }
+        }
+      else if (n < cs->ranges[i].lo - 1)
+        {
+          /* This is a new range below the current one.  */
+          cs->ranges = scm_gc_realloc (cs->ranges,
+                                       sizeof (scm_t_char_range) * len,
+                                       sizeof (scm_t_char_range) * (len + 1),
+                                       "character-set");
+          memmove (cs->ranges + (i + 1), cs->ranges + i,
+                   sizeof (scm_t_char_range) * (len - i));
+          cs->ranges[i].lo = n;
+          cs->ranges[i].hi = n;
+          cs->len = len + 1;
+          return;
+        }
+
+      i++;
+    }
+
+  /* This is a new range above all previous ranges.  */
+  if (len == 0)
+    {
+      cs->ranges = scm_gc_malloc (sizeof (scm_t_char_range), "character-set");
+    }
+  else
+    {
+      cs->ranges = scm_gc_realloc (cs->ranges,
+                                   sizeof (scm_t_char_range) * len,
+                                   sizeof (scm_t_char_range) * (len + 1),
+                                   "character-set");
+    }
+  cs->ranges[len].lo = n;
+  cs->ranges[len].hi = n;
+  cs->len = len + 1;
+
+  return;
+}
+
+/* If N is in charset CS, remove it.  */
+void
+scm_i_charset_unset (scm_t_char_set *cs, scm_t_wchar n)
+{
+  size_t i;
+  size_t len;
+
+  len = cs->len;
+
+  i = 0;
+  while (i < len)
+    {
+      if (n < cs->ranges[i].lo)
+        /* Not in this set.  */
+        return;
+
+      if (n == cs->ranges[i].lo && n == cs->ranges[i].hi)
+        {
+          /* Remove this one-character range.  */
+          if (len == 1)
+            {
+              scm_gc_free (cs->ranges,
+                           sizeof (scm_t_char_range) * cs->len,
+                           "character-set");
+              cs->ranges = NULL;
+              cs->len = 0;
+              return;
+            }
+          else if (i < len - 1)
+            {
+              memmove (cs->ranges + i, cs->ranges + (i + 1),
+                       sizeof (scm_t_char_range) * (len - i - 1));
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+          else if (i == len - 1)
+            {
+              cs->ranges = scm_gc_realloc (cs->ranges,
+                                           sizeof (scm_t_char_range) * len,
+                                           sizeof (scm_t_char_range) * (len -
+                                                                        1),
+                                           "character-set");
+              cs->len = len - 1;
+              return;
+            }
+        }
+      else if (n == cs->ranges[i].lo)
+        {
+          /* Shrink this range from the left.  */
+          cs->ranges[i].lo = n + 1;
+          return;
+        }
+      else if (n == cs->ranges[i].hi)
+        {
+          /* Shrink this range from the right.  */
+          cs->ranges[i].hi = n - 1;
+          return;
+        }
+      else if (n > cs->ranges[i].lo && n < cs->ranges[i].hi)
+        {
+          /* Split this range into two pieces.  */
+          cs->ranges = scm_gc_realloc (cs->ranges,
+                                       sizeof (scm_t_char_range) * len,
+                                       sizeof (scm_t_char_range) * (len + 1),
+                                       "character-set");
+          if (i < len - 1)
+            memmove (cs->ranges + (i + 2), cs->ranges + (i + 1),
+                     sizeof (scm_t_char_range) * (len - i - 1));
+          cs->ranges[i + 1].hi = cs->ranges[i].hi;
+          cs->ranges[i + 1].lo = n + 1;
+          cs->ranges[i].hi = n - 1;
+          cs->len = len + 1;
+          return;
+        }
+
+      i++;
+    }
+
+  /* This value is above all ranges, so do nothing here.  */
+  return;
+}
+
+static int
+charsets_equal (scm_t_char_set *a, scm_t_char_set *b)
+{
+  if (a->len != b->len)
+    return 0;
+
+  if (memcmp (a->ranges, b->ranges, sizeof (scm_t_char_range) * a->len) != 0)
+    return 0;
+
+  return 1;
+}
+
+/* Return true if every character in A is also in B.  */
+static int
+charsets_leq (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0, j = 0;
+  scm_t_wchar alo, ahi;
+
+  if (a->len == 0)
+    return 1;
+  if (b->len == 0)
+    return 0;
+  while (i < a->len)
+    {
+      alo = a->ranges[i].lo;
+      ahi = a->ranges[i].hi;
+      while (b->ranges[j].hi < alo)
+        {
+          if (j < b->len - 1)
+            j++;
+          else
+            return 0;
+        }
+      if (alo < b->ranges[j].lo || ahi > b->ranges[j].hi)
+        return 0;
+      i++;
+    }
+
+  return 1;
+}
+
+/* Merge B into A. */
+static void
+charsets_union (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0;
+  scm_t_wchar blo, bhi, n;
+
+  if (b->len == 0)
+    return;
+
+  if (a->len == 0)
+    {
+      a->len = b->len;
+      a->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * b->len,
+                                 "character-set");
+      memcpy (a->ranges, b->ranges, sizeof (scm_t_char_range) * b->len);
+      return;
+    }
+
+  /* This needs optimization.  */
+  while (i < b->len)
+    {
+      blo = b->ranges[i].lo;
+      bhi = b->ranges[i].hi;
+      for (n = blo; n <= bhi; n++)
+        scm_i_charset_set (a, n);
+
+      i++;
+    }
+
+  return;
+}
+
+/* Remove elements not both in A and B from A. */
+static void
+charsets_intersection (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0;
+  scm_t_wchar blo, bhi, n;
+  scm_t_char_set *c;
+
+  if (a->len == 0)
+    return;
+
+  if (b->len == 0)
+    {
+      scm_gc_free (a->ranges, sizeof (scm_t_char_range) * a->len,
+                   "character-set");
+      a->len = 0;
+      return;
+    }
+
+  c = (scm_t_char_set *) scm_malloc (sizeof (scm_t_char_set));
+  c->len = 0;
+  c->ranges = NULL;
+
+  while (i < b->len)
+    {
+      blo = b->ranges[i].lo;
+      bhi = b->ranges[i].hi;
+      for (n = blo; n <= bhi; n++)
+        if (scm_i_charset_get (a, n))
+          scm_i_charset_set (c, n);
+      i++;
+    }
+  scm_gc_free (a->ranges, sizeof (scm_t_char_range) * a->len,
+               "character-set");
+
+  a->len = c->len;
+  if (c->len != 0)
+    a->ranges = c->ranges;
+  else
+    a->ranges = NULL;
+  free (c);
+  return;
+}
+
+/* Make P the compelement of Q.  */
+static void
+charsets_complement (scm_t_char_set *p, scm_t_char_set *q)
+{
+  int k, idx;
+
+  if (q->len == 0)
+    {
+      /* Fill with all valid codepoints.  */
+      p->len = 2;
+      p->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * 2,
+                                 "character-set");
+      p->ranges[0].lo = 0;
+      p->ranges[0].hi = 0xd7ff;
+      p->ranges[1].lo = 0xe000;
+      p->ranges[1].hi = SCM_CODEPOINT_MAX;
+      return;
+    }
+
+  if (p->len > 0)
+    scm_gc_free (p->ranges, sizeof (scm_t_char_set) * p->len,
+                 "character-set");
+
+  p->len = 0;
+  if (q->ranges[0].lo > 0)
+    p->len++;
+  if (q->ranges[q->len - 1].hi < SCM_CODEPOINT_MAX)
+    p->len++;
+  p->len += q->len - 1;
+  p->ranges =
+    (scm_t_char_range *) scm_gc_malloc (sizeof (scm_t_char_range) * p->len,
+                                        "character-set");
+  idx = 0;
+  if (q->ranges[0].lo > 0)
+    {
+      p->ranges[idx].lo = 0;
+      p->ranges[idx++].hi = q->ranges[0].lo - 1;
+    }
+  for (k = 1; k < q->len; k++)
+    {
+      p->ranges[idx].lo = q->ranges[k - 1].hi + 1;
+      p->ranges[idx++].hi = q->ranges[k].lo - 1;
+    }
+  if (q->ranges[q->len - 1].hi < SCM_CODEPOINT_MAX)
+    {
+      p->ranges[idx].lo = q->ranges[q->len - 1].hi + 1;
+      p->ranges[idx].hi = SCM_CODEPOINT_MAX;
+    }
+  return;
+}
+
+/* Replace A with elements only found in one of A or B.  */
+static void
+charsets_xor (scm_t_char_set *a, scm_t_char_set *b)
+{
+  size_t i = 0;
+  scm_t_wchar blo, bhi, n;
+
+  if (b->len == 0)
+    {
+      return;
+    }
 
+  if (a->len == 0)
+    {
+      a->ranges =
+        (scm_t_char_range *) scm_gc_malloc (sizeof (scm_t_char_range) *
+                                            b->len, "character-set");
+      a->len = b->len;
+      memcpy (a->ranges, b->ranges, sizeof (scm_t_char_range) * a->len);
+      return;
+    }
+
+  while (i < b->len)
+    {
+      blo = b->ranges[i].lo;
+      bhi = b->ranges[i].hi;
+      for (n = blo; n <= bhi; n++)
+        {
+          if (scm_i_charset_get (a, n))
+            scm_i_charset_unset (a, n);
+          else
+            scm_i_charset_set (a, n);
+        }
+
+      i++;
+    }
+  return;
+}
 
 /* Smob print hook for character sets.  */
 static int
 charset_print (SCM charset, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  int i;
+  size_t i;
   int first = 1;
+  scm_t_char_set *p;
+  const size_t max_ranges_to_print = 50;
+
+  p = SCM_CHARSET_DATA (charset);
 
   scm_puts ("#<charset {", port);
-  for (i = 0; i < SCM_CHARSET_SIZE; i++)
-    if (SCM_CHARSET_GET (charset, i))
-      {
-       if (first)
-         first = 0;
-       else
-         scm_puts (" ", port);
-       scm_write (SCM_MAKE_CHAR (i), port);
-      }
+  for (i = 0; i < p->len; i++)
+    {
+      if (first)
+        first = 0;
+      else
+        scm_puts (" ", port);
+      scm_write (SCM_MAKE_CHAR (p->ranges[i].lo), port);
+      if (p->ranges[i].lo != p->ranges[i].hi)
+        {
+          scm_puts ("..", port);
+          scm_write (SCM_MAKE_CHAR (p->ranges[i].hi), port);
+        }
+      if (i >= max_ranges_to_print)
+        {
+          /* Too many to print here.  Quit early.  */
+          scm_puts (" ...", port);
+          break;
+        }
+    }
   scm_puts ("}>", port);
   return 1;
 }
 
+/* Smob print hook for character sets cursors.  */
+static int
+charset_cursor_print (SCM cursor, SCM port,
+                      scm_print_state *pstate SCM_UNUSED)
+{
+  scm_t_char_set_cursor *cur;
+
+  cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
+
+  scm_puts ("#<charset-cursor ", port);
+  if (cur->range == (size_t) (-1))
+    scm_puts ("(empty)", port);
+  else
+    {
+      scm_write (scm_from_size_t (cur->range), port);
+      scm_puts (":", port);
+      scm_write (scm_from_int32 (cur->n), port);
+    }
+  scm_puts (">", port);
+  return 1;
+}
 
 
 /* Create a new, empty character set.  */
 static SCM
-make_char_set (const char * func_name)
+make_char_set (const char *func_name)
 {
-  long * p;
+  scm_t_char_set *p;
 
-  p = scm_gc_malloc (BYTES_PER_CHARSET, "character-set");
-  memset (p, 0, BYTES_PER_CHARSET);
+  p = scm_gc_malloc (sizeof (scm_t_char_set), "character-set");
+  memset (p, 0, sizeof (scm_t_char_set));
   SCM_RETURN_NEWSMOB (scm_tc16_charset, p);
 }
 
@@ -98,22 +550,22 @@ SCM_DEFINE (scm_char_set_eq, "char-set=", 0, 0, 1,
 #define FUNC_NAME s_scm_char_set_eq
 {
   int argnum = 1;
-  long *cs1_data = NULL;
+  scm_t_char_set *cs1_data = NULL;
 
   SCM_VALIDATE_REST_ARGUMENT (char_sets);
 
   while (!scm_is_null (char_sets))
     {
       SCM csi = SCM_CAR (char_sets);
-      long *csi_data;
+      scm_t_char_set *csi_data;
 
       SCM_VALIDATE_SMOB (argnum, csi, charset);
       argnum++;
-      csi_data = (long *) SCM_SMOB_DATA (csi);
+      csi_data = SCM_CHARSET_DATA (csi);
       if (cs1_data == NULL)
-       cs1_data = csi_data;
-      else if (memcmp (cs1_data, csi_data, BYTES_PER_CHARSET) != 0)
-       return SCM_BOOL_F;
+        cs1_data = csi_data;
+      else if (!charsets_equal (cs1_data, csi_data))
+        return SCM_BOOL_F;
       char_sets = SCM_CDR (char_sets);
     }
   return SCM_BOOL_T;
@@ -128,28 +580,23 @@ SCM_DEFINE (scm_char_set_leq, "char-set<=", 0, 0, 1,
 #define FUNC_NAME s_scm_char_set_leq
 {
   int argnum = 1;
-  long *prev_data = NULL;
+  scm_t_char_set *prev_data = NULL;
 
   SCM_VALIDATE_REST_ARGUMENT (char_sets);
 
   while (!scm_is_null (char_sets))
     {
       SCM csi = SCM_CAR (char_sets);
-      long *csi_data;
+      scm_t_char_set *csi_data;
 
       SCM_VALIDATE_SMOB (argnum, csi, charset);
       argnum++;
-      csi_data = (long *) SCM_SMOB_DATA (csi);
+      csi_data = SCM_CHARSET_DATA (csi);
       if (prev_data)
-       {
-         int k;
-
-         for (k = 0; k < LONGS_PER_CHARSET; k++)
-           {
-             if ((prev_data[k] & csi_data[k]) != prev_data[k])
-               return SCM_BOOL_F;
-           }
-       }
+        {
+          if (!charsets_leq (prev_data, csi_data))
+            return SCM_BOOL_F;
+        }
       prev_data = csi_data;
       char_sets = SCM_CDR (char_sets);
     }
@@ -167,9 +614,10 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
 {
   const unsigned long default_bnd = 871;
   unsigned long bnd;
-  long * p;
+  scm_t_char_set *p;
   unsigned long val = 0;
   int k;
+  scm_t_wchar c;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
 
@@ -179,14 +627,14 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
     {
       bnd = scm_to_ulong (bound);
       if (bnd == 0)
-       bnd = default_bnd;
+        bnd = default_bnd;
     }
 
-  p = (long *) SCM_SMOB_DATA (cs);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
+  p = SCM_CHARSET_DATA (cs);
+  for (k = 0; k < p->len; k++)
     {
-      if (p[k] != 0)
-        val = p[k] + (val << 1);
+      for (c = p->ranges[k].lo; c <= p->ranges[k].hi; c++)
+        val = c + (val << 1);
     }
   return scm_from_ulong (val % bnd);
 }
@@ -194,89 +642,150 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
 
 
 SCM_DEFINE (scm_char_set_cursor, "char-set-cursor", 1, 0, 0,
-           (SCM cs),
-           "Return a cursor into the character set @var{cs}.")
+            (SCM cs), "Return a cursor into the character set @var{cs}.")
 #define FUNC_NAME s_scm_char_set_cursor
 {
-  int idx;
+  scm_t_char_set *cs_data;
+  scm_t_char_set_cursor *cur_data;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (idx = 0; idx < SCM_CHARSET_SIZE; idx++)
+  cs_data = SCM_CHARSET_DATA (cs);
+  cur_data =
+    (scm_t_char_set_cursor *) scm_gc_malloc (sizeof (scm_t_char_set_cursor),
+                                             "charset-cursor");
+  if (cs_data->len == 0)
     {
-      if (SCM_CHARSET_GET (cs, idx))
-       break;
+      cur_data->range = (size_t) (-1);
+      cur_data->n = 0;
     }
-  return SCM_I_MAKINUM (idx);
+  else
+    {
+      cur_data->range = 0;
+      cur_data->n = cs_data->ranges[0].lo;
+    }
+  SCM_RETURN_NEWSMOB (scm_tc16_charset_cursor, cur_data);
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_ref, "char-set-ref", 2, 0, 0,
-           (SCM cs, SCM cursor),
-           "Return the character at the current cursor position\n"
-           "@var{cursor} in the character set @var{cs}.  It is an error to\n"
-           "pass a cursor for which @code{end-of-char-set?} returns true.")
+            (SCM cs, SCM cursor),
+            "Return the character at the current cursor position\n"
+            "@var{cursor} in the character set @var{cs}.  It is an error to\n"
+            "pass a cursor for which @code{end-of-char-set?} returns true.")
 #define FUNC_NAME s_scm_char_set_ref
 {
-  size_t ccursor = scm_to_size_t (cursor);
+  scm_t_char_set *cs_data;
+  scm_t_char_set_cursor *cur_data;
+  size_t i;
+
   SCM_VALIDATE_SMOB (1, cs, charset);
+  SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
 
-  if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
+  cs_data = SCM_CHARSET_DATA (cs);
+  cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
+
+  /* Validate that this cursor is still true.  */
+  i = cur_data->range;
+  if (i == (size_t) (-1)
+      || i >= cs_data->len
+      || cur_data->n < cs_data->ranges[i].lo
+      || cur_data->n > cs_data->ranges[i].hi)
     SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
-  return SCM_MAKE_CHAR (ccursor);
+  return SCM_MAKE_CHAR (cur_data->n);
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_cursor_next, "char-set-cursor-next", 2, 0, 0,
-           (SCM cs, SCM cursor),
-           "Advance the character set cursor @var{cursor} to the next\n"
-           "character in the character set @var{cs}.  It is an error if the\n"
-           "cursor given satisfies @code{end-of-char-set?}.")
+            (SCM cs, SCM cursor),
+            "Advance the character set cursor @var{cursor} to the next\n"
+            "character in the character set @var{cs}.  It is an error if the\n"
+            "cursor given satisfies @code{end-of-char-set?}.")
 #define FUNC_NAME s_scm_char_set_cursor_next
 {
-  size_t ccursor = scm_to_size_t (cursor);
+  scm_t_char_set *cs_data;
+  scm_t_char_set_cursor *cur_data;
+  size_t i;
+
   SCM_VALIDATE_SMOB (1, cs, charset);
+  SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
+
+  cs_data = SCM_CHARSET_DATA (cs);
+  cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
 
-  if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
+  /* Validate that this cursor is still true.  */
+  i = cur_data->range;
+  if (i == (size_t) (-1)
+      || i >= cs_data->len
+      || cur_data->n < cs_data->ranges[i].lo
+      || cur_data->n > cs_data->ranges[i].hi)
     SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
-  for (ccursor++; ccursor < SCM_CHARSET_SIZE; ccursor++)
+  /* Increment the cursor.  */
+  if (cur_data->n == cs_data->ranges[i].hi)
     {
-      if (SCM_CHARSET_GET (cs, ccursor))
-       break;
+      if (i + 1 < cs_data->len)
+        {
+          cur_data->range = i + 1;
+          cur_data->n = cs_data->ranges[i + 1].lo;
+        }
+      else
+        {
+          /* This is the end of the road.  */
+          cur_data->range = (size_t) (-1);
+          cur_data->n = 0;
+        }
     }
-  return SCM_I_MAKINUM (ccursor);
+  else
+    {
+      cur_data->n = cur_data->n + 1;
+    }
+
+  return cursor;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_end_of_char_set_p, "end-of-char-set?", 1, 0, 0,
-           (SCM cursor),
-           "Return @code{#t} if @var{cursor} has reached the end of a\n"
-           "character set, @code{#f} otherwise.")
+            (SCM cursor),
+            "Return @code{#t} if @var{cursor} has reached the end of a\n"
+            "character set, @code{#f} otherwise.")
 #define FUNC_NAME s_scm_end_of_char_set_p
 {
-  size_t ccursor = scm_to_size_t (cursor);
-  return scm_from_bool (ccursor >= SCM_CHARSET_SIZE);
+  scm_t_char_set_cursor *cur_data;
+  SCM_VALIDATE_SMOB (1, cursor, charset_cursor);
+
+  cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
+  if (cur_data->range == (size_t) (-1))
+    return SCM_BOOL_T;
+
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_fold, "char-set-fold", 3, 0, 0,
-           (SCM kons, SCM knil, SCM cs),
-           "Fold the procedure @var{kons} over the character set @var{cs},\n"
-           "initializing it with @var{knil}.")
+            (SCM kons, SCM knil, SCM cs),
+            "Fold the procedure @var{kons} over the character set @var{cs},\n"
+            "initializing it with @var{knil}.")
 #define FUNC_NAME s_scm_char_set_fold
 {
+  scm_t_char_set *cs_data;
   int k;
+  scm_t_wchar n;
 
   SCM_VALIDATE_PROC (1, kons);
   SCM_VALIDATE_SMOB (3, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return knil;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-       knil = scm_call_2 (kons, SCM_MAKE_CHAR (k), knil);
+        knil = scm_call_2 (kons, SCM_MAKE_CHAR (n), knil);
       }
   return knil;
 }
@@ -366,19 +875,29 @@ SCM_DEFINE (scm_char_set_unfold_x, "char-set-unfold!", 5, 
0, 0,
 
 
 SCM_DEFINE (scm_char_set_for_each, "char-set-for-each", 2, 0, 0,
-           (SCM proc, SCM cs),
-           "Apply @var{proc} to every character in the character set\n"
-           "@var{cs}.  The return value is not specified.")
+            (SCM proc, SCM cs),
+            "Apply @var{proc} to every character in the character set\n"
+            "@var{cs}.  The return value is not specified.")
 #define FUNC_NAME s_scm_char_set_for_each
 {
+  scm_t_char_set *cs_data;
   int k;
+  scm_t_wchar n;
 
   SCM_VALIDATE_PROC (1, proc);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      scm_call_1 (proc, SCM_MAKE_CHAR (k));
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return SCM_UNSPECIFIED;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
+      {
+        scm_call_1 (proc, SCM_MAKE_CHAR (n));
+      }
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -392,18 +911,26 @@ SCM_DEFINE (scm_char_set_map, "char-set-map", 2, 0, 0,
 {
   SCM result;
   int k;
+  scm_t_char_set *cs_data;
+  scm_t_wchar n;
 
   SCM_VALIDATE_PROC (1, proc);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
   result = make_char_set (FUNC_NAME);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return result;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-       SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (k));
-       if (!SCM_CHARP (ch))
-         SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-       SCM_CHARSET_SET (result, SCM_CHAR (ch));
+        SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (n));
+        if (!SCM_CHARP (ch))
+          SCM_MISC_ERROR ("procedure ~S returned non-char",
+                          scm_list_1 (proc));
+        SCM_CHARSET_SET (result, SCM_CHAR (ch));
       }
   return result;
 }
@@ -417,15 +944,23 @@ SCM_DEFINE (scm_char_set_copy, "char-set-copy", 1, 0, 0,
 #define FUNC_NAME s_scm_char_set_copy
 {
   SCM ret;
-  long * p1, * p2;
-  int k;
+  scm_t_char_set *p1, *p2;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
   ret = make_char_set (FUNC_NAME);
-  p1 = (long *) SCM_SMOB_DATA (cs);
-  p2 = (long *) SCM_SMOB_DATA (ret);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    p2[k] = p1[k];
+  p1 = SCM_CHARSET_DATA (cs);
+  p2 = SCM_CHARSET_DATA (ret);
+  p2->len = p1->len;
+
+  if (p1->len == 0)
+    p2->ranges = NULL;
+  else
+    {
+      p2->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * p1->len,
+                                  "character-set");
+      memcpy (p2->ranges, p1->ranges, sizeof (scm_t_char_range) * p1->len);
+    }
+
   return ret;
 }
 #undef FUNC_NAME
@@ -437,20 +972,18 @@ SCM_DEFINE (scm_char_set, "char-set", 0, 0, 1,
 #define FUNC_NAME s_scm_char_set
 {
   SCM cs;
-  long * p;
   int argnum = 1;
 
   SCM_VALIDATE_REST_ARGUMENT (rest);
   cs = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (argnum, SCM_CAR (rest), c);
       argnum++;
       rest = SCM_CDR (rest);
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -465,7 +998,6 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
 #define FUNC_NAME s_scm_list_to_char_set
 {
   SCM cs;
-  long * p;
 
   SCM_VALIDATE_LIST (1, list);
   if (SCM_UNBNDP (base_cs))
@@ -475,16 +1007,16 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 
1, 0,
       SCM_VALIDATE_SMOB (2, base_cs, charset);
       cs = scm_char_set_copy (base_cs);
     }
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (list))
     {
       SCM chr = SCM_CAR (list);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (0, chr, c);
       list = SCM_CDR (list);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -492,26 +1024,23 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 
1, 0,
 
 
 SCM_DEFINE (scm_list_to_char_set_x, "list->char-set!", 2, 0, 0,
-           (SCM list, SCM base_cs),
-           "Convert the character list @var{list} to a character set.  The\n"
-           "characters are added to @var{base_cs} and @var{base_cs} is\n"
-           "returned.")
+            (SCM list, SCM base_cs),
+            "Convert the character list @var{list} to a character set.  The\n"
+            "characters are added to @var{base_cs} and @var{base_cs} is\n"
+            "returned.")
 #define FUNC_NAME s_scm_list_to_char_set_x
 {
-  long * p;
-
   SCM_VALIDATE_LIST (1, list);
   SCM_VALIDATE_SMOB (2, base_cs, charset);
-  p = (long *) SCM_SMOB_DATA (base_cs);
   while (!scm_is_null (list))
     {
       SCM chr = SCM_CAR (list);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (0, chr, c);
       list = SCM_CDR (list);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (base_cs, c);
     }
   return base_cs;
 }
@@ -526,8 +1055,6 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 
1, 0,
 #define FUNC_NAME s_scm_string_to_char_set
 {
   SCM cs;
-  long * p;
-  const char * s;
   size_t k = 0, len;
 
   SCM_VALIDATE_STRING (1, str);
@@ -538,13 +1065,11 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 
1, 1, 0,
       SCM_VALIDATE_SMOB (2, base_cs, charset);
       cs = scm_char_set_copy (base_cs);
     }
-  p = (long *) SCM_SMOB_DATA (cs);
-  s = scm_i_string_chars (str);
   len = scm_i_string_length (str);
   while (k < len)
     {
-      int c = s[k++];
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      scm_t_wchar c = scm_i_string_ref (str, k++);
+      SCM_CHARSET_SET (cs, c);
     }
   scm_remember_upto_here_1 (str);
   return cs;
@@ -553,25 +1078,21 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 
1, 1, 0,
 
 
 SCM_DEFINE (scm_string_to_char_set_x, "string->char-set!", 2, 0, 0,
-           (SCM str, SCM base_cs),
-           "Convert the string @var{str} to a character set.  The\n"
-           "characters from the string are added to @var{base_cs}, and\n"
-           "@var{base_cs} is returned.")
+            (SCM str, SCM base_cs),
+            "Convert the string @var{str} to a character set.  The\n"
+            "characters from the string are added to @var{base_cs}, and\n"
+            "@var{base_cs} is returned.")
 #define FUNC_NAME s_scm_string_to_char_set_x
 {
-  long * p;
-  const char * s;
   size_t k = 0, len;
 
   SCM_VALIDATE_STRING (1, str);
   SCM_VALIDATE_SMOB (2, base_cs, charset);
-  p = (long *) SCM_SMOB_DATA (base_cs);
-  s = scm_i_string_chars (str);
   len = scm_i_string_length (str);
   while (k < len)
     {
-      int c = s[k++];
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      scm_t_wchar c = scm_i_string_ref (str, k++);
+      SCM_CHARSET_SET (base_cs, c);
     }
   scm_remember_upto_here_1 (str);
   return base_cs;
@@ -588,7 +1109,8 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 
0,
 {
   SCM ret;
   int k;
-  long * p;
+  scm_t_wchar n;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
@@ -599,17 +1121,20 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 
1, 0,
     }
   else
     ret = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (ret);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    {
-      if (SCM_CHARSET_GET (cs, k))
-       {
-         SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
 
-         if (scm_is_true (res))
-           p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
-       }
-    }
+  p = SCM_CHARSET_DATA (cs);
+
+  if (p->len == 0)
+    return ret;
+
+  for (k = 0; k < p->len; k++)
+    for (n = p->ranges[k].lo; n <= p->ranges[k].hi; n++)
+      {
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+
+        if (scm_is_true (res))
+          SCM_CHARSET_SET (ret, n);
+      }
   return ret;
 }
 #undef FUNC_NAME
@@ -623,22 +1148,24 @@ SCM_DEFINE (scm_char_set_filter_x, "char-set-filter!", 
3, 0, 0,
 #define FUNC_NAME s_scm_char_set_filter_x
 {
   int k;
-  long * p;
+  scm_t_wchar n;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
   SCM_VALIDATE_SMOB (3, base_cs, charset);
-  p = (long *) SCM_SMOB_DATA (base_cs);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    {
-      if (SCM_CHARSET_GET (cs, k))
-       {
-         SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
+  p = SCM_CHARSET_DATA (cs);
+  if (p->len == 0)
+    return base_cs;
 
-         if (scm_is_true (res))
-           p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
-       }
-    }
+  for (k = 0; k < p->len; k++)
+    for (n = p->ranges[k].lo; n <= p->ranges[k].hi; n++)
+      {
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
+
+        if (scm_is_true (res))
+          SCM_CHARSET_SET (base_cs, n);
+      }
   return base_cs;
 }
 #undef FUNC_NAME
@@ -662,7 +1189,6 @@ SCM_DEFINE (scm_ucs_range_to_char_set, 
"ucs-range->char-set", 2, 2, 0,
 {
   SCM cs;
   size_t clower, cupper;
-  long * p;
 
   clower = scm_to_size_t (lower);
   cupper = scm_to_size_t (upper);
@@ -670,15 +1196,15 @@ SCM_DEFINE (scm_ucs_range_to_char_set, 
"ucs-range->char-set", 2, 2, 0,
   if (!SCM_UNBNDP (error))
     {
       if (scm_is_true (error))
-       {
-         SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
-         SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
-       }
+        {
+          SCM_ASSERT_RANGE (1, lower, SCM_IS_UNICODE_CHAR (clower));
+          SCM_ASSERT_RANGE (2, upper, SCM_IS_UNICODE_CHAR (cupper));
+        }
     }
-  if (clower > SCM_CHARSET_SIZE)
-    clower = SCM_CHARSET_SIZE;
-  if (cupper > SCM_CHARSET_SIZE)
-    cupper = SCM_CHARSET_SIZE;
+  if (clower > 0x10FFFF)
+    clower = 0x10FFFF;
+  if (cupper > 0x10FFFF)
+    cupper = 0x10FFFF;
   if (SCM_UNBNDP (base_cs))
     cs = make_char_set (FUNC_NAME);
   else
@@ -686,10 +1212,11 @@ SCM_DEFINE (scm_ucs_range_to_char_set, 
"ucs-range->char-set", 2, 2, 0,
       SCM_VALIDATE_SMOB (4, base_cs, charset);
       cs = scm_char_set_copy (base_cs);
     }
-  p = (long *) SCM_SMOB_DATA (cs);
+  /* It not be difficult to write a more optimized version of the
+     following.  */
   while (clower < cupper)
     {
-      p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, clower);
       clower++;
     }
   return cs;
@@ -714,24 +1241,24 @@ SCM_DEFINE (scm_ucs_range_to_char_set_x, 
"ucs-range->char-set!", 4, 0, 0,
 #define FUNC_NAME s_scm_ucs_range_to_char_set_x
 {
   size_t clower, cupper;
-  long * p;
 
   clower = scm_to_size_t (lower);
   cupper = scm_to_size_t (upper);
   SCM_ASSERT_RANGE (2, upper, cupper >= clower);
   if (scm_is_true (error))
     {
-      SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
-      SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
+      SCM_ASSERT_RANGE (1, lower, SCM_IS_UNICODE_CHAR (clower));
+      SCM_ASSERT_RANGE (2, upper, SCM_IS_UNICODE_CHAR (cupper));
     }
-  if (clower > SCM_CHARSET_SIZE)
-    clower = SCM_CHARSET_SIZE;
-  if (cupper > SCM_CHARSET_SIZE)
-    cupper = SCM_CHARSET_SIZE;
-  p = (long *) SCM_SMOB_DATA (base_cs);
+  if (clower > SCM_CODEPOINT_MAX)
+    clower = SCM_CODEPOINT_MAX;
+  if (cupper > SCM_CODEPOINT_MAX)
+    cupper = SCM_CODEPOINT_MAX;
+
   while (clower < cupper)
     {
-      p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
+      if (SCM_IS_UNICODE_CHAR (clower))
+        SCM_CHARSET_SET (base_cs, clower);
       clower++;
     }
   return base_cs;
@@ -760,12 +1287,18 @@ SCM_DEFINE (scm_char_set_size, "char-set-size", 1, 0, 0,
 #define FUNC_NAME s_scm_char_set_size
 {
   int k, count = 0;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      count++;
-  return SCM_I_MAKINUM (count);
+  cs_data = SCM_CHARSET_DATA (cs);
+
+  if (cs_data->len == 0)
+    return scm_from_int (0);
+
+  for (k = 0; k < cs_data->len; k++)
+    count += cs_data->ranges[k].hi - cs_data->ranges[k].lo + 1;
+
+  return scm_from_int (count);
 }
 #undef FUNC_NAME
 
@@ -777,16 +1310,21 @@ SCM_DEFINE (scm_char_set_count, "char-set-count", 2, 0, 
0,
 #define FUNC_NAME s_scm_char_set_count
 {
   int k, count = 0;
+  scm_t_wchar n;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
+  cs_data = SCM_CHARSET_DATA (cs);
+  if (cs_data->len == 0)
+    return scm_from_int (0);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-       SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
-       if (scm_is_true (res))
-         count++;
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+        if (scm_is_true (res))
+          count++;
       }
   return SCM_I_MAKINUM (count);
 }
@@ -800,12 +1338,18 @@ SCM_DEFINE (scm_char_set_to_list, "char-set->list", 1, 
0, 0,
 #define FUNC_NAME s_scm_char_set_to_list
 {
   int k;
+  scm_t_wchar n;
   SCM result = SCM_EOL;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (k = SCM_CHARSET_SIZE; k > 0; k--)
-    if (SCM_CHARSET_GET (cs, k - 1))
-      result = scm_cons (SCM_MAKE_CHAR (k - 1), result);
+  p = SCM_CHARSET_DATA (cs);
+  if (p->len == 0)
+    return SCM_EOL;
+
+  for (k = p->len - 1; k >= 0; k--)
+    for (n = p->ranges[k].hi; n >= p->ranges[k].lo; n--)
+      result = scm_cons (SCM_MAKE_CHAR (n), result);
   return result;
 }
 #undef FUNC_NAME
@@ -821,17 +1365,35 @@ SCM_DEFINE (scm_char_set_to_string, "char-set->string", 
1, 0, 0,
   int k;
   int count = 0;
   int idx = 0;
+  int wide = 0;
   SCM result;
-  char * p;
+  scm_t_wchar n;
+  scm_t_char_set *cs_data;
+  char *buf;
+  scm_t_wchar *wbuf;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      count++;
-  result = scm_i_make_string (count, &p);
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
-      p[idx++] = k;
+  cs_data = SCM_CHARSET_DATA (cs);
+  if (cs_data->len == 0)
+    return scm_nullstr;
+
+  if (cs_data->ranges[cs_data->len - 1].hi > 255)
+    wide = 1;
+
+  count = scm_to_int (scm_char_set_size (cs));
+  if (wide)
+    result = scm_i_make_wide_string (count, &wbuf);
+  else
+    result = scm_i_make_string (count, &buf);
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
+      {
+        if (wide)
+          wbuf[idx++] = n;
+        else
+          buf[idx++] = n;
+      }
   return result;
 }
 #undef FUNC_NAME
@@ -857,19 +1419,25 @@ SCM_DEFINE (scm_char_set_every, "char-set-every", 2, 0, 
0,
 #define FUNC_NAME s_scm_char_set_every
 {
   int k;
+  scm_t_wchar n;
   SCM res = SCM_BOOL_T;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = SCM_CHARSET_DATA (cs);
+  if (cs_data->len == 0)
+    return SCM_BOOL_T;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-       res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
-       if (scm_is_false (res))
-         return res;
+        res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+        if (scm_is_false (res))
+          return res;
       }
-  return res;
+  return SCM_BOOL_T;
 }
 #undef FUNC_NAME
 
@@ -881,16 +1449,20 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0,
 #define FUNC_NAME s_scm_char_set_any
 {
   int k;
+  scm_t_wchar n;
+  scm_t_char_set *cs_data;
 
   SCM_VALIDATE_PROC (1, pred);
   SCM_VALIDATE_SMOB (2, cs, charset);
 
-  for (k = 0; k < SCM_CHARSET_SIZE; k++)
-    if (SCM_CHARSET_GET (cs, k))
+  cs_data = (scm_t_char_set *) cs;
+
+  for (k = 0; k < cs_data->len; k++)
+    for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
       {
-       SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
-       if (scm_is_true (res))
-         return res;
+        SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+        if (scm_is_true (res))
+          return res;
       }
   return SCM_BOOL_F;
 }
@@ -898,27 +1470,24 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0,
 
 
 SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1,
-           (SCM cs, SCM rest),
-           "Add all character arguments to the first argument, which must\n"
-           "be a character set.")
+            (SCM cs, SCM rest),
+            "Add all character arguments to the first argument, which must\n"
+            "be a character set.")
 #define FUNC_NAME s_scm_char_set_adjoin
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
   cs = scm_char_set_copy (cs);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -926,27 +1495,24 @@ SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 
0, 1,
 
 
 SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1,
-           (SCM cs, SCM rest),
-           "Delete all character arguments from the first argument, which\n"
-           "must be a character set.")
+            (SCM cs, SCM rest),
+            "Delete all character arguments from the first argument, which\n"
+            "must be a character set.")
 #define FUNC_NAME s_scm_char_set_delete
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
   cs = scm_char_set_copy (cs);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
+      SCM_CHARSET_UNSET (cs, c);
     }
   return cs;
 }
@@ -954,26 +1520,23 @@ SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 
0, 1,
 
 
 SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1,
-           (SCM cs, SCM rest),
-           "Add all character arguments to the first argument, which must\n"
-           "be a character set.")
+            (SCM cs, SCM rest),
+            "Add all character arguments to the first argument, which must\n"
+            "be a character set.")
 #define FUNC_NAME s_scm_char_set_adjoin_x
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+      SCM_CHARSET_SET (cs, c);
     }
   return cs;
 }
@@ -981,26 +1544,23 @@ SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 
1, 0, 1,
 
 
 SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1,
-           (SCM cs, SCM rest),
-           "Delete all character arguments from the first argument, which\n"
-           "must be a character set.")
+            (SCM cs, SCM rest),
+            "Delete all character arguments from the first argument, which\n"
+            "must be a character set.")
 #define FUNC_NAME s_scm_char_set_delete_x
 {
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs);
   while (!scm_is_null (rest))
     {
       SCM chr = SCM_CAR (rest);
-      int c;
+      scm_t_wchar c;
 
       SCM_VALIDATE_CHAR_COPY (1, chr, c);
       rest = SCM_CDR (rest);
 
-      p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
+      SCM_CHARSET_UNSET (cs, c);
     }
   return cs;
 }
@@ -1008,21 +1568,19 @@ SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 
1, 0, 1,
 
 
 SCM_DEFINE (scm_char_set_complement, "char-set-complement", 1, 0, 0,
-           (SCM cs),
-           "Return the complement of the character set @var{cs}.")
+            (SCM cs), "Return the complement of the character set @var{cs}.")
 #define FUNC_NAME s_scm_char_set_complement
 {
-  int k;
   SCM res;
-  long * p, * q;
+  scm_t_char_set *p, *q;
 
   SCM_VALIDATE_SMOB (1, cs, charset);
 
   res = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (res);
-  q = (long *) SCM_SMOB_DATA (cs);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    p[k] = ~q[k];
+  p = SCM_CHARSET_DATA (res);
+  q = SCM_CHARSET_DATA (cs);
+
+  charsets_complement (p, q);
   return res;
 }
 #undef FUNC_NAME
@@ -1035,22 +1593,21 @@ SCM_DEFINE (scm_char_set_union, "char-set-union", 0, 0, 
1,
 {
   int c = 1;
   SCM res;
-  long * p;
+  scm_t_char_set *p;
 
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
   res = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (res);
+  p = SCM_CHARSET_DATA (res);
   while (!scm_is_null (rest))
     {
-      int k;
       SCM cs = SCM_CAR (rest);
       SCM_VALIDATE_SMOB (c, cs, charset);
       c++;
       rest = SCM_CDR (rest);
 
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
+
+      charsets_union (p, (scm_t_char_set *) SCM_SMOB_DATA (cs));
     }
   return res;
 }
@@ -1070,26 +1627,24 @@ SCM_DEFINE (scm_char_set_intersection, 
"char-set-intersection", 0, 0, 1,
     res = make_char_set (FUNC_NAME);
   else
     {
-      long *p;
+      scm_t_char_set *p;
       int argnum = 2;
 
       res = scm_char_set_copy (SCM_CAR (rest));
-      p = (long *) SCM_SMOB_DATA (res);
+      p = SCM_CHARSET_DATA (res);
       rest = SCM_CDR (rest);
 
       while (scm_is_pair (rest))
-       {
-         int k;
-         SCM cs = SCM_CAR (rest);
-         long *cs_data;
-
-         SCM_VALIDATE_SMOB (argnum, cs, charset);
-         argnum++;
-         cs_data = (long *) SCM_SMOB_DATA (cs);
-         rest = SCM_CDR (rest);
-         for (k = 0; k < LONGS_PER_CHARSET; k++)
-           p[k] &= cs_data[k];
-       }
+        {
+          SCM cs = SCM_CAR (rest);
+          scm_t_char_set *cs_data;
+
+          SCM_VALIDATE_SMOB (argnum, cs, charset);
+          argnum++;
+          cs_data = SCM_CHARSET_DATA (cs);
+          rest = SCM_CDR (rest);
+          charsets_intersection (p, cs_data);
+        }
     }
 
   return res;
@@ -1103,24 +1658,25 @@ SCM_DEFINE (scm_char_set_difference, 
"char-set-difference", 1, 0, 1,
 #define FUNC_NAME s_scm_char_set_difference
 {
   int c = 2;
-  SCM res;
-  long * p;
+  SCM res, compl;
+  scm_t_char_set *p, *q;
 
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
   res = scm_char_set_copy (cs1);
-  p = (long *) SCM_SMOB_DATA (res);
+  p = SCM_CHARSET_DATA (res);
+  compl = make_char_set (FUNC_NAME);
+  q = SCM_CHARSET_DATA (compl);
   while (!scm_is_null (rest))
     {
-      int k;
       SCM cs = SCM_CAR (rest);
       SCM_VALIDATE_SMOB (c, cs, charset);
       c++;
       rest = SCM_CDR (rest);
 
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
+      charsets_complement (q, SCM_CHARSET_DATA (cs));
+      charsets_intersection (p, q);
     }
   return res;
 }
@@ -1141,26 +1697,24 @@ SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1,
   else
     {
       int argnum = 2;
-      long * p;
+      scm_t_char_set *p;
 
       res = scm_char_set_copy (SCM_CAR (rest));
-      p = (long *) SCM_SMOB_DATA (res);
+      p = SCM_CHARSET_DATA (res);
       rest = SCM_CDR (rest);
 
       while (scm_is_pair (rest))
-       {
-         SCM cs = SCM_CAR (rest);
-         long *cs_data;
-         int k;
-
-         SCM_VALIDATE_SMOB (argnum, cs, charset);
-         argnum++;
-         cs_data = (long *) SCM_SMOB_DATA (cs);
-         rest = SCM_CDR (rest);
-
-         for (k = 0; k < LONGS_PER_CHARSET; k++)
-           p[k] ^= cs_data[k];
-       }
+        {
+          SCM cs = SCM_CAR (rest);
+          scm_t_char_set *cs_data;
+
+          SCM_VALIDATE_SMOB (argnum, cs, charset);
+          argnum++;
+          cs_data = SCM_CHARSET_DATA (cs);
+          rest = SCM_CDR (rest);
+
+          charsets_xor (p, cs_data);
+        }
     }
   return res;
 }
@@ -1175,30 +1729,26 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, 
"char-set-diff+intersection", 1
 {
   int c = 2;
   SCM res1, res2;
-  long * p, * q;
+  scm_t_char_set *p, *q;
 
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
   res1 = scm_char_set_copy (cs1);
   res2 = make_char_set (FUNC_NAME);
-  p = (long *) SCM_SMOB_DATA (res1);
-  q = (long *) SCM_SMOB_DATA (res2);
+  p = SCM_CHARSET_DATA (res1);
+  q = SCM_CHARSET_DATA (res2);
   while (!scm_is_null (rest))
     {
-      int k;
       SCM cs = SCM_CAR (rest);
-      long *r;
+      scm_t_char_set *r;
 
       SCM_VALIDATE_SMOB (c, cs, charset);
       c++;
-      r = (long *) SCM_SMOB_DATA (cs);
+      r = SCM_CHARSET_DATA (cs);
 
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       {
-         q[k] |= p[k] & r[k];
-         p[k] &= ~r[k];
-       }
+      charsets_union (q, r);
+      charsets_intersection (p, r);
       rest = SCM_CDR (rest);
     }
   return scm_values (scm_list_2 (res1, res2));
@@ -1207,101 +1757,53 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, 
"char-set-diff+intersection", 1
 
 
 SCM_DEFINE (scm_char_set_complement_x, "char-set-complement!", 1, 0, 0,
-           (SCM cs),
-           "Return the complement of the character set @var{cs}.")
+            (SCM cs), "Return the complement of the character set @var{cs}.")
 #define FUNC_NAME s_scm_char_set_complement_x
 {
-  int k;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs, charset);
-  p = (long *) SCM_SMOB_DATA (cs);
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    p[k] = ~p[k];
+  cs = scm_char_set_complement (cs);
   return cs;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_union_x, "char-set-union!", 1, 0, 1,
-           (SCM cs1, SCM rest),
-           "Return the union of all argument character sets.")
+            (SCM cs1, SCM rest),
+            "Return the union of all argument character sets.")
 #define FUNC_NAME s_scm_char_set_union_x
 {
-  int c = 2;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
-    }
+  cs1 = scm_char_set_union (scm_cons (cs1, rest));
   return cs1;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_intersection_x, "char-set-intersection!", 1, 0, 1,
-           (SCM cs1, SCM rest),
-           "Return the intersection of all argument character sets.")
+            (SCM cs1, SCM rest),
+            "Return the intersection of all argument character sets.")
 #define FUNC_NAME s_scm_char_set_intersection_x
 {
-  int c = 2;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       p[k] &= ((long *) SCM_SMOB_DATA (cs))[k];
-    }
+  cs1 = scm_char_set_intersection (scm_cons (cs1, rest));
   return cs1;
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_char_set_difference_x, "char-set-difference!", 1, 0, 1,
-           (SCM cs1, SCM rest),
-           "Return the difference of all argument character sets.")
+            (SCM cs1, SCM rest),
+            "Return the difference of all argument character sets.")
 #define FUNC_NAME s_scm_char_set_difference_x
 {
-  int c = 2;
-  long * p;
-
   SCM_VALIDATE_SMOB (1, cs1, charset);
   SCM_VALIDATE_REST_ARGUMENT (rest);
 
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
-    }
+  cs1 = scm_char_set_difference (cs1, rest);
   return cs1;
 }
 #undef FUNC_NAME
@@ -1316,86 +1818,32 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 
1,
      (define a (char-set #\a))
      (char-set-xor a a a) -> char set #\a
      (char-set-xor! a a a) -> char set #\a
-  */
+   */
   return scm_char_set_xor (scm_cons (cs1, rest));
-
-#if 0
-  /* this would give (char-set-xor! a a a) -> empty char set.  */
-  int c = 2;
-  long * p;
-
-  SCM_VALIDATE_SMOB (1, cs1, charset);
-  SCM_VALIDATE_REST_ARGUMENT (rest);
-
-  p = (long *) SCM_SMOB_DATA (cs1);
-  while (!scm_is_null (rest))
-    {
-      int k;
-      SCM cs = SCM_CAR (rest);
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      rest = SCM_CDR (rest);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       p[k] ^= ((long *) SCM_SMOB_DATA (cs))[k];
-    }
-  return cs1;
-#endif
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_char_set_diff_plus_intersection_x, 
"char-set-diff+intersection!", 2, 0, 1,
-           (SCM cs1, SCM cs2, SCM rest),
-           "Return the difference and the intersection of all argument\n"
-           "character sets.")
+SCM_DEFINE (scm_char_set_diff_plus_intersection_x,
+            "char-set-diff+intersection!", 2, 0, 1, (SCM cs1, SCM cs2,
+                                                     SCM rest),
+            "Return the difference and the intersection of all argument\n"
+            "character sets.")
 #define FUNC_NAME s_scm_char_set_diff_plus_intersection_x
 {
-  int c = 3;
-  long * p, * q;
-  int k;
+  SCM diff, intersect;
 
-  SCM_VALIDATE_SMOB (1, cs1, charset);
-  SCM_VALIDATE_SMOB (2, cs2, charset);
-  SCM_VALIDATE_REST_ARGUMENT (rest);
-
-  p = (long *) SCM_SMOB_DATA (cs1);
-  q = (long *) SCM_SMOB_DATA (cs2);
-  if (p == q)
-    {
-      /* (char-set-diff+intersection! a a ...): can't share storage,
-        but we know the answer without checking for further
-        arguments.  */
-      return scm_values (scm_list_2 (make_char_set (FUNC_NAME), cs1));
-    }
-  for (k = 0; k < LONGS_PER_CHARSET; k++)
-    {
-      long t = p[k];
-
-      p[k] &= ~q[k];
-      q[k] = t & q[k];
-    }
-  while (!scm_is_null (rest))
-    {
-      SCM cs = SCM_CAR (rest);
-      long *r;
-
-      SCM_VALIDATE_SMOB (c, cs, charset);
-      c++;
-      r = (long *) SCM_SMOB_DATA (cs);
-
-      for (k = 0; k < LONGS_PER_CHARSET; k++)
-       {
-         q[k] |= p[k] & r[k];
-         p[k] &= ~r[k];
-       }
-      rest = SCM_CDR (rest);
-    }
+  diff = scm_char_set_difference (cs1, scm_cons (cs2, rest));
+  intersect =
+    scm_char_set_intersection (scm_cons (cs1, scm_cons (cs2, rest)));
+  cs1 = diff;
+  cs2 = intersect;
   return scm_values (scm_list_2 (cs1, cs2));
 }
 #undef FUNC_NAME
 
 
+
 /* Standard character sets.  */
 
 SCM scm_char_set_lower_case;
@@ -1419,146 +1867,77 @@ SCM scm_char_set_full;
 
 /* Create an empty character set and return it after binding it to NAME.  */
 static inline SCM
-define_charset (const char *name)
+define_charset (const char *name, const scm_t_char_set *p)
 {
-  SCM cs = make_char_set (NULL);
+  SCM cs;
+
+  SCM_NEWSMOB (cs, scm_tc16_charset, p);
   scm_c_define (name, cs);
   return scm_permanent_object (cs);
 }
 
-/* Membership predicates for the various char sets.
-
-   XXX: The `punctuation' and `symbol' char sets have no direct equivalent in
-   <ctype.h>.  Thus, the predicates below yield correct results for ASCII,
-   but they do not provide the result described by the SRFI for Latin-1.  The
-   correct Latin-1 result could only be obtained by hard-coding the
-   characters listed by the SRFI, but the problem would remain for other
-   8-bit charsets.
-
-   Similarly, character 0xA0 in Latin-1 (unbreakable space, `#\0240') should
-   be part of `char-set:blank'.  However, glibc's current (2006/09) Latin-1
-   locales (which use the ISO 14652 "i18n" FDCC-set) do not consider it
-   `blank' so it ends up in `char-set:punctuation'.  */
-#ifdef HAVE_ISBLANK
-# define CSET_BLANK_PRED(c)  (isblank (c))
-#else
-# define CSET_BLANK_PRED(c)                    \
-   (((c) == ' ') || ((c) == '\t'))
-#endif
-
-#define CSET_SYMBOL_PRED(c)                                    \
-  (((c) != '\0') && (strchr ("$+<=>^`|~", (c)) != NULL))
-#define CSET_PUNCT_PRED(c)                                     \
-  ((ispunct (c)) && (!CSET_SYMBOL_PRED (c)))
-
-#define CSET_LOWER_PRED(c)       (islower (c))
-#define CSET_UPPER_PRED(c)       (isupper (c))
-#define CSET_LETTER_PRED(c)      (isalpha (c))
-#define CSET_DIGIT_PRED(c)       (isdigit (c))
-#define CSET_WHITESPACE_PRED(c)  (isspace (c))
-#define CSET_CONTROL_PRED(c)     (iscntrl (c))
-#define CSET_HEX_DIGIT_PRED(c)   (isxdigit (c))
-#define CSET_ASCII_PRED(c)       (isascii (c))
-
-/* Some char sets are explicitly defined by the SRFI as a union of other char
-   sets so we try to follow this closely.  */
-
-#define CSET_LETTER_AND_DIGIT_PRED(c)          \
-  (CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c))
-
-#define CSET_GRAPHIC_PRED(c)                           \
-  (CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c)         \
-   || CSET_PUNCT_PRED (c) || CSET_SYMBOL_PRED (c))
-
-#define CSET_PRINTING_PRED(c)                          \
-  (CSET_GRAPHIC_PRED (c) || CSET_WHITESPACE_PRED (c))
-
-/* False and true predicates.  */
-#define CSET_TRUE_PRED(c)    (1)
-#define CSET_FALSE_PRED(c)   (0)
-
-
-/* Compute the contents of all the standard character sets.  Computation may
-   need to be re-done at `setlocale'-time because some char sets (e.g.,
-   `char-set:letter') need to reflect the character set supported by Guile.
-
-   For instance, at startup time, the "C" locale is used, thus Guile supports
-   only ASCII; therefore, `char-set:letter' only contains English letters.
-   The user can change this by invoking `setlocale' and specifying a locale
-   with an 8-bit charset, thereby augmenting some of the SRFI-14 standard
-   character sets.
-
-   This works because some of the predicates used below to construct
-   character sets (e.g., `isalpha(3)') are locale-dependent (so
-   charset-dependent, though generally not language-dependent).  For details,
-   please see the `guile-devel' mailing list archive of September 2006.  */
-void
-scm_srfi_14_compute_char_sets (void)
+#ifdef SCM_CHARSET_DEBUG
+SCM_DEFINE (scm_debug_char_set, "debug-char-set", 1, 0, 0,
+            (SCM charset),
+            "Print out the internal C structure of @var{charset}.\n")
+#define FUNC_NAME s_scm_debug_char_set
 {
-#define UPDATE_CSET(c, cset, pred)             \
-  do                                           \
-    {                                          \
-      if (pred (c))                            \
-       SCM_CHARSET_SET ((cset), (c));          \
-      else                                     \
-       SCM_CHARSET_UNSET ((cset), (c));        \
-    }                                          \
-  while (0)
-
-  register int ch;
-
-  for (ch = 0; ch < 256; ch++)
+  int i;
+  scm_t_char_set *cs = SCM_CHARSET_DATA (charset);
+  fprintf (stderr, "cs %p\n", cs);
+  fprintf (stderr, "len %d\n", cs->len);
+  fprintf (stderr, "arr %p\n", cs->ranges);
+  for (i = 0; i < cs->len; i++)
     {
-      UPDATE_CSET (ch, scm_char_set_upper_case, CSET_UPPER_PRED);
-      UPDATE_CSET (ch, scm_char_set_lower_case, CSET_LOWER_PRED);
-      UPDATE_CSET (ch, scm_char_set_title_case, CSET_FALSE_PRED);
-      UPDATE_CSET (ch, scm_char_set_letter, CSET_LETTER_PRED);
-      UPDATE_CSET (ch, scm_char_set_digit, CSET_DIGIT_PRED);
-      UPDATE_CSET (ch, scm_char_set_letter_and_digit,
-                  CSET_LETTER_AND_DIGIT_PRED);
-      UPDATE_CSET (ch, scm_char_set_graphic, CSET_GRAPHIC_PRED);
-      UPDATE_CSET (ch, scm_char_set_printing, CSET_PRINTING_PRED);
-      UPDATE_CSET (ch, scm_char_set_whitespace, CSET_WHITESPACE_PRED);
-      UPDATE_CSET (ch, scm_char_set_iso_control, CSET_CONTROL_PRED);
-      UPDATE_CSET (ch, scm_char_set_punctuation, CSET_PUNCT_PRED);
-      UPDATE_CSET (ch, scm_char_set_symbol, CSET_SYMBOL_PRED);
-      UPDATE_CSET (ch, scm_char_set_hex_digit, CSET_HEX_DIGIT_PRED);
-      UPDATE_CSET (ch, scm_char_set_blank, CSET_BLANK_PRED);
-      UPDATE_CSET (ch, scm_char_set_ascii, CSET_ASCII_PRED);
-      UPDATE_CSET (ch, scm_char_set_empty, CSET_FALSE_PRED);
-      UPDATE_CSET (ch, scm_char_set_full, CSET_TRUE_PRED);
+      if (cs->ranges[i].lo == cs->ranges[i].hi)
+        fprintf (stderr, "%04x\n", cs->ranges[i].lo);
+      else
+        fprintf (stderr, "%04x..%04x\t[%d]\n",
+                 cs->ranges[i].lo,
+                 cs->ranges[i].hi, cs->ranges[i].hi - cs->ranges[i].lo + 1);
     }
-
-#undef UPDATE_CSET
+  printf ("\n");
+  return SCM_UNSPECIFIED;
 }
-
+#undef FUNC_NAME
+#endif /* SCM_CHARSET_DEBUG */
 
+
+
 void
 scm_init_srfi_14 (void)
 {
-  scm_tc16_charset = scm_make_smob_type ("character-set",
-                                        BYTES_PER_CHARSET);
+  scm_tc16_charset = scm_make_smob_type ("character-set", 0);
   scm_set_smob_print (scm_tc16_charset, charset_print);
 
-  scm_char_set_upper_case = define_charset ("char-set:upper-case");
-  scm_char_set_lower_case = define_charset ("char-set:lower-case");
-  scm_char_set_title_case = define_charset ("char-set:title-case");
-  scm_char_set_letter = define_charset ("char-set:letter");
-  scm_char_set_digit = define_charset ("char-set:digit");
-  scm_char_set_letter_and_digit = define_charset ("char-set:letter+digit");
-  scm_char_set_graphic = define_charset ("char-set:graphic");
-  scm_char_set_printing = define_charset ("char-set:printing");
-  scm_char_set_whitespace = define_charset ("char-set:whitespace");
-  scm_char_set_iso_control = define_charset ("char-set:iso-control");
-  scm_char_set_punctuation = define_charset ("char-set:punctuation");
-  scm_char_set_symbol = define_charset ("char-set:symbol");
-  scm_char_set_hex_digit = define_charset ("char-set:hex-digit");
-  scm_char_set_blank = define_charset ("char-set:blank");
-  scm_char_set_ascii = define_charset ("char-set:ascii");
-  scm_char_set_empty = define_charset ("char-set:empty");
-  scm_char_set_full = define_charset ("char-set:full");
-
-  scm_srfi_14_compute_char_sets ();
+  scm_tc16_charset_cursor = scm_make_smob_type ("char-set-cursor", 0);
+  scm_set_smob_print (scm_tc16_charset_cursor, charset_cursor_print);
+
+  scm_char_set_upper_case =
+    define_charset ("char-set:upper-case", &cs_upper_case);
+  scm_char_set_lower_case =
+    define_charset ("char-set:lower-case", &cs_lower_case);
+  scm_char_set_title_case =
+    define_charset ("char-set:title-case", &cs_title_case);
+  scm_char_set_letter = define_charset ("char-set:letter", &cs_letter);
+  scm_char_set_digit = define_charset ("char-set:digit", &cs_digit);
+  scm_char_set_letter_and_digit =
+    define_charset ("char-set:letter+digit", &cs_letter_plus_digit);
+  scm_char_set_graphic = define_charset ("char-set:graphic", &cs_graphic);
+  scm_char_set_printing = define_charset ("char-set:printing", &cs_printing);
+  scm_char_set_whitespace =
+    define_charset ("char-set:whitespace", &cs_whitespace);
+  scm_char_set_iso_control =
+    define_charset ("char-set:iso-control", &cs_iso_control);
+  scm_char_set_punctuation =
+    define_charset ("char-set:punctuation", &cs_punctuation);
+  scm_char_set_symbol = define_charset ("char-set:symbol", &cs_symbol);
+  scm_char_set_hex_digit =
+    define_charset ("char-set:hex-digit", &cs_hex_digit);
+  scm_char_set_blank = define_charset ("char-set:blank", &cs_blank);
+  scm_char_set_ascii = define_charset ("char-set:ascii", &cs_ascii);
+  scm_char_set_empty = define_charset ("char-set:empty", &cs_empty);
+  scm_char_set_full = define_charset ("char-set:full", &cs_full);
 
 #include "libguile/srfi-14.x"
 }
diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h
index 54e0d32..1b9c295 100644
--- a/libguile/srfi-14.h
+++ b/libguile/srfi-14.h
@@ -24,22 +24,34 @@
 
 #include "libguile/__scm.h"
 
-#define SCM_CHARSET_SIZE 256
+typedef struct
+{
+  scm_t_wchar lo;
+  scm_t_wchar hi;
+} scm_t_char_range;
 
-/* We expect 8-bit bytes here.  Should be no problem in the year
-   2001.  */
-#ifndef SCM_BITS_PER_LONG
-# define SCM_BITS_PER_LONG (sizeof (long) * 8)
-#endif
+typedef struct 
+{
+  size_t len;
+  scm_t_char_range *ranges;
+} scm_t_char_set;
 
-#define SCM_CHARSET_GET(cs, idx) (((long *) SCM_SMOB_DATA (cs))\
-                                  [((unsigned char) (idx)) / 
SCM_BITS_PER_LONG] &\
-                                  (1L << (((unsigned char) (idx)) % 
SCM_BITS_PER_LONG)))
+typedef struct
+{
+  size_t range;
+  scm_t_wchar n;
+} scm_t_char_set_cursor;
+
+#define SCM_CHARSET_GET(cs,idx)                                 \
+  scm_i_charset_get((scm_t_char_set *)SCM_SMOB_DATA(cs),idx)
 
 #define SCM_CHARSETP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_charset))
 
 /* Smob type code for character sets.  */
 SCM_API int scm_tc16_charset;
+SCM_INTERNAL int scm_i_charset_get (scm_t_char_set *cs, scm_t_wchar n);
+SCM_INTERNAL void scm_i_charset_set (scm_t_char_set *cs, scm_t_wchar n);
+SCM_INTERNAL void scm_i_charset_unset (scm_t_char_set *cs, scm_t_wchar n);
 
 SCM_API SCM scm_char_set_p (SCM obj);
 SCM_API SCM scm_char_set_eq (SCM char_sets);
@@ -88,6 +100,9 @@ SCM_API SCM scm_char_set_intersection_x (SCM cs1, SCM rest);
 SCM_API SCM scm_char_set_difference_x (SCM cs1, SCM rest);
 SCM_API SCM scm_char_set_xor_x (SCM cs1, SCM rest);
 SCM_API SCM scm_char_set_diff_plus_intersection_x (SCM cs1, SCM cs2, SCM rest);
+#if SCM_CHARSET_DEBUG
+SCM_API SCM scm_debug_char_set (SCM cs);
+#endif /* SCM_CHARSET_DEBUG */
 
 SCM_API SCM scm_char_set_lower_case;
 SCM_API SCM scm_char_set_upper_case;
@@ -107,7 +122,6 @@ SCM_API SCM scm_char_set_ascii;
 SCM_API SCM scm_char_set_empty;
 SCM_API SCM scm_char_set_full;
 
-SCM_INTERNAL void scm_srfi_14_compute_char_sets (void);
 SCM_INTERNAL void scm_init_srfi_14 (void);
 
 #endif /* SCM_SRFI_14_H */
diff --git a/libguile/srfi-14.i.c b/libguile/srfi-14.i.c
new file mode 100644
index 0000000..5ef21f3
--- /dev/null
+++ b/libguile/srfi-14.i.c
@@ -0,0 +1,7150 @@
+/* srfi-14.i.c -- standard SRFI-14 character set data */
+
+/* This file is #include'd by srfi-14.c.  */
+
+/* This file was generated from 
http://unicode.org/Public/UNIDATA/UnicodeData.txt
+   with the unidata_to_charset.pl script.  */
+
+scm_t_char_range cs_lower_case_ranges[] = {
+  {0x0061, 0x007a}
+  ,
+  {0x00b5, 0x00b5}
+  ,
+  {0x00df, 0x00f6}
+  ,
+  {0x00f8, 0x00ff}
+  ,
+  {0x0101, 0x0101}
+  ,
+  {0x0103, 0x0103}
+  ,
+  {0x0105, 0x0105}
+  ,
+  {0x0107, 0x0107}
+  ,
+  {0x0109, 0x0109}
+  ,
+  {0x010b, 0x010b}
+  ,
+  {0x010d, 0x010d}
+  ,
+  {0x010f, 0x010f}
+  ,
+  {0x0111, 0x0111}
+  ,
+  {0x0113, 0x0113}
+  ,
+  {0x0115, 0x0115}
+  ,
+  {0x0117, 0x0117}
+  ,
+  {0x0119, 0x0119}
+  ,
+  {0x011b, 0x011b}
+  ,
+  {0x011d, 0x011d}
+  ,
+  {0x011f, 0x011f}
+  ,
+  {0x0121, 0x0121}
+  ,
+  {0x0123, 0x0123}
+  ,
+  {0x0125, 0x0125}
+  ,
+  {0x0127, 0x0127}
+  ,
+  {0x0129, 0x0129}
+  ,
+  {0x012b, 0x012b}
+  ,
+  {0x012d, 0x012d}
+  ,
+  {0x012f, 0x012f}
+  ,
+  {0x0131, 0x0131}
+  ,
+  {0x0133, 0x0133}
+  ,
+  {0x0135, 0x0135}
+  ,
+  {0x0137, 0x0138}
+  ,
+  {0x013a, 0x013a}
+  ,
+  {0x013c, 0x013c}
+  ,
+  {0x013e, 0x013e}
+  ,
+  {0x0140, 0x0140}
+  ,
+  {0x0142, 0x0142}
+  ,
+  {0x0144, 0x0144}
+  ,
+  {0x0146, 0x0146}
+  ,
+  {0x0148, 0x0149}
+  ,
+  {0x014b, 0x014b}
+  ,
+  {0x014d, 0x014d}
+  ,
+  {0x014f, 0x014f}
+  ,
+  {0x0151, 0x0151}
+  ,
+  {0x0153, 0x0153}
+  ,
+  {0x0155, 0x0155}
+  ,
+  {0x0157, 0x0157}
+  ,
+  {0x0159, 0x0159}
+  ,
+  {0x015b, 0x015b}
+  ,
+  {0x015d, 0x015d}
+  ,
+  {0x015f, 0x015f}
+  ,
+  {0x0161, 0x0161}
+  ,
+  {0x0163, 0x0163}
+  ,
+  {0x0165, 0x0165}
+  ,
+  {0x0167, 0x0167}
+  ,
+  {0x0169, 0x0169}
+  ,
+  {0x016b, 0x016b}
+  ,
+  {0x016d, 0x016d}
+  ,
+  {0x016f, 0x016f}
+  ,
+  {0x0171, 0x0171}
+  ,
+  {0x0173, 0x0173}
+  ,
+  {0x0175, 0x0175}
+  ,
+  {0x0177, 0x0177}
+  ,
+  {0x017a, 0x017a}
+  ,
+  {0x017c, 0x017c}
+  ,
+  {0x017e, 0x0180}
+  ,
+  {0x0183, 0x0183}
+  ,
+  {0x0185, 0x0185}
+  ,
+  {0x0188, 0x0188}
+  ,
+  {0x018c, 0x018d}
+  ,
+  {0x0192, 0x0192}
+  ,
+  {0x0195, 0x0195}
+  ,
+  {0x0199, 0x019b}
+  ,
+  {0x019e, 0x019e}
+  ,
+  {0x01a1, 0x01a1}
+  ,
+  {0x01a3, 0x01a3}
+  ,
+  {0x01a5, 0x01a5}
+  ,
+  {0x01a8, 0x01a8}
+  ,
+  {0x01ab, 0x01ab}
+  ,
+  {0x01ad, 0x01ad}
+  ,
+  {0x01b0, 0x01b0}
+  ,
+  {0x01b4, 0x01b4}
+  ,
+  {0x01b6, 0x01b6}
+  ,
+  {0x01b9, 0x01ba}
+  ,
+  {0x01bd, 0x01bd}
+  ,
+  {0x01bf, 0x01bf}
+  ,
+  {0x01c6, 0x01c6}
+  ,
+  {0x01c9, 0x01c9}
+  ,
+  {0x01cc, 0x01cc}
+  ,
+  {0x01ce, 0x01ce}
+  ,
+  {0x01d0, 0x01d0}
+  ,
+  {0x01d2, 0x01d2}
+  ,
+  {0x01d4, 0x01d4}
+  ,
+  {0x01d6, 0x01d6}
+  ,
+  {0x01d8, 0x01d8}
+  ,
+  {0x01da, 0x01da}
+  ,
+  {0x01dc, 0x01dd}
+  ,
+  {0x01df, 0x01df}
+  ,
+  {0x01e1, 0x01e1}
+  ,
+  {0x01e3, 0x01e3}
+  ,
+  {0x01e5, 0x01e5}
+  ,
+  {0x01e7, 0x01e7}
+  ,
+  {0x01e9, 0x01e9}
+  ,
+  {0x01eb, 0x01eb}
+  ,
+  {0x01ed, 0x01ed}
+  ,
+  {0x01ef, 0x01f0}
+  ,
+  {0x01f3, 0x01f3}
+  ,
+  {0x01f5, 0x01f5}
+  ,
+  {0x01f9, 0x01f9}
+  ,
+  {0x01fb, 0x01fb}
+  ,
+  {0x01fd, 0x01fd}
+  ,
+  {0x01ff, 0x01ff}
+  ,
+  {0x0201, 0x0201}
+  ,
+  {0x0203, 0x0203}
+  ,
+  {0x0205, 0x0205}
+  ,
+  {0x0207, 0x0207}
+  ,
+  {0x0209, 0x0209}
+  ,
+  {0x020b, 0x020b}
+  ,
+  {0x020d, 0x020d}
+  ,
+  {0x020f, 0x020f}
+  ,
+  {0x0211, 0x0211}
+  ,
+  {0x0213, 0x0213}
+  ,
+  {0x0215, 0x0215}
+  ,
+  {0x0217, 0x0217}
+  ,
+  {0x0219, 0x0219}
+  ,
+  {0x021b, 0x021b}
+  ,
+  {0x021d, 0x021d}
+  ,
+  {0x021f, 0x021f}
+  ,
+  {0x0221, 0x0221}
+  ,
+  {0x0223, 0x0223}
+  ,
+  {0x0225, 0x0225}
+  ,
+  {0x0227, 0x0227}
+  ,
+  {0x0229, 0x0229}
+  ,
+  {0x022b, 0x022b}
+  ,
+  {0x022d, 0x022d}
+  ,
+  {0x022f, 0x022f}
+  ,
+  {0x0231, 0x0231}
+  ,
+  {0x0233, 0x0239}
+  ,
+  {0x023c, 0x023c}
+  ,
+  {0x023f, 0x0240}
+  ,
+  {0x0242, 0x0242}
+  ,
+  {0x0247, 0x0247}
+  ,
+  {0x0249, 0x0249}
+  ,
+  {0x024b, 0x024b}
+  ,
+  {0x024d, 0x024d}
+  ,
+  {0x024f, 0x0261}
+  ,
+  {0x0263, 0x0269}
+  ,
+  {0x026b, 0x0273}
+  ,
+  {0x0275, 0x0275}
+  ,
+  {0x0277, 0x0280}
+  ,
+  {0x0282, 0x028e}
+  ,
+  {0x0290, 0x0293}
+  ,
+  {0x029a, 0x029a}
+  ,
+  {0x029d, 0x029e}
+  ,
+  {0x02a0, 0x02a0}
+  ,
+  {0x02a3, 0x02ab}
+  ,
+  {0x02ae, 0x02af}
+  ,
+  {0x0345, 0x0345}
+  ,
+  {0x0363, 0x036f}
+  ,
+  {0x0371, 0x0371}
+  ,
+  {0x0373, 0x0373}
+  ,
+  {0x0377, 0x0377}
+  ,
+  {0x037b, 0x037d}
+  ,
+  {0x0390, 0x0390}
+  ,
+  {0x03ac, 0x03ce}
+  ,
+  {0x03d0, 0x03d1}
+  ,
+  {0x03d5, 0x03d7}
+  ,
+  {0x03d9, 0x03d9}
+  ,
+  {0x03db, 0x03db}
+  ,
+  {0x03dd, 0x03dd}
+  ,
+  {0x03df, 0x03df}
+  ,
+  {0x03e1, 0x03e1}
+  ,
+  {0x03e3, 0x03e3}
+  ,
+  {0x03e5, 0x03e5}
+  ,
+  {0x03e7, 0x03e7}
+  ,
+  {0x03e9, 0x03e9}
+  ,
+  {0x03eb, 0x03eb}
+  ,
+  {0x03ed, 0x03ed}
+  ,
+  {0x03ef, 0x03f2}
+  ,
+  {0x03f5, 0x03f5}
+  ,
+  {0x03f8, 0x03f8}
+  ,
+  {0x03fb, 0x03fb}
+  ,
+  {0x0430, 0x045f}
+  ,
+  {0x0461, 0x0461}
+  ,
+  {0x0463, 0x0463}
+  ,
+  {0x0465, 0x0465}
+  ,
+  {0x0467, 0x0467}
+  ,
+  {0x0469, 0x0469}
+  ,
+  {0x046b, 0x046b}
+  ,
+  {0x046d, 0x046d}
+  ,
+  {0x046f, 0x046f}
+  ,
+  {0x0471, 0x0471}
+  ,
+  {0x0473, 0x0473}
+  ,
+  {0x0475, 0x0475}
+  ,
+  {0x0477, 0x0477}
+  ,
+  {0x0479, 0x0479}
+  ,
+  {0x047b, 0x047b}
+  ,
+  {0x047d, 0x047d}
+  ,
+  {0x047f, 0x047f}
+  ,
+  {0x0481, 0x0481}
+  ,
+  {0x048b, 0x048b}
+  ,
+  {0x048d, 0x048d}
+  ,
+  {0x048f, 0x048f}
+  ,
+  {0x0491, 0x0491}
+  ,
+  {0x0493, 0x0493}
+  ,
+  {0x0495, 0x0495}
+  ,
+  {0x0497, 0x0497}
+  ,
+  {0x0499, 0x0499}
+  ,
+  {0x049b, 0x049b}
+  ,
+  {0x049d, 0x049d}
+  ,
+  {0x049f, 0x049f}
+  ,
+  {0x04a1, 0x04a1}
+  ,
+  {0x04a3, 0x04a3}
+  ,
+  {0x04a5, 0x04a5}
+  ,
+  {0x04a7, 0x04a7}
+  ,
+  {0x04a9, 0x04a9}
+  ,
+  {0x04ab, 0x04ab}
+  ,
+  {0x04ad, 0x04ad}
+  ,
+  {0x04af, 0x04af}
+  ,
+  {0x04b1, 0x04b1}
+  ,
+  {0x04b3, 0x04b3}
+  ,
+  {0x04b5, 0x04b5}
+  ,
+  {0x04b7, 0x04b7}
+  ,
+  {0x04b9, 0x04b9}
+  ,
+  {0x04bb, 0x04bb}
+  ,
+  {0x04bd, 0x04bd}
+  ,
+  {0x04bf, 0x04bf}
+  ,
+  {0x04c2, 0x04c2}
+  ,
+  {0x04c4, 0x04c4}
+  ,
+  {0x04c6, 0x04c6}
+  ,
+  {0x04c8, 0x04c8}
+  ,
+  {0x04ca, 0x04ca}
+  ,
+  {0x04cc, 0x04cc}
+  ,
+  {0x04ce, 0x04cf}
+  ,
+  {0x04d1, 0x04d1}
+  ,
+  {0x04d3, 0x04d3}
+  ,
+  {0x04d5, 0x04d5}
+  ,
+  {0x04d7, 0x04d7}
+  ,
+  {0x04d9, 0x04d9}
+  ,
+  {0x04db, 0x04db}
+  ,
+  {0x04dd, 0x04dd}
+  ,
+  {0x04df, 0x04df}
+  ,
+  {0x04e1, 0x04e1}
+  ,
+  {0x04e3, 0x04e3}
+  ,
+  {0x04e5, 0x04e5}
+  ,
+  {0x04e7, 0x04e7}
+  ,
+  {0x04e9, 0x04e9}
+  ,
+  {0x04eb, 0x04eb}
+  ,
+  {0x04ed, 0x04ed}
+  ,
+  {0x04ef, 0x04ef}
+  ,
+  {0x04f1, 0x04f1}
+  ,
+  {0x04f3, 0x04f3}
+  ,
+  {0x04f5, 0x04f5}
+  ,
+  {0x04f7, 0x04f7}
+  ,
+  {0x04f9, 0x04f9}
+  ,
+  {0x04fb, 0x04fb}
+  ,
+  {0x04fd, 0x04fd}
+  ,
+  {0x04ff, 0x04ff}
+  ,
+  {0x0501, 0x0501}
+  ,
+  {0x0503, 0x0503}
+  ,
+  {0x0505, 0x0505}
+  ,
+  {0x0507, 0x0507}
+  ,
+  {0x0509, 0x0509}
+  ,
+  {0x050b, 0x050b}
+  ,
+  {0x050d, 0x050d}
+  ,
+  {0x050f, 0x050f}
+  ,
+  {0x0511, 0x0511}
+  ,
+  {0x0513, 0x0513}
+  ,
+  {0x0515, 0x0515}
+  ,
+  {0x0517, 0x0517}
+  ,
+  {0x0519, 0x0519}
+  ,
+  {0x051b, 0x051b}
+  ,
+  {0x051d, 0x051d}
+  ,
+  {0x051f, 0x051f}
+  ,
+  {0x0521, 0x0521}
+  ,
+  {0x0523, 0x0523}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x1930, 0x1938}
+  ,
+  {0x1d02, 0x1d02}
+  ,
+  {0x1d08, 0x1d09}
+  ,
+  {0x1d11, 0x1d14}
+  ,
+  {0x1d16, 0x1d17}
+  ,
+  {0x1d1d, 0x1d1f}
+  ,
+  {0x1d62, 0x1d77}
+  ,
+  {0x1d79, 0x1d7a}
+  ,
+  {0x1d7c, 0x1d7d}
+  ,
+  {0x1d7f, 0x1d9a}
+  ,
+  {0x1dca, 0x1dca}
+  ,
+  {0x1dd3, 0x1dda}
+  ,
+  {0x1ddc, 0x1ddd}
+  ,
+  {0x1de0, 0x1de0}
+  ,
+  {0x1de3, 0x1de6}
+  ,
+  {0x1e01, 0x1e01}
+  ,
+  {0x1e03, 0x1e03}
+  ,
+  {0x1e05, 0x1e05}
+  ,
+  {0x1e07, 0x1e07}
+  ,
+  {0x1e09, 0x1e09}
+  ,
+  {0x1e0b, 0x1e0b}
+  ,
+  {0x1e0d, 0x1e0d}
+  ,
+  {0x1e0f, 0x1e0f}
+  ,
+  {0x1e11, 0x1e11}
+  ,
+  {0x1e13, 0x1e13}
+  ,
+  {0x1e15, 0x1e15}
+  ,
+  {0x1e17, 0x1e17}
+  ,
+  {0x1e19, 0x1e19}
+  ,
+  {0x1e1b, 0x1e1b}
+  ,
+  {0x1e1d, 0x1e1d}
+  ,
+  {0x1e1f, 0x1e1f}
+  ,
+  {0x1e21, 0x1e21}
+  ,
+  {0x1e23, 0x1e23}
+  ,
+  {0x1e25, 0x1e25}
+  ,
+  {0x1e27, 0x1e27}
+  ,
+  {0x1e29, 0x1e29}
+  ,
+  {0x1e2b, 0x1e2b}
+  ,
+  {0x1e2d, 0x1e2d}
+  ,
+  {0x1e2f, 0x1e2f}
+  ,
+  {0x1e31, 0x1e31}
+  ,
+  {0x1e33, 0x1e33}
+  ,
+  {0x1e35, 0x1e35}
+  ,
+  {0x1e37, 0x1e37}
+  ,
+  {0x1e39, 0x1e39}
+  ,
+  {0x1e3b, 0x1e3b}
+  ,
+  {0x1e3d, 0x1e3d}
+  ,
+  {0x1e3f, 0x1e3f}
+  ,
+  {0x1e41, 0x1e41}
+  ,
+  {0x1e43, 0x1e43}
+  ,
+  {0x1e45, 0x1e45}
+  ,
+  {0x1e47, 0x1e47}
+  ,
+  {0x1e49, 0x1e49}
+  ,
+  {0x1e4b, 0x1e4b}
+  ,
+  {0x1e4d, 0x1e4d}
+  ,
+  {0x1e4f, 0x1e4f}
+  ,
+  {0x1e51, 0x1e51}
+  ,
+  {0x1e53, 0x1e53}
+  ,
+  {0x1e55, 0x1e55}
+  ,
+  {0x1e57, 0x1e57}
+  ,
+  {0x1e59, 0x1e59}
+  ,
+  {0x1e5b, 0x1e5b}
+  ,
+  {0x1e5d, 0x1e5d}
+  ,
+  {0x1e5f, 0x1e5f}
+  ,
+  {0x1e61, 0x1e61}
+  ,
+  {0x1e63, 0x1e63}
+  ,
+  {0x1e65, 0x1e65}
+  ,
+  {0x1e67, 0x1e67}
+  ,
+  {0x1e69, 0x1e69}
+  ,
+  {0x1e6b, 0x1e6b}
+  ,
+  {0x1e6d, 0x1e6d}
+  ,
+  {0x1e6f, 0x1e6f}
+  ,
+  {0x1e71, 0x1e71}
+  ,
+  {0x1e73, 0x1e73}
+  ,
+  {0x1e75, 0x1e75}
+  ,
+  {0x1e77, 0x1e77}
+  ,
+  {0x1e79, 0x1e79}
+  ,
+  {0x1e7b, 0x1e7b}
+  ,
+  {0x1e7d, 0x1e7d}
+  ,
+  {0x1e7f, 0x1e7f}
+  ,
+  {0x1e81, 0x1e81}
+  ,
+  {0x1e83, 0x1e83}
+  ,
+  {0x1e85, 0x1e85}
+  ,
+  {0x1e87, 0x1e87}
+  ,
+  {0x1e89, 0x1e89}
+  ,
+  {0x1e8b, 0x1e8b}
+  ,
+  {0x1e8d, 0x1e8d}
+  ,
+  {0x1e8f, 0x1e8f}
+  ,
+  {0x1e91, 0x1e91}
+  ,
+  {0x1e93, 0x1e93}
+  ,
+  {0x1e95, 0x1e9d}
+  ,
+  {0x1e9f, 0x1e9f}
+  ,
+  {0x1ea1, 0x1ea1}
+  ,
+  {0x1ea3, 0x1ea3}
+  ,
+  {0x1ea5, 0x1ea5}
+  ,
+  {0x1ea7, 0x1ea7}
+  ,
+  {0x1ea9, 0x1ea9}
+  ,
+  {0x1eab, 0x1eab}
+  ,
+  {0x1ead, 0x1ead}
+  ,
+  {0x1eaf, 0x1eaf}
+  ,
+  {0x1eb1, 0x1eb1}
+  ,
+  {0x1eb3, 0x1eb3}
+  ,
+  {0x1eb5, 0x1eb5}
+  ,
+  {0x1eb7, 0x1eb7}
+  ,
+  {0x1eb9, 0x1eb9}
+  ,
+  {0x1ebb, 0x1ebb}
+  ,
+  {0x1ebd, 0x1ebd}
+  ,
+  {0x1ebf, 0x1ebf}
+  ,
+  {0x1ec1, 0x1ec1}
+  ,
+  {0x1ec3, 0x1ec3}
+  ,
+  {0x1ec5, 0x1ec5}
+  ,
+  {0x1ec7, 0x1ec7}
+  ,
+  {0x1ec9, 0x1ec9}
+  ,
+  {0x1ecb, 0x1ecb}
+  ,
+  {0x1ecd, 0x1ecd}
+  ,
+  {0x1ecf, 0x1ecf}
+  ,
+  {0x1ed1, 0x1ed1}
+  ,
+  {0x1ed3, 0x1ed3}
+  ,
+  {0x1ed5, 0x1ed5}
+  ,
+  {0x1ed7, 0x1ed7}
+  ,
+  {0x1ed9, 0x1ed9}
+  ,
+  {0x1edb, 0x1edb}
+  ,
+  {0x1edd, 0x1edd}
+  ,
+  {0x1edf, 0x1edf}
+  ,
+  {0x1ee1, 0x1ee1}
+  ,
+  {0x1ee3, 0x1ee3}
+  ,
+  {0x1ee5, 0x1ee5}
+  ,
+  {0x1ee7, 0x1ee7}
+  ,
+  {0x1ee9, 0x1ee9}
+  ,
+  {0x1eeb, 0x1eeb}
+  ,
+  {0x1eed, 0x1eed}
+  ,
+  {0x1eef, 0x1eef}
+  ,
+  {0x1ef1, 0x1ef1}
+  ,
+  {0x1ef3, 0x1ef3}
+  ,
+  {0x1ef5, 0x1ef5}
+  ,
+  {0x1ef7, 0x1ef7}
+  ,
+  {0x1ef9, 0x1ef9}
+  ,
+  {0x1efb, 0x1efb}
+  ,
+  {0x1efd, 0x1efd}
+  ,
+  {0x1eff, 0x1f07}
+  ,
+  {0x1f10, 0x1f15}
+  ,
+  {0x1f20, 0x1f27}
+  ,
+  {0x1f30, 0x1f37}
+  ,
+  {0x1f40, 0x1f45}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f60, 0x1f67}
+  ,
+  {0x1f70, 0x1f7d}
+  ,
+  {0x1f80, 0x1f87}
+  ,
+  {0x1f90, 0x1f97}
+  ,
+  {0x1fa0, 0x1fa7}
+  ,
+  {0x1fb0, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fb7}
+  ,
+  {0x1fbe, 0x1fbe}
+  ,
+  {0x1fc2, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fc7}
+  ,
+  {0x1fd0, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fd7}
+  ,
+  {0x1fe0, 0x1fe7}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ff7}
+  ,
+  {0xa641, 0xa641}
+  ,
+  {0xa643, 0xa643}
+  ,
+  {0xa645, 0xa645}
+  ,
+  {0xa647, 0xa647}
+  ,
+  {0xa649, 0xa649}
+  ,
+  {0xa64b, 0xa64b}
+  ,
+  {0xa64d, 0xa64d}
+  ,
+  {0xa64f, 0xa64f}
+  ,
+  {0xa651, 0xa651}
+  ,
+  {0xa653, 0xa653}
+  ,
+  {0xa655, 0xa655}
+  ,
+  {0xa657, 0xa657}
+  ,
+  {0xa659, 0xa659}
+  ,
+  {0xa65b, 0xa65b}
+  ,
+  {0xa65d, 0xa65d}
+  ,
+  {0xa65f, 0xa65f}
+  ,
+  {0xa663, 0xa663}
+  ,
+  {0xa665, 0xa665}
+  ,
+  {0xa667, 0xa667}
+  ,
+  {0xa669, 0xa669}
+  ,
+  {0xa66b, 0xa66b}
+  ,
+  {0xa66d, 0xa66d}
+  ,
+  {0xa681, 0xa681}
+  ,
+  {0xa683, 0xa683}
+  ,
+  {0xa685, 0xa685}
+  ,
+  {0xa687, 0xa687}
+  ,
+  {0xa689, 0xa689}
+  ,
+  {0xa68b, 0xa68b}
+  ,
+  {0xa68d, 0xa68d}
+  ,
+  {0xa68f, 0xa68f}
+  ,
+  {0xa691, 0xa691}
+  ,
+  {0xa693, 0xa693}
+  ,
+  {0xa695, 0xa695}
+  ,
+  {0xa697, 0xa697}
+  ,
+  {0xa723, 0xa723}
+  ,
+  {0xa725, 0xa725}
+  ,
+  {0xa727, 0xa727}
+  ,
+  {0xa729, 0xa729}
+  ,
+  {0xa72b, 0xa72b}
+  ,
+  {0xa72d, 0xa72d}
+  ,
+  {0xa72f, 0xa72f}
+  ,
+  {0xa733, 0xa733}
+  ,
+  {0xa735, 0xa735}
+  ,
+  {0xa737, 0xa737}
+  ,
+  {0xa739, 0xa739}
+  ,
+  {0xa73b, 0xa73b}
+  ,
+  {0xa73d, 0xa73d}
+  ,
+  {0xa73f, 0xa73f}
+  ,
+  {0xa741, 0xa741}
+  ,
+  {0xa743, 0xa743}
+  ,
+  {0xa745, 0xa745}
+  ,
+  {0xa747, 0xa747}
+  ,
+  {0xa749, 0xa749}
+  ,
+  {0xa74b, 0xa74b}
+  ,
+  {0xa74d, 0xa74d}
+  ,
+  {0xa74f, 0xa74f}
+  ,
+  {0xa751, 0xa751}
+  ,
+  {0xa753, 0xa753}
+  ,
+  {0xa755, 0xa755}
+  ,
+  {0xa757, 0xa757}
+  ,
+  {0xa759, 0xa759}
+  ,
+  {0xa75b, 0xa75b}
+  ,
+  {0xa75d, 0xa75d}
+  ,
+  {0xa75f, 0xa75f}
+  ,
+  {0xa761, 0xa761}
+  ,
+  {0xa763, 0xa763}
+  ,
+  {0xa765, 0xa765}
+  ,
+  {0xa767, 0xa767}
+  ,
+  {0xa769, 0xa769}
+  ,
+  {0xa76b, 0xa76b}
+  ,
+  {0xa76d, 0xa76d}
+  ,
+  {0xa76f, 0xa76f}
+  ,
+  {0xa771, 0xa775}
+  ,
+  {0xa777, 0xa778}
+  ,
+  {0xa77a, 0xa77a}
+  ,
+  {0xa77c, 0xa77c}
+  ,
+  {0xa77f, 0xa77f}
+  ,
+  {0xa781, 0xa781}
+  ,
+  {0xa783, 0xa783}
+  ,
+  {0xa785, 0xa785}
+  ,
+  {0xa787, 0xa787}
+  ,
+  {0xa78c, 0xa78c}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xff41, 0xff5a}
+  ,
+  {0x10428, 0x1044f}
+  ,
+  {0xe0061, 0xe007a}
+};
+
+scm_t_char_set cs_lower_case = {
+  523,
+  cs_lower_case_ranges
+};
+
+scm_t_char_range cs_upper_case_ranges[] = {
+  {0x0041, 0x005a}
+  ,
+  {0x00c0, 0x00d6}
+  ,
+  {0x00d8, 0x00de}
+  ,
+  {0x0100, 0x0100}
+  ,
+  {0x0102, 0x0102}
+  ,
+  {0x0104, 0x0104}
+  ,
+  {0x0106, 0x0106}
+  ,
+  {0x0108, 0x0108}
+  ,
+  {0x010a, 0x010a}
+  ,
+  {0x010c, 0x010c}
+  ,
+  {0x010e, 0x010e}
+  ,
+  {0x0110, 0x0110}
+  ,
+  {0x0112, 0x0112}
+  ,
+  {0x0114, 0x0114}
+  ,
+  {0x0116, 0x0116}
+  ,
+  {0x0118, 0x0118}
+  ,
+  {0x011a, 0x011a}
+  ,
+  {0x011c, 0x011c}
+  ,
+  {0x011e, 0x011e}
+  ,
+  {0x0120, 0x0120}
+  ,
+  {0x0122, 0x0122}
+  ,
+  {0x0124, 0x0124}
+  ,
+  {0x0126, 0x0126}
+  ,
+  {0x0128, 0x0128}
+  ,
+  {0x012a, 0x012a}
+  ,
+  {0x012c, 0x012c}
+  ,
+  {0x012e, 0x012e}
+  ,
+  {0x0130, 0x0130}
+  ,
+  {0x0132, 0x0132}
+  ,
+  {0x0134, 0x0134}
+  ,
+  {0x0136, 0x0136}
+  ,
+  {0x0139, 0x0139}
+  ,
+  {0x013b, 0x013b}
+  ,
+  {0x013d, 0x013d}
+  ,
+  {0x013f, 0x013f}
+  ,
+  {0x0141, 0x0141}
+  ,
+  {0x0143, 0x0143}
+  ,
+  {0x0145, 0x0145}
+  ,
+  {0x0147, 0x0147}
+  ,
+  {0x014a, 0x014a}
+  ,
+  {0x014c, 0x014c}
+  ,
+  {0x014e, 0x014e}
+  ,
+  {0x0150, 0x0150}
+  ,
+  {0x0152, 0x0152}
+  ,
+  {0x0154, 0x0154}
+  ,
+  {0x0156, 0x0156}
+  ,
+  {0x0158, 0x0158}
+  ,
+  {0x015a, 0x015a}
+  ,
+  {0x015c, 0x015c}
+  ,
+  {0x015e, 0x015e}
+  ,
+  {0x0160, 0x0160}
+  ,
+  {0x0162, 0x0162}
+  ,
+  {0x0164, 0x0164}
+  ,
+  {0x0166, 0x0166}
+  ,
+  {0x0168, 0x0168}
+  ,
+  {0x016a, 0x016a}
+  ,
+  {0x016c, 0x016c}
+  ,
+  {0x016e, 0x016e}
+  ,
+  {0x0170, 0x0170}
+  ,
+  {0x0172, 0x0172}
+  ,
+  {0x0174, 0x0174}
+  ,
+  {0x0176, 0x0176}
+  ,
+  {0x0178, 0x0179}
+  ,
+  {0x017b, 0x017b}
+  ,
+  {0x017d, 0x017d}
+  ,
+  {0x0181, 0x0182}
+  ,
+  {0x0184, 0x0184}
+  ,
+  {0x0186, 0x0187}
+  ,
+  {0x0189, 0x018b}
+  ,
+  {0x018e, 0x0191}
+  ,
+  {0x0193, 0x0194}
+  ,
+  {0x0196, 0x0198}
+  ,
+  {0x019c, 0x019d}
+  ,
+  {0x019f, 0x01a0}
+  ,
+  {0x01a2, 0x01a2}
+  ,
+  {0x01a4, 0x01a4}
+  ,
+  {0x01a6, 0x01a7}
+  ,
+  {0x01a9, 0x01a9}
+  ,
+  {0x01ac, 0x01ac}
+  ,
+  {0x01ae, 0x01af}
+  ,
+  {0x01b1, 0x01b3}
+  ,
+  {0x01b5, 0x01b5}
+  ,
+  {0x01b7, 0x01b8}
+  ,
+  {0x01bc, 0x01bc}
+  ,
+  {0x01c4, 0x01c4}
+  ,
+  {0x01c7, 0x01c7}
+  ,
+  {0x01ca, 0x01ca}
+  ,
+  {0x01cd, 0x01cd}
+  ,
+  {0x01cf, 0x01cf}
+  ,
+  {0x01d1, 0x01d1}
+  ,
+  {0x01d3, 0x01d3}
+  ,
+  {0x01d5, 0x01d5}
+  ,
+  {0x01d7, 0x01d7}
+  ,
+  {0x01d9, 0x01d9}
+  ,
+  {0x01db, 0x01db}
+  ,
+  {0x01de, 0x01de}
+  ,
+  {0x01e0, 0x01e0}
+  ,
+  {0x01e2, 0x01e2}
+  ,
+  {0x01e4, 0x01e4}
+  ,
+  {0x01e6, 0x01e6}
+  ,
+  {0x01e8, 0x01e8}
+  ,
+  {0x01ea, 0x01ea}
+  ,
+  {0x01ec, 0x01ec}
+  ,
+  {0x01ee, 0x01ee}
+  ,
+  {0x01f1, 0x01f1}
+  ,
+  {0x01f4, 0x01f4}
+  ,
+  {0x01f6, 0x01f8}
+  ,
+  {0x01fa, 0x01fa}
+  ,
+  {0x01fc, 0x01fc}
+  ,
+  {0x01fe, 0x01fe}
+  ,
+  {0x0200, 0x0200}
+  ,
+  {0x0202, 0x0202}
+  ,
+  {0x0204, 0x0204}
+  ,
+  {0x0206, 0x0206}
+  ,
+  {0x0208, 0x0208}
+  ,
+  {0x020a, 0x020a}
+  ,
+  {0x020c, 0x020c}
+  ,
+  {0x020e, 0x020e}
+  ,
+  {0x0210, 0x0210}
+  ,
+  {0x0212, 0x0212}
+  ,
+  {0x0214, 0x0214}
+  ,
+  {0x0216, 0x0216}
+  ,
+  {0x0218, 0x0218}
+  ,
+  {0x021a, 0x021a}
+  ,
+  {0x021c, 0x021c}
+  ,
+  {0x021e, 0x021e}
+  ,
+  {0x0220, 0x0220}
+  ,
+  {0x0222, 0x0222}
+  ,
+  {0x0224, 0x0224}
+  ,
+  {0x0226, 0x0226}
+  ,
+  {0x0228, 0x0228}
+  ,
+  {0x022a, 0x022a}
+  ,
+  {0x022c, 0x022c}
+  ,
+  {0x022e, 0x022e}
+  ,
+  {0x0230, 0x0230}
+  ,
+  {0x0232, 0x0232}
+  ,
+  {0x023a, 0x023b}
+  ,
+  {0x023d, 0x023e}
+  ,
+  {0x0241, 0x0241}
+  ,
+  {0x0243, 0x0246}
+  ,
+  {0x0248, 0x0248}
+  ,
+  {0x024a, 0x024a}
+  ,
+  {0x024c, 0x024c}
+  ,
+  {0x024e, 0x024e}
+  ,
+  {0x0370, 0x0370}
+  ,
+  {0x0372, 0x0372}
+  ,
+  {0x0376, 0x0376}
+  ,
+  {0x0386, 0x0386}
+  ,
+  {0x0388, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x038f}
+  ,
+  {0x0391, 0x03a1}
+  ,
+  {0x03a3, 0x03ab}
+  ,
+  {0x03cf, 0x03cf}
+  ,
+  {0x03d8, 0x03d8}
+  ,
+  {0x03da, 0x03da}
+  ,
+  {0x03dc, 0x03dc}
+  ,
+  {0x03de, 0x03de}
+  ,
+  {0x03e0, 0x03e0}
+  ,
+  {0x03e2, 0x03e2}
+  ,
+  {0x03e4, 0x03e4}
+  ,
+  {0x03e6, 0x03e6}
+  ,
+  {0x03e8, 0x03e8}
+  ,
+  {0x03ea, 0x03ea}
+  ,
+  {0x03ec, 0x03ec}
+  ,
+  {0x03ee, 0x03ee}
+  ,
+  {0x03f4, 0x03f4}
+  ,
+  {0x03f7, 0x03f7}
+  ,
+  {0x03f9, 0x03fa}
+  ,
+  {0x03fd, 0x042f}
+  ,
+  {0x0460, 0x0460}
+  ,
+  {0x0462, 0x0462}
+  ,
+  {0x0464, 0x0464}
+  ,
+  {0x0466, 0x0466}
+  ,
+  {0x0468, 0x0468}
+  ,
+  {0x046a, 0x046a}
+  ,
+  {0x046c, 0x046c}
+  ,
+  {0x046e, 0x046e}
+  ,
+  {0x0470, 0x0470}
+  ,
+  {0x0472, 0x0472}
+  ,
+  {0x0474, 0x0474}
+  ,
+  {0x0476, 0x0476}
+  ,
+  {0x0478, 0x0478}
+  ,
+  {0x047a, 0x047a}
+  ,
+  {0x047c, 0x047c}
+  ,
+  {0x047e, 0x047e}
+  ,
+  {0x0480, 0x0480}
+  ,
+  {0x048a, 0x048a}
+  ,
+  {0x048c, 0x048c}
+  ,
+  {0x048e, 0x048e}
+  ,
+  {0x0490, 0x0490}
+  ,
+  {0x0492, 0x0492}
+  ,
+  {0x0494, 0x0494}
+  ,
+  {0x0496, 0x0496}
+  ,
+  {0x0498, 0x0498}
+  ,
+  {0x049a, 0x049a}
+  ,
+  {0x049c, 0x049c}
+  ,
+  {0x049e, 0x049e}
+  ,
+  {0x04a0, 0x04a0}
+  ,
+  {0x04a2, 0x04a2}
+  ,
+  {0x04a4, 0x04a4}
+  ,
+  {0x04a6, 0x04a6}
+  ,
+  {0x04a8, 0x04a8}
+  ,
+  {0x04aa, 0x04aa}
+  ,
+  {0x04ac, 0x04ac}
+  ,
+  {0x04ae, 0x04ae}
+  ,
+  {0x04b0, 0x04b0}
+  ,
+  {0x04b2, 0x04b2}
+  ,
+  {0x04b4, 0x04b4}
+  ,
+  {0x04b6, 0x04b6}
+  ,
+  {0x04b8, 0x04b8}
+  ,
+  {0x04ba, 0x04ba}
+  ,
+  {0x04bc, 0x04bc}
+  ,
+  {0x04be, 0x04be}
+  ,
+  {0x04c0, 0x04c1}
+  ,
+  {0x04c3, 0x04c3}
+  ,
+  {0x04c5, 0x04c5}
+  ,
+  {0x04c7, 0x04c7}
+  ,
+  {0x04c9, 0x04c9}
+  ,
+  {0x04cb, 0x04cb}
+  ,
+  {0x04cd, 0x04cd}
+  ,
+  {0x04d0, 0x04d0}
+  ,
+  {0x04d2, 0x04d2}
+  ,
+  {0x04d4, 0x04d4}
+  ,
+  {0x04d6, 0x04d6}
+  ,
+  {0x04d8, 0x04d8}
+  ,
+  {0x04da, 0x04da}
+  ,
+  {0x04dc, 0x04dc}
+  ,
+  {0x04de, 0x04de}
+  ,
+  {0x04e0, 0x04e0}
+  ,
+  {0x04e2, 0x04e2}
+  ,
+  {0x04e4, 0x04e4}
+  ,
+  {0x04e6, 0x04e6}
+  ,
+  {0x04e8, 0x04e8}
+  ,
+  {0x04ea, 0x04ea}
+  ,
+  {0x04ec, 0x04ec}
+  ,
+  {0x04ee, 0x04ee}
+  ,
+  {0x04f0, 0x04f0}
+  ,
+  {0x04f2, 0x04f2}
+  ,
+  {0x04f4, 0x04f4}
+  ,
+  {0x04f6, 0x04f6}
+  ,
+  {0x04f8, 0x04f8}
+  ,
+  {0x04fa, 0x04fa}
+  ,
+  {0x04fc, 0x04fc}
+  ,
+  {0x04fe, 0x04fe}
+  ,
+  {0x0500, 0x0500}
+  ,
+  {0x0502, 0x0502}
+  ,
+  {0x0504, 0x0504}
+  ,
+  {0x0506, 0x0506}
+  ,
+  {0x0508, 0x0508}
+  ,
+  {0x050a, 0x050a}
+  ,
+  {0x050c, 0x050c}
+  ,
+  {0x050e, 0x050e}
+  ,
+  {0x0510, 0x0510}
+  ,
+  {0x0512, 0x0512}
+  ,
+  {0x0514, 0x0514}
+  ,
+  {0x0516, 0x0516}
+  ,
+  {0x0518, 0x0518}
+  ,
+  {0x051a, 0x051a}
+  ,
+  {0x051c, 0x051c}
+  ,
+  {0x051e, 0x051e}
+  ,
+  {0x0520, 0x0520}
+  ,
+  {0x0522, 0x0522}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x10a0, 0x10c5}
+  ,
+  {0x1d7b, 0x1d7b}
+  ,
+  {0x1d7e, 0x1d7e}
+  ,
+  {0x1e00, 0x1e00}
+  ,
+  {0x1e02, 0x1e02}
+  ,
+  {0x1e04, 0x1e04}
+  ,
+  {0x1e06, 0x1e06}
+  ,
+  {0x1e08, 0x1e08}
+  ,
+  {0x1e0a, 0x1e0a}
+  ,
+  {0x1e0c, 0x1e0c}
+  ,
+  {0x1e0e, 0x1e0e}
+  ,
+  {0x1e10, 0x1e10}
+  ,
+  {0x1e12, 0x1e12}
+  ,
+  {0x1e14, 0x1e14}
+  ,
+  {0x1e16, 0x1e16}
+  ,
+  {0x1e18, 0x1e18}
+  ,
+  {0x1e1a, 0x1e1a}
+  ,
+  {0x1e1c, 0x1e1c}
+  ,
+  {0x1e1e, 0x1e1e}
+  ,
+  {0x1e20, 0x1e20}
+  ,
+  {0x1e22, 0x1e22}
+  ,
+  {0x1e24, 0x1e24}
+  ,
+  {0x1e26, 0x1e26}
+  ,
+  {0x1e28, 0x1e28}
+  ,
+  {0x1e2a, 0x1e2a}
+  ,
+  {0x1e2c, 0x1e2c}
+  ,
+  {0x1e2e, 0x1e2e}
+  ,
+  {0x1e30, 0x1e30}
+  ,
+  {0x1e32, 0x1e32}
+  ,
+  {0x1e34, 0x1e34}
+  ,
+  {0x1e36, 0x1e36}
+  ,
+  {0x1e38, 0x1e38}
+  ,
+  {0x1e3a, 0x1e3a}
+  ,
+  {0x1e3c, 0x1e3c}
+  ,
+  {0x1e3e, 0x1e3e}
+  ,
+  {0x1e40, 0x1e40}
+  ,
+  {0x1e42, 0x1e42}
+  ,
+  {0x1e44, 0x1e44}
+  ,
+  {0x1e46, 0x1e46}
+  ,
+  {0x1e48, 0x1e48}
+  ,
+  {0x1e4a, 0x1e4a}
+  ,
+  {0x1e4c, 0x1e4c}
+  ,
+  {0x1e4e, 0x1e4e}
+  ,
+  {0x1e50, 0x1e50}
+  ,
+  {0x1e52, 0x1e52}
+  ,
+  {0x1e54, 0x1e54}
+  ,
+  {0x1e56, 0x1e56}
+  ,
+  {0x1e58, 0x1e58}
+  ,
+  {0x1e5a, 0x1e5a}
+  ,
+  {0x1e5c, 0x1e5c}
+  ,
+  {0x1e5e, 0x1e5e}
+  ,
+  {0x1e60, 0x1e60}
+  ,
+  {0x1e62, 0x1e62}
+  ,
+  {0x1e64, 0x1e64}
+  ,
+  {0x1e66, 0x1e66}
+  ,
+  {0x1e68, 0x1e68}
+  ,
+  {0x1e6a, 0x1e6a}
+  ,
+  {0x1e6c, 0x1e6c}
+  ,
+  {0x1e6e, 0x1e6e}
+  ,
+  {0x1e70, 0x1e70}
+  ,
+  {0x1e72, 0x1e72}
+  ,
+  {0x1e74, 0x1e74}
+  ,
+  {0x1e76, 0x1e76}
+  ,
+  {0x1e78, 0x1e78}
+  ,
+  {0x1e7a, 0x1e7a}
+  ,
+  {0x1e7c, 0x1e7c}
+  ,
+  {0x1e7e, 0x1e7e}
+  ,
+  {0x1e80, 0x1e80}
+  ,
+  {0x1e82, 0x1e82}
+  ,
+  {0x1e84, 0x1e84}
+  ,
+  {0x1e86, 0x1e86}
+  ,
+  {0x1e88, 0x1e88}
+  ,
+  {0x1e8a, 0x1e8a}
+  ,
+  {0x1e8c, 0x1e8c}
+  ,
+  {0x1e8e, 0x1e8e}
+  ,
+  {0x1e90, 0x1e90}
+  ,
+  {0x1e92, 0x1e92}
+  ,
+  {0x1e94, 0x1e94}
+  ,
+  {0x1e9e, 0x1e9e}
+  ,
+  {0x1ea0, 0x1ea0}
+  ,
+  {0x1ea2, 0x1ea2}
+  ,
+  {0x1ea4, 0x1ea4}
+  ,
+  {0x1ea6, 0x1ea6}
+  ,
+  {0x1ea8, 0x1ea8}
+  ,
+  {0x1eaa, 0x1eaa}
+  ,
+  {0x1eac, 0x1eac}
+  ,
+  {0x1eae, 0x1eae}
+  ,
+  {0x1eb0, 0x1eb0}
+  ,
+  {0x1eb2, 0x1eb2}
+  ,
+  {0x1eb4, 0x1eb4}
+  ,
+  {0x1eb6, 0x1eb6}
+  ,
+  {0x1eb8, 0x1eb8}
+  ,
+  {0x1eba, 0x1eba}
+  ,
+  {0x1ebc, 0x1ebc}
+  ,
+  {0x1ebe, 0x1ebe}
+  ,
+  {0x1ec0, 0x1ec0}
+  ,
+  {0x1ec2, 0x1ec2}
+  ,
+  {0x1ec4, 0x1ec4}
+  ,
+  {0x1ec6, 0x1ec6}
+  ,
+  {0x1ec8, 0x1ec8}
+  ,
+  {0x1eca, 0x1eca}
+  ,
+  {0x1ecc, 0x1ecc}
+  ,
+  {0x1ece, 0x1ece}
+  ,
+  {0x1ed0, 0x1ed0}
+  ,
+  {0x1ed2, 0x1ed2}
+  ,
+  {0x1ed4, 0x1ed4}
+  ,
+  {0x1ed6, 0x1ed6}
+  ,
+  {0x1ed8, 0x1ed8}
+  ,
+  {0x1eda, 0x1eda}
+  ,
+  {0x1edc, 0x1edc}
+  ,
+  {0x1ede, 0x1ede}
+  ,
+  {0x1ee0, 0x1ee0}
+  ,
+  {0x1ee2, 0x1ee2}
+  ,
+  {0x1ee4, 0x1ee4}
+  ,
+  {0x1ee6, 0x1ee6}
+  ,
+  {0x1ee8, 0x1ee8}
+  ,
+  {0x1eea, 0x1eea}
+  ,
+  {0x1eec, 0x1eec}
+  ,
+  {0x1eee, 0x1eee}
+  ,
+  {0x1ef0, 0x1ef0}
+  ,
+  {0x1ef2, 0x1ef2}
+  ,
+  {0x1ef4, 0x1ef4}
+  ,
+  {0x1ef6, 0x1ef6}
+  ,
+  {0x1ef8, 0x1ef8}
+  ,
+  {0x1efa, 0x1efa}
+  ,
+  {0x1efc, 0x1efc}
+  ,
+  {0x1efe, 0x1efe}
+  ,
+  {0x1f08, 0x1f0f}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f28, 0x1f2f}
+  ,
+  {0x1f38, 0x1f3f}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f5f}
+  ,
+  {0x1f68, 0x1f6f}
+  ,
+  {0x1f88, 0x1f8f}
+  ,
+  {0x1f98, 0x1f9f}
+  ,
+  {0x1fa8, 0x1faf}
+  ,
+  {0x1fb8, 0x1fbc}
+  ,
+  {0x1fc8, 0x1fcc}
+  ,
+  {0x1fd8, 0x1fdb}
+  ,
+  {0x1fe8, 0x1fec}
+  ,
+  {0x1ff8, 0x1ffc}
+  ,
+  {0xa640, 0xa640}
+  ,
+  {0xa642, 0xa642}
+  ,
+  {0xa644, 0xa644}
+  ,
+  {0xa646, 0xa646}
+  ,
+  {0xa648, 0xa648}
+  ,
+  {0xa64a, 0xa64a}
+  ,
+  {0xa64c, 0xa64c}
+  ,
+  {0xa64e, 0xa64e}
+  ,
+  {0xa650, 0xa650}
+  ,
+  {0xa652, 0xa652}
+  ,
+  {0xa654, 0xa654}
+  ,
+  {0xa656, 0xa656}
+  ,
+  {0xa658, 0xa658}
+  ,
+  {0xa65a, 0xa65a}
+  ,
+  {0xa65c, 0xa65c}
+  ,
+  {0xa65e, 0xa65e}
+  ,
+  {0xa662, 0xa662}
+  ,
+  {0xa664, 0xa664}
+  ,
+  {0xa666, 0xa666}
+  ,
+  {0xa668, 0xa668}
+  ,
+  {0xa66a, 0xa66a}
+  ,
+  {0xa66c, 0xa66c}
+  ,
+  {0xa680, 0xa680}
+  ,
+  {0xa682, 0xa682}
+  ,
+  {0xa684, 0xa684}
+  ,
+  {0xa686, 0xa686}
+  ,
+  {0xa688, 0xa688}
+  ,
+  {0xa68a, 0xa68a}
+  ,
+  {0xa68c, 0xa68c}
+  ,
+  {0xa68e, 0xa68e}
+  ,
+  {0xa690, 0xa690}
+  ,
+  {0xa692, 0xa692}
+  ,
+  {0xa694, 0xa694}
+  ,
+  {0xa696, 0xa696}
+  ,
+  {0xa722, 0xa722}
+  ,
+  {0xa724, 0xa724}
+  ,
+  {0xa726, 0xa726}
+  ,
+  {0xa728, 0xa728}
+  ,
+  {0xa72a, 0xa72a}
+  ,
+  {0xa72c, 0xa72c}
+  ,
+  {0xa72e, 0xa72e}
+  ,
+  {0xa732, 0xa732}
+  ,
+  {0xa734, 0xa734}
+  ,
+  {0xa736, 0xa736}
+  ,
+  {0xa738, 0xa738}
+  ,
+  {0xa73a, 0xa73a}
+  ,
+  {0xa73c, 0xa73c}
+  ,
+  {0xa73e, 0xa73e}
+  ,
+  {0xa740, 0xa740}
+  ,
+  {0xa742, 0xa742}
+  ,
+  {0xa744, 0xa744}
+  ,
+  {0xa746, 0xa746}
+  ,
+  {0xa748, 0xa748}
+  ,
+  {0xa74a, 0xa74a}
+  ,
+  {0xa74c, 0xa74c}
+  ,
+  {0xa74e, 0xa74e}
+  ,
+  {0xa750, 0xa750}
+  ,
+  {0xa752, 0xa752}
+  ,
+  {0xa754, 0xa754}
+  ,
+  {0xa756, 0xa756}
+  ,
+  {0xa758, 0xa758}
+  ,
+  {0xa75a, 0xa75a}
+  ,
+  {0xa75c, 0xa75c}
+  ,
+  {0xa75e, 0xa75e}
+  ,
+  {0xa760, 0xa760}
+  ,
+  {0xa762, 0xa762}
+  ,
+  {0xa764, 0xa764}
+  ,
+  {0xa766, 0xa766}
+  ,
+  {0xa768, 0xa768}
+  ,
+  {0xa76a, 0xa76a}
+  ,
+  {0xa76c, 0xa76c}
+  ,
+  {0xa76e, 0xa76e}
+  ,
+  {0xa779, 0xa779}
+  ,
+  {0xa77b, 0xa77b}
+  ,
+  {0xa77d, 0xa77e}
+  ,
+  {0xa780, 0xa780}
+  ,
+  {0xa782, 0xa782}
+  ,
+  {0xa784, 0xa784}
+  ,
+  {0xa786, 0xa786}
+  ,
+  {0xa78b, 0xa78b}
+  ,
+  {0xff21, 0xff3a}
+  ,
+  {0x10400, 0x10427}
+  ,
+  {0xe0041, 0xe005a}
+};
+
+scm_t_char_set cs_upper_case = {
+  492,
+  cs_upper_case_ranges
+};
+
+scm_t_char_range cs_title_case_ranges[] = {
+  {0x01c5, 0x01c5}
+  ,
+  {0x01c8, 0x01c8}
+  ,
+  {0x01cb, 0x01cb}
+  ,
+  {0x01f2, 0x01f2}
+  ,
+  {0x1f88, 0x1f8f}
+  ,
+  {0x1f98, 0x1f9f}
+  ,
+  {0x1fa8, 0x1faf}
+  ,
+  {0x1fbc, 0x1fbc}
+  ,
+  {0x1fcc, 0x1fcc}
+  ,
+  {0x1ffc, 0x1ffc}
+};
+
+scm_t_char_set cs_title_case = {
+  10,
+  cs_title_case_ranges
+};
+
+scm_t_char_range cs_letter_ranges[] = {
+  {0x0041, 0x005a}
+  ,
+  {0x0061, 0x007a}
+  ,
+  {0x00aa, 0x00aa}
+  ,
+  {0x00b5, 0x00b5}
+  ,
+  {0x00ba, 0x00ba}
+  ,
+  {0x00c0, 0x00d6}
+  ,
+  {0x00d8, 0x00f6}
+  ,
+  {0x00f8, 0x02c1}
+  ,
+  {0x02c6, 0x02d1}
+  ,
+  {0x02e0, 0x02e4}
+  ,
+  {0x02ec, 0x02ec}
+  ,
+  {0x02ee, 0x02ee}
+  ,
+  {0x0370, 0x0374}
+  ,
+  {0x0376, 0x0377}
+  ,
+  {0x037a, 0x037d}
+  ,
+  {0x0386, 0x0386}
+  ,
+  {0x0388, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x03f5}
+  ,
+  {0x03f7, 0x0481}
+  ,
+  {0x048a, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x0559}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f2}
+  ,
+  {0x0621, 0x064a}
+  ,
+  {0x066e, 0x066f}
+  ,
+  {0x0671, 0x06d3}
+  ,
+  {0x06d5, 0x06d5}
+  ,
+  {0x06e5, 0x06e6}
+  ,
+  {0x06ee, 0x06ef}
+  ,
+  {0x06fa, 0x06fc}
+  ,
+  {0x06ff, 0x06ff}
+  ,
+  {0x0710, 0x0710}
+  ,
+  {0x0712, 0x072f}
+  ,
+  {0x074d, 0x07a5}
+  ,
+  {0x07b1, 0x07b1}
+  ,
+  {0x07ca, 0x07ea}
+  ,
+  {0x07f4, 0x07f5}
+  ,
+  {0x07fa, 0x07fa}
+  ,
+  {0x0904, 0x0939}
+  ,
+  {0x093d, 0x093d}
+  ,
+  {0x0950, 0x0950}
+  ,
+  {0x0958, 0x0961}
+  ,
+  {0x0971, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bd, 0x09bd}
+  ,
+  {0x09ce, 0x09ce}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e1}
+  ,
+  {0x09f0, 0x09f1}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a72, 0x0a74}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abd, 0x0abd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae1}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3d, 0x0b3d}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b61}
+  ,
+  {0x0b71, 0x0b71}
+  ,
+  {0x0b83, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c3d}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c61}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbd, 0x0cbd}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce1}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d3d}
+  ,
+  {0x0d60, 0x0d61}
+  ,
+  {0x0d7a, 0x0d7f}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0e01, 0x0e30}
+  ,
+  {0x0e32, 0x0e33}
+  ,
+  {0x0e40, 0x0e46}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb0}
+  ,
+  {0x0eb2, 0x0eb3}
+  ,
+  {0x0ebd, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f00}
+  ,
+  {0x0f40, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f88, 0x0f8b}
+  ,
+  {0x1000, 0x102a}
+  ,
+  {0x103f, 0x103f}
+  ,
+  {0x1050, 0x1055}
+  ,
+  {0x105a, 0x105d}
+  ,
+  {0x1061, 0x1061}
+  ,
+  {0x1065, 0x1066}
+  ,
+  {0x106e, 0x1070}
+  ,
+  {0x1075, 0x1081}
+  ,
+  {0x108e, 0x108e}
+  ,
+  {0x10a0, 0x10c5}
+  ,
+  {0x10d0, 0x10fa}
+  ,
+  {0x10fc, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x1380, 0x138f}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x166c}
+  ,
+  {0x166f, 0x1676}
+  ,
+  {0x1681, 0x169a}
+  ,
+  {0x16a0, 0x16ea}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1711}
+  ,
+  {0x1720, 0x1731}
+  ,
+  {0x1740, 0x1751}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17d7, 0x17d7}
+  ,
+  {0x17dc, 0x17dc}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18a8}
+  ,
+  {0x18aa, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1950, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19c1, 0x19c7}
+  ,
+  {0x1a00, 0x1a16}
+  ,
+  {0x1b05, 0x1b33}
+  ,
+  {0x1b45, 0x1b4b}
+  ,
+  {0x1b83, 0x1ba0}
+  ,
+  {0x1bae, 0x1baf}
+  ,
+  {0x1c00, 0x1c23}
+  ,
+  {0x1c4d, 0x1c4f}
+  ,
+  {0x1c5a, 0x1c7d}
+  ,
+  {0x1d00, 0x1dbf}
+  ,
+  {0x1e00, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fbc}
+  ,
+  {0x1fbe, 0x1fbe}
+  ,
+  {0x1fc2, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fcc}
+  ,
+  {0x1fd0, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fe0, 0x1fec}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffc}
+  ,
+  {0x2071, 0x2071}
+  ,
+  {0x207f, 0x207f}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x2102, 0x2102}
+  ,
+  {0x2107, 0x2107}
+  ,
+  {0x210a, 0x2113}
+  ,
+  {0x2115, 0x2115}
+  ,
+  {0x2119, 0x211d}
+  ,
+  {0x2124, 0x2124}
+  ,
+  {0x2126, 0x2126}
+  ,
+  {0x2128, 0x2128}
+  ,
+  {0x212a, 0x212d}
+  ,
+  {0x212f, 0x2139}
+  ,
+  {0x213c, 0x213f}
+  ,
+  {0x2145, 0x2149}
+  ,
+  {0x214e, 0x214e}
+  ,
+  {0x2183, 0x2184}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2ce4}
+  ,
+  {0x2d00, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2e2f, 0x2e2f}
+  ,
+  {0x3005, 0x3006}
+  ,
+  {0x3031, 0x3035}
+  ,
+  {0x303b, 0x303c}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x309d, 0x309f}
+  ,
+  {0x30a1, 0x30fa}
+  ,
+  {0x30fc, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x31a0, 0x31b7}
+  ,
+  {0x31f0, 0x31ff}
+  ,
+  {0x3400, 0x4db5}
+  ,
+  {0x4e00, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa500, 0xa60c}
+  ,
+  {0xa610, 0xa61f}
+  ,
+  {0xa62a, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa66e}
+  ,
+  {0xa67f, 0xa697}
+  ,
+  {0xa717, 0xa71f}
+  ,
+  {0xa722, 0xa788}
+  ,
+  {0xa78b, 0xa78c}
+  ,
+  {0xa7fb, 0xa801}
+  ,
+  {0xa803, 0xa805}
+  ,
+  {0xa807, 0xa80a}
+  ,
+  {0xa80c, 0xa822}
+  ,
+  {0xa840, 0xa873}
+  ,
+  {0xa882, 0xa8b3}
+  ,
+  {0xa90a, 0xa925}
+  ,
+  {0xa930, 0xa946}
+  ,
+  {0xaa00, 0xaa28}
+  ,
+  {0xaa40, 0xaa42}
+  ,
+  {0xaa44, 0xaa4b}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb1d}
+  ,
+  {0xfb1f, 0xfb28}
+  ,
+  {0xfb2a, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3d}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfb}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff21, 0xff3a}
+  ,
+  {0xff41, 0xff5a}
+  ,
+  {0xff66, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10330, 0x10340}
+  ,
+  {0x10342, 0x10349}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x103a0, 0x103c3}
+  ,
+  {0x103c8, 0x103cf}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10915}
+  ,
+  {0x10920, 0x10939}
+  ,
+  {0x10a00, 0x10a00}
+  ,
+  {0x10a10, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d6c0}
+  ,
+  {0x1d6c2, 0x1d6da}
+  ,
+  {0x1d6dc, 0x1d6fa}
+  ,
+  {0x1d6fc, 0x1d714}
+  ,
+  {0x1d716, 0x1d734}
+  ,
+  {0x1d736, 0x1d74e}
+  ,
+  {0x1d750, 0x1d76e}
+  ,
+  {0x1d770, 0x1d788}
+  ,
+  {0x1d78a, 0x1d7a8}
+  ,
+  {0x1d7aa, 0x1d7c2}
+  ,
+  {0x1d7c4, 0x1d7cb}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+};
+
+scm_t_char_set cs_letter = {
+  390,
+  cs_letter_ranges
+};
+
+scm_t_char_range cs_digit_ranges[] = {
+  {0x0030, 0x0039}
+  ,
+  {0x0660, 0x0669}
+  ,
+  {0x06f0, 0x06f9}
+  ,
+  {0x07c0, 0x07c9}
+  ,
+  {0x0966, 0x096f}
+  ,
+  {0x09e6, 0x09ef}
+  ,
+  {0x0a66, 0x0a6f}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0b66, 0x0b6f}
+  ,
+  {0x0be6, 0x0bef}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0d66, 0x0d6f}
+  ,
+  {0x0e50, 0x0e59}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0f20, 0x0f29}
+  ,
+  {0x1040, 0x1049}
+  ,
+  {0x1090, 0x1099}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1946, 0x194f}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x1b50, 0x1b59}
+  ,
+  {0x1bb0, 0x1bb9}
+  ,
+  {0x1c40, 0x1c49}
+  ,
+  {0x1c50, 0x1c59}
+  ,
+  {0xa620, 0xa629}
+  ,
+  {0xa8d0, 0xa8d9}
+  ,
+  {0xa900, 0xa909}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xff10, 0xff19}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x1d7ce, 0x1d7ff}
+};
+
+scm_t_char_set cs_digit = {
+  33,
+  cs_digit_ranges
+};
+
+scm_t_char_range cs_hex_digit_ranges[] = {
+  {0x0030, 0x0039}
+  ,
+  {0x0041, 0x0046}
+  ,
+  {0x0061, 0x0066}
+};
+
+scm_t_char_set cs_hex_digit = {
+  3,
+  cs_hex_digit_ranges
+};
+
+scm_t_char_range cs_letter_plus_digit_ranges[] = {
+  {0x0030, 0x0039}
+  ,
+  {0x0041, 0x005a}
+  ,
+  {0x0061, 0x007a}
+  ,
+  {0x00aa, 0x00aa}
+  ,
+  {0x00b5, 0x00b5}
+  ,
+  {0x00ba, 0x00ba}
+  ,
+  {0x00c0, 0x00d6}
+  ,
+  {0x00d8, 0x00f6}
+  ,
+  {0x00f8, 0x02c1}
+  ,
+  {0x02c6, 0x02d1}
+  ,
+  {0x02e0, 0x02e4}
+  ,
+  {0x02ec, 0x02ec}
+  ,
+  {0x02ee, 0x02ee}
+  ,
+  {0x0370, 0x0374}
+  ,
+  {0x0376, 0x0377}
+  ,
+  {0x037a, 0x037d}
+  ,
+  {0x0386, 0x0386}
+  ,
+  {0x0388, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x03f5}
+  ,
+  {0x03f7, 0x0481}
+  ,
+  {0x048a, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x0559}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f2}
+  ,
+  {0x0621, 0x064a}
+  ,
+  {0x0660, 0x0669}
+  ,
+  {0x066e, 0x066f}
+  ,
+  {0x0671, 0x06d3}
+  ,
+  {0x06d5, 0x06d5}
+  ,
+  {0x06e5, 0x06e6}
+  ,
+  {0x06ee, 0x06fc}
+  ,
+  {0x06ff, 0x06ff}
+  ,
+  {0x0710, 0x0710}
+  ,
+  {0x0712, 0x072f}
+  ,
+  {0x074d, 0x07a5}
+  ,
+  {0x07b1, 0x07b1}
+  ,
+  {0x07c0, 0x07ea}
+  ,
+  {0x07f4, 0x07f5}
+  ,
+  {0x07fa, 0x07fa}
+  ,
+  {0x0904, 0x0939}
+  ,
+  {0x093d, 0x093d}
+  ,
+  {0x0950, 0x0950}
+  ,
+  {0x0958, 0x0961}
+  ,
+  {0x0966, 0x096f}
+  ,
+  {0x0971, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bd, 0x09bd}
+  ,
+  {0x09ce, 0x09ce}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e1}
+  ,
+  {0x09e6, 0x09f1}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a6f}
+  ,
+  {0x0a72, 0x0a74}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abd, 0x0abd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae1}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3d, 0x0b3d}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b61}
+  ,
+  {0x0b66, 0x0b6f}
+  ,
+  {0x0b71, 0x0b71}
+  ,
+  {0x0b83, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0be6, 0x0bef}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c3d}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c61}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbd, 0x0cbd}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce1}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d3d}
+  ,
+  {0x0d60, 0x0d61}
+  ,
+  {0x0d66, 0x0d6f}
+  ,
+  {0x0d7a, 0x0d7f}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0e01, 0x0e30}
+  ,
+  {0x0e32, 0x0e33}
+  ,
+  {0x0e40, 0x0e46}
+  ,
+  {0x0e50, 0x0e59}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb0}
+  ,
+  {0x0eb2, 0x0eb3}
+  ,
+  {0x0ebd, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f00}
+  ,
+  {0x0f20, 0x0f29}
+  ,
+  {0x0f40, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f88, 0x0f8b}
+  ,
+  {0x1000, 0x102a}
+  ,
+  {0x103f, 0x1049}
+  ,
+  {0x1050, 0x1055}
+  ,
+  {0x105a, 0x105d}
+  ,
+  {0x1061, 0x1061}
+  ,
+  {0x1065, 0x1066}
+  ,
+  {0x106e, 0x1070}
+  ,
+  {0x1075, 0x1081}
+  ,
+  {0x108e, 0x108e}
+  ,
+  {0x1090, 0x1099}
+  ,
+  {0x10a0, 0x10c5}
+  ,
+  {0x10d0, 0x10fa}
+  ,
+  {0x10fc, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x1380, 0x138f}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x166c}
+  ,
+  {0x166f, 0x1676}
+  ,
+  {0x1681, 0x169a}
+  ,
+  {0x16a0, 0x16ea}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1711}
+  ,
+  {0x1720, 0x1731}
+  ,
+  {0x1740, 0x1751}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17d7, 0x17d7}
+  ,
+  {0x17dc, 0x17dc}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18a8}
+  ,
+  {0x18aa, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1946, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19c1, 0x19c7}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x1a00, 0x1a16}
+  ,
+  {0x1b05, 0x1b33}
+  ,
+  {0x1b45, 0x1b4b}
+  ,
+  {0x1b50, 0x1b59}
+  ,
+  {0x1b83, 0x1ba0}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c23}
+  ,
+  {0x1c40, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7d}
+  ,
+  {0x1d00, 0x1dbf}
+  ,
+  {0x1e00, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fbc}
+  ,
+  {0x1fbe, 0x1fbe}
+  ,
+  {0x1fc2, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fcc}
+  ,
+  {0x1fd0, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fe0, 0x1fec}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffc}
+  ,
+  {0x2071, 0x2071}
+  ,
+  {0x207f, 0x207f}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x2102, 0x2102}
+  ,
+  {0x2107, 0x2107}
+  ,
+  {0x210a, 0x2113}
+  ,
+  {0x2115, 0x2115}
+  ,
+  {0x2119, 0x211d}
+  ,
+  {0x2124, 0x2124}
+  ,
+  {0x2126, 0x2126}
+  ,
+  {0x2128, 0x2128}
+  ,
+  {0x212a, 0x212d}
+  ,
+  {0x212f, 0x2139}
+  ,
+  {0x213c, 0x213f}
+  ,
+  {0x2145, 0x2149}
+  ,
+  {0x214e, 0x214e}
+  ,
+  {0x2183, 0x2184}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2ce4}
+  ,
+  {0x2d00, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2e2f, 0x2e2f}
+  ,
+  {0x3005, 0x3006}
+  ,
+  {0x3031, 0x3035}
+  ,
+  {0x303b, 0x303c}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x309d, 0x309f}
+  ,
+  {0x30a1, 0x30fa}
+  ,
+  {0x30fc, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x31a0, 0x31b7}
+  ,
+  {0x31f0, 0x31ff}
+  ,
+  {0x3400, 0x4db5}
+  ,
+  {0x4e00, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa500, 0xa60c}
+  ,
+  {0xa610, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa66e}
+  ,
+  {0xa67f, 0xa697}
+  ,
+  {0xa717, 0xa71f}
+  ,
+  {0xa722, 0xa788}
+  ,
+  {0xa78b, 0xa78c}
+  ,
+  {0xa7fb, 0xa801}
+  ,
+  {0xa803, 0xa805}
+  ,
+  {0xa807, 0xa80a}
+  ,
+  {0xa80c, 0xa822}
+  ,
+  {0xa840, 0xa873}
+  ,
+  {0xa882, 0xa8b3}
+  ,
+  {0xa8d0, 0xa8d9}
+  ,
+  {0xa900, 0xa925}
+  ,
+  {0xa930, 0xa946}
+  ,
+  {0xaa00, 0xaa28}
+  ,
+  {0xaa40, 0xaa42}
+  ,
+  {0xaa44, 0xaa4b}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb1d}
+  ,
+  {0xfb1f, 0xfb28}
+  ,
+  {0xfb2a, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3d}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfb}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff10, 0xff19}
+  ,
+  {0xff21, 0xff3a}
+  ,
+  {0xff41, 0xff5a}
+  ,
+  {0xff66, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10330, 0x10340}
+  ,
+  {0x10342, 0x10349}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x103a0, 0x103c3}
+  ,
+  {0x103c8, 0x103cf}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10915}
+  ,
+  {0x10920, 0x10939}
+  ,
+  {0x10a00, 0x10a00}
+  ,
+  {0x10a10, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d6c0}
+  ,
+  {0x1d6c2, 0x1d6da}
+  ,
+  {0x1d6dc, 0x1d6fa}
+  ,
+  {0x1d6fc, 0x1d714}
+  ,
+  {0x1d716, 0x1d734}
+  ,
+  {0x1d736, 0x1d74e}
+  ,
+  {0x1d750, 0x1d76e}
+  ,
+  {0x1d770, 0x1d788}
+  ,
+  {0x1d78a, 0x1d7a8}
+  ,
+  {0x1d7aa, 0x1d7c2}
+  ,
+  {0x1d7c4, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+};
+
+scm_t_char_set cs_letter_plus_digit = {
+  411,
+  cs_letter_plus_digit_ranges
+};
+
+scm_t_char_range cs_graphic_ranges[] = {
+  {0x0021, 0x007e}
+  ,
+  {0x00a1, 0x00ac}
+  ,
+  {0x00ae, 0x0377}
+  ,
+  {0x037a, 0x037e}
+  ,
+  {0x0384, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x055f}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x0591, 0x05c7}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f4}
+  ,
+  {0x0606, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x0621, 0x065e}
+  ,
+  {0x0660, 0x06dc}
+  ,
+  {0x06de, 0x070d}
+  ,
+  {0x0710, 0x074a}
+  ,
+  {0x074d, 0x07b1}
+  ,
+  {0x07c0, 0x07fa}
+  ,
+  {0x0901, 0x0939}
+  ,
+  {0x093c, 0x094d}
+  ,
+  {0x0950, 0x0954}
+  ,
+  {0x0958, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0981, 0x0983}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bc, 0x09c4}
+  ,
+  {0x09c7, 0x09c8}
+  ,
+  {0x09cb, 0x09ce}
+  ,
+  {0x09d7, 0x09d7}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e3}
+  ,
+  {0x09e6, 0x09fa}
+  ,
+  {0x0a01, 0x0a03}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a3c, 0x0a3c}
+  ,
+  {0x0a3e, 0x0a42}
+  ,
+  {0x0a47, 0x0a48}
+  ,
+  {0x0a4b, 0x0a4d}
+  ,
+  {0x0a51, 0x0a51}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a75}
+  ,
+  {0x0a81, 0x0a83}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abc, 0x0ac5}
+  ,
+  {0x0ac7, 0x0ac9}
+  ,
+  {0x0acb, 0x0acd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae3}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b01, 0x0b03}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3c, 0x0b44}
+  ,
+  {0x0b47, 0x0b48}
+  ,
+  {0x0b4b, 0x0b4d}
+  ,
+  {0x0b56, 0x0b57}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b63}
+  ,
+  {0x0b66, 0x0b71}
+  ,
+  {0x0b82, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bbe, 0x0bc2}
+  ,
+  {0x0bc6, 0x0bc8}
+  ,
+  {0x0bca, 0x0bcd}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0bd7, 0x0bd7}
+  ,
+  {0x0be6, 0x0bfa}
+  ,
+  {0x0c01, 0x0c03}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c44}
+  ,
+  {0x0c46, 0x0c48}
+  ,
+  {0x0c4a, 0x0c4d}
+  ,
+  {0x0c55, 0x0c56}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c63}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c78, 0x0c7f}
+  ,
+  {0x0c82, 0x0c83}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbc, 0x0cc4}
+  ,
+  {0x0cc6, 0x0cc8}
+  ,
+  {0x0cca, 0x0ccd}
+  ,
+  {0x0cd5, 0x0cd6}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce3}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d02, 0x0d03}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d44}
+  ,
+  {0x0d46, 0x0d48}
+  ,
+  {0x0d4a, 0x0d4d}
+  ,
+  {0x0d57, 0x0d57}
+  ,
+  {0x0d60, 0x0d63}
+  ,
+  {0x0d66, 0x0d75}
+  ,
+  {0x0d79, 0x0d7f}
+  ,
+  {0x0d82, 0x0d83}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0dca, 0x0dca}
+  ,
+  {0x0dcf, 0x0dd4}
+  ,
+  {0x0dd6, 0x0dd6}
+  ,
+  {0x0dd8, 0x0ddf}
+  ,
+  {0x0df2, 0x0df4}
+  ,
+  {0x0e01, 0x0e3a}
+  ,
+  {0x0e3f, 0x0e5b}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb9}
+  ,
+  {0x0ebb, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ec8, 0x0ecd}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f71, 0x0f8b}
+  ,
+  {0x0f90, 0x0f97}
+  ,
+  {0x0f99, 0x0fbc}
+  ,
+  {0x0fbe, 0x0fcc}
+  ,
+  {0x0fce, 0x0fd4}
+  ,
+  {0x1000, 0x1099}
+  ,
+  {0x109e, 0x10c5}
+  ,
+  {0x10d0, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x135f, 0x137c}
+  ,
+  {0x1380, 0x1399}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x1676}
+  ,
+  {0x1681, 0x169c}
+  ,
+  {0x16a0, 0x16f0}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1714}
+  ,
+  {0x1720, 0x1736}
+  ,
+  {0x1740, 0x1753}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1772, 0x1773}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17b6, 0x17dd}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x17f0, 0x17f9}
+  ,
+  {0x1800, 0x180d}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1920, 0x192b}
+  ,
+  {0x1930, 0x193b}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x1944, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19b0, 0x19c9}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x19de, 0x1a1b}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b00, 0x1b4b}
+  ,
+  {0x1b50, 0x1b7c}
+  ,
+  {0x1b80, 0x1baa}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c37}
+  ,
+  {0x1c3b, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7f}
+  ,
+  {0x1d00, 0x1de6}
+  ,
+  {0x1dfe, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fdd, 0x1fef}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffe}
+  ,
+  {0x2010, 0x2027}
+  ,
+  {0x2030, 0x205e}
+  ,
+  {0x2070, 0x2071}
+  ,
+  {0x2074, 0x208e}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x20d0, 0x20f0}
+  ,
+  {0x2100, 0x214f}
+  ,
+  {0x2153, 0x2188}
+  ,
+  {0x2190, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x2460, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2cea}
+  ,
+  {0x2cf9, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2de0, 0x2e30}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3001, 0x303f}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x3099, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x3190, 0x31b7}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x31f0, 0x321e}
+  ,
+  {0x3220, 0x3243}
+  ,
+  {0x3250, 0x32fe}
+  ,
+  {0x3300, 0x4db5}
+  ,
+  {0x4dc0, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa500, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa673}
+  ,
+  {0xa67c, 0xa697}
+  ,
+  {0xa700, 0xa78c}
+  ,
+  {0xa7fb, 0xa82b}
+  ,
+  {0xa840, 0xa877}
+  ,
+  {0xa880, 0xa8c4}
+  ,
+  {0xa8ce, 0xa8d9}
+  ,
+  {0xa900, 0xa953}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa00, 0xaa36}
+  ,
+  {0xaa40, 0xaa4d}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3f}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfd}
+  ,
+  {0xfe00, 0xfe19}
+  ,
+  {0xfe20, 0xfe26}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe66}
+  ,
+  {0xfe68, 0xfe6b}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff01, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfffc, 0xfffd}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10100, 0x10102}
+  ,
+  {0x10107, 0x10133}
+  ,
+  {0x10137, 0x1018a}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fd}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10320, 0x10323}
+  ,
+  {0x10330, 0x1034a}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x1039f, 0x103c3}
+  ,
+  {0x103c8, 0x103d5}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10919}
+  ,
+  {0x1091f, 0x10939}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a00, 0x10a03}
+  ,
+  {0x10a05, 0x10a06}
+  ,
+  {0x10a0c, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x10a38, 0x10a3a}
+  ,
+  {0x10a3f, 0x10a47}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x12400, 0x12462}
+  ,
+  {0x12470, 0x12473}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d172}
+  ,
+  {0x1d17b, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d360, 0x1d371}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+  ,
+  {0xe0100, 0xe01ef}
+};
+
+scm_t_char_set cs_graphic = {
+  445,
+  cs_graphic_ranges
+};
+
+scm_t_char_range cs_whitespace_ranges[] = {
+  {0x0009, 0x000d}
+  ,
+  {0x0020, 0x0020}
+  ,
+  {0x00a0, 0x00a0}
+  ,
+  {0x1680, 0x1680}
+  ,
+  {0x180e, 0x180e}
+  ,
+  {0x2000, 0x200a}
+  ,
+  {0x2028, 0x2029}
+  ,
+  {0x202f, 0x202f}
+  ,
+  {0x205f, 0x205f}
+  ,
+  {0x3000, 0x3000}
+};
+
+scm_t_char_set cs_whitespace = {
+  10,
+  cs_whitespace_ranges
+};
+
+scm_t_char_range cs_printing_ranges[] = {
+  {0x0009, 0x000d}
+  ,
+  {0x0020, 0x007e}
+  ,
+  {0x00a0, 0x00ac}
+  ,
+  {0x00ae, 0x0377}
+  ,
+  {0x037a, 0x037e}
+  ,
+  {0x0384, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x055f}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x0591, 0x05c7}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f4}
+  ,
+  {0x0606, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x0621, 0x065e}
+  ,
+  {0x0660, 0x06dc}
+  ,
+  {0x06de, 0x070d}
+  ,
+  {0x0710, 0x074a}
+  ,
+  {0x074d, 0x07b1}
+  ,
+  {0x07c0, 0x07fa}
+  ,
+  {0x0901, 0x0939}
+  ,
+  {0x093c, 0x094d}
+  ,
+  {0x0950, 0x0954}
+  ,
+  {0x0958, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0981, 0x0983}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bc, 0x09c4}
+  ,
+  {0x09c7, 0x09c8}
+  ,
+  {0x09cb, 0x09ce}
+  ,
+  {0x09d7, 0x09d7}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e3}
+  ,
+  {0x09e6, 0x09fa}
+  ,
+  {0x0a01, 0x0a03}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a3c, 0x0a3c}
+  ,
+  {0x0a3e, 0x0a42}
+  ,
+  {0x0a47, 0x0a48}
+  ,
+  {0x0a4b, 0x0a4d}
+  ,
+  {0x0a51, 0x0a51}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a75}
+  ,
+  {0x0a81, 0x0a83}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abc, 0x0ac5}
+  ,
+  {0x0ac7, 0x0ac9}
+  ,
+  {0x0acb, 0x0acd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae3}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b01, 0x0b03}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3c, 0x0b44}
+  ,
+  {0x0b47, 0x0b48}
+  ,
+  {0x0b4b, 0x0b4d}
+  ,
+  {0x0b56, 0x0b57}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b63}
+  ,
+  {0x0b66, 0x0b71}
+  ,
+  {0x0b82, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bbe, 0x0bc2}
+  ,
+  {0x0bc6, 0x0bc8}
+  ,
+  {0x0bca, 0x0bcd}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0bd7, 0x0bd7}
+  ,
+  {0x0be6, 0x0bfa}
+  ,
+  {0x0c01, 0x0c03}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c44}
+  ,
+  {0x0c46, 0x0c48}
+  ,
+  {0x0c4a, 0x0c4d}
+  ,
+  {0x0c55, 0x0c56}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c63}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c78, 0x0c7f}
+  ,
+  {0x0c82, 0x0c83}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbc, 0x0cc4}
+  ,
+  {0x0cc6, 0x0cc8}
+  ,
+  {0x0cca, 0x0ccd}
+  ,
+  {0x0cd5, 0x0cd6}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce3}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d02, 0x0d03}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d44}
+  ,
+  {0x0d46, 0x0d48}
+  ,
+  {0x0d4a, 0x0d4d}
+  ,
+  {0x0d57, 0x0d57}
+  ,
+  {0x0d60, 0x0d63}
+  ,
+  {0x0d66, 0x0d75}
+  ,
+  {0x0d79, 0x0d7f}
+  ,
+  {0x0d82, 0x0d83}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0dca, 0x0dca}
+  ,
+  {0x0dcf, 0x0dd4}
+  ,
+  {0x0dd6, 0x0dd6}
+  ,
+  {0x0dd8, 0x0ddf}
+  ,
+  {0x0df2, 0x0df4}
+  ,
+  {0x0e01, 0x0e3a}
+  ,
+  {0x0e3f, 0x0e5b}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb9}
+  ,
+  {0x0ebb, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ec8, 0x0ecd}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f71, 0x0f8b}
+  ,
+  {0x0f90, 0x0f97}
+  ,
+  {0x0f99, 0x0fbc}
+  ,
+  {0x0fbe, 0x0fcc}
+  ,
+  {0x0fce, 0x0fd4}
+  ,
+  {0x1000, 0x1099}
+  ,
+  {0x109e, 0x10c5}
+  ,
+  {0x10d0, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x135f, 0x137c}
+  ,
+  {0x1380, 0x1399}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x1676}
+  ,
+  {0x1680, 0x169c}
+  ,
+  {0x16a0, 0x16f0}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1714}
+  ,
+  {0x1720, 0x1736}
+  ,
+  {0x1740, 0x1753}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1772, 0x1773}
+  ,
+  {0x1780, 0x17b3}
+  ,
+  {0x17b6, 0x17dd}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x17f0, 0x17f9}
+  ,
+  {0x1800, 0x180e}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1920, 0x192b}
+  ,
+  {0x1930, 0x193b}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x1944, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19b0, 0x19c9}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x19de, 0x1a1b}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b00, 0x1b4b}
+  ,
+  {0x1b50, 0x1b7c}
+  ,
+  {0x1b80, 0x1baa}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c37}
+  ,
+  {0x1c3b, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7f}
+  ,
+  {0x1d00, 0x1de6}
+  ,
+  {0x1dfe, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fdd, 0x1fef}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffe}
+  ,
+  {0x2000, 0x200a}
+  ,
+  {0x2010, 0x2029}
+  ,
+  {0x202f, 0x205f}
+  ,
+  {0x2070, 0x2071}
+  ,
+  {0x2074, 0x208e}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x20d0, 0x20f0}
+  ,
+  {0x2100, 0x214f}
+  ,
+  {0x2153, 0x2188}
+  ,
+  {0x2190, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x2460, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2cea}
+  ,
+  {0x2cf9, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2de0, 0x2e30}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3000, 0x303f}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x3099, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x3190, 0x31b7}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x31f0, 0x321e}
+  ,
+  {0x3220, 0x3243}
+  ,
+  {0x3250, 0x32fe}
+  ,
+  {0x3300, 0x4db5}
+  ,
+  {0x4dc0, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa500, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa673}
+  ,
+  {0xa67c, 0xa697}
+  ,
+  {0xa700, 0xa78c}
+  ,
+  {0xa7fb, 0xa82b}
+  ,
+  {0xa840, 0xa877}
+  ,
+  {0xa880, 0xa8c4}
+  ,
+  {0xa8ce, 0xa8d9}
+  ,
+  {0xa900, 0xa953}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa00, 0xaa36}
+  ,
+  {0xaa40, 0xaa4d}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xf900, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3f}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfd}
+  ,
+  {0xfe00, 0xfe19}
+  ,
+  {0xfe20, 0xfe26}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe66}
+  ,
+  {0xfe68, 0xfe6b}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xff01, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfffc, 0xfffd}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10100, 0x10102}
+  ,
+  {0x10107, 0x10133}
+  ,
+  {0x10137, 0x1018a}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fd}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10320, 0x10323}
+  ,
+  {0x10330, 0x1034a}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x1039f, 0x103c3}
+  ,
+  {0x103c8, 0x103d5}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10919}
+  ,
+  {0x1091f, 0x10939}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a00, 0x10a03}
+  ,
+  {0x10a05, 0x10a06}
+  ,
+  {0x10a0c, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x10a38, 0x10a3a}
+  ,
+  {0x10a3f, 0x10a47}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x12400, 0x12462}
+  ,
+  {0x12470, 0x12473}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d172}
+  ,
+  {0x1d17b, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d360, 0x1d371}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+  ,
+  {0xe0100, 0xe01ef}
+};
+
+scm_t_char_set cs_printing = {
+  447,
+  cs_printing_ranges
+};
+
+scm_t_char_range cs_iso_control_ranges[] = {
+  {0x0000, 0x001f}
+  ,
+  {0x007f, 0x009f}
+};
+
+scm_t_char_set cs_iso_control = {
+  2,
+  cs_iso_control_ranges
+};
+
+scm_t_char_range cs_punctuation_ranges[] = {
+  {0x0021, 0x0023}
+  ,
+  {0x0025, 0x002a}
+  ,
+  {0x002c, 0x002f}
+  ,
+  {0x003a, 0x003b}
+  ,
+  {0x003f, 0x0040}
+  ,
+  {0x005b, 0x005d}
+  ,
+  {0x005f, 0x005f}
+  ,
+  {0x007b, 0x007b}
+  ,
+  {0x007d, 0x007d}
+  ,
+  {0x00a1, 0x00a1}
+  ,
+  {0x00ab, 0x00ab}
+  ,
+  {0x00b7, 0x00b7}
+  ,
+  {0x00bb, 0x00bb}
+  ,
+  {0x00bf, 0x00bf}
+  ,
+  {0x037e, 0x037e}
+  ,
+  {0x0387, 0x0387}
+  ,
+  {0x055a, 0x055f}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x05be, 0x05be}
+  ,
+  {0x05c0, 0x05c0}
+  ,
+  {0x05c3, 0x05c3}
+  ,
+  {0x05c6, 0x05c6}
+  ,
+  {0x05f3, 0x05f4}
+  ,
+  {0x0609, 0x060a}
+  ,
+  {0x060c, 0x060d}
+  ,
+  {0x061b, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x066a, 0x066d}
+  ,
+  {0x06d4, 0x06d4}
+  ,
+  {0x0700, 0x070d}
+  ,
+  {0x07f7, 0x07f9}
+  ,
+  {0x0964, 0x0965}
+  ,
+  {0x0970, 0x0970}
+  ,
+  {0x0df4, 0x0df4}
+  ,
+  {0x0e4f, 0x0e4f}
+  ,
+  {0x0e5a, 0x0e5b}
+  ,
+  {0x0f04, 0x0f12}
+  ,
+  {0x0f3a, 0x0f3d}
+  ,
+  {0x0f85, 0x0f85}
+  ,
+  {0x0fd0, 0x0fd4}
+  ,
+  {0x104a, 0x104f}
+  ,
+  {0x10fb, 0x10fb}
+  ,
+  {0x1361, 0x1368}
+  ,
+  {0x166d, 0x166e}
+  ,
+  {0x169b, 0x169c}
+  ,
+  {0x16eb, 0x16ed}
+  ,
+  {0x1735, 0x1736}
+  ,
+  {0x17d4, 0x17d6}
+  ,
+  {0x17d8, 0x17da}
+  ,
+  {0x1800, 0x180a}
+  ,
+  {0x1944, 0x1945}
+  ,
+  {0x19de, 0x19df}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b5a, 0x1b60}
+  ,
+  {0x1c3b, 0x1c3f}
+  ,
+  {0x1c7e, 0x1c7f}
+  ,
+  {0x2010, 0x2027}
+  ,
+  {0x2030, 0x2043}
+  ,
+  {0x2045, 0x2051}
+  ,
+  {0x2053, 0x205e}
+  ,
+  {0x207d, 0x207e}
+  ,
+  {0x208d, 0x208e}
+  ,
+  {0x2329, 0x232a}
+  ,
+  {0x2768, 0x2775}
+  ,
+  {0x27c5, 0x27c6}
+  ,
+  {0x27e6, 0x27ef}
+  ,
+  {0x2983, 0x2998}
+  ,
+  {0x29d8, 0x29db}
+  ,
+  {0x29fc, 0x29fd}
+  ,
+  {0x2cf9, 0x2cfc}
+  ,
+  {0x2cfe, 0x2cff}
+  ,
+  {0x2e00, 0x2e2e}
+  ,
+  {0x2e30, 0x2e30}
+  ,
+  {0x3001, 0x3003}
+  ,
+  {0x3008, 0x3011}
+  ,
+  {0x3014, 0x301f}
+  ,
+  {0x3030, 0x3030}
+  ,
+  {0x303d, 0x303d}
+  ,
+  {0x30a0, 0x30a0}
+  ,
+  {0x30fb, 0x30fb}
+  ,
+  {0xa60d, 0xa60f}
+  ,
+  {0xa673, 0xa673}
+  ,
+  {0xa67e, 0xa67e}
+  ,
+  {0xa874, 0xa877}
+  ,
+  {0xa8ce, 0xa8cf}
+  ,
+  {0xa92e, 0xa92f}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xfd3e, 0xfd3f}
+  ,
+  {0xfe10, 0xfe19}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe61}
+  ,
+  {0xfe63, 0xfe63}
+  ,
+  {0xfe68, 0xfe68}
+  ,
+  {0xfe6a, 0xfe6b}
+  ,
+  {0xff01, 0xff03}
+  ,
+  {0xff05, 0xff0a}
+  ,
+  {0xff0c, 0xff0f}
+  ,
+  {0xff1a, 0xff1b}
+  ,
+  {0xff1f, 0xff20}
+  ,
+  {0xff3b, 0xff3d}
+  ,
+  {0xff3f, 0xff3f}
+  ,
+  {0xff5b, 0xff5b}
+  ,
+  {0xff5d, 0xff5d}
+  ,
+  {0xff5f, 0xff65}
+  ,
+  {0x10100, 0x10101}
+  ,
+  {0x1039f, 0x1039f}
+  ,
+  {0x103d0, 0x103d0}
+  ,
+  {0x1091f, 0x1091f}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12470, 0x12473}
+};
+
+scm_t_char_set cs_punctuation = {
+  112,
+  cs_punctuation_ranges
+};
+
+scm_t_char_range cs_symbol_ranges[] = {
+  {0x0024, 0x0024}
+  ,
+  {0x002b, 0x002b}
+  ,
+  {0x003c, 0x003e}
+  ,
+  {0x005e, 0x005e}
+  ,
+  {0x0060, 0x0060}
+  ,
+  {0x007c, 0x007c}
+  ,
+  {0x007e, 0x007e}
+  ,
+  {0x00a2, 0x00a9}
+  ,
+  {0x00ac, 0x00ac}
+  ,
+  {0x00ae, 0x00b1}
+  ,
+  {0x00b4, 0x00b4}
+  ,
+  {0x00b6, 0x00b6}
+  ,
+  {0x00b8, 0x00b8}
+  ,
+  {0x00d7, 0x00d7}
+  ,
+  {0x00f7, 0x00f7}
+  ,
+  {0x02c2, 0x02c5}
+  ,
+  {0x02d2, 0x02df}
+  ,
+  {0x02e5, 0x02eb}
+  ,
+  {0x02ed, 0x02ed}
+  ,
+  {0x02ef, 0x02ff}
+  ,
+  {0x0375, 0x0375}
+  ,
+  {0x0384, 0x0385}
+  ,
+  {0x03f6, 0x03f6}
+  ,
+  {0x0482, 0x0482}
+  ,
+  {0x0606, 0x0608}
+  ,
+  {0x060b, 0x060b}
+  ,
+  {0x060e, 0x060f}
+  ,
+  {0x06e9, 0x06e9}
+  ,
+  {0x06fd, 0x06fe}
+  ,
+  {0x07f6, 0x07f6}
+  ,
+  {0x09f2, 0x09f3}
+  ,
+  {0x09fa, 0x09fa}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b70, 0x0b70}
+  ,
+  {0x0bf3, 0x0bfa}
+  ,
+  {0x0c7f, 0x0c7f}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d79, 0x0d79}
+  ,
+  {0x0e3f, 0x0e3f}
+  ,
+  {0x0f01, 0x0f03}
+  ,
+  {0x0f13, 0x0f17}
+  ,
+  {0x0f1a, 0x0f1f}
+  ,
+  {0x0f34, 0x0f34}
+  ,
+  {0x0f36, 0x0f36}
+  ,
+  {0x0f38, 0x0f38}
+  ,
+  {0x0fbe, 0x0fc5}
+  ,
+  {0x0fc7, 0x0fcc}
+  ,
+  {0x0fce, 0x0fcf}
+  ,
+  {0x109e, 0x109f}
+  ,
+  {0x1360, 0x1360}
+  ,
+  {0x1390, 0x1399}
+  ,
+  {0x17db, 0x17db}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x19e0, 0x19ff}
+  ,
+  {0x1b61, 0x1b6a}
+  ,
+  {0x1b74, 0x1b7c}
+  ,
+  {0x1fbd, 0x1fbd}
+  ,
+  {0x1fbf, 0x1fc1}
+  ,
+  {0x1fcd, 0x1fcf}
+  ,
+  {0x1fdd, 0x1fdf}
+  ,
+  {0x1fed, 0x1fef}
+  ,
+  {0x1ffd, 0x1ffe}
+  ,
+  {0x2044, 0x2044}
+  ,
+  {0x2052, 0x2052}
+  ,
+  {0x207a, 0x207c}
+  ,
+  {0x208a, 0x208c}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x2100, 0x2101}
+  ,
+  {0x2103, 0x2106}
+  ,
+  {0x2108, 0x2109}
+  ,
+  {0x2114, 0x2114}
+  ,
+  {0x2116, 0x2118}
+  ,
+  {0x211e, 0x2123}
+  ,
+  {0x2125, 0x2125}
+  ,
+  {0x2127, 0x2127}
+  ,
+  {0x2129, 0x2129}
+  ,
+  {0x212e, 0x212e}
+  ,
+  {0x213a, 0x213b}
+  ,
+  {0x2140, 0x2144}
+  ,
+  {0x214a, 0x214d}
+  ,
+  {0x214f, 0x214f}
+  ,
+  {0x2190, 0x2328}
+  ,
+  {0x232b, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x249c, 0x24e9}
+  ,
+  {0x2500, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2767}
+  ,
+  {0x2794, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27c4}
+  ,
+  {0x27c7, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x27e5}
+  ,
+  {0x27f0, 0x2982}
+  ,
+  {0x2999, 0x29d7}
+  ,
+  {0x29dc, 0x29fb}
+  ,
+  {0x29fe, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2ce5, 0x2cea}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3004, 0x3004}
+  ,
+  {0x3012, 0x3013}
+  ,
+  {0x3020, 0x3020}
+  ,
+  {0x3036, 0x3037}
+  ,
+  {0x303e, 0x303f}
+  ,
+  {0x309b, 0x309c}
+  ,
+  {0x3190, 0x3191}
+  ,
+  {0x3196, 0x319f}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x3200, 0x321e}
+  ,
+  {0x322a, 0x3243}
+  ,
+  {0x3250, 0x3250}
+  ,
+  {0x3260, 0x327f}
+  ,
+  {0x328a, 0x32b0}
+  ,
+  {0x32c0, 0x32fe}
+  ,
+  {0x3300, 0x33ff}
+  ,
+  {0x4dc0, 0x4dff}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa700, 0xa716}
+  ,
+  {0xa720, 0xa721}
+  ,
+  {0xa789, 0xa78a}
+  ,
+  {0xa828, 0xa82b}
+  ,
+  {0xfb29, 0xfb29}
+  ,
+  {0xfdfc, 0xfdfd}
+  ,
+  {0xfe62, 0xfe62}
+  ,
+  {0xfe64, 0xfe66}
+  ,
+  {0xfe69, 0xfe69}
+  ,
+  {0xff04, 0xff04}
+  ,
+  {0xff0b, 0xff0b}
+  ,
+  {0xff1c, 0xff1e}
+  ,
+  {0xff3e, 0xff3e}
+  ,
+  {0xff40, 0xff40}
+  ,
+  {0xff5c, 0xff5c}
+  ,
+  {0xff5e, 0xff5e}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfffc, 0xfffd}
+  ,
+  {0x10102, 0x10102}
+  ,
+  {0x10137, 0x1013f}
+  ,
+  {0x10179, 0x10189}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fc}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d164}
+  ,
+  {0x1d16a, 0x1d16c}
+  ,
+  {0x1d183, 0x1d184}
+  ,
+  {0x1d18c, 0x1d1a9}
+  ,
+  {0x1d1ae, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d241}
+  ,
+  {0x1d245, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d6c1, 0x1d6c1}
+  ,
+  {0x1d6db, 0x1d6db}
+  ,
+  {0x1d6fb, 0x1d6fb}
+  ,
+  {0x1d715, 0x1d715}
+  ,
+  {0x1d735, 0x1d735}
+  ,
+  {0x1d74f, 0x1d74f}
+  ,
+  {0x1d76f, 0x1d76f}
+  ,
+  {0x1d789, 0x1d789}
+  ,
+  {0x1d7a9, 0x1d7a9}
+  ,
+  {0x1d7c3, 0x1d7c3}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+};
+
+scm_t_char_set cs_symbol = {
+  179,
+  cs_symbol_ranges
+};
+
+scm_t_char_range cs_blank_ranges[] = {
+  {0x0009, 0x0009}
+  ,
+  {0x0020, 0x0020}
+  ,
+  {0x00a0, 0x00a0}
+  ,
+  {0x1680, 0x1680}
+  ,
+  {0x180e, 0x180e}
+  ,
+  {0x2000, 0x200a}
+  ,
+  {0x202f, 0x202f}
+  ,
+  {0x205f, 0x205f}
+  ,
+  {0x3000, 0x3000}
+};
+
+scm_t_char_set cs_blank = {
+  9,
+  cs_blank_ranges
+};
+
+scm_t_char_range cs_ascii_ranges[] = {
+  {0x0000, 0x007f}
+};
+
+scm_t_char_set cs_ascii = {
+  0,
+  cs_ascii_ranges
+};
+
+scm_t_char_range cs_empty_ranges[] = {
+};
+
+scm_t_char_set cs_empty = {
+  0,
+  cs_empty_ranges
+};
+
+scm_t_char_range cs_full_ranges[] = {
+  {0x0000, 0x0377}
+  ,
+  {0x037a, 0x037e}
+  ,
+  {0x0384, 0x038a}
+  ,
+  {0x038c, 0x038c}
+  ,
+  {0x038e, 0x03a1}
+  ,
+  {0x03a3, 0x0523}
+  ,
+  {0x0531, 0x0556}
+  ,
+  {0x0559, 0x055f}
+  ,
+  {0x0561, 0x0587}
+  ,
+  {0x0589, 0x058a}
+  ,
+  {0x0591, 0x05c7}
+  ,
+  {0x05d0, 0x05ea}
+  ,
+  {0x05f0, 0x05f4}
+  ,
+  {0x0600, 0x0603}
+  ,
+  {0x0606, 0x061b}
+  ,
+  {0x061e, 0x061f}
+  ,
+  {0x0621, 0x065e}
+  ,
+  {0x0660, 0x070d}
+  ,
+  {0x070f, 0x074a}
+  ,
+  {0x074d, 0x07b1}
+  ,
+  {0x07c0, 0x07fa}
+  ,
+  {0x0901, 0x0939}
+  ,
+  {0x093c, 0x094d}
+  ,
+  {0x0950, 0x0954}
+  ,
+  {0x0958, 0x0972}
+  ,
+  {0x097b, 0x097f}
+  ,
+  {0x0981, 0x0983}
+  ,
+  {0x0985, 0x098c}
+  ,
+  {0x098f, 0x0990}
+  ,
+  {0x0993, 0x09a8}
+  ,
+  {0x09aa, 0x09b0}
+  ,
+  {0x09b2, 0x09b2}
+  ,
+  {0x09b6, 0x09b9}
+  ,
+  {0x09bc, 0x09c4}
+  ,
+  {0x09c7, 0x09c8}
+  ,
+  {0x09cb, 0x09ce}
+  ,
+  {0x09d7, 0x09d7}
+  ,
+  {0x09dc, 0x09dd}
+  ,
+  {0x09df, 0x09e3}
+  ,
+  {0x09e6, 0x09fa}
+  ,
+  {0x0a01, 0x0a03}
+  ,
+  {0x0a05, 0x0a0a}
+  ,
+  {0x0a0f, 0x0a10}
+  ,
+  {0x0a13, 0x0a28}
+  ,
+  {0x0a2a, 0x0a30}
+  ,
+  {0x0a32, 0x0a33}
+  ,
+  {0x0a35, 0x0a36}
+  ,
+  {0x0a38, 0x0a39}
+  ,
+  {0x0a3c, 0x0a3c}
+  ,
+  {0x0a3e, 0x0a42}
+  ,
+  {0x0a47, 0x0a48}
+  ,
+  {0x0a4b, 0x0a4d}
+  ,
+  {0x0a51, 0x0a51}
+  ,
+  {0x0a59, 0x0a5c}
+  ,
+  {0x0a5e, 0x0a5e}
+  ,
+  {0x0a66, 0x0a75}
+  ,
+  {0x0a81, 0x0a83}
+  ,
+  {0x0a85, 0x0a8d}
+  ,
+  {0x0a8f, 0x0a91}
+  ,
+  {0x0a93, 0x0aa8}
+  ,
+  {0x0aaa, 0x0ab0}
+  ,
+  {0x0ab2, 0x0ab3}
+  ,
+  {0x0ab5, 0x0ab9}
+  ,
+  {0x0abc, 0x0ac5}
+  ,
+  {0x0ac7, 0x0ac9}
+  ,
+  {0x0acb, 0x0acd}
+  ,
+  {0x0ad0, 0x0ad0}
+  ,
+  {0x0ae0, 0x0ae3}
+  ,
+  {0x0ae6, 0x0aef}
+  ,
+  {0x0af1, 0x0af1}
+  ,
+  {0x0b01, 0x0b03}
+  ,
+  {0x0b05, 0x0b0c}
+  ,
+  {0x0b0f, 0x0b10}
+  ,
+  {0x0b13, 0x0b28}
+  ,
+  {0x0b2a, 0x0b30}
+  ,
+  {0x0b32, 0x0b33}
+  ,
+  {0x0b35, 0x0b39}
+  ,
+  {0x0b3c, 0x0b44}
+  ,
+  {0x0b47, 0x0b48}
+  ,
+  {0x0b4b, 0x0b4d}
+  ,
+  {0x0b56, 0x0b57}
+  ,
+  {0x0b5c, 0x0b5d}
+  ,
+  {0x0b5f, 0x0b63}
+  ,
+  {0x0b66, 0x0b71}
+  ,
+  {0x0b82, 0x0b83}
+  ,
+  {0x0b85, 0x0b8a}
+  ,
+  {0x0b8e, 0x0b90}
+  ,
+  {0x0b92, 0x0b95}
+  ,
+  {0x0b99, 0x0b9a}
+  ,
+  {0x0b9c, 0x0b9c}
+  ,
+  {0x0b9e, 0x0b9f}
+  ,
+  {0x0ba3, 0x0ba4}
+  ,
+  {0x0ba8, 0x0baa}
+  ,
+  {0x0bae, 0x0bb9}
+  ,
+  {0x0bbe, 0x0bc2}
+  ,
+  {0x0bc6, 0x0bc8}
+  ,
+  {0x0bca, 0x0bcd}
+  ,
+  {0x0bd0, 0x0bd0}
+  ,
+  {0x0bd7, 0x0bd7}
+  ,
+  {0x0be6, 0x0bfa}
+  ,
+  {0x0c01, 0x0c03}
+  ,
+  {0x0c05, 0x0c0c}
+  ,
+  {0x0c0e, 0x0c10}
+  ,
+  {0x0c12, 0x0c28}
+  ,
+  {0x0c2a, 0x0c33}
+  ,
+  {0x0c35, 0x0c39}
+  ,
+  {0x0c3d, 0x0c44}
+  ,
+  {0x0c46, 0x0c48}
+  ,
+  {0x0c4a, 0x0c4d}
+  ,
+  {0x0c55, 0x0c56}
+  ,
+  {0x0c58, 0x0c59}
+  ,
+  {0x0c60, 0x0c63}
+  ,
+  {0x0c66, 0x0c6f}
+  ,
+  {0x0c78, 0x0c7f}
+  ,
+  {0x0c82, 0x0c83}
+  ,
+  {0x0c85, 0x0c8c}
+  ,
+  {0x0c8e, 0x0c90}
+  ,
+  {0x0c92, 0x0ca8}
+  ,
+  {0x0caa, 0x0cb3}
+  ,
+  {0x0cb5, 0x0cb9}
+  ,
+  {0x0cbc, 0x0cc4}
+  ,
+  {0x0cc6, 0x0cc8}
+  ,
+  {0x0cca, 0x0ccd}
+  ,
+  {0x0cd5, 0x0cd6}
+  ,
+  {0x0cde, 0x0cde}
+  ,
+  {0x0ce0, 0x0ce3}
+  ,
+  {0x0ce6, 0x0cef}
+  ,
+  {0x0cf1, 0x0cf2}
+  ,
+  {0x0d02, 0x0d03}
+  ,
+  {0x0d05, 0x0d0c}
+  ,
+  {0x0d0e, 0x0d10}
+  ,
+  {0x0d12, 0x0d28}
+  ,
+  {0x0d2a, 0x0d39}
+  ,
+  {0x0d3d, 0x0d44}
+  ,
+  {0x0d46, 0x0d48}
+  ,
+  {0x0d4a, 0x0d4d}
+  ,
+  {0x0d57, 0x0d57}
+  ,
+  {0x0d60, 0x0d63}
+  ,
+  {0x0d66, 0x0d75}
+  ,
+  {0x0d79, 0x0d7f}
+  ,
+  {0x0d82, 0x0d83}
+  ,
+  {0x0d85, 0x0d96}
+  ,
+  {0x0d9a, 0x0db1}
+  ,
+  {0x0db3, 0x0dbb}
+  ,
+  {0x0dbd, 0x0dbd}
+  ,
+  {0x0dc0, 0x0dc6}
+  ,
+  {0x0dca, 0x0dca}
+  ,
+  {0x0dcf, 0x0dd4}
+  ,
+  {0x0dd6, 0x0dd6}
+  ,
+  {0x0dd8, 0x0ddf}
+  ,
+  {0x0df2, 0x0df4}
+  ,
+  {0x0e01, 0x0e3a}
+  ,
+  {0x0e3f, 0x0e5b}
+  ,
+  {0x0e81, 0x0e82}
+  ,
+  {0x0e84, 0x0e84}
+  ,
+  {0x0e87, 0x0e88}
+  ,
+  {0x0e8a, 0x0e8a}
+  ,
+  {0x0e8d, 0x0e8d}
+  ,
+  {0x0e94, 0x0e97}
+  ,
+  {0x0e99, 0x0e9f}
+  ,
+  {0x0ea1, 0x0ea3}
+  ,
+  {0x0ea5, 0x0ea5}
+  ,
+  {0x0ea7, 0x0ea7}
+  ,
+  {0x0eaa, 0x0eab}
+  ,
+  {0x0ead, 0x0eb9}
+  ,
+  {0x0ebb, 0x0ebd}
+  ,
+  {0x0ec0, 0x0ec4}
+  ,
+  {0x0ec6, 0x0ec6}
+  ,
+  {0x0ec8, 0x0ecd}
+  ,
+  {0x0ed0, 0x0ed9}
+  ,
+  {0x0edc, 0x0edd}
+  ,
+  {0x0f00, 0x0f47}
+  ,
+  {0x0f49, 0x0f6c}
+  ,
+  {0x0f71, 0x0f8b}
+  ,
+  {0x0f90, 0x0f97}
+  ,
+  {0x0f99, 0x0fbc}
+  ,
+  {0x0fbe, 0x0fcc}
+  ,
+  {0x0fce, 0x0fd4}
+  ,
+  {0x1000, 0x1099}
+  ,
+  {0x109e, 0x10c5}
+  ,
+  {0x10d0, 0x10fc}
+  ,
+  {0x1100, 0x1159}
+  ,
+  {0x115f, 0x11a2}
+  ,
+  {0x11a8, 0x11f9}
+  ,
+  {0x1200, 0x1248}
+  ,
+  {0x124a, 0x124d}
+  ,
+  {0x1250, 0x1256}
+  ,
+  {0x1258, 0x1258}
+  ,
+  {0x125a, 0x125d}
+  ,
+  {0x1260, 0x1288}
+  ,
+  {0x128a, 0x128d}
+  ,
+  {0x1290, 0x12b0}
+  ,
+  {0x12b2, 0x12b5}
+  ,
+  {0x12b8, 0x12be}
+  ,
+  {0x12c0, 0x12c0}
+  ,
+  {0x12c2, 0x12c5}
+  ,
+  {0x12c8, 0x12d6}
+  ,
+  {0x12d8, 0x1310}
+  ,
+  {0x1312, 0x1315}
+  ,
+  {0x1318, 0x135a}
+  ,
+  {0x135f, 0x137c}
+  ,
+  {0x1380, 0x1399}
+  ,
+  {0x13a0, 0x13f4}
+  ,
+  {0x1401, 0x1676}
+  ,
+  {0x1680, 0x169c}
+  ,
+  {0x16a0, 0x16f0}
+  ,
+  {0x1700, 0x170c}
+  ,
+  {0x170e, 0x1714}
+  ,
+  {0x1720, 0x1736}
+  ,
+  {0x1740, 0x1753}
+  ,
+  {0x1760, 0x176c}
+  ,
+  {0x176e, 0x1770}
+  ,
+  {0x1772, 0x1773}
+  ,
+  {0x1780, 0x17dd}
+  ,
+  {0x17e0, 0x17e9}
+  ,
+  {0x17f0, 0x17f9}
+  ,
+  {0x1800, 0x180e}
+  ,
+  {0x1810, 0x1819}
+  ,
+  {0x1820, 0x1877}
+  ,
+  {0x1880, 0x18aa}
+  ,
+  {0x1900, 0x191c}
+  ,
+  {0x1920, 0x192b}
+  ,
+  {0x1930, 0x193b}
+  ,
+  {0x1940, 0x1940}
+  ,
+  {0x1944, 0x196d}
+  ,
+  {0x1970, 0x1974}
+  ,
+  {0x1980, 0x19a9}
+  ,
+  {0x19b0, 0x19c9}
+  ,
+  {0x19d0, 0x19d9}
+  ,
+  {0x19de, 0x1a1b}
+  ,
+  {0x1a1e, 0x1a1f}
+  ,
+  {0x1b00, 0x1b4b}
+  ,
+  {0x1b50, 0x1b7c}
+  ,
+  {0x1b80, 0x1baa}
+  ,
+  {0x1bae, 0x1bb9}
+  ,
+  {0x1c00, 0x1c37}
+  ,
+  {0x1c3b, 0x1c49}
+  ,
+  {0x1c4d, 0x1c7f}
+  ,
+  {0x1d00, 0x1de6}
+  ,
+  {0x1dfe, 0x1f15}
+  ,
+  {0x1f18, 0x1f1d}
+  ,
+  {0x1f20, 0x1f45}
+  ,
+  {0x1f48, 0x1f4d}
+  ,
+  {0x1f50, 0x1f57}
+  ,
+  {0x1f59, 0x1f59}
+  ,
+  {0x1f5b, 0x1f5b}
+  ,
+  {0x1f5d, 0x1f5d}
+  ,
+  {0x1f5f, 0x1f7d}
+  ,
+  {0x1f80, 0x1fb4}
+  ,
+  {0x1fb6, 0x1fc4}
+  ,
+  {0x1fc6, 0x1fd3}
+  ,
+  {0x1fd6, 0x1fdb}
+  ,
+  {0x1fdd, 0x1fef}
+  ,
+  {0x1ff2, 0x1ff4}
+  ,
+  {0x1ff6, 0x1ffe}
+  ,
+  {0x2000, 0x2064}
+  ,
+  {0x206a, 0x2071}
+  ,
+  {0x2074, 0x208e}
+  ,
+  {0x2090, 0x2094}
+  ,
+  {0x20a0, 0x20b5}
+  ,
+  {0x20d0, 0x20f0}
+  ,
+  {0x2100, 0x214f}
+  ,
+  {0x2153, 0x2188}
+  ,
+  {0x2190, 0x23e7}
+  ,
+  {0x2400, 0x2426}
+  ,
+  {0x2440, 0x244a}
+  ,
+  {0x2460, 0x269d}
+  ,
+  {0x26a0, 0x26bc}
+  ,
+  {0x26c0, 0x26c3}
+  ,
+  {0x2701, 0x2704}
+  ,
+  {0x2706, 0x2709}
+  ,
+  {0x270c, 0x2727}
+  ,
+  {0x2729, 0x274b}
+  ,
+  {0x274d, 0x274d}
+  ,
+  {0x274f, 0x2752}
+  ,
+  {0x2756, 0x2756}
+  ,
+  {0x2758, 0x275e}
+  ,
+  {0x2761, 0x2794}
+  ,
+  {0x2798, 0x27af}
+  ,
+  {0x27b1, 0x27be}
+  ,
+  {0x27c0, 0x27ca}
+  ,
+  {0x27cc, 0x27cc}
+  ,
+  {0x27d0, 0x2b4c}
+  ,
+  {0x2b50, 0x2b54}
+  ,
+  {0x2c00, 0x2c2e}
+  ,
+  {0x2c30, 0x2c5e}
+  ,
+  {0x2c60, 0x2c6f}
+  ,
+  {0x2c71, 0x2c7d}
+  ,
+  {0x2c80, 0x2cea}
+  ,
+  {0x2cf9, 0x2d25}
+  ,
+  {0x2d30, 0x2d65}
+  ,
+  {0x2d6f, 0x2d6f}
+  ,
+  {0x2d80, 0x2d96}
+  ,
+  {0x2da0, 0x2da6}
+  ,
+  {0x2da8, 0x2dae}
+  ,
+  {0x2db0, 0x2db6}
+  ,
+  {0x2db8, 0x2dbe}
+  ,
+  {0x2dc0, 0x2dc6}
+  ,
+  {0x2dc8, 0x2dce}
+  ,
+  {0x2dd0, 0x2dd6}
+  ,
+  {0x2dd8, 0x2dde}
+  ,
+  {0x2de0, 0x2e30}
+  ,
+  {0x2e80, 0x2e99}
+  ,
+  {0x2e9b, 0x2ef3}
+  ,
+  {0x2f00, 0x2fd5}
+  ,
+  {0x2ff0, 0x2ffb}
+  ,
+  {0x3000, 0x303f}
+  ,
+  {0x3041, 0x3096}
+  ,
+  {0x3099, 0x30ff}
+  ,
+  {0x3105, 0x312d}
+  ,
+  {0x3131, 0x318e}
+  ,
+  {0x3190, 0x31b7}
+  ,
+  {0x31c0, 0x31e3}
+  ,
+  {0x31f0, 0x321e}
+  ,
+  {0x3220, 0x3243}
+  ,
+  {0x3250, 0x32fe}
+  ,
+  {0x3300, 0x4db5}
+  ,
+  {0x4dc0, 0x9fc3}
+  ,
+  {0xa000, 0xa48c}
+  ,
+  {0xa490, 0xa4c6}
+  ,
+  {0xa500, 0xa62b}
+  ,
+  {0xa640, 0xa65f}
+  ,
+  {0xa662, 0xa673}
+  ,
+  {0xa67c, 0xa697}
+  ,
+  {0xa700, 0xa78c}
+  ,
+  {0xa7fb, 0xa82b}
+  ,
+  {0xa840, 0xa877}
+  ,
+  {0xa880, 0xa8c4}
+  ,
+  {0xa8ce, 0xa8d9}
+  ,
+  {0xa900, 0xa953}
+  ,
+  {0xa95f, 0xa95f}
+  ,
+  {0xaa00, 0xaa36}
+  ,
+  {0xaa40, 0xaa4d}
+  ,
+  {0xaa50, 0xaa59}
+  ,
+  {0xaa5c, 0xaa5f}
+  ,
+  {0xac00, 0xd7a3}
+  ,
+  {0xd800, 0xfa2d}
+  ,
+  {0xfa30, 0xfa6a}
+  ,
+  {0xfa70, 0xfad9}
+  ,
+  {0xfb00, 0xfb06}
+  ,
+  {0xfb13, 0xfb17}
+  ,
+  {0xfb1d, 0xfb36}
+  ,
+  {0xfb38, 0xfb3c}
+  ,
+  {0xfb3e, 0xfb3e}
+  ,
+  {0xfb40, 0xfb41}
+  ,
+  {0xfb43, 0xfb44}
+  ,
+  {0xfb46, 0xfbb1}
+  ,
+  {0xfbd3, 0xfd3f}
+  ,
+  {0xfd50, 0xfd8f}
+  ,
+  {0xfd92, 0xfdc7}
+  ,
+  {0xfdf0, 0xfdfd}
+  ,
+  {0xfe00, 0xfe19}
+  ,
+  {0xfe20, 0xfe26}
+  ,
+  {0xfe30, 0xfe52}
+  ,
+  {0xfe54, 0xfe66}
+  ,
+  {0xfe68, 0xfe6b}
+  ,
+  {0xfe70, 0xfe74}
+  ,
+  {0xfe76, 0xfefc}
+  ,
+  {0xfeff, 0xfeff}
+  ,
+  {0xff01, 0xffbe}
+  ,
+  {0xffc2, 0xffc7}
+  ,
+  {0xffca, 0xffcf}
+  ,
+  {0xffd2, 0xffd7}
+  ,
+  {0xffda, 0xffdc}
+  ,
+  {0xffe0, 0xffe6}
+  ,
+  {0xffe8, 0xffee}
+  ,
+  {0xfff9, 0xfffd}
+  ,
+  {0x10000, 0x1000b}
+  ,
+  {0x1000d, 0x10026}
+  ,
+  {0x10028, 0x1003a}
+  ,
+  {0x1003c, 0x1003d}
+  ,
+  {0x1003f, 0x1004d}
+  ,
+  {0x10050, 0x1005d}
+  ,
+  {0x10080, 0x100fa}
+  ,
+  {0x10100, 0x10102}
+  ,
+  {0x10107, 0x10133}
+  ,
+  {0x10137, 0x1018a}
+  ,
+  {0x10190, 0x1019b}
+  ,
+  {0x101d0, 0x101fd}
+  ,
+  {0x10280, 0x1029c}
+  ,
+  {0x102a0, 0x102d0}
+  ,
+  {0x10300, 0x1031e}
+  ,
+  {0x10320, 0x10323}
+  ,
+  {0x10330, 0x1034a}
+  ,
+  {0x10380, 0x1039d}
+  ,
+  {0x1039f, 0x103c3}
+  ,
+  {0x103c8, 0x103d5}
+  ,
+  {0x10400, 0x1049d}
+  ,
+  {0x104a0, 0x104a9}
+  ,
+  {0x10800, 0x10805}
+  ,
+  {0x10808, 0x10808}
+  ,
+  {0x1080a, 0x10835}
+  ,
+  {0x10837, 0x10838}
+  ,
+  {0x1083c, 0x1083c}
+  ,
+  {0x1083f, 0x1083f}
+  ,
+  {0x10900, 0x10919}
+  ,
+  {0x1091f, 0x10939}
+  ,
+  {0x1093f, 0x1093f}
+  ,
+  {0x10a00, 0x10a03}
+  ,
+  {0x10a05, 0x10a06}
+  ,
+  {0x10a0c, 0x10a13}
+  ,
+  {0x10a15, 0x10a17}
+  ,
+  {0x10a19, 0x10a33}
+  ,
+  {0x10a38, 0x10a3a}
+  ,
+  {0x10a3f, 0x10a47}
+  ,
+  {0x10a50, 0x10a58}
+  ,
+  {0x12000, 0x1236e}
+  ,
+  {0x12400, 0x12462}
+  ,
+  {0x12470, 0x12473}
+  ,
+  {0x1d000, 0x1d0f5}
+  ,
+  {0x1d100, 0x1d126}
+  ,
+  {0x1d129, 0x1d1dd}
+  ,
+  {0x1d200, 0x1d245}
+  ,
+  {0x1d300, 0x1d356}
+  ,
+  {0x1d360, 0x1d371}
+  ,
+  {0x1d400, 0x1d454}
+  ,
+  {0x1d456, 0x1d49c}
+  ,
+  {0x1d49e, 0x1d49f}
+  ,
+  {0x1d4a2, 0x1d4a2}
+  ,
+  {0x1d4a5, 0x1d4a6}
+  ,
+  {0x1d4a9, 0x1d4ac}
+  ,
+  {0x1d4ae, 0x1d4b9}
+  ,
+  {0x1d4bb, 0x1d4bb}
+  ,
+  {0x1d4bd, 0x1d4c3}
+  ,
+  {0x1d4c5, 0x1d505}
+  ,
+  {0x1d507, 0x1d50a}
+  ,
+  {0x1d50d, 0x1d514}
+  ,
+  {0x1d516, 0x1d51c}
+  ,
+  {0x1d51e, 0x1d539}
+  ,
+  {0x1d53b, 0x1d53e}
+  ,
+  {0x1d540, 0x1d544}
+  ,
+  {0x1d546, 0x1d546}
+  ,
+  {0x1d54a, 0x1d550}
+  ,
+  {0x1d552, 0x1d6a5}
+  ,
+  {0x1d6a8, 0x1d7cb}
+  ,
+  {0x1d7ce, 0x1d7ff}
+  ,
+  {0x1f000, 0x1f02b}
+  ,
+  {0x1f030, 0x1f093}
+  ,
+  {0x20000, 0x2a6d6}
+  ,
+  {0x2f800, 0x2fa1d}
+  ,
+  {0xe0001, 0xe0001}
+  ,
+  {0xe0020, 0xe007f}
+  ,
+  {0xe0100, 0xe01ef}
+  ,
+  {0xf0000, 0xffffd}
+  ,
+  {0x100000, 0x10fffd}
+};
+
+scm_t_char_set cs_full = {
+  445,
+  cs_full_ranges
+};
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index b45d402..de1130f 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -29,13 +29,17 @@
 #include "libguile/_scm.h"
 #include "libguile/__scm.h"
 #include "libguile/srfi-4.h"
+#include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/uniform.h"
 #include "libguile/error.h"
+#include "libguile/eval.h"
 #include "libguile/read.h"
 #include "libguile/ports.h"
 #include "libguile/chars.h"
 #include "libguile/vectors.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/strings.h"
 #include "libguile/strports.h"
 #include "libguile/dynwind.h"
@@ -468,11 +472,8 @@ uvec_to_list (int type, SCM uvec)
   SCM res = SCM_EOL;
 
   elts = uvec_elements (type, uvec, &handle, &len, &inc);
-  for (i = len*inc; i > 0;)
-    {
-      i -= inc;
-      res = scm_cons (scm_array_handle_ref (&handle, i), res);
-    }
+  for (i = len - 1; i >= 0; i--)
+    res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
   scm_array_handle_release (&handle);
   return res;
 }
@@ -545,29 +546,6 @@ list_to_uvec (int type, SCM list)
   return uvec;
 }
 
-static SCM
-coerce_to_uvec (int type, SCM obj)
-{
-  if (is_uvec (type, obj))
-    return obj;
-  else if (scm_is_pair (obj))
-    return list_to_uvec (type, obj);
-  else if (scm_is_generalized_vector (obj))
-    {
-      scm_t_array_handle handle;
-      size_t len = scm_c_generalized_vector_length (obj), i;
-      SCM uvec = alloc_uvec (type, len);
-      scm_array_get_handle (uvec, &handle);
-      for (i = 0; i < len; i++)
-       scm_array_handle_set (&handle, i,
-                             scm_c_generalized_vector_ref (obj, i));
-      scm_array_handle_release (&handle);
-      return uvec;
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, obj, "list or generalized vector");
-}
-
 SCM_SYMBOL (scm_sym_a, "a");
 SCM_SYMBOL (scm_sym_b, "b");
 
@@ -588,222 +566,6 @@ scm_i_generalized_vector_type (SCM v)
     return SCM_BOOL_F;
 }
 
-int
-scm_is_uniform_vector (SCM obj)
-{
-  if (SCM_IS_UVEC (obj))
-    return 1;
-  if (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
-    {
-      SCM v = SCM_I_ARRAY_V (obj);
-      return SCM_IS_UVEC (v);
-    }
-  return 0;
-}
-
-size_t
-scm_c_uniform_vector_length (SCM uvec)
-{
-  /* scm_generalized_vector_get_handle will ultimately call us to get
-     the length of uniform vectors, so we can't use uvec_elements for
-     naked vectors.
-  */
-
-  if (SCM_IS_UVEC (uvec))
-    return SCM_UVEC_LENGTH (uvec);
-  else
-    {
-      scm_t_array_handle handle;
-      size_t len;
-      ssize_t inc;
-      uvec_elements (-1, uvec, &handle, &len, &inc);
-      scm_array_handle_release (&handle);
-      return len;
-    }
-}
-
-SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} if @var{obj} is a uniform vector.")
-#define FUNC_NAME s_scm_uniform_vector_p
-{
-  return scm_from_bool (scm_is_uniform_vector (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_uniform_vector_ref (SCM v, size_t idx)
-{
-  scm_t_array_handle handle;
-  size_t len;
-  ssize_t inc;
-  SCM res;
-
-  uvec_elements (-1, v, &handle, &len, &inc);
-  if (idx >= len)
-    scm_out_of_range (NULL, scm_from_size_t (idx));
-  res = scm_array_handle_ref (&handle, idx*inc);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
-           (SCM v, SCM idx),
-           "Return the element at index @var{idx} of the\n"
-           "homogenous numeric vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_ref
-{
-#if SCM_ENABLE_DEPRECATED
-  /* Support old argument convention.
-   */
-  if (scm_is_pair (idx))
-    {
-      scm_c_issue_deprecation_warning
-       ("Using a list as the index to uniform-vector-ref is deprecated.");
-      if (!scm_is_null (SCM_CDR (idx)))
-       scm_wrong_num_args (NULL);
-      idx = SCM_CAR (idx);
-    }
-#endif
-
-  return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
-{
-  scm_t_array_handle handle;
-  size_t len;
-  ssize_t inc;
-
-  uvec_writable_elements (-1, v, &handle, &len, &inc);
-  if (idx >= len)
-    scm_out_of_range (NULL, scm_from_size_t (idx));
-  scm_array_handle_set (&handle, idx*inc, val);
-  scm_array_handle_release (&handle);
-}
-
-SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
-           (SCM v, SCM idx, SCM val),
-           "Set the element at index @var{idx} of the\n"
-           "homogenous numeric vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_uniform_vector_set_x
-{
-#if SCM_ENABLE_DEPRECATED
-  /* Support old argument convention.
-   */
-  if (scm_is_pair (idx))
-    {
-      scm_c_issue_deprecation_warning
-       ("Using a list as the index to uniform-vector-set! is deprecated.");
-      if (!scm_is_null (SCM_CDR (idx)))
-       scm_wrong_num_args (NULL);
-      idx = SCM_CAR (idx);
-    }
-#endif
-
-  scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
-            (SCM uvec),
-           "Convert the uniform numeric vector @var{uvec} to a list.")
-#define FUNC_NAME s_scm_uniform_vector_to_list
-{
-  return uvec_to_list (-1, uvec);
-}
-#undef FUNC_NAME
-
-size_t
-scm_array_handle_uniform_element_size (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (scm_is_uniform_vector (vec))
-    return uvec_sizes[SCM_UVEC_TYPE(vec)];
-  if (scm_is_bytevector (vec))
-    return 1U;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
-}
-
-#if SCM_ENABLE_DEPRECATED
- 
-/* return the size of an element in a uniform array or 0 if type not
-   found.  */
-size_t
-scm_uniform_element_size (SCM obj)
-{
-  scm_c_issue_deprecation_warning 
-    ("scm_uniform_element_size is deprecated.  "
-     "Use scm_array_handle_uniform_element_size instead.");
-
-  if (SCM_IS_UVEC (obj))
-    return uvec_sizes[SCM_UVEC_TYPE(obj)];
-  else
-    return 0;
-}
-
-#endif
-
-const void *
-scm_array_handle_uniform_elements (scm_t_array_handle *h)
-{
-  return scm_array_handle_uniform_writable_elements (h);
-}
-
-void *
-scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_IS_UVEC (vec))
-    {
-      size_t size = uvec_sizes[SCM_UVEC_TYPE(vec)];
-      char *elts = SCM_UVEC_BASE (vec);
-      return (void *) (elts + size*h->base);
-    }
-  if (scm_is_bytevector (vec))
-    return SCM_BYTEVECTOR_CONTENTS (vec);
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
-}
-
-const void *
-scm_uniform_vector_elements (SCM uvec, 
-                            scm_t_array_handle *h,
-                            size_t *lenp, ssize_t *incp)
-{
-  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
-}
-
-void *
-scm_uniform_vector_writable_elements (SCM uvec, 
-                                     scm_t_array_handle *h,
-                                     size_t *lenp, ssize_t *incp)
-{
-  scm_generalized_vector_get_handle (uvec, h);
-  if (lenp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_uniform_writable_elements (h);
-}
-
-SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
-           (SCM v),
-           "Return the number of elements in the uniform vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_length
-{
-  return uvec_length (-1, v);
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0,
            (SCM uvec, SCM port_or_fd, SCM start, SCM end),
            "Fill the elements of @var{uvec} by reading\n"
@@ -1039,6 +801,36 @@ SCM_DEFINE (scm_uniform_vector_write, 
"uniform-vector-write", 1, 3, 0,
 #define CTYPE double
 #include "libguile/srfi-4.i.c"
 
+#define DEFINE_SCHEME_PROXY100(cname, modname, scmname)                 \
+  SCM cname (SCM arg1)                                                  \
+  {                                                                     \
+    static SCM var = SCM_BOOL_F;                                        \
+    if (scm_is_false (var))                                             \
+      var = scm_c_module_lookup (scm_c_resolve_module (modname), scmname); \
+    return scm_call_1 (SCM_VARIABLE_REF (var), arg1);                   \
+  }
+
+#define DEFPROXY100(cname, scmname)               \
+  DEFINE_SCHEME_PROXY100 (cname, MOD, scmname)
+
+#define DEFINE_SRFI_4_GNU_PROXIES(tag)                              \
+  DEFPROXY100 (scm_any_to_##tag##vector, "any->" #tag "vector")
+
+#define MOD "srfi srfi-4 gnu"
+DEFINE_SRFI_4_GNU_PROXIES (u8);
+DEFINE_SRFI_4_GNU_PROXIES (s8);
+DEFINE_SRFI_4_GNU_PROXIES (u16);
+DEFINE_SRFI_4_GNU_PROXIES (s16);
+DEFINE_SRFI_4_GNU_PROXIES (u32);
+DEFINE_SRFI_4_GNU_PROXIES (s32);
+DEFINE_SRFI_4_GNU_PROXIES (u64);
+DEFINE_SRFI_4_GNU_PROXIES (s64);
+DEFINE_SRFI_4_GNU_PROXIES (f32);
+DEFINE_SRFI_4_GNU_PROXIES (f64);
+DEFINE_SRFI_4_GNU_PROXIES (c32);
+DEFINE_SRFI_4_GNU_PROXIES (c64);
+
+
 static scm_i_t_array_ref uvec_reffers[12] = {
   u8ref, s8ref,
   u16ref, s16ref,
@@ -1057,18 +849,35 @@ static scm_i_t_array_set uvec_setters[12] = {
   c32set, c64set
 };
 
-scm_i_t_array_ref
-scm_i_uniform_vector_ref_proc (SCM uvec)
+static SCM
+uvec_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  return uvec_reffers [SCM_UVEC_TYPE(h->array)] (h, index);
+}
+
+static void
+uvec_handle_set (scm_t_array_handle *h, size_t index, SCM val)
 {
-  return uvec_reffers[SCM_UVEC_TYPE(uvec)];
+  uvec_setters [SCM_UVEC_TYPE(h->array)] (h, index, val);
 }
 
-scm_i_t_array_set
-scm_i_uniform_vector_set_proc (SCM uvec)
+static void
+uvec_get_handle (SCM v, scm_t_array_handle *h)
 {
-  return uvec_setters[SCM_UVEC_TYPE(uvec)];
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_UVEC_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_UVEC_TYPE (v) + SCM_ARRAY_ELEMENT_TYPE_U8;
+  h->elements = h->writable_elements = SCM_UVEC_BASE (v);
 }
 
+SCM_ARRAY_IMPLEMENTATION (scm_tc16_uvec, 0xffff,
+                          uvec_handle_ref, uvec_handle_set,
+                          uvec_get_handle);
+
 void
 scm_init_srfi_4 (void)
 {
@@ -1087,6 +896,24 @@ scm_init_srfi_4 (void)
     scm_permanent_object (scm_c_read_string ("9223372036854775807"));
 #endif
 
+#define REGISTER(tag, TAG)                                       \
+  scm_i_register_vector_constructor                              \
+    (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG],    \
+     scm_make_##tag##vector)
+
+  REGISTER (u8, U8); 
+  REGISTER (s8, S8); 
+  REGISTER (u16, U16);
+  REGISTER (s16, S16);
+  REGISTER (u32, U32);
+  REGISTER (s32, S32);
+  REGISTER (u64, U64);
+  REGISTER (s64, S64);
+  REGISTER (f32, F32);
+  REGISTER (f64, F64);
+  REGISTER (c32, C32);
+  REGISTER (c64, C64);
+
 #include "libguile/srfi-4.x"
 
 }
diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h
index a1a9baf..3a45fd9 100644
--- a/libguile/srfi-4.h
+++ b/libguile/srfi-4.h
@@ -2,7 +2,7 @@
 #define SCM_SRFI_4_H
 /* srfi-4.c --- Homogeneous numeric vector datatypes.
  *
- *     Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+ *     Copyright (C) 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
@@ -22,35 +22,6 @@
 
 
 #include "libguile/__scm.h"
-#include "libguile/unif.h"
-
-/* Generic procedures.
- */
-
-SCM_API SCM scm_uniform_vector_p (SCM v);
-SCM_API SCM scm_uniform_vector_length (SCM v);
-SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_uniform_vector_to_list (SCM v);
-SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
-                                      SCM start, SCM end);
-SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
-                                     SCM start, SCM end);
-
-SCM_API int scm_is_uniform_vector (SCM obj);
-SCM_API size_t scm_c_uniform_vector_length (SCM v);
-SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h);
-SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
-SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle 
*h);
-SCM_API const void *scm_uniform_vector_elements (SCM uvec, 
-                                                scm_t_array_handle *h,
-                                                size_t *lenp, ssize_t *incp);
-SCM_API void *scm_uniform_vector_writable_elements (SCM uvec, 
-                                                   scm_t_array_handle *h,
-                                                   size_t *lenp,
-                                                   ssize_t *incp);
 
 /* Specific procedures.
  */
diff --git a/libguile/srfi-4.i.c b/libguile/srfi-4.i.c
index 58a52c1..cecd6c6 100644
--- a/libguile/srfi-4.i.c
+++ b/libguile/srfi-4.i.c
@@ -121,17 +121,6 @@ SCM_DEFINE (F(scm_list_to_,TAG,vector), 
"list->"S(TAG)"vector", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (F(scm_any_to_,TAG,vector), "any->"S(TAG)"vector", 1, 0, 0,
-           (SCM obj),
-           "Convert @var{obj}, which can be a list, vector, or\n"
-           "uniform vector, to a numeric uniform vector of\n"
-           "type " S(TAG)".")
-#define FUNC_NAME s_F(scm_any_to_,TAG,vector)
-{
-  return coerce_to_uvec (TYPE, obj);
-}
-#undef FUNC_NAME
-
 #ifdef CTYPE
 
 SCM
@@ -187,13 +176,13 @@ F(scm_,TAG,vector_writable_elements) (SCM uvec,
 #endif
 
 static SCM
-F(,TAG,ref) (scm_t_array_handle *handle, ssize_t pos)
+F(,TAG,ref) (scm_t_array_handle *handle, size_t pos)
 {
   return uvec_fast_ref (TYPE, handle->elements, pos);
 }
 
 static void
-F(,TAG,set) (scm_t_array_handle *handle, ssize_t pos, SCM val)
+F(,TAG,set) (scm_t_array_handle *handle, size_t pos, SCM val)
 {
   uvec_fast_set_x (TYPE, handle->writable_elements, pos, val);
 }
diff --git a/libguile/stime.c b/libguile/stime.c
index a684337..54022c2 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -46,6 +46,7 @@
 #include <stdio.h>
 #include <errno.h>
 #include <strftime.h>
+#include <unistr.h>
 
 #include "libguile/_scm.h"
 #include "libguile/async.h"
@@ -53,6 +54,7 @@
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
 #include "libguile/dynwind.h"
+#include "libguile/strings.h"
 
 #include "libguile/validate.h"
 #include "libguile/stime.h"
@@ -624,18 +626,20 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 {
   struct tm t;
 
-  char *tbuf;
+  scm_t_uint8 *tbuf;
   int size = 50;
-  const char *fmt;
-  char *myfmt;
+  scm_t_uint8 *fmt;
+  scm_t_uint8 *myfmt;
   int len;
   SCM result;
 
   SCM_VALIDATE_STRING (1, format);
   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 
-  fmt = scm_i_string_chars (format);
-  len = scm_i_string_length (format);
+  /* Convert string to UTF-8 so that non-ASCII characters in the
+     format are passed through unchanged.  */
+  fmt = scm_i_to_utf8_string (format);
+  len = strlen ((const char *) fmt);
 
   /* Ugly hack: strftime can return 0 if its buffer is too small,
      but some valid time strings (e.g. "%p") can sometimes produce
@@ -643,9 +647,11 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
      character to the format string, so that valid returns are always
      nonzero. */
   myfmt = scm_malloc (len+2);
-  *myfmt = 'x';
-  strncpy(myfmt+1, fmt, len);
-  myfmt[len+1] = 0;
+  *myfmt = (scm_t_uint8) 'x';
+  strncpy ((char *) myfmt + 1, (const char *) fmt, len);
+  myfmt[len + 1] = 0;
+  scm_remember_upto_here_1 (format);
+  free (fmt);
 
   tbuf = scm_malloc (size);
   {
@@ -680,7 +686,8 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 
     /* Use `nstrftime ()' from Gnulib, which supports all GNU extensions
        supported by glibc.  */
-    while ((len = nstrftime (tbuf, size, myfmt, &t, 0, 0)) == 0)
+    while ((len = nstrftime ((char *) tbuf, size, 
+                            (const char *) myfmt, &t, 0, 0)) == 0)
       {
        free (tbuf);
        size *= 2;
@@ -696,7 +703,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 #endif
     }
 
-  result = scm_from_locale_stringn (tbuf + 1, len - 1);
+  result = scm_i_from_utf8_string ((const scm_t_uint8 *) tbuf + 1);
   free (tbuf);
   free (myfmt);
 #if HAVE_STRUCT_TM_TM_ZONE
@@ -722,14 +729,17 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 #define FUNC_NAME s_scm_strptime
 {
   struct tm t;
-  const char *fmt, *str, *rest;
+  scm_t_uint8 *fmt, *str, *rest;
+  size_t used_len;
   long zoff;
 
   SCM_VALIDATE_STRING (1, format);
   SCM_VALIDATE_STRING (2, string);
 
-  fmt = scm_i_string_chars (format);
-  str = scm_i_string_chars (string);
+  /* Convert strings to UTF-8 so that non-ASCII characters are passed
+     through unchanged.  */
+  fmt = scm_i_to_utf8_string (format);
+  str = scm_i_to_utf8_string (string);
 
   /* initialize the struct tm */
 #define tm_init(field) t.field = 0
@@ -751,7 +761,8 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
      fields, hence the use of SCM_CRITICAL_SECTION_START.  */
   t.tm_isdst = -1;
   SCM_CRITICAL_SECTION_START;
-  rest = strptime (str, fmt, &t);
+  rest = (scm_t_uint8 *) strptime ((const char *) str, 
+                                   (const char *) fmt, &t);
   SCM_CRITICAL_SECTION_END;
   if (rest == NULL)
     {
@@ -759,6 +770,9 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
          instance it doesn't.  Force a sensible value for our error
          message.  */
       errno = EINVAL;
+      scm_remember_upto_here_2 (format, string);
+      free (str);
+      free (fmt);
       SCM_SYSERROR;
     }
 
@@ -770,8 +784,14 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
   zoff = 0;
 #endif
 
+  /* Compute the number of UTF-8 characters.  */
+  used_len = u8_strnlen (str, rest-str);
+  scm_remember_upto_here_2 (format, string);
+  free (str);
+  free (fmt);
+
   return scm_cons (filltime (&t, zoff, NULL),
-                  scm_from_signed_integer (rest - str));
+                  scm_from_signed_integer (used_len));
 }
 #undef FUNC_NAME
 #endif /* HAVE_STRPTIME */
diff --git a/libguile/strings.c b/libguile/strings.c
index 8aa1e66..dfa0690 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -28,10 +28,13 @@
 #include <unistr.h>
 #include <uniconv.h>
 
+#include "striconveh.h"
+
 #include "libguile/_scm.h"
 #include "libguile/chars.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/deprecation.h"
 #include "libguile/validate.h"
 
@@ -86,16 +89,16 @@
 #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)   ((char *)SCM_CELL_WORD_1(buf))
+#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)    ((char *)SCM_CELL_OBJECT_LOC(buf,1))
+#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_WIDE_CHARS(buf) ((scm_t_wchar *)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))
@@ -190,7 +193,7 @@ widen_stringbuf (SCM buf)
       mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string");
       for (i = 0; i < len; i++)
         mem[i] =
-          (scm_t_wchar) (unsigned char) STRINGBUF_INLINE_CHARS (buf)[i];
+          (scm_t_wchar) STRINGBUF_INLINE_CHARS (buf)[i];
       mem[len] = 0;
 
       SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) ^ STRINGBUF_F_INLINE);
@@ -205,7 +208,7 @@ widen_stringbuf (SCM buf)
       mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string");
       for (i = 0; i < len; i++)
         mem[i] =
-          (scm_t_wchar) (unsigned char) STRINGBUF_OUTLINE_CHARS (buf)[i];
+          (scm_t_wchar) STRINGBUF_OUTLINE_CHARS (buf)[i];
       mem[len] = 0;
 
       scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf), len + 1, "string");
@@ -216,6 +219,36 @@ widen_stringbuf (SCM buf)
     }
 }
 
+/* Convert a stringbuf of 32-bit UCS-4-encoded characters to one
+   containing 8-bit Latin-1-encoded characters, if possible.  */
+static void
+narrow_stringbuf (SCM buf)
+{
+  size_t i, len;
+  scm_t_wchar *wmem;
+  char *mem;
+
+  if (!STRINGBUF_WIDE (buf))
+    return;
+
+  len = STRINGBUF_OUTLINE_LENGTH (buf);
+  i = 0;
+  wmem = STRINGBUF_WIDE_CHARS (buf);
+  while (i < len)
+    if (wmem[i++] > 0xFF)
+      return;
+
+  mem = scm_gc_malloc (sizeof (char) * (len + 1), "string");
+  for (i = 0; i < len; i++)
+    mem[i] = (unsigned char) wmem[i];
+
+  scm_gc_free (wmem, sizeof (scm_t_wchar) * (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);
+}
+
 scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 /* Copy-on-write strings.
@@ -257,7 +290,7 @@ scm_i_make_string (size_t len, char **charsp)
   SCM buf = make_stringbuf (len);
   SCM res;
   if (charsp)
-    *charsp = STRINGBUF_CHARS (buf);
+    *charsp = (char *) STRINGBUF_CHARS (buf);
   res = scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
                         (scm_t_bits)0, (scm_t_bits) len);
   return res;
@@ -423,6 +456,18 @@ scm_i_is_narrow_string (SCM str)
   return !STRINGBUF_WIDE (STRING_STRINGBUF (str));
 }
 
+/* Try to coerce a string to be narrow.  It if is narrow already, do
+   nothing.  If it is wide, shrink it to narrow if none of its
+   characters are above 0xFF.  Return true if the string is narrow or
+   was made to be narrow.  */
+int
+scm_i_try_narrow_string (SCM str)
+{
+  narrow_stringbuf (STRING_STRINGBUF (str));
+
+  return scm_i_is_narrow_string (str);
+}
+
 /* Returns a pointer to the 8-bit Latin-1 encoded character array of
    STR.  */
 const char *
@@ -432,7 +477,7 @@ scm_i_string_chars (SCM str)
   size_t start;
   get_str_buf_start (&str, &buf, &start);
   if (scm_i_is_narrow_string (str))
-    return STRINGBUF_CHARS (buf) + start;
+    return (const char *) STRINGBUF_CHARS (buf) + start;
   else
     scm_misc_error (NULL, "Invalid read access of chars of wide string: ~s",
                     scm_list_1 (str));
@@ -449,7 +494,7 @@ scm_i_string_wide_chars (SCM str)
 
   get_str_buf_start (&str, &buf, &start);
   if (!scm_i_is_narrow_string (str))
-    return STRINGBUF_WIDE_CHARS (buf) + start;
+    return (const scm_t_wchar *) STRINGBUF_WIDE_CHARS (buf) + start;
   else
     scm_misc_error (NULL, "Invalid read access of chars of narrow string: ~s",
                     scm_list_1 (str));
@@ -521,7 +566,7 @@ scm_i_string_writable_chars (SCM str)
 
   get_str_buf_start (&str, &buf, &start);
   if (scm_i_is_narrow_string (str))
-    return STRINGBUF_CHARS (buf) + start;
+    return (char *) STRINGBUF_CHARS (buf) + start;
   else
     scm_misc_error (NULL, "Invalid write access of chars of wide string: ~s",
                     scm_list_1 (str));
@@ -539,7 +584,7 @@ scm_i_string_writable_wide_chars (SCM str)
   if (!scm_i_is_narrow_string (str))
     return STRINGBUF_WIDE_CHARS (buf) + start;
   else
-    scm_misc_error (NULL, "Invalid read access of chars of narrow string: ~s",
+    scm_misc_error (NULL, "Invalid write access of chars of narrow string: ~s",
                     scm_list_1 (str));
 }
 
@@ -561,6 +606,60 @@ scm_i_string_ref (SCM str, size_t x)
     return scm_i_string_wide_chars (str)[x];
 }
 
+/* Returns index+1 of the first char in STR that matches C, or
+   0 if the char is not found.  */
+int
+scm_i_string_contains_char (SCM str, char ch)
+{
+  size_t i;
+  size_t len = scm_i_string_length (str);
+
+  i = 0;
+  if (scm_i_is_narrow_string (str))
+    {
+      while (i < len)
+        {
+          if (scm_i_string_chars (str)[i] == ch)
+            return i+1;
+          i++;
+        }
+    }
+  else
+    {
+      while (i < len)
+        {
+          if (scm_i_string_wide_chars (str)[i] 
+              == (unsigned char) ch)
+            return i+1;
+          i++;
+        }
+    }
+  return 0;
+}
+
+int 
+scm_i_string_strcmp (SCM sstr, size_t start_x, const char *cstr)
+{
+  if (scm_i_is_narrow_string (sstr))
+    {
+      const char *a = scm_i_string_chars (sstr) + start_x;
+      const char *b = cstr;
+      return strncmp (a, b, strlen(b));
+    }
+  else
+    {
+      size_t i;
+      const scm_t_wchar *a = scm_i_string_wide_chars (sstr) + start_x;
+      const char *b = cstr;
+      for (i = 0; i < strlen (b); i++)
+        {
+          if (a[i] != (unsigned char) b[i])
+            return 1;
+        }
+    }
+  return 0;
+}
+
 /* Set the Pth character of STR to UCS-4 codepoint CHR. */
 void
 scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
@@ -571,7 +670,7 @@ scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
   if (scm_i_is_narrow_string (str))
     {
       char *dst = scm_i_string_writable_chars (str);
-      dst[p] = (char) (unsigned char) chr;
+      dst[p] = chr;
     }
   else
     {
@@ -581,7 +680,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
    symbols.[hc].  This has been done to keep stringbufs and the
    internals of strings and string-like objects confined to this file.
@@ -695,7 +794,7 @@ scm_i_symbol_chars (SCM sym)
 
   buf = SYMBOL_STRINGBUF (sym);
   if (!STRINGBUF_WIDE (buf))
-    return STRINGBUF_CHARS (buf);
+    return (const char *) STRINGBUF_CHARS (buf);
   else
     scm_misc_error (NULL, "Invalid access of chars of a wide symbol ~S",
                     scm_list_1 (sym));
@@ -710,7 +809,7 @@ scm_i_symbol_wide_chars (SCM sym)
 
   buf = SYMBOL_STRINGBUF (sym);
   if (STRINGBUF_WIDE (buf))
-    return STRINGBUF_WIDE_CHARS (buf);
+    return (const scm_t_wchar *) STRINGBUF_WIDE_CHARS (buf);
   else
     scm_misc_error (NULL, "Invalid access of chars of a narrow symbol ~S",
                     scm_list_1 (sym));
@@ -802,7 +901,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, 
(SCM str),
   else
     e5 = scm_cons (scm_from_locale_symbol ("read-only"),
                    SCM_BOOL_F);
-      
+
   /* Stringbuf info */
   if (!STRINGBUF_WIDE (buf))
     {
@@ -967,11 +1066,12 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
            "@var{chrs}.")
 #define FUNC_NAME s_scm_string
 {
-  SCM result;
+  SCM result = SCM_BOOL_F;
   SCM rest;
   size_t len;
   size_t p = 0;
   long i;
+  int wide = 0;
 
   /* Verify that this is a list of chars.  */
   i = scm_ilength (chrs);
@@ -984,6 +1084,8 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
     {
       SCM elt = SCM_CAR (rest);
       SCM_VALIDATE_CHAR (SCM_ARGn, elt);
+      if (SCM_CHAR (elt) > 0xFF)
+        wide = 1;
       rest = SCM_CDR (rest);
       len--;
       scm_remember_upto_here_1 (elt);
@@ -993,16 +1095,35 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
   len = (size_t) i;
   rest = chrs;
 
-  result = scm_i_make_string (len, NULL);
-  result = scm_i_string_start_writing (result);
-  while (len > 0 && scm_is_pair (rest))
+  if (wide == 0)
     {
-      SCM elt = SCM_CAR (rest);
-      scm_i_string_set_x (result, p, SCM_CHAR (elt));
-      p++;
-      rest = SCM_CDR (rest);
-      len--;
-      scm_remember_upto_here_1 (elt);
+      result = scm_i_make_string (len, NULL);
+      result = scm_i_string_start_writing (result);
+      char *buf = scm_i_string_writable_chars (result);
+      while (len > 0 && scm_is_pair (rest))
+        {
+          SCM elt = SCM_CAR (rest);
+          buf[p] = (unsigned char) SCM_CHAR (elt);
+          p++;
+          rest = SCM_CDR (rest);
+          len--;
+          scm_remember_upto_here_1 (elt);
+        }
+    }
+  else
+    {
+      result = scm_i_make_wide_string (len, NULL);
+      result = scm_i_string_start_writing (result);
+      scm_t_wchar *buf = scm_i_string_writable_wide_chars (result);
+      while (len > 0 && scm_is_pair (rest))
+        {
+          SCM elt = SCM_CAR (rest);
+          buf[p] = SCM_CHAR (elt);
+          p++;
+          rest = SCM_CDR (rest);
+          len--;
+          scm_remember_upto_here_1 (elt);
+        }
     }
   scm_i_string_stop_writing ();
 
@@ -1057,11 +1178,11 @@ SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_string_width, "string-width", 1, 0, 0,
+SCM_DEFINE (scm_string_bytes_per_char, "string-bytes-per-char", 1, 0, 0,
             (SCM string),
             "Return the bytes used to represent a character in @var{string}."
             "This will return 1 or 4.")
-#define FUNC_NAME s_scm_string_width
+#define FUNC_NAME s_scm_string_bytes_per_char
 {
   SCM_VALIDATE_STRING (1, string);
   if (!scm_i_is_narrow_string (string))
@@ -1315,20 +1436,105 @@ scm_is_string (SCM obj)
   return IS_STRING (obj);
 }
 
+static SCM
+scm_from_stringn (const char *str, size_t len, const char *encoding,
+                  scm_t_string_failed_conversion_handler handler)
+{
+  size_t u32len, i;
+  scm_t_wchar *u32;
+  int wide = 0;
+  SCM res;
+
+  if (encoding == NULL)
+    {
+      /* If encoding is null, use Latin-1.  */
+      char *buf;
+      res = scm_i_make_string (len, &buf);
+      memcpy (buf, str, len);
+      return res;
+    }
+
+  u32len = 0;
+  u32 = (scm_t_wchar *) u32_conv_from_encoding (encoding,
+                                                (enum iconv_ilseq_handler)
+                                                handler,
+                                                str, len,
+                                                NULL,
+                                                NULL, &u32len);
+
+  if (u32 == NULL)
+    {
+      if (errno == ENOMEM)
+        scm_memory_error ("locale string conversion");
+      else
+        {
+          /* There are invalid sequences in the input string.  */
+          SCM errstr;
+          char *dst;
+          errstr = scm_i_make_string (len, &dst);
+          memcpy (dst, str, len);
+          scm_misc_error (NULL, "input locale conversion error from ~s: ~s",
+                          scm_list_2 (scm_from_locale_string (encoding),
+                                      errstr));
+          scm_remember_upto_here_1 (errstr);
+        }
+    }
+
+  i = 0;
+  while (i < u32len)
+    if (u32[i++] > 0xFF)
+      {
+        wide = 1;
+        break;
+      }
+
+  if (!wide)
+    {
+      char *dst;
+      res = scm_i_make_string (u32len, &dst);
+      for (i = 0; i < u32len; i ++)
+        dst[i] = (unsigned char) u32[i];
+      dst[u32len] = '\0';
+    }
+  else
+    {
+      scm_t_wchar *wdst;
+      res = scm_i_make_wide_string (u32len, &wdst);
+      u32_cpy ((scm_t_uint32 *) wdst, (scm_t_uint32 *) u32, u32len);
+      wdst[u32len] = 0;
+    }
+
+  free (u32);
+  return res;
+}
+
 SCM
 scm_from_locale_stringn (const char *str, size_t len)
 {
-  SCM res;
-  char *dst;
+  const char *enc;
+  scm_t_string_failed_conversion_handler hndl;
+  SCM inport;
+  scm_t_port *pt;
 
   if (len == (size_t) -1)
     len = strlen (str);
   if (len == 0)
     return scm_nullstr;
 
-  res = scm_i_make_string (len, &dst);
-  memcpy (dst, str, len);
-  return res;
+  inport = scm_current_input_port ();
+  if (!SCM_UNBNDP (inport) && SCM_OPINPORTP (inport))
+    {
+      pt = SCM_PTAB_ENTRY (inport);
+      enc = pt->encoding;
+      hndl = pt->ilseq_handler;
+    }
+  else
+    {
+      enc = NULL;
+      hndl = SCM_FAILED_CONVERSION_ERROR;
+    }
+
+  return scm_from_stringn (str, len, enc, hndl);
 }
 
 SCM
@@ -1340,6 +1546,14 @@ scm_from_locale_string (const char *str)
   return scm_from_locale_stringn (str, -1);
 }
 
+SCM
+scm_i_from_utf8_string (const scm_t_uint8 *str)
+{
+  return scm_from_stringn ((const char *) str,
+                           strlen ((char *) str), "UTF-8",
+                           SCM_FAILED_CONVERSION_ERROR);
+}
+
 /* Create a new scheme string from the C string STR.  The memory of
    STR may be used directly as storage for the new string.  */
 SCM
@@ -1428,23 +1642,33 @@ unistring_escapes_to_guile_escapes (char **bufp, size_t 
*lenp)
 char *
 scm_to_locale_stringn (SCM str, size_t * lenp)
 {
+  SCM outport;
+  scm_t_port *pt;
   const char *enc;
 
-  /* In the future, enc will hold the port's encoding.  */
-  enc = NULL;
+  outport = scm_current_output_port ();
+  if (!SCM_UNBNDP (outport) && SCM_OPOUTPORTP (outport))
+    {
+      pt = SCM_PTAB_ENTRY (outport);
+      enc = pt->encoding;
+    }
+  else
+    enc = NULL;
 
-  return scm_to_stringn (str, lenp, enc, 
-                         SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
+  return scm_to_stringn (str, lenp, 
+                         enc,
+                         scm_i_get_conversion_strategy (SCM_BOOL_F));
 }
 
 /* Low-level scheme to C string conversion function.  */
 char *
-scm_to_stringn (SCM str, size_t * lenp, const char *encoding,
+scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
                 scm_t_string_failed_conversion_handler handler)
 {
-  static const char iso[11] = "ISO-8859-1";
   char *buf;
   size_t ilen, len, i;
+  int ret;
+  const char *enc;
 
   if (!scm_is_string (str))
     scm_wrong_type_arg_msg (NULL, 0, str, "string");
@@ -1458,7 +1682,7 @@ scm_to_stringn (SCM str, size_t * lenp, const char 
*encoding,
         *lenp = 0;
       return buf;
     }
-       
+
   if (lenp == NULL)
     for (i = 0; i < ilen; i++)
       if (scm_i_string_ref (str, i) == '\0')
@@ -1466,8 +1690,10 @@ scm_to_stringn (SCM str, size_t * lenp, const char 
*encoding,
                         "string contains #\\nul character: ~S",
                         scm_list_1 (str));
 
-  if (scm_i_is_narrow_string (str))
+  if (scm_i_is_narrow_string (str) && (encoding == NULL))
     {
+      /* If using native Latin-1 encoding, just copy the string
+         contents.  */
       if (lenp)
         {
           buf = scm_malloc (ilen);
@@ -1484,20 +1710,44 @@ scm_to_stringn (SCM str, size_t * lenp, const char 
*encoding,
         }
     }
 
-  
+
   buf = NULL;
   len = 0;
-  buf = u32_conv_to_encoding (iso,
-                              (enum iconv_ilseq_handler) handler,
-                              (scm_t_uint32 *) scm_i_string_wide_chars (str),
-                              ilen, NULL, NULL, &len);
-  if (buf == NULL)
-    scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"",
-                    scm_list_2 (scm_from_locale_string (iso), str));
+  enc = encoding;
+  if (enc == NULL)
+    enc = "ISO-8859-1";
+  if (scm_i_is_narrow_string (str))
+    {
+      ret = mem_iconveh (scm_i_string_chars (str), ilen,
+                         "ISO-8859-1", enc,
+                         (enum iconv_ilseq_handler) handler, NULL,
+                         &buf, &len);
 
-  if (handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
-    unistring_escapes_to_guile_escapes (&buf, &len);
+      if (ret == 0 && handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
+        unistring_escapes_to_guile_escapes (&buf, &len);
 
+      if (ret != 0)
+        {
+          scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"", 
+                          scm_list_2 (scm_from_locale_string (enc),
+                                      str));
+        }
+    }
+  else
+    {
+      buf = u32_conv_to_encoding (enc, 
+                                  (enum iconv_ilseq_handler) handler,
+                                  (scm_t_uint32 *) scm_i_string_wide_chars 
(str), 
+                                  ilen,
+                                  NULL,
+                                  NULL, &len);
+      if (buf == NULL)
+        {
+          scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"", 
+                          scm_list_2 (scm_from_locale_string (enc),
+                                      str));
+        }
+    }
   if (lenp)
     *lenp = len;
   else
@@ -1516,6 +1766,14 @@ scm_to_locale_string (SCM str)
   return scm_to_locale_stringn (str, NULL);
 }
 
+scm_t_uint8 *
+scm_i_to_utf8_string (SCM str)
+{
+  char *u8str;
+  u8str = scm_to_stringn (str, NULL, "UTF-8", SCM_FAILED_CONVERSION_ERROR);
+  return (scm_t_uint8 *) u8str;
+}
+
 size_t
 scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len)
 {
@@ -1662,6 +1920,36 @@ scm_i_deprecated_string_length (SCM str)
 
 #endif
 
+static SCM
+string_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  return scm_c_string_ref (h->array, index);
+}
+
+static void
+string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
+{
+  scm_c_string_set_x (h->array, index, val);
+}
+
+static void
+string_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = scm_c_string_length (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_CHAR;
+  h->elements = h->writable_elements = NULL;
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f & ~2,
+                          string_handle_ref, string_handle_set,
+                          string_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string);
+
 void
 scm_init_strings ()
 {
diff --git a/libguile/strings.h b/libguile/strings.h
index c3e3e6a..95dc7ac 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -102,7 +102,7 @@ SCM_API SCM scm_string_p (SCM x);
 SCM_API SCM scm_string (SCM chrs);
 SCM_API SCM scm_make_string (SCM k, SCM chr);
 SCM_API SCM scm_string_length (SCM str);
-SCM_API SCM scm_string_width (SCM str);
+SCM_API SCM scm_string_bytes_per_char (SCM str);
 SCM_API SCM scm_string_ref (SCM str, SCM k);
 SCM_API SCM scm_string_set_x (SCM str, SCM k, SCM chr);
 SCM_API SCM scm_substring (SCM str, SCM start, SCM end);
@@ -124,6 +124,7 @@ SCM_API SCM scm_c_substring_copy (SCM str, size_t start, 
size_t end);
 SCM_API int scm_is_string (SCM x);
 SCM_API SCM scm_from_locale_string (const char *str);
 SCM_API SCM scm_from_locale_stringn (const char *str, size_t len);
+SCM_INTERNAL SCM scm_i_from_utf8_string (const scm_t_uint8 *str);
 SCM_API SCM scm_take_locale_string (char *str);
 SCM_API SCM scm_take_locale_stringn (char *str, size_t len);
 SCM_API char *scm_to_locale_string (SCM str);
@@ -132,6 +133,7 @@ SCM_INTERNAL char *scm_to_stringn (SCM str, size_t *lenp,
                                    const char *encoding,
                                    scm_t_string_failed_conversion_handler
                                    handler);
+SCM_INTERNAL scm_t_uint8 *scm_i_to_utf8_string (SCM str);
 SCM_API size_t scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len);
 
 SCM_API SCM scm_makfromstrs (int argc, char **argv);
@@ -152,6 +154,8 @@ SCM_INTERNAL SCM scm_i_string_start_writing (SCM str);
 SCM_INTERNAL void scm_i_string_stop_writing (void);
 SCM_INTERNAL int scm_i_is_narrow_string (SCM str);
 SCM_INTERNAL scm_t_wchar scm_i_string_ref (SCM str, size_t x);
+SCM_INTERNAL int scm_i_string_contains_char (SCM str, char c);
+SCM_INTERNAL int scm_i_string_strcmp (SCM sstr, size_t start_x, const char 
*cstr);
 SCM_INTERNAL void scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr);
 /* internal functions related to symbols. */
 
@@ -167,6 +171,7 @@ 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);
 SCM_INTERNAL int scm_i_is_narrow_symbol (SCM str);
+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);
 
diff --git a/libguile/strports.c b/libguile/strports.c
index 5c67bf9..490a15f 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -30,7 +30,7 @@
 #include <unistd.h>
 #endif
 
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/eval.h"
 #include "libguile/ports.h"
 #include "libguile/read.h"
@@ -39,6 +39,7 @@
 #include "libguile/modules.h"
 #include "libguile/validate.h"
 #include "libguile/deprecation.h"
+#include "libguile/srfi-4.h"
 
 #include "libguile/strports.h"
 
@@ -289,42 +290,33 @@ st_truncate (SCM port, scm_t_off length)
 }
 
 SCM 
-scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
+scm_i_mkstrport (SCM pos, const char *locale_str, size_t str_len, long modes, 
const char *caller)
 {
-  SCM z;
+  SCM z, str;
   scm_t_port *pt;
-  size_t str_len, c_pos;
-
-  SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
+  size_t c_pos;
+  char *buf;
+
+  /* Because ports are inherently 8-bit, strings need to be converted
+     to a locale representation for storage.  But, since string ports
+     rely on string functionality for their memory management, we need
+     to create a new string that has the 8-bit locale representation
+     of the underlying string.  This violates the guideline that the
+     internal encoding of characters in strings is in unicode
+     codepoints. */
+  str = scm_i_make_string (str_len, &buf);
+  memcpy (buf, locale_str, str_len);
 
-  str_len = scm_i_string_length (str);
   c_pos = scm_to_unsigned_integer (pos, 0, str_len);
 
   if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
     scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
 
-  /* XXX
- 
-     Make a new string to isolate us from changes to the original.
-     This is done so that we can rely on scm_i_string_chars to stay in
-     place even across SCM_TICKs.
-
-     Additionally, when we are going to write to the string, we make a
-     copy so that we can write to it without having to use
-     scm_i_string_writable_chars.
-  */
-
-  if (modes & SCM_WRTNG)
-    str = scm_c_substring_copy (str, 0, str_len);
-  else
-    str = scm_c_substring (str, 0, str_len);
-
   scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
   z = scm_new_port_table_entry (scm_tc16_strport);
   pt = SCM_PTAB_ENTRY(z);
   SCM_SETSTREAM (z, SCM_UNPACK (str));
   SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
-  /* see above why we can use scm_i_string_chars here. */
   pt->write_buf = pt->read_buf = (unsigned char *) scm_i_string_chars (str);
   pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
   pt->write_buf_size = pt->read_buf_size = str_len;
@@ -340,22 +332,60 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char 
*caller)
   return z;
 }
 
+SCM 
+scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
+{
+  SCM z;
+  size_t str_len;
+  char *buf;
+
+  SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
+
+  /* Because ports are inherently 8-bit, strings need to be converted
+     to a locale representation for storage.  But, since string ports
+     rely on string functionality for their memory management, we need
+     to create a new string that has the 8-bit locale representation
+     of the underlying string.  This violates the guideline that the
+     internal encoding of characters in strings is in unicode
+     codepoints. */
+  buf = scm_to_locale_stringn (str, &str_len);
+  z = scm_i_mkstrport (pos, buf, str_len, modes, caller);
+  free (buf);
+  return z;
+}
+
 /* create a new string from a string port's buffer.  */
 SCM scm_strport_to_string (SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   SCM str;
-  char *dst;
   
   if (pt->rw_active == SCM_PORT_WRITE)
     st_flush (port);
 
-  str = scm_i_make_string (pt->read_buf_size, &dst);
-  memcpy (dst, (char *) pt->read_buf, pt->read_buf_size);
+  str = scm_from_locale_stringn ((char *)pt->read_buf, pt->read_buf_size);
   scm_remember_upto_here_1 (port);
   return str;
 }
 
+/* Create a vector containing the locale representation of the string in the
+   port's buffer.  */
+SCM scm_strport_to_locale_u8vector (SCM port)
+{
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  SCM vec;
+  char *buf;
+  
+  if (pt->rw_active == SCM_PORT_WRITE)
+    st_flush (port);
+
+  buf = scm_malloc (pt->read_buf_size);
+  memcpy (buf, pt->read_buf, pt->read_buf_size);
+  vec = scm_take_u8vector ((unsigned char *) buf, pt->read_buf_size);
+  scm_remember_upto_here_1 (port);
+  return vec;
+}
+
 SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
            (SCM obj, SCM printer),
            "Return a Scheme string obtained by printing @var{obj}.\n"
@@ -380,6 +410,25 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 
0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_call_with_output_locale_u8vector, 
"call-with-output-locale-u8vector", 1, 0, 0, 
+           (SCM proc),
+           "Calls the one-argument procedure @var{proc} with a newly created 
output\n"
+           "port.  When the function returns, a vector containing the bytes of 
a\n"
+           "locale representation of the characters written into the port is 
returned\n")
+#define FUNC_NAME s_scm_call_with_output_locale_u8vector
+{
+  SCM p;
+
+  p = scm_mkstrport (SCM_INUM0, 
+                    scm_make_string (SCM_INUM0, SCM_UNDEFINED),
+                    SCM_OPN | SCM_WRTNG,
+                     FUNC_NAME);
+  scm_call_1 (proc, p);
+
+  return scm_get_output_locale_u8vector (p);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, 
            (SCM proc),
            "Calls the one-argument procedure @var{proc} with a newly created 
output\n"
@@ -424,6 +473,27 @@ SCM_DEFINE (scm_open_input_string, "open-input-string", 1, 
0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_open_input_locale_u8vector, "open-input-locale-u8vector", 1, 
0, 0,
+           (SCM vec),
+           "Take a u8vector containing the bytes of a string encoded in the\n"
+           "current locale and return an input port that delivers characters\n"
+           "from the string. The port can be closed by\n"
+           "@code{close-input-port}, though its storage will be reclaimed\n"
+           "by the garbage collector if it becomes inaccessible.")
+#define FUNC_NAME s_scm_open_input_locale_u8vector
+{
+  scm_t_array_handle hnd;
+  ssize_t inc;
+  size_t len;
+  const scm_t_uint8 *buf;
+
+  buf = scm_u8vector_elements (vec, &hnd, &len, &inc);
+  SCM p = scm_i_mkstrport(SCM_INUM0, (const char *) buf, len, SCM_OPN | 
SCM_RDNG, FUNC_NAME);
+  scm_array_handle_release (&hnd);
+  return p;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_open_output_string, "open-output-string", 0, 0, 0, 
            (void),
            "Return an output port that will accumulate characters for\n"
@@ -456,11 +526,26 @@ SCM_DEFINE (scm_get_output_string, "get-output-string", 
1, 0, 0,
 #undef FUNC_NAME
 
 
+SCM_DEFINE (scm_get_output_locale_u8vector, "get-output-locale-u8vector", 1, 
0, 0, 
+           (SCM port),
+           "Given an output port created by @code{open-output-string},\n"
+           "return a u8 vector containing the characters of the string\n"
+           "encoded in the current locale.")
+#define FUNC_NAME s_scm_get_output_locale_u8vector
+{
+  SCM_VALIDATE_OPOUTSTRPORT (1, port);
+  return scm_strport_to_locale_u8vector (port);
+}
+#undef FUNC_NAME
+
+
 /* Given a null-terminated string EXPR containing a Scheme expression
    read it, and return it as an SCM value. */
 SCM
 scm_c_read_string (const char *expr)
 {
+  /* FIXME: the c string gets packed into a string, only to get
+     immediately unpacked in scm_mkstrport.  */
   SCM port = scm_mkstrport (SCM_INUM0,
                            scm_from_locale_string (expr),
                            SCM_OPN | SCM_RDNG,
diff --git a/libguile/strports.h b/libguile/strports.h
index 3129c03..b2ded01 100644
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -44,13 +44,19 @@ SCM_API scm_t_bits scm_tc16_strport;
 
 
 SCM_API SCM scm_mkstrport (SCM pos, SCM str, long modes, const char * caller);
+SCM_INTERNAL SCM scm_i_mkstrport (SCM pos, const char *locale_str, size_t 
str_len, 
+                                 long modes, const char *caller);
 SCM_API SCM scm_strport_to_string (SCM port);
+SCM_API SCM scm_strport_to_locale_u8vector (SCM port);
 SCM_API SCM scm_object_to_string (SCM obj, SCM printer);
 SCM_API SCM scm_call_with_output_string (SCM proc);
+SCM_API SCM scm_call_with_output_locale_u8vector (SCM proc);
 SCM_API SCM scm_call_with_input_string (SCM str, SCM proc);
 SCM_API SCM scm_open_input_string (SCM str);
+SCM_API SCM scm_open_input_locale_u8vector (SCM str);
 SCM_API SCM scm_open_output_string (void);
 SCM_API SCM scm_get_output_string (SCM port);
+SCM_API SCM scm_get_output_locale_u8vector (SCM port);
 SCM_API SCM scm_c_read_string (const char *expr);
 SCM_API SCM scm_c_eval_string (const char *expr);
 SCM_API SCM scm_c_eval_string_in_module (const char *expr, SCM module);
diff --git a/libguile/struct.c b/libguile/struct.c
index f701f8f..b7e72a7 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -30,6 +30,7 @@
 #include "libguile/hashtab.h"
 #include "libguile/ports.h"
 #include "libguile/strings.h"
+#include "libguile/srfi-13.h"
 
 #include "libguile/validate.h"
 #include "libguile/struct.h"
@@ -63,9 +64,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 
0, 0,
 {
   SCM new_sym;
   SCM_VALIDATE_STRING (1, fields);
+  scm_t_wchar c;
 
   { /* scope */
-    const char * field_desc;
     size_t len;
     int x;
 
@@ -74,11 +75,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 
0, 0,
       SCM_MISC_ERROR ("odd length field specification: ~S", 
                      scm_list_1 (fields));
 
-    field_desc = scm_i_string_chars (fields);
-
     for (x = 0; x < len; x += 2)
       {
-       switch (field_desc[x])
+       switch (c = scm_i_string_ref (fields, x))
          {
          case 'u':
          case 'p':
@@ -90,13 +89,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 
1, 0, 0,
            break;
          default:
            SCM_MISC_ERROR ("unrecognized field type: ~S", 
-                           scm_list_1 (SCM_MAKE_CHAR (field_desc[x])));
+                           scm_list_1 (SCM_MAKE_CHAR (c)));
          }
 
-       switch (field_desc[x + 1])
+       switch (c = scm_i_string_ref (fields, x + 1))
          {
          case 'w':
-           if (field_desc[x] == 's')
+           if (scm_i_string_ref (fields, x) == 's')
              SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
          case 'r':
          case 'o':
@@ -104,7 +103,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 
1, 0, 0,
          case 'R':
          case 'W':
          case 'O':
-           if (field_desc[x] == 's')
+           if (scm_i_string_ref (fields, x) == 's')
              SCM_MISC_ERROR ("self fields not allowed in tail array", 
                              SCM_EOL);
            if (x != len - 2)
@@ -113,12 +112,12 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 
1, 0, 0,
            break;
          default:
            SCM_MISC_ERROR ("unrecognized ref specification: ~S",
-                           scm_list_1 (SCM_MAKE_CHAR (field_desc[x + 1])));
+                           scm_list_1 (SCM_MAKE_CHAR (c)));
          }
 #if 0
-       if (field_desc[x] == 'd')
+       if (scm_i_string_ref (fields, x, 'd'))
          {
-           if (field_desc[x + 2] != '-')
+           if (!scm_i_string_ref (fields, x+2, '-'))
              SCM_MISC_ERROR ("missing dash field at position ~A",
                              scm_list_1 (scm_from_int (x / 2)));
            x += 2;
@@ -140,18 +139,18 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 
1, 0, 0,
 static void
 scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM 
inits)
 {
-  unsigned const char *fields_desc =
-    (unsigned const char *) scm_i_symbol_chars (layout) - 2;
-  unsigned char prot = 0;
+  scm_t_wchar prot = 0;
   int n_fields = scm_i_symbol_length (layout) / 2;
   int tailp = 0;
+  int i;
 
+  i = -2;
   while (n_fields)
     {
       if (!tailp)
        {
-         fields_desc += 2;
-         prot = fields_desc[1];
+         i += 2;
+         prot = scm_i_symbol_ref (layout, i+1);
          if (SCM_LAYOUT_TAILP (prot))
            {
              tailp = 1;
@@ -162,8 +161,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, 
int tail_elts, SCM in
                break;
            }
        }
-      
-      switch (*fields_desc)
+      switch (scm_i_symbol_ref (layout, i))
        {
 #if 0
        case 'i':
@@ -239,7 +237,8 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
 {
   SCM layout;
   scm_t_bits * mem;
-  int tmp;
+  SCM tmp;
+  size_t len;
 
   if (!SCM_STRUCTP (x))
     return SCM_BOOL_F;
@@ -250,11 +249,14 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 
0,
       < scm_i_string_length (required_vtable_fields))
     return SCM_BOOL_F;
 
-  tmp = strncmp (scm_i_symbol_chars (layout),
-                scm_i_string_chars (required_vtable_fields),
-                scm_i_string_length (required_vtable_fields));
-  scm_remember_upto_here_1 (required_vtable_fields);
-  if (tmp)
+  len = scm_i_string_length (required_vtable_fields);
+  tmp = scm_string_eq (scm_symbol_to_string (layout), 
+                      required_vtable_fields, 
+                      scm_from_size_t (0), 
+                      scm_from_size_t (len), 
+                      scm_from_size_t (0),
+                      scm_from_size_t (len));
+  if (scm_is_false (tmp))
     return SCM_BOOL_F;
 
   mem = SCM_STRUCT_DATA (x);
@@ -621,8 +623,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
   size_t layout_len;
   size_t p;
   scm_t_bits n_fields;
-  const char *fields_desc;
-  char field_type = 0;
+  scm_t_wchar field_type = 0;
   
 
   SCM_VALIDATE_STRUCT (1, handle);
@@ -631,7 +632,6 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
   data = SCM_STRUCT_DATA (handle);
   p = scm_to_size_t (pos);
 
-  fields_desc = scm_i_symbol_chars (layout);
   layout_len = scm_i_symbol_length (layout);
   if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
     /* no extra words */
@@ -643,9 +643,9 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
 
   if (p * 2 < layout_len)
     {
-      char ref;
-      field_type = fields_desc[p * 2];
-      ref = fields_desc[p * 2 + 1];
+      scm_t_wchar ref;
+      field_type = scm_i_symbol_ref (layout, p * 2);
+      ref = scm_i_symbol_ref (layout, p * 2 + 1);
       if ((ref != 'r') && (ref != 'w'))
        {
          if ((ref == 'R') || (ref == 'W'))
@@ -654,8 +654,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
            SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
        }
     }
-  else if (fields_desc[layout_len - 1] != 'O')    
-    field_type = fields_desc[layout_len - 2];
+  else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
+    field_type = scm_i_symbol_ref(layout, layout_len - 2);
   else
     SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
   
@@ -703,8 +703,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   size_t layout_len;
   size_t p;
   int n_fields;
-  const char *fields_desc;
-  char field_type = 0;
+  scm_t_wchar field_type = 0;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
@@ -712,7 +711,6 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   data = SCM_STRUCT_DATA (handle);
   p = scm_to_size_t (pos);
 
-  fields_desc = scm_i_symbol_chars (layout);
   layout_len = scm_i_symbol_length (layout);
   if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
     /* no extra words */
@@ -725,13 +723,13 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   if (p * 2 < layout_len)
     {
       char set_x;
-      field_type = fields_desc[p * 2];
-      set_x = fields_desc [p * 2 + 1];
+      field_type = scm_i_symbol_ref (layout, p * 2);
+      set_x = scm_i_symbol_ref (layout, p * 2 + 1);
       if (set_x != 'w')
        SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
     }
-  else if (fields_desc[layout_len - 1] == 'W')    
-    field_type = fields_desc[layout_len - 2];
+  else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')    
+    field_type = scm_i_symbol_ref (layout, layout_len - 2);
   else
     SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
   
diff --git a/libguile/symbols.c b/libguile/symbols.c
index 6faac61..c77749f 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -89,15 +89,17 @@ scm_i_hash_symbol (SCM obj, unsigned long n, void *closure)
 }
 
 static SCM
-lookup_interned_symbol (const char *name, size_t len,
-                       unsigned long raw_hash)
+lookup_interned_symbol (SCM name, unsigned long raw_hash)
 {
   /* Try to find the symbol in the symbols table */
   SCM result = SCM_BOOL_F;
   SCM bucket, elt, previous_elt;
+  size_t len;
   unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
 
+  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))
@@ -130,15 +132,32 @@ lookup_interned_symbol (const char *name, size_t len,
       if (scm_i_symbol_hash (sym) == raw_hash
          && scm_i_symbol_length (sym) == len)
        {
-         const char *chrs = scm_i_symbol_chars (sym);
-         size_t i = len;
-
-         while (i != 0)
-           {
-             --i;
-             if (name[i] != chrs[i])
-               goto next_symbol;
-           }
+          size_t i = len;
+
+          /* Slightly faster path for comparing narrow to narrow.  */
+          if (scm_i_is_narrow_string (name) && scm_i_is_narrow_symbol (sym))
+            {
+              const char *chrs = scm_i_symbol_chars (sym);
+              const char *str = scm_i_string_chars (name);
+
+              while (i != 0)
+                {
+                  --i;
+                  if (str[i] != chrs[i])
+                    goto next_symbol;
+                }
+            }
+          else
+            {
+              /* Somewhat slower path for comparing narrow to wide or
+                 wide to wide.  */
+              while (i != 0)
+                {
+                  --i;
+                  if (scm_i_string_ref (name, i) != scm_i_symbol_ref (sym, i))
+                    goto next_symbol;
+                }
+            }
 
          /* We found it.  */
          result = sym;
@@ -174,32 +193,12 @@ intern_symbol (SCM symbol)
 }
 
 static SCM
-scm_i_c_mem2symbol (const char *name, size_t len)
+scm_i_str2symbol (SCM str)
 {
   SCM symbol;
-  size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
+  size_t raw_hash = scm_i_string_hash (str);
 
-  symbol = lookup_interned_symbol (name, len, raw_hash);
-  if (scm_is_false (symbol))
-    {
-      /* The symbol was not found, create it.  */
-      symbol = scm_i_c_make_symbol (name, len, 0, raw_hash,
-                                   scm_cons (SCM_BOOL_F, SCM_EOL));
-      intern_symbol (symbol);
-    }
-
-  return symbol;
-}
-
-static SCM
-scm_i_mem2symbol (SCM str)
-{
-  SCM symbol;
-  const char *name = scm_i_string_chars (str);
-  size_t len = scm_i_string_length (str);
-  size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
-
-  symbol = lookup_interned_symbol (name, len, raw_hash);
+  symbol = lookup_interned_symbol (str, raw_hash);
   if (scm_is_false (symbol))
     {
       /* The symbol was not found, create it.  */
@@ -213,11 +212,9 @@ scm_i_mem2symbol (SCM str)
 
 
 static SCM
-scm_i_mem2uninterned_symbol (SCM str)
+scm_i_str2uninterned_symbol (SCM str)
 {
-  const char *name = scm_i_string_chars (str);
-  size_t len = scm_i_string_length (str);
-  size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
+  size_t raw_hash = scm_i_string_hash (str);
 
   return scm_i_make_symbol (str, SCM_I_F_SYMBOL_UNINTERNED, 
                            raw_hash, scm_cons (SCM_BOOL_F, SCM_EOL));
@@ -252,7 +249,7 @@ SCM_DEFINE (scm_make_symbol, "make-symbol", 1, 0, 0,
 #define FUNC_NAME s_scm_make_symbol
 {
   SCM_VALIDATE_STRING (1, name);
-  return scm_i_mem2uninterned_symbol (name);
+  return scm_i_str2uninterned_symbol (name);
 }
 #undef FUNC_NAME
 
@@ -314,7 +311,7 @@ SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0,
 #define FUNC_NAME s_scm_string_to_symbol
 {
   SCM_VALIDATE_STRING (1, string);
-  return scm_i_mem2symbol (string);
+  return scm_i_str2symbol (string);
 }
 #undef FUNC_NAME
 
@@ -421,44 +418,23 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
 SCM
 scm_from_locale_symbol (const char *sym)
 {
-  return scm_i_c_mem2symbol (sym, strlen (sym));
+  return scm_from_locale_symboln (sym, -1);
 }
 
 SCM
 scm_from_locale_symboln (const char *sym, size_t len)
 {
-  return scm_i_c_mem2symbol (sym, len);
+  SCM str = scm_from_locale_stringn (sym, len);
+  return scm_i_str2symbol (str);
 }
 
 SCM
 scm_take_locale_symboln (char *sym, size_t len)
 {
-  SCM res;
-  unsigned long raw_hash;
-
-  if (len == (size_t)-1)
-    len = strlen (sym);
-  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.  */
-      sym = scm_realloc (sym, len+1);
-      sym[len] = '\0';
-    }
-
-  raw_hash = scm_string_hash ((unsigned char *)sym, len);
-  res = lookup_interned_symbol (sym, len, raw_hash);
-  if (scm_is_false (res))
-    {
-      res = scm_i_c_take_symbol (sym, len, 0, raw_hash,
-                                scm_cons (SCM_BOOL_F, SCM_EOL));
-      intern_symbol (res);
-    }
-  else
-    free (sym);
+  SCM str;
 
-  return res;
+  str = scm_take_locale_stringn (sym, len);
+  return scm_i_str2symbol (str);
 }
 
 SCM
diff --git a/libguile/tags.h b/libguile/tags.h
index 43853dc..e51b865 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -449,11 +449,11 @@ typedef unsigned long scm_t_bits;
 #define scm_tc7_unused_6       55
 #define scm_tc7_unused_7       71
 #define scm_tc7_unused_8       77
-#define scm_tc7_unused_9       79
 
 #define scm_tc7_dsubr          61
 #define scm_tc7_gsubr          63
 #define scm_tc7_rpsubr         69
+#define scm_tc7_program                79
 #define scm_tc7_subr_0         85
 #define scm_tc7_subr_1         87
 #define scm_tc7_cxr            93
diff --git a/libguile/threads.c b/libguile/threads.c
index f92ca26..f440bf5 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -299,7 +299,7 @@ unblock_from_queue (SCM queue)
       var 't'
       // save registers.
       SCM_FLUSH_REGISTER_WINDOWS;      // sparc only
-      setjmp (t->regs);                // here's most of the magic
+      SCM_I_SETJMP (t->regs);          // here's most of the magic
 
    ... and returns.
 
@@ -353,7 +353,7 @@ unblock_from_queue (SCM queue)
       t->top = SCM_STACK_PTR (&t);
       // save registers.
       SCM_FLUSH_REGISTER_WINDOWS;
-      setjmp (t->regs);
+      SCM_I_SETJMP (t->regs);
       res = func(data);
       scm_enter_guile (t);
 
@@ -404,7 +404,7 @@ suspend (void)
   t->top = SCM_STACK_PTR (&t);
   /* save registers. */
   SCM_FLUSH_REGISTER_WINDOWS;
-  setjmp (t->regs);
+  SCM_I_SETJMP (t->regs);
   return t;
 }
 
diff --git a/libguile/threads.h b/libguile/threads.h
index d48d530..55102df 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -111,7 +111,7 @@ typedef struct scm_i_thread {
   SCM vm;
   SCM_STACKITEM *base;
   SCM_STACKITEM *top;
-  jmp_buf regs;
+  scm_i_jmp_buf regs;
 #ifdef __ia64__
   void *register_backing_store_base;
   scm_t_contregs *pending_rbs_continuation;
diff --git a/libguile/throw.c b/libguile/throw.c
index b48bea1..cf6ea4a 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -23,6 +23,7 @@
 #endif
 
 #include <stdio.h>
+#include <unistdio.h>
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/smob.h"
@@ -59,7 +60,7 @@ static scm_t_bits tc16_jmpbuffer;
 #define DEACTIVATEJB(x) \
   (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L))))
 
-#define JBJMPBUF(OBJ)           ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
+#define JBJMPBUF(OBJ)           ((scm_i_jmp_buf *) SCM_CELL_WORD_1 (OBJ))
 #define SETJBJMPBUF(x, v)        (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
 #define SCM_JBDFRAME(x)         ((scm_t_debug_frame *) SCM_CELL_WORD_2 (x))
 #define SCM_SETJBDFRAME(x, v)    (SCM_SET_CELL_WORD_2 ((x), (scm_t_bits) (v)))
@@ -81,7 +82,7 @@ make_jmpbuf (void)
 {
   SCM answer;
   SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0);
-  SETJBJMPBUF(answer, (jmp_buf *)0);
+  SETJBJMPBUF(answer, (scm_i_jmp_buf *)0);
   DEACTIVATEJB(answer);
   return answer;
 }
@@ -91,7 +92,7 @@ make_jmpbuf (void)
 
 struct jmp_buf_and_retval      /* use only on the stack, in scm_catch */
 {
-  jmp_buf buf;                 /* must be first */
+  scm_i_jmp_buf buf;           /* must be first */
   SCM throw_tag;
   SCM retval;
 };
@@ -194,7 +195,7 @@ scm_c_catch (SCM tag,
   pre_unwind.lazy_catch_p = 0;
   SCM_SETJBPREUNWIND(jmpbuf, &pre_unwind);
 
-  if (setjmp (jbr.buf))
+  if (SCM_I_SETJMP (jbr.buf))
     {
       SCM throw_tag;
       SCM throw_args;
@@ -744,8 +745,12 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
        */
       fprintf (stderr, "throw from within critical section.\n");
       if (scm_is_symbol (key))
-       fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key));
-
+       {
+         if (scm_i_is_narrow_symbol (key))
+           fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key));
+         else
+           ulc_fprintf (stderr, "error key: %llU\n", scm_i_symbol_wide_chars 
(key));
+       }
       
       for (; scm_is_pair (s); s = scm_cdr (s), i++)
        {
@@ -884,7 +889,7 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
       jbr->throw_tag = key;
       jbr->retval = args;
       scm_i_set_last_debug_frame (SCM_JBDFRAME (jmpbuf));
-      longjmp (*JBJMPBUF (jmpbuf), 1);
+      SCM_I_LONGJMP (*JBJMPBUF (jmpbuf), 1);
     }
 
   /* Otherwise, it's some random piece of junk.  */
diff --git a/libguile/unidata_to_charset.pl b/libguile/unidata_to_charset.pl
new file mode 100755
index 0000000..6871e67
--- /dev/null
+++ b/libguile/unidata_to_charset.pl
@@ -0,0 +1,399 @@
+#!/usr/bin/perl
+# unidata_to_charset.pl --- Compute SRFI-14 charsets from UnicodeData.txt
+#
+# Copyright (C) 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
+
+open(my $in,  "<",  "UnicodeData.txt")  or die "Can't open UnicodeData.txt: 
$!";           
+open(my $out, ">",  "srfi-14.i.c") or die "Can't open srfi-14.i.c: $!";
+
+# For Unicode, we follow Java's specification: a character is
+# lowercase if
+#    * it is not in the range [U+2000,U+2FFF], and
+#    * the Unicode attribute table does not give a lowercase mapping
+#      for it, and
+#    * at least one of the following is true:
+#          o the Unicode attribute table gives a mapping to uppercase
+#            for the character, or
+#          o the name for the character in the Unicode attribute table
+#            contains the words "SMALL LETTER" or "SMALL LIGATURE".
+
+sub lower_case {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint < 0x2000 || $codepoint > 0x2FFF)
+        && (!defined($lowercase) || $lowercase eq "")
+        && ((defined($uppercase) && $uppercase ne "")
+            || ($name =~ /(SMALL LETTER|SMALL LIGATURE)/))) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# For Unicode, we follow Java's specification: a character is
+# uppercase if
+#    * it is not in the range [U+2000,U+2FFF], and
+#    * the Unicode attribute table does not give an uppercase mapping
+#      for it (this excludes titlecase characters), and
+#    * at least one of the following is true:
+#          o the Unicode attribute table gives a mapping to lowercase
+#            for the character, or
+#          o the name for the character in the Unicode attribute table
+#            contains the words "CAPITAL LETTER" or "CAPITAL LIGATURE".
+
+sub upper_case {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint < 0x2000 || $codepoint > 0x2FFF)
+        && (!defined($uppercase) || $uppercase eq "")
+        && ((defined($lowercase) && $lowercase ne "")
+            || ($name =~ /(CAPITAL LETTER|CAPITAL LIGATURE)/))) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A character is titlecase if it has the category Lt in the character
+# attribute database.
+
+sub title_case {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (defined($category) && $category eq "Lt") {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A letter is any character with one of the letter categories (Lu, Ll,
+# Lt, Lm, Lo) in the Unicode character database.
+
+sub letter {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (defined($category) && ($category eq "Lu"
+                               || $category eq "Ll"
+                               || $category eq "Lt"
+                               || $category eq "Lm"
+                               || $category eq "Lo")) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A character is a digit if it has the category Nd in the character
+# attribute database. In Latin-1 and ASCII, the only such characters
+# are 0123456789. In Unicode, there are other digit characters in
+# other code blocks, such as Gujarati digits and Tibetan digits.
+
+sub digit {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (defined($category) && $category eq "Nd") {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# The only hex digits are 0123456789abcdefABCDEF. 
+
+sub hex_digit {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint >= 0x30 && $codepoint <= 0x39)
+        || ($codepoint >= 0x41 && $codepoint <= 0x46)
+        || ($codepoint >= 0x61 && $codepoint <= 0x66)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# The union of char-set:letter and char-set:digit.
+
+sub letter_plus_digit {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (letter($codepoint, $name, $category, $uppercase, $lowercase)
+        || digit($codepoint, $name, $category, $uppercase, $lowercase)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# Characters that would 'use ink' when printed
+sub graphic {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/L|M|N|P|S/)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A whitespace character is either
+#    * a character with one of the space, line, or paragraph separator
+#      categories (Zs, Zl or Zp) of the Unicode character database.
+#    * U+0009 Horizontal tabulation (\t control-I)
+#    * U+000A Line feed (\n control-J)
+#    * U+000B Vertical tabulation (\v control-K)
+#    * U+000C Form feed (\f control-L)
+#    * U+000D Carriage return (\r control-M)
+
+sub whitespace {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/Zs|Zl|Zp/)
+        || $codepoint == 0x9
+        || $codepoint == 0xA 
+        || $codepoint == 0xB 
+        || $codepoint == 0xC 
+        || $codepoint == 0xD) { 
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A printing character is one that would occupy space when printed,
+# i.e., a graphic character or a space character. char-set:printing is
+# the union of char-set:whitespace and char-set:graphic.
+
+sub printing {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (whitespace($codepoint, $name, $category, $uppercase, $lowercase)
+        || graphic($codepoint, $name, $category, $uppercase, $lowercase)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# The ISO control characters are the Unicode/Latin-1 characters in the
+# ranges [U+0000,U+001F] and [U+007F,U+009F].
+
+sub iso_control {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if (($codepoint >= 0x00 && $codepoint <= 0x1F)
+        || ($codepoint >= 0x7F && $codepoint <= 0x9F)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# A punctuation character is any character that has one of the
+# punctuation categories in the Unicode character database (Pc, Pd,
+# Ps, Pe, Pi, Pf, or Po.)
+
+# Note that srfi-14 gives conflicting requirements!!  It claims that
+# only the Unicode punctuation is necessary, but, explicitly calls out
+# the soft hyphen character (U+00AD) as punctution.  Current versions
+# of Unicode consider U+00AD to be a formatting character, not
+# punctuation.
+
+sub punctuation {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/P/)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+        
+# A symbol is any character that has one of the symbol categories in
+# the Unicode character database (Sm, Sc, Sk, or So).
+
+sub symbol {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/S/)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+        
+# Blank chars are horizontal whitespace.  A blank character is either
+#    * a character with the space separator category (Zs) in the
+#      Unicode character database.
+#    * U+0009 Horizontal tabulation (\t control-I) 
+sub blank {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($category =~ (/Zs/)
+        || $codepoint == 0x9) { 
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# ASCII
+sub ascii {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    if ($codepoint <= 0x7F) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# Empty
+sub empty {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    return 0;
+}
+
+# Full -- All characters.  
+sub full {
+    my($codepoint, $name, $category, $uppercase, $lowercase)= @_;
+    return 1;
+}
+
+
+# The procedure generates the two C structures necessary to describe a
+# given category.
+sub compute {
+    my($f) = @_;
+    my $start = -1;
+    my $end = -1;
+    my $len = 0;
+    my @rstart = (-1);
+    my @rend = (-1);
+
+    seek($in, 0, 0) or die "Can't seek to beginning of file: $!";
+
+    print "$f\n";
+
+    while (<$in>) {
+        # Parse the 14 column, semicolon-delimited UnicodeData.txt
+        # file
+        chomp;
+        my(@fields) = split(/;/);
+
+        # The codepoint: an integer
+        my $codepoint = hex($fields[0]); 
+
+        # If this is a character range, the last character in this
+        # range
+        my $codepoint_end = $codepoint;  
+
+        # The name of the character
+        my $name = $fields[1];    
+
+        # A two-character category code, such as Ll (lower-case
+        # letter)
+        my $category = $fields[2];       
+
+        # The codepoint of the uppercase version of this char
+        my $uppercase = $fields[12];   
+
+        # The codepoint of the lowercase version of this char
+        my $lowercase = $fields[13];    
+
+        my $pass = &$f($codepoint,$name,$category,$uppercase,$lowercase);
+        if ($pass == 1) {
+
+            # Some pairs of lines in UnicodeData.txt delimit ranges of
+            # characters.
+            if ($name =~ /First/) {
+                $line = <$in>;
+                die $! if $!;
+                $codepoint_end = hex( (split(/;/, $line))[0] );
+            }                 
+
+            # Compute ranges of characters [start:end] that meet the
+            # criteria.  Store the ranges.
+            if ($start == -1) {
+                $start = $codepoint;
+                $end = $codepoint_end;
+            } elsif ($end + 1 == $codepoint) {
+                $end = $codepoint_end;
+            } else {
+                $rstart[$len] = $start;
+                $rend[$len] = $end;
+                $len++;
+                $start = $codepoint;
+                $end = $codepoint_end;
+            }
+        }
+    }
+
+    # Extra logic to ensure that the last range is included
+    if ($start != -1) {
+        if ($len > 0 && address@hidden != $start) {
+            $rstart[$len] = $start;
+            $rend[$len] = $end;
+            $len++;
+        } elsif ($len == 0) {
+            $rstart[0] = $start;
+            $rend[0] = $end;
+        }
+    }
+
+    # Print the C struct that contains the range list.
+    print $out "scm_t_char_range cs_" . $f . "_ranges[] = {\n";
+    if ($rstart[0] != -1) {
+        for (my $i=0; $i<@rstart-1; $i++) {
+            printf $out "  {0x%04x, 0x%04x},\n", $rstart[$i], $rend[$i];
+        }
+        printf $out "  {0x%04x, 0x%04x}\n", address@hidden, address@hidden;
+    }
+    print $out "};\n\n";
+
+    # Print the C struct that contains the range list length and
+    # pointer to the range list.
+    print $out "scm_t_char_set cs_${f} = {\n";
+    print $out "  $len,\n";
+    print $out "  cs_" . $f . "_ranges\n";
+    print $out "};\n\n";
+}
+
+# Write a bit of a header
+print $out "/* srfi-14.i.c -- standard SRFI-14 character set data */\n\n";
+print $out "/* This file is #include'd by srfi-14.c.  */\n\n";
+print $out "/* This file was generated from\n"
+print $out "   http://unicode.org/Public/UNIDATA/UnicodeData.txt\n";;
+print $out "   with the unidata_to_charset.pl script.  */\n\n";
+
+# Write the C structs for each SRFI-14 charset
+compute "lower_case";
+compute "upper_case";
+compute "title_case";
+compute "letter";
+compute "digit";
+compute "hex_digit";
+compute "letter_plus_digit";
+compute "graphic";
+compute "whitespace";
+compute "printing";
+compute "iso_control";
+compute "punctuation";
+compute "symbol";
+compute "blank";
+compute "ascii";
+compute "empty";
+compute "full";
+
+close $in;
+close $out;
+
+exec ('indent srfi-14.i.c') or print STDERR "call to 'indent' failed: $!";
+
+# And we're done.
+
+
+
+
+
+
diff --git a/libguile/unif.c b/libguile/unif.c
deleted file mode 100644
index 20bc2cf..0000000
--- a/libguile/unif.c
+++ /dev/null
@@ -1,3006 +0,0 @@
-/* Copyright (C) 1995,1996,1997,1998,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
- */
-
-
-/*
-  This file has code for arrays in lots of variants (double, integer,
-  unsigned etc. ). It suffers from hugely repetitive code because
-  there is similar (but different) code for every variant included. (urg.)
-
-  --hwn
-*/
-
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <stdio.h>
-#include <errno.h>
-#include <string.h>
-
-#include "libguile/_scm.h"
-#include "libguile/__scm.h"
-#include "libguile/eq.h"
-#include "libguile/chars.h"
-#include "libguile/eval.h"
-#include "libguile/fports.h"
-#include "libguile/smob.h"
-#include "libguile/feature.h"
-#include "libguile/root.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-4.h"
-#include "libguile/vectors.h"
-#include "libguile/bytevectors.h"
-#include "libguile/list.h"
-#include "libguile/deprecation.h"
-#include "libguile/dynwind.h"
-
-#include "libguile/validate.h"
-#include "libguile/unif.h"
-#include "libguile/ramap.h"
-#include "libguile/print.h"
-#include "libguile/read.h"
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#ifdef HAVE_IO_H
-#include <io.h>
-#endif
-
-
-/* The set of uniform scm_vector types is:
- *  Vector of:          Called:   Replaced by:
- * unsigned char       string
- * char                        byvect     s8 or u8, depending on signedness of 
'char'
- * boolean             bvect      
- * signed long         ivect      s32
- * unsigned long       uvect      u32
- * float               fvect      f32
- * double              dvect      d32
- * complex double      cvect      c64
- * short               svect      s16
- * long long           llvect     s64
- */
-
-scm_t_bits scm_i_tc16_array;
-scm_t_bits scm_i_tc16_enclosed_array;
-
-#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | 
SCM_I_ARRAY_FLAG_CONTIGUOUS))
-#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~SCM_I_ARRAY_FLAG_CONTIGUOUS))
-
-typedef SCM creator_proc (SCM len, SCM fill);
-
-struct {
-  char *type_name;
-  SCM type;
-  creator_proc *creator;
-} type_creator_table[] = {
-  { "a", SCM_UNSPECIFIED, scm_make_string },
-  { "b", SCM_UNSPECIFIED, scm_make_bitvector },
-  { "u8", SCM_UNSPECIFIED, scm_make_u8vector },
-  { "s8", SCM_UNSPECIFIED, scm_make_s8vector },
-  { "u16", SCM_UNSPECIFIED, scm_make_u16vector },
-  { "s16", SCM_UNSPECIFIED, scm_make_s16vector },
-  { "u32", SCM_UNSPECIFIED, scm_make_u32vector },
-  { "s32", SCM_UNSPECIFIED, scm_make_s32vector },
-  { "u64", SCM_UNSPECIFIED, scm_make_u64vector },
-  { "s64", SCM_UNSPECIFIED, scm_make_s64vector },
-  { "f32", SCM_UNSPECIFIED, scm_make_f32vector },
-  { "f64", SCM_UNSPECIFIED, scm_make_f64vector },
-  { "c32", SCM_UNSPECIFIED, scm_make_c32vector },
-  { "c64", SCM_UNSPECIFIED, scm_make_c64vector },
-  { "vu8", SCM_UNSPECIFIED, scm_make_bytevector },
-  { NULL }
-};
-
-static void
-init_type_creator_table ()
-{
-  int i;
-  for (i = 0; type_creator_table[i].type_name; i++)
-    {
-      SCM sym = scm_from_locale_symbol (type_creator_table[i].type_name);
-      type_creator_table[i].type = scm_permanent_object (sym);
-    }
-}
-
-static creator_proc *
-type_to_creator (SCM type)
-{
-  int i;
-
-  if (scm_is_eq (type, SCM_BOOL_T))
-    return scm_make_vector;
-  for (i = 0; type_creator_table[i].type_name; i++)
-    if (scm_is_eq (type, type_creator_table[i].type))
-      return type_creator_table[i].creator;
-
-  scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (type));
-}
-
-static SCM
-make_typed_vector (SCM type, size_t len)
-{
-  creator_proc *creator = type_to_creator (type);
-  return creator (scm_from_size_t (len), SCM_UNDEFINED);
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_SYMBOL (scm_sym_s, "s");
-SCM_SYMBOL (scm_sym_l, "l");
-
-static int
-singp (SCM obj)
-{
-  if (!SCM_REALP (obj))
-    return 0;
-  else
-    {
-      double x = SCM_REAL_VALUE (obj);
-      float fx = x;
-      return (- SCM_FLTMAX < x) && (x < SCM_FLTMAX) && (fx == x);
-    }
-}
-
-SCM_API int scm_i_inump (SCM obj);
-SCM_API scm_t_signed_bits scm_i_inum (SCM obj);
-
-static SCM
-prototype_to_type (SCM proto)
-{
-  const char *type_name;
-
-  if (scm_is_eq (proto, SCM_BOOL_T))
-    type_name = "b";
-  else if (scm_is_eq (proto, SCM_MAKE_CHAR (0)))
-    type_name = "s8";
-  else if (SCM_CHARP (proto))
-    type_name = "a";
-  else if (scm_i_inump (proto))
-    {
-      if (scm_i_inum (proto) > 0)
-       type_name = "u32";
-      else
-       type_name = "s32";
-    }
-  else if (scm_is_eq (proto, scm_sym_s))
-    type_name = "s16";
-  else if (scm_is_eq (proto, scm_sym_l))
-    type_name = "s64";
-  else if (SCM_REALP (proto)
-          || scm_is_true (scm_eqv_p (proto,
-                                     scm_divide (scm_from_int (1),
-                                                 scm_from_int (3)))))
-    {
-      if (singp (proto))
-       type_name = "f32";
-      else
-       type_name = "f64";
-    }
-  else if (SCM_COMPLEXP (proto))
-    type_name = "c64";
-  else if (scm_is_null (proto))
-    type_name = NULL;
-  else
-    type_name = NULL;
-
-  if (type_name)
-    return scm_from_locale_symbol (type_name);
-  else
-    return SCM_BOOL_T;
-}
-
-static SCM
-scm_i_get_old_prototype (SCM uvec)
-{
-  if (scm_is_bitvector (uvec))
-    return SCM_BOOL_T;
-  else if (scm_is_string (uvec))
-    return SCM_MAKE_CHAR ('a');
-  else if (scm_is_true (scm_s8vector_p (uvec)))
-    return SCM_MAKE_CHAR ('\0');
-  else if (scm_is_true (scm_s16vector_p (uvec)))
-    return scm_sym_s;
-  else if (scm_is_true (scm_u32vector_p (uvec)))
-    return scm_from_int (1);
-  else if (scm_is_true (scm_s32vector_p (uvec)))
-    return scm_from_int (-1);
-  else if (scm_is_true (scm_s64vector_p (uvec)))
-    return scm_sym_l;
-  else if (scm_is_true (scm_f32vector_p (uvec)))
-    return scm_from_double (1.0);
-  else if (scm_is_true (scm_f64vector_p (uvec)))
-    return scm_divide (scm_from_int (1), scm_from_int (3));
-  else if (scm_is_true (scm_c64vector_p (uvec)))
-    return scm_c_make_rectangular (0, 1);
-  else if (scm_is_vector (uvec))
-    return SCM_EOL;
-  else
-    scm_misc_error (NULL, "~a has no prototype", scm_list_1 (uvec));
-}
-
-SCM
-scm_make_uve (long k, SCM prot)
-#define FUNC_NAME "scm_make_uve"
-{
-  scm_c_issue_deprecation_warning
-    ("`scm_make_uve' is deprecated, see the manual for alternatives.");
-
-  return make_typed_vector (prototype_to_type (prot), k);
-}
-#undef FUNC_NAME
-
-#endif
-
-int
-scm_is_array (SCM obj)
-{
-  return (SCM_I_ENCLOSED_ARRAYP (obj)
-         || SCM_I_ARRAYP (obj)
-         || scm_is_generalized_vector (obj));
-}
-
-int
-scm_is_typed_array (SCM obj, SCM type)
-{
-  if (SCM_I_ENCLOSED_ARRAYP (obj))
-    {
-      /* Enclosed arrays are arrays but are not of any type.
-      */
-      return 0;
-    }
-
-  /* Get storage vector. 
-   */
-  if (SCM_I_ARRAYP (obj))
-    obj = SCM_I_ARRAY_V (obj);
-
-  /* It must be a generalized vector (which includes vectors, strings, etc).
-   */
-  if (!scm_is_generalized_vector (obj))
-    return 0;
-
-  return scm_is_eq (type, scm_i_generalized_vector_type (obj));
-}
-
-static SCM
-enclosed_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return scm_i_cvref (SCM_I_ARRAY_V (h->array), pos + h->base, 1);
-}
-
-static SCM
-vector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return ((const SCM *)h->elements)[pos];
-}
-
-static SCM
-string_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  pos += h->base;
-  if (SCM_I_ARRAYP (h->array))
-    return scm_c_string_ref (SCM_I_ARRAY_V (h->array), pos);
-  else
-    return scm_c_string_ref (h->array, pos);
-}
-
-static SCM
-bitvector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  pos += scm_array_handle_bit_elements_offset (h);
-  return
-    scm_from_bool (((scm_t_uint32 *)h->elements)[pos/32] & (1l << (pos % 32)));
-}
-
-static SCM
-bytevector_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  return scm_from_uint8 (((scm_t_uint8 *) h->elements)[pos]);
-}
-
-static SCM
-memoize_ref (scm_t_array_handle *h, ssize_t pos)
-{
-  SCM v = h->array;
-
-  if (SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      h->ref = enclosed_ref;
-      return enclosed_ref (h, pos);
-    }
-
-  if (SCM_I_ARRAYP (v))
-    v = SCM_I_ARRAY_V (v);
-
-  if (scm_is_vector (v))
-    {
-      h->elements = scm_array_handle_elements (h);
-      h->ref = vector_ref;
-    }
-  else if (scm_is_uniform_vector (v))
-    {
-      h->elements = scm_array_handle_uniform_elements (h);
-      h->ref = scm_i_uniform_vector_ref_proc (v);
-    }
-  else if (scm_is_string (v))
-    {
-      h->ref = string_ref;
-    }
-  else if (scm_is_bitvector (v))
-    {
-      h->elements = scm_array_handle_bit_elements (h);
-      h->ref = bitvector_ref;
-    }
-  else if (scm_is_bytevector (v))
-    {
-      h->elements = scm_array_handle_uniform_elements (h);
-      h->ref = bytevector_ref;
-    }
-  else
-    scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
-  return h->ref (h, pos);
-}
-
-static void
-enclosed_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-enclosed array");
-}
-
-static void
-vector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  ((SCM *)h->writable_elements)[pos] = val;
-}
-
-static void
-string_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  pos += h->base;
-  if (SCM_I_ARRAYP (h->array))
-    scm_c_string_set_x (SCM_I_ARRAY_V (h->array), pos, val);
-  else
-    scm_c_string_set_x (h->array, pos, val);
-}
-
-static void
-bitvector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_t_uint32 mask;
-  pos += scm_array_handle_bit_elements_offset (h);
-  mask = 1l << (pos % 32);
-  if (scm_to_bool (val))
-    ((scm_t_uint32 *)h->writable_elements)[pos/32] |= mask;
-  else
-    ((scm_t_uint32 *)h->writable_elements)[pos/32] &= ~mask;
-}
-
-static void
-bytevector_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  scm_t_uint8 c_value;
-  scm_t_uint8 *elements;
-
-  c_value = scm_to_uint8 (val);
-  elements = (scm_t_uint8 *) h->elements;
-  elements[pos] = (scm_t_uint8) c_value;
-}
-
-static void
-memoize_set (scm_t_array_handle *h, ssize_t pos, SCM val)
-{
-  SCM v = h->array;
-
-  if (SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      h->set = enclosed_set;
-      enclosed_set (h, pos, val);
-      return;
-    }
-
-  if (SCM_I_ARRAYP (v))
-    v = SCM_I_ARRAY_V (v);
-
-  if (scm_is_vector (v))
-    {
-      h->writable_elements = scm_array_handle_writable_elements (h);
-      h->set = vector_set;
-    }
-  else if (scm_is_uniform_vector (v))
-    {
-      h->writable_elements = scm_array_handle_uniform_writable_elements (h);
-      h->set = scm_i_uniform_vector_set_proc (v);
-    }
-  else if (scm_is_string (v))
-    {
-      h->set = string_set;
-    }
-  else if (scm_is_bitvector (v))
-    {
-      h->writable_elements = scm_array_handle_bit_writable_elements (h);
-      h->set = bitvector_set;
-    }
-  else if (scm_is_bytevector (v))
-    {
-      h->elements = scm_array_handle_uniform_writable_elements (h);
-      h->set = bytevector_set;
-    }
-  else
-    scm_misc_error (NULL, "unknown array type: ~a", scm_list_1 (h->array));
-
-  h->set (h, pos, val);
-}
-
-void
-scm_array_get_handle (SCM array, scm_t_array_handle *h)
-{
-  h->array = array;
-  h->ref = memoize_ref;
-  h->set = memoize_set;
-
-  if (SCM_I_ARRAYP (array) || SCM_I_ENCLOSED_ARRAYP (array))
-    {
-      h->dims = SCM_I_ARRAY_DIMS (array);
-      h->base = SCM_I_ARRAY_BASE (array);
-    }
-  else if (scm_is_generalized_vector (array))
-    {
-      h->dim0.lbnd = 0;
-      h->dim0.ubnd = scm_c_generalized_vector_length (array) - 1;
-      h->dim0.inc = 1;
-      h->dims = &h->dim0;
-      h->base = 0;
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, array, "array");
-}
-
-void
-scm_array_handle_release (scm_t_array_handle *h)
-{
-  /* Nothing to do here until arrays need to be reserved for real.
-   */
-}
-
-size_t
-scm_array_handle_rank (scm_t_array_handle *h)
-{
-  if (SCM_I_ARRAYP (h->array) || SCM_I_ENCLOSED_ARRAYP (h->array))
-    return SCM_I_ARRAY_NDIM (h->array);
-  else
-    return 1;
-}
-
-scm_t_array_dim *
-scm_array_handle_dims (scm_t_array_handle *h)
-{
-  return h->dims;
-}
-
-const SCM *
-scm_array_handle_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_I_IS_VECTOR (vec))
-    return SCM_I_VECTOR_ELTS (vec) + h->base;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
-SCM *
-scm_array_handle_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (SCM_I_IS_VECTOR (vec))
-    return SCM_I_VECTOR_WELTS (vec) + h->base;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
-           (SCM obj, SCM prot),
-           "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
-           "not.")
-#define FUNC_NAME s_scm_array_p
-{
-  if (!SCM_UNBNDP (prot))
-    {
-      scm_c_issue_deprecation_warning
-       ("Using prototypes with `array?' is deprecated."
-        "  Use `typed-array?' instead.");
-
-      return scm_typed_array_p (obj, prototype_to_type (prot));
-    }
-  else
-    return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-#else /* !SCM_ENABLE_DEPRECATED */
-
-/* We keep the old 2-argument C prototype for a while although the old
-   PROT argument is always ignored now.  C code should probably use
-   scm_is_array or scm_is_typed_array anyway.
-*/
-
-static SCM scm_i_array_p (SCM obj);
-
-SCM_DEFINE (scm_i_array_p, "array?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} if the @var{obj} is an array, and @code{#f} if\n"
-           "not.")
-#define FUNC_NAME s_scm_i_array_p
-{
-  return scm_from_bool (scm_is_array (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_array_p (SCM obj, SCM prot)
-{
-  return scm_from_bool (scm_is_array (obj));
-}
-
-#endif /* !SCM_ENABLE_DEPRECATED */
-
-
-SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
-           (SCM obj, SCM type),
-           "Return @code{#t} if the @var{obj} is an array of type\n"
-           "@var{type}, and @code{#f} if not.")
-#define FUNC_NAME s_scm_typed_array_p
-{
-  return scm_from_bool (scm_is_typed_array (obj, type));
-}
-#undef FUNC_NAME
-
-size_t
-scm_c_array_rank (SCM array)
-{
-  scm_t_array_handle handle;
-  size_t res;
-
-  scm_array_get_handle (array, &handle);
-  res = scm_array_handle_rank (&handle);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
-           (SCM array),
-           "Return the number of dimensions of the array @var{array.}\n")
-#define FUNC_NAME s_scm_array_rank
-{
-  return scm_from_size_t (scm_c_array_rank (array));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
-           (SCM ra),
-           "@code{array-dimensions} is similar to @code{array-shape} but 
replaces\n"
-           "elements with a @code{0} minimum with one greater than the 
maximum. So:\n"
-           "@lisp\n"
-           "(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 
5)\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_array_dimensions
-{
-  scm_t_array_handle handle;
-  scm_t_array_dim *s;
-  SCM res = SCM_EOL;
-  size_t k;
-      
-  scm_array_get_handle (ra, &handle);
-  s = scm_array_handle_dims (&handle);
-  k = scm_array_handle_rank (&handle);
-
-  while (k--)
-    res = scm_cons (s[k].lbnd
-                   ? scm_cons2 (scm_from_ssize_t (s[k].lbnd),
-                                scm_from_ssize_t (s[k].ubnd),
-                                SCM_EOL)
-                   : scm_from_ssize_t (1 + s[k].ubnd),
-                   res);
-
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
-           (SCM ra),
-           "Return the root vector of a shared array.")
-#define FUNC_NAME s_scm_shared_array_root
-{
-  if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
-    return SCM_I_ARRAY_V (ra);
-  else if (scm_is_generalized_vector (ra))
-    return ra;
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
-           (SCM ra),
-           "Return the root vector index of the first element in the array.")
-#define FUNC_NAME s_scm_shared_array_offset
-{
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (ra, &handle);
-  res = scm_from_size_t (handle.base);
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, 
-           (SCM ra),
-           "For each dimension, return the distance between elements in the 
root vector.")
-#define FUNC_NAME s_scm_shared_array_increments
-{
-  scm_t_array_handle handle;
-  SCM res = SCM_EOL;
-  size_t k;
-  scm_t_array_dim *s;
-
-  scm_array_get_handle (ra, &handle);
-  k = scm_array_handle_rank (&handle);
-  s = scm_array_handle_dims (&handle);
-  while (k--)
-    res = scm_cons (scm_from_ssize_t (s[k].inc), res);
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-ssize_t
-scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
-{
-  scm_t_array_dim *s = scm_array_handle_dims (h);
-  ssize_t pos = 0, i;
-  size_t k = scm_array_handle_rank (h);
-  
-  while (k > 0 && scm_is_pair (indices))
-    {
-      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
-      pos += (i - s->lbnd) * s->inc;
-      k--;
-      s++;
-      indices = SCM_CDR (indices);
-    }
-  if (k > 0 || !scm_is_null (indices))
-    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
-                   scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
-  return pos;
-}
-
-SCM 
-scm_i_make_ra (int ndim, int enclosed)
-{
-  scm_t_bits tag = enclosed? scm_i_tc16_enclosed_array : scm_i_tc16_array;
-  SCM ra;
-  SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + tag,
-              scm_gc_malloc ((sizeof (scm_i_t_array) +
-                             ndim * sizeof (scm_t_array_dim)),
-                            "array"));
-  SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
-  return ra;
-}
-
-static char s_bad_spec[] = "Bad scm_array dimension";
-
-
-/* Increments will still need to be set. */
-
-static SCM 
-scm_i_shap2ra (SCM args)
-{
-  scm_t_array_dim *s;
-  SCM ra, spec, sp;
-  int ndim = scm_ilength (args);
-  if (ndim < 0)
-    scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-
-  ra = scm_i_make_ra (ndim, 0);
-  SCM_I_ARRAY_BASE (ra) = 0;
-  s = SCM_I_ARRAY_DIMS (ra);
-  for (; !scm_is_null (args); s++, args = SCM_CDR (args))
-    {
-      spec = SCM_CAR (args);
-      if (scm_is_integer (spec))
-       {
-         if (scm_to_long (spec) < 0)
-           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-         s->lbnd = 0;
-         s->ubnd = scm_to_long (spec) - 1;
-         s->inc = 1;
-       }
-      else
-       {
-         if (!scm_is_pair (spec) || !scm_is_integer (SCM_CAR (spec)))
-           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-         s->lbnd = scm_to_long (SCM_CAR (spec));
-         sp = SCM_CDR (spec);
-         if (!scm_is_pair (sp) 
-             || !scm_is_integer (SCM_CAR (sp))
-             || !scm_is_null (SCM_CDR (sp)))
-           scm_misc_error (NULL, s_bad_spec, SCM_EOL);
-         s->ubnd = scm_to_long (SCM_CAR (sp));
-         s->inc = 1;
-       }
-    }
-  return ra;
-}
-
-SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
-           (SCM type, SCM fill, SCM bounds),
-           "Create and return an array of type @var{type}.")
-#define FUNC_NAME s_scm_make_typed_array
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  creator_proc *creator;
-  SCM ra;
-  
-  creator = type_to_creator (type);
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-    {
-      s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-    }
-
-  if (scm_is_eq (fill, SCM_UNSPECIFIED))
-    fill = SCM_UNDEFINED;
-
-  SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), fill);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
-      return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM
-scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
-                                 size_t byte_len)
-#define FUNC_NAME "scm_from_contiguous_typed_array"
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  creator_proc *creator;
-  SCM ra;
-  scm_t_array_handle h;
-  void *base;
-  size_t sz;
-  
-  creator = type_to_creator (type);
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-    {
-      s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-      rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-    }
-  SCM_I_ARRAY_V (ra) = creator (scm_from_size_t (rlen), SCM_UNDEFINED);
-
-
-  scm_array_get_handle (ra, &h);
-  base = scm_array_handle_uniform_writable_elements (&h);
-  sz = scm_array_handle_uniform_element_size (&h);
-  scm_array_handle_release (&h);
-
-  if (byte_len % sz)
-    SCM_MISC_ERROR ("byte length not a multiple of the unit size", SCM_EOL);
-  if (byte_len / sz != rlen)
-    SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
-
-  memcpy (base, bytes, byte_len);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
-      return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
-           (SCM fill, SCM bounds),
-           "Create and return an array.")
-#define FUNC_NAME s_scm_make_array
-{
-  return scm_make_typed_array (SCM_BOOL_T, fill, bounds);
-}
-#undef FUNC_NAME
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 
1, 0,
-           (SCM dims, SCM prot, SCM fill),
-           "@deffnx {Scheme Procedure} make-uniform-vector length prototype 
[fill]\n"
-           "Create and return a uniform array or vector of type\n"
-           "corresponding to @var{prototype} with dimensions @var{dims} or\n"
-           "length @var{length}.  If @var{fill} is supplied, it's used to\n"
-           "fill the array, otherwise @var{prototype} is used.")
-#define FUNC_NAME s_scm_dimensions_to_uniform_array
-{
-  scm_c_issue_deprecation_warning
-    ("`dimensions->uniform-array' is deprecated.  "
-     "Use `make-typed-array' instead.");
-
-  if (scm_is_integer (dims))
-    dims = scm_list_1 (dims);
-
-  if (SCM_UNBNDP (fill))
-    {
-      /* Using #\nul as the prototype yields a s8 array, but numeric
-        arrays can't store characters, so we have to special case this.
-      */
-      if (scm_is_eq (prot, SCM_MAKE_CHAR (0)))
-       fill = scm_from_int (0);
-      else
-       fill = prot;
-    }
-
-  return scm_make_typed_array (prototype_to_type (prot), fill, dims);
-}
-#undef FUNC_NAME
-
-#endif
-
-static void 
-scm_i_ra_set_contp (SCM ra)
-{
-  size_t k = SCM_I_ARRAY_NDIM (ra);
-  if (k)
-    {
-      long inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
-      while (k--)
-       {
-         if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
-           {
-             SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
-             return;
-           }
-         inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd 
-                 - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
-       }
-    }
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-}
-
-
-SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
-           (SCM oldra, SCM mapfunc, SCM dims),
-           "@code{make-shared-array} can be used to create shared subarrays of 
other\n"
-           "arrays.  The @var{mapper} is a function that translates 
coordinates in\n"
-           "the new array into coordinates in the old array.  A @var{mapper} 
must be\n"
-           "linear, and its range must stay within the bounds of the old 
array, but\n"
-           "it can be otherwise arbitrary.  A simple example:\n"
-           "@lisp\n"
-           "(define fred (make-array #f 8 8))\n"
-           "(define freds-diagonal\n"
-           "  (make-shared-array fred (lambda (i) (list i i)) 8))\n"
-           "(array-set! freds-diagonal 'foo 3)\n"
-           "(array-ref fred 3 3) @result{} foo\n"
-           "(define freds-center\n"
-           "  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 
2))\n"
-           "(array-ref freds-center 0 0) @result{} foo\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_make_shared_array
-{
-  scm_t_array_handle old_handle;
-  SCM ra;
-  SCM inds, indptr;
-  SCM imap;
-  size_t k;
-  ssize_t i;
-  long old_base, old_min, new_min, old_max, new_max;
-  scm_t_array_dim *s;
-
-  SCM_VALIDATE_REST_ARGUMENT (dims);
-  SCM_VALIDATE_PROC (2, mapfunc);
-  ra = scm_i_shap2ra (dims);
-
-  scm_array_get_handle (oldra, &old_handle);
-
-  if (SCM_I_ARRAYP (oldra))
-    {
-      SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
-      old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
-      s = scm_array_handle_dims (&old_handle);
-      k = scm_array_handle_rank (&old_handle);
-      while (k--)
-       {
-         if (s[k].inc > 0)
-           old_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-         else
-           old_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-       }
-    }
-  else
-    {
-      SCM_I_ARRAY_V (ra) = oldra;
-      old_base = old_min = 0;
-      old_max = scm_c_generalized_vector_length (oldra) - 1;
-    }
-
-  inds = SCM_EOL;
-  s = SCM_I_ARRAY_DIMS (ra);
-  for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
-    {
-      inds = scm_cons (scm_from_long (s[k].lbnd), inds);
-      if (s[k].ubnd < s[k].lbnd)
-       {
-         if (1 == SCM_I_ARRAY_NDIM (ra))
-           ra = make_typed_vector (scm_array_type (ra), 0);
-         else
-           SCM_I_ARRAY_V (ra) = make_typed_vector (scm_array_type (ra), 0);
-         scm_array_handle_release (&old_handle);
-         return ra;
-       }
-    }
-
-  imap = scm_apply_0 (mapfunc, scm_reverse (inds));
-  i = scm_array_handle_pos (&old_handle, imap);
-  SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
-  indptr = inds;
-  k = SCM_I_ARRAY_NDIM (ra);
-  while (k--)
-    {
-      if (s[k].ubnd > s[k].lbnd)
-       {
-         SCM_SETCAR (indptr, scm_sum (SCM_CAR (indptr), scm_from_int (1)));
-         imap = scm_apply_0 (mapfunc, scm_reverse (inds));
-         s[k].inc = scm_array_handle_pos (&old_handle, imap) - i;
-         i += s[k].inc;
-         if (s[k].inc > 0)
-           new_max += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-         else
-           new_min += (s[k].ubnd - s[k].lbnd) * s[k].inc;
-       }
-      else
-       s[k].inc = new_max - new_min + 1;       /* contiguous by default */
-      indptr = SCM_CDR (indptr);
-    }
-
-  scm_array_handle_release (&old_handle);
-
-  if (old_min > new_min || old_max < new_max)
-    SCM_MISC_ERROR ("mapping out of range", SCM_EOL);
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    {
-      SCM v = SCM_I_ARRAY_V (ra);
-      size_t length = scm_c_generalized_vector_length (v);
-      if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
-       return v;
-      if (s->ubnd < s->lbnd)
-       return make_typed_vector (scm_array_type (ra), 0);
-    }
-  scm_i_ra_set_contp (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
-
-/* args are RA . DIMS */
-SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, 
-           (SCM ra, SCM args),
-           "Return an array sharing contents with @var{array}, but with\n"
-           "dimensions arranged in a different order.  There must be one\n"
-           "@var{dim} argument for each dimension of @var{array}.\n"
-           "@var{dim0}, @var{dim1}, @dots{} should be integers between 0\n"
-           "and the rank of the array to be returned.  Each integer in that\n"
-           "range must appear at least once in the argument list.\n"
-           "\n"
-           "The values of @var{dim0}, @var{dim1}, @dots{} correspond to\n"
-           "dimensions in the array to be returned, their positions in the\n"
-           "argument list to dimensions of @var{array}.  Several @var{dim}s\n"
-           "may have the same value, in which case the returned array will\n"
-           "have smaller rank than @var{array}.\n"
-           "\n"
-           "@lisp\n"
-           "(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))\n"
-           "(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)\n"
-           "(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) 
@result{}\n"
-           "                #2((a 4) (b 5) (c 6))\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_transpose_array
-{
-  SCM res, vargs;
-  scm_t_array_dim *s, *r;
-  int ndim, i, k;
-
-  SCM_VALIDATE_REST_ARGUMENT (args);
-  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
-
-  if (scm_is_generalized_vector (ra))
-    {
-      /* Make sure that we are called with a single zero as
-        arguments. 
-      */
-      if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
-       SCM_WRONG_NUM_ARGS ();
-      SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
-      SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
-      return ra;
-    }
-
-  if (SCM_I_ARRAYP (ra) || SCM_I_ENCLOSED_ARRAYP (ra))
-    {
-      vargs = scm_vector (args);
-      if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
-       SCM_WRONG_NUM_ARGS ();
-      ndim = 0;
-      for (k = 0; k < SCM_I_ARRAY_NDIM (ra); k++)
-       {
-         i = scm_to_signed_integer (SCM_SIMPLE_VECTOR_REF (vargs, k),
-                                    0, SCM_I_ARRAY_NDIM(ra));
-         if (ndim < i)
-           ndim = i;
-       }
-      ndim++;
-      res = scm_i_make_ra (ndim, 0);
-      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
-      for (k = ndim; k--;)
-       {
-         SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
-         SCM_I_ARRAY_DIMS (res)[k].ubnd = -1;
-       }
-      for (k = SCM_I_ARRAY_NDIM (ra); k--;)
-       {
-         i = scm_to_int (SCM_SIMPLE_VECTOR_REF (vargs, k));
-         s = &(SCM_I_ARRAY_DIMS (ra)[k]);
-         r = &(SCM_I_ARRAY_DIMS (res)[i]);
-         if (r->ubnd < r->lbnd)
-           {
-             r->lbnd = s->lbnd;
-             r->ubnd = s->ubnd;
-             r->inc = s->inc;
-             ndim--;
-           }
-         else
-           {
-             if (r->ubnd > s->ubnd)
-               r->ubnd = s->ubnd;
-             if (r->lbnd < s->lbnd)
-               {
-                 SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
-                 r->lbnd = s->lbnd;
-               }
-             r->inc += s->inc;
-           }
-       }
-      if (ndim > 0)
-       SCM_MISC_ERROR ("bad argument list", SCM_EOL);
-      scm_i_ra_set_contp (res);
-      return res;
-    }
-
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-/* args are RA . AXES */
-SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, 
-           (SCM ra, SCM axes),
-           "@var{dim0}, @var{dim1} @dots{} should be nonnegative integers less 
than\n"
-           "the rank of @var{array}.  @var{enclose-array} returns an array\n"
-           "resembling an array of shared arrays.  The dimensions of each 
shared\n"
-           "array are the same as the @var{dim}th dimensions of the original 
array,\n"
-           "the dimensions of the outer array are the same as those of the 
original\n"
-           "array that did not match a @var{dim}.\n\n"
-           "An enclosed array is not a general Scheme array.  Its elements may 
not\n"
-           "be set using @code{array-set!}.  Two references to the same 
element of\n"
-           "an enclosed array will be @code{equal?} but will not in general 
be\n"
-           "@code{eq?}.  The value returned by @var{array-prototype} when 
given an\n"
-           "enclosed array is unspecified.\n\n"
-           "examples:\n"
-           "@lisp\n"
-           "(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) 
@result{}\n"
-           "   #<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) 
#1(3 6))>\n\n"
-           "(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) 
@result{}\n"
-           "   #<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 
6))>\n"
-           "@end lisp")
-#define FUNC_NAME s_scm_enclose_array
-{
-  SCM axv, res, ra_inr;
-  const char *c_axv;
-  scm_t_array_dim vdim, *s = &vdim;
-  int ndim, j, k, ninr, noutr;
-
-  SCM_VALIDATE_REST_ARGUMENT (axes);
-  if (scm_is_null (axes))
-    axes = scm_cons ((SCM_I_ARRAYP (ra) ? scm_from_size_t (SCM_I_ARRAY_NDIM 
(ra) - 1) : SCM_INUM0), SCM_EOL);
-  ninr = scm_ilength (axes);
-  if (ninr < 0)
-    SCM_WRONG_NUM_ARGS ();
-  ra_inr = scm_i_make_ra (ninr, 0);
-
-  if (scm_is_generalized_vector (ra))
-    {
-      s->lbnd = 0;
-      s->ubnd = scm_c_generalized_vector_length (ra) - 1;
-      s->inc = 1;
-      SCM_I_ARRAY_V (ra_inr) = ra;
-      SCM_I_ARRAY_BASE (ra_inr) = 0;
-      ndim = 1;
-    }
-  else if (SCM_I_ARRAYP (ra))
-    {
-      s = SCM_I_ARRAY_DIMS (ra);
-      SCM_I_ARRAY_V (ra_inr) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (ra_inr) = SCM_I_ARRAY_BASE (ra);
-      ndim = SCM_I_ARRAY_NDIM (ra);
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-
-  noutr = ndim - ninr;
-  if (noutr < 0)
-    SCM_WRONG_NUM_ARGS ();
-  axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0));
-  res = scm_i_make_ra (noutr, 1);
-  SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra_inr);
-  SCM_I_ARRAY_V (res) = ra_inr;
-  for (k = 0; k < ninr; k++, axes = SCM_CDR (axes))
-    {
-      if (!scm_is_integer (SCM_CAR (axes)))
-       SCM_MISC_ERROR ("bad axis", SCM_EOL);
-      j = scm_to_int (SCM_CAR (axes));
-      SCM_I_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
-      SCM_I_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
-      SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
-      scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
-    }
-  c_axv = scm_i_string_chars (axv);
-  for (j = 0, k = 0; k < noutr; k++, j++)
-    {
-      while (c_axv[j])
-       j++;
-      SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
-      SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
-      SCM_I_ARRAY_DIMS (res)[k].inc = s[j].inc;
-    }
-  scm_remember_upto_here_1 (axv);
-  scm_i_ra_set_contp (ra_inr);
-  scm_i_ra_set_contp (res);
-  return res;
-}
-#undef FUNC_NAME
-
-
-
-SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, 
-           (SCM v, SCM args),
-           "Return @code{#t} if its arguments would be acceptable to\n"
-           "@code{array-ref}.")
-#define FUNC_NAME s_scm_array_in_bounds_p
-{
-  SCM res = SCM_BOOL_T;
-
-  SCM_VALIDATE_REST_ARGUMENT (args);
-
-  if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
-    {
-      size_t k, ndim = SCM_I_ARRAY_NDIM (v);
-      scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
-
-      for (k = 0; k < ndim; k++)
-       {
-         long ind;
-
-         if (!scm_is_pair (args))
-           SCM_WRONG_NUM_ARGS ();
-         ind = scm_to_long (SCM_CAR (args));
-         args = SCM_CDR (args);
-
-         if (ind < s[k].lbnd || ind > s[k].ubnd)
-           {
-             res = SCM_BOOL_F;
-             /* We do not stop the checking after finding a violation
-                since we want to validate the type-correctness and
-                number of arguments in any case.
-             */
-           }
-       }
-    }
-  else if (scm_is_generalized_vector (v))
-    {
-      /* Since real arrays have been covered above, all generalized
-        vectors are guaranteed to be zero-origin here.
-      */
-
-      long ind;
-
-      if (!scm_is_pair (args))
-       SCM_WRONG_NUM_ARGS ();
-      ind = scm_to_long (SCM_CAR (args));
-      args = SCM_CDR (args);
-      res = scm_from_bool (ind >= 0
-                          && ind < scm_c_generalized_vector_length (v));
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "array");
-
-  if (!scm_is_null (args))
-    SCM_WRONG_NUM_ARGS ();
-
-  return res;
-}
-#undef FUNC_NAME
-
-SCM 
-scm_i_cvref (SCM v, size_t pos, int enclosed)
-{
-  if (enclosed)
-    {
-      int k = SCM_I_ARRAY_NDIM (v);
-      SCM res = scm_i_make_ra (k, 0);
-      SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (v);
-      SCM_I_ARRAY_BASE (res) = pos;
-      while (k--)
-       {
-         SCM_I_ARRAY_DIMS (res)[k].ubnd = SCM_I_ARRAY_DIMS (v)[k].ubnd;
-         SCM_I_ARRAY_DIMS (res)[k].lbnd = SCM_I_ARRAY_DIMS (v)[k].lbnd;
-         SCM_I_ARRAY_DIMS (res)[k].inc = SCM_I_ARRAY_DIMS (v)[k].inc;
-       }
-      return res;
-    }
-  else
-    return scm_c_generalized_vector_ref (v, pos);
-}
-
-SCM_DEFINE (scm_array_ref, "array-ref", 1, 0, 1,
-           (SCM v, SCM args),
-           "Return the element at the @code{(index1, index2)} element in\n"
-           "@var{array}.")
-#define FUNC_NAME s_scm_array_ref
-{
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (v, &handle);
-  res = scm_array_handle_ref (&handle, scm_array_handle_pos (&handle, args));
-  scm_array_handle_release (&handle);
-  return res;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, 
-           (SCM v, SCM obj, SCM args),
-           "Set the element at the @code{(index1, index2)} element in 
@var{array} to\n"
-           "@var{new-value}.  The value returned by array-set! is 
unspecified.")
-#define FUNC_NAME s_scm_array_set_x           
-{
-  scm_t_array_handle handle;
-
-  scm_array_get_handle (v, &handle);
-  scm_array_handle_set (&handle, scm_array_handle_pos (&handle, args), obj);
-  scm_array_handle_release (&handle);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-/* attempts to unroll an array into a one-dimensional array.
-   returns the unrolled array or #f if it can't be done.  */
-  /* if strict is not SCM_UNDEFINED, return #f if returned array
-                    wouldn't have contiguous elements.  */
-SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
-           (SCM ra, SCM strict),
-           "If @var{array} may be @dfn{unrolled} into a one dimensional shared 
array\n"
-           "without changing their order (last subscript changing fastest), 
then\n"
-           "@code{array-contents} returns that shared array, otherwise it 
returns\n"
-           "@code{#f}.  All arrays made by @var{make-array} and\n"
-           "@var{make-uniform-array} may be unrolled, some arrays made by\n"
-           "@var{make-shared-array} may not be.\n\n"
-           "If the optional argument @var{strict} is provided, a shared array 
will\n"
-           "be returned only if its elements are stored internally contiguous 
in\n"
-           "memory.")
-#define FUNC_NAME s_scm_array_contents
-{
-  SCM sra;
-
-  if (scm_is_generalized_vector (ra))
-    return ra;
-
-  if (SCM_I_ARRAYP (ra))
-    {
-      size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
-      if (!SCM_I_ARRAYP (ra) || !SCM_I_ARRAY_CONTP (ra))
-       return SCM_BOOL_F;
-      for (k = 0; k < ndim; k++)
-       len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 
1;
-      if (!SCM_UNBNDP (strict))
-       {
-         if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
-           return SCM_BOOL_F;
-         if (scm_is_bitvector (SCM_I_ARRAY_V (ra)))
-           {
-             if (len != scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) ||
-                 SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT ||
-                 len % SCM_LONG_BIT)
-               return SCM_BOOL_F;
-           }
-       }
-      
-      {
-       SCM v = SCM_I_ARRAY_V (ra);
-       size_t length = scm_c_generalized_vector_length (v);
-       if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS 
(ra)->inc)
-         return v;
-      }
-      
-      sra = scm_i_make_ra (1, 0);
-      SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
-      SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
-      SCM_I_ARRAY_V (sra) = SCM_I_ARRAY_V (ra);
-      SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
-      SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim - 
1].inc : 1);
-      return sra;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-
-SCM 
-scm_ra2contig (SCM ra, int copy)
-{
-  SCM ret;
-  long inc = 1;
-  size_t k, len = 1;
-  for (k = SCM_I_ARRAY_NDIM (ra); k--;)
-    len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
-  k = SCM_I_ARRAY_NDIM (ra);
-  if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 
1].inc)))
-    {
-      if (!scm_is_bitvector (SCM_I_ARRAY_V (ra)))
-       return ra;
-      if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) &&
-          0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT &&
-          0 == len % SCM_LONG_BIT))
-       return ra;
-    }
-  ret = scm_i_make_ra (k, 0);
-  SCM_I_ARRAY_BASE (ret) = 0;
-  while (k--)
-    {
-      SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
-      SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd;
-      SCM_I_ARRAY_DIMS (ret)[k].inc = inc;
-      inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1;
-    }
-  SCM_I_ARRAY_V (ret) = make_typed_vector (scm_array_type (ra), inc);
-  if (copy)
-    scm_array_copy_x (ra, ret);
-  return ret;
-}
-
-
-
-SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
-           (SCM ura, SCM port_or_fd, SCM start, SCM end),
-           "@deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] 
[start] [end]\n"
-           "Attempt to read all elements of @var{ura}, in lexicographic order, 
as\n"
-           "binary objects from @var{port-or-fdes}.\n"
-           "If an end of file is encountered,\n"
-           "the objects up to that point are put into @var{ura}\n"
-           "(starting at the beginning) and the remainder of the array is\n"
-           "unchanged.\n\n"
-           "The optional arguments @var{start} and @var{end} allow\n"
-           "a specified region of a vector (or linearized array) to be read,\n"
-           "leaving the remainder of the vector unchanged.\n\n"
-           "@code{uniform-array-read!} returns the number of objects read.\n"
-           "@var{port-or-fdes} may be omitted, in which case it defaults to 
the value\n"
-           "returned by @code{(current-input-port)}.")
-#define FUNC_NAME s_scm_uniform_array_read_x
-{
-  if (SCM_UNBNDP (port_or_fd))
-    port_or_fd = scm_current_input_port ();
-
-  if (scm_is_uniform_vector (ura))
-    {
-      return scm_uniform_vector_read_x (ura, port_or_fd, start, end);
-    }
-  else if (SCM_I_ARRAYP (ura))
-    {
-      size_t base, vlen, cstart, cend;
-      SCM cra, ans;
-      
-      cra = scm_ra2contig (ura, 0);
-      base = SCM_I_ARRAY_BASE (cra);
-      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
-       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
-
-      cstart = 0;
-      cend = vlen;
-      if (!SCM_UNBNDP (start))
-       {
-         cstart = scm_to_unsigned_integer (start, 0, vlen);
-         if (!SCM_UNBNDP (end))
-           cend = scm_to_unsigned_integer (end, cstart, vlen);
-       }
-
-      ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd,
-                                      scm_from_size_t (base + cstart),
-                                      scm_from_size_t (base + cend));
-
-      if (!scm_is_eq (cra, ura))
-       scm_array_copy_x (cra, ura);
-      return ans;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ura))
-    scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");    
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
-           (SCM ura, SCM port_or_fd, SCM start, SCM end),
-           "Writes all elements of @var{ura} as binary objects to\n"
-           "@var{port-or-fdes}.\n\n"
-           "The optional arguments @var{start}\n"
-           "and @var{end} allow\n"
-           "a specified region of a vector (or linearized array) to be 
written.\n\n"
-           "The number of objects actually written is returned.\n"
-           "@var{port-or-fdes} may be\n"
-           "omitted, in which case it defaults to the value returned by\n"
-           "@code{(current-output-port)}.")
-#define FUNC_NAME s_scm_uniform_array_write
-{
-  if (SCM_UNBNDP (port_or_fd))
-    port_or_fd = scm_current_output_port ();
-
-  if (scm_is_uniform_vector (ura))
-    {
-      return scm_uniform_vector_write (ura, port_or_fd, start, end);
-    }
-  else if (SCM_I_ARRAYP (ura))
-    {
-      size_t base, vlen, cstart, cend;
-      SCM cra, ans;
-      
-      cra = scm_ra2contig (ura, 1);
-      base = SCM_I_ARRAY_BASE (cra);
-      vlen = SCM_I_ARRAY_DIMS (cra)->inc *
-       (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1);
-
-      cstart = 0;
-      cend = vlen;
-      if (!SCM_UNBNDP (start))
-       {
-         cstart = scm_to_unsigned_integer (start, 0, vlen);
-         if (!SCM_UNBNDP (end))
-           cend = scm_to_unsigned_integer (end, cstart, vlen);
-       }
-
-      ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd,
-                                     scm_from_size_t (base + cstart),
-                                     scm_from_size_t (base + cend));
-
-      return ans;
-    }
-  else if (SCM_I_ENCLOSED_ARRAYP (ura))
-    scm_wrong_type_arg_msg (NULL, 0, ura, "non-enclosed array");    
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ura, "array");
-}
-#undef FUNC_NAME
-
-
-/** Bit vectors */
-
-static scm_t_bits scm_tc16_bitvector;
-
-#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
-#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
-#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
-
-
-static int
-bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
-{
-  size_t bit_len = BITVECTOR_LENGTH (vec);
-  size_t word_len = (bit_len+31)/32;
-  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
-  size_t i, j;
-
-  scm_puts ("#*", port);
-  for (i = 0; i < word_len; i++, bit_len -= 32)
-    {
-      scm_t_uint32 mask = 1;
-      for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
-       scm_putc ((bits[i] & mask)? '1' : '0', port);
-    }
-    
-  return 1;
-}
-
-static SCM
-bitvector_equalp (SCM vec1, SCM vec2)
-{
-  size_t bit_len = BITVECTOR_LENGTH (vec1);
-  size_t word_len = (bit_len + 31) / 32;
-  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
-  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
-  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
-
-  /* compare lengths */
-  if (BITVECTOR_LENGTH (vec2) != bit_len)
-    return SCM_BOOL_F;
-  /* avoid underflow in word_len-1 below. */
-  if (bit_len == 0)
-    return SCM_BOOL_T;
-  /* compare full words */
-  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
-    return SCM_BOOL_F;
-  /* compare partial last words */
-  if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
-    return SCM_BOOL_F;
-  return SCM_BOOL_T;
-}
-
-int
-scm_is_bitvector (SCM vec)
-{
-  return IS_BITVECTOR (vec);
-}
-
-SCM_DEFINE (scm_bitvector_p, "bitvector?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} when @var{obj} is a bitvector, else\n"
-           "return @code{#f}.")
-#define FUNC_NAME s_scm_bitvector_p
-{
-  return scm_from_bool (scm_is_bitvector (obj));
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_make_bitvector (size_t len, SCM fill)
-{
-  size_t word_len = (len + 31) / 32;
-  scm_t_uint32 *bits;
-  SCM res;
-
-  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
-                       "bitvector");
-  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
-
-  if (!SCM_UNBNDP (fill))
-    scm_bitvector_fill_x (res, fill);
-      
-  return res;
-}
-
-SCM_DEFINE (scm_make_bitvector, "make-bitvector", 1, 1, 0,
-           (SCM len, SCM fill),
-           "Create a new bitvector of length @var{len} and\n"
-           "optionally initialize all elements to @var{fill}.")
-#define FUNC_NAME s_scm_make_bitvector
-{
-  return scm_c_make_bitvector (scm_to_size_t (len), fill);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
-           (SCM bits),
-           "Create a new bitvector with the arguments as elements.")
-#define FUNC_NAME s_scm_bitvector
-{
-  return scm_list_to_bitvector (bits);
-}
-#undef FUNC_NAME
-
-size_t
-scm_c_bitvector_length (SCM vec)
-{
-  scm_assert_smob_type (scm_tc16_bitvector, vec);
-  return BITVECTOR_LENGTH (vec);
-}
-
-SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
-           (SCM vec),
-           "Return the length of the bitvector @var{vec}.")
-#define FUNC_NAME s_scm_bitvector_length
-{
-  return scm_from_size_t (scm_c_bitvector_length (vec));
-}
-#undef FUNC_NAME
-
-const scm_t_uint32 *
-scm_array_handle_bit_elements (scm_t_array_handle *h)
-{
-  return scm_array_handle_bit_writable_elements (h);
-}
-
-scm_t_uint32 *
-scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
-{
-  SCM vec = h->array;
-  if (SCM_I_ARRAYP (vec))
-    vec = SCM_I_ARRAY_V (vec);
-  if (IS_BITVECTOR (vec))
-    return BITVECTOR_BITS (vec) + h->base/32;
-  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
-}
-
-size_t
-scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
-{
-  return h->base % 32;
-}
-
-const scm_t_uint32 *
-scm_bitvector_elements (SCM vec,
-                       scm_t_array_handle *h,
-                       size_t *offp,
-                       size_t *lenp,
-                       ssize_t *incp)
-{
-  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
-}
-
-
-scm_t_uint32 *
-scm_bitvector_writable_elements (SCM vec,
-                                scm_t_array_handle *h,
-                                size_t *offp,
-                                size_t *lenp,
-                                ssize_t *incp)
-{
-  scm_generalized_vector_get_handle (vec, h);
-  if (offp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *offp = scm_array_handle_bit_elements_offset (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_bit_writable_elements (h);
-}
-
-SCM
-scm_c_bitvector_ref (SCM vec, size_t idx)
-{
-  scm_t_array_handle handle;
-  const scm_t_uint32 *bits;
-
-  if (IS_BITVECTOR (vec))
-    {
-      if (idx >= BITVECTOR_LENGTH (vec))
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-    }
-  else
-    {
-      SCM res;
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
-      if (idx >= len)
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
-      scm_array_handle_release (&handle);
-      return res;
-    }
-}
-
-SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
-           (SCM vec, SCM idx),
-           "Return the element at index @var{idx} of the bitvector\n"
-           "@var{vec}.")
-#define FUNC_NAME s_scm_bitvector_ref
-{
-  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
-{
-  scm_t_array_handle handle;
-  scm_t_uint32 *bits, mask;
-
-  if (IS_BITVECTOR (vec))
-    {
-      if (idx >= BITVECTOR_LENGTH (vec))
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      bits = BITVECTOR_BITS(vec);
-    }
-  else
-    {
-      size_t len, off;
-      ssize_t inc;
-  
-      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
-      if (idx >= len)
-       scm_out_of_range (NULL, scm_from_size_t (idx));
-      idx = idx*inc + off;
-    }
-
-  mask = 1L << (idx%32);
-  if (scm_is_true (val))
-    bits[idx/32] |= mask;
-  else
-    bits[idx/32] &= ~mask;
-
-  if (!IS_BITVECTOR (vec))
-      scm_array_handle_release (&handle);
-}
-
-SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
-           (SCM vec, SCM idx, SCM val),
-           "Set the element at index @var{idx} of the bitvector\n"
-           "@var{vec} when @var{val} is true, else clear it.")
-#define FUNC_NAME s_scm_bitvector_set_x
-{
-  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
-           (SCM vec, SCM val),
-           "Set all elements of the bitvector\n"
-           "@var{vec} when @var{val} is true, else clear them.")
-#define FUNC_NAME s_scm_bitvector_fill_x
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-
-  bits = scm_bitvector_writable_elements (vec, &handle,
-                                         &off, &len, &inc);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-
-      if (scm_is_true (val))
-       {
-         memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
-         bits[word_len-1] |= last_mask;
-       }
-      else
-       {
-         memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
-         bits[word_len-1] &= ~last_mask;
-       }
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       scm_array_handle_set (&handle, i*inc, val);
-    }
-
-  scm_array_handle_release (&handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
-           (SCM list),
-           "Return a new bitvector initialized with the elements\n"
-           "of @var{list}.")
-#define FUNC_NAME s_scm_list_to_bitvector
-{
-  size_t bit_len = scm_to_size_t (scm_length (list));
-  SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
-  size_t word_len = (bit_len+31)/32;
-  scm_t_array_handle handle;
-  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
-                                                       NULL, NULL, NULL);
-  size_t i, j;
-
-  for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
-    {
-      scm_t_uint32 mask = 1;
-      bits[i] = 0;
-      for (j = 0; j < 32 && j < bit_len;
-          j++, mask <<= 1, list = SCM_CDR (list))
-       if (scm_is_true (SCM_CAR (list)))
-         bits[i] |= mask;
-    }
-
-  scm_array_handle_release (&handle);
-
-  return vec;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
-           (SCM vec),
-           "Return a new list initialized with the elements\n"
-           "of the bitvector @var{vec}.")
-#define FUNC_NAME s_scm_bitvector_to_list
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-  SCM res = SCM_EOL;
-
-  bits = scm_bitvector_writable_elements (vec, &handle,
-                                         &off, &len, &inc);
-
-  if (off == 0 && inc == 1)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      size_t i, j;
-
-      for (i = 0; i < word_len; i++, len -= 32)
-       {
-         scm_t_uint32 mask = 1;
-         for (j = 0; j < 32 && j < len; j++, mask <<= 1)
-           res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
-       }
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
-    }
-
-  scm_array_handle_release (&handle);
-  
-  return scm_reverse_x (res, SCM_EOL);
-}
-#undef FUNC_NAME
-
-/* From mmix-arith.w by Knuth.
-
-  Here's a fun way to count the number of bits in a tetrabyte.
-
-  [This classical trick is called the ``Gillies--Miller method for
-  sideways addition'' in {\sl The Preparation of Programs for an
-  Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
-  edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
-  the tricks used here were suggested by Balbir Singh, Peter
-  Rossmanith, and Stefan Schwoon.]
-*/
-
-static size_t
-count_ones (scm_t_uint32 x)
-{
-  x=x-((x>>1)&0x55555555);
-  x=(x&0x33333333)+((x>>2)&0x33333333);
-  x=(x+(x>>4))&0x0f0f0f0f;
-  x=x+(x>>8);
-  return (x+(x>>16)) & 0xff;
-}
-
-SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
-           (SCM b, SCM bitvector),
-           "Return the number of occurrences of the boolean @var{b} in\n"
-           "@var{bitvector}.")
-#define FUNC_NAME s_scm_bit_count
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-  int bit = scm_to_bool (b);
-  size_t count = 0;
-
-  bits = scm_bitvector_writable_elements (bitvector, &handle,
-                                         &off, &len, &inc);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      /* the usual case
-       */
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t i;
-
-      for (i = 0; i < word_len-1; i++)
-       count += count_ones (bits[i]);
-      count += count_ones (bits[i] & last_mask);
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
-         count++;
-    }
-  
-  scm_array_handle_release (&handle);
-
-  return scm_from_size_t (bit? count : len-count);
-}
-#undef FUNC_NAME
-
-/* returns 32 for x == 0. 
-*/
-static size_t
-find_first_one (scm_t_uint32 x)
-{
-  size_t pos = 0;
-  /* do a binary search in x. */
-  if ((x & 0xFFFF) == 0)
-    x >>= 16, pos += 16;
-  if ((x & 0xFF) == 0)
-    x >>= 8, pos += 8;
-  if ((x & 0xF) == 0)
-    x >>= 4, pos += 4;
-  if ((x & 0x3) == 0)
-    x >>= 2, pos += 2;
-  if ((x & 0x1) == 0)
-    pos += 1;
-  return pos;
-}
-
-SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
-           (SCM item, SCM v, SCM k),
-           "Return the index of the first occurrance of @var{item} in bit\n"
-           "vector @var{v}, starting from @var{k}.  If there is no\n"
-           "@var{item} entry between @var{k} and the end of\n"
-           "@var{bitvector}, then return @code{#f}.  For example,\n"
-           "\n"
-           "@example\n"
-           "(bit-position #t #*000101 0)  @result{} 3\n"
-           "(bit-position #f #*0001111 3) @result{} #f\n"
-           "@end example")
-#define FUNC_NAME s_scm_bit_position
-{
-  scm_t_array_handle handle;
-  size_t off, len, first_bit;
-  ssize_t inc;
-  const scm_t_uint32 *bits;
-  int bit = scm_to_bool (item);
-  SCM res = SCM_BOOL_F;
-  
-  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
-  first_bit = scm_to_unsigned_integer (k, 0, len);
-
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      size_t i, word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t first_word = first_bit / 32;
-      scm_t_uint32 first_mask =
-       ((scm_t_uint32)-1) << (first_bit - 32*first_word);
-      scm_t_uint32 w;
-      
-      for (i = first_word; i < word_len; i++)
-       {
-         w = (bit? bits[i] : ~bits[i]);
-         if (i == first_word)
-           w &= first_mask;
-         if (i == word_len-1)
-           w &= last_mask;
-         if (w)
-           {
-             res = scm_from_size_t (32*i + find_first_one (w));
-             break;
-           }
-       }
-    }
-  else
-    {
-      size_t i;
-      for (i = first_bit; i < len; i++)
-       {
-         SCM elt = scm_array_handle_ref (&handle, i*inc);
-         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-           {
-             res = scm_from_size_t (i);
-             break;
-           }
-       }
-    }
-
-  scm_array_handle_release (&handle);
-
-  return res;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
-           (SCM v, SCM kv, SCM obj),
-           "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
-           "selecting the entries to change.  The return value is\n"
-           "unspecified.\n"
-           "\n"
-           "If @var{kv} is a bit vector, then those entries where it has\n"
-           "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
-           "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
-           "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
-           "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
-           "\n"
-           "@example\n"
-           "(define bv #*01000010)\n"
-           "(bit-set*! bv #*10010001 #t)\n"
-           "bv\n"
-           "@result{} #*11010011\n"
-           "@end example\n"
-           "\n"
-           "If @var{kv} is a u32vector, then its elements are\n"
-           "indices into @var{v} which are set to @var{obj}.\n"
-           "\n"
-           "@example\n"
-           "(define bv #*01000010)\n"
-           "(bit-set*! bv #u32(5 2 7) #t)\n"
-           "bv\n"
-           "@result{} #*01100111\n"
-           "@end example")
-#define FUNC_NAME s_scm_bit_set_star_x
-{
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  scm_t_uint32 *v_bits;
-  int bit;
-
-  /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  bit = scm_to_bool (obj);
-
-  v_bits = scm_bitvector_writable_elements (v, &v_handle,
-                                           &v_off, &v_len, &v_inc);
-
-  if (scm_is_bitvector (kv))
-    {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (v, &kv_handle,
-                                       &kv_off, &kv_len, &kv_inc);
-
-      if (v_len != kv_len)
-       scm_misc_error (NULL,
-                       "bit vectors must have equal length",
-                       SCM_EOL);
-
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-       {
-         size_t word_len = (kv_len + 31) / 32;
-         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
-         size_t i;
- 
-         if (bit == 0)
-           {
-             for (i = 0; i < word_len-1; i++)
-               v_bits[i] &= ~kv_bits[i];
-             v_bits[i] &= ~(kv_bits[i] & last_mask);
-           }
-         else
-           {
-             for (i = 0; i < word_len-1; i++)
-               v_bits[i] |= kv_bits[i];
-             v_bits[i] |= kv_bits[i] & last_mask;
-           }
-       }
-      else
-       {
-         size_t i;
-         for (i = 0; i < kv_len; i++)
-           if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
-             scm_array_handle_set (&v_handle, i*v_inc, obj);
-       }
-      
-      scm_array_handle_release (&kv_handle);
-
-    }
-  else if (scm_is_true (scm_u32vector_p (kv)))
-    {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-       scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
-
-      scm_array_handle_release (&kv_handle);
-    }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
-           (SCM v, SCM kv, SCM obj),
-           "Return a count of how many entries in bit vector @var{v} are\n"
-           "equal to @var{obj}, with @var{kv} selecting the entries to\n"
-           "consider.\n"
-           "\n"
-           "If @var{kv} is a bit vector, then those entries where it has\n"
-           "@code{#t} are the ones in @var{v} which are considered.\n"
-           "@var{kv} and @var{v} must be the same length.\n"
-           "\n"
-           "If @var{kv} is a u32vector, then it contains\n"
-           "the indexes in @var{v} to consider.\n"
-           "\n"
-           "For example,\n"
-           "\n"
-           "@example\n"
-           "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
-           "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
-           "@end example")
-#define FUNC_NAME s_scm_bit_count_star
-{
-  scm_t_array_handle v_handle;
-  size_t v_off, v_len;
-  ssize_t v_inc;
-  const scm_t_uint32 *v_bits;
-  size_t count = 0;
-  int bit;
-
-  /* Validate that OBJ is a boolean so this is done even if we don't
-     need BIT.
-  */
-  bit = scm_to_bool (obj);
-
-  v_bits = scm_bitvector_elements (v, &v_handle,
-                                  &v_off, &v_len, &v_inc);
-
-  if (scm_is_bitvector (kv))
-    {
-      scm_t_array_handle kv_handle;
-      size_t kv_off, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_bits;
-      
-      kv_bits = scm_bitvector_elements (v, &kv_handle,
-                                       &kv_off, &kv_len, &kv_inc);
-
-      if (v_len != kv_len)
-       scm_misc_error (NULL,
-                       "bit vectors must have equal length",
-                       SCM_EOL);
-
-      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
-       {
-         size_t i, word_len = (kv_len + 31) / 32;
-         scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
-         scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
-
-         for (i = 0; i < word_len-1; i++)
-           count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
-         count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
-       }
-      else
-       {
-         size_t i;
-         for (i = 0; i < kv_len; i++)
-           if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
-             {
-               SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
-               if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-                 count++;
-             }
-       }
-      
-      scm_array_handle_release (&kv_handle);
-
-    }
-  else if (scm_is_true (scm_u32vector_p (kv)))
-    {
-      scm_t_array_handle kv_handle;
-      size_t i, kv_len;
-      ssize_t kv_inc;
-      const scm_t_uint32 *kv_elts;
-
-      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
-      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
-       {
-         SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
-         if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
-           count++;
-       }
-
-      scm_array_handle_release (&kv_handle);
-    }
-  else 
-    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
-
-  scm_array_handle_release (&v_handle);
-
-  return scm_from_size_t (count);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, 
-           (SCM v),
-           "Modify the bit vector @var{v} by replacing each element with\n"
-           "its negation.")
-#define FUNC_NAME s_scm_bit_invert_x
-{
-  scm_t_array_handle handle;
-  size_t off, len;
-  ssize_t inc;
-  scm_t_uint32 *bits;
-
-  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
-  
-  if (off == 0 && inc == 1 && len > 0)
-    {
-      size_t word_len = (len + 31) / 32;
-      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
-      size_t i;
-
-      for (i = 0; i < word_len-1; i++)
-       bits[i] = ~bits[i];
-      bits[i] = bits[i] ^ last_mask;
-    }
-  else
-    {
-      size_t i;
-      for (i = 0; i < len; i++)
-       scm_array_handle_set (&handle, i*inc,
-                             scm_not (scm_array_handle_ref (&handle, i*inc)));
-    }
-
-  scm_array_handle_release (&handle);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM
-scm_istr2bve (SCM str)
-{
-  scm_t_array_handle handle;
-  size_t len = scm_i_string_length (str);
-  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
-  SCM res = vec;
-
-  scm_t_uint32 mask;
-  size_t k, j;
-  const char *c_str;
-  scm_t_uint32 *data;
-
-  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
-  c_str = scm_i_string_chars (str);
-
-  for (k = 0; k < (len + 31) / 32; k++)
-    {
-      data[k] = 0L;
-      j = len - k * 32;
-      if (j > 32)
-       j = 32;
-      for (mask = 1L; j--; mask <<= 1)
-       switch (*c_str++)
-         {
-         case '0':
-           break;
-         case '1':
-           data[k] |= mask;
-           break;
-         default:
-           res = SCM_BOOL_F;
-           goto exit;
-         }
-    }
-  
- exit:
-  scm_array_handle_release (&handle);
-  scm_remember_upto_here_1 (str);
-  return res;
-}
-
-
-
-static SCM 
-ra2l (SCM ra, unsigned long base, unsigned long k)
-{
-  SCM res = SCM_EOL;
-  long inc;
-  size_t i;
-  int enclosed = SCM_I_ENCLOSED_ARRAYP (ra);
-  
-  if (k == SCM_I_ARRAY_NDIM (ra))
-    return scm_i_cvref (SCM_I_ARRAY_V (ra), base, enclosed);
-
-  inc = SCM_I_ARRAY_DIMS (ra)[k].inc;
-  if (SCM_I_ARRAY_DIMS (ra)[k].ubnd < SCM_I_ARRAY_DIMS (ra)[k].lbnd)
-    return SCM_EOL;
-  i = base + (1 + SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS 
(ra)[k].lbnd) * inc;
-  do
-    {
-      i -= inc;
-      res = scm_cons (ra2l (ra, i, k + 1), res);
-    }
-  while (i != base);
-  return res;
-}
-
-
-SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, 
-           (SCM v),
-           "Return a list consisting of all the elements, in order, of\n"
-           "@var{array}.")
-#define FUNC_NAME s_scm_array_to_list
-{
-  if (scm_is_generalized_vector (v))
-    return scm_generalized_vector_to_list (v);
-  else if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
-    return ra2l (v, SCM_I_ARRAY_BASE (v), 0);
-
-  scm_wrong_type_arg_msg (NULL, 0, v, "array");
-}
-#undef FUNC_NAME
-
-
-static void l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k);
-
-SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
-           (SCM type, SCM shape, SCM lst),
-           "Return an array of the type @var{type}\n"
-           "with elements the same as those of @var{lst}.\n"
-           "\n"
-           "The argument @var{shape} determines the number of dimensions\n"
-           "of the array and their shape.  It is either an exact integer,\n"
-           "giving the\n"
-           "number of dimensions directly, or a list whose length\n"
-           "specifies the number of dimensions and each element specified\n"
-           "the lower and optionally the upper bound of the corresponding\n"
-           "dimension.\n"
-           "When the element is list of two elements, these elements\n"
-           "give the lower and upper bounds.  When it is an exact\n"
-           "integer, it gives only the lower bound.")
-#define FUNC_NAME s_scm_list_to_typed_array
-{
-  SCM row;
-  SCM ra;
-  scm_t_array_handle handle;
-
-  row = lst;
-  if (scm_is_integer (shape))
-    {
-      size_t k = scm_to_size_t (shape);
-      shape = SCM_EOL;
-      while (k-- > 0)
-       {
-         shape = scm_cons (scm_length (row), shape);
-         if (k > 0 && !scm_is_null (row))
-           row = scm_car (row);
-       }
-    }
-  else
-    {
-      SCM shape_spec = shape;
-      shape = SCM_EOL;
-      while (1)
-       {
-         SCM spec = scm_car (shape_spec);
-         if (scm_is_pair (spec))
-           shape = scm_cons (spec, shape);
-         else
-           shape = scm_cons (scm_list_2 (spec,
-                                         scm_sum (scm_sum (spec,
-                                                           scm_length (row)),
-                                                  scm_from_int (-1))),
-                             shape);
-         shape_spec = scm_cdr (shape_spec);
-         if (scm_is_pair (shape_spec))
-           {
-             if (!scm_is_null (row))
-               row = scm_car (row);
-           }
-         else
-           break;
-       }
-    }
-
-  ra = scm_make_typed_array (type, SCM_UNSPECIFIED,
-                            scm_reverse_x (shape, SCM_EOL));
-
-  scm_array_get_handle (ra, &handle);
-  l2ra (lst, &handle, 0, 0);
-  scm_array_handle_release (&handle);
-
-  return ra;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_list_to_array, "list->array", 2, 0, 0,
-           (SCM ndim, SCM lst),
-           "Return an array with elements the same as those of @var{lst}.")
-#define FUNC_NAME s_scm_list_to_array
-{
-  return scm_list_to_typed_array (SCM_BOOL_T, ndim, lst);
-}
-#undef FUNC_NAME
-
-static void
-l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
-{
-  if (k == scm_array_handle_rank (handle))
-    scm_array_handle_set (handle, pos, lst);
-  else
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (handle) + k;
-      ssize_t inc = dim->inc;
-      size_t len = 1 + dim->ubnd - dim->lbnd, n;
-      char *errmsg = NULL;
-
-      n = len;
-      while (n > 0 && scm_is_pair (lst))
-       {
-         l2ra (SCM_CAR (lst), handle, pos, k + 1);
-         pos += inc;
-         lst = SCM_CDR (lst);
-         n -= 1;
-       }
-      if (n != 0)
-       errmsg = "too few elements for array dimension ~a, need ~a";
-      if (!scm_is_null (lst))
-       errmsg = "too many elements for array dimension ~a, want ~a";
-      if (errmsg)
-       scm_misc_error (NULL, errmsg, scm_list_2 (scm_from_ulong (k),
-                                                 scm_from_size_t (len)));
-    }
-}
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
-           (SCM ndim, SCM prot, SCM lst),
-           "Return a uniform array of the type indicated by prototype\n"
-           "@var{prot} with elements the same as those of @var{lst}.\n"
-           "Elements must be of the appropriate type, no coercions are\n"
-           "done.\n"
-           "\n"
-           "The argument @var{ndim} determines the number of dimensions\n"
-           "of the array.  It is either an exact integer, giving the\n"
-           "number directly, or a list of exact integers, whose length\n"
-           "specifies the number of dimensions and each element is the\n"
-           "lower index bound of its dimension.")
-#define FUNC_NAME s_scm_list_to_uniform_array
-{
-  return scm_list_to_typed_array (prototype_to_type (prot), ndim, lst);
-}
-#undef FUNC_NAME
-
-#endif
-
-/* Print dimension DIM of ARRAY.
- */
-
-static int
-scm_i_print_array_dimension (SCM array, int dim, int base, int enclosed,
-                            SCM port, scm_print_state *pstate)
-{
-  scm_t_array_dim *dim_spec = SCM_I_ARRAY_DIMS (array) + dim;
-  long idx;
-
-  scm_putc ('(', port);
-
-  for (idx = dim_spec->lbnd; idx <= dim_spec->ubnd; idx++)
-    {
-      if (dim < SCM_I_ARRAY_NDIM(array)-1)
-       scm_i_print_array_dimension (array, dim+1, base, enclosed, 
-                                    port, pstate);
-      else
-       scm_iprin1 (scm_i_cvref (SCM_I_ARRAY_V (array), base, enclosed), 
-                   port, pstate);
-      if (idx < dim_spec->ubnd)
-       scm_putc (' ', port);
-      base += dim_spec->inc;
-    }
-
-  scm_putc (')', port);
-  return 1;
-}
-
-/* Print an array.  (Only for strict arrays, not for generalized vectors.)
-*/
-
-static int
-scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
-{
-  long ndim = SCM_I_ARRAY_NDIM (array);
-  scm_t_array_dim *dim_specs = SCM_I_ARRAY_DIMS (array);
-  SCM v = SCM_I_ARRAY_V (array);
-  unsigned long base = SCM_I_ARRAY_BASE (array);
-  long i;
-  int print_lbnds = 0, zero_size = 0, print_lens = 0;
-
-  scm_putc ('#', port);
-  if (ndim != 1 || dim_specs[0].lbnd != 0)
-    scm_intprint (ndim, 10, port);
-  if (scm_is_uniform_vector (v))
-    scm_puts (scm_i_uniform_vector_tag (v), port);
-  else if (scm_is_bitvector (v))
-    scm_puts ("b", port);
-  else if (scm_is_string (v))
-    scm_puts ("a", port);
-  else if (!scm_is_vector (v))
-    scm_puts ("?", port);
-  
-  for (i = 0; i < ndim; i++)
-    {
-      if (dim_specs[i].lbnd != 0)
-       print_lbnds = 1;
-      if (dim_specs[i].ubnd - dim_specs[i].lbnd + 1 == 0)
-       zero_size = 1;
-      else if (zero_size)
-       print_lens = 1;
-    }
-
-  if (print_lbnds || print_lens)
-    for (i = 0; i < ndim; i++)
-      {
-       if (print_lbnds)
-         {
-           scm_putc ('@', port);
-           scm_intprint (dim_specs[i].lbnd, 10, port);
-         }
-       if (print_lens)
-         {
-           scm_putc (':', port);
-           scm_intprint (dim_specs[i].ubnd - dim_specs[i].lbnd + 1,
-                         10, port);
-         }
-      }
-
-  if (ndim == 0)
-    {
-      /* Rank zero arrays, which are really just scalars, are printed
-        specially.  The consequent way would be to print them as
-
-            #0 OBJ
-
-         where OBJ is the printed representation of the scalar, but we
-         print them instead as
-
-            #0(OBJ)
-
-         to make them look less strange.
-
-        Just printing them as
-
-            OBJ
-
-         would be correct in a way as well, but zero rank arrays are
-         not really the same as Scheme values since they are boxed and
-         can be modified with array-set!, say.
-      */
-      scm_putc ('(', port);
-      scm_iprin1 (scm_i_cvref (v, base, 0), port, pstate);
-      scm_putc (')', port);
-      return 1;
-    }
-  else
-    return scm_i_print_array_dimension (array, 0, base, 0, port, pstate);
-}
-
-static int
-scm_i_print_enclosed_array (SCM array, SCM port, scm_print_state *pstate)
-{
-  size_t base;
-
-  scm_putc ('#', port);
-  base = SCM_I_ARRAY_BASE (array);
-  scm_puts ("<enclosed-array ", port);
-  scm_i_print_array_dimension (array, 0, base, 1, port, pstate);
-  scm_putc ('>', port);
-  return 1;
-}
-
-/* Read an array.  This function can also read vectors and uniform
-   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
-   handled here.
-
-   C is the first character read after the '#'.
-*/
-
-static SCM
-tag_to_type (const char *tag, SCM port)
-{
-#if SCM_ENABLE_DEPRECATED
-  {
-    /* Recognize the old syntax.
-     */
-    const char *instead;
-    switch (tag[0])
-      {
-      case 'u':
-       instead = "u32";
-       break;
-      case 'e':
-       instead = "s32";
-       break;
-      case 's':
-       instead = "f32";
-       break;
-      case 'i':
-       instead = "f64";
-       break;
-      case 'y':
-       instead = "s8";
-       break;
-      case 'h':
-       instead = "s16";
-       break;
-      case 'l':
-       instead = "s64";
-       break;
-      case 'c':
-       instead = "c64";
-       break;
-      default:
-       instead = NULL;
-       break;
-      }
-    
-    if (instead && tag[1] == '\0')
-      {
-       scm_c_issue_deprecation_warning_fmt
-         ("The tag '%c' is deprecated for uniform vectors. "
-          "Use '%s' instead.", tag[0], instead);
-       return scm_from_locale_symbol (instead);
-      }
-  }
-#endif
-  
-  if (*tag == '\0')
-    return SCM_BOOL_T;
-  else
-    return scm_from_locale_symbol (tag);
-}
-
-static int
-read_decimal_integer (SCM port, int c, ssize_t *resp)
-{
-  ssize_t sign = 1;
-  ssize_t res = 0;
-  int got_it = 0;
-
-  if (c == '-')
-    {
-      sign = -1;
-      c = scm_getc (port);
-    }
-
-  while ('0' <= c && c <= '9')
-    {
-      res = 10*res + c-'0';
-      got_it = 1;
-      c = scm_getc (port);
-    }
-
-  if (got_it)
-    *resp = sign * res;
-  return c;
-}
-
-SCM
-scm_i_read_array (SCM port, int c)
-{
-  ssize_t rank;
-  int got_rank;
-  char tag[80];
-  int tag_len;
-
-  SCM shape = SCM_BOOL_F, elements;
-
-  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
-     the array code can not deal with zero-length dimensions yet, and
-     we want to allow zero-length vectors, of course.
-  */
-  if (c == '(')
-    {
-      scm_ungetc (c, port);
-      return scm_vector (scm_read (port));
-    }
-
-  /* Disambiguate between '#f' and uniform floating point vectors.
-   */
-  if (c == 'f')
-    {
-      c = scm_getc (port);
-      if (c != '3' && c != '6')
-       {
-         if (c != EOF)
-           scm_ungetc (c, port);
-         return SCM_BOOL_F;
-       }
-      rank = 1;
-      got_rank = 1;
-      tag[0] = 'f';
-      tag_len = 1;
-      goto continue_reading_tag;
-    }
-
-  /* Read rank. 
-   */
-  rank = 1;
-  c = read_decimal_integer (port, c, &rank);
-  if (rank < 0)
-    scm_i_input_error (NULL, port, "array rank must be non-negative",
-                      SCM_EOL);
-
-  /* Read tag. 
-   */
-  tag_len = 0;
- continue_reading_tag:
-  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
-    {
-      tag[tag_len++] = c;
-      c = scm_getc (port);
-    }
-  tag[tag_len] = '\0';
-  
-  /* Read shape. 
-   */
-  if (c == '@' || c == ':')
-    {
-      shape = SCM_EOL;
-      
-      do
-       {
-         ssize_t lbnd = 0, len = 0;
-         SCM s;
-
-         if (c == '@')
-           {
-             c = scm_getc (port);
-             c = read_decimal_integer (port, c, &lbnd);
-           }
-         
-         s = scm_from_ssize_t (lbnd);
-
-         if (c == ':')
-           {
-             c = scm_getc (port);
-             c = read_decimal_integer (port, c, &len);
-             if (len < 0)
-               scm_i_input_error (NULL, port,
-                                  "array length must be non-negative",
-                                  SCM_EOL);
-
-             s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
-           }
-
-         shape = scm_cons (s, shape);
-       } while (c == '@' || c == ':');
-
-      shape = scm_reverse_x (shape, SCM_EOL);
-    }
-
-  /* Read nested lists of elements.
-   */
-  if (c != '(')
-    scm_i_input_error (NULL, port,
-                      "missing '(' in vector or array literal",
-                      SCM_EOL);
-  scm_ungetc (c, port);
-  elements = scm_read (port);
-
-  if (scm_is_false (shape))
-    shape = scm_from_ssize_t (rank);
-  else if (scm_ilength (shape) != rank)
-    scm_i_input_error 
-      (NULL, port,
-       "the number of shape specifications must match the array rank",
-       SCM_EOL);
-
-  /* Handle special print syntax of rank zero arrays; see
-     scm_i_print_array for a rationale.
-  */
-  if (rank == 0)
-    {
-      if (!scm_is_pair (elements))
-       scm_i_input_error (NULL, port,
-                          "too few elements in array literal, need 1",
-                          SCM_EOL);
-      if (!scm_is_null (SCM_CDR (elements)))
-       scm_i_input_error (NULL, port,
-                          "too many elements in array literal, want 1",
-                          SCM_EOL);
-      elements = SCM_CAR (elements);
-    }
-
-  /* Construct array. 
-   */
-  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
-}
-
-SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
-           (SCM ra),
-           "")
-#define FUNC_NAME s_scm_array_type
-{
-  if (SCM_I_ARRAYP (ra))
-    return scm_i_generalized_vector_type (SCM_I_ARRAY_V (ra));
-  else if (scm_is_generalized_vector (ra))
-    return scm_i_generalized_vector_type (ra);
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    scm_wrong_type_arg_msg (NULL, 0, ra, "non-enclosed array");
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_DEFINE (scm_array_prototype, "array-prototype", 1, 0, 0, 
-           (SCM ra),
-           "Return an object that would produce an array of the same type\n"
-           "as @var{array}, if used as the @var{prototype} for\n"
-           "@code{make-uniform-array}.")
-#define FUNC_NAME s_scm_array_prototype
-{
-  if (SCM_I_ARRAYP (ra))
-    return scm_i_get_old_prototype (SCM_I_ARRAY_V (ra));
-  else if (scm_is_generalized_vector (ra))
-    return scm_i_get_old_prototype (ra);
-  else if (SCM_I_ENCLOSED_ARRAYP (ra))
-    return SCM_UNSPECIFIED;
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-}
-#undef FUNC_NAME
-
-#endif
-
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM 
-scm_make_ra (int ndim)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_make_ra is deprecated.  Use scm_make_array or similar instead.");
-  return scm_i_make_ra (ndim, 0);
-}
-
-SCM 
-scm_shap2ra (SCM args, const char *what)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_shap2ra is deprecated.  Use scm_make_array or similar instead.");
-  return scm_i_shap2ra (args);
-}
-
-SCM
-scm_cvref (SCM v, unsigned long pos, SCM last)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_cvref is deprecated.  Use scm_c_generalized_vector_ref instead.");
-  return scm_c_generalized_vector_ref (v, pos);
-}
-
-void 
-scm_ra_set_contp (SCM ra)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_ra_set_contp is deprecated.  There should be no need for it.");
-  scm_i_ra_set_contp (ra);
-}
-
-long 
-scm_aind (SCM ra, SCM args, const char *what)
-{
-  scm_t_array_handle handle;
-  ssize_t pos;
-
-  scm_c_issue_deprecation_warning
-    ("scm_aind is deprecated.  Use scm_array_handle_pos instead.");
-
-  if (scm_is_integer (args))
-    args = scm_list_1 (args);
-  
-  scm_array_get_handle (ra, &handle);
-  pos = scm_array_handle_pos (&handle, args) + SCM_I_ARRAY_BASE (ra);
-  scm_array_handle_release (&handle);
-  return pos;
-}
-
-int 
-scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
-{
-  scm_c_issue_deprecation_warning
-    ("scm_raprin1 is deprecated.  Use scm_display or scm_write instead.");
-
-  scm_iprin1 (exp, port, pstate);
-  return 1;
-}
-
-#endif
-
-void
-scm_init_unif ()
-{
-  scm_i_tc16_array = scm_make_smob_type ("array", 0);
-  scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
-  scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
-
-  scm_i_tc16_enclosed_array = scm_make_smob_type ("enclosed-array", 0);
-  scm_set_smob_print (scm_i_tc16_enclosed_array, scm_i_print_enclosed_array);
-  scm_set_smob_equalp (scm_i_tc16_enclosed_array, scm_array_equal_p);
-
-  scm_add_feature ("array");
-
-  scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
-  scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
-  scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
-
-  init_type_creator_table ();
-
-#include "libguile/unif.x"
-
-}
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/unif.h b/libguile/unif.h
deleted file mode 100644
index 91d26c8..0000000
--- a/libguile/unif.h
+++ /dev/null
@@ -1,198 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_UNIF_H
-#define SCM_UNIF_H
-
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 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
- */
-
-
-
-#include "libguile/__scm.h"
-#include "libguile/print.h"
-
-
-
-/* This file contains the definitions for arrays and bit vectors.
-   Uniform numeric vectors are now in srfi-4.c.
-*/
-
-
-/** Arrays */
-
-typedef struct scm_t_array_dim
-{
-  ssize_t lbnd;
-  ssize_t ubnd;
-  ssize_t inc;
-} scm_t_array_dim;
-
-SCM_API SCM scm_array_p (SCM v, SCM prot);
-SCM_API SCM scm_typed_array_p (SCM v, SCM type);
-SCM_API SCM scm_make_array (SCM fill, SCM bounds);
-SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
-SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
-                                             const void *bytes,
-                                             size_t byte_len);
-SCM_API SCM scm_array_rank (SCM ra);
-SCM_API size_t scm_c_array_rank (SCM ra);
-SCM_API SCM scm_array_dimensions (SCM ra);
-SCM_API SCM scm_shared_array_root (SCM ra);
-SCM_API SCM scm_shared_array_offset (SCM ra);
-SCM_API SCM scm_shared_array_increments (SCM ra);
-SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
-SCM_API SCM scm_transpose_array (SCM ra, SCM args);
-SCM_API SCM scm_enclose_array (SCM ra, SCM axes);
-SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
-SCM_API SCM scm_array_ref (SCM v, SCM args);
-SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
-SCM_API SCM scm_array_contents (SCM ra, SCM strict);
-SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
-                                     SCM start, SCM end);
-SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
-                                    SCM start, SCM end);
-SCM_API SCM scm_array_to_list (SCM v);
-SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
-SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
-SCM_API SCM scm_array_type (SCM ra);
-
-SCM_API int scm_is_array (SCM obj);
-SCM_API int scm_is_typed_array (SCM obj, SCM type);
-
-SCM_API SCM scm_ra2contig (SCM ra, int copy);
-
-struct scm_t_array_handle;
-
-typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, ssize_t);
-typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, ssize_t, SCM);
-
-typedef struct scm_t_array_handle {
-  SCM array;
-  size_t base;
-  scm_t_array_dim *dims;
-  scm_t_array_dim dim0;
-  scm_i_t_array_ref ref;
-  scm_i_t_array_set set;
-  const void *elements;
-  void *writable_elements;
-} scm_t_array_handle;
-
-SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
-SCM_API size_t scm_array_handle_rank (scm_t_array_handle *h);
-SCM_API scm_t_array_dim *scm_array_handle_dims (scm_t_array_handle *h);
-SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
-SCM_API const SCM *scm_array_handle_elements (scm_t_array_handle *h);
-SCM_API SCM *scm_array_handle_writable_elements (scm_t_array_handle *h);
-SCM_API void scm_array_handle_release (scm_t_array_handle *h);
-
-/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
-
-
-/** Bit vectors */
-
-SCM_API SCM scm_bitvector_p (SCM vec);
-SCM_API SCM scm_bitvector (SCM bits);
-SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
-SCM_API SCM scm_bitvector_length (SCM vec);
-SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx);
-SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
-SCM_API SCM scm_list_to_bitvector (SCM list);
-SCM_API SCM scm_bitvector_to_list (SCM vec);
-SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
-
-SCM_API SCM scm_bit_count (SCM item, SCM seq);
-SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
-SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
-SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
-SCM_API SCM scm_bit_invert_x (SCM v);
-SCM_API SCM scm_istr2bve (SCM str);
-
-SCM_API int scm_is_bitvector (SCM obj);
-SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
-SCM_API size_t scm_c_bitvector_length (SCM vec);
-SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
-SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
-SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle 
*h);
-SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements 
(scm_t_array_handle *h);
-SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
-SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
-                                                   scm_t_array_handle *h,
-                                                   size_t *offp,
-                                                   size_t *lenp,
-                                                   ssize_t *incp);
-SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
-                                                      scm_t_array_handle *h,
-                                                      size_t *offp,
-                                                      size_t *lenp,
-                                                      ssize_t *incp);
-
-/* internal. */
-
-typedef struct scm_i_t_array
-{
-  SCM v;  /* the contents of the array, e.g., a vector or uniform vector.  */
-  unsigned long base;
-} scm_i_t_array;
-
-SCM_API scm_t_bits scm_i_tc16_array;
-SCM_API scm_t_bits scm_i_tc16_enclosed_array;
-
-#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
-
-#define SCM_I_ARRAYP(a)            SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
-#define SCM_I_ENCLOSED_ARRAYP(a) \
-                            SCM_TYP16_PREDICATE (scm_i_tc16_enclosed_array, a)
-#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
-#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
-
-#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
-#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
-#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
-#define SCM_I_ARRAY_DIMS(a) \
-  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
-
-SCM_INTERNAL SCM scm_i_make_ra (int ndim, int enclosed);
-SCM_INTERNAL SCM scm_i_cvref (SCM v, size_t p, int enclosed);
-SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
-
-/* deprecated. */
-
-#if SCM_ENABLE_DEPRECATED
-
-SCM_API SCM scm_make_uve (long k, SCM prot);
-SCM_API SCM scm_array_prototype (SCM ra);
-SCM_API SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
-SCM_API SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
-SCM_API SCM scm_make_ra (int ndim);
-SCM_API SCM scm_shap2ra (SCM args, const char *what);
-SCM_API SCM scm_cvref (SCM v, unsigned long pos, SCM last);
-SCM_API void scm_ra_set_contp (SCM ra);
-SCM_API long scm_aind (SCM ra, SCM args, const char *what);
-SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
-
-#endif
-
-SCM_INTERNAL void scm_init_unif (void);
-
-#endif  /* SCM_UNIF_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/uniform.c b/libguile/uniform.c
new file mode 100644
index 0000000..28125da
--- /dev/null
+++ b/libguile/uniform.c
@@ -0,0 +1,254 @@
+/* Copyright (C) 1995,1996,1997,1998,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 <assert.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/uniform.h"
+
+
+const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = 
{
+  0,
+  0,
+  1,
+  8,
+  8, 8,
+  16, 16,
+  32, 32,
+  64, 64,
+  32, 64,
+  64, 128
+};
+
+/* FIXME: return bit size instead of byte size? */
+size_t
+scm_array_handle_uniform_element_size (scm_t_array_handle *h)
+{
+  size_t ret = scm_i_array_element_type_sizes[h->element_type];
+  if (ret && ret % 8 == 0)
+    return ret / 8;
+  else
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "uniform array");
+}
+
+const void *
+scm_array_handle_uniform_elements (scm_t_array_handle *h)
+{
+  return scm_array_handle_uniform_writable_elements (h);
+}
+
+void *
+scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
+{
+  size_t esize;
+  scm_t_uint8 *ret;
+
+  esize = scm_array_handle_uniform_element_size (h);
+  ret = ((scm_t_uint8*) h->writable_elements) + h->base * esize;
+  return ret;
+}
+
+int
+scm_is_uniform_vector (SCM obj)
+{
+  scm_t_array_handle h;
+  int ret = 0;
+
+  if (scm_is_generalized_vector (obj))
+    {
+      scm_generalized_vector_get_handle (obj, &h);
+      ret = SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
+      scm_array_handle_release (&h);
+    }
+  return ret;
+}
+
+size_t
+scm_c_uniform_vector_length (SCM uvec)
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (uvec, &h, &len, &inc);
+  scm_array_handle_release (&h);
+  return len;
+}
+
+SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
+           (SCM obj),
+           "Return @code{#t} if @var{obj} is a uniform vector.")
+#define FUNC_NAME s_scm_uniform_vector_p
+{
+  return scm_from_bool (scm_is_uniform_vector (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1, 
0, 0,
+           (SCM v),
+           "Return the number of elements in the uniform vector, @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_element_type
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  SCM ret;
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_array_handle_element_type (&h);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 
0, 0,
+           (SCM v),
+           "Return the number of bytes allocated to each element in the\n"
+            "uniform vector, @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_element_size
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  SCM ret;
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h));
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_uniform_vector_ref (SCM v, size_t idx)
+{
+  SCM ret;
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  ret = scm_array_handle_ref (&h, idx*inc);
+  scm_array_handle_release (&h);
+  return ret;
+}
+
+SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
+           (SCM v, SCM idx),
+           "Return the element at index @var{idx} of the\n"
+           "homogenous numeric vector @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_ref
+{
+  return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
+{
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (v, &h, &len, &inc);
+  scm_array_handle_set (&h, idx*inc, val);
+  scm_array_handle_release (&h);
+}
+
+SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
+           (SCM v, SCM idx, SCM val),
+           "Set the element at index @var{idx} of the\n"
+           "homogenous numeric vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_uniform_vector_set_x
+{
+  scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
+            (SCM uvec),
+           "Convert the uniform numeric vector @var{uvec} to a list.")
+#define FUNC_NAME s_scm_uniform_vector_to_list
+{
+  SCM ret;
+  scm_t_array_handle h;
+  size_t len;
+  ssize_t inc;
+  
+  scm_uniform_vector_elements (uvec, &h, &len, &inc);
+  ret = scm_generalized_vector_to_list (uvec);
+  scm_array_handle_release (&h);
+  return ret;
+}
+#undef FUNC_NAME
+
+const void *
+scm_uniform_vector_elements (SCM uvec, 
+                            scm_t_array_handle *h,
+                            size_t *lenp, ssize_t *incp)
+{
+  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
+}
+
+void *
+scm_uniform_vector_writable_elements (SCM uvec, 
+                                     scm_t_array_handle *h,
+                                     size_t *lenp, ssize_t *incp)
+{
+  void *ret;
+  scm_generalized_vector_get_handle (uvec, h);
+  /* FIXME nonlocal exit */
+  ret = scm_array_handle_uniform_writable_elements (h);
+  if (lenp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return ret;
+}
+
+SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
+           (SCM v),
+           "Return the number of elements in the uniform vector @var{v}.")
+#define FUNC_NAME s_scm_uniform_vector_length
+{
+  return scm_from_size_t (scm_c_uniform_vector_length (v));
+}
+#undef FUNC_NAME
+
+
+void
+scm_init_uniform (void)
+{
+#include "libguile/uniform.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/uniform.h b/libguile/uniform.h
new file mode 100644
index 0000000..b1f3965
--- /dev/null
+++ b/libguile/uniform.h
@@ -0,0 +1,77 @@
+/* classes: h_files */
+
+#ifndef SCM_UNIFORM_H
+#define SCM_UNIFORM_H
+
+/* Copyright (C) 1995,1996,1997,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
+ * 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
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/generalized-vectors.h"
+
+
+
+/*
+ * Uniform vectors contain unboxed values. They are not necessarily contiguous.
+ */
+
+SCM_INTERNAL const size_t scm_i_array_element_type_sizes[];
+#define SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED(t)    \
+  (scm_i_array_element_type_sizes[(t)] != 0)
+
+/* returns type size in bits */
+SCM_API size_t scm_array_handle_uniform_element_size (scm_t_array_handle *h);
+
+SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
+SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle 
*h);
+
+SCM_API SCM scm_uniform_vector_p (SCM v);
+SCM_API SCM scm_uniform_vector_length (SCM v);
+SCM_API SCM scm_uniform_vector_element_type (SCM v);
+SCM_API SCM scm_uniform_vector_element_size (SCM v);
+SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
+SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
+SCM_API SCM scm_uniform_vector_to_list (SCM v);
+SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
+                                      SCM start, SCM end);
+SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
+                                     SCM start, SCM end);
+
+SCM_API int scm_is_uniform_vector (SCM obj);
+SCM_API size_t scm_c_uniform_vector_length (SCM v);
+SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
+SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API const void *scm_uniform_vector_elements (SCM uvec, 
+                                                scm_t_array_handle *h,
+                                                size_t *lenp, ssize_t *incp);
+SCM_API void *scm_uniform_vector_writable_elements (SCM uvec, 
+                                                   scm_t_array_handle *h,
+                                                   size_t *lenp,
+                                                   ssize_t *incp);
+
+SCM_INTERNAL void scm_init_uniform (void);
+
+#endif  /* SCM_UNIFORM_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 255323f..190e3e3 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -30,9 +30,11 @@
 
 #include "libguile/validate.h"
 #include "libguile/vectors.h"
-#include "libguile/unif.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/arrays.h"
+#include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/srfi-4.h"
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
@@ -609,135 +611,42 @@ SCM_DEFINE (scm_vector_move_right_x, 
"vector-move-right!", 5, 0, 0,
 #undef FUNC_NAME
 
 
-/* Generalized vectors. */
-
-int
-scm_is_generalized_vector (SCM obj)
-{
-  return (scm_is_vector (obj)
-         || scm_is_string (obj)
-         || scm_is_bitvector (obj)
-         || scm_is_uniform_vector (obj)
-         || scm_is_bytevector (obj));
-}
-
-SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} if @var{obj} is a vector, string,\n"
-           "bitvector, or uniform numeric vector.")
-#define FUNC_NAME s_scm_generalized_vector_p
-{
-  return scm_from_bool (scm_is_generalized_vector (obj));
-}
-#undef FUNC_NAME
-
-void
-scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
-{
-  scm_array_get_handle (vec, h);
-  if (scm_array_handle_rank (h) != 1)
-    scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
-}
-
-size_t
-scm_c_generalized_vector_length (SCM v)
+static SCM
+vector_handle_ref (scm_t_array_handle *h, size_t idx)
 {
-  if (scm_is_vector (v))
-    return scm_c_vector_length (v);
-  else if (scm_is_string (v))
-    return scm_c_string_length (v);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_length (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_length (v);
-  else if (scm_is_bytevector (v))
-    return scm_c_bytevector_length (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
+  if (idx > h->dims[0].ubnd)
+    scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx));
+  return ((SCM*)h->elements)[idx];
 }
 
-SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 
0,
-           (SCM v),
-           "Return the length of the generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_length
+static void
+vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
 {
-  return scm_from_size_t (scm_c_generalized_vector_length (v));
+  if (idx > h->dims[0].ubnd)
+    scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx));
+  ((SCM*)h->writable_elements)[idx] = val;
 }
-#undef FUNC_NAME
 
-SCM
-scm_c_generalized_vector_ref (SCM v, size_t idx)
+static void
+vector_get_handle (SCM v, scm_t_array_handle *h)
 {
-  if (scm_is_vector (v))
-    return scm_c_vector_ref (v, idx);
-  else if (scm_is_string (v))
-    return scm_c_string_ref (v, idx);
-  else if (scm_is_bitvector (v))
-    return scm_c_bitvector_ref (v, idx);
-  else if (scm_is_uniform_vector (v))
-    return scm_c_uniform_vector_ref (v, idx);
-  else if (scm_is_bytevector (v))
-    return scm_from_uint8 (scm_c_bytevector_ref (v, idx));
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_I_VECTOR_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM;
+  h->elements = h->writable_elements = SCM_I_VECTOR_WELTS (v);
 }
 
-SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
-           (SCM v, SCM idx),
-           "Return the element at index @var{idx} of the\n"
-           "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_ref
-{
-  return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
-{
-  if (scm_is_vector (v))
-    scm_c_vector_set_x (v, idx, val);
-  else if (scm_is_string (v))
-    scm_c_string_set_x (v, idx, val);
-  else if (scm_is_bitvector (v))
-    scm_c_bitvector_set_x (v, idx, val);
-  else if (scm_is_uniform_vector (v))
-    scm_c_uniform_vector_set_x (v, idx, val);
-  else if (scm_is_bytevector (v))
-    scm_i_bytevector_generalized_set_x (v, idx, val);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-
-SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
-           (SCM v, SCM idx, SCM val),
-           "Set the element at index @var{idx} of the\n"
-           "generalized vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_generalized_vector_set_x
-{
-  scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 
0,
-           (SCM v),
-           "Return a new list whose elements are the elements of the\n"
-           "generalized vector @var{v}.")
-#define FUNC_NAME s_scm_generalized_vector_to_list
-{
-  if (scm_is_vector (v))
-    return scm_vector_to_list (v);
-  else if (scm_is_string (v))
-    return scm_string_to_list (v);
-  else if (scm_is_bitvector (v))
-    return scm_bitvector_to_list (v);
-  else if (scm_is_uniform_vector (v))
-    return scm_uniform_vector_to_list (v);
-  else
-    scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
-}
-#undef FUNC_NAME
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2,
+                          vector_handle_ref, vector_handle_set,
+                          vector_get_handle);
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_wvect, 0x7f & ~2,
+                          vector_handle_ref, vector_handle_set,
+                          vector_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector);
 
 
 void
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 7af38d8..0e2cb6e 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -24,7 +24,7 @@
 
 
 #include "libguile/__scm.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 
 
 
@@ -61,21 +61,6 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_SIMPLE_VECTOR_REF(x,idx)     ((SCM_I_VECTOR_ELTS(x))[idx])
 #define SCM_SIMPLE_VECTOR_SET(x,idx,val) ((SCM_I_VECTOR_WELTS(x))[idx]=(val))
 
-/* Generalized vectors */
-
-SCM_API SCM scm_generalized_vector_p (SCM v);
-SCM_API SCM scm_generalized_vector_length (SCM v);
-SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_generalized_vector_to_list (SCM v);
-
-SCM_API int scm_is_generalized_vector (SCM obj);
-SCM_API size_t scm_c_generalized_vector_length (SCM v);
-SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API void scm_generalized_vector_get_handle (SCM vec,
-                                               scm_t_array_handle *h);
-
 /* Internals */
 
 #define SCM_I_IS_VECTOR(x)     (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index b0888c1..b373cd0 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -41,7 +41,7 @@ static SCM
 VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
 {
   /* VM registers */
-  register scm_byte_t *ip IP_REG;      /* instruction pointer */
+  register scm_t_uint8 *ip IP_REG;     /* instruction pointer */
   register SCM *sp SP_REG;             /* stack pointer */
   register SCM *fp FP_REG;             /* frame pointer */
 
@@ -107,11 +107,17 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int 
nargs)
 
     /* Initial frame */
     CACHE_REGISTER ();
+    PUSH ((SCM)fp); /* dynamic link */
+    PUSH (0); /* ra */
+    PUSH (0); /* mvra */
     CACHE_PROGRAM ();
     PUSH (program);
-    NEW_FRAME ();
-
-    /* Initial arguments */
+    fp = sp + 1;
+    INIT_FRAME ();
+    /* MV-call frame, function & arguments */
+    PUSH ((SCM)fp); /* dynamic link */
+    PUSH (0); /* ra */
+    PUSH (0); /* mvra */
     PUSH (prog);
     if (SCM_UNLIKELY (sp + nargs >= stack_limit))
       goto vm_error_too_many_args;
@@ -152,12 +158,12 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int 
nargs)
     SCM err_msg;
 
   vm_error_bad_instruction:
-    err_msg  = scm_from_locale_string ("VM: Bad instruction: ~A");
+    err_msg  = scm_from_locale_string ("VM: Bad instruction: ~s");
     finish_args = scm_list_1 (scm_from_uchar (ip[-1]));
     goto vm_error;
 
   vm_error_unbound:
-    err_msg  = scm_from_locale_string ("VM: Unbound variable: ~A");
+    err_msg  = scm_from_locale_string ("VM: Unbound variable: ~s");
     goto vm_error;
 
   vm_error_wrong_type_arg:
@@ -178,10 +184,9 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int 
nargs)
     goto vm_error;
 
   vm_error_wrong_type_apply:
-    err_msg  = scm_from_locale_string ("VM: Wrong type to apply: ~S "
-                                      "[IP offset: ~a]");
-    finish_args = scm_list_2 (program,
-                             SCM_I_MAKINUM (ip - bp->base));
+    SYNC_ALL ();
+    scm_error (scm_misc_error_key, FUNC_NAME, "Wrong type to apply: ~S",
+               scm_list_1 (program), SCM_BOOL_F);
     goto vm_error;
 
   vm_error_stack_overflow:
@@ -195,7 +200,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int 
nargs)
     goto vm_error;
 
   vm_error_improper_list:
-    err_msg  = scm_from_locale_string ("VM: Attempt to unroll an improper 
list: tail is ~A");
+    err_msg  = scm_from_locale_string ("Expected a proper list, but got object 
with tail ~s");
     goto vm_error;
 
   vm_error_not_a_pair:
@@ -211,12 +216,12 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int 
nargs)
     goto vm_error;
 
   vm_error_no_values:
-    err_msg  = scm_from_locale_string ("VM: 0-valued return");
+    err_msg  = scm_from_locale_string ("Zero values returned to single-valued 
continuation");
     finish_args = SCM_EOL;
     goto vm_error;
 
   vm_error_not_enough_values:
-    err_msg  = scm_from_locale_string ("VM: Not enough values for mv-bind");
+    err_msg  = scm_from_locale_string ("Too few values returned to 
continuation");
     finish_args = SCM_EOL;
     goto vm_error;
 
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index b819b90..3c1bbf6 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -386,34 +386,29 @@ do {                                              \
 /* See frames.h for the layout of stack frames */
 /* When this is called, bp points to the new program data,
    and the arguments are already on the stack */
-#define NEW_FRAME()                            \
+#define INIT_FRAME()                           \
 {                                              \
   int i;                                       \
-  SCM *dl, *data;                               \
-  scm_byte_t *ra = ip;                          \
-                                               \
-  /* Save old registers */                      \
-  ra = ip;                                      \
-  dl = fp;                                      \
                                                \
   /* New registers */                           \
-  fp = sp - bp->nargs + 1;                      \
-  data = SCM_FRAME_DATA_ADDRESS (fp);           \
-  sp = data + 2;                                \
+  sp += bp->nlocs;                              \
   CHECK_OVERFLOW ();                           \
   stack_base = sp;                             \
   ip = bp->base;                               \
                                                \
   /* Init local variables */                   \
-  for (i=bp->nlocs; i; i--)                     \
-    data[-i] = SCM_UNDEFINED;                   \
-                                               \
-  /* Set frame data */                         \
-  data[2] = (SCM)ra;                            \
-  data[1] = 0x0;                                \
-  data[0] = (SCM)dl;                            \
+  for (i=bp->nlocs; i;)                         \
+    sp[-(--i)] = SCM_UNDEFINED;                 \
 }
 
+#define DROP_FRAME()                            \
+  {                                             \
+    sp -= 3;                                    \
+    NULLSTACK (3);                              \
+    CHECK_UNDERFLOW ();                         \
+  }
+    
+
 /*
   Local Variables:
   c-file-style: "gnu"
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index b298c88..0662f81 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -71,13 +71,7 @@ VM_DEFINE_INSTRUCTION (3, drop, "drop", 0, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (4, mark, "mark", 0, 0, 1)
-{
-  PUSH (SCM_UNDEFINED);
-  NEXT;
-}
-
-VM_DEFINE_INSTRUCTION (5, dup, "dup", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (4, dup, "dup", 0, 0, 1)
 {
   SCM x = *sp;
   PUSH (x);
@@ -89,49 +83,49 @@ VM_DEFINE_INSTRUCTION (5, dup, "dup", 0, 0, 1)
  * Object creation
  */
 
-VM_DEFINE_INSTRUCTION (6, void, "void", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (5, void, "void", 0, 0, 1)
 {
   PUSH (SCM_UNSPECIFIED);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (7, make_true, "make-true", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (6, make_true, "make-true", 0, 0, 1)
 {
   PUSH (SCM_BOOL_T);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (8, make_false, "make-false", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (7, make_false, "make-false", 0, 0, 1)
 {
   PUSH (SCM_BOOL_F);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (9, make_eol, "make-eol", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (8, make_eol, "make-eol", 0, 0, 1)
 {
   PUSH (SCM_EOL);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (10, make_int8, "make-int8", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (9, make_int8, "make-int8", 1, 0, 1)
 {
   PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (11, make_int8_0, "make-int8:0", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (10, make_int8_0, "make-int8:0", 0, 0, 1)
 {
   PUSH (SCM_INUM0);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (12, make_int8_1, "make-int8:1", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (11, make_int8_1, "make-int8:1", 0, 0, 1)
 {
   PUSH (SCM_I_MAKINUM (1));
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (13, make_int16, "make-int16", 2, 0, 1)
+VM_DEFINE_INSTRUCTION (12, make_int16, "make-int16", 2, 0, 1)
 {
   int h = FETCH ();
   int l = FETCH ();
@@ -139,7 +133,7 @@ VM_DEFINE_INSTRUCTION (13, make_int16, "make-int16", 2, 0, 
1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (14, make_int64, "make-int64", 8, 0, 1)
+VM_DEFINE_INSTRUCTION (13, make_int64, "make-int64", 8, 0, 1)
 {
   scm_t_uint64 v = 0;
   v += FETCH ();
@@ -154,7 +148,7 @@ VM_DEFINE_INSTRUCTION (14, make_int64, "make-int64", 8, 0, 
1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (15, make_uint64, "make-uint64", 8, 0, 1)
+VM_DEFINE_INSTRUCTION (14, make_uint64, "make-uint64", 8, 0, 1)
 {
   scm_t_uint64 v = 0;
   v += FETCH ();
@@ -169,7 +163,7 @@ VM_DEFINE_INSTRUCTION (15, make_uint64, "make-uint64", 8, 
0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (16, make_char8, "make-char8", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (15, make_char8, "make-char8", 1, 0, 1)
 {
   scm_t_uint8 v = 0;
   v = FETCH ();
@@ -181,7 +175,7 @@ VM_DEFINE_INSTRUCTION (16, make_char8, "make-char8", 1, 0, 
1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (42, make_char32, "make-char32", 4, 0, 1)
+VM_DEFINE_INSTRUCTION (16, make_char32, "make-char32", 4, 0, 1)
 {
   scm_t_wchar v = 0;
   v += FETCH ();
@@ -221,34 +215,6 @@ VM_DEFINE_INSTRUCTION (18, vector, "vector", 2, -1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (19, list_mark, "list-mark", 0, 0, 0)
-{
-  POP_LIST_MARK ();
-  NEXT;
-}
-
-VM_DEFINE_INSTRUCTION (20, cons_mark, "cons-mark", 0, 0, 0)
-{
-  POP_CONS_MARK ();
-  NEXT;
-}
-
-VM_DEFINE_INSTRUCTION (21, vector_mark, "vector-mark", 0, 0, 0)
-{
-  POP_LIST_MARK ();
-  SYNC_REGISTER ();
-  *sp = scm_vector (*sp);
-  NEXT;
-}
-
-VM_DEFINE_INSTRUCTION (22, list_break, "list-break", 0, 0, 0)
-{
-  SCM l;
-  POP (l);
-  PUSH_LIST (l, SCM_NULLP);
-  NEXT;
-}
-
 
 /*
  * Variable access
@@ -271,7 +237,7 @@ VM_DEFINE_INSTRUCTION (22, list_break, "list-break", 0, 0, 
0)
 
 /* ref */
 
-VM_DEFINE_INSTRUCTION (23, object_ref, "object-ref", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (19, object_ref, "object-ref", 1, 0, 1)
 {
   register unsigned objnum = FETCH ();
   CHECK_OBJECT (objnum);
@@ -280,7 +246,7 @@ VM_DEFINE_INSTRUCTION (23, object_ref, "object-ref", 1, 0, 
1)
 }
 
 /* FIXME: necessary? elt 255 of the vector could be a vector... */
-VM_DEFINE_INSTRUCTION (24, long_object_ref, "long-object-ref", 2, 0, 1)
+VM_DEFINE_INSTRUCTION (20, long_object_ref, "long-object-ref", 2, 0, 1)
 {
   unsigned int objnum = FETCH ();
   objnum <<= 8;
@@ -290,14 +256,14 @@ VM_DEFINE_INSTRUCTION (24, long_object_ref, 
"long-object-ref", 2, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (25, local_ref, "local-ref", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (21, local_ref, "local-ref", 1, 0, 1)
 {
   PUSH (LOCAL_REF (FETCH ()));
   ASSERT_BOUND (*sp);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (26, long_local_ref, "long-local-ref", 2, 0, 1)
+VM_DEFINE_INSTRUCTION (22, long_local_ref, "long-local-ref", 2, 0, 1)
 {
   unsigned int i = FETCH ();
   i <<= 8;
@@ -307,7 +273,7 @@ VM_DEFINE_INSTRUCTION (26, long_local_ref, 
"long-local-ref", 2, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (23, variable_ref, "variable-ref", 0, 0, 1)
 {
   SCM x = *sp;
 
@@ -326,7 +292,7 @@ VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 
0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (28, toplevel_ref, "toplevel-ref", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (24, toplevel_ref, "toplevel-ref", 1, 0, 1)
 {
   unsigned objnum = FETCH ();
   SCM what;
@@ -349,7 +315,7 @@ VM_DEFINE_INSTRUCTION (28, toplevel_ref, "toplevel-ref", 1, 
0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (29, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
+VM_DEFINE_INSTRUCTION (25, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
 {
   SCM what;
   unsigned int objnum = FETCH ();
@@ -376,14 +342,14 @@ VM_DEFINE_INSTRUCTION (29, long_toplevel_ref, 
"long-toplevel-ref", 2, 0, 1)
 
 /* set */
 
-VM_DEFINE_INSTRUCTION (30, local_set, "local-set", 1, 1, 0)
+VM_DEFINE_INSTRUCTION (26, local_set, "local-set", 1, 1, 0)
 {
   LOCAL_SET (FETCH (), *sp);
   DROP ();
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (31, long_local_set, "long-local-set", 2, 1, 0)
+VM_DEFINE_INSTRUCTION (27, long_local_set, "long-local-set", 2, 1, 0)
 {
   unsigned int i = FETCH ();
   i <<= 8;
@@ -393,14 +359,14 @@ VM_DEFINE_INSTRUCTION (31, long_local_set, 
"long-local-set", 2, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 1, 0)
+VM_DEFINE_INSTRUCTION (28, variable_set, "variable-set", 0, 1, 0)
 {
   VARIABLE_SET (sp[0], sp[-1]);
   DROPN (2);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (33, toplevel_set, "toplevel-set", 1, 1, 0)
+VM_DEFINE_INSTRUCTION (29, toplevel_set, "toplevel-set", 1, 1, 0)
 {
   unsigned objnum = FETCH ();
   SCM what;
@@ -419,7 +385,7 @@ VM_DEFINE_INSTRUCTION (33, toplevel_set, "toplevel-set", 1, 
1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (34, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
+VM_DEFINE_INSTRUCTION (30, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
 {
   SCM what;
   unsigned int objnum = FETCH ();
@@ -464,7 +430,7 @@ VM_DEFINE_INSTRUCTION (34, long_toplevel_set, 
"long-toplevel-set", 2, 1, 0)
   NEXT;                                                \
 }
 
-VM_DEFINE_INSTRUCTION (35, br, "br", 2, 0, 0)
+VM_DEFINE_INSTRUCTION (31, br, "br", 2, 0, 0)
 {
   scm_t_int16 offset;
   FETCH_OFFSET (offset);
@@ -472,34 +438,34 @@ VM_DEFINE_INSTRUCTION (35, br, "br", 2, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (36, br_if, "br-if", 2, 0, 0)
+VM_DEFINE_INSTRUCTION (32, br_if, "br-if", 2, 0, 0)
 {
   BR (!SCM_FALSEP (*sp));
 }
 
-VM_DEFINE_INSTRUCTION (37, br_if_not, "br-if-not", 2, 0, 0)
+VM_DEFINE_INSTRUCTION (33, br_if_not, "br-if-not", 2, 0, 0)
 {
   BR (SCM_FALSEP (*sp));
 }
 
-VM_DEFINE_INSTRUCTION (38, br_if_eq, "br-if-eq", 2, 0, 0)
+VM_DEFINE_INSTRUCTION (34, br_if_eq, "br-if-eq", 2, 0, 0)
 {
   sp--; /* underflow? */
   BR (SCM_EQ_P (sp[0], sp[1]));
 }
 
-VM_DEFINE_INSTRUCTION (39, br_if_not_eq, "br-if-not-eq", 2, 0, 0)
+VM_DEFINE_INSTRUCTION (35, br_if_not_eq, "br-if-not-eq", 2, 0, 0)
 {
   sp--; /* underflow? */
   BR (!SCM_EQ_P (sp[0], sp[1]));
 }
 
-VM_DEFINE_INSTRUCTION (40, br_if_null, "br-if-null", 2, 0, 0)
+VM_DEFINE_INSTRUCTION (36, br_if_null, "br-if-null", 2, 0, 0)
 {
   BR (SCM_NULLP (*sp));
 }
 
-VM_DEFINE_INSTRUCTION (41, br_if_not_null, "br-if-not-null", 2, 0, 0)
+VM_DEFINE_INSTRUCTION (37, br_if_not_null, "br-if-not-null", 2, 0, 0)
 {
   BR (!SCM_NULLP (*sp));
 }
@@ -509,7 +475,15 @@ VM_DEFINE_INSTRUCTION (41, br_if_not_null, 
"br-if-not-null", 2, 0, 0)
  * Subprogram call
  */
 
-VM_DEFINE_INSTRUCTION (43, call, "call", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (38, new_frame, "new-frame", 0, 0, 3)
+{
+  PUSH ((SCM)fp); /* dynamic link */
+  PUSH (0);  /* mvra */
+  PUSH (0);  /* ra */
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (39, call, "call", 1, -1, 1)
 {
   SCM x;
   nargs = FETCH ();
@@ -528,71 +502,32 @@ VM_DEFINE_INSTRUCTION (43, call, "call", 1, -1, 1)
       program = x;
       CACHE_PROGRAM ();
       INIT_ARGS ();
-      NEW_FRAME ();
+      fp = sp - bp->nargs + 1;
+      ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
+      ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
+      SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+      SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0);
+      INIT_FRAME ();
       ENTER_HOOK ();
       APPLY_HOOK ();
       NEXT;
     }
-#ifdef ENABLE_TRAMPOLINE
-  /* Seems to slow down the fibo test, dunno why */
-  /*
-   * Subr call
-   */
-  switch (nargs) 
-    {
-    case 0:
-      {
-        scm_t_trampoline_0 call = scm_trampoline_0 (x);
-        if (call) 
-          {
-            SYNC_ALL ();
-            *sp = call (x);
-            NEXT;
-          }
-        break;
-      }
-    case 1:
-      {
-        scm_t_trampoline_1 call = scm_trampoline_1 (x);
-        if (call)
-          {
-            SCM arg1;
-            POP (arg1);
-            SYNC_ALL ();
-            *sp = call (x, arg1);
-            NEXT;
-          }
-        break;
-      }
-    case 2:
-      {
-        scm_t_trampoline_2 call = scm_trampoline_2 (x);
-        if (call)
-          {
-            SCM arg1, arg2;
-            POP (arg2);
-            POP (arg1);
-            SYNC_ALL ();
-            *sp = call (x, arg1, arg2);
-            NEXT;
-          }
-        break;
-      }
-    }
-#endif
   /*
    * Other interpreted or compiled call
    */
   if (!SCM_FALSEP (scm_procedure_p (x)))
     {
-      /* At this point, the stack contains the procedure and each one of its
-        arguments.  */
+      SCM args;
+      /* At this point, the stack contains the frame, the procedure and each 
one
+        of its arguments. */
       POP_LIST (nargs);
+      POP (args);
+      DROP (); /* drop the procedure */
+      DROP_FRAME ();
+      
       SYNC_REGISTER ();
-      /* keep args on stack so they are marked */
-      sp[-1] = scm_apply (x, sp[0], SCM_EOL);
+      PUSH (scm_apply (x, args, SCM_EOL));
       NULLSTACK_FOR_NONLOCAL_EXIT ();
-      DROP ();
       if (SCM_UNLIKELY (SCM_VALUESP (*sp)))
         {
           /* truncate values */
@@ -605,32 +540,12 @@ VM_DEFINE_INSTRUCTION (43, call, "call", 1, -1, 1)
         }
       NEXT;
     }
-  /*
-   * Continuation call
-   */
-  if (SCM_VM_CONT_P (x))
-    {
-      program = x;
-    vm_call_continuation:
-      /* Check the number of arguments */
-      /* FIXME multiple args */
-      if (nargs != 1)
-       scm_wrong_num_args (program);
-
-      /* Reinstate the continuation */
-      EXIT_HOOK ();
-      reinstate_vm_cont (vp, program);
-      CACHE_REGISTER ();
-      program = SCM_FRAME_PROGRAM (fp);
-      CACHE_PROGRAM ();
-      NEXT;
-    }
 
   program = x;
   goto vm_error_wrong_type_apply;
 }
 
-VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (40, goto_args, "goto/args", 1, -1, 1)
 {
   register SCM x;
   nargs = FETCH ();
@@ -641,151 +556,55 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, 
-1, 1)
   SCM_TICK;    /* allow interrupt here */
 
   /*
-   * Tail recursive call
-   */
-  if (SCM_EQ_P (x, program))
-    {
-      int i;
-
-      /* Move arguments */
-      INIT_ARGS ();
-      sp -= bp->nargs - 1;
-      for (i = 0; i < bp->nargs; i++)
-       LOCAL_SET (i, sp[i]);
-
-      /* Drop the first argument and the program itself.  */
-      sp -= 2;
-      NULLSTACK (bp->nargs + 1);
-
-      /* Init locals to valid SCM values */
-      for (i = 0; i < bp->nlocs; i++)
-       LOCAL_SET (i + bp->nargs, SCM_UNDEFINED);
-
-      /* Call itself */
-      ip = bp->base;
-      APPLY_HOOK ();
-      NEXT;
-    }
-
-  /*
-   * Tail call, but not to self -- reuse the frame, keeping the ra and dl
+   * Tail call
    */
   if (SCM_PROGRAM_P (x))
     {
-      SCM *data, *tail_args, *dl;
       int i;
-      scm_byte_t *ra, *mvra;
 #ifdef VM_ENABLE_STACK_NULLING
       SCM *old_sp;
 #endif
 
       EXIT_HOOK ();
 
-      /* save registers */
-      tail_args = stack_base + 2;
-      ra = SCM_FRAME_RETURN_ADDRESS (fp);
-      mvra = SCM_FRAME_MV_RETURN_ADDRESS (fp);
-      dl = SCM_FRAME_DYNAMIC_LINK (fp);
-
       /* switch programs */
       program = x;
       CACHE_PROGRAM ();
       INIT_ARGS ();
-      /* delay updating the frame so that if INIT_ARGS has to cons up a rest
-         arg, going into GC, the stack still makes sense */
-      fp[-1] = program;
-      nargs = bp->nargs;
 
 #ifdef VM_ENABLE_STACK_NULLING
       old_sp = sp;
       CHECK_STACK_LEAK ();
 #endif
 
-      /* new registers -- logically this would be better later, but let's make
-         sure we have space for the locals now */
-      data = SCM_FRAME_DATA_ADDRESS (fp);
-      ip = bp->base;
-      stack_base = data + 2;
-      sp = stack_base;
-      CHECK_OVERFLOW ();
-
-      /* copy args, bottom-up */
-      for (i = 0; i < nargs; i++)
-        fp[i] = tail_args[i];
+      /* delay shuffling the new program+args down so that if INIT_ARGS had to
+         cons up a rest arg, going into GC, the stack still made sense */
+      for (i = -1, sp = sp - bp->nargs + 1; i < bp->nargs; i++)
+        fp[i] = sp[i];
+      sp = fp + i - 1;
 
       NULLSTACK (old_sp - sp);
 
-      /* init locals */
-      for (i = bp->nlocs; i; i--)
-        data[-i] = SCM_UNDEFINED;
-      
-      /* Set frame data */
-      data[2] = (SCM)ra;
-      data[1] = (SCM)mvra;
-      data[0] = (SCM)dl;
+      INIT_FRAME ();
 
       ENTER_HOOK ();
       APPLY_HOOK ();
       NEXT;
     }
-#ifdef ENABLE_TRAMPOLINE
-  /* This seems to actually slow down the fibo test -- dunno why */
-  /*
-   * Subr call
-   */
-  switch (nargs) 
-    {
-    case 0:
-      {
-        scm_t_trampoline_0 call = scm_trampoline_0 (x);
-        if (call) 
-          {
-            SYNC_ALL ();
-            *sp = call (x);
-            goto vm_return;
-          }
-        break;
-      }
-    case 1:
-      {
-        scm_t_trampoline_1 call = scm_trampoline_1 (x);
-        if (call)
-          {
-            SCM arg1;
-            POP (arg1);
-            SYNC_ALL ();
-            *sp = call (x, arg1);
-            goto vm_return;
-          }
-        break;
-      }
-    case 2:
-      {
-        scm_t_trampoline_2 call = scm_trampoline_2 (x);
-        if (call)
-          {
-            SCM arg1, arg2;
-            POP (arg2);
-            POP (arg1);
-            SYNC_ALL ();
-            *sp = call (x, arg1, arg2);
-            goto vm_return;
-          }
-        break;
-      }
-    }
-#endif
 
   /*
    * Other interpreted or compiled call
    */
   if (!SCM_FALSEP (scm_procedure_p (x)))
     {
+      SCM args;
       POP_LIST (nargs);
+      POP (args);
+
       SYNC_REGISTER ();
-      sp[-1] = scm_apply (x, sp[0], SCM_EOL);
+      *sp = scm_apply (x, args, SCM_EOL);
       NULLSTACK_FOR_NONLOCAL_EXIT ();
-      DROP ();
+
       if (SCM_UNLIKELY (SCM_VALUESP (*sp)))
         {
           /* multiple values returned to continuation */
@@ -796,21 +615,16 @@ VM_DEFINE_INSTRUCTION (44, goto_args, "goto/args", 1, -1, 
1)
           PUSH_LIST (values, SCM_NULLP);
           goto vm_return_values;
         }
-      goto vm_return;
+      else
+        goto vm_return;
     }
 
   program = x;
 
-  /*
-   * Continuation call
-   */
-  if (SCM_VM_CONT_P (program))
-    goto vm_call_continuation;
-
   goto vm_error_wrong_type_apply;
 }
 
-VM_DEFINE_INSTRUCTION (45, goto_nargs, "goto/nargs", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (41, goto_nargs, "goto/nargs", 0, 0, 1)
 {
   SCM x;
   POP (x);
@@ -819,7 +633,7 @@ VM_DEFINE_INSTRUCTION (45, goto_nargs, "goto/nargs", 0, 0, 
1)
   goto vm_goto_args;
 }
 
-VM_DEFINE_INSTRUCTION (46, call_nargs, "call/nargs", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (42, call_nargs, "call/nargs", 0, 0, 1)
 {
   SCM x;
   POP (x);
@@ -828,7 +642,7 @@ VM_DEFINE_INSTRUCTION (46, call_nargs, "call/nargs", 0, 0, 
1)
   goto vm_call;
 }
 
-VM_DEFINE_INSTRUCTION (47, mv_call, "mv-call", 3, -1, 1)
+VM_DEFINE_INSTRUCTION (43, mv_call, "mv-call", 3, -1, 1)
 {
   SCM x;
   scm_t_int16 offset;
@@ -848,8 +662,12 @@ VM_DEFINE_INSTRUCTION (47, mv_call, "mv-call", 3, -1, 1)
       program = x;
       CACHE_PROGRAM ();
       INIT_ARGS ();
-      NEW_FRAME ();
-      SCM_FRAME_DATA_ADDRESS (fp)[1] = (SCM)mvra;
+      fp = sp - bp->nargs + 1;
+      ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
+      ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
+      SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+      SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra);
+      INIT_FRAME ();
       ENTER_HOOK ();
       APPLY_HOOK ();
       NEXT;
@@ -859,13 +677,17 @@ VM_DEFINE_INSTRUCTION (47, mv_call, "mv-call", 3, -1, 1)
    */
   if (!SCM_FALSEP (scm_procedure_p (x)))
     {
+      SCM args;
       /* At this point, the stack contains the procedure and each one of its
         arguments.  */
       POP_LIST (nargs);
+      POP (args);
+      DROP (); /* drop the procedure */
+      DROP_FRAME ();
+      
       SYNC_REGISTER ();
-      sp[-1] = scm_apply (x, sp[0], SCM_EOL);
+      PUSH (scm_apply (x, args, SCM_EOL));
       NULLSTACK_FOR_NONLOCAL_EXIT ();
-      DROP ();
       if (SCM_VALUESP (*sp))
         {
           SCM values, len;
@@ -878,20 +700,12 @@ VM_DEFINE_INSTRUCTION (47, mv_call, "mv-call", 3, -1, 1)
         }
       NEXT;
     }
-  /*
-   * Continuation call
-   */
-  if (SCM_VM_CONT_P (x))
-    {
-      program = x;
-      goto vm_call_continuation;
-    }
 
   program = x;
   goto vm_error_wrong_type_apply;
 }
 
-VM_DEFINE_INSTRUCTION (48, apply, "apply", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (44, apply, "apply", 1, -1, 1)
 {
   int len;
   SCM ls;
@@ -910,7 +724,7 @@ VM_DEFINE_INSTRUCTION (48, apply, "apply", 1, -1, 1)
   goto vm_call;
 }
 
-VM_DEFINE_INSTRUCTION (49, goto_apply, "goto/apply", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (45, goto_apply, "goto/apply", 1, -1, 1)
 {
   int len;
   SCM ls;
@@ -929,7 +743,7 @@ VM_DEFINE_INSTRUCTION (49, goto_apply, "goto/apply", 1, -1, 
1)
   goto vm_goto_args;
 }
 
-VM_DEFINE_INSTRUCTION (50, call_cc, "call/cc", 0, 1, 1)
+VM_DEFINE_INSTRUCTION (46, call_cc, "call/cc", 0, 1, 1)
 {
   int first;
   SCM proc, cont;
@@ -938,6 +752,9 @@ VM_DEFINE_INSTRUCTION (50, call_cc, "call/cc", 0, 1, 1)
   cont = scm_make_continuation (&first);
   if (first) 
     {
+      PUSH ((SCM)fp); /* dynamic link */
+      PUSH (0);  /* mvra */
+      PUSH (0);  /* ra */
       PUSH (proc);
       PUSH (cont);
       nargs = 1;
@@ -963,7 +780,7 @@ VM_DEFINE_INSTRUCTION (50, call_cc, "call/cc", 0, 1, 1)
     }
 }
 
-VM_DEFINE_INSTRUCTION (51, goto_cc, "goto/cc", 0, 1, 1)
+VM_DEFINE_INSTRUCTION (47, goto_cc, "goto/cc", 0, 1, 1)
 {
   int first;
   SCM proc, cont;
@@ -995,7 +812,7 @@ VM_DEFINE_INSTRUCTION (51, goto_cc, "goto/cc", 0, 1, 1)
     }
 }
 
-VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1)
+VM_DEFINE_INSTRUCTION (48, return, "return", 0, 1, 1)
 {
  vm_return:
   EXIT_HOOK ();
@@ -1003,17 +820,16 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1)
   SYNC_REGISTER ();
   SCM_TICK;    /* allow interrupt here */
   {
-    SCM ret, *data;
-    data = SCM_FRAME_DATA_ADDRESS (fp);
+    SCM ret;
 
     POP (ret);
     ASSERT (sp == stack_base);
-    ASSERT (stack_base == data + 2);
+    ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
 
     /* Restore registers */
     sp = SCM_FRAME_LOWER_ADDRESS (fp);
-    ip = SCM_FRAME_BYTE_CAST (data[2]);
-    fp = SCM_FRAME_STACK_CAST (data[0]);
+    ip = SCM_FRAME_RETURN_ADDRESS (fp);
+    fp = SCM_FRAME_DYNAMIC_LINK (fp);
     {
 #ifdef VM_ENABLE_STACK_NULLING
       int nullcount = stack_base - sp;
@@ -1033,28 +849,25 @@ VM_DEFINE_INSTRUCTION (52, return, "return", 0, 1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 1, -1, -1)
+VM_DEFINE_INSTRUCTION (49, return_values, "return/values", 1, -1, -1)
 {
   /* nvalues declared at top level, because for some reason gcc seems to think
      that perhaps it might be used without declaration. Fooey to that, I say. 
*/
-  SCM *data;
-
   nvalues = FETCH ();
  vm_return_values:
   EXIT_HOOK ();
   RETURN_HOOK ();
 
-  data = SCM_FRAME_DATA_ADDRESS (fp);
-  ASSERT (stack_base == data + 2);
+  ASSERT (stack_base == SCM_FRAME_UPPER_ADDRESS (fp) - 1);
 
   /* data[1] is the mv return address */
-  if (nvalues != 1 && data[1]) 
+  if (nvalues != 1 && SCM_FRAME_MV_RETURN_ADDRESS (fp)) 
     {
       int i;
       /* Restore registers */
       sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
-      ip = SCM_FRAME_BYTE_CAST (data[1]); /* multiple value ra */
-      fp = SCM_FRAME_STACK_CAST (data[0]);
+      ip = SCM_FRAME_MV_RETURN_ADDRESS (fp);
+      fp = SCM_FRAME_DYNAMIC_LINK (fp);
         
       /* Push return values, and the number of values */
       for (i = 0; i < nvalues; i++)
@@ -1073,8 +886,8 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 
1, -1, -1)
          continuation.) */
       /* Restore registers */
       sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
-      ip = SCM_FRAME_BYTE_CAST (data[2]); /* single value ra */
-      fp = SCM_FRAME_STACK_CAST (data[0]);
+      ip = SCM_FRAME_RETURN_ADDRESS (fp);
+      fp = SCM_FRAME_DYNAMIC_LINK (fp);
         
       /* Push first value */
       *++sp = stack_base[1];
@@ -1093,7 +906,7 @@ VM_DEFINE_INSTRUCTION (53, return_values, "return/values", 
1, -1, -1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (54, return_values_star, "return/values*", 1, -1, -1)
+VM_DEFINE_INSTRUCTION (50, return_values_star, "return/values*", 1, -1, -1)
 {
   SCM l;
 
@@ -1116,7 +929,7 @@ VM_DEFINE_INSTRUCTION (54, return_values_star, 
"return/values*", 1, -1, -1)
   goto vm_return_values;
 }
 
-VM_DEFINE_INSTRUCTION (55, truncate_values, "truncate-values", 2, -1, -1)
+VM_DEFINE_INSTRUCTION (51, truncate_values, "truncate-values", 2, -1, -1)
 {
   SCM x;
   int nbinds, rest;
@@ -1139,7 +952,7 @@ VM_DEFINE_INSTRUCTION (55, truncate_values, 
"truncate-values", 2, -1, -1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (56, box, "box", 1, 1, 0)
+VM_DEFINE_INSTRUCTION (52, box, "box", 1, 1, 0)
 {
   SCM val;
   POP (val);
@@ -1153,7 +966,7 @@ VM_DEFINE_INSTRUCTION (56, box, "box", 1, 1, 0)
      (set! a (lambda () (b ...)))
      ...)
  */
-VM_DEFINE_INSTRUCTION (57, empty_box, "empty-box", 1, 0, 0)
+VM_DEFINE_INSTRUCTION (53, empty_box, "empty-box", 1, 0, 0)
 {
   SYNC_BEFORE_GC ();
   LOCAL_SET (FETCH (),
@@ -1161,7 +974,7 @@ VM_DEFINE_INSTRUCTION (57, empty_box, "empty-box", 1, 0, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (58, local_boxed_ref, "local-boxed-ref", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (54, local_boxed_ref, "local-boxed-ref", 1, 0, 1)
 {
   SCM v = LOCAL_REF (FETCH ());
   ASSERT_BOUND_VARIABLE (v);
@@ -1169,7 +982,7 @@ VM_DEFINE_INSTRUCTION (58, local_boxed_ref, 
"local-boxed-ref", 1, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (59, local_boxed_set, "local-boxed-set", 1, 1, 0)
+VM_DEFINE_INSTRUCTION (55, local_boxed_set, "local-boxed-set", 1, 1, 0)
 {
   SCM v, val;
   v = LOCAL_REF (FETCH ());
@@ -1179,7 +992,7 @@ VM_DEFINE_INSTRUCTION (59, local_boxed_set, 
"local-boxed-set", 1, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (60, free_ref, "free-ref", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (56, free_ref, "free-ref", 1, 0, 1)
 {
   scm_t_uint8 idx = FETCH ();
   
@@ -1190,7 +1003,7 @@ VM_DEFINE_INSTRUCTION (60, free_ref, "free-ref", 1, 0, 1)
 
 /* no free-set -- if a var is assigned, it should be in a box */
 
-VM_DEFINE_INSTRUCTION (61, free_boxed_ref, "free-boxed-ref", 1, 0, 1)
+VM_DEFINE_INSTRUCTION (57, free_boxed_ref, "free-boxed-ref", 1, 0, 1)
 {
   SCM v;
   scm_t_uint8 idx = FETCH ();
@@ -1201,7 +1014,7 @@ VM_DEFINE_INSTRUCTION (61, free_boxed_ref, 
"free-boxed-ref", 1, 0, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (62, free_boxed_set, "free-boxed-set", 1, 1, 0)
+VM_DEFINE_INSTRUCTION (58, free_boxed_set, "free-boxed-set", 1, 1, 0)
 {
   SCM v, val;
   scm_t_uint8 idx = FETCH ();
@@ -1213,18 +1026,18 @@ VM_DEFINE_INSTRUCTION (62, free_boxed_set, 
"free-boxed-set", 1, 1, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (63, make_closure, "make-closure", 0, 2, 1)
+VM_DEFINE_INSTRUCTION (59, make_closure, "make-closure", 0, 2, 1)
 {
   SCM vect;
   POP (vect);
   SYNC_BEFORE_GC ();
   /* fixme underflow */
-  SCM_NEWSMOB3 (*sp, scm_tc16_program, SCM_PROGRAM_OBJCODE (*sp),
-                SCM_PROGRAM_OBJTABLE (*sp), vect);
+  *sp = scm_double_cell (scm_tc7_program, (scm_t_bits)SCM_PROGRAM_OBJCODE 
(*sp),
+                         (scm_t_bits)SCM_PROGRAM_OBJTABLE (*sp), 
(scm_t_bits)vect);
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (64, make_variable, "make-variable", 0, 0, 1)
+VM_DEFINE_INSTRUCTION (60, make_variable, "make-variable", 0, 0, 1)
 {
   SYNC_BEFORE_GC ();
   /* fixme underflow */
@@ -1232,7 +1045,7 @@ VM_DEFINE_INSTRUCTION (64, make_variable, 
"make-variable", 0, 0, 1)