Merging Guile-R6RS-Libs in `master'

Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Hello Guilers!

I think it'd be nice to merge what's in Guile-R6RS-Libs into `master'.
There are a few issues that need to be sorted out, though.

The API is visible at
http://www.fdn.fr/~lcourtes/software/guile/guile-r6rs-libs.html and the
standard is at
http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-1.html#node_toc_start .

  0. Incompleteness

     Guile-R6RS-Libs provides a small subset of what's in /R6RS Standard
     Libraries/.  In particular:

       - The UTF routines in `(rnrs bytevector)' are available, but wide
         string support isn't (yet) available.  I think that's not a big
         issue given that Mike is working on it.

       - The `(rnrs io ports)' provides only binary I/O routines.  These
         routines do not use the right exception mechanism.  For
         instance, `port-position' should raise an `&assertion' R6RS
         error condition, which isn't implemented.

       - Some of the I/O procedures take a TRANSCODER argument but
         ignore it.

    Although it's incomplete compared to the standard, I find it useful
    because the APIs provide functionality not otherwise available in
    Guile.

  1. Module naming

     The 2 available modules are named `(rnrs ...)', as described in
     R6RS.  However, R6RS specifies the version number `(6)' as part of
     the name as well, which we don't support.

     Modules could be called `(r6rs ...)', which would address the
     version number problem, or even `(ice-9 ...)', which would make it
     clear that the implementation is not R6RS-compliant but rather
     "inspired" by R6RS APIs.

     I'm not sure which one of these 3 options is the best one.  This
     will probably depend on how Unicode support evolves.


  2. C name space

     C function/macro/variable names are all prefixed with `scm_r6rs_'.
     Should it change to `scm_'?

  3. Bytevectors as generalized vectors?

     We could easily make bytevectors accessible through the generalized
     vector API.

     Pros: good integration, intuitive, convenient.
     Cons: incentive to use a "standard" API in a non-standard way.

     The latter may not be a problem since SRFI-4 vectors already behave
     this way.

  4. Bytevector read syntax

     ... needs to be implemented.


Comments welcome.

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Julian Graham]

Hi Ludovic,

Cool!  Thanks for doing this.


>     Modules could be called `(r6rs ...)', which would address the
>     version number problem, or even `(ice-9 ...)', which would make it
>     clear that the implementation is not R6RS-compliant but rather
>     "inspired" by R6RS APIs.

For what it's worth, I'd prefer the `(ice-9 ...)' approach, since, to
be fair, these are Guile modules, not R6RS libraries (which have some
specific differences in their export interfaces and the way they are
looked up / matched).

On a related note, have you had a chance to review the R6RS library
search mechanism I proposed a while back? [1]  Using that algorithm
(and going with the `ice-9' prefix), your modules could be wrapped
such that:

  * There would exist a library wrapper module called `(rnrs bytevectors)'

  * Loading this module would cause the library form for the R6RS
library `(rnrs bytevectors (6))' to be loaded (from, say, a file in
the same directory called "bytevectors.scm.6") and registered with the
R6RS library system.

  * This library would delegate to `(ice-9 rnrs bytevector)' and
re-export its bindings as required.

Does that make sense?  This way your module would be available both to
users of the Guile module and to users of R6RS libraries while
maintaining proper version semantics.


Regards,
Julian

[1] - http://article.gmane.org/gmane.lisp.guile.devel/8305

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Hi Julian,

Julian Graham <joolean@gmail.com> writes:

> On a related note, have you had a chance to review the R6RS library
> search mechanism I proposed a while back? [1]  Using that algorithm
> (and going with the `ice-9' prefix), your modules could be wrapped
> such that:
>
>   * There would exist a library wrapper module called `(rnrs bytevectors)'
>
>   * Loading this module would cause the library form for the R6RS
> library `(rnrs bytevectors (6))' to be loaded (from, say, a file in
> the same directory called "bytevectors.scm.6") and registered with the
> R6RS library system.
>
>   * This library would delegate to `(ice-9 rnrs bytevector)' and
> re-export its bindings as required.
>
> Does that make sense?  This way your module would be available both to
> users of the Guile module and to users of R6RS libraries while
> maintaining proper version semantics.

Hmm, I concur with Andy "that the Guile module `(foo)' should be
representable as the R6RS module `(foo)', and vice versa".  Is there any
reason why this wouldn't be possible (sorry if this has already been
said)?

That means, for instance, that module versioning could first be
implemented in Guile's module system, which would then simply be used by
the `library' form.

The main differences between these two module systems are module
versioning, and phase separation.  Fortunately, R6RS' system is a
superset of Guile's, so we could extend the latter so that it could be
used as the foundation of the former.

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Julian Graham]

Hi Ludovic,

> That means, for instance, that module versioning could first be
> implemented in Guile's module system, which would then simply be used by
> the `library' form.
>
> The main differences between these two module systems are module
> versioning, and phase separation.  Fortunately, R6RS' system is a
> superset of Guile's, so we could extend the latter so that it could be
> used as the foundation of the former.

Hey, if we're open to extending the module system, then sure -- that
would certainly make for a cleaner, more efficient implementation.
That's got my vote.


Regards,
Julian

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Hello,

Julian Graham <joolean@gmail.com> writes:

> Hey, if we're open to extending the module system, then sure -- that
> would certainly make for a cleaner, more efficient implementation.
> That's got my vote.

Cool!  ;-)

The trick is to extend it in a backward-compatible way as much as
possible.  But now that we have hygiene and `use-syntax' has been
sort-of phased out (Andy?), that should be doable.

Perhaps we could create a branch so that you could experiment things?

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Julian Graham]

> Cool!  ;-)
>
> The trick is to extend it in a backward-compatible way as much as
> possible.  But now that we have hygiene and `use-syntax' has been
> sort-of phased out (Andy?), that should be doable.
>
> Perhaps we could create a branch so that you could experiment things?


*Urk*  You didn't mean me, did you?  I have to confess, I'm totally at
a loss as to how we're going to make versioning work with the autoload
system.  Maybe we could discuss a little first?

In particular, I see some difficulty in terms of determining whether
to fully load and evaluate a module form during search.  My
understanding is that, in general terms, the existing system does the
following:

1. Checks the set of registered modules
2. Locates a candidate module based on filename and loads it
3. Re-checks the set of registered modules

Is that more or less accurate?  The main assumption here is, I think,
that the first file matching the module specifier will contain the
definition of the desired module.  Based on our discussion of ways of
representing version [1], that may no longer hold.


Regards,
Julian

[1] - http://article.gmane.org/gmane.lisp.guile.devel/8172

Re: Merging Guile-R6RS-Libs in `master'

[Andy Wingo]

Hi Julian!

On Wed 22 Apr 2009 20:32, Julian Graham <joolean@gmail.com> writes:

> I have to confess, I'm totally at a loss as to how we're going to make
> versioning work with the autoload system.
>
> In particular, I see some difficulty in terms of determining whether
> to fully load and evaluate a module form during search.  My
> understanding is that, in general terms, the existing system does the
> following:
>
> 1. Checks the set of registered modules
> 2. Locates a candidate module based on filename and loads it
> 3. Re-checks the set of registered modules

This is the process for the modules that exist currently. Note that no
module that currently exists has a version; so the lookup procedure for
versioned modules can be different than what we currently have.

For example, we can load a file, knowing with certainty that it should
define a module of the given name and version.

Not sure where I'm going with this ;)

But given that the non-normative Appendix F states:

    Names for libraries may include a version. An import spec may
    designate a set of acceptable versions that may be imported.
    Conversely, only one version of each library should be part of a
    program. This allows using the “name part” of a library name for
    different purposes than the version.

    In particular, if several different variants of a library exists
    where it is feasible that they coexist in the same program, it is
    recommended that different names be used for the variants. In
    contrast, for compatible versions of a library where coexistence of
    several versions is unnecessary and undesirable, it is recommended
    that the same name and different versions be used. In particular, it
    is recommended that new versions of libraries that are conservative
    extensions of old ones differ only in the version, not in the name.
    Correspondingly, it is recommended that import specs do not
    constrain an import to a single version, but instead specify a wide
    range of acceptable versions of a library.

    Implementations that allow two libraries of the same name with
    different versions to coexist in the same program should report when
    processing a program that actually makes use of this extension.

Guile should probably only support one "live" version of a module. So
Guile's internal module namespace stays the same. Versions are only
important when loading files from disk. I propose that we do it like
this:

  (foo bar) -> foo/bar.scm in the path, just as we have it now
  (foo bar (n)) -> foo/barSEPn.scm, where SEP is some separator not
  valid in identifiers.

Candidates for SEP? Unfortunately all the ones that can be bare in the
shell seem to be taken. Actually maybe `/' is a good candidate, or in
general the path separator. So it would be foo/bar/n.scm, where n would
be the version.

We then fix the path-searching functions in load.c to understand
versions -- some trickiness there but we can do it.

Cheers,

Andy
-- 
http://wingolog.org/

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Andy Wingo <wingo@pobox.com> writes:

> But given that the non-normative Appendix F states:

[...]

>     In particular, it is recommended that new versions of libraries
>     that are conservative extensions of old ones differ only in the
>     version, not in the name.  Correspondingly, it is recommended that
>     import specs do not constrain an import to a single version, but
>     instead specify a wide range of acceptable versions of a library.

I've always felt that this versioning thing was half-baked.  That the
appendix recommends *not* to use it in some cases is not reassuring...

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Julian Graham]

Hi Andy,

> Guile should probably only support one "live" version of a module. So
> Guile's internal module namespace stays the same. Versions are only
> important when loading files from disk. I propose that we do it like
> this:

Actually, I'd like to disagree here -- maybe I've been writing too
much Java, but isn't it possible that the VM would be running more
than one "program" (or maybe I misunderstand that term)?  Or let's say
that I absolutely need version 4 of library `foo', but that in the
transitive closure of my library dependencies, there's another library
(which I may prefer not to modify) that absolutely needs version 3 of
`foo'.


>  (foo bar) -> foo/bar.scm in the path, just as we have it now
>  (foo bar (n)) -> foo/barSEPn.scm, where SEP is some separator not
>  valid in identifiers.
>
> Candidates for SEP? Unfortunately all the ones that can be bare in the
> shell seem to be taken. Actually maybe `/' is a good candidate, or in
> general the path separator. So it would be foo/bar/n.scm, where n would
> be the version.
>
> We then fix the path-searching functions in load.c to understand
> versions -- some trickiness there but we can do it.

I like this, except it puts the constraint on module authors that
their source files need to be named n.scm.  Maybe that's not a big
deal (and it could be mitigated with some kind of "install"
procedure), but what if the mapping were:

(foo bar baz (m n)) -> foo/bar/m/n/baz.scm


Regards,
Julian

Re: Merging Guile-R6RS-Libs in `master'

[Andy Wingo]

On Wed 22 Apr 2009 22:22, Julian Graham <joolean@gmail.com> writes:

> Hi Andy,
>
>> Guile should probably only support one "live" version of a module. So
>> Guile's internal module namespace stays the same. Versions are only
>> important when loading files from disk. I propose that we do it like
>> this:
>
> Actually, I'd like to disagree here -- maybe I've been writing too
> much Java, but isn't it possible that the VM would be running more
> than one "program" (or maybe I misunderstand that term)?  Or let's say
> that I absolutely need version 4 of library `foo', but that in the
> transitive closure of my library dependencies, there's another library
> (which I may prefer not to modify) that absolutely needs version 3 of
> `foo'.

I can imagine this, but I can't imagine it working. What if those
modules dlopen different versions of a shared library? There's going to
be breakage, one way or another. Better to error out, "Version 3.2 is
already loaded, incompatible with >= 4.0", or something.

I agree with Ludo that versions are a bit half-baked. We should do what
it takes to support them, but my personal opinion is that we don't have
to think more about the things that the editors forgot to think about --
i.e. concurrent versions of the same lib.

The problem of upgrading a module's version within a running system
seems to be isomorphic to reloading a module. Jao has some ideas about
how to do that.

> (foo bar baz (m n)) -> foo/bar/m/n/baz.scm

Looks good to me!

My two cents,

Andy
-- 
http://wingolog.org/

Re: Merging Guile-R6RS-Libs in `master'

[Andy Wingo]

On Wed 22 Apr 2009 17:53, ludo@gnu.org (Ludovic Courtès) writes:

> Julian Graham <joolean@gmail.com> writes:
>
>> Hey, if we're open to extending the module system, then sure -- that
>> would certainly make for a cleaner, more efficient implementation.
>> That's got my vote.

Mine too :)

> The trick is to extend it in a backward-compatible way as much as
> possible.  But now that we have hygiene and `use-syntax' has been
> sort-of phased out (Andy?), that should be doable.

use-syntax deprecation is coming soon, perhaps tonight.

> Perhaps we could create a branch so that you could experiment things?

What would it have? Module versions? We should probably take advantage
of the occasion to separate the variable namespace from the module
namespace.

Cheers,

Andy
-- 
http://wingolog.org/

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Andy Wingo <wingo@pobox.com> writes:

> On Wed 22 Apr 2009 17:53, ludo@gnu.org (Ludovic Courtès) writes:

>> Perhaps we could create a branch so that you could experiment things?
>
> What would it have? Module versions?

Yes, to start with.

> We should probably take advantage
> of the occasion to separate the variable namespace from the module
> namespace.

Oooh, Andy, you are subversive.  ;-)

Honestly, I'm not yet a 100% convinced that we should get rid of it.
I'm well aware of its shortcomings (inevitable name clashes, mostly),
but it feels like a natural fit in a system with first-class modules.
Admittedly, I'm still in search of a problem the hierarchical name space
could solve, but, hey, who knows?  :-)

I'm also slightly concerned about compatibility issues if we remove it.

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Andy Wingo]

Hi Ludovic,

On Wed 22 Apr 2009 09:55, ludo@gnu.org (Ludovic Courtès) writes:

> That means, for instance, that module versioning could first be
> implemented in Guile's module system, which would then simply be used by
> the `library' form.

That probably makes sense, yes.

> The main differences between these two module systems are module
> versioning, and phase separation.  Fortunately, R6RS' system is a
> superset of Guile's, so we could extend the latter so that it could be
  ^^^^^^^^
> used as the foundation of the former.

Perhaps you meant to say subset? I believe we'll succeed in implementing
r6rs modules with Guile modules, but I don't think you could implement
Guile modules on top of r6rs modules.

Besides that, I don't think that phasing has any practical implication,
given the loopholes in the spec -- the set of bindings that a module
needs can be determined for *all* phases. That is to say, there is one
set of bindings that satisfies the needs of the spec for all phases of
evaluation of a module. Bindings needed at expansion time will be
present at runtime, but that's allowed.

Just some nitpicks :)

Andy
-- 
http://wingolog.org/

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Hello Andy,

Andy Wingo <wingo@pobox.com> writes:

> On Wed 22 Apr 2009 09:55, ludo@gnu.org (Ludovic Courtès) writes:

>> The main differences between these two module systems are module
>> versioning, and phase separation.  Fortunately, R6RS' system is a
>> superset of Guile's, so we could extend the latter so that it could be
>   ^^^^^^^^
>> used as the foundation of the former.
>
> Perhaps you meant to say subset? I believe we'll succeed in implementing
> r6rs modules with Guile modules, but I don't think you could implement
> Guile modules on top of r6rs modules.

Yes, but what I meant to say was that R6RS' module system is stricter,
or more precisely defined than Guile's, but...

> Besides that, I don't think that phasing has any practical implication,
> given the loopholes in the spec -- the set of bindings that a module
> needs can be determined for *all* phases. That is to say, there is one
> set of bindings that satisfies the needs of the spec for all phases of
> evaluation of a module. Bindings needed at expansion time will be
> present at runtime, but that's allowed.

I didn't know the spec was so permissive.  Given that, indeed, R6'
module system is a subset of Guile's.

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Julian Graham]

>> Besides that, I don't think that phasing has any practical implication,
>> given the loopholes in the spec -- the set of bindings that a module
>> needs can be determined for *all* phases. That is to say, there is one
>> set of bindings that satisfies the needs of the spec for all phases of
>> evaluation of a module. Bindings needed at expansion time will be
>> present at runtime, but that's allowed.
>
> I didn't know the spec was so permissive.  Given that, indeed, R6'
> module system is a subset of Guile's.

Yeah, it's kind of amazing: It takes several pages to lay out a rich,
complex description of binding visibility and instantiation timing and
then rolls it all back in a paragraph at the end that basically says,
"Of course, implementations are free to disregard all of this."

Re: Merging Guile-R6RS-Libs in `master'

[Andy Wingo]

Hello Ludovic,

On Tue 21 Apr 2009 23:18, ludo@gnu.org (Ludovic Courtès) writes:

> Hello Guilers!
>
> I think it'd be nice to merge what's in Guile-R6RS-Libs into `master'.

I do too!

>      The 2 available modules are named `(rnrs ...)', as described in
>      R6RS.  However, R6RS specifies the version number `(6)' as part of
>      the name as well, which we don't support.
>
>      Modules could be called `(r6rs ...)', which would address the
>      version number problem, or even `(ice-9 ...)', which would make it
>      clear that the implementation is not R6RS-compliant but rather
>      "inspired" by R6RS APIs.
>
>      I'm not sure which one of these 3 options is the best one.  This
>      will probably depend on how Unicode support evolves.

My intuition is that the Guile module `(foo)' should be representable as
the R6RS module `(foo)', and vice versa. At this point, I know of no
caveats.

If this intuition is correct, `rnrs' should be the prefix; what to do
with (6) is another question. Julian, do you know of any pitfalls in
unifying the R6RS module namespace with the Guile module namespace?

>   2. C name space
>
>      C function/macro/variable names are all prefixed with `scm_r6rs_'.
>      Should it change to `scm_'?

FWIW, I think so.

>   3. Bytevectors as generalized vectors?
>
>      We could easily make bytevectors accessible through the generalized
>      vector API.
>
>      Pros: good integration, intuitive, convenient.
>      Cons: incentive to use a "standard" API in a non-standard way.
>
>      The latter may not be a problem since SRFI-4 vectors already behave
>      this way.

I have never used e.g. generalized-vector-ref. Too much typing. Do it if
it makes sense, or if it's too much work add a FIXME to the docs so
someone else can come along and take care of it.

>   4. Bytevector read syntax
>
>      ... needs to be implemented.

You are the reader master :)

> Comments welcome.

o/~ Did you ever know that you're my hero o/~

Andy
-- 
http://wingolog.org/

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Hi Andy,

Andy Wingo <wingo@pobox.com> writes:

> My intuition is that the Guile module `(foo)' should be representable as
> the R6RS module `(foo)', and vice versa.

+1.

>>   2. C name space
>>
>>      C function/macro/variable names are all prefixed with `scm_r6rs_'.
>>      Should it change to `scm_'?
>
> FWIW, I think so.

OK.

> I have never used e.g. generalized-vector-ref. Too much typing. Do it if
> it makes sense, or if it's too much work add a FIXME to the docs so
> someone else can come along and take care of it.

OK, I'll do it as a bonus.

(BTW, method dispatching in this code could probably be improved...)

Thanks!

Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

[-- Attachment #1.1: Type: text/plain, Size: 610 bytes --]

Hello!

Attached is my initial patch to integrate Guile-R6RS-Libs (bytevectors
and I/O ports).  I'll commit it shortly to `master' if nobody objects.

It adds a dependency on GNU libunistring (by Bruno Haible).  We could
avoid it by importing all the Gnulib modules libunistring is based on,
but I think it's better to not ship and link a copy of such a large body
of code.  Mike's work needs it as well.

Then will come:

  * documentation, probably with bytevectors in `api-data.texi' and
    ports in `api-io.texi';

  * reader extension;

  * generalized vector extension for bytevectors.

Thanks,
Ludo'.


