fill-buf-adjust: new function.

* stream.c (fill_buf_adjust): New function.
(stream_init): Register fill-buf-adjust intrinsic.

* stream.h (fill_buf_adjust): Declared.

* txr.1: Documented.

3 files changed, 34 insertions, 1 deletions

diff --git a/stream.c b/stream.c
index 53e76afb..e32334eb 100644
--- a/stream.c
+++ b/stream.c
@@ -2889,6 +2889,20 @@ val fill_buf(val buf, val pos_in, val stream_in)
   return ops->fill_buf(stream, buf, pos);
 }
 
+val fill_buf_adjust(val buf, val pos_in, val stream_in)
+{
+  val self = lit("fill-buf-adjust");
+  val stream = default_arg(stream_in, std_input);
+  cnum pos = c_num(default_arg(pos_in, zero));
+  val readpos;
+  struct strm_ops *ops = coerce(struct strm_ops *,
+                                cobj_ops(self, stream, stream_s));
+  buf_set_length(buf, buf_alloc_size(buf), zero);
+  readpos = ops->fill_buf(stream, buf, pos);
+  buf_set_length(buf, readpos, zero);
+  return readpos;
+}
+
 struct fmt {
   size_t minsize;
   const char *dec;
@@ -4624,6 +4638,7 @@ void stream_init(void)
   reg_fun(unget_byte_s, func_n2o(unget_byte, 1));
   reg_fun(put_buf_s, func_n3o(put_buf, 1));
   reg_fun(fill_buf_s, func_n3o(fill_buf, 1));
+  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));
   reg_fun(intern(lit("truncate-stream"), user_package), func_n2o(truncate_stream, 1));
diff --git a/stream.h b/stream.h
index 449bf90e..37ab89a9 100644
--- a/stream.h
+++ b/stream.h
@@ -188,6 +188,7 @@ val unget_char(val ch, val stream);
 val unget_byte(val byte, val stream);
 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 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 5207606d..41d1568f 100644
--- a/txr.1
+++ b/txr.1
@@ -58014,9 +58014,10 @@ the length of the buffer.
 If an error occurs before any bytes are written, the function
 throws an error.
 
-.coNP Function @ fill-buf
+.coNP Functions @ fill-buf and @ fill-buf-adjust
 .synb
 .mets (fill-buf < buf >> [ pos <> [ stream ]])
+.mets (fill-buf-adjust < buf >> [ pos <> [ stream ]])
 .syne
 .desc
 The
@@ -58065,6 +58066,22 @@ any bytes are read, then an exception is thrown.
 If an end-of-file condition occurs before any bytes are read, then zero
 is returned.
 
+The
+.code fill-buf-adjust
+differs usefully from
+.code fill-buf
+as follows. Whereas
+.code fill-buf
+doesn't manipulate the length of the buffer at any stage of the operation, the
+.code fill-buf-adjust
+begins by adjusting the length of the buffer to the underlying allocated size.
+Then it performs the fill operation in
+exactly the same manner as
+.codn fill-buf .
+Finally, if the operation succeeds, then
+.code fill-buf-adjust
+adjusts the length of the buffer to match the position that is returned.
+
 .SS* Buffer streams
 A stream type exists which allows
 .code buf