streams: new get-buf function.

* stream.c (get_buf) New function.
(stream_init): Register get-buf intrinsic.

* stream.h (get_buf): Declared.

* stdlib/getput.tl (sys:get-buf-common): Function removed.
(file-get-buf, command-get-buf, map-command-buf,
map-process-buf): Use get-buf instead of sys:get-buf-common.

* txr.1: Documented.

4 files changed, 94 insertions, 26 deletions

diff --git a/stdlib/getput.tl b/stdlib/getput.tl
index 77cf1aff..9609b47e 100644
--- a/stdlib/getput.tl
+++ b/stdlib/getput.tl
@@ -25,28 +25,6 @@
 ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 ;; POSSIBILITY OF SUCH DAMAGE.
 
-(defun sys:get-buf-common (s bytes seek)
-  (let ((b (make-buf 0 0 (min bytes 4096)))
-        (o 0))
-    (when (plusp seek)
-      (unless (ignerr (seek-stream s seek :from-current))
-        (let* ((b (make-buf (min seek 4096))))
-          (while (plusp seek)
-            (if (< seek 4096)
-              (buf-set-length b seek))
-            (let ((p (fill-buf b 0 s)))
-              (if (zerop p)
-                (return))
-              (dec seek p))))))
-    (while (or (null bytes) (< (len b) bytes))
-      (let ((p (fill-buf-adjust b o s)))
-        (when (= p o)
-          (return))
-        (set o p)
-        (when (eql p (buf-alloc-size b))
-          (buf-set-length b (min (+ p p) bytes)))))
-    b))
-
 (defun sys:maproc-common (cmd-lambda put-expr get-expr)
   (tree-bind (pipe-rd . pipe-wr) (pipe)
     (with-stream (cmd-stdout (open-fileno pipe-wr "w"))
@@ -133,7 +111,7 @@
 
 (defun file-get-buf (name : bytes (seek 0) mopt)
   (with-stream (s (open-file name `rb@(if bytes "u")@mopt`))
-    (sys:get-buf-common s bytes seek)))
+    (get-buf s bytes seek)))
 
 (defun file-put-buf (name buf : (seek 0) mopt)
   (with-stream (s (open-file name `wb@mopt`))
@@ -200,7 +178,7 @@
 
 (defun command-get-buf (cmd : bytes (skip 0))
   (with-stream (s (open-command cmd (if bytes "rbu" "rb")))
-    (sys:get-buf-common s bytes skip)))
+    (get-buf s bytes skip)))
 
 (defun command-put-buf (cmd buf : mopt)
   (with-stream (s (open-command cmd `wb@mopt`))
@@ -245,12 +223,12 @@
 (defun map-command-buf (command buf : (pos 0) bytes (skip 0) mopt)
   (sys:maproc-common (lambda () (open-command command `w@mopt`))
                      (lambda (strm) (put-buf buf pos strm))
-                     (lambda (strm) (sys:get-buf-common strm bytes skip))))
+                     (lambda (strm) (get-buf strm bytes skip))))
 
 (defun map-process-buf (program args buf : (pos 0) bytes (skip 0) mopt)
   (sys:maproc-common (lambda () (open-process program `w@mopt` args))
                      (lambda (strm) (put-buf buf pos strm))
-                     (lambda (strm) (sys:get-buf-common strm bytes skip))))
+                     (lambda (strm) (get-buf strm bytes skip))))
 
 (defmacro close-lazy-streams (. body)
   ^(let ((sys:*lazy-streams*))
diff --git a/stream.c b/stream.c
index 5dbc0a2e..da72ce52 100644
--- a/stream.c
+++ b/stream.c
@@ -3507,6 +3507,57 @@ val get_line_as_buf(val stream_in)
   return buf;
 }
 
+val get_buf(val stream_in, val bytes_in, val seek_in)
+{
+  val self = lit("get-buf");
+  val stream = default_arg_strict(stream_in, std_input);
+  struct strm_ops *ops = coerce(struct strm_ops *,
+                                cobj_ops(self, stream, stream_cls));
+  ucnum bytes = if3(null_or_missing_p(bytes_in),
+                    UINT_PTR_MAX, c_unum(bytes_in, self));
+  ucnum seek = if3(null_or_missing_p(seek_in), 0, c_unum(seek_in, self));
+  val buf = make_buf_fast(0, 0, min(bytes, BUFSIZ));
+  val offs = zero;
+
+  bytes = min(UINT_PTR_MAX - 1, bytes);
+
+  if (seek > 0) {
+    if (ops->seek != unimpl_seek) {
+      ops->seek(stream, unum(seek), strm_cur);
+    } else {
+#if CONFIG_SMALL_MEM
+      unsigned char discard[256];
+#else
+      unsigned char discard[4096];
+#endif
+      while (seek > 0) {
+        ucnum readsz = min(sizeof discard, seek);
+        ucnum nread = ops->fill_buf(stream, discard, readsz, 0);
+        if (nread == 0)
+          seek = 0;
+        else
+          seek -= nread;
+      }
+    }
+  }
+
+  while (buf->b.len < bytes) {
+    val rpos = fill_buf_adjust(buf, offs, stream);
+    if (eql(offs, rpos))
+      break;
+    offs = rpos;
+    if (eql(rpos, unum(buf->b.size))) {
+      size_t nsize = buf->b.size + buf->b.size / 2;
+      if (nsize < buf->b.size)
+        nsize = UINT_PTR_MAX;
+      nsize = min(nsize, bytes);
+      buf_set_length(buf, unum(nsize), zero);
+    }
+  }
+
+  return buf;
+}
+
 struct fmt {
   const char *type;
   const char *dec;
@@ -6071,6 +6122,7 @@ void stream_init(void)
   reg_fun(put_buf_s, func_n3o(put_buf, 1));
   reg_fun(fill_buf_s, func_n3o(fill_buf, 1));
   reg_fun(intern(lit("get-line-as-buf"), user_package), func_n1o(get_line_as_buf, 0));
+  reg_fun(intern(lit("get-buf"), user_package), func_n3o(get_buf, 0));
   reg_fun(intern(lit("fill-buf-adjust"), user_package), func_n3o(fill_buf_adjust, 1));
   reg_fun(intern(lit("flush-stream"), user_package), func_n1o(flush_stream, 0));
   reg_fun(intern(lit("seek-stream"), user_package), func_n3(seek_stream));
diff --git a/stream.h b/stream.h
index d8cb61f1..677ec270 100644
--- a/stream.h
+++ b/stream.h
@@ -247,6 +247,7 @@ val put_buf(val buf, val pos, val stream);
 val fill_buf(val buf, val pos, val stream);
 val fill_buf_adjust(val buf, val pos, val stream);
 val get_line_as_buf(val stream);
+val get_buf(val stream_in, val bytes_in, val seek_in);
 val vformat(val stream, val string, va_list);
 val vformat_to_string(val string, va_list);
 val format(val stream, val string, ...);
diff --git a/txr.1 b/txr.1
index 9bb54f1f..1878f628 100644
--- a/txr.1
+++ b/txr.1
@@ -30047,6 +30047,43 @@ is omitted, it defaults to
 
 The stream is required to support byte input.
 
+.coNP Function @ get-buf
+.synb
+.mets (get-buf >> [ stream >> [ bytes <> [ skip ]]])
+.syne
+.desc
+The
+.code get-buf
+function reads bytes from a
+.metn stream ,
+returning them as a new buffer object.
+
+If
+.meta stream
+is omitted, it defaults to
+.codn *stdin* .
+
+If
+.meta bytes
+is specified, it indicates the maximum number of bytes to read.
+The returned buffer shall have a length no greater than
+.metn bytes ,
+but may have a greater allocation size. If
+.meta bytes
+is unspecified, then as many bytes as possible are read from
+the stream, returned in a buffer as large a possible.
+
+If
+.meta skip
+is specified, the operation will first skip that many
+bytes from the current position in the stream. If the stream
+supports the
+.code seek-stream
+operation, then that operation is used to perform the skip, otherwise
+.meta skip
+bytes are read from the stream and discarded.
+
+
 .coNP Functions @ file-get-buf and @ command-get-buf
 .synb
 .mets (file-get-buf < name >> [ max-bytes