buffers: improve put-buf and fill-buf.

* stream.h (struct strm_ops): put_buf and fill_buf function
pointers get third argument to indicate starting position
of read and write.
(put_buf, fill_buf): Declarations updated.

* stream.c (unimpl_put_buf, unimpl_fill_buf): Third argument
added.
(generic_put_buf, generic_fill_buf, stdio_put_buf,
stdio_fill_buf): Implement position
argument.
(delegate_put_buf, delegate_fill_buf): Take third argument,
pass it down.
(put_buf, fill_buf): New position argument in second position.
Defaulted to zero. Passed down.
(stream_init): Updated registration of put-buf and fill-buf.

* txr.1: Updated documentation.

3 files changed, 91 insertions, 52 deletions

diff --git a/stream.c b/stream.c
index 0b2e607a..a4560f05 100644
--- a/stream.c
+++ b/stream.c
@@ -179,12 +179,12 @@ static noreturn val unimpl_unget_byte(val stream, int byte)
   unimpl(stream, lit("unget-byte"));
 }
 
-static noreturn val unimpl_put_buf(val stream, val buf)
+static noreturn val unimpl_put_buf(val stream, val buf, cnum pos)
 {
   unimpl(stream, lit("put-buf"));
 }
 
-static noreturn val unimpl_fill_buf(val stream, val buf)
+static noreturn val unimpl_fill_buf(val stream, val buf, cnum pos)
 {
   unimpl(stream, lit("fill-buf"));
 }
@@ -304,33 +304,42 @@ static val null_get_fd(val stream)
   return nil;
 }
 
-static val generic_put_buf(val stream, val buf)
+static val generic_put_buf(val stream, val buf, cnum pos)
 {
   val self = lit("put-buf");
   struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops);
   cnum len = c_num(length_buf(buf)), i;
   mem_t *ptr = buf_get(buf, self);
 
-  for (i = 0; i < len; i++)
+  if (pos >= len)
+    return num(len);
+
+  for (i = pos; i < len; i++)
     ops->put_byte(stream, *ptr++);
 
-  return t;
+  if (i > len)
+    i = len;
+
+  return num(i);
 }
 
-static val generic_fill_buf(val stream, val buf)
+static val generic_fill_buf(val stream, val buf, cnum pos)
 {
   val self = lit("fill-buf");
   struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops);
   cnum len = c_num(length_buf(buf)), i;
   mem_t *ptr = buf_get(buf, self);
 
-  for (i = 0; i < len; i++) {
+  for (i = pos; i < len; i++) {
     val byte = ops->get_byte(stream);
     if (!byte)
       break;
     *ptr++ = c_num(byte);
   }
 
+  if (i > len)
+    i = len;
+
   return num(i);
 }
 
@@ -845,7 +854,7 @@ static val stdio_unget_byte(val stream, int byte)
          : stdio_maybe_error(stream, lit("writing"));
 }
 
-static val stdio_put_buf(val stream, val buf)
+static val stdio_put_buf(val stream, val buf, cnum pos)
 {
   val self = lit("put-buf");
   ucnum len = c_unum(length_buf(buf));
@@ -853,26 +862,36 @@ static val stdio_put_buf(val stream, val buf)
   struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle);
   if ((size_t) len != len)
     uw_throwf(error_s, lit("~a: buffer too large"), self, nao);
+  if (pos >= len)
+    return num(len);
   errno = 0;
-  return h->f != 0 && fwrite(ptr, 1, len, h->f) == len
-         ? t : stdio_maybe_error(stream, lit("writing"));
+  if (h->f != 0) {
+    cnum nwrit = fwrite(ptr + pos, 1, len - pos, h->f);
+    if (nwrit > 0)
+      return num(pos + nwrit);
+  }
+  stdio_maybe_error(stream, lit("writing"));
+  return zero;
 }
 
-static val stdio_fill_buf(val stream, val buf)
+static val stdio_fill_buf(val stream, val buf, cnum pos)
 {
   val self = lit("fill-buf");
   ucnum len = c_unum(length_buf(buf));
   mem_t *ptr = buf_get(buf, self);
   struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle);
-  size_t nread = 0;
   if ((size_t) len != len)
     uw_throwf(error_s, lit("~a: buffer too large"), self, nao);
+  if (pos >= len)
+    return num(len);
   errno = 0;
-  if (h->f != 0)
-    nread = fread(ptr, 1, len, h->f);
-  if (nread == len || nread < len || feof(h->f))
-    return unum(len);
-  return stdio_maybe_read_error(stream);
+  if (h->f != 0) {
+    cnum nread = fread(ptr + pos, 1, len - pos, h->f);
+    if (nread > 0)
+      return unum(pos + nread);
+  }
+  stdio_maybe_read_error(stream);
+  return zero;
 }
 
 static val stdio_close(val stream, val throw_on_error)
@@ -2518,16 +2537,16 @@ static val delegate_unget_byte(val stream, int byte)
   return s->target_ops->unget_byte(s->target_stream, byte);
 }
 
-static val delegate_put_buf(val stream, val buf)
+static val delegate_put_buf(val stream, val buf, cnum pos)
 {
   struct delegate_base *s = coerce(struct delegate_base *, stream->co.handle);
-  return s->target_ops->put_buf(s->target_stream, buf);
+  return s->target_ops->put_buf(s->target_stream, buf, pos);
 }
 
-static val delegate_fill_buf(val stream, val buf)
+static val delegate_fill_buf(val stream, val buf, cnum pos)
 {
   struct delegate_base *s = coerce(struct delegate_base *, stream->co.handle);
-  return s->target_ops->fill_buf(s->target_stream, buf);
+  return s->target_ops->fill_buf(s->target_stream, buf, pos);
 }
 
 static val delegate_close(val stream, val throw_on_error)
