Hi Chris,
Christopher Baines <m...@cbaines.net> skribis:
> I'm looking at this since it's used in (web response)
> read-response-body.
>
> * module/ice-9/suspendable-ports.scm (get-bytevector-all): New
> procedure.
> (port-bindings): Add it.
Given that ‘get-bytevector-n!’ already has a variant in
suspendable-ports.scm, my preference would be to rewrite
‘get-bytevector-all’ in Scheme (patch attached). That way, it would
naturally be suspendable. (It’s also in line with the general strategy
of moving things to Scheme.)
I don’t expect significant performance difference compared to the C
implementation since that is dominated by allocations and I/O.
Thoughts?
Ludo’.
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 7c51bf617..ffa1e1b2b 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -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
-{
- SCM result;
- size_t c_len, c_count;
- size_t c_read, c_total;
-
- SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+static SCM get_bytevector_all_var;
- 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;
+static void
+init_bytevector_io_vars (void)
+{
+ get_bytevector_all_var =
+ scm_c_public_lookup ("ice-9 binary-port", "get-bytevector-all");
+}
- if (c_len > c_total)
- return scm_c_shrink_bytevector (result, c_total);
+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 result;
+ return scm_call_1 (scm_variable_ref (get_bytevector_all_var), port);
}
-#undef FUNC_NAME
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index b7eddc93d..864d9ef9a 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -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)))))))
