streams: put-buf and fill-buf functions.

* stream.h (struct strm_ops): New function pointer members,
put_buf and fill_buf.
(strm_ops_init): Two new parameters in macro.
(put_buf, fill_buf): Declared.

* stream.c (unimpl_put_buf, unimpl_fill_buf, generic_put_buf,
generic_fill_buf): New static functions.
(fill_stream_ops): Default new fill_buf and fill_buf virtual
functions intelligently based on whether get_byte and put_byte
are available.
(stdio_put_buf, stdio_fill_buf): New static functions.
(stdio_ops, tail_ops, pipe_ops, dir_ops, string_in_ops,
byte_in_ops, strlist_in_ops, string_out_ops, strlist_out_ops,
cat_stream_ops): Add arguments to strm_ops_init macro for
get_buf and fill_buf.
(delegate_put_buf, delegate_fill_buf): New  static functions.
(record_adapter_ops): Add arguments to strm_ops_init macro
for get_buf and fill_buf.
(put_buf, fill_buf): New functions.
(stream_init): Register put-buf and fill-buf intrinsics.

* socket.c (dgram_strm_ops): Add arguments to strm_ops_init
macro call.

* syslog.c (syslog_strm_ops): Likewise.

4 files changed, 129 insertions, 9 deletions

diff --git a/socket.c b/socket.c
index 51db01a9..6b583f1d 100644
--- a/socket.c
+++ b/socket.c
@@ -658,6 +658,8 @@ static_def(struct strm_ops dgram_strm_ops =
                 dgram_get_byte,
                 dgram_unget_char,
                 dgram_unget_byte,
+                0,
+                0,
                 dgram_close,
                 dgram_flush,
                 0,
diff --git a/stream.c b/stream.c
index 021dd2f1..0b2e607a 100644
--- a/stream.c
+++ b/stream.c
@@ -68,6 +68,8 @@
 #include "eval.h"
 #include "regex.h"
 #include "txr.h"
+#include "arith.h"
+#include "buf.h"
 
 /* Adhere to ISO C rules about direction switching on update streams. */
 #ifndef __gnu_linux__
@@ -177,6 +179,16 @@ 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)
+{
+  unimpl(stream, lit("put-buf"));
+}
+
+static noreturn val unimpl_fill_buf(val stream, val buf)
+{
+  unimpl(stream, lit("fill-buf"));
+}
+
 static noreturn val unimpl_seek(val stream, val off, enum strm_whence whence)
 {
   unimpl(stream, lit("seek-stream"));
@@ -292,6 +304,36 @@ static val null_get_fd(val stream)
   return nil;
 }
 
+static val generic_put_buf(val stream, val buf)
+{
+  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++)
+    ops->put_byte(stream, *ptr++);
+
+  return t;
+}
+
+static val generic_fill_buf(val stream, val buf)
+{
+  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++) {
+    val byte = ops->get_byte(stream);
+    if (!byte)
+      break;
+    *ptr++ = c_num(byte);
+  }
+
+  return num(i);
+}
+
 void fill_stream_ops(struct strm_ops *ops)
 {
   if (!ops->put_string)
@@ -310,6 +352,10 @@ void fill_stream_ops(struct strm_ops *ops)
     ops->unget_char = unimpl_unget_char;
   if (!ops->unget_byte)
     ops->unget_byte = unimpl_unget_byte;
+  if (!ops->put_buf)
+    ops->put_buf = (ops->get_byte ? generic_put_buf : unimpl_put_buf);
+  if (!ops->fill_buf)
+    ops->fill_buf = (ops->put_byte ? generic_fill_buf : unimpl_fill_buf);
   if (!ops->close)
     ops->close = null_close;
   if (!ops->flush)
@@ -350,6 +396,7 @@ static struct strm_ops null_ops =
                 null_put_string, null_put_char, null_put_byte, null_get_line,
                 null_get_char, null_get_byte,
                 unimpl_unget_char, unimpl_unget_byte,
+                unimpl_put_buf, unimpl_fill_buf,
                 null_close, null_flush, null_seek, unimpl_truncate,
                 null_get_prop, null_set_prop,
                 null_get_error, null_get_error_str, null_clear_error,
@@ -795,7 +842,37 @@ static val stdio_unget_byte(val stream, int byte)
   errno = 0;
   return h->f != 0 && ungetc(byte, coerce(FILE *, h->f)) != EOF
          ? num_fast(byte)
-         : stdio_maybe_error(stream, lit("pushing back byte into"));
+         : stdio_maybe_error(stream, lit("writing"));
+}
+
+static val stdio_put_buf(val stream, val buf)
+{
+  val self = lit("put-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);
+  if ((size_t) len != len)
+    uw_throwf(error_s, lit("~a: buffer too large"), self, nao);
+  errno = 0;
+  return h->f != 0 && fwrite(ptr, 1, len, h->f) == len
+         ? t : stdio_maybe_error(stream, lit("writing"));
+}
+
+static val stdio_fill_buf(val stream, val buf)
+{
+  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);
+  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);
 }
 
 static val stdio_close(val stream, val throw_on_error)
