mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Rewrite ‘get-bytevector-all’ in Scheme.

Browse source 
* libguile/r6rs-ports.c (get_bytevector_all_var): New variable.
(init_bytevector_io_vars): New function.
(scm_get_bytevector_all): Rewrite as a proxy to ‘get-bytevector-all’
from (ice-9 binary-port).
* module/ice-9/binary-ports.scm (get-bytevector-all): New procedure.
* NEWS: Update.

Reported-by: Christopher Baines <mail@cbaines.net>
This commit is contained in:
Ludovic Courtès 2024-06-16 15:01:49 +02:00
parent 27feb2bfd3
commit 461ff313fa
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 51 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

7
NEWS
View file

@ -48,6 +48,13 @@ files. See "Random Access" in the manual for details.
A list of superclasses can now be provided via #:super.
** 'get-bytevector-all' is now written in Scheme and is thus suspendable
The 'get-bytevector-all' procedure from (rnrs io ports) and (ice-9
binary-port) used to be implemented in C, making it non-suspendable--a
bummer for programs using suspendable ports and Fibers. It has been
rewritten in Scheme, addressing this limitation.
* Bug fixes
** Fix incorrect comparison between exact and inexact numbers

67
libguile/r6rs-ports.c
View file

@ -1,4 +1,4 @@
/* Copyright 2009-2011,2013-2015,2018-2019,2023
/* Copyright 2009-2011,2013-2015,2018-2019,2023,2024
Free Software Foundation, Inc.
This file is part of Guile.
@ -393,58 +393,23 @@ SCM_DEFINE (scm_get_bytevector_some_x, "get-bytevector-some!", 4, 0, 0,
}
#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
static SCM get_bytevector_all_var;
static void
init_bytevector_io_vars (void)
{
SCM result;
size_t c_len, c_count;
size_t c_read, c_total;
SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
c_len = c_count = 4096;
result = scm_c_make_bytevector (c_count);
c_total = c_read = 0;
do
{
if (c_read > c_len - c_total)
{
/* Grow the bytevector. */
SCM prev = result;
if (INT_ADD_OVERFLOW (c_len, c_len))
scm_num_overflow (FUNC_NAME);
result = scm_c_make_bytevector (c_len * 2);
memcpy (SCM_BYTEVECTOR_CONTENTS (result),
SCM_BYTEVECTOR_CONTENTS (prev),
c_total);
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_bytes (port, result, c_total, c_count);
c_total += c_read, c_count -= c_read;
}
while (c_count == 0);
if (c_total == 0)
return SCM_EOF_VAL;
if (c_len > c_total)
return scm_c_shrink_bytevector (result, c_total);
return result;
get_bytevector_all_var =
scm_c_public_lookup ("ice-9 binary-port", "get-bytevector-all");
}
SCM
scm_get_bytevector_all (SCM port)
{
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, init_bytevector_io_vars);
return scm_call_1 (scm_variable_ref (get_bytevector_all_var), port);
}
#undef FUNC_NAME

29
module/ice-9/binary-ports.scm
View file

@ -1,5 +1,5 @@
;;; binary-ports.scm --- Binary IO on ports
;;; Copyright (C) 2009-2011,2013,2016,2019,2021,2023 Free Software Foundation, Inc.
;;; Copyright (C) 2009-2011,2013,2016,2019,2021,2023,2024 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
@ -27,6 +27,7 @@
(define-module (ice-9 binary-ports)
#:use-module (rnrs bytevectors)
#:autoload (rnrs bytevectors gnu) (bytevector-slice)
#:use-module (ice-9 match)
#:use-module (ice-9 custom-ports)
#:export (eof-object
@ -180,3 +181,29 @@ bytevector composed of the bytes written into the port is returned."
;; FIXME: Instead default to current encoding, if
;; someone reads text from this port.
#:encoding 'ISO-8859-1 #:conversion-strategy 'error))
;;;
;;; Binary input.
;;;
(define (get-bytevector-all 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 initial-capacity 4096)
(let loop ((bv (make-bytevector initial-capacity))
(capacity initial-capacity)
(size 0))
(match (get-bytevector-n! port bv size (- capacity size))
((? eof-object?)
(bytevector-slice bv 0 size))
(read
(let ((size (+ read size)))
(if (= capacity size)
(let* ((capacity (* capacity 2))
(new (make-bytevector capacity)))
(bytevector-copy! bv 0 new 0 size)
(loop new capacity size))
(loop bv capacity size)))))))