[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Add 'bytevector-slice'.
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] 02/02: Add 'bytevector-slice'. |
|
Date: |
Sat, 14 Jan 2023 10:14:57 -0500 (EST) |
civodul pushed a commit to branch main
in repository guile.
commit e441c34f1666921f6b15597c1aa3a50596a129d7
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jan 6 17:46:06 2023 +0100
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.
---
NEWS | 7 ++++
am/bootstrap.am | 1 +
doc/ref/api-data.texi | 46 ++++++++++++++++++++++++++-
doc/ref/guile.texi | 2 +-
libguile/bytevectors.c | 63 +++++++++++++++++++++++++++++++++++-
libguile/bytevectors.h | 3 +-
module/rnrs/bytevectors/gnu.scm | 24 ++++++++++++++
test-suite/tests/bytevectors.test | 67 ++++++++++++++++++++++++++++++++++++++-
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?"