@@ -2787,18 +2806,20 @@ val unget_byte(val byte, val stream_in)
   return ops->unget_byte(stream, b);
 }
 
-val put_buf(val buf, val stream_in)
+val put_buf(val buf, val pos_in, val stream_in)
 {
   val stream = default_arg(stream_in, std_output);
+  cnum pos = c_num(default_arg(pos_in, zero));
   struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s));
-  return ops->put_buf(stream, buf);
+  return ops->put_buf(stream, buf, pos);
 }
 
-val fill_buf(val buf, val stream_in)
+val fill_buf(val buf, val pos_in, val stream_in)
 {
   val stream = default_arg(stream_in, std_input);
+  cnum pos = c_num(default_arg(pos_in, zero));
   struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s));
-  return ops->fill_buf(stream, buf);
+  return ops->fill_buf(stream, buf, pos);
 }
 
 struct fmt {
@@ -4426,8 +4447,8 @@ void stream_init(void)
   reg_fun(intern(lit("put-strings"), user_package), func_n2o(put_strings, 1));
   reg_fun(intern(lit("unget-char"), user_package), func_n2o(unget_char, 1));
   reg_fun(intern(lit("unget-byte"), user_package), func_n2o(unget_byte, 1));
-  reg_fun(intern(lit("put-buf"), user_package), func_n2o(put_buf, 1));
-  reg_fun(intern(lit("fill-buf"), user_package), func_n2o(fill_buf, 1));
+  reg_fun(intern(lit("put-buf"), user_package), func_n3o(put_buf, 1));
+  reg_fun(intern(lit("fill-buf"), user_package), func_n3o(fill_buf, 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_n2(truncate_stream));
diff --git a/stream.h b/stream.h
index 2a324ad3..4484d554 100644
--- a/stream.h
+++ b/stream.h
@@ -63,8 +63,8 @@ struct strm_ops {
   val (*get_byte)(val);
   val (*unget_char)(val, val);
   val (*unget_byte)(val, int);
-  val (*put_buf)(val, val);
-  val (*fill_buf)(val, val);
+  val (*put_buf)(val, val, cnum);
+  val (*fill_buf)(val, val, cnum);
   val (*close)(val, val);
   val (*flush)(val);
   val (*seek)(val, val, enum strm_whence);
@@ -180,8 +180,8 @@ val get_char(val);
 val get_byte(val);
 val unget_char(val ch, val stream);
 val unget_byte(val byte, val stream);
-val put_buf(val buf, val stream);
-val fill_buf(val buf, val stream);
+val put_buf(val buf, val pos, val stream);
+val fill_buf(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 83fb6acd..7ad8884c 100644
--- a/txr.1
+++ b/txr.1
@@ -53227,15 +53227,17 @@ returning that value as a Lisp object of type
 
 .coNP Function @ put-buf
 .synb
-.mets (put-buf < buf <> [ stream ])
+.mets (put-buf < buf >> [ pos <> [ stream ]])
 .syne
 .desc
 The
 .code put-buf
 function writes the contents of buffer
-.code buf
-to a stream. Each byte of the buffer starting with the first
-is written to the stream as if by a
+.metn buf ,
+starting at position
+.meta pos
+to a stream, through to the last byte, if possible.
+Successive bytes from the buffer are written to the stream as if by a
 .code put-byte
 operation.
 
@@ -53244,6 +53246,10 @@ If
 is omitted, it defaults to
 .codn *stdout* .
 
+If
+.meta pos
+is omitted, it defaults to zero.
+
 The stream must support the
 .code put-byte
 operation. Buffers which support
@@ -53257,31 +53263,39 @@ do not support
 
 The
 .code put-buf
-function returns
-.code t
-if the buffer is successfully written in its entirety.
-Otherwise, it throws an error.
+function returns the position of the last byte that was successfully written.
+If the buffer was written through to the end, then this value corresponds to
+the length of the buffer.
+
+If an error occurs before any bytes are written, the function
+throws an error.
 
 .coNP Function @ fill-buf
 .synb
-.mets (fill-buf < buf <> [ stream ])
+.mets (fill-buf < buf >> [ pos <> [ stream ]])
 .syne
 .desc
 The
 .code fill-buf
-function examines the length of
+reads bytes from
+.meta stream
+and writes them into consecutive locations in buffer
 .meta buf
-and attempts to read that many bytes from the stream,
-placing them into the buffer. The bytes are read as if using the
+starting at position
+.metn pos .
+The bytes are read as if using the
 .code get-byte
-function, and are placed into consecutive bytes within the buffer,
-starting at the first.
+function.
 
 If the
 .meta stream
 argument is omitted, it defaults to
 .codn *stdin* .
 
+If
+.meta pos
+is omitted, it defaults to zero.
+
 The stream must support the
 .code get-byte
 operation. Buffers which support
@@ -53294,14 +53308,18 @@ do not support
 .codn fill-buf .
 
 The
-.code put-buf
-function returns the number of bytes which were read.  If an end-of-file
-condition occurs before the buffer is filled, then the value returned is
-smaller than the buffer length. In this case, the area of the buffer beyond the
-read size retains its previous content.
+.code fill-buf
+function returns the position of the last byte that was successfully read.
+If an end-of-file or other error condition occurs before the buffer is filled
+through to the end, then the value returned is smaller than the buffer length.
+In this case, the area of the buffer beyond the read size retains its previous
+content.
 
-If an error situation occurs other than a premature end-of-file,
-an exception is thrown.
+If an error situation occurs other than a premature end-of-file before
+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.
 
 .coSS The @ cptr type