* eval.c (eval_init): New put-byte function interned.

* stream.c (struct strm_ops): New member, put_byte.
(stdio_put_byte): New function.
(stdio_ops, pipe_ops, string_in_ops, byte_in_ops,
string_out_ops, strlist_out_ops, dir_ops): Updated.
(put_byte): New function.

* stream.h (put_byte): Declared.

4 files changed, 55 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 76ce0d5f..5f400108 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2012-02-25  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (eval_init): New put-byte function interned.
+
+	* stream.c (struct strm_ops): New member, put_byte.
+	(stdio_put_byte): New function.
+	(stdio_ops, pipe_ops, string_in_ops, byte_in_ops,
+	string_out_ops, strlist_out_ops, dir_ops): Updated.
+	(put_byte): New function.
+
+	* stream.h (put_byte): Declared.
+
+2012-02-25  Kaz Kylheku  <kaz@kylheku.com>
+
 	* parser.l (num_esc): Skip octal indicator 'o' if present.
 	This is needed for character constants.
 	(CHRLIT): Fix broken hex constants, being treated as octal.
diff --git a/eval.c b/eval.c
index 9347b708..1bfd5817 100644
--- a/eval.c
+++ b/eval.c
@@ -2201,6 +2201,7 @@ void eval_init(void)
   reg_fun(intern(lit("put-string"), user_package), func_n2o(put_string, 1));
   reg_fun(intern(lit("put-line"), user_package), func_n2o(put_line, 1));
   reg_fun(intern(lit("put-char"), user_package), func_n2o(put_char, 1));
+  reg_fun(intern(lit("put-byte"), user_package), func_n2o(put_byte, 1));
   reg_fun(intern(lit("flush-stream"), user_package), func_n1(flush_stream));
   reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory));
   reg_fun(intern(lit("open-file"), user_package), func_n2(open_file));
diff --git a/stream.c b/stream.c
index dffc8e25..ed7c05bd 100644
--- a/stream.c
+++ b/stream.c
@@ -51,6 +51,7 @@ struct strm_ops {
   struct cobj_ops cobj_ops;
   val (*put_string)(val, val);
   val (*put_char)(val, val);
+  val (*put_byte)(val, val);
   val (*get_line)(val);
   val (*get_char)(val);
   val (*get_byte)(val);
@@ -148,6 +149,22 @@ static val stdio_put_char(val stream, val ch)
          ? t : stdio_maybe_write_error(stream);
 }
 
+static val stdio_put_byte(val stream, val byte)
+{
+  cnum b = c_num(byte);
+  struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
+
+  if (h->f == stdout)
+    output_produced = t;
+
+  if (b < 0 || b > 255)
+    uw_throwf(file_error_s, lit("put-byte on ~a: byte value ~a out of range"),
+              stream, byte, nao);
+
+  return h->f != 0 && putc(b, (FILE *) h->f) != EOF
+         ? t : stdio_maybe_write_error(stream);
+}
+
 static val stdio_flush(val stream)
 {
   struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
@@ -245,6 +262,7 @@ static struct strm_ops stdio_ops = {
     cobj_hash_op },
   stdio_put_string,
   stdio_put_char,
+  stdio_put_byte,
   stdio_get_line,
   stdio_get_char,
   stdio_get_byte,
@@ -299,6 +317,7 @@ static struct strm_ops pipe_ops = {
     cobj_hash_op },
   stdio_put_string,
   stdio_put_char,
+  stdio_put_byte,
   stdio_get_line,
   stdio_get_char,
   stdio_get_byte,
@@ -365,9 +384,11 @@ static struct strm_ops string_in_ops = {
     cobj_hash_op },
   0,
   0,
+  0,
   string_in_get_line,
   string_in_get_char,
   0,
+  0,
   0
 };
 
@@ -396,6 +417,7 @@ static struct strm_ops byte_in_ops = {
   0,
   0,
   0,
+  0,
   byte_in_get_byte,
   0
 };
@@ -468,6 +490,7 @@ static struct strm_ops string_out_ops = {
   0,
   0,
   0,
+  0,
 };
 
 static void strlist_mark(val stream)
@@ -534,6 +557,7 @@ static struct strm_ops strlist_out_ops = {
   0,
   0,
   0,
+  0,
 };
 
 val make_strlist_output_stream(void)
@@ -597,6 +621,7 @@ static struct strm_ops dir_ops = {
     cobj_hash_op },
   0,
   0,
+  0,
   dir_get_line,
   0,
   0,
@@ -1185,6 +1210,22 @@ val put_char(val ch, val stream)
   }
 }
 
+val put_byte(val byte, val stream)
+{
+  if (!stream)
+    stream = std_output;
+
+  type_check (stream, COBJ);
+  type_assert (stream->co.cls == stream_s, (lit("~a is not a stream"),
+                                            stream, nao));
+
+  {
+    struct strm_ops *ops = (struct strm_ops *) stream->co.ops;
+    return ops->put_char ? ops->put_byte(stream, byte) : nil;
+  }
+}
+
+
 val put_line(val string, val stream)
 {
   return (put_string(string, stream), put_char(chr('\n'), stream));
diff --git a/stream.h b/stream.h
index 207d2acb..458c3cac 100644
--- a/stream.h
+++ b/stream.h
@@ -48,6 +48,7 @@ val formatv(val stream, val string, val args);
 val put_string(val string, val stream);
 val put_line(val string, val stream);
 val put_char(val ch, val stream);
+val put_byte(val byte, val stream);
 val flush_stream(val stream);
 val open_directory(val path);
 val open_file(val path, val mode_str);