@@ -925,6 +1002,8 @@ static struct strm_ops stdio_ops =
                 stdio_get_byte,
                 stdio_unget_char,
                 stdio_unget_byte,
+                stdio_put_buf,
+                stdio_fill_buf,
                 stdio_close,
                 stdio_flush,
                 stdio_seek,
@@ -1114,6 +1193,8 @@ static struct strm_ops tail_ops =
                 tail_get_byte,
                 stdio_unget_char,
                 stdio_unget_byte,
+                stdio_put_buf,
+                stdio_fill_buf,
                 stdio_close,
                 stdio_flush,
                 stdio_seek,
@@ -1209,6 +1290,8 @@ static struct strm_ops pipe_ops =
                 stdio_get_byte,
                 stdio_unget_char,
                 stdio_unget_byte,
+                stdio_put_buf,
+                stdio_fill_buf,
                 pipe_close,
                 stdio_flush,
                 0, /* seek: not on pipes */
@@ -1559,7 +1642,7 @@ static struct strm_ops dir_ops =
                 wli("dir-stream"),
                 0, 0, 0,
                 dir_get_line,
-                0, 0, 0, 0,
+                0, 0, 0, 0, 0, 0,
                 dir_close,
                 0, 0, 0, 0, 0,
                 dir_get_error,
@@ -1681,7 +1764,7 @@ static struct strm_ops string_in_ops =
                 string_in_get_char,
                 0,
                 string_in_unget_char,
-                0, 0, 0,
+                0, 0, 0, 0, 0,
                 0, /* TODO: seek */
                 0, /* TODO: truncate */
                 string_in_get_prop,
@@ -1758,7 +1841,7 @@ static struct strm_ops byte_in_ops =
                 0, 0, 0, 0, 0,
                 byte_in_get_byte,
                 0,
-                byte_in_unget_byte,
+                byte_in_unget_byte, 0, 0,
                 0, 0, 0, 0, 0, 0,
                 byte_in_get_error,
                 byte_in_get_error_str,
@@ -1894,7 +1977,7 @@ static struct strm_ops strlist_in_ops =
                 strlist_in_get_char,
                 0,
                 strlist_in_unget_char,
-                0, 0, 0,
+                0, 0, 0, 0, 0,
                 0, /* TODO: seek */
                 0, /* TODO: truncate */
                 strlist_in_get_prop,
@@ -2033,7 +2116,7 @@ static struct strm_ops string_out_ops =
                 string_out_put_string,
                 string_out_put_char,
                 string_out_put_byte,
-                0, 0, 0, 0, 0, 0, 0,
+                0, 0, 0, 0, 0, 0, 0, 0, 0,
                 0, /* TODO: seek; fill-with-spaces semantics if past end. */
                 0,
                 0, 0, 0, 0, 0, 0);