[-- Attachment #1.2: The patch --]
[-- Type: text/x-patch, Size: 164725 bytes --]

From 49e92cb7e629792fd670ac5b6a23cdba9641658d Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 27 May 2009 18:18:07 +0200
Subject: [PATCH] Import R6RS bytevectors and I/O ports from Guile-R6RS-Libs 0.2.

* README: Document dependency on GNU libunistring.

* benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add
  `benchmark/bytevectors.bm'.

* configure.in: Make sure we have libunistring; update $LIBS.

* libguile.h: Include "bytevectors.h" and "r6rs-ports.h".

* libguile/Makefile.am (libguile_la_SOURCES): Add `bytevectors.c' and
  `r6rs-ports.c'
  (DOT_X_FILES): Add `bytevectors.x' and `r6rs-ports.x'.
  (DOT_DOC_FILES): Add `bytevectors.doc' and `r6rs-ports.doc'.
  (noinst_HEADERS): Add `ieee-754.h'.
  (modinclude_HEADERS): Add `bytevectors.h' and `r6rs-ports.h'

* libguile/validate.h (SCM_VALIDATE_BYTEVECTOR): New macro.

* module/Makefile.am (SOURCES): Add $(RNRS_SOURCES).
  (RNRS_SOURCES): New variable.

* test-suite/Makefile.am (SCM_TESTS): Add `bytevectors.test' and
  `r6rs-ports.test'.
---
 README                                    |    6 +
 benchmark-suite/Makefile.am               |    1 +
 benchmark-suite/benchmarks/bytevectors.bm |   99 ++
 configure.in                              |    7 +
 libguile.h                                |    4 +-
 libguile/Makefile.am                      |   26 +-
 libguile/bytevectors.c                    | 1978 +++++++++++++++++++++++++++++
 libguile/bytevectors.h                    |  133 ++
 libguile/ieee-754.h                       |   90 ++
 libguile/r6rs-ports.c                     | 1118 ++++++++++++++++
 libguile/r6rs-ports.h                     |   43 +
 libguile/validate.h                       |    5 +-
 module/Makefile.am                        |    7 +-
 module/rnrs/bytevector.scm                |   84 ++
 module/rnrs/io/ports.scm                  |  111 ++
 test-suite/Makefile.am                    |    2 +
 test-suite/tests/bytevectors.test         |  531 ++++++++
 test-suite/tests/r6rs-ports.test          |  455 +++++++
 18 files changed, 4688 insertions(+), 12 deletions(-)
 create mode 100644 benchmark-suite/benchmarks/bytevectors.bm
 create mode 100644 libguile/bytevectors.c
 create mode 100644 libguile/bytevectors.h
 create mode 100644 libguile/ieee-754.h
 create mode 100644 libguile/r6rs-ports.c
 create mode 100644 libguile/r6rs-ports.h
 create mode 100644 module/rnrs/bytevector.scm
 create mode 100644 module/rnrs/io/ports.scm
 create mode 100644 test-suite/tests/bytevectors.test
 create mode 100644 test-suite/tests/r6rs-ports.test

diff --git a/README b/README
index 9993fcf..4950229 100644
--- a/README
+++ b/README
@@ -61,6 +61,12 @@ Guile requires the following external packages:
     libltdl is used for loading extensions at run-time.  It is
     available from http://www.gnu.org/software/libtool/
 
+  - GNU libunistring
+
+    libunistring is used for Unicode string operations, such as the
+    `utf*->string' procedures.  It is available from
+    http://www.gnu.org/software/libunistring/ .
+
 
 Special Instructions For Some Systems =====================================
 
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index e65e8bc..dcadd58 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -1,4 +1,5 @@
 SCM_BENCHMARKS = benchmarks/0-reference.bm		\
+		 benchmarks/bytevectors.bm		\
 	         benchmarks/continuations.bm		\
                  benchmarks/if.bm			\
                  benchmarks/logand.bm			\
diff --git a/benchmark-suite/benchmarks/bytevectors.bm b/benchmark-suite/benchmarks/bytevectors.bm
new file mode 100644
index 0000000..9547a71
--- /dev/null
+++ b/benchmark-suite/benchmarks/bytevectors.bm
@@ -0,0 +1,99 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; R6RS Byte Vectors.
+;;;
+;;; Copyright 2009  Ludovic Courtès <ludo@gnu.org>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+(define-module (benchmarks bytevector)
+  :use-module (rnrs bytevector)
+  :use-module (srfi srfi-4)
+  :use-module (benchmark-suite lib))
+
+(define bv (make-bytevector 16384))
+
+(define %native-endianness
+  (native-endianness))
+
+(define %foreign-endianness
+  (if (eq? (native-endianness) (endianness little))
+      (endianness big)
+      (endianness little)))
+
+(define u8v  (make-u8vector 16384))
+(define u16v (make-u16vector 8192))
+(define u32v (make-u32vector 4196))
+(define u64v (make-u64vector 2048))
+
+\f
+(with-benchmark-prefix "ref/set!"
+
+  (benchmark "bytevector-u8-ref" 1000000
+    (bytevector-u8-ref bv 0))
+
+  (benchmark "bytevector-u16-ref (foreign)" 1000000
+    (bytevector-u16-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u16-ref (native)" 1000000
+    (bytevector-u16-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u16-native-ref" 1000000
+    (bytevector-u16-native-ref bv 0))
+
+  (benchmark "bytevector-u32-ref (foreign)" 1000000
+    (bytevector-u32-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u32-ref (native)" 1000000
+    (bytevector-u32-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u32-native-ref" 1000000
+    (bytevector-u32-native-ref bv 0))
+
+  (benchmark "bytevector-u64-ref (foreign)" 1000000
+    (bytevector-u64-ref bv 0 %foreign-endianness))
+
+  (benchmark "bytevector-u64-ref (native)" 1000000
+    (bytevector-u64-ref bv 0 %native-endianness))
+
+  (benchmark "bytevector-u64-native-ref" 1000000
+    (bytevector-u16-native-ref bv 0)))
+
+\f
+(with-benchmark-prefix "lists"
+
+  (benchmark "bytevector->u8-list" 2000
+    (bytevector->u8-list bv))
+
+  (benchmark "bytevector->uint-list 16-bit" 2000
+    (bytevector->uint-list bv (native-endianness) 2))
+
+  (benchmark "bytevector->uint-list 64-bit" 2000
+    (bytevector->uint-list bv (native-endianness) 8)))
+
+\f
+(with-benchmark-prefix "SRFI-4" ;; for comparison
+
+  (benchmark "u8vector-ref" 1000000
+    (u8vector-ref u8v 0))
+
+  (benchmark "u16vector-ref" 1000000
+    (u16vector-ref u16v 0))
+
+  (benchmark "u32vector-ref" 1000000
+    (u32vector-ref u32v 0))
+
+  (benchmark "u64vector-ref" 1000000
+    (u64vector-ref u64v 0)))
diff --git a/configure.in b/configure.in
index 07c4766..6568e52 100644
--- a/configure.in
+++ b/configure.in
@@ -836,6 +836,13 @@ AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <gmp.h>]],
   [],
   [AC_MSG_ERROR([At least GNU MP 4.1 is required, see README])])
 
+dnl GNU libunistring tests.
+if test "x$LTLIBUNISTRING" != "x"; then
+   LIBS="$LTLIBUNISTRING $LIBS"
+else
+   AC_MSG_ERROR([GNU libunistring is required, please install it.])
+fi
+
 dnl i18n tests
 #AC_CHECK_HEADERS([libintl.h])
 #AC_CHECK_FUNCS(gettext)
diff --git a/libguile.h b/libguile.h
index 40122df..6a6d232 100644
--- a/libguile.h
+++ b/libguile.h
@@ -1,7 +1,7 @@
 #ifndef SCM_LIBGUILE_H
 #define SCM_LIBGUILE_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,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
@@ -32,6 +32,7 @@ extern "C" {
 #include "libguile/arbiters.h"
 #include "libguile/async.h"
 #include "libguile/boolean.h"
+#include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
 #include "libguile/dynl.h"
@@ -75,6 +76,7 @@ extern "C" {
 #include "libguile/procprop.h"
 #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"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 63f2ef2..fcf197a 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -106,7 +106,8 @@ guile_LDFLAGS = $(GUILE_CFLAGS)
 libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 
 libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
-    chars.c continuations.c convert.c debug.c deprecation.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-mark.c gc-segment.c gc-malloc.c gc-card.c		\
@@ -115,7 +116,8 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.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 random.c rdelim.c read.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	\
@@ -134,7 +136,8 @@ libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS =	\
    -module -L$(builddir) -lguile				\
    -version-info @LIBGUILE_I18N_INTERFACE@
 
-DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	\
+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 eq.x error.x eval.x evalext.x	\
     extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x	\
@@ -143,7 +146,8 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.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 random.x rdelim.x read.x root.x rw.x scmsigs.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		\
@@ -155,7 +159,8 @@ 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 chars.doc continuations.doc debug.doc deprecation.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	\
@@ -165,7 +170,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.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 random.doc rdelim.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		\
@@ -204,7 +210,7 @@ install-exec-hook:
 ## working.
 noinst_HEADERS = convert.i.c					\
                  conv-integer.i.c conv-uinteger.i.c		\
-                 eval.i.c					\
+                 eval.i.c ieee-754.h				\
                  srfi-4.i.c					\
                  quicksort.i.c                                  \
                  win32-uname.h win32-dirent.h win32-socket.h	\
@@ -223,7 +229,8 @@ 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	\
-    boolean.h chars.h continuations.h convert.h debug.h debug-malloc.h	\
+    boolean.h bytevectors.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		\
@@ -232,7 +239,8 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.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 regex-posix.h print.h procprop.h procs.h properties.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	\
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
new file mode 100644
index 0000000..4c3a353
--- /dev/null
+++ b/libguile/bytevectors.c
@@ -0,0 +1,1978 @@
+/* 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 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <alloca.h>
+
+#include <gmp.h>
+
+#include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+#include "libguile/ieee-754.h"
+
+#include <byteswap.h>
+#include <striconveh.h>
+#include <uniconv.h>
+
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
+#else
+/* Assuming 32-bit longs.  */
+# define ULONG_MAX 4294967295UL
+#endif
+
+#include <string.h>
+
+
+\f
+/* Utilities.  */
+
+/* Convenience macros.  These are used by the various templates (macros) that
+   are parameterized by integer signedness.  */
+#define INT8_T_signed           scm_t_int8
+#define INT8_T_unsigned         scm_t_uint8
+#define INT16_T_signed          scm_t_int16
+#define INT16_T_unsigned        scm_t_uint16
+#define INT32_T_signed          scm_t_int32
+#define INT32_T_unsigned        scm_t_uint32
+#define is_signed_int8(_x)      (((_x) >= -128L) && ((_x) <= 127L))
+#define is_unsigned_int8(_x)    ((_x) <= 255UL)
+#define is_signed_int16(_x)     (((_x) >= -32768L) && ((_x) <= 32767L))
+#define is_unsigned_int16(_x)   ((_x) <= 65535UL)
+#define is_signed_int32(_x)     (((_x) >= -2147483648L) && ((_x) <= 2147483647L))
+#define is_unsigned_int32(_x)   ((_x) <= 4294967295UL)
+#define SIGNEDNESS_signed       1
+#define SIGNEDNESS_unsigned     0
+
+#define INT_TYPE(_size, _sign)  INT ## _size ## _T_ ## _sign
+#define INT_SWAP(_size)         bswap_ ## _size
+#define INT_VALID_P(_size, _sign) is_ ## _sign ## _int ## _size
+#define SIGNEDNESS(_sign)       SIGNEDNESS_ ## _sign
+
+
+#define INTEGER_ACCESSOR_PROLOGUE(_len, _sign)			\
+  unsigned c_len, c_index;					\
+  _sign char *c_bv;						\
+								\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);				\
+  c_index = scm_to_uint (index);				\
+								\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);				\
+  c_bv = (_sign char *) SCM_BYTEVECTOR_CONTENTS (bv);		\
+								\
+  if (SCM_UNLIKELY (c_index + ((_len) >> 3UL) - 1 >= c_len))	\
+    scm_out_of_range (FUNC_NAME, index);
+
+/* Template for fixed-size integer access (only 8, 16 or 32-bit).  */
+#define INTEGER_REF(_len, _sign)			\
+  SCM result;						\
+							\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);		\
+  SCM_VALIDATE_SYMBOL (3, endianness);			\
+							\
+  {							\
+    INT_TYPE (_len, _sign)  c_result;			\
+							\
+    memcpy (&c_result, &c_bv[c_index], (_len) / 8);	\
+    if (!scm_is_eq (endianness, native_endianness))	\
+      c_result = INT_SWAP (_len) (c_result);		\
+							\
+    result = SCM_I_MAKINUM (c_result);			\
+  }							\
+							\
+  return result;
+
+/* Template for fixed-size integer access using the native endianness.  */
+#define INTEGER_NATIVE_REF(_len, _sign)			\
+  SCM result;						\
+							\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);		\
+							\
+  {							\
+    INT_TYPE (_len, _sign)  c_result;			\
+							\
+    memcpy (&c_result, &c_bv[c_index], (_len) / 8);	\
+    result = SCM_I_MAKINUM (c_result);			\
+  }							\
+							\
+  return result;
+
+/* Template for fixed-size integer modification (only 8, 16 or 32-bit).  */
+#define INTEGER_SET(_len, _sign)				\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+  SCM_VALIDATE_SYMBOL (3, endianness);				\
+								\
+  {								\
+    _sign long c_value;						\
+    INT_TYPE (_len, _sign) c_value_short;			\
+								\
+    if (SCM_UNLIKELY (!SCM_I_INUMP (value)))			\
+      scm_wrong_type_arg (FUNC_NAME, 3, value);			\
+								\
+    c_value = SCM_I_INUM (value);				\
+    if (SCM_UNLIKELY (!INT_VALID_P (_len, _sign) (c_value)))	\
+      scm_out_of_range (FUNC_NAME, value);			\
+								\
+    c_value_short = (INT_TYPE (_len, _sign)) c_value;		\
+    if (!scm_is_eq (endianness, native_endianness))		\
+      c_value_short = INT_SWAP (_len) (c_value_short);		\
+								\
+    memcpy (&c_bv[c_index], &c_value_short, (_len) / 8);	\
+  }								\
+								\
+  return SCM_UNSPECIFIED;
+
+/* Template for fixed-size integer modification using the native
+   endianness.  */
+#define INTEGER_NATIVE_SET(_len, _sign)				\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);			\
+								\
+  {								\
+    _sign long c_value;						\
+    INT_TYPE (_len, _sign) c_value_short;			\
+								\
+    if (SCM_UNLIKELY (!SCM_I_INUMP (value)))			\
+      scm_wrong_type_arg (FUNC_NAME, 3, value);			\
+								\
+    c_value = SCM_I_INUM (value);				\
+    if (SCM_UNLIKELY (!INT_VALID_P (_len, _sign) (c_value)))	\
+      scm_out_of_range (FUNC_NAME, value);			\
+								\
+    c_value_short = (INT_TYPE (_len, _sign)) c_value;		\
+								\
+    memcpy (&c_bv[c_index], &c_value_short, (_len) / 8);	\
+  }								\
+								\
+  return SCM_UNSPECIFIED;
+
+
+\f
+/* Bytevector type.  */
+
+SCM_GLOBAL_SMOB (scm_tc16_bytevector, "r6rs-bytevector", 0);
+
+#define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)	\
+  SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
+#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf)	\
+  SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
+
+/* The empty bytevector.  */
+SCM scm_null_bytevector = SCM_UNSPECIFIED;
+
+
+static inline SCM
+make_bytevector_from_buffer (unsigned len, signed char *contents)
+{
+  /* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD.  */
+  SCM_RETURN_NEWSMOB2 (scm_tc16_bytevector, len, contents);
+}
+
+static inline SCM
+make_bytevector (unsigned len)
+{
+  SCM bv;
+
+  if (SCM_UNLIKELY (len == 0))
+    bv = scm_null_bytevector;
+  else
+    {
+      signed char *contents = NULL;
+
+      if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
+	contents = (signed char *) scm_gc_malloc (len, SCM_GC_BYTEVECTOR);
+
+      bv = make_bytevector_from_buffer (len, contents);
+    }
+
+  return bv;
+}
+
+/* Return a new bytevector of size LEN octets.  */
+SCM
+scm_c_make_bytevector (unsigned len)
+{
+  return (make_bytevector (len));
+}
+
+/* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
+   by CONTENTS must have been allocated using `scm_gc_malloc ()'.  */
+SCM
+scm_c_take_bytevector (signed char *contents, unsigned 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 bv;
+}
+
+/* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
+   size) and return BV.  */
+SCM
+scm_i_shrink_bytevector (SCM bv, unsigned c_new_len)
+{
+  if (!SCM_BYTEVECTOR_INLINE_P (bv))
+    {
+      unsigned c_len;
+      signed char *c_bv, *c_new_bv;
+
+      c_len = SCM_BYTEVECTOR_LENGTH (bv);
+      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+      SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
+
+      if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_new_len))
+	{
+	  /* Copy to the in-line buffer and free the current buffer.  */
+	  c_new_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+	  memcpy (c_new_bv, c_bv, c_new_len);
+	  scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+	}
+      else
+	{
+	  /* Resize the existing buffer.  */
+	  c_new_bv = scm_gc_realloc (c_bv, c_len, c_new_len,
+				     SCM_GC_BYTEVECTOR);
+	  SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
+	}
+    }
+
+  return bv;
+}
+
+SCM_SMOB_PRINT (scm_tc16_bytevector, print_bytevector,
+		bv, port, pstate)
+{
+  unsigned c_len, i;
+  unsigned char *c_bv;
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  scm_puts ("#vu8(", port);
+  for (i = 0; i < c_len; i++)
+    {
+      if (i > 0)
+	scm_putc (' ', port);
+
+      scm_uintprint (c_bv[i], 10, port);
+    }
+
+  scm_putc (')', port);
+
+  /* Make GCC think we use it.  */
+  scm_remember_upto_here ((SCM) pstate);
+
+  return 1;
+}
+
+SCM_SMOB_FREE (scm_tc16_bytevector, free_bytevector, bv)
+{
+
+  if (!SCM_BYTEVECTOR_INLINE_P (bv))
+    {
+      unsigned c_len;
+      signed char *c_bv;
+
+      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+      c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+
+  return 0;
+}
+
+
+\f
+/* General operations.  */
+
+SCM_SYMBOL (scm_sym_big, "big");
+SCM_SYMBOL (scm_sym_little, "little");
+
+SCM scm_endianness_big, scm_endianness_little;
+
+/* Host endianness (a symbol).  */
+static SCM native_endianness = SCM_UNSPECIFIED;
+
+/* Byte-swapping.  */
+#ifndef bswap_24
+# define bswap_24(_x)				\
+  ((((_x) & 0xff0000) >> 16) |			\
+   (((_x) & 0x00ff00))       |			\
+   (((_x) & 0x0000ff) << 16))
+#endif
+
+
+SCM_DEFINE (scm_native_endianness, "native-endianness", 0, 0, 0,
+	    (void),
+	    "Return a symbol denoting the machine's native endianness.")
+#define FUNC_NAME s_scm_native_endianness
+{
+  return native_endianness;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_p, "bytevector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return true if @var{obj} is a bytevector.")
+#define FUNC_NAME s_scm_bytevector_p
+{
+  return (scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_bytevector,
+					     obj)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
+	    (SCM len, SCM fill),
+	    "Return a newly allocated bytevector of @var{len} bytes, "
+	    "optionally filled with @var{fill}.")
+#define FUNC_NAME s_scm_make_bytevector
+{
+  SCM bv;
+  unsigned c_len;
+  signed char c_fill = '\0';
+
+  SCM_VALIDATE_UINT_COPY (1, len, c_len);
+  if (fill != SCM_UNDEFINED)
+    {
+      int value;
+
+      value = scm_to_int (fill);
+      if (SCM_UNLIKELY ((value < -128) || (value > 255)))
+	scm_out_of_range (FUNC_NAME, fill);
+      c_fill = (signed char) value;
+    }
+
+  bv = make_bytevector (c_len);
+  if (fill != SCM_UNDEFINED)
+    {
+      unsigned i;
+      signed char *contents;
+
+      contents = SCM_BYTEVECTOR_CONTENTS (bv);
+      for (i = 0; i < c_len; i++)
+	contents[i] = c_fill;
+    }
+
+  return bv;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_length, "bytevector-length", 1, 0, 0,
+	    (SCM bv),
+	    "Return the length (in bytes) of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_length
+{
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  return (scm_from_uint (SCM_BYTEVECTOR_LENGTH (bv)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_eq_p, "bytevector=?", 2, 0, 0,
+	    (SCM bv1, SCM bv2),
+	    "Return is @var{bv1} equals to @var{bv2}---i.e., if they "
+	    "have the same length and contents.")
+#define FUNC_NAME s_scm_bytevector_eq_p
+{
+  SCM result = SCM_BOOL_F;
+  unsigned c_len1, c_len2;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv1);
+  SCM_VALIDATE_BYTEVECTOR (2, bv2);
+
+  c_len1 = SCM_BYTEVECTOR_LENGTH (bv1);
+  c_len2 = SCM_BYTEVECTOR_LENGTH (bv2);
+
+  if (c_len1 == c_len2)
+    {
+      signed char *c_bv1, *c_bv2;
+
+      c_bv1 = SCM_BYTEVECTOR_CONTENTS (bv1);
+      c_bv2 = SCM_BYTEVECTOR_CONTENTS (bv2);
+
+      result = scm_from_bool (!memcmp (c_bv1, c_bv2, c_len1));
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_fill_x, "bytevector-fill!", 2, 0, 0,
+	    (SCM bv, SCM fill),
+	    "Fill bytevector @var{bv} with @var{fill}, a byte.")
+#define FUNC_NAME s_scm_bytevector_fill_x
+{
+  unsigned c_len, i;
+  signed char *c_bv, c_fill;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  c_fill = scm_to_int8 (fill);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+  for (i = 0; i < c_len; i++)
+    c_bv[i] = c_fill;
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
+	    (SCM source, SCM source_start, SCM target, SCM target_start,
+	     SCM len),
+	    "Copy @var{len} bytes from @var{source} into @var{target}, "
+	    "starting reading from @var{source_start} (a positive index "
+	    "within @var{source}) and start writing at "
+	    "@var{target_start}.")
+#define FUNC_NAME s_scm_bytevector_copy_x
+{
+  unsigned c_len, c_source_len, c_target_len;
+  unsigned c_source_start, c_target_start;
+  signed char *c_source, *c_target;
+
+  SCM_VALIDATE_BYTEVECTOR (1, source);
+  SCM_VALIDATE_BYTEVECTOR (3, target);
+
+  c_len = scm_to_uint (len);
+  c_source_start = scm_to_uint (source_start);
+  c_target_start = scm_to_uint (target_start);
+
+  c_source = SCM_BYTEVECTOR_CONTENTS (source);
+  c_target = SCM_BYTEVECTOR_CONTENTS (target);
+  c_source_len = SCM_BYTEVECTOR_LENGTH (source);
+  c_target_len = SCM_BYTEVECTOR_LENGTH (target);
+
+  if (SCM_UNLIKELY (c_source_start + c_len > c_source_len))
+    scm_out_of_range (FUNC_NAME, source_start);
+  if (SCM_UNLIKELY (c_target_start + c_len > c_target_len))
+    scm_out_of_range (FUNC_NAME, target_start);
+
+  memcpy (c_target + c_target_start,
+	  c_source + c_source_start,
+	  c_len);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
+	    (SCM bv),
+	    "Return a newly allocated copy of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_copy
+{
+  SCM copy;
+  unsigned c_len;
+  signed char *c_bv, *c_copy;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
+
+  copy = make_bytevector (c_len);
+  c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
+  memcpy (c_copy, c_bv, c_len);
+
+  return copy;
+}
+#undef FUNC_NAME
+
+\f
+/* Operations on bytes and octets.  */
+
+SCM_DEFINE (scm_bytevector_u8_ref, "bytevector-u8-ref", 2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_u8_ref
+{
+  INTEGER_NATIVE_REF (8, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s8_ref, "bytevector-s8-ref", 2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the byte located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_s8_ref
+{
+  INTEGER_NATIVE_REF (8, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u8_set_x, "bytevector-u8-set!", 3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_u8_set_x
+{
+  INTEGER_NATIVE_SET (8, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s8_set_x, "bytevector-s8-set!", 3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Return the octet located at @var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_u8_set_x
+{
+  INTEGER_NATIVE_SET (8, signed);
+}
+#undef FUNC_NAME
+
+#undef OCTET_ACCESSOR_PROLOGUE
+
+
+SCM_DEFINE (scm_bytevector_to_u8_list, "bytevector->u8-list", 1, 0, 0,
+	    (SCM bv),
+	    "Return a newly allocated list of octets containing the "
+	    "contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_u8_list
+{
+  SCM lst, pair;
+  unsigned c_len, i;
+  unsigned char *c_bv;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  lst = scm_make_list (scm_from_uint (c_len), SCM_UNSPECIFIED);
+  for (i = 0, pair = lst;
+       i < c_len;
+       i++, pair = SCM_CDR (pair))
+    {
+      SCM_SETCAR (pair, SCM_I_MAKINUM (c_bv[i]));
+    }
+
+  return lst;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
+	    (SCM lst),
+	    "Turn @var{lst}, a list of octets, into a bytevector.")
+#define FUNC_NAME s_scm_u8_list_to_bytevector
+{
+  SCM bv, item;
+  long c_len, i;
+  unsigned char *c_bv;
+
+  SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
+
+  bv = make_bytevector (c_len);
+  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
+    {
+      item = SCM_CAR (lst);
+
+      if (SCM_LIKELY (SCM_I_INUMP (item)))
+	{
+	  long c_item;
+
+	  c_item = SCM_I_INUM (item);
+	  if (SCM_LIKELY ((c_item >= 0) && (c_item < 256)))
+	    c_bv[i] = (unsigned char) c_item;
+	  else
+	    goto type_error;
+	}
+      else
+	goto type_error;
+    }
+
+  return bv;
+
+ type_error:
+  scm_wrong_type_arg (FUNC_NAME, 1, item);
+
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+/* Compute the two's complement of VALUE (a positive integer) on SIZE octets
+   using (2^(SIZE * 8) - VALUE).  */
+static inline void
+twos_complement (mpz_t value, size_t size)
+{
+  unsigned long bit_count;
+
+  /* We expect BIT_COUNT to fit in a unsigned long thanks to the range
+     checking on SIZE performed earlier.  */
+  bit_count = (unsigned long) size << 3UL;
+
+  if (SCM_LIKELY (bit_count < sizeof (unsigned long)))
+    mpz_ui_sub (value, 1UL << bit_count, value);
+  else
+    {
+      mpz_t max;
+
+      mpz_init (max);
+      mpz_ui_pow_ui (max, 2, bit_count);
+      mpz_sub (value, max, value);
+      mpz_clear (max);
+    }
+}
+
+static inline SCM
+bytevector_large_ref (const char *c_bv, size_t c_size, int signed_p,
+		      SCM endianness)
+{
+  SCM result;
+  mpz_t c_mpz;
+  int c_endianness, negative_p = 0;
+
+  if (signed_p)
+    {
+      if (scm_is_eq (endianness, scm_sym_big))
+	negative_p = c_bv[0] & 0x80;
+      else
+	negative_p = c_bv[c_size - 1] & 0x80;
+    }
+
+  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+
+  mpz_init (c_mpz);
+  mpz_import (c_mpz, 1 /* 1 word */, 1 /* word order doesn't matter */,
+	      c_size /* word is C_SIZE-byte long */,
+	      c_endianness,
+	      0 /* nails */, c_bv);
+
+  if (signed_p && negative_p)
+    {
+      twos_complement (c_mpz, c_size);
+      mpz_neg (c_mpz, c_mpz);
+    }
+
+  result = scm_from_mpz (c_mpz);
+  mpz_clear (c_mpz);  /* FIXME: Needed? */
+
+  return result;
+}
+
+static inline int
+bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
+		      SCM value, SCM endianness)
+{
+  mpz_t c_mpz;
+  int c_endianness, c_sign, err = 0;
+
+  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+
+  mpz_init (c_mpz);
+  scm_to_mpz (value, c_mpz);
+
+  c_sign = mpz_sgn (c_mpz);
+  if (c_sign < 0)
+    {
+      if (SCM_LIKELY (signed_p))
+	{
+	  mpz_neg (c_mpz, c_mpz);
+	  twos_complement (c_mpz, c_size);
+	}
+      else
+	{
+	  err = -1;
+	  goto finish;
+	}
+    }
+
+  if (c_sign == 0)
+    /* Zero.  */
+    memset (c_bv, 0, c_size);
+  else
+    {
+      size_t word_count, value_size;
+
+      value_size = (mpz_sizeinbase (c_mpz, 2) + (8 * c_size)) / (8 * c_size);
+      if (SCM_UNLIKELY (value_size > c_size))
+	{
+	  err = -2;
+	  goto finish;
+	}
+
+
+      mpz_export (c_bv, &word_count, 1 /* word order doesn't matter */,
+		  c_size, c_endianness,
+		  0 /* nails */, c_mpz);
+      if (SCM_UNLIKELY (word_count != 1))
+	/* Shouldn't happen since we already checked with VALUE_SIZE.  */
+	abort ();
+    }
+
+ finish:
+  mpz_clear (c_mpz);
+
+  return err;
+}
+
+#define GENERIC_INTEGER_ACCESSOR_PROLOGUE(_sign)			\
+  unsigned long c_len, c_index, c_size;					\
+  char *c_bv;								\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);					\
+  c_index = scm_to_ulong (index);					\
+  c_size = scm_to_ulong (size);						\
+									\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);					\
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);				\
+									\
+  /* C_SIZE must have its 3 higher bits set to zero so that		\
+     multiplying it by 8 yields a number that fits in an		\
+     unsigned long.  */							\
+  if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))	\
+    scm_out_of_range (FUNC_NAME, size);					\
+  if (SCM_UNLIKELY (c_index + c_size > c_len))				\
+    scm_out_of_range (FUNC_NAME, index);
+
+
+/* Template of an integer reference function.  */
+#define GENERIC_INTEGER_REF(_sign)					\
+  SCM result;								\
+									\
+  if (c_size < 3)							\
+    {									\
+      int swap;								\
+      _sign int value;							\
+									\
+      swap = !scm_is_eq (endianness, native_endianness);		\
+      switch (c_size)							\
+	{								\
+	case 1:								\
+	  {								\
+	    _sign char c_value8;					\
+	    memcpy (&c_value8, c_bv, 1);				\
+	    value = c_value8;						\
+	  }								\
+	  break;							\
+	case 2:								\
+	  {								\
+	    INT_TYPE (16, _sign)  c_value16;				\
+	    memcpy (&c_value16, c_bv, 2);				\
+	    if (swap)							\
+	      value = (INT_TYPE (16, _sign)) bswap_16 (c_value16);	\
+	    else							\
+	      value = c_value16;					\
+	  }								\
+	  break;							\
+	default:							\
+	  abort ();							\
+	}								\
+									\
+      result = SCM_I_MAKINUM ((_sign int) value);			\
+    }									\
+  else									\
+    result = bytevector_large_ref ((char *) c_bv,			\
+				   c_size, SIGNEDNESS (_sign),		\
+				   endianness);				\
+									\
+  return result;
+
+static inline SCM
+bytevector_signed_ref (const char *c_bv, size_t c_size, SCM endianness)
+{
+  GENERIC_INTEGER_REF (signed);
+}
+
+static inline SCM
+bytevector_unsigned_ref (const char *c_bv, size_t c_size, SCM endianness)
+{
+  GENERIC_INTEGER_REF (unsigned);
+}
+
+
+/* Template of an integer assignment function.  */
+#define GENERIC_INTEGER_SET(_sign)					\
+  if (c_size < 3)							\
+    {									\
+      _sign int c_value;						\
+									\
+      if (SCM_UNLIKELY (!SCM_I_INUMP (value)))				\
+	goto range_error;						\
+									\
+      c_value = SCM_I_INUM (value);					\
+      switch (c_size)							\
+	{								\
+	case 1:								\
+	  if (SCM_LIKELY (INT_VALID_P (8, _sign) (c_value)))		\
+	    {								\
+	      _sign char c_value8;					\
+	      c_value8 = (_sign char) c_value;				\
+	      memcpy (c_bv, &c_value8, 1);				\
+	    }								\
+	  else								\
+	    goto range_error;						\
+	  break;							\
+									\
+	case 2:								\
+	  if (SCM_LIKELY (INT_VALID_P (16, _sign) (c_value)))		\
+	    {								\
+	      int swap;							\
+	      INT_TYPE (16, _sign)  c_value16;				\
+									\
+	      swap = !scm_is_eq (endianness, native_endianness);	\
+									\
+	      if (swap)							\
+		c_value16 = (INT_TYPE (16, _sign)) bswap_16 (c_value);	\
+	      else							\
+		c_value16 = c_value;					\
+									\
+	      memcpy (c_bv, &c_value16, 2);				\
+	    }								\
+	  else								\
+	    goto range_error;						\
+	  break;							\
+									\
+	default:							\
+	  abort ();							\
+	}								\
+    }									\
+  else									\
+    {									\
+      int err;								\
+									\
+      err = bytevector_large_set (c_bv, c_size,				\
+				  SIGNEDNESS (_sign),			\
+				  value, endianness);			\
+      if (err)								\
+	goto range_error;						\
+    }									\
+									\
+  return;								\
+									\
+ range_error:								\
+  scm_out_of_range (FUNC_NAME, value);					\
+  return;
+
+static inline void
+bytevector_signed_set (char *c_bv, size_t c_size,
+		       SCM value, SCM endianness,
+		       const char *func_name)
+#define FUNC_NAME func_name
+{
+  GENERIC_INTEGER_SET (signed);
+}
+#undef FUNC_NAME
+
+static inline void
+bytevector_unsigned_set (char *c_bv, size_t c_size,
+			 SCM value, SCM endianness,
+			 const char *func_name)
+#define FUNC_NAME func_name
+{
+  GENERIC_INTEGER_SET (unsigned);
+}
+#undef FUNC_NAME
+
+#undef GENERIC_INTEGER_SET
+#undef GENERIC_INTEGER_REF
+
+
+SCM_DEFINE (scm_bytevector_uint_ref, "bytevector-uint-ref", 4, 0, 0,
+	    (SCM bv, SCM index, SCM endianness, SCM size),
+	    "Return the @var{size}-octet long unsigned integer at index "
+	    "@var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_uint_ref
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+
+  return (bytevector_unsigned_ref (&c_bv[c_index], c_size, endianness));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_sint_ref, "bytevector-sint-ref", 4, 0, 0,
+	    (SCM bv, SCM index, SCM endianness, SCM size),
+	    "Return the @var{size}-octet long unsigned integer at index "
+	    "@var{index} in @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_sint_ref
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+
+  return (bytevector_signed_ref (&c_bv[c_index], c_size, endianness));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_uint_set_x, "bytevector-uint-set!", 5, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness, SCM size),
+	    "Set the @var{size}-octet long unsigned integer at @var{index} "
+	    "to @var{value}.")
+#define FUNC_NAME s_scm_bytevector_uint_set_x
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (unsigned);
+
+  bytevector_unsigned_set (&c_bv[c_index], c_size, value, endianness,
+			   FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_sint_set_x, "bytevector-sint-set!", 5, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness, SCM size),
+	    "Set the @var{size}-octet long signed integer at @var{index} "
+	    "to @var{value}.")
+#define FUNC_NAME s_scm_bytevector_sint_set_x
+{
+  GENERIC_INTEGER_ACCESSOR_PROLOGUE (signed);
+
+  bytevector_signed_set (&c_bv[c_index], c_size, value, endianness,
+			 FUNC_NAME);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+\f
+/* Operations on integers of arbitrary size.  */
+
+#define INTEGERS_TO_LIST(_sign)						\
+  SCM lst, pair;							\
+  size_t i, c_len, c_size;						\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, bv);					\
+  SCM_VALIDATE_SYMBOL (2, endianness);					\
+  c_size = scm_to_uint (size);						\
+									\
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);					\
+  if (SCM_UNLIKELY (c_len == 0))					\
+    lst = SCM_EOL;							\
+  else if (SCM_UNLIKELY (c_len < c_size))				\
+    scm_out_of_range (FUNC_NAME, size);					\
+  else									\
+    {									\
+      const char *c_bv;							\
+									\
+      c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);			\
+									\
+      lst = scm_make_list (scm_from_uint (c_len / c_size),		\
+			   SCM_UNSPECIFIED);				\
+      for (i = 0, pair = lst;						\
+	   i <= c_len - c_size;						\
+	   i += c_size, c_bv += c_size, pair = SCM_CDR (pair))		\
+	{								\
+	  SCM_SETCAR (pair,						\
+		      bytevector_ ## _sign ## _ref (c_bv, c_size,	\
+						    endianness));	\
+	}								\
+    }									\
+									\
+  return lst;
+
+SCM_DEFINE (scm_bytevector_to_sint_list, "bytevector->sint-list",
+	    3, 0, 0,
+	    (SCM bv, SCM endianness, SCM size),
+	    "Return a list of signed integers of @var{size} octets "
+	    "representing the contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_sint_list
+{
+  INTEGERS_TO_LIST (signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_to_uint_list, "bytevector->uint-list",
+	    3, 0, 0,
+	    (SCM bv, SCM endianness, SCM size),
+	    "Return a list of unsigned integers of @var{size} octets "
+	    "representing the contents of @var{bv}.")
+#define FUNC_NAME s_scm_bytevector_to_uint_list
+{
+  INTEGERS_TO_LIST (unsigned);
+}
+#undef FUNC_NAME
+
+#undef INTEGER_TO_LIST
+
+
+#define INTEGER_LIST_TO_BYTEVECTOR(_sign)				\
+  SCM bv;								\
+  long c_len;								\
+  size_t c_size;							\
+  char *c_bv, *c_bv_ptr;						\
+									\
+  SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);				\
+  SCM_VALIDATE_SYMBOL (2, endianness);					\
+  c_size = scm_to_uint (size);						\
+									\
+  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);				\
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);				\
+									\
+  for (c_bv_ptr = c_bv;							\
+       !scm_is_null (lst);						\
+       lst = SCM_CDR (lst), c_bv_ptr += c_size)				\
+    {									\
+      bytevector_ ## _sign ## _set (c_bv_ptr, c_size,			\
+				    SCM_CAR (lst), endianness,		\
+				    FUNC_NAME);				\
+    }									\
+									\
+  return bv;
+
+
+SCM_DEFINE (scm_uint_list_to_bytevector, "uint-list->bytevector",
+	    3, 0, 0,
+	    (SCM lst, SCM endianness, SCM size),
+	    "Return a bytevector containing the unsigned integers "
+	    "listed in @var{lst} and encoded on @var{size} octets "
+	    "according to @var{endianness}.")
+#define FUNC_NAME s_scm_uint_list_to_bytevector
+{
+  INTEGER_LIST_TO_BYTEVECTOR (unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_sint_list_to_bytevector, "sint-list->bytevector",
+	    3, 0, 0,
+	    (SCM lst, SCM endianness, SCM size),
+	    "Return a bytevector containing the signed integers "
+	    "listed in @var{lst} and encoded on @var{size} octets "
+	    "according to @var{endianness}.")
+#define FUNC_NAME s_scm_sint_list_to_bytevector
+{
+  INTEGER_LIST_TO_BYTEVECTOR (signed);
+}
+#undef FUNC_NAME
+
+#undef INTEGER_LIST_TO_BYTEVECTOR
+
+
+\f
+/* Operations on 16-bit integers.  */
+
+SCM_DEFINE (scm_bytevector_u16_ref, "bytevector-u16-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u16_ref
+{
+  INTEGER_REF (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_ref, "bytevector-s16-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 16-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s16_ref
+{
+  INTEGER_REF (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_native_ref, "bytevector-u16-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u16_native_ref
+{
+  INTEGER_NATIVE_REF (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_native_ref, "bytevector-s16-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 16-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s16_native_ref
+{
+  INTEGER_NATIVE_REF (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_set_x, "bytevector-u16-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u16_set_x
+{
+  INTEGER_SET (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_set_x, "bytevector-s16-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s16_set_x
+{
+  INTEGER_SET (16, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u16_native_set_x, "bytevector-u16-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u16_native_set_x
+{
+  INTEGER_NATIVE_SET (16, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s16_native_set_x, "bytevector-s16-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s16_native_set_x
+{
+  INTEGER_NATIVE_SET (16, signed);
+}
+#undef FUNC_NAME
+
+
+\f
+/* Operations on 32-bit integers.  */
+
+/* Unfortunately, on 32-bit machines `SCM' is not large enough to hold
+   arbitrary 32-bit integers.  Thus we fall back to using the
+   `large_{ref,set}' variants on 32-bit machines.  */
+
+#define LARGE_INTEGER_REF(_len, _sign)					\
+  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				\
+  SCM_VALIDATE_SYMBOL (3, endianness);					\
+									\
+  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	\
+				SIGNEDNESS (_sign), endianness));
+
+#define LARGE_INTEGER_SET(_len, _sign)					\
+  int err;								\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+  SCM_VALIDATE_SYMBOL (4, endianness);					\
+									\
+  err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
+			      SIGNEDNESS (_sign), value, endianness);	\
+  if (SCM_UNLIKELY (err))						\
+     scm_out_of_range (FUNC_NAME, value);				\
+									\
+  return SCM_UNSPECIFIED;
+
+#define LARGE_INTEGER_NATIVE_REF(_len, _sign)				 \
+  INTEGER_ACCESSOR_PROLOGUE(_len, _sign);				 \
+  return (bytevector_large_ref ((char *) c_bv + c_index, _len / 8,	 \
+				SIGNEDNESS (_sign), native_endianness));
+
+#define LARGE_INTEGER_NATIVE_SET(_len, _sign)				\
+  int err;								\
+  INTEGER_ACCESSOR_PROLOGUE (_len, _sign);				\
+									\
+  err = bytevector_large_set ((char *) c_bv + c_index, _len / 8,	\
+			      SIGNEDNESS (_sign), value,		\
+			      native_endianness);			\
+  if (SCM_UNLIKELY (err))						\
+     scm_out_of_range (FUNC_NAME, value);				\
+									\
+  return SCM_UNSPECIFIED;
+
+
+SCM_DEFINE (scm_bytevector_u32_ref, "bytevector-u32-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u32_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_REF (32, unsigned);
+#else
+  LARGE_INTEGER_REF (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_ref, "bytevector-s32-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 32-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s32_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_REF (32, signed);
+#else
+  LARGE_INTEGER_REF (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_native_ref, "bytevector-u32-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u32_native_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_REF (32, unsigned);
+#else
+  LARGE_INTEGER_NATIVE_REF (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_native_ref, "bytevector-s32-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 32-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s32_native_ref
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_REF (32, signed);
+#else
+  LARGE_INTEGER_NATIVE_REF (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_set_x, "bytevector-u32-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u32_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_SET (32, unsigned);
+#else
+  LARGE_INTEGER_SET (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_set_x, "bytevector-s32-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s32_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_SET (32, signed);
+#else
+  LARGE_INTEGER_SET (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u32_native_set_x, "bytevector-u32-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u32_native_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_SET (32, unsigned);
+#else
+  LARGE_INTEGER_NATIVE_SET (32, unsigned);
+#endif
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s32_native_set_x, "bytevector-s32-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s32_native_set_x
+{
+#if SIZEOF_VOID_P > 4
+  INTEGER_NATIVE_SET (32, signed);
+#else
+  LARGE_INTEGER_NATIVE_SET (32, signed);
+#endif
+}
+#undef FUNC_NAME
+
+
+\f
+/* Operations on 64-bit integers.  */
+
+/* For 64-bit integers, we use only the `large_{ref,set}' variant.  */
+
+SCM_DEFINE (scm_bytevector_u64_ref, "bytevector-u64-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_u64_ref
+{
+  LARGE_INTEGER_REF (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_ref, "bytevector-s64-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the signed 64-bit integer from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_s64_ref
+{
+  LARGE_INTEGER_REF (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_native_ref, "bytevector-u64-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u64_native_ref
+{
+  LARGE_INTEGER_NATIVE_REF (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_native_ref, "bytevector-s64-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the unsigned 64-bit integer from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s64_native_ref
+{
+  LARGE_INTEGER_NATIVE_REF (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_set_x, "bytevector-u64-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_u64_set_x
+{
+  LARGE_INTEGER_SET (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_set_x, "bytevector-s64-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_s64_set_x
+{
+  LARGE_INTEGER_SET (64, signed);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_u64_native_set_x, "bytevector-u64-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the unsigned integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_u64_native_set_x
+{
+  LARGE_INTEGER_NATIVE_SET (64, unsigned);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_s64_native_set_x, "bytevector-s64-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the signed integer @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_s64_native_set_x
+{
+  LARGE_INTEGER_NATIVE_SET (64, signed);
+}
+#undef FUNC_NAME
+
+
+\f
+/* Operations on IEEE-754 numbers.  */
+
+/* There are two possible word endians, visible in glibc's <ieee754.h>.
+   However, in R6RS, when the endianness is `little', little endian is
+   assumed for both the byte order and the word order.  This is clear from
+   Section 2.1 of R6RS-lib (in response to
+   http://www.r6rs.org/formal-comments/comment-187.txt).  */
+
+
+/* Convert to/from a floating-point number with different endianness.  This
+   method is probably not the most efficient but it should be portable.  */
+
+static inline void
+float_to_foreign_endianness (union scm_ieee754_float *target,
+			     float source)
+{
+  union scm_ieee754_float src;
+
+  src.f = source;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  target->little_endian.negative = src.big_endian.negative;
+  target->little_endian.exponent = src.big_endian.exponent;
+  target->little_endian.mantissa = src.big_endian.mantissa;
+#else
+  target->big_endian.negative = src.little_endian.negative;
+  target->big_endian.exponent = src.little_endian.exponent;
+  target->big_endian.mantissa = src.little_endian.mantissa;
+#endif
+}
+
+static inline float
+float_from_foreign_endianness (const union scm_ieee754_float *source)
+{
+  union scm_ieee754_float result;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  result.big_endian.negative = source->little_endian.negative;
+  result.big_endian.exponent = source->little_endian.exponent;
+  result.big_endian.mantissa = source->little_endian.mantissa;
+#else
+  result.little_endian.negative = source->big_endian.negative;
+  result.little_endian.exponent = source->big_endian.exponent;
+  result.little_endian.mantissa = source->big_endian.mantissa;
+#endif
+
+  return (result.f);
+}
+
+static inline void
+double_to_foreign_endianness (union scm_ieee754_double *target,
+			      double source)
+{
+  union scm_ieee754_double src;
+
+  src.d = source;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  target->little_little_endian.negative  = src.big_endian.negative;
+  target->little_little_endian.exponent  = src.big_endian.exponent;
+  target->little_little_endian.mantissa0 = src.big_endian.mantissa0;
+  target->little_little_endian.mantissa1 = src.big_endian.mantissa1;
+#else
+  target->big_endian.negative  = src.little_little_endian.negative;
+  target->big_endian.exponent  = src.little_little_endian.exponent;
+  target->big_endian.mantissa0 = src.little_little_endian.mantissa0;
+  target->big_endian.mantissa1 = src.little_little_endian.mantissa1;
+#endif
+}
+
+static inline double
+double_from_foreign_endianness (const union scm_ieee754_double *source)
+{
+  union scm_ieee754_double result;
+
+#ifdef WORDS_BIGENDIAN
+  /* Assuming little endian for both byte and word order.  */
+  result.big_endian.negative  = source->little_little_endian.negative;
+  result.big_endian.exponent  = source->little_little_endian.exponent;
+  result.big_endian.mantissa0 = source->little_little_endian.mantissa0;
+  result.big_endian.mantissa1 = source->little_little_endian.mantissa1;
+#else
+  result.little_little_endian.negative  = source->big_endian.negative;
+  result.little_little_endian.exponent  = source->big_endian.exponent;
+  result.little_little_endian.mantissa0 = source->big_endian.mantissa0;
+  result.little_little_endian.mantissa1 = source->big_endian.mantissa1;
+#endif
+
+  return (result.d);
+}
+
+/* Template macros to abstract over doubles and floats.
+   XXX: Guile can only convert to/from doubles.  */
+#define IEEE754_UNION(_c_type)           union scm_ieee754_ ## _c_type
+#define IEEE754_TO_SCM(_c_type)          scm_from_double
+#define IEEE754_FROM_SCM(_c_type)        scm_to_double
+#define IEEE754_FROM_FOREIGN_ENDIANNESS(_c_type)	\
+   _c_type ## _from_foreign_endianness
+#define IEEE754_TO_FOREIGN_ENDIANNESS(_c_type)	\
+   _c_type ## _to_foreign_endianness
+
+
+/* Templace getters and setters.  */
+
+#define IEEE754_ACCESSOR_PROLOGUE(_type)			\
+  INTEGER_ACCESSOR_PROLOGUE (sizeof (_type) << 3UL, signed);
+
+#define IEEE754_REF(_type)					\
+  _type c_result;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  SCM_VALIDATE_SYMBOL (3, endianness);				\
+								\
+  if (scm_is_eq (endianness, native_endianness))		\
+    memcpy (&c_result, &c_bv[c_index], sizeof (c_result));	\
+  else								\
+    {								\
+      IEEE754_UNION (_type) c_raw;				\
+								\
+      memcpy (&c_raw, &c_bv[c_index], sizeof (c_raw));		\
+      c_result =						\
+	IEEE754_FROM_FOREIGN_ENDIANNESS (_type) (&c_raw);	\
+    }								\
+								\
+  return (IEEE754_TO_SCM (_type) (c_result));
+
+#define IEEE754_NATIVE_REF(_type)				\
+  _type c_result;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+								\
+  memcpy (&c_result, &c_bv[c_index], sizeof (c_result));	\
+  return (IEEE754_TO_SCM (_type) (c_result));
+
+#define IEEE754_SET(_type)					\
+  _type c_value;						\
+								\
+  IEEE754_ACCESSOR_PROLOGUE (_type);				\
+  SCM_VALIDATE_REAL (3, value);					\
+  SCM_VALIDATE_SYMBOL (4, endianness);				\
+  c_value = IEEE754_FROM_SCM (_type) (value);			\
+								\
+  if (scm_is_eq (endianness, native_endianness))		\
+    memcpy (&c_bv[c_index], &c_value, sizeof (c_value));	\
+  else								\
+    {								\
+      IEEE754_UNION (_type) c_raw;				\
+								\
+      IEEE754_TO_FOREIGN_ENDIANNESS (_type) (&c_raw, c_value);	\
+      memcpy (&c_bv[c_index], &c_raw, sizeof (c_raw));		\
+    }								\
+								\
+  return SCM_UNSPECIFIED;
+
+#define IEEE754_NATIVE_SET(_type)			\
+  _type c_value;					\
+							\
+  IEEE754_ACCESSOR_PROLOGUE (_type);			\
+  SCM_VALIDATE_REAL (3, value);				\
+  c_value = IEEE754_FROM_SCM (_type) (value);		\
+							\
+  memcpy (&c_bv[c_index], &c_value, sizeof (c_value));	\
+  return SCM_UNSPECIFIED;
+
+
+/* Single precision.  */
+
+SCM_DEFINE (scm_bytevector_ieee_single_ref,
+	    "bytevector-ieee-single-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the IEEE-754 single from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_ref
+{
+  IEEE754_REF (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_native_ref,
+	    "bytevector-ieee-single-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the IEEE-754 single from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_native_ref
+{
+  IEEE754_NATIVE_REF (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_set_x,
+	    "bytevector-ieee-single-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store real @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_set_x
+{
+  IEEE754_SET (float);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_single_native_set_x,
+	    "bytevector-ieee-single-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the real @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_single_native_set_x
+{
+  IEEE754_NATIVE_SET (float);
+}
+#undef FUNC_NAME
+
+
+/* Double precision.  */
+
+SCM_DEFINE (scm_bytevector_ieee_double_ref,
+	    "bytevector-ieee-double-ref",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM endianness),
+	    "Return the IEEE-754 double from @var{bv} at "
+	    "@var{index}.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_ref
+{
+  IEEE754_REF (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_native_ref,
+	    "bytevector-ieee-double-native-ref",
+	    2, 0, 0,
+	    (SCM bv, SCM index),
+	    "Return the IEEE-754 double from @var{bv} at "
+	    "@var{index} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_native_ref
+{
+  IEEE754_NATIVE_REF (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_set_x,
+	    "bytevector-ieee-double-set!",
+	    4, 0, 0,
+	    (SCM bv, SCM index, SCM value, SCM endianness),
+	    "Store real @var{value} in @var{bv} at @var{index} according to "
+	    "@var{endianness}.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_set_x
+{
+  IEEE754_SET (double);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bytevector_ieee_double_native_set_x,
+	    "bytevector-ieee-double-native-set!",
+	    3, 0, 0,
+	    (SCM bv, SCM index, SCM value),
+	    "Store the real @var{value} at index @var{index} "
+	    "of @var{bv} using the native endianness.")
+#define FUNC_NAME s_scm_bytevector_ieee_double_native_set_x
+{
+  IEEE754_NATIVE_SET (double);
+}
+#undef FUNC_NAME
+
+
+#undef IEEE754_UNION
+#undef IEEE754_TO_SCM
+#undef IEEE754_FROM_SCM
+#undef IEEE754_FROM_FOREIGN_ENDIANNESS
+#undef IEEE754_TO_FOREIGN_ENDIANNESS
+#undef IEEE754_REF
+#undef IEEE754_NATIVE_REF
+#undef IEEE754_SET
+#undef IEEE754_NATIVE_SET
+
+\f
+/* Operations on strings.  */
+
+
+/* Produce a function that returns the length of a UTF-encoded string.  */
+#define UTF_STRLEN_FUNCTION(_utf_width)					\
+static inline size_t							\
+utf ## _utf_width ## _strlen (const uint ## _utf_width ## _t *str)	\
+{									\
+  size_t len = 0;							\
+  const uint ## _utf_width ## _t *ptr;					\
+  for (ptr = str;							\
+       *ptr != 0;							\
+       ptr++)								\
+    {									\
+      len++;								\
+    }									\
+									\
+  return (len * ((_utf_width) / 8));					\
+}
+
+UTF_STRLEN_FUNCTION (8)
+
+
+/* Return the length (in bytes) of STR, a UTF-(UTF_WIDTH) encoded string.  */
+#define UTF_STRLEN(_utf_width, _str)		\
+  utf ## _utf_width ## _strlen (_str)
+
+/* Return the "portable" name of the UTF encoding of size UTF_WIDTH and
+   ENDIANNESS (Gnulib's `iconv_open' module guarantees the portability of the
+   encoding name).  */
+static inline void
+utf_encoding_name (char *name, size_t utf_width, SCM endianness)
+{
+  strcpy (name, "UTF-");
+  strcat (name, ((utf_width == 8)
+		 ? "8"
+		 : ((utf_width == 16)
+		    ? "16"
+		    : ((utf_width == 32)
+		       ? "32"
+		       : "??"))));
+  strcat (name,
+	  ((scm_is_eq (endianness, scm_sym_big))
+	   ? "BE"
+	   : ((scm_is_eq (endianness, scm_sym_little))
+	      ? "LE"
+	      : "unknown")));
+}
+
+/* Maximum length of a UTF encoding name.  */
+#define MAX_UTF_ENCODING_NAME_LEN  16
+
+/* Produce the body of a `string->utf' function.  */
+#define STRING_TO_UTF(_utf_width)					\
+  SCM utf;								\
+  int err;								\
+  char *c_str;								\
+  char c_utf_name[MAX_UTF_ENCODING_NAME_LEN];				\
+  char *c_utf = NULL, *c_locale;					\
+  size_t c_strlen, c_raw_strlen, c_utf_len = 0;				\
+									\
+  SCM_VALIDATE_STRING (1, str);						\
+  if (endianness == SCM_UNDEFINED)					\
+    endianness = scm_sym_big;						\
+  else									\
+    SCM_VALIDATE_SYMBOL (2, endianness);				\
+									\
+  c_strlen = scm_c_string_length (str);					\
+  c_raw_strlen = c_strlen * ((_utf_width) / 8);				\
+  do									\
+    {									\
+      c_str = (char *) alloca (c_raw_strlen + 1);			\
+      c_raw_strlen = scm_to_locale_stringbuf (str, c_str, c_strlen);	\
+    }									\
+  while (c_raw_strlen > c_strlen);					\
+  c_str[c_raw_strlen] = '\0';						\
+									\
+  utf_encoding_name (c_utf_name, (_utf_width), endianness);		\
+									\
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);		\
+  strcpy (c_locale, locale_charset ());					\
+									\
+  err = mem_iconveh (c_str, c_raw_strlen,				\
+		     c_locale, c_utf_name,				\
+		     iconveh_question_mark, NULL,			\
+		     &c_utf, &c_utf_len);				\
+  if (SCM_UNLIKELY (err))						\
+    scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A",	\
+		      scm_list_1 (str), err);				\
+  else									\
+    /* C_UTF is null-terminated.  */					\
+    utf = scm_c_take_bytevector ((signed char *) c_utf,			\
+				      c_utf_len);			\
+									\
+  return (utf);
+
+
+
+SCM_DEFINE (scm_string_to_utf8, "string->utf8",
+	    1, 0, 0,
+	    (SCM str),
+	    "Return a newly allocated bytevector that contains the UTF-8 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf8
+{
+  SCM utf;
+  char *c_str;
+  uint8_t *c_utf;
+  size_t c_strlen, c_raw_strlen;
+
+  SCM_VALIDATE_STRING (1, str);
+
+  c_strlen = scm_c_string_length (str);
+  c_raw_strlen = c_strlen;
+  do
+    {
+      c_str = (char *) alloca (c_raw_strlen + 1);
+      c_raw_strlen = scm_to_locale_stringbuf (str, c_str, c_strlen);
+    }
+  while (c_raw_strlen > c_strlen);
+  c_str[c_raw_strlen] = '\0';
+
+  c_utf = u8_strconv_from_locale (c_str);
+  if (SCM_UNLIKELY (c_utf == NULL))
+    scm_syserror (FUNC_NAME);
+  else
+    /* C_UTF is null-terminated.  */
+    utf = scm_c_take_bytevector ((signed char *) c_utf,
+				      UTF_STRLEN (8, c_utf));
+
+  return (utf);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_to_utf16, "string->utf16",
+	    1, 1, 0,
+	    (SCM str, SCM endianness),
+	    "Return a newly allocated bytevector that contains the UTF-16 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf16
+{
+  STRING_TO_UTF (16);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_string_to_utf32, "string->utf32",
+	    1, 1, 0,
+	    (SCM str, SCM endianness),
+	    "Return a newly allocated bytevector that contains the UTF-32 "
+	    "encoding of @var{str}.")
+#define FUNC_NAME s_scm_string_to_utf32
+{
+  STRING_TO_UTF (32);
+}
+#undef FUNC_NAME
+
+
+/* Produce the body of a function that converts a UTF-encoded bytevector to a
+   string.  */
+#define UTF_TO_STRING(_utf_width)					\
+  SCM str = SCM_BOOL_F;							\
+  int err;								\
+  char *c_str = NULL, *c_locale;					\
+  char c_utf_name[MAX_UTF_ENCODING_NAME_LEN];				\
+  const char *c_utf;							\
+  size_t c_strlen = 0, c_utf_len;					\
+									\
+  SCM_VALIDATE_BYTEVECTOR (1, utf);					\
+  if (endianness == SCM_UNDEFINED)					\
+    endianness = scm_sym_big;						\
+  else									\
+    SCM_VALIDATE_SYMBOL (2, endianness);				\
+									\
+  c_utf_len = SCM_BYTEVECTOR_LENGTH (utf);				\
+  c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf);			\
+  utf_encoding_name (c_utf_name, (_utf_width), endianness);		\
+									\
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);		\
+  strcpy (c_locale, locale_charset ());					\
+									\
+  err = mem_iconveh (c_utf, c_utf_len,					\
+		     c_utf_name, c_locale,				\
+		     iconveh_question_mark, NULL,			\
+		     &c_str, &c_strlen);				\
+  if (SCM_UNLIKELY (err))						\
+    scm_syserror_msg (FUNC_NAME, "failed to convert to string: ~A",	\
+		      scm_list_1 (utf), err);				\
+  else									\
+    /* C_STR is null-terminated.  */					\
+    str = scm_take_locale_stringn (c_str, c_strlen);			\
+									\
+  return (str);
+
+
+SCM_DEFINE (scm_utf8_to_string, "utf8->string",
+	    1, 0, 0,
+	    (SCM utf),
+	    "Return a newly allocate string that contains from the UTF-8-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf8_to_string
+{
+  SCM str;
+  int err;
+  char *c_str = NULL, *c_locale;
+  const char *c_utf;
+  size_t c_utf_len, c_strlen = 0;
+
+  SCM_VALIDATE_BYTEVECTOR (1, utf);
+
+  c_utf_len = SCM_BYTEVECTOR_LENGTH (utf);
+
+  c_locale = (char *) alloca (strlen (locale_charset ()) + 1);
+  strcpy (c_locale, locale_charset ());
+
+  c_utf = (char *) SCM_BYTEVECTOR_CONTENTS (utf);
+  err = mem_iconveh (c_utf, c_utf_len,
+		     "UTF-8", c_locale,
+		     iconveh_question_mark, NULL,
+		     &c_str, &c_strlen);
+  if (SCM_UNLIKELY (err))
+    scm_syserror_msg (FUNC_NAME, "failed to convert to string: ~A",
+		      scm_list_1 (utf), err);
+  else
+    /* C_STR is null-terminated.  */
+    str = scm_take_locale_stringn (c_str, c_strlen);
+
+  return (str);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_utf16_to_string, "utf16->string",
+	    1, 1, 0,
+	    (SCM utf, SCM endianness),
+	    "Return a newly allocate string that contains from the UTF-16-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf16_to_string
+{
+  UTF_TO_STRING (16);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_utf32_to_string, "utf32->string",
+	    1, 1, 0,
+	    (SCM utf, SCM endianness),
+	    "Return a newly allocate string that contains from the UTF-32-"
+	    "encoded contents of bytevector @var{utf}.")
+#define FUNC_NAME s_scm_utf32_to_string
+{
+  UTF_TO_STRING (32);
+}
+#undef FUNC_NAME
+
+
+\f
+/* Initialization.  */
+
+void
+scm_init_bytevectors (void)
+{
+#include "libguile/bytevectors.x"
+
+#ifdef WORDS_BIGENDIAN
+  native_endianness = scm_sym_big;
+#else
+  native_endianness = scm_sym_little;
+#endif
+
+  scm_endianness_big = scm_sym_big;
+  scm_endianness_little = scm_sym_little;
+
+  scm_null_bytevector =
+    scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+}
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
new file mode 100644
index 0000000..98c38ac
--- /dev/null
+++ b/libguile/bytevectors.h
@@ -0,0 +1,133 @@
+#ifndef SCM_BYTEVECTORS_H
+#define SCM_BYTEVECTORS_H
+
+/* 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 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+\f
+
+#include "libguile/__scm.h"
+
+
+/* R6RS bytevectors.  */
+
+#define SCM_BYTEVECTOR_LENGTH(_bv)		\
+  ((unsigned) SCM_SMOB_DATA (_bv))
+#define SCM_BYTEVECTOR_CONTENTS(_bv)		\
+  (SCM_BYTEVECTOR_INLINE_P (_bv)			\
+   ? (signed char *) SCM_SMOB_OBJECT_2_LOC (_bv)	\
+   : (signed char *) SCM_SMOB_DATA_2 (_bv))
+
+
+SCM_API SCM scm_endianness_big;
+SCM_API SCM scm_endianness_little;
+
+SCM_API SCM scm_make_bytevector (SCM, SCM);
+SCM_API SCM scm_c_make_bytevector (unsigned);
+SCM_API SCM scm_native_endianness (void);
+SCM_API SCM scm_bytevector_p (SCM);
+SCM_API SCM scm_bytevector_length (SCM);
+SCM_API SCM scm_bytevector_eq_p (SCM, SCM);
+SCM_API SCM scm_bytevector_fill_x (SCM, SCM);
+SCM_API SCM scm_bytevector_copy_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_copy (SCM);
+
+SCM_API SCM scm_bytevector_to_u8_list (SCM);
+SCM_API SCM scm_u8_list_to_bytevector (SCM);
+SCM_API SCM scm_uint_list_to_bytevector (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_to_uint_list (SCM, SCM, SCM);
+SCM_API SCM scm_sint_list_to_bytevector (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_to_sint_list (SCM, SCM, SCM);
+
+SCM_API SCM scm_bytevector_u16_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s16_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u32_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s32_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u64_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s64_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_u8_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_s8_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_uint_ref (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_sint_ref (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u8_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s8_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_uint_set_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_sint_set_x (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u16_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s16_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u32_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s32_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_u64_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_s64_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_single_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_ref (SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_native_ref (SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_set_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_bytevector_ieee_double_native_set_x (SCM, SCM, SCM);
+SCM_API SCM scm_string_to_utf8 (SCM);
+SCM_API SCM scm_string_to_utf16 (SCM, SCM);
+SCM_API SCM scm_string_to_utf32 (SCM, SCM);
+SCM_API SCM scm_utf8_to_string (SCM);
+SCM_API SCM scm_utf16_to_string (SCM, SCM);
+SCM_API SCM scm_utf32_to_string (SCM, SCM);
+
+
+\f
+/* Internal API.  */
+
+/* The threshold (in octets) under which bytevectors are stored "in-line",
+   i.e., without allocating memory beside the SMOB itself (a double cell).
+   This optimization is necessary since small bytevectors are expected to be
+   common.  */
+#define SCM_BYTEVECTOR_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)))
+
+/* Hint that is passed to `scm_gc_malloc ()' and friends.  */
+#define SCM_GC_BYTEVECTOR "bytevector"
+
+SCM_API void scm_init_bytevectors (void);
+
+SCM_INTERNAL scm_t_bits scm_tc16_bytevector;
+SCM_INTERNAL SCM scm_c_take_bytevector (signed char *, unsigned);
+
+#define scm_c_shrink_bytevector(_bv, _len)		\
+  (SCM_BYTEVECTOR_INLINE_P (_bv)			\
+   ? (_bv)						\
+   : scm_i_shrink_bytevector ((_bv), (_len)))
+
+SCM_INTERNAL SCM scm_i_shrink_bytevector (SCM, unsigned);
+SCM_INTERNAL SCM scm_null_bytevector;
+
+#endif /* SCM_BYTEVECTORS_H */
diff --git a/libguile/ieee-754.h b/libguile/ieee-754.h
new file mode 100644
index 0000000..e345efa
--- /dev/null
+++ b/libguile/ieee-754.h
@@ -0,0 +1,90 @@
+/* Copyright (C) 1992, 1995, 1996, 1999 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C 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 the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+
+#ifndef SCM_IEEE_754_H
+#define SCM_IEEE_754_H 1
+
+/* Based on glibc's <ieee754.h> and modified by Ludovic Courtès to include
+   all possible IEEE-754 double-precision representations.  */
+
+\f
+/* IEEE 754 simple-precision format (32-bit).  */
+
+union scm_ieee754_float
+  {
+    float f;
+
+    struct
+      {
+	unsigned int negative:1;
+	unsigned int exponent:8;
+	unsigned int mantissa:23;
+      } big_endian;
+
+    struct
+      {
+      	unsigned int mantissa:23;
+	unsigned int exponent:8;
+	unsigned int negative:1;
+      } little_endian;
+  };
+
+
+\f
+/* IEEE 754 double-precision format (64-bit).  */
+
+union scm_ieee754_double
+  {
+    double d;
+
+    struct
+      {
+	/* Big endian.  */
+
+	unsigned int negative:1;
+	unsigned int exponent:11;
+	/* Together these comprise the mantissa.  */
+	unsigned int mantissa0:20;
+	unsigned int mantissa1:32;
+      } big_endian;
+
+    struct
+      {
+	/* Both byte order and word order are little endian.  */
+
+	/* Together these comprise the mantissa.  */
+	unsigned int mantissa1:32;
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+      } little_little_endian;
+
+    struct
+      {
+	/* Byte order is little endian but word order is big endian.  Not
+	   sure this is very wide spread.  */
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+	unsigned int mantissa1:32;
+      } little_big_endian;
+
+  };
+
+
+#endif /* SCM_IEEE_754_H */
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
new file mode 100644
index 0000000..a07636f
--- /dev/null
+++ b/libguile/r6rs-ports.c
@@ -0,0 +1,1118 @@
+/* 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 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#include <string.h>
+#include <stdio.h>
+#include <assert.h>
+
+#include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
+#include "libguile/chars.h"
+#include "libguile/eval.h"
+#include "libguile/r6rs-ports.h"
+#include "libguile/strings.h"
+#include "libguile/validate.h"
+#include "libguile/values.h"
+#include "libguile/vectors.h"
+
+
+\f
+/* Unimplemented features.  */
+
+
+/* Transoders are currently not implemented since Guile 1.8 is not
+   Unicode-capable.  Thus, most of the code here assumes the use of the
+   binary transcoder.  */
+static inline void
+transcoders_not_implemented (void)
+{
+  fprintf (stderr, "%s: warning: transcoders not implemented\n",
+	   PACKAGE_NAME);
+}
+
+\f
+/* End-of-file object.  */
+
+SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
+	    (void),
+	    "Return the end-of-file object.")
+#define FUNC_NAME s_scm_eof_object
+{
+  return (SCM_EOF_VAL);
+}
+#undef FUNC_NAME
+
+\f
+/* Input ports.  */
+
+#ifndef MIN
+# define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif
+
+/* Bytevector input ports or "bip" for short.  */
+static scm_t_bits bytevector_input_port_type = 0;
+
+static inline SCM
+make_bip (SCM bv)
+{
+  SCM port;
+  char *c_bv;
+  unsigned c_len;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
+
+  port = scm_new_port_table_entry (bytevector_input_port_type);
+
+  /* Prevent BV from being GC'd.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (bv));
+
+  /* Have the port directly access the bytevector.  */
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
+  c_port->read_end = (unsigned char *) c_bv + c_len;
+  c_port->read_buf_size = c_len;
+
+  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
+  SCM_SET_CELL_TYPE (port, bytevector_input_port_type | mode_bits);
+
+  return port;
+}
+
+static SCM
+bip_mark (SCM port)
+{
+  /* Mark the underlying bytevector.  */
+  return (SCM_PACK (SCM_STREAM (port)));
+}
+
+static int
+bip_fill_input (SCM port)
+{
+  int result;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+  if (c_port->read_pos >= c_port->read_end)
+    result = EOF;
+  else
+    result = (int) *c_port->read_pos;
+
+  return result;
+}
+
+static off_t
+bip_seek (SCM port, off_t offset, int whence)
+#define FUNC_NAME "bip_seek"
+{
+  off_t c_result = 0;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+  switch (whence)
+    {
+    case SEEK_CUR:
+      offset += c_port->read_pos - c_port->read_buf;
+      /* Fall through.  */
+
+    case SEEK_SET:
+      if (c_port->read_buf + offset < c_port->read_end)
+	{
+	  c_port->read_pos = c_port->read_buf + offset;
+	  c_result = offset;
+	}
+      else
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      break;
+
+    case SEEK_END:
+      if (c_port->read_end - offset >= c_port->read_buf)
+	{
+	  c_port->read_pos = c_port->read_end - offset;
+	  c_result = c_port->read_pos - c_port->read_buf;
+	}
+      else
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      break;
+
+    default:
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "invalid `seek' parameter");
+    }
+
+  return c_result;
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the bytevector input port type.  */
+static inline void
+initialize_bytevector_input_ports (void)
+{
+  bytevector_input_port_type =
+    scm_make_port_type ("r6rs-bytevector-input-port", bip_fill_input,
+			NULL);
+
+  scm_set_port_mark (bytevector_input_port_type, bip_mark);
+  scm_set_port_seek (bytevector_input_port_type, bip_seek);
+}
+
+
+SCM_DEFINE (scm_open_bytevector_input_port,
+	    "open-bytevector-input-port", 1, 1, 0,
+	    (SCM bv, SCM transcoder),
+	    "Return an input port whose contents are drawn from "
+	    "bytevector @var{bv}.")
+#define FUNC_NAME s_scm_open_bytevector_input_port
+{
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
+    transcoders_not_implemented ();
+
+  return (make_bip (bv));
+}
+#undef FUNC_NAME
+
+\f
+/* Custom binary ports.  The following routines are shared by input and
+   output custom binary ports.  */
+
+#define SCM_CBP_GET_POSITION_PROC(_port)			\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 1)
+#define SCM_CBP_SET_POSITION_PROC(_port)			\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 2)
+#define SCM_CBP_CLOSE_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 3)
+
+static SCM
+cbp_mark (SCM port)
+{
+  /* Mark the underlying method and object vector.  */
+  return (SCM_PACK (SCM_STREAM (port)));
+}
+
+static off_t
+cbp_seek (SCM port, off_t offset, int whence)
+#define FUNC_NAME "cbp_seek"
+{
+  SCM result;
+  off_t c_result = 0;
+
+  switch (whence)
+    {
+    case SEEK_CUR:
+      {
+	SCM get_position_proc;
+
+	get_position_proc = SCM_CBP_GET_POSITION_PROC (port);
+	if (SCM_LIKELY (scm_is_true (get_position_proc)))
+	  result = scm_call_0 (get_position_proc);
+	else
+	  scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+				  "R6RS custom binary port does not "
+				  "support `port-position'");
+
+	offset += scm_to_int (result);
+	/* Fall through.  */
+      }
+
+    case SEEK_SET:
+      {
+	SCM set_position_proc;
+
+	set_position_proc = SCM_CBP_SET_POSITION_PROC (port);
+	if (SCM_LIKELY (scm_is_true (set_position_proc)))
+	  result = scm_call_1 (set_position_proc, scm_from_int (offset));
+	else
+	  scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+				  "R6RS custom binary port does not "
+				  "support `set-port-position!'");
+
+	/* Assuming setting the position succeeded.  */
+	c_result = offset;
+	break;
+      }
+
+    default:
+      /* `SEEK_END' cannot be supported.  */
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "R6RS custom binary ports do not "
+			      "support `SEEK_END'");
+    }
+
+  return c_result;
+}
+#undef FUNC_NAME
+
+static int
+cbp_close (SCM port)
+{
+  SCM close_proc;
+
+  close_proc = SCM_CBP_CLOSE_PROC (port);
+  if (scm_is_true (close_proc))
+    /* Invoke the `close' thunk.  */
+    scm_call_0 (close_proc);
+
+  return 1;
+}
+
+\f
+/* Custom binary input port ("cbip" for short).  */
+
+static scm_t_bits custom_binary_input_port_type = 0;
+
+/* Size of the buffer embedded in custom binary input ports.  */
+#define CBIP_BUFFER_SIZE  4096
+
+/* Return the bytevector associated with PORT.  */
+#define SCM_CBIP_BYTEVECTOR(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4)
+
+/* Return the various procedures of PORT.  */
+#define SCM_CBIP_READ_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+
+
+static inline SCM
+make_cbip (SCM read_proc, SCM get_position_proc,
+	   SCM set_position_proc, SCM close_proc)
+{
+  SCM port, bv, method_vector;
+  char *c_bv;
+  unsigned c_len;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
+
+  /* Use a bytevector as the underlying buffer.  */
+  c_len = CBIP_BUFFER_SIZE;
+  bv = scm_c_make_bytevector (c_len);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  /* Store the various methods and bytevector in a vector.  */
+  method_vector = scm_c_make_vector (5, SCM_BOOL_F);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 4, bv);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 0, read_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
+
+  port = scm_new_port_table_entry (custom_binary_input_port_type);
+
+  /* Attach it the method vector.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
+
+  /* Have the port directly access the buffer (bytevector).  */
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
+  c_port->read_end = (unsigned char *) c_bv;
+  c_port->read_buf_size = c_len;
+
+  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
+  SCM_SET_CELL_TYPE (port, custom_binary_input_port_type | mode_bits);
+
+  return port;
+}
+
+static int
+cbip_fill_input (SCM port)
+#define FUNC_NAME "cbip_fill_input"
+{
+  int result;
+  scm_t_port *c_port = SCM_PTAB_ENTRY (port);
+
+ again:
+  if (c_port->read_pos >= c_port->read_end)
+    {
+      /* Invoke the user's `read!' procedure.  */
+      unsigned c_octets;
+      SCM bv, read_proc, octets;
+
+      /* Use the bytevector associated with PORT as the buffer passed to the
+	 `read!' procedure, thereby avoiding additional allocations.  */
+      bv = SCM_CBIP_BYTEVECTOR (port);
+      read_proc = SCM_CBIP_READ_PROC (port);
+
+      /* The assumption here is that C_PORT's internal buffer wasn't changed
+	 behind our back.  */
+      assert (c_port->read_buf ==
+	      (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
+      assert ((unsigned) c_port->read_buf_size
+	      == SCM_BYTEVECTOR_LENGTH (bv));
+
+      octets = scm_call_3 (read_proc, bv, SCM_INUM0,
+			   SCM_I_MAKINUM (CBIP_BUFFER_SIZE));
+      c_octets = scm_to_uint (octets);
+
+      c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
+      c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
+
+      if (c_octets > 0)
+	goto again;
+      else
+	result = EOF;
+    }
+  else
+    result = (int) *c_port->read_pos;
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_custom_binary_input_port,
+	    "make-custom-binary-input-port", 5, 0, 0,
+	    (SCM id, SCM read_proc, SCM get_position_proc,
+	     SCM set_position_proc, SCM close_proc),
+	    "Return a new custom binary input port whose input is drained "
+	    "by invoking @var{read_proc} and passing it a bytevector, an "
+	    "index where octets should be written, and an octet count.")
+#define FUNC_NAME s_scm_make_custom_binary_input_port
+{
+  SCM_VALIDATE_STRING (1, id);
+  SCM_VALIDATE_PROC (2, read_proc);
+
+  if (!scm_is_false (get_position_proc))
+    SCM_VALIDATE_PROC (3, get_position_proc);
+
+  if (!scm_is_false (set_position_proc))
+    SCM_VALIDATE_PROC (4, set_position_proc);
+
+  if (!scm_is_false (close_proc))
+    SCM_VALIDATE_PROC (5, close_proc);
+
+  return (make_cbip (read_proc, get_position_proc, set_position_proc,
+		     close_proc));
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the custom binary input port type.  */
+static inline void
+initialize_custom_binary_input_ports (void)
+{
+  custom_binary_input_port_type =
+    scm_make_port_type ("r6rs-custom-binary-input-port",
+			cbip_fill_input, NULL);
+
+  scm_set_port_mark (custom_binary_input_port_type, cbp_mark);
+  scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
+  scm_set_port_close (custom_binary_input_port_type, cbp_close);
+}
+
+
+\f
+/* Binary input.  */
+
+/* We currently don't support specific binary input ports.  */
+#define SCM_VALIDATE_BINARY_INPUT_PORT SCM_VALIDATE_OPINPORT
+
+SCM_DEFINE (scm_get_u8, "get-u8", 1, 0, 0,
+	    (SCM port),
+	    "Read an octet from @var{port}, a binary input port, "
+	    "blocking as necessary.")
+#define FUNC_NAME s_scm_get_u8
+{
+  SCM result;
+  int c_result;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_result = scm_getc (port);
+  if (c_result == EOF)
+    result = SCM_EOF_VAL;
+  else
+    result = SCM_I_MAKINUM ((unsigned char) c_result);
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_lookahead_u8, "lookahead-u8", 1, 0, 0,
+	    (SCM port),
+	    "Like @code{get-u8} but does not update @var{port} to "
+	    "point past the octet.")
+#define FUNC_NAME s_scm_lookahead_u8
+{
+  SCM result;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  result = scm_peek_char (port);
+  if (SCM_CHARP (result))
+    result = SCM_I_MAKINUM ((signed char) SCM_CHAR (result));
+  else
+    result = SCM_EOF_VAL;
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0,
+	    (SCM port, SCM count),
+	    "Read @var{count} octets from @var{port}, blocking as "
+	    "necessary and return a bytevector containing the octets "
+	    "read.  If fewer bytes are available, a bytevector smaller "
+	    "than @var{count} is returned.")
+#define FUNC_NAME s_scm_get_bytevector_n
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_count;
+  size_t c_read;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  c_count = scm_to_uint (count);
+
+  result = scm_c_make_bytevector (c_count);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (result);
+
+  if (SCM_LIKELY (c_count > 0))
+    /* XXX: `scm_c_read ()' does not update the port position.  */
+    c_read = scm_c_read (port, c_bv, c_count);
+  else
+    /* Don't invoke `scm_c_read ()' since it may block.  */
+    c_read = 0;
+
+  if ((c_read == 0) && (c_count > 0))
+    {
+      if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+	result = SCM_EOF_VAL;
+      else
+	result = scm_null_bytevector;
+    }
+  else
+    {
+      if (c_read < c_count)
+	result = scm_c_shrink_bytevector (result, c_read);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+	    "Read @var{count} bytes from @var{port} and store them "
+	    "in @var{bv} starting at index @var{start}.  Return either "
+	    "the number of bytes actually read or the end-of-file "
+	    "object.")
+#define FUNC_NAME s_scm_get_bytevector_n_x
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_start, c_count, c_len;
+  size_t c_read;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+  c_start = scm_to_uint (start);
+  c_count = scm_to_uint (count);
+
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  if (SCM_UNLIKELY (c_start + c_count > c_len))
+    scm_out_of_range (FUNC_NAME, count);
+
+  if (SCM_LIKELY (c_count > 0))
+    c_read = scm_c_read (port, c_bv + c_start, c_count);
+  else
+    /* Don't invoke `scm_c_read ()' since it may block.  */
+    c_read = 0;
+
+  if ((c_read == 0) && (c_count > 0))
+    {
+      if (SCM_EOF_OBJECT_P (scm_peek_char (port)))
+	result = SCM_EOF_VAL;
+      else
+	result = SCM_I_MAKINUM (0);
+    }
+  else
+    result = scm_from_size_t (c_read);
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
+	    (SCM port),
+	    "Read from @var{port}, blocking as necessary, until data "
+	    "are available or and end-of-file is reached.  Return either "
+	    "a new bytevector containing the data read or the "
+	    "end-of-file object.")
+#define FUNC_NAME s_scm_get_bytevector_some
+{
+  /* Read at least one byte, unless the end-of-file is already reached, and
+     read while characters are available (buffered).  */
+
+  SCM result;
+  char *c_bv;
+  unsigned c_len;
+  size_t c_total;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_len = 4096;
+  c_bv = (char *) scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+  c_total = 0;
+
+  do
+    {
+      int c_chr;
+
+      if (c_total + 1 > c_len)
+	{
+	  /* Grow the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2,
+					  SCM_GC_BYTEVECTOR);
+	  c_len *= 2;
+	}
+
+      /* We can't use `scm_c_read ()' since it blocks.  */
+      c_chr = scm_getc (port);
+      if (c_chr != EOF)
+	{
+	  c_bv[c_total] = (char) c_chr;
+	  c_total++;
+	}
+    }
+  while ((scm_is_true (scm_char_ready_p (port)))
+	 && (!SCM_EOF_OBJECT_P (scm_peek_char (port))));
+
+  if (c_total == 0)
+    {
+      result = SCM_EOF_VAL;
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+  else
+    {
+      if (c_len > c_total)
+	{
+	  /* Shrink the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total,
+					  SCM_GC_BYTEVECTOR);
+	  c_len = (unsigned) c_total;
+	}
+
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
+	    (SCM port),
+	    "Read from @var{port}, blocking as necessary, until "
+	    "the end-of-file is reached.  Return either "
+	    "a new bytevector containing the data read or the "
+	    "end-of-file object (if no data were available).")
+#define FUNC_NAME s_scm_get_bytevector_all
+{
+  SCM result;
+  char *c_bv;
+  unsigned c_len, c_count;
+  size_t c_read, c_total;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+
+  c_len = c_count = 4096;
+  c_bv = (char *) scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR);
+  c_total = c_read = 0;
+
+  do
+    {
+      if (c_total + c_read > c_len)
+	{
+	  /* Grow the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2,
+					  SCM_GC_BYTEVECTOR);
+	  c_count = c_len;
+	  c_len *= 2;
+	}
+
+      /* `scm_c_read ()' blocks until C_COUNT bytes are available or EOF is
+	 reached.  */
+      c_read = scm_c_read (port, c_bv + c_total, c_count);
+      c_total += c_read, c_count -= c_read;
+    }
+  while (!SCM_EOF_OBJECT_P (scm_peek_char (port)));
+
+  if (c_total == 0)
+    {
+      result = SCM_EOF_VAL;
+      scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
+    }
+  else
+    {
+      if (c_len > c_total)
+	{
+	  /* Shrink the bytevector.  */
+	  c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total,
+					  SCM_GC_BYTEVECTOR);
+	  c_len = (unsigned) c_total;
+	}
+
+      result = scm_c_take_bytevector ((signed char *) c_bv, c_len);
+    }
+
+  return result;
+}
+#undef FUNC_NAME
+
+
+\f
+/* Binary output.  */
+
+/* We currently don't support specific binary input ports.  */
+#define SCM_VALIDATE_BINARY_OUTPUT_PORT SCM_VALIDATE_OPOUTPORT
+
+
+SCM_DEFINE (scm_put_u8, "put-u8", 2, 0, 0,
+	    (SCM port, SCM octet),
+	    "Write @var{octet} to binary port @var{port}.")
+#define FUNC_NAME s_scm_put_u8
+{
+  scm_t_uint8 c_octet;
+
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+  c_octet = scm_to_uint8 (octet);
+
+  scm_putc ((char) c_octet, port);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+	    "Write the contents of @var{bv} to @var{port}, optionally "
+	    "starting at index @var{start} and limiting to @var{count} "
+	    "octets.")
+#define FUNC_NAME s_scm_put_bytevector
+{
+  char *c_bv;
+  unsigned c_start, c_count, c_len;
+
+  SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
+
+  if (start != SCM_UNDEFINED)
+    {
+      c_start = scm_to_uint (start);
+
+      if (count != SCM_UNDEFINED)
+	{
+	  c_count = scm_to_uint (count);
+	  if (SCM_UNLIKELY (c_start + c_count > c_len))
+	    scm_out_of_range (FUNC_NAME, count);
+	}
+      else
+	{
+	  if (SCM_UNLIKELY (c_start >= c_len))
+	    scm_out_of_range (FUNC_NAME, start);
+	  else
+	    c_count = c_len - c_start;
+	}
+    }
+  else
+    c_start = 0, c_count = c_len;
+
+  scm_c_write (port, c_bv + c_start, c_count);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+\f
+/* Bytevector output port ("bop" for short).  */
+
+/* Implementation of "bops".
+
+   Each bop has an internal buffer, of type `scm_t_bop_buffer', attached to
+   it.  The procedure returned along with the output port is actually an
+   applicable SMOB.  The SMOB holds a reference to the port.  When applied,
+   the SMOB swallows the port's internal buffer, turning it into a
+   bytevector, and resets it.
+
+   XXX: Access to a bop's internal buffer is not thread-safe.  */
+
+static scm_t_bits bytevector_output_port_type = 0;
+
+SCM_SMOB (bytevector_output_port_procedure,
+	  "r6rs-bytevector-output-port-procedure",
+	  0);
+
+#define SCM_GC_BOP "r6rs-bytevector-output-port"
+#define SCM_BOP_BUFFER_INITIAL_SIZE 4096
+
+/* Representation of a bop's internal buffer.  */
+typedef struct
+{
+  size_t total_len;
+  size_t len;
+  size_t pos;
+  char  *buffer;
+} scm_t_bop_buffer;
+
+
+/* Accessing a bop's buffer.  */
+#define SCM_BOP_BUFFER(_port)		\
+  ((scm_t_bop_buffer *) SCM_STREAM (_port))
+#define SCM_SET_BOP_BUFFER(_port, _buf)		\
+  (SCM_SETSTREAM ((_port), (scm_t_bits) (_buf)))
+
+
+static inline void
+bop_buffer_init (scm_t_bop_buffer *buf)
+{
+  buf->total_len = buf->len = buf->pos = 0;
+  buf->buffer = NULL;
+}
+
+static inline void
+bop_buffer_grow (scm_t_bop_buffer *buf, size_t min_size)
+{
+  char *new_buf;
+  size_t new_size;
+
+  for (new_size = buf->total_len
+	 ? buf->total_len : SCM_BOP_BUFFER_INITIAL_SIZE;
+       new_size < min_size;
+       new_size *= 2);
+
+  if (buf->buffer)
+    new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
+			      new_size, SCM_GC_BOP);
+  else
+    new_buf = scm_gc_malloc (new_size, SCM_GC_BOP);
+
+  buf->buffer = new_buf;
+  buf->total_len = new_size;
+}
+
+static inline SCM
+make_bop (void)
+{
+  SCM port, bop_proc;
+  scm_t_port *c_port;
+  scm_t_bop_buffer *buf;
+  const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
+
+  port = scm_new_port_table_entry (bytevector_output_port_type);
+
+  buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
+  bop_buffer_init (buf);
+
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
+  c_port->write_buf_size = 0;
+
+  SCM_SET_BOP_BUFFER (port, buf);
+
+  /* Mark PORT as open and writable.  */
+  SCM_SET_CELL_TYPE (port, bytevector_output_port_type | mode_bits);
+
+  /* Make the bop procedure.  */
+  SCM_NEWSMOB (bop_proc, bytevector_output_port_procedure,
+	       SCM_PACK (port));
+
+  return (scm_values (scm_list_2 (port, bop_proc)));
+}
+
+static size_t
+bop_free (SCM port)
+{
+  /* The port itself is necessarily freed _after_ the bop proc, since the bop
+     proc holds a reference to it.  Thus we can safely free the internal
+     buffer when the bop becomes unreferenced.  */
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+  if (buf->buffer)
+    scm_gc_free (buf->buffer, buf->total_len, SCM_GC_BOP);
+
+  scm_gc_free (buf, sizeof (* buf), SCM_GC_BOP);
+
+  return 0;
+}
+
+/* Write SIZE octets from DATA to PORT.  */
+static void
+bop_write (SCM port, const void *data, size_t size)
+{
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+
+  if (buf->pos + size > buf->total_len)
+    bop_buffer_grow (buf, buf->pos + size);
+
+  memcpy (buf->buffer + buf->pos, data, size);
+  buf->pos += size;
+  buf->len = (buf->len > buf->pos) ? buf->len : buf->pos;
+}
+
+static off_t
+bop_seek (SCM port, off_t offset, int whence)
+#define FUNC_NAME "bop_seek"
+{
+  scm_t_bop_buffer *buf;
+
+  buf = SCM_BOP_BUFFER (port);
+  switch (whence)
+    {
+    case SEEK_CUR:
+      offset += (off_t) buf->pos;
+      /* Fall through.  */
+
+    case SEEK_SET:
+      if (offset < 0 || (unsigned) offset > buf->len)
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      else
+	buf->pos = offset;
+      break;
+
+    case SEEK_END:
+      if (offset < 0 || (unsigned) offset >= buf->len)
+	scm_out_of_range (FUNC_NAME, scm_from_int (offset));
+      else
+	buf->pos = buf->len - (offset + 1);
+      break;
+
+    default:
+      scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
+			      "invalid `seek' parameter");
+    }
+
+  return buf->pos;
+}
+#undef FUNC_NAME
+
+/* Fetch data from a bop.  */
+SCM_SMOB_APPLY (bytevector_output_port_procedure,
+		bop_proc_apply, 0, 0, 0, (SCM bop_proc))
+{
+  SCM port, bv;
+  scm_t_bop_buffer *buf, result_buf;
+
+  port = SCM_PACK (SCM_SMOB_DATA (bop_proc));
+  buf = SCM_BOP_BUFFER (port);
+
+  result_buf = *buf;
+  bop_buffer_init (buf);
+
+  if (result_buf.len == 0)
+    bv = scm_c_take_bytevector (NULL, 0);
+  else
+    {
+      if (result_buf.total_len > result_buf.len)
+	/* Shrink the buffer.  */
+	result_buf.buffer = scm_gc_realloc ((void *) result_buf.buffer,
+					    result_buf.total_len,
+					    result_buf.len,
+					    SCM_GC_BOP);
+
+      bv = scm_c_take_bytevector ((signed char *) result_buf.buffer,
+				       result_buf.len);
+    }
+
+  return bv;
+}
+
+SCM_SMOB_MARK (bytevector_output_port_procedure, bop_proc_mark,
+	       bop_proc)
+{
+  /* Mark the port associated with BOP_PROC.  */
+  return (SCM_PACK (SCM_SMOB_DATA (bop_proc)));
+}
+
+
+SCM_DEFINE (scm_open_bytevector_output_port,
+	    "open-bytevector-output-port", 0, 1, 0,
+	    (SCM transcoder),
+	    "Return two values: an output port and a procedure.  The latter "
+	    "should be called with zero arguments to obtain a bytevector "
+	    "containing the data accumulated by the port.")
+#define FUNC_NAME s_scm_open_bytevector_output_port
+{
+  if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
+    transcoders_not_implemented ();
+
+  return (make_bop ());
+}
+#undef FUNC_NAME
+
+static inline void
+initialize_bytevector_output_ports (void)
+{
+  bytevector_output_port_type =
+    scm_make_port_type ("r6rs-bytevector-output-port",
+			NULL, bop_write);
+
+  scm_set_port_seek (bytevector_output_port_type, bop_seek);
+  scm_set_port_free (bytevector_output_port_type, bop_free);
+}
+
+\f
+/* Custom binary output port ("cbop" for short).  */
+
+static scm_t_bits custom_binary_output_port_type;
+
+/* Return the various procedures of PORT.  */
+#define SCM_CBOP_WRITE_PROC(_port)				\
+  SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
+
+
+static inline SCM
+make_cbop (SCM write_proc, SCM get_position_proc,
+	   SCM set_position_proc, SCM close_proc)
+{
+  SCM port, method_vector;
+  scm_t_port *c_port;
+  const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
+
+  /* Store the various methods and bytevector in a vector.  */
+  method_vector = scm_c_make_vector (4, SCM_BOOL_F);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 0, write_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 1, get_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
+  SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
+
+  port = scm_new_port_table_entry (custom_binary_output_port_type);
+
+  /* Attach it the method vector.  */
+  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
+
+  /* Have the port directly access the buffer (bytevector).  */
+  c_port = SCM_PTAB_ENTRY (port);
+  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
+  c_port->write_buf_size = c_port->read_buf_size = 0;
+
+  /* Mark PORT as open, writable and unbuffered.  */
+  SCM_SET_CELL_TYPE (port, custom_binary_output_port_type | mode_bits);
+
+  return port;
+}
+
+/* Write SIZE octets from DATA to PORT.  */
+static void
+cbop_write (SCM port, const void *data, size_t size)
+#define FUNC_NAME "cbop_write"
+{
+  long int c_result;
+  size_t c_written;
+  SCM bv, write_proc, result;
+
+  /* XXX: Allocating a new bytevector at each `write' call is inefficient,
+     but necessary since (1) we don't control the lifetime of the buffer
+     pointed to by DATA, and (2) the `write!' procedure could capture the
+     bytevector it is passed.  */
+  bv = scm_c_make_bytevector (size);
+  memcpy (SCM_BYTEVECTOR_CONTENTS (bv), data, size);
+
+  write_proc = SCM_CBOP_WRITE_PROC (port);
+
+  /* Since the `write' procedure of Guile's ports has type `void', it must
+     try hard to write exactly SIZE bytes, regardless of how many bytes the
+     sink can handle.  */
+  for (c_written = 0;
+       c_written < size;
+       c_written += c_result)
+    {
+      result = scm_call_3 (write_proc, bv,
+			   scm_from_size_t (c_written),
+			   scm_from_size_t (size - c_written));
+
+      c_result = scm_to_long (result);
+      if (SCM_UNLIKELY (c_result < 0
+			|| (size_t) c_result > (size - c_written)))
+	scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
+				"R6RS custom binary output port `write!' "
+				"returned a incorrect integer");
+    }
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_make_custom_binary_output_port,
+	    "make-custom-binary-output-port", 5, 0, 0,
+	    (SCM id, SCM write_proc, SCM get_position_proc,
+	     SCM set_position_proc, SCM close_proc),
+	    "Return a new custom binary output port whose output is drained "
+	    "by invoking @var{write_proc} and passing it a bytevector, an "
+	    "index where octets should be written, and an octet count.")
+#define FUNC_NAME s_scm_make_custom_binary_output_port
+{
+  SCM_VALIDATE_STRING (1, id);
+  SCM_VALIDATE_PROC (2, write_proc);
+
+  if (!scm_is_false (get_position_proc))
+    SCM_VALIDATE_PROC (3, get_position_proc);
+
+  if (!scm_is_false (set_position_proc))
+    SCM_VALIDATE_PROC (4, set_position_proc);
+
+  if (!scm_is_false (close_proc))
+    SCM_VALIDATE_PROC (5, close_proc);
+
+  return (make_cbop (write_proc, get_position_proc, set_position_proc,
+		     close_proc));
+}
+#undef FUNC_NAME
+
+
+/* Instantiate the custom binary output port type.  */
+static inline void
+initialize_custom_binary_output_ports (void)
+{
+  custom_binary_output_port_type =
+    scm_make_port_type ("r6rs-custom-binary-output-port",
+			NULL, cbop_write);
+
+  scm_set_port_mark (custom_binary_output_port_type, cbp_mark);
+  scm_set_port_seek (custom_binary_output_port_type, cbp_seek);
+  scm_set_port_close (custom_binary_output_port_type, cbp_close);
+}
+
+\f
+/* Initialization.  */
+
+void
+scm_init_r6rs_ports (void)
+{
+#include "r6rs-ports.x"
+
+  initialize_bytevector_input_ports ();
+  initialize_custom_binary_input_ports ();
+  initialize_bytevector_output_ports ();
+  initialize_custom_binary_output_ports ();
+}
diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h
new file mode 100644
index 0000000..e29d962
--- /dev/null
+++ b/libguile/r6rs-ports.h
@@ -0,0 +1,43 @@
+#ifndef SCM_R6RS_PORTS_H
+#define SCM_R6RS_PORTS_H
+
+/* 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 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+\f
+
+#include "libguile/__scm.h"
+
+/* R6RS I/O Ports.  */
+
+SCM_API SCM scm_eof_object (void);
+SCM_API SCM scm_open_bytevector_input_port (SCM, SCM);
+SCM_API SCM scm_make_custom_binary_input_port (SCM, SCM, SCM, SCM, SCM);
+SCM_API SCM scm_get_u8 (SCM);
+SCM_API SCM scm_lookahead_u8 (SCM);
+SCM_API SCM scm_get_bytevector_n (SCM, SCM);
+SCM_API SCM scm_get_bytevector_n_x (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_get_bytevector_some (SCM);
+SCM_API SCM scm_get_bytevector_all (SCM);
+SCM_API SCM scm_put_u8 (SCM, SCM);
+SCM_API SCM scm_put_bytevector (SCM, SCM, SCM, SCM);
+SCM_API SCM scm_open_bytevector_output_port (SCM);
+SCM_API SCM scm_make_custom_binary_output_port (SCM, SCM, SCM, SCM, SCM);
+
+SCM_API void scm_init_r6rs_ports (void);
+
+#endif /* SCM_R6RS_PORTS_H */
diff --git a/libguile/validate.h b/libguile/validate.h
index e05b7dd..c362c02 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VALIDATE_H
 #define SCM_VALIDATE_H
 
-/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2002, 2004, 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
@@ -150,6 +150,9 @@
     cvar = scm_to_bool (flag); \
   } while (0)
 
+#define SCM_VALIDATE_BYTEVECTOR(_pos, _obj)		\
+  SCM_VALIDATE_SMOB ((_pos), (_obj), bytevector)
+
 #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character")
 
 #define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \
diff --git a/module/Makefile.am b/module/Makefile.am
index 95dc75a..d149bb6 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -31,7 +31,7 @@ modpath =
 # putting these core modules first.
 
 SOURCES =								\
-  ice-9/psyntax-pp.scm \
+  ice-9/psyntax-pp.scm							\
   system/base/pmatch.scm system/base/syntax.scm				\
   system/base/compile.scm system/base/language.scm			\
 									\
@@ -53,6 +53,7 @@ SOURCES =								\
 									\
   $(ICE_9_SOURCES)							\
   $(SRFI_SOURCES)							\
+  $(RNRS_SOURCES)							\
   $(OOP_SOURCES)							\
 									\
   $(SCRIPTS_SOURCES)
@@ -209,6 +210,10 @@ SRFI_SOURCES = \
   srfi/srfi-69.scm \
   srfi/srfi-88.scm
 
+RNRS_SOURCES =					\
+  rnrs/bytevector.scm				\
+  rnrs/io/ports.scm
+
 EXTRA_DIST += scripts/ChangeLog-2008
 EXTRA_DIST += scripts/README
 
diff --git a/module/rnrs/bytevector.scm b/module/rnrs/bytevector.scm
new file mode 100644
index 0000000..793cbc0
--- /dev/null
+++ b/module/rnrs/bytevector.scm
@@ -0,0 +1,84 @@
+;;;; bytevector.scm --- R6RS bytevector API
+
+;;;;	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 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+
+;;; Commentary:
+;;;
+;;; A "bytevector" is a raw bit string.  This module provides procedures to
+;;; manipulate bytevectors and interpret their contents in a number of ways:
+;;; bytevector contents can be accessed as signed or unsigned integer of
+;;; various sizes and endianness, as IEEE-754 floating point numbers, or as
+;;; strings.  It is a useful tool to decode binary data.
+;;;
+;;; Code:
+
+(define-module (rnrs bytevector)
+  :export-syntax (endianness)
+  :export (native-endianness bytevector?
+           make-bytevector bytevector-length bytevector=? bytevector-fill!
+           bytevector-copy! bytevector-copy bytevector-u8-ref
+           bytevector-s8-ref
+           bytevector-u8-set! bytevector-s8-set! bytevector->u8-list
+           u8-list->bytevector
+           bytevector-uint-ref bytevector-uint-set!
+           bytevector-sint-ref bytevector-sint-set!
+           bytevector->sint-list bytevector->uint-list
+           uint-list->bytevector sint-list->bytevector
+
+           bytevector-u16-ref bytevector-s16-ref
+           bytevector-u16-set! bytevector-s16-set!
+           bytevector-u16-native-ref bytevector-s16-native-ref
+           bytevector-u16-native-set! bytevector-s16-native-set!
+
+           bytevector-u32-ref bytevector-s32-ref
+           bytevector-u32-set! bytevector-s32-set!
+           bytevector-u32-native-ref bytevector-s32-native-ref
+           bytevector-u32-native-set! bytevector-s32-native-set!
+
+           bytevector-u64-ref bytevector-s64-ref
+           bytevector-u64-set! bytevector-s64-set!
+           bytevector-u64-native-ref bytevector-s64-native-ref
+           bytevector-u64-native-set! bytevector-s64-native-set!
+
+           bytevector-ieee-single-ref
+           bytevector-ieee-single-set!
+           bytevector-ieee-single-native-ref
+           bytevector-ieee-single-native-set!
+
+           bytevector-ieee-double-ref
+           bytevector-ieee-double-set!
+           bytevector-ieee-double-native-ref
+           bytevector-ieee-double-native-set!
+
+           string->utf8 string->utf16 string->utf32
+           utf8->string utf16->string utf32->string))
+
+
+(load-extension "libguile" "scm_init_bytevectors")
+
+(define-macro (endianness sym)
+  (if (memq sym '(big little))
+      `(quote ,sym)
+      (error "unsupported endianness" sym)))
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; bytevector.scm ends here
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
new file mode 100644
index 0000000..73843ee
--- /dev/null
+++ b/module/rnrs/io/ports.scm
@@ -0,0 +1,111 @@
+;;;; ports.scm --- R6RS port API
+
+;;;;	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 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+
+;;; Commentary:
+;;;
+;;; The I/O port API of the R6RS is provided by this module.  In many areas
+;;; it complements or refines Guile's own historical port API.  For instance,
+;;; it allows for binary I/O with bytevectors.
+;;;
+;;; Code:
+
+(define-module (rnrs io ports)
+  :re-export (eof-object? port? input-port? output-port?)
+  :export (eof-object
+
+           ;; input & output ports
+           port-transcoder binary-port? transcoded-port
+           port-position set-port-position!
+           port-has-port-position? port-has-set-port-position!?
+           call-with-port
+
+           ;; input ports
+           open-bytevector-input-port
+           make-custom-binary-input-port
+
+           ;; binary input
+           get-u8 lookahead-u8
+           get-bytevector-n get-bytevector-n!
+           get-bytevector-some get-bytevector-all
+
+           ;; output ports
+           open-bytevector-output-port
+           make-custom-binary-output-port
+
+           ;; binary output
+           put-u8 put-bytevector))
+
+(load-extension "libguile" "scm_init_r6rs_ports")
+
+
+\f
+;;;
+;;; Input and output ports.
+;;;
+
+(define (port-transcoder port)
+  (error "port transcoders are not supported" port))
+
+(define (binary-port? port)
+  ;; So far, we don't support transcoders other than the binary transcoder.
+  #t)
+
+(define (transcoded-port port)
+  (error "port transcoders are not supported" port))
+
+(define (port-position port)
+  "Return the offset (an integer) indicating where the next octet will be
+read from/written to in @var{port}."
+
+  ;; FIXME: We should raise an `&assertion' error when not supported.
+  (seek port 0 SEEK_CUR))
+
+(define (set-port-position! port offset)
+  "Set the position where the next octet will be read from/written to
+@var{port}."
+
+  ;; FIXME: We should raise an `&assertion' error when not supported.
+  (seek port offset SEEK_SET))
+
+(define (port-has-port-position? port)
+  "Return @code{#t} is @var{port} supports @code{port-position}."
+  (and (false-if-exception (port-position port)) #t))
+
+(define (port-has-set-port-position!? port)
+  "Return @code{#t} is @var{port} supports @code{set-port-position!}."
+  (and (false-if-exception (set-port-position! port (port-position port)))
+       #t))
+
+(define (call-with-port port proc)
+  "Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
+@var{proc}.  Return the return values of @var{proc}."
+  (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc port))
+      (lambda ()
+        (close-port port))))
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; End:
+
+;;; ports.scm ends here
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 3854d4a..0b986d4 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -26,6 +26,7 @@ SCM_TESTS = tests/alist.test			\
 	    tests/arbiters.test			\
 	    tests/asm-to-bytecode.test		\
 	    tests/bit-operations.test		\
+	    tests/bytevectors.test		\
 	    tests/c-api.test			\
 	    tests/chars.test			\
 	    tests/common-list.test		\
@@ -62,6 +63,7 @@ SCM_TESTS = tests/alist.test			\
 	    tests/q.test			\
 	    tests/r4rs.test			\
 	    tests/r5rs_pitfall.test		\
+	    tests/r6rs-ports.test		\
 	    tests/ramap.test			\
 	    tests/reader.test			\
 	    tests/receive.test			\
diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test
new file mode 100644
index 0000000..b2ae65c
--- /dev/null
+++ b/test-suite/tests/bytevectors.test
@@ -0,0 +1,531 @@
+;;;; bytevectors.test --- Exercise the R6RS bytevector API.
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Ludovic Courtès
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-bytevector)
+  :use-module (test-suite lib)
+  :use-module (rnrs bytevector))
+
+;;; Some of the tests in here are examples taken from the R6RS Standard
+;;; Libraries document.
+
+\f
+(with-test-prefix "2.2 General Operations"
+
+  (pass-if "native-endianness"
+    (not (not (memq (native-endianness) '(big little)))))
+
+  (pass-if "make-bytevector"
+    (and (bytevector? (make-bytevector 20))
+         (bytevector? (make-bytevector 20 3))))
+
+  (pass-if "bytevector-length"
+    (= (bytevector-length (make-bytevector 20)) 20))
+
+  (pass-if "bytevector=?"
+    (and (bytevector=? (make-bytevector 20 7)
+                       (make-bytevector 20 7))
+         (not (bytevector=? (make-bytevector 20 7)
+                            (make-bytevector 20 0))))))
+
+\f
+(with-test-prefix "2.3 Operations on Bytes and Octets"
+
+  (pass-if "bytevector-{u8,s8}-ref"
+    (equal? '(-127 129 -1 255)
+            (let ((b1 (make-bytevector 16 -127))
+                  (b2 (make-bytevector 16 255)))
+              (list (bytevector-s8-ref b1 0)
+                    (bytevector-u8-ref b1 0)
+                    (bytevector-s8-ref b2 0)
+                    (bytevector-u8-ref b2 0)))))
+
+  (pass-if "bytevector-{u8,s8}-set!"
+    (equal? '(-126 130 -10 246)
+            (let ((b (make-bytevector 16 -127)))
+
+              (bytevector-s8-set! b 0 -126)
+              (bytevector-u8-set! b 1 246)
+
+              (list (bytevector-s8-ref b 0)
+                    (bytevector-u8-ref b 0)
+                    (bytevector-s8-ref b 1)
+                    (bytevector-u8-ref b 1)))))
+
+  (pass-if "bytevector->u8-list"
+    (let ((lst '(1 2 3 128 150 255)))
+      (equal? lst
+              (bytevector->u8-list
+               (let ((b (make-bytevector 6)))
+                 (for-each (lambda (i v)
+                             (bytevector-u8-set! b i v))
+                           (iota 6)
+                           lst)
+                 b)))))
+
+  (pass-if "u8-list->bytevector"
+    (let ((lst '(1 2 3 128 150 255)))
+      (equal? lst
+              (bytevector->u8-list (u8-list->bytevector lst)))))
+
+  (pass-if "bytevector-uint-{ref,set!} [small]"
+    (let ((b (make-bytevector 15)))
+      (bytevector-uint-set! b 0 #x1234
+                            (endianness little) 2)
+      (equal? (bytevector-uint-ref b 0 (endianness big) 2)
+              #x3412)))
+
+  (pass-if "bytevector-uint-set! [large]"
+    (let ((b (make-bytevector 16)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector->u8-list b)
+              '(253 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 255))))
+
+  (pass-if "bytevector-uint-{ref,set!} [large]"
+    (let ((b (make-bytevector 120)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector-uint-ref b 0 (endianness little) 16)
+              #xfffffffffffffffffffffffffffffffd)))
+
+  (pass-if "bytevector-sint-ref [small]"
+    (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
+      (equal? (bytevector-sint-ref b 0 (endianness big) 2)
+              (bytevector-sint-ref b 1 (endianness little) 2)
+              -16)))
+
+  (pass-if "bytevector-sint-ref [large]"
+    (let ((b (make-bytevector 50)))
+      (bytevector-uint-set! b 0 (- (expt 2 128) 3)
+                            (endianness little) 16)
+      (equal? (bytevector-sint-ref b 0 (endianness little) 16)
+              -3)))
+
+  (pass-if "bytevector-sint-set! [small]"
+    (let ((b (make-bytevector 3)))
+      (bytevector-sint-set! b 0 -16 (endianness big) 2)
+      (bytevector-sint-set! b 1 -16 (endianness little) 2)
+      (equal? (bytevector->u8-list b)
+	      '(#xff #xf0 #xff)))))
+
+\f
+(with-test-prefix "2.4 Operations on Integers of Arbitrary Size"
+
+  (pass-if "bytevector->sint-list"
+    (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+      (equal? (bytevector->sint-list b (endianness little) 2)
+              '(513 -253 513 513))))
+
+  (pass-if "bytevector->uint-list"
+    (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
+      (equal? (bytevector->uint-list b (endianness big) 2)
+              '(513 65283 513 513))))
+
+  (pass-if "bytevector->uint-list [empty]"
+    (let ((b (make-bytevector 0)))
+      (null? (bytevector->uint-list b (endianness big) 2))))
+
+  (pass-if-exception "bytevector->sint-list [out-of-range]"
+    exception:out-of-range
+    (bytevector->sint-list (make-bytevector 6) (endianness little) 8))
+
+  (pass-if "bytevector->sint-list [off-by-one]"
+    (equal? (bytevector->sint-list (make-bytevector 31 #xff)
+                                   (endianness little) 8)
+            '(-1 -1 -1)))
+
+  (pass-if "{sint,uint}-list->bytevector"
+    (let ((b1 (sint-list->bytevector '(513 -253 513 513)
+                                     (endianness little) 2))
+          (b2 (uint-list->bytevector '(513 65283 513 513)
+                                     (endianness little) 2))
+          (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
+      (and (bytevector=? b1 b2)
+           (bytevector=? b2 b3))))
+
+  (pass-if "sint-list->bytevector [limits]"
+           (bytevector=? (sint-list->bytevector '(-32768 32767)
+                                                (endianness big) 2)
+                         (let ((bv (make-bytevector 4)))
+                           (bytevector-u8-set! bv 0 #x80)
+                           (bytevector-u8-set! bv 1 #x00)
+                           (bytevector-u8-set! bv 2 #x7f)
+                           (bytevector-u8-set! bv 3 #xff)
+                           bv)))
+
+  (pass-if-exception "sint-list->bytevector [out-of-range]"
+    exception:out-of-range
+    (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
+                           2))
+
+  (pass-if-exception "uint-list->bytevector [out-of-range]"
+    exception:out-of-range
+    (uint-list->bytevector '(0 -1) (endianness big) 2)))
+
+\f
+(with-test-prefix "2.5 Operations on 16-Bit Integers"
+
+  (pass-if "bytevector-u16-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u16-ref b 14 (endianness little))
+                   #xfdff)
+           (equal? (bytevector-u16-ref b 14 (endianness big))
+                   #xfffd))))
+
+  (pass-if "bytevector-s16-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s16-ref b 14 (endianness little))
+                   -513)
+           (equal? (bytevector-s16-ref b 14 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-s16-ref [unaligned]"
+    (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
+      (equal? (bytevector-s16-ref b 1 (endianness little))
+	      -16)))
+
+  (pass-if "bytevector-{u16,s16}-ref"
+    (let ((b (make-bytevector 2)))
+      (bytevector-u16-set! b 0 44444 (endianness little))
+      (and (equal? (bytevector-u16-ref b 0 (endianness little))
+                   44444)
+           (equal? (bytevector-s16-ref b 0 (endianness little))
+                   (- 44444 65536)))))
+
+  (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
+    (let ((b (make-bytevector 2)))
+      (bytevector-u16-native-set! b 0 44444)
+      (and (equal? (bytevector-u16-native-ref b 0)
+                   44444)
+           (equal? (bytevector-s16-native-ref b 0)
+                   (- 44444 65536)))))
+
+  (pass-if "bytevector-s16-{ref,set!} [unaligned]"
+    (let ((b (make-bytevector 3)))
+      (bytevector-s16-set! b 1 -77 (endianness little))
+      (equal? (bytevector-s16-ref b 1 (endianness little))
+	      -77))))
+
+\f
+(with-test-prefix "2.6 Operations on 32-bit Integers"
+
+  (pass-if "bytevector-u32-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u32-ref b 12 (endianness little))
+                   #xfdffffff)
+           (equal? (bytevector-u32-ref b 12 (endianness big))
+                   #xfffffffd))))
+
+  (pass-if "bytevector-s32-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s32-ref b 12 (endianness little))
+                   -33554433)
+           (equal? (bytevector-s32-ref b 12 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-{u32,s32}-ref"
+    (let ((b (make-bytevector 4)))
+      (bytevector-u32-set! b 0 2222222222 (endianness little))
+      (and (equal? (bytevector-u32-ref b 0 (endianness little))
+                   2222222222)
+           (equal? (bytevector-s32-ref b 0 (endianness little))
+                   (- 2222222222 (expt 2 32))))))
+
+  (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
+    (let ((b (make-bytevector 4)))
+      (bytevector-u32-native-set! b 0 2222222222)
+      (and (equal? (bytevector-u32-native-ref b 0)
+                   2222222222)
+           (equal? (bytevector-s32-native-ref b 0)
+                   (- 2222222222 (expt 2 32)))))))
+
+\f
+(with-test-prefix "2.7 Operations on 64-bit Integers"
+
+  (pass-if "bytevector-u64-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-u64-ref b 8 (endianness little))
+                   #xfdffffffffffffff)
+           (equal? (bytevector-u64-ref b 8 (endianness big))
+                   #xfffffffffffffffd))))
+
+  (pass-if "bytevector-s64-ref"
+    (let ((b (u8-list->bytevector
+              '(255 255 255 255 255 255 255 255
+                255 255 255 255 255 255 255 253))))
+      (and (equal? (bytevector-s64-ref b 8 (endianness little))
+                   -144115188075855873)
+           (equal? (bytevector-s64-ref b 8 (endianness big))
+                   -3))))
+
+  (pass-if "bytevector-{u64,s64}-ref"
+    (let ((b (make-bytevector 8))
+          (big 9333333333333333333))
+      (bytevector-u64-set! b 0 big (endianness little))
+      (and (equal? (bytevector-u64-ref b 0 (endianness little))
+                   big)
+           (equal? (bytevector-s64-ref b 0 (endianness little))
+                   (- big (expt 2 64))))))
+
+  (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (big 9333333333333333333))
+      (bytevector-u64-native-set! b 0 big)
+      (and (equal? (bytevector-u64-native-ref b 0)
+                   big)
+           (equal? (bytevector-s64-native-ref b 0)
+                   (- big (expt 2 64))))))
+
+  (pass-if "ref/set! with zero"
+     (let ((b (make-bytevector 8)))
+       (bytevector-s64-set! b 0 -1 (endianness big))
+       (bytevector-u64-set! b 0  0 (endianness big))
+       (= 0 (bytevector-u64-ref b 0 (endianness big))))))
+
+\f
+(with-test-prefix "2.8 Operations on IEEE-754 Representations"
+
+  (pass-if "bytevector-ieee-single-native-{ref,set!}"
+    (let ((b (make-bytevector 4))
+          (number 3.00))
+      (bytevector-ieee-single-native-set! b 0 number)
+      (equal? (bytevector-ieee-single-native-ref b 0)
+              number)))
+
+  (pass-if "bytevector-ieee-single-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (number 3.14))
+      (bytevector-ieee-single-set! b 0 number (endianness little))
+      (bytevector-ieee-single-set! b 4 number (endianness big))
+      (equal? (bytevector-ieee-single-ref b 0 (endianness little))
+              (bytevector-ieee-single-ref b 4 (endianness big)))))
+
+  (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
+    (let ((b (make-bytevector 9))
+          (number 3.14))
+      (bytevector-ieee-single-set! b 1 number (endianness little))
+      (bytevector-ieee-single-set! b 5 number (endianness big))
+      (equal? (bytevector-ieee-single-ref b 1 (endianness little))
+              (bytevector-ieee-single-ref b 5 (endianness big)))))
+
+  (pass-if "bytevector-ieee-double-native-{ref,set!}"
+    (let ((b (make-bytevector 8))
+          (number 3.14))
+      (bytevector-ieee-double-native-set! b 0 number)
+      (equal? (bytevector-ieee-double-native-ref b 0)
+              number)))
+
+  (pass-if "bytevector-ieee-double-{ref,set!}"
+    (let ((b (make-bytevector 16))
+          (number 3.14))
+      (bytevector-ieee-double-set! b 0 number (endianness little))
+      (bytevector-ieee-double-set! b 8 number (endianness big))
+      (equal? (bytevector-ieee-double-ref b 0 (endianness little))
+              (bytevector-ieee-double-ref b 8 (endianness big))))))
+
+\f
+(define (with-locale locale thunk)
+  ;; Run THUNK under LOCALE.
+  (let ((original-locale (setlocale LC_ALL)))
+    (catch 'system-error
+      (lambda ()
+        (setlocale LC_ALL locale))
+      (lambda (key . args)
+        (throw 'unresolved)))
+
+    (dynamic-wind
+        (lambda ()
+          #t)
+        thunk
+        (lambda ()
+          (setlocale LC_ALL original-locale)))))
+
+(define (with-latin1-locale thunk)
+  ;; Try out several ISO-8859-1 locales and run THUNK under the one that
+  ;; works (if any).
+  (define %locales
+    (map (lambda (name)
+           (string-append name ".ISO-8859-1"))
+         '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
+
+  (let loop ((locales %locales))
+    (if (null? locales)
+        (throw 'unresolved)
+        (catch 'unresolved
+          (lambda ()
+            (with-locale (car locales) thunk))
+          (lambda (key . args)
+            (loop (cdr locales)))))))
+
+
+;; Default to the C locale for the following tests.
+(setlocale LC_ALL "C")
+
+
+(with-test-prefix "2.9 Operations on Strings"
+
+  (pass-if "string->utf8"
+    (let* ((str  "hello, world")
+           (utf8 (string->utf8 str)))
+      (and (bytevector? utf8)
+           (= (bytevector-length utf8)
+              (string-length str))
+           (equal? (string->list str)
+                   (map integer->char (bytevector->u8-list utf8))))))
+
+  (pass-if "string->utf8 [latin-1]"
+    (with-latin1-locale
+      (lambda ()
+        (let* ((str  "hé, ça va bien ?")
+               (utf8 (string->utf8 str)))
+          (and (bytevector? utf8)
+               (= (bytevector-length utf8)
+                  (+ 2 (string-length str))))))))
+
+  (pass-if "string->utf16"
+    (let* ((str   "hello, world")
+           (utf16 (string->utf16 str)))
+      (and (bytevector? utf16)
+           (= (bytevector-length utf16)
+              (* 2 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16
+                                               (endianness big) 2))))))
+
+  (pass-if "string->utf16 [little]"
+    (let* ((str   "hello, world")
+           (utf16 (string->utf16 str (endianness little))))
+      (and (bytevector? utf16)
+           (= (bytevector-length utf16)
+              (* 2 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16
+                                               (endianness little) 2))))))
+
+
+  (pass-if "string->utf32"
+    (let* ((str   "hello, world")
+           (utf32 (string->utf32 str)))
+      (and (bytevector? utf32)
+           (= (bytevector-length utf32)
+              (* 4 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32
+                                               (endianness big) 4))))))
+
+  (pass-if "string->utf32 [little]"
+    (let* ((str   "hello, world")
+           (utf32 (string->utf32 str (endianness little))))
+      (and (bytevector? utf32)
+           (= (bytevector-length utf32)
+              (* 4 (string-length str)))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32
+                                               (endianness little) 4))))))
+
+  (pass-if "utf8->string"
+    (let* ((utf8  (u8-list->bytevector (map char->integer
+                                            (string->list "hello, world"))))
+           (str   (utf8->string utf8)))
+      (and (string? str)
+           (= (string-length str)
+              (bytevector-length utf8))
+           (equal? (string->list str)
+                   (map integer->char (bytevector->u8-list utf8))))))
+
+  (pass-if "utf8->string [latin-1]"
+    (with-latin1-locale
+      (lambda ()
+        (let* ((utf8  (string->utf8 "hé, ça va bien ?"))
+               (str   (utf8->string utf8)))
+          (and (string? str)
+               (= (string-length str)
+                  (- (bytevector-length utf8) 2)))))))
+
+  (pass-if "utf16->string"
+    (let* ((utf16  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness big) 2))
+           (str   (utf16->string utf16)))
+      (and (string? str)
+           (= (* 2 (string-length str))
+              (bytevector-length utf16))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16 (endianness big)
+                                               2))))))
+
+  (pass-if "utf16->string [little]"
+    (let* ((utf16  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness little) 2))
+           (str   (utf16->string utf16 (endianness little))))
+      (and (string? str)
+           (= (* 2 (string-length str))
+              (bytevector-length utf16))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf16 (endianness little)
+                                               2))))))
+  (pass-if "utf32->string"
+    (let* ((utf32  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness big) 4))
+           (str   (utf32->string utf32)))
+      (and (string? str)
+           (= (* 4 (string-length str))
+              (bytevector-length utf32))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32 (endianness big)
+                                               4))))))
+
+  (pass-if "utf32->string [little]"
+    (let* ((utf32  (uint-list->bytevector (map char->integer
+                                               (string->list "hello, world"))
+                                          (endianness little) 4))
+           (str   (utf32->string utf32 (endianness little))))
+      (and (string? str)
+           (= (* 4 (string-length str))
+              (bytevector-length utf32))
+           (equal? (string->list str)
+                   (map integer->char
+                        (bytevector->uint-list utf32 (endianness little)
+                                               4)))))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; mode: scheme
+;;; End:
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
new file mode 100644
index 0000000..204f371
--- /dev/null
+++ b/test-suite/tests/r6rs-ports.test
@@ -0,0 +1,455 @@
+;;;; r6rs-ports.test --- Exercise the R6RS I/O port API.
+;;;;
+;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Ludovic Courtès
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-io-ports)
+  :use-module (test-suite lib)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-11)
+  :use-module (rnrs io ports)
+  :use-module (rnrs bytevector))
+
+;;; All these tests assume Guile 1.8's port system, where characters are
+;;; treated as octets.
+
+\f
+(with-test-prefix "7.2.5 End-of-File Object"
+
+  (pass-if "eof-object"
+    (and (eqv? (eof-object) (eof-object))
+         (eq?  (eof-object) (eof-object)))))
+
+\f
+(with-test-prefix "7.2.8 Binary Input"
+
+  (pass-if "get-u8"
+    (let ((port (open-input-string "A")))
+      (and (= (char->integer #\A) (get-u8 port))
+           (eof-object? (get-u8 port)))))
+
+  (pass-if "lookahead-u8"
+    (let ((port (open-input-string "A")))
+      (and (= (char->integer #\A) (lookahead-u8 port))
+           (not (eof-object? port))
+           (= (char->integer #\A) (get-u8 port))
+           (eof-object? (get-u8 port)))))
+
+  (pass-if "get-bytevector-n [short]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv (get-bytevector-n port 4)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-n [long]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv (get-bytevector-n port 256)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU Guile"))))))
+
+  (pass-if-exception "get-bytevector-n with closed port"
+    exception:wrong-type-arg
+
+    (let ((port (%make-void-port "r")))
+
+      (close-port port)
+      (get-bytevector-n port 3)))
+
+  (pass-if "get-bytevector-n! [short]"
+    (let* ((port (open-input-string "GNU Guile"))
+           (bv   (make-bytevector 4))
+           (read (get-bytevector-n! port bv 0 4)))
+      (and (equal? read 4)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-n! [long]"
+    (let* ((str  "GNU Guile")
+           (port (open-input-string str))
+           (bv   (make-bytevector 256))
+           (read (get-bytevector-n! port bv 0 256)))
+      (and (equal? read (string-length str))
+           (equal? (map (lambda (i)
+                          (bytevector-u8-ref bv i))
+                        (iota read))
+                   (map char->integer (string->list str))))))
+
+  (pass-if "get-bytevector-some [simple]"
+    (let* ((str  "GNU Guile")
+           (port (open-input-string str))
+           (bv   (get-bytevector-some port)))
+      (and (bytevector? bv)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list str))))))
+
+  (pass-if "get-bytevector-some [only-some]"
+    (let* ((str   "GNU Guile")
+           (index 0)
+           (port  (make-soft-port
+                   (vector #f #f #f
+                           (lambda ()
+                             (if (>= index (string-length str))
+                                 (eof-object)
+                                 (let ((c (string-ref str index)))
+                                   (set! index (+ index 1))
+                                   c)))
+                           (lambda () #t)
+                           (lambda ()
+                             ;; Number of readily available octets: falls to
+                             ;; zero after 4 octets have been read.
+                             (- 4 (modulo index 5))))
+                   "r"))
+           (bv    (get-bytevector-some port)))
+      (and (bytevector? bv)
+           (= index 4)
+           (= (bytevector-length bv) index)
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list "GNU "))))))
+
+  (pass-if "get-bytevector-all"
+    (let* ((str   "GNU Guile")
+           (index 0)
+           (port  (make-soft-port
+                   (vector #f #f #f
+                           (lambda ()
+                             (if (>= index (string-length str))
+                                 (eof-object)
+                                 (let ((c (string-ref str index)))
+                                   (set! index (+ index 1))
+                                   c)))
+                           (lambda () #t)
+                           (let ((cont? #f))
+                             (lambda ()
+                               ;; Number of readily available octets: falls to
+                               ;; zero after 4 octets have been read and then
+                               ;; starts again.
+                               (let ((a (if cont?
+                                            (- (string-length str) index)
+                                            (- 4 (modulo index 5)))))
+                                 (if (= 0 a) (set! cont? #t))
+                                 a))))
+                   "r"))
+           (bv    (get-bytevector-all port)))
+      (and (bytevector? bv)
+           (= index (string-length str))
+           (= (bytevector-length bv) (string-length str))
+           (equal? (bytevector->u8-list bv)
+                   (map char->integer (string->list str)))))))
+
+\f
+(define (make-soft-output-port)
+  (let* ((bv (make-bytevector 1024))
+         (read-index  0)
+         (write-index 0)
+         (write-char (lambda (chr)
+                       (bytevector-u8-set! bv write-index
+                                           (char->integer chr))
+                       (set! write-index (+ 1 write-index)))))
+    (make-soft-port
+     (vector write-char
+             (lambda (str)   ;; write-string
+               (for-each write-char (string->list str)))
+             (lambda () #t)  ;; flush-output
+             (lambda ()      ;; read-char
+               (if (>= read-index (bytevector-length bv))
+                   (eof-object)
+                   (let ((c (bytevector-u8-ref bv read-index)))
+                     (set! read-index (+ read-index 1))
+                     (integer->char c))))
+             (lambda () #t)) ;; close-port
+     "rw")))
+
+(with-test-prefix "7.2.11 Binary Output"
+
+  (pass-if "put-u8"
+    (let ((port (make-soft-output-port)))
+      (put-u8 port 77)
+      (equal? (get-u8 port) 77)))
+
+  (pass-if "put-bytevector [2 args]"
+    (let ((port (make-soft-output-port))
+          (bv   (make-bytevector 256)))
+      (put-bytevector port bv)
+      (equal? (bytevector->u8-list bv)
+              (bytevector->u8-list
+               (get-bytevector-n port (bytevector-length bv))))))
+
+  (pass-if "put-bytevector [3 args]"
+    (let ((port  (make-soft-output-port))
+          (bv    (make-bytevector 256))
+          (start 10))
+      (put-bytevector port bv start)
+      (equal? (drop (bytevector->u8-list bv) start)
+              (bytevector->u8-list
+               (get-bytevector-n port (- (bytevector-length bv) start))))))
+
+  (pass-if "put-bytevector [4 args]"
+    (let ((port  (make-soft-output-port))
+          (bv    (make-bytevector 256))
+          (start 10)
+          (count 77))
+      (put-bytevector port bv start count)
+      (equal? (take (drop (bytevector->u8-list bv) start) count)
+              (bytevector->u8-list
+               (get-bytevector-n port count)))))
+
+  (pass-if-exception "put-bytevector with closed port"
+    exception:wrong-type-arg
+
+    (let* ((bv   (make-bytevector 4))
+           (port (%make-void-port "w")))
+
+      (close-port port)
+      (put-bytevector port bv))))
+
+\f
+(with-test-prefix "7.2.7 Input Ports"
+
+  ;; This section appears here so that it can use the binary input
+  ;; primitives.
+
+  (pass-if "open-bytevector-input-port [1 arg]"
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv))
+           (read-to-string
+            (lambda (port)
+              (let loop ((chr (read-char port))
+                         (result '()))
+                (if (eof-object? chr)
+                    (apply string (reverse! result))
+                    (loop (read-char port)
+                          (cons chr result)))))))
+
+      (equal? (read-to-string port) str)))
+
+  (pass-if-exception "bytevector-input-port is read-only"
+    exception:wrong-type-arg
+
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv #f)))
+
+      (write "hello" port)))
+
+  (pass-if "bytevector input port supports seeking"
+    (let* ((str "Hello Port!")
+           (bv (u8-list->bytevector (map char->integer
+                                         (string->list str))))
+           (port (open-bytevector-input-port bv #f)))
+
+      (and (port-has-port-position? port)
+           (= 0 (port-position port))
+           (port-has-set-port-position!? port)
+           (begin
+             (set-port-position! port 6)
+             (= 6 (port-position port)))
+           (bytevector=? (get-bytevector-all port)
+                         (u8-list->bytevector
+                          (map char->integer (string->list "Port!")))))))
+
+  (pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
+    exception:wrong-num-args
+
+    ;; Prior to Guile-R6RS-Libs 0.2, the last 3 arguments were wrongfully
+    ;; optional.
+    (make-custom-binary-input-port "port" (lambda args #t)))
+
+  (pass-if "make-custom-binary-input-port"
+    (let* ((source (make-bytevector 7777))
+           (read! (let ((pos 0)
+                        (len (bytevector-length source)))
+                    (lambda (bv start count)
+                      (let ((amount (min count (- len pos))))
+                        (if (> amount 0)
+                            (bytevector-copy! source pos
+                                              bv start amount))
+                        (set! pos (+ pos amount))
+                        amount))))
+           (port (make-custom-binary-input-port "the port" read!
+                                                #f #f #f)))
+
+      (bytevector=? (get-bytevector-all port) source)))
+
+  (pass-if "custom binary input port does not support `port-position'"
+    (let* ((str "Hello Port!")
+           (source (open-bytevector-input-port
+                    (u8-list->bytevector
+                     (map char->integer (string->list str)))))
+           (read! (lambda (bv start count)
+                    (let ((r (get-bytevector-n! source bv start count)))
+                      (if (eof-object? r)
+                          0
+                          r))))
+           (port (make-custom-binary-input-port "the port" read!
+                                                #f #f #f)))
+      (not (or (port-has-port-position? port)
+               (port-has-set-port-position!? port)))))
+
+  (pass-if "custom binary input port supports `port-position'"
+    (let* ((str "Hello Port!")
+           (source (open-bytevector-input-port
+                    (u8-list->bytevector
+                     (map char->integer (string->list str)))))
+           (read! (lambda (bv start count)
+                    (let ((r (get-bytevector-n! source bv start count)))
+                      (if (eof-object? r)
+                          0
+                          r))))
+           (get-pos (lambda ()
+                      (port-position source)))
+           (set-pos! (lambda (pos)
+                       (set-port-position! source pos)))
+           (port (make-custom-binary-input-port "the port" read!
+                                                get-pos set-pos! #f)))
+
+      (and (port-has-port-position? port)
+           (= 0 (port-position port))
+           (port-has-set-port-position!? port)
+           (begin
+             (set-port-position! port 6)
+             (= 6 (port-position port)))
+           (bytevector=? (get-bytevector-all port)
+                         (u8-list->bytevector
+                          (map char->integer (string->list "Port!")))))))
+
+  (pass-if "custom binary input port `close-proc' is called"
+    (let* ((closed?  #f)
+           (read!    (lambda (bv start count) 0))
+           (get-pos  (lambda () 0))
+           (set-pos! (lambda (pos) #f))
+           (close!   (lambda () (set! closed? #t)))
+           (port     (make-custom-binary-input-port "the port" read!
+                                                    get-pos set-pos!
+                                                    close!)))
+
+      (close-port port)
+      closed?)))
+
+\f
+(with-test-prefix "8.2.10 Output ports"
+
+  (pass-if "open-bytevector-output-port"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port #f)))
+      (let ((source (make-bytevector 7777)))
+        (put-bytevector port source)
+        (and (bytevector=? (get-content) source)
+             (bytevector=? (get-content) (make-bytevector 0))))))
+
+  (pass-if "open-bytevector-output-port [put-u8]"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (put-u8 port 77)
+      (and (bytevector=? (get-content) (make-bytevector 1 77))
+           (bytevector=? (get-content) (make-bytevector 0)))))
+
+  (pass-if "open-bytevector-output-port [display]"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (display "hello" port)
+      (and (bytevector=? (get-content) (string->utf8 "hello"))
+           (bytevector=? (get-content) (make-bytevector 0)))))
+
+  (pass-if "bytevector output port supports `port-position'"
+    (let-values (((port get-content)
+                  (open-bytevector-output-port)))
+      (let ((source (make-bytevector 7777))
+            (overwrite (make-bytevector 33)))
+        (and (port-has-port-position? port)
+             (port-has-set-port-position!? port)
+             (begin
+               (put-bytevector port source)
+               (= (bytevector-length source)
+                  (port-position port)))
+             (begin
+               (set-port-position! port 10)
+               (= 10 (port-position port)))
+             (begin
+               (put-bytevector port overwrite)
+               (bytevector-copy! overwrite 0 source 10
+                                 (bytevector-length overwrite))
+               (= (port-position port)
+                  (+ 10 (bytevector-length overwrite))))
+             (bytevector=? (get-content) source)
+             (bytevector=? (get-content) (make-bytevector 0))))))
+
+  (pass-if "make-custom-binary-output"
+    (let ((port (make-custom-binary-output-port "cbop"
+                                                (lambda (x y z) 0)
+                                                #f #f #f)))
+      (and (output-port? port)
+           (binary-port? port)
+           (not (port-has-port-position? port))
+           (not (port-has-set-port-position!? port)))))
+
+  (pass-if "make-custom-binary-output-port [partial writes]"
+    (let* ((source   (uint-list->bytevector (iota 333)
+                                            (native-endianness) 2))
+           (sink     (make-bytevector (bytevector-length source)))
+           (sink-pos 0)
+           (eof?     #f)
+           (write!   (lambda (bv start count)
+                       (if (= 0 count)
+                           (begin
+                             (set! eof? #t)
+                             0)
+                           (let ((u8 (bytevector-u8-ref bv start)))
+                             ;; Get one byte at a time.
+                             (bytevector-u8-set! sink sink-pos u8)
+                             (set! sink-pos (+ 1 sink-pos))
+                             1))))
+           (port     (make-custom-binary-output-port "cbop" write!
+                                                     #f #f #f)))
+      (put-bytevector port source)
+      (and (= sink-pos (bytevector-length source))
+           (not eof?)
+           (bytevector=? sink source))))
+
+  (pass-if "make-custom-binary-output-port [full writes]"
+    (let* ((source   (uint-list->bytevector (iota 333)
+                                            (native-endianness) 2))
+           (sink     (make-bytevector (bytevector-length source)))
+           (sink-pos 0)
+           (eof?     #f)
+           (write!   (lambda (bv start count)
+                       (if (= 0 count)
+                           (begin
+                             (set! eof? #t)
+                             0)
+                           (begin
+                             (bytevector-copy! bv start
+                                               sink sink-pos
+                                               count)
+                             (set! sink-pos (+ sink-pos count))
+                             count))))
+           (port     (make-custom-binary-output-port "cbop" write!
+                                                     #f #f #f)))
+      (put-bytevector port source)
+      (and (= sink-pos (bytevector-length source))
+           (not eof?)
+           (bytevector=? sink source)))))
+
+
+;;; Local Variables:
+;;; coding: latin-1
+;;; mode: scheme
+;;; End:
-- 
1.6.1.3


[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]

Re: Merging Guile-R6RS-Libs in `master'

[Andy Wingo]

Hi Ludovic!

On Thu 28 May 2009 00:27, ludo@gnu.org (Ludovic Courtès) writes:

> Attached is my initial patch to integrate Guile-R6RS-Libs (bytevectors
> and I/O ports).  I'll commit it shortly to `master' if nobody objects.

Yay!

> It adds a dependency on GNU libunistring (by Bruno Haible).  We could
> avoid it by importing all the Gnulib modules libunistring is based on,
> but I think it's better to not ship and link a copy of such a large body
> of code.  Mike's work needs it as well.

This is unfortunate, to have a new dependency, and on a library that's
not in released distros, nor even very googlable. (I'm on the fedora 11
prereleases, and it seems there is no unistring package.)

It's also unfortunate that we won't be sharing unicode tables with other
apps that exist.

But, I guess this is the right way forward. ASCII and wchar were even
less "fortunate" ;-)

Yay for unicode in Guile!

Andy
-- 
http://wingolog.org/

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Hello!

Andy Wingo <wingo@pobox.com> writes:

> This is unfortunate, to have a new dependency, and on a library that's
> not in released distros, nor even very googlable. (I'm on the fedora 11
> prereleases, and it seems there is no unistring package.)

I agree.  Hopefully libunistring will become more widely available in
the not-so-far future.  If it's not the case, we still have the option
of switching to the `uniconv' series of Gnulib modules, which provide
the same code.

> It's also unfortunate that we won't be sharing unicode tables with other
> apps that exist.

What do you mean?

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Ludovic Courtès]

Hello,

I've just committed the whole thing:
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1ee2c72eafaae5f91f4c899bc4b4853af5c16f28 .

GNU libunistring is now required, see
http://www.gnu.org/software/libunistring/ for details.

Thanks,
Ludo'.

Re: Merging Guile-R6RS-Libs in `master'

[Andy Wingo]

Heya Ludo,

On Thu 28 May 2009 21:16, ludo@gnu.org (Ludovic Courtès) writes:

> Andy Wingo <wingo@pobox.com> writes:
>
>> It's also unfortunate that we won't be sharing unicode tables with other
>> apps that exist.
>
> What do you mean?

The unicode character tables occupy a significant size, in terms of
read-only memory. If other apps on the OS are using libunistring, this
cost is divided among all apps; but if you have an app that uses GLib,
for example, you're duplicating the tables that they have.

(It still seems to me that unistring is the right solution for Guile and
GNU, though.)

Cheers,

Andy
-- 
http://wingolog.org/