Add 'bytevector-slice'.

* module/rnrs/bytevectors/gnu.scm: New file.
* am/bootstrap.am (SOURCES): Add it.
* libguile/bytevectors.c (scm_bytevector_slice): New function.
* libguile/bytevectors.h (scm_bytevector_slice): New declaration.
* test-suite/tests/bytevectors.test ("bytevector-slice"): New tests.
* doc/ref/api-data.texi (Bytevector Slices): New node.

8 files changed, 208 insertions, 5 deletions

diff --git a/NEWS b/NEWS
index 121ad0b8e..7789d5929 100644
--- a/NEWS
+++ b/NEWS
@@ -65,6 +65,13 @@ IPv6 support; they can be used with `bind'.
 Likewise, the `IPPROTO_IPV6' and `IPV6_V6ONLY' constants are defined,
 for use with `setsockopt'.
 
+** New `bytevector-slice' procedure
+
+As an extension to the R6RS interface, the new (rnrs bytevectors gnu)
+module defines `bytevector-slice', which returns a bytevector that
+aliases part of an existing bytevector.  See "Bytevector Slices" in the
+manual.
+
 ** Disassembler now shows intrinsic names
 
 Disassembler output now includes the name of intrinsics next to each
diff --git a/am/bootstrap.am b/am/bootstrap.am
index 0257d53dc..53ee68315 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -249,6 +249,7 @@ SOURCES =					\
   rnrs/arithmetic/fixnums.scm			\
   rnrs/arithmetic/flonums.scm			\
   rnrs/bytevectors.scm				\
+  rnrs/bytevectors/gnu.scm			\
   rnrs/io/simple.scm				\
   rnrs/io/ports.scm				\
   rnrs/records/inspection.scm			\
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 30190f315..d332aa997 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000-2004, 2006-2017, 2019-2020, 2022
+@c Copyright (C)  1996, 1997, 2000-2004, 2006-2017, 2019-2020, 2022-2023
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -6673,6 +6673,7 @@ Bytevectors can be used with the binary input/output primitives
 * Bytevectors as Strings::      Interpreting bytes as Unicode strings.
 * Bytevectors as Arrays::       Guile extension to the bytevector API.
 * Bytevectors as Uniform Vectors::  Bytevectors and SRFI-4.
+* Bytevector Slices::           Aliases for parts of a bytevector.
 @end menu
 
 @node Bytevector Endianness
@@ -7108,6 +7109,49 @@ Bytevectors may also be accessed with the SRFI-4 API. @xref{SRFI-4 and
 Bytevectors}, for more information.
 
 
+@node Bytevector Slices
+@subsubsection Bytevector Slices
+
+@cindex subset, of a bytevector
+@cindex slice, of a bytevector
+@cindex slice, of a uniform vector
+As an extension to the R6RS specification, the @code{(rnrs bytevectors
+gnu)} module provides the @code{bytevector-slice} procedure, which
+returns a bytevector aliasing part of an existing bytevector.
+
+@deffn {Scheme Procedure} bytevector-slice @var{bv} @var{offset} [@var{size}]
+@deffnx {C Function} scm_bytevector_slice (@var{bv}, @var{offset}, @var{size})
+Return the slice of @var{bv} starting at @var{offset} and counting
+@var{size} bytes.  When @var{size} is omitted, the slice covers all
+of @var{bv} starting from @var{offset}.  The returned slice shares
+storage with @var{bv}: changes to the slice are visible in @var{bv}
+and vice-versa.
+
+When @var{bv} is actually a SRFI-4 uniform vector, its element
+type is preserved unless @var{offset} and @var{size} are not aligned
+on its element type size.
+@end deffn
+
+Here is an example showing how to use it:
+
+@lisp
+(use-modules (rnrs bytevectors)
+             (rnrs bytevectors gnu))
+
+(define bv (u8-list->bytevector (iota 10)))
+(define slice (bytevector-slice bv 2 3))
+
+slice
+@result{} #vu8(2 3 4)
+
+(bytevector-u8-set! slice 0 77)
+slice
+@result{} #vu8(77 3 4)
+
+bv
+@result{} #vu8(0 1 77 3 4 5 6 7 8 9)
+@end lisp
+
 @node Arrays
 @subsection Arrays
 @tpindex Arrays
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index 6a81a0893..8414c3e2d 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -13,7 +13,7 @@
 @copying
 This manual documents Guile version @value{VERSION}.
 
-Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software Foundation,
+Copyright (C) 1996-1997, 2000-2005, 2009-2023 Free Software Foundation,
 Inc. @*
 Copyright (C) 2021 Maxime Devos
 
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index bbc23f449..6d9f6476d 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -1,4 +1,4 @@
-/* Copyright 2009-2015,2018-2019
+/* Copyright 2009-2015,2018-2019,2023
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -24,6 +24,7 @@
 
 #include <limits.h>
 #include <byteswap.h>
+#include <intprops.h>
 #include <errno.h>
 #include <striconveh.h>
 #include <uniconv.h>
@@ -325,6 +326,66 @@ scm_c_take_typed_bytevector (signed char *contents, size_t len,
   return ret;
 }
 
+SCM_DEFINE (scm_bytevector_slice, "bytevector-slice", 2, 1, 0,
+            (SCM bv, SCM offset, SCM size),
+            "Return the slice of @var{bv} starting at @var{offset} and counting\n"
+            "@var{size} bytes.  When @var{size} is omitted, the slice covers all\n"
+            "of @var{bv} starting from @var{offset}.  The returned slice shares\n"
+            "storage with @var{bv}: changes to the slice are visible in @var{bv}\n"
+            "and vice-versa.\n"
+            "\n"
+            "When @var{bv} is actually a SRFI-4 uniform vector, its element\n"
+            "type is preserved unless @var{offset} and @var{size} are not aligned\n"
+            "on its element type size.\n")
+#define FUNC_NAME s_scm_bytevector_slice
+{
+  SCM ret;
+  size_t c_offset, c_size;
+  scm_t_array_element_type element_type;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bv);
+
+  c_offset = scm_to_size_t (offset);
+
+  if (SCM_UNBNDP (size))
+    {
+      if (c_offset < SCM_BYTEVECTOR_LENGTH (bv))
+        c_size = SCM_BYTEVECTOR_LENGTH (bv) - c_offset;
+      else
+        c_size = 0;
+    }
+  else
+    c_size = scm_to_size_t (size);
+
+  if (INT_ADD_OVERFLOW (c_offset, c_size)
+      || (c_offset + c_size > SCM_BYTEVECTOR_LENGTH (bv)))
+    scm_out_of_range (FUNC_NAME, offset);
+
+  /* Preserve the element type of BV, unless we're not slicing on type
+     boundaries.  */
+  element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (bv);
+  if ((c_offset % SCM_BYTEVECTOR_TYPE_SIZE (bv) != 0)
+      || (c_size % SCM_BYTEVECTOR_TYPE_SIZE (bv) != 0))
+    element_type = SCM_ARRAY_ELEMENT_TYPE_VU8;
+  else
+    c_size /= (scm_i_array_element_type_sizes[element_type] / 8);
+
+  ret = make_bytevector_from_buffer (c_size,
+                                     SCM_BYTEVECTOR_CONTENTS (bv) + c_offset,
+                                     element_type);
+  if (!SCM_MUTABLE_BYTEVECTOR_P (bv))
+    {
+      /* Preserve the immutability property.  */
+      scm_t_bits flags = SCM_BYTEVECTOR_FLAGS (ret);
+      SCM_SET_BYTEVECTOR_FLAGS (ret, flags | SCM_F_BYTEVECTOR_IMMUTABLE);
+    }
+
+  SCM_BYTEVECTOR_SET_PARENT (ret, bv);
+
+  return ret;
+}
+#undef FUNC_NAME
+
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
    size) and return the new bytevector (possibly different from BV).  */
 SCM
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index 980d6e267..593c94859 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -1,7 +1,7 @@
 #ifndef SCM_BYTEVECTORS_H
 #define SCM_BYTEVECTORS_H
 
-/* Copyright 2009,2011,2018
+/* Copyright 2009, 2011, 2018, 2023
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -52,6 +52,7 @@ SCM_API uint8_t scm_c_bytevector_ref (SCM, size_t);
 SCM_API void scm_c_bytevector_set_x (SCM, size_t, uint8_t);
 
 SCM_API SCM scm_make_bytevector (SCM, SCM);
+SCM_API SCM scm_bytevector_slice (SCM, SCM, SCM);
 SCM_API SCM scm_native_endianness (void);
 SCM_API SCM scm_bytevector_p (SCM);
 SCM_API SCM scm_bytevector_length (SCM);
diff --git a/module/rnrs/bytevectors/gnu.scm b/module/rnrs/bytevectors/gnu.scm
new file mode 100644
index 000000000..3258dfd17
--- /dev/null
+++ b/module/rnrs/bytevectors/gnu.scm
@@ -0,0 +1,24 @@
+;;;; gnu.scm --- GNU extensions to the bytevector API.
+
+;;;;	Copyright (C) 2023 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (rnrs bytevectors gnu)
+  #:version (6)
+  #:export (bytevector-slice))
+
+(define bytevector-slice
+  (@@ (rnrs bytevectors) bytevector-slice))
diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test
index 732aadb3e..504910202 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -1,6 +1,6 @@
 ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;; Copyright (C) 2009-2015, 2018, 2021 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2015, 2018, 2021, 2023 Free Software Foundation, Inc.
 ;;;;
 ;;;; Ludovic Courtès
 ;;;;
@@ -22,6 +22,8 @@
   #:use-module (test-suite lib)
   #:use-module (system base compile)
   #:use-module (rnrs bytevectors)
+  #:use-module (rnrs bytevectors gnu)
+  #:use-module ((system foreign) #:select (sizeof size_t))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-4))
 
@@ -667,6 +669,69 @@
     (with-input-from-string "#vu8(0 256)" read)))
 
 
+(with-test-prefix "bytevector-slice"
+
+  (pass-if-exception "wrong size"
+      exception:out-of-range
+    (let ((b #vu8(1 2 3)))
+      (bytevector-slice b 1 3)))
+
+  (pass-if-equal "slices"
+      (list #vu8(1 2) #vu8(2 3)
+            #vu8(1)   #vu8(2) #vu8(3))
+    (let ((b #vu8(1 2 3)))
+      (list (bytevector-slice b 0 2)
+            (bytevector-slice b 1)
+            (bytevector-slice b 0 1)
+            (bytevector-slice b 1 1)
+            (bytevector-slice b 2))))
+
+  (pass-if-exception "immutable flag preserved"
+      exception:wrong-type-arg
+    (compile '(begin
+                (use-modules (rnrs bytevectors)
+                             (rnrs bytevectors gnu))
+
+                ;; The literal bytevector below is immutable.
+                (let ((bv #vu8(1 2 3)))
+                  (bytevector-u8-set! (bytevector-slice bv 1) 0 0)))
+
+             ;; Disable optimizations to invoke the full-blown
+             ;; 'scm_bytevector_u8_set_x' procedure, which checks for
+             ;; the SCM_F_BYTEVECTOR_IMMUTABLE flag.
+             #:optimization-level 0
+             #:to 'value))
+
+  (pass-if-exception "size + offset overflows"
+      exception:out-of-range
+    (let ((size_t-max (expt 2 (* 8 (sizeof size_t)))))
+      ;; Without overflow checks, this would read arbitrary memory.
+      (bytevector-slice #vu8(1 2 3) (- size_t-max 10) 10)))
+
+  (pass-if-equal "slice of f32vector"
+      '(8 2)
+    (let* ((v #f32(1.1 1.2 3.14))
+           (s (bytevector-slice v 4)))
+      (and (= (f32vector-ref s 0)
+              (f32vector-ref v 1))
+           (list (bytevector-length s)
+                 (f32vector-length s)))))
+
+  (pass-if-equal "unaligned offset for f32vector"
+      10
+    (let* ((v #f32(1.1 1.2 3.14))
+           (s (bytevector-slice v 2)))
+      (and (not (f32vector? s))
+           (bytevector-length s))))
+
+  (pass-if-equal "unaligned size for f32vector"
+      1
+    (let* ((v #f32(1.1 1.2 3.14))
+           (s (bytevector-slice v 0 1)))
+      (and (not (f32vector? s))
+           (bytevector-length s)))))
+
+
 (with-test-prefix "Arrays"
 
   (pass-if "array?"