@@ -2153,7 +2236,7 @@ static struct strm_ops strlist_out_ops =
                 wli("strlist-output-stream"),
                 strlist_out_put_string,
                 strlist_out_put_char,
-                0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+                0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
 
 val make_strlist_output_stream(void)
 {
@@ -2337,6 +2420,7 @@ static struct strm_ops cat_stream_ops =
                 cat_get_byte,
                 cat_unget_char,
                 cat_unget_byte,
+                0, 0,
                 0, 0, 0, 0,
                 cat_get_prop,
                 0,
@@ -2434,6 +2518,18 @@ 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)
+{
+  struct delegate_base *s = coerce(struct delegate_base *, stream->co.handle);
+  return s->target_ops->put_buf(s->target_stream, buf);
+}
+
+static val delegate_fill_buf(val stream, val buf)
+{
+  struct delegate_base *s = coerce(struct delegate_base *, stream->co.handle);
+  return s->target_ops->fill_buf(s->target_stream, buf);
+}
+
 static val delegate_close(val stream, val throw_on_error)
 {
   struct delegate_base *s = coerce(struct delegate_base *, stream->co.handle);
@@ -2578,6 +2674,7 @@ static struct strm_ops record_adapter_ops =
                 delegate_put_string, delegate_put_char, delegate_put_byte,
                 record_adapter_get_line, delegate_get_char, delegate_get_byte,
                 delegate_unget_char, delegate_unget_byte,
+                delegate_put_buf, delegate_fill_buf,
                 delegate_close, delegate_flush, delegate_seek,
                 delegate_truncate, delegate_get_prop, delegate_set_prop,
                 delegate_get_error, delegate_get_error_str,
@@ -2690,6 +2787,20 @@ val unget_byte(val byte, val stream_in)
   return ops->unget_byte(stream, b);
 }
 
+val put_buf(val buf, val stream_in)
+{
+  val stream = default_arg(stream_in, std_output);
+  struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s));
+  return ops->put_buf(stream, buf);
+}
+
+val fill_buf(val buf, val stream_in)
+{
+  val stream = default_arg(stream_in, std_input);
+  struct strm_ops *ops = coerce(struct strm_ops *, cobj_ops(stream, stream_s));
+  return ops->fill_buf(stream, buf);
+}
+
 struct fmt {
   size_t minsize;
   const char *dec;
@@ -4315,6 +4426,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("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 290af343..2a324ad3 100644
--- a/stream.h
+++ b/stream.h
@@ -63,6 +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 (*close)(val, val);
   val (*flush)(val);
   val (*seek)(val, val, enum strm_whence);
@@ -81,11 +83,12 @@ struct strm_ops {
 
 #define strm_ops_init(cobj_init_macro, name, put_string, put_char, put_byte, \
                       get_line, get_char, get_byte, unget_char, unget_byte,  \
+                      put_buf, fill_buf,                                     \
                       close, flush, seek, truncate, get_prop, set_prop,      \
                       get_error, get_error_str, clear_error, get_fd)         \
 {                                                                            \
     cobj_init_macro, name, put_string, put_char, put_byte, get_line,         \
-    get_char, get_byte, unget_char, unget_byte,                              \
+    get_char, get_byte, unget_char, unget_byte, put_buf, fill_buf,           \
     close, flush, seek, truncate, get_prop, set_prop,                        \
     get_error, get_error_str, clear_error, get_fd, 0, 0, 0, 0                \
 }
@@ -177,6 +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 vformat(val stream, val string, va_list);
 val vformat_to_string(val string, va_list);
 val format(val stream, val string, ...);
diff --git a/syslog.c b/syslog.c
index 1123bbeb..cf98e3c2 100644
--- a/syslog.c
+++ b/syslog.c
@@ -228,7 +228,7 @@ static_def(struct strm_ops syslog_strm_ops =
                 syslog_put_string,
                 syslog_put_char,
                 syslog_put_byte,
-                0, 0, 0, 0, 0, 0, 0, 0, 0,
+                0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                 syslog_get_prop,
                 syslog_set_prop,
                 0, 0, 0, 0))