From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Add 'bytevector-slice'. Date: Wed, 11 Jan 2023 16:00:15 +0100 Message-ID: <20230111150015.10219-1-ludo@gnu.org> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="39387"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Andy Wingo , =?UTF-8?q?Ludovic=20Court=C3=A8s?= To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Wed Jan 11 16:01:12 2023 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pFcbI-000A56-8d for guile-devel@m.gmane-mx.org; Wed, 11 Jan 2023 16:01:12 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pFcal-0008RB-7G; Wed, 11 Jan 2023 10:00:40 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pFcaZ-0008Qj-Vh for guile-devel@gnu.org; Wed, 11 Jan 2023 10:00:28 -0500 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pFcaY-0006mN-CC; Wed, 11 Jan 2023 10:00:26 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=3Vg2E2nV3JrAmaVklPY7w0rdmKydRaEsv+dE22l+Vt0=; b=eJw+zUnsiqW8iG PGaUNvgCOu75c6gKgD82yP8JZHjM3EmGCS7zeSiKjs4jB4l9huy2ttuN7QZtKGzv5GyYP2k61EDzo yB4nIOL8TX3R8smLc0wcqH1GIrUQHmnrRwxlegw3Jc5hmZ5FIhO/FmC0LaV9fLDsXbso8Ewtf5wlQ wePaKxwbZ0jWAqWKcKBj1dViAz898emoHAFIdRQYcTnPsFPDHI1JgpfUROBNtQy4TRi0AdM2BtHfK XlV8Yf3QjqEdH13M1T/MpZIigOpfwnzgaToA6TV1A37hLtqkXxd9N7nY7T4MSRTsEjhm6kxdIk4OE o7L3wddhMx5cji0OmMiQ==; Original-Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pFcaV-0003wL-TO; Wed, 11 Jan 2023 10:00:26 -0500 X-Mailer: git-send-email 2.38.1 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.devel:21557 Archived-At: * 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. --- am/bootstrap.am | 1 + doc/ref/api-data.texi | 46 ++++++++++++++++++++- doc/ref/guile.texi | 2 +- libguile/bytevectors.c | 69 ++++++++++++++++++++++++++++++- libguile/bytevectors.h | 3 +- module/rnrs/bytevectors/gnu.scm | 24 +++++++++++ test-suite/tests/bytevectors.test | 53 +++++++++++++++++++++++- 7 files changed, 193 insertions(+), 5 deletions(-) create mode 100644 module/rnrs/bytevectors/gnu.scm Hello! This is an updated version of the ‘bytevector-slice’ primitive I used in the linker/assembler patch series¹ that I think is ready to go. I went to some length to do something sensible wrt. element type of the input, when the input is a SRFI-4 uniform vector. The other option would be to make the output a pure bytevector unconditionally, but I thought it would be more consistent and useful to preserve the input element type when possible (see tests with an f32vector). If there are no objections, I’ll push it to ‘main’ in the coming days. Thanks, Ludo’. ¹ https://lists.gnu.org/archive/html/guile-devel/2023-01/msg00013.html 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 8658b9785..fe2d2af50 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..6b920c88a 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -1,4 +1,4 @@ -/* Copyright 2009-2015,2018-2019 +/* Copyright 2009-2015,2018-2019,2022-2023 Free Software Foundation, Inc. This file is part of Guile. @@ -325,6 +325,73 @@ 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); + + /* FIXME: Until 3.0.8 included, the assembler would not set the + SCM_F_BYTEVECTOR_CONTIGUOUS flag on literals. Thus, ignore it and + assume BV is contiguous (how could it not be anyway?). */ +#if 0 + if (!SCM_BYTEVECTOR_CONTIGUOUS_P (bv)) + scm_wrong_type_arg_msg (FUNC_NAME, 0, bv, "contiguous bytevector"); +#endif + + 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 (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..6179bfd86 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,2022 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..ce97535a8 --- /dev/null +++ b/module/rnrs/bytevectors/gnu.scm @@ -0,0 +1,24 @@ +;;;; gnu.scm --- GNU extensions to the bytevector API. + +;;;; Copyright (C) 2022 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..dc4b32370 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,7 @@ #:use-module (test-suite lib) #:use-module (system base compile) #:use-module (rnrs bytevectors) + #:use-module (rnrs bytevectors gnu) #:use-module (srfi srfi-1) #:use-module (srfi srfi-4)) @@ -666,6 +667,56 @@ exception:out-of-range (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-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 slice of f32vector" + 10 + (let* ((v #f32(1.1 1.2 3.14)) + (s (bytevector-slice v 2))) + (and (not (f32vector? s)) + (bytevector-length s))))) + (with-test-prefix "Arrays" -- 2.38.1