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'.

18 files changed, 4688 insertions, 12 deletions

diff --git a/README b/README
index 9993fcfaf..4950229df 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 e65e8bcb2..dcadd5869 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 000000000..9547a71df
--- /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))
+
+
+(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)))
+
+
+(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)))
+
+
+(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 07c476686..6568e524f 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 40122dfa2..6a6d232f9 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 63f2ef2bf..fcf197a54 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 000000000..4c3a353a1
--- /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>
+
+
+
+/* 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;
+
+
+
+/* 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;
+}
+
+
+
+/* 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
+
+
+/* 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
+
+
+
+/* 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
+
+
+
+/* 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
+
+
+
+/* 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
+
+
+
+/* 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
+
+
+
+/* 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
+
+
+/* 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
+
+
+
+/* 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 000000000..98c38aca2
--- /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
+ */
+
+
+
+#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);
+
+
+
+/* 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 000000000..e345efaae
--- /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.  */
+
+
+/* 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;
+  };
+
+
+
+/* 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 000000000..a07636fce
--- /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"
+
+
+
+/* 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);
+}
+
+
+/* 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
+
+
+/* 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
+
+
+/* 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;
+}
+
+
+/* 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);
+}
+
+
+
+/* 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
+
+
+
+/* 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
+
+
+
+/* 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);
+}
+
+
+/* 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);
+}
+
+
+/* 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 000000000..e29d96200
--- /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
+ */
+
+
+
+#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 e05b7dd83..c362c02f3 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 95dc75ac2..d149bb64a 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 000000000..793cbc020
--- /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 000000000..73843ee55
--- /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")
+
+
+
+;;;
+;;; 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 3854d4ab1..0b986d4a2 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 000000000..b2ae65c1f
--- /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.
+
+
+(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))))))
+
+
+(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)))))
+
+
+(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)))
+
+
+(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))))
+
+
+(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)))))))
+
+
+(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))))))
+
+
+(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))))))
+
+
+(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 000000000..204f37144
--- /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.
+
+
+(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)))))
+
+
+(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)))))))
+
+
+(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))))
+
+
+(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?)))
+
+
+(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: