From 14dec723707ee766642397962fa93124d9c86811 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 16 Apr 2019 23:14:27 -0400
Subject: [PATCH 1/4] DRAFT: Add get-bytevector-some!.

---
 libguile/r6rs-ports.c         | 37 +++++++++++++++++++++++++++++++++++
 libguile/r6rs-ports.h         |  5 ++++-
 module/ice-9/binary-ports.scm |  1 +
 3 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index c1cbbdf30..9b64696a6 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -502,6 +502,43 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_get_bytevector_some_x, "get-bytevector-some!", 4, 0, 0,
+	    (SCM port, SCM bv, SCM start, SCM count),
+            "Read up to @var{count} bytes from @var{port}, blocking "
+            "as necessary until at least one byte is available or an "
+            "end-of-file is reached.  Store them in @var{bv} starting "
+            "at index @var{start}.  Return the number of bytes actually "
+            "read, or 0 if an end-of-file was reached.")
+#define FUNC_NAME s_scm_get_bytevector_some_x
+{
+  SCM buf;
+  size_t c_start, c_count, c_len;
+  size_t cur, avail, transfer_size;
+
+  SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  SCM_VALIDATE_BYTEVECTOR (2, bv);
+  c_start = scm_to_size_t (start);
+  c_count = scm_to_size_t (count);
+  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+
+  if (SCM_UNLIKELY (c_start + c_count > c_len ||
+                    c_count == 0))
+    scm_out_of_range (FUNC_NAME, count);
+
+  buf = scm_fill_input (port, 0, &cur, &avail);
+  transfer_size = min (avail, c_count);
+
+  if (transfer_size == 0)
+    scm_port_buffer_set_has_eof_p (buf, SCM_BOOL_F);
+  else
+    scm_port_buffer_take
+      (buf, ((scm_t_uint8 *) SCM_BYTEVECTOR_CONTENTS (bv)) + c_start,
+       transfer_size, cur, avail);
+  
+  return scm_from_size_t (transfer_size);
+}
+#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 "
diff --git a/libguile/r6rs-ports.h b/libguile/r6rs-ports.h
index a2c63c7f4..7dfa382ef 100644
--- a/libguile/r6rs-ports.h
+++ b/libguile/r6rs-ports.h
@@ -1,7 +1,7 @@
 #ifndef SCM_R6RS_PORTS_H
 #define SCM_R6RS_PORTS_H
 
-/* Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2009-2011, 2013, 2019 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
@@ -46,4 +46,7 @@ SCM_API SCM scm_get_string_n_x (SCM, SCM, SCM, SCM);
 SCM_API void scm_init_r6rs_ports (void);
 SCM_INTERNAL void scm_register_r6rs_ports (void);
 
+/* Guile extensions, not in R6RS.  */
+SCM_API SCM scm_get_bytevector_some_x (SCM, SCM, SCM, SCM);
+
 #endif /* SCM_R6RS_PORTS_H */
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index e0da3df1a..62fd9786f 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -36,6 +36,7 @@
             get-bytevector-n
             get-bytevector-n!
             get-bytevector-some
+            get-bytevector-some!  ; Guile extension, not in R6RS
             get-bytevector-all
             get-string-n!
             put-u8
-- 
2.21.0