Merge branch 'object-streams' into 'develop'

Bivalent streams improvements

See merge request embeddable-common-lisp/ecl!355

CHANGELOG

@@ -29,7 +29,23 @@
 
 * Pending changes since 24.5.10
 
-- *readtable* and *package* are local to an initialized module preventing
+- Byte operations on binary sequence streams and char operations on
+  character sequence streams do not require a roundtrip for encoding and
+  decoding elements (direct reading and writing to vector)
+
+- When a sequence stream is created with :END NIL, then updating the vector
+  fill pointer affects the stream maximum position before EOF
+
+- Sequence streams are now bivalent and allow for the underlying vector
+  upgraded array element type to be either a character or any byte
+
+- Fix a bug in UNREAD-CHAR called on STRING-INPUT-STREAM that moved the
+  position to negative values
+
+- New operators for binary and bivalent streams: EXT:PEEK-BYTE,
+  EXT:UNREAD-BYTE, GRAY:STREAM-PEEK-BYTE and GRAY:STREAM-UNREAD-BYTE.
+
+- *READTABLE* and *PACKAGE* are local to an initialized module preventing
   an issue where file-locality of them did not propagate to executables
 
 - Logical pathnames with multiple wild directories are now correctly

msvc/c/Makefile

@@ -99,9 +99,9 @@ WRITER_OBJS = print.obj float_to_digits.obj float_to_string.obj \
 
 READER_OBJS = read.obj parse_integer.obj parse_number.obj
 
-STREAM_OBJS = stream.obj file.obj strm_os.obj \
+STREAM_OBJS = stream.obj file.obj strm_os.obj strm_clos.obj \
-        strm_clos.obj strm_string.obj strm_composite.obj \
+        strm_string.obj strm_composite.obj strm_common.obj \
-        strm_common.obj strm_sequence.obj strm_eformat.obj
+        strm_sequence.obj strm_eformat.obj strm_binary.obj
 
 FFI_OBJS = ffi.obj libraries.obj backtrace.obj mmap.obj cdata.obj
 

src/c/Makefile.in

@@ -72,9 +72,9 @@ WRITER_OBJS = print.o printer/float_to_digits.o printer/float_to_string.o
 
 READER_OBJS = read.o reader/parse_integer.o reader/parse_number.o
 
-STREAM_OBJS = stream.o file.o streams/strm_os.o                                 \
+STREAM_OBJS = stream.o file.o streams/strm_os.o streams/strm_clos.o             \
-        streams/strm_clos.o streams/strm_string.o streams/strm_composite.o      \
+        streams/strm_string.o streams/strm_composite.o streams/strm_common.o    \
-        streams/strm_common.o streams/strm_sequence.o streams/strm_eformat.o
+        streams/strm_sequence.o streams/strm_eformat.o streams/strm_binary.o
 
 FFI_OBJS = ffi.o ffi/libraries.o ffi/backtrace.o ffi/mmap.o ffi/cdata.o
 

src/c/alloc_2.d

@@ -623,6 +623,7 @@ void init_type_info (void)
     to_bitmap(&o, &(o.stream.ops)) |
     to_bitmap(&o, &(o.stream.object0)) |
     to_bitmap(&o, &(o.stream.object1)) |
+    to_bitmap(&o, &(o.stream.last_byte)) |
     to_bitmap(&o, &(o.stream.byte_stack)) |
     to_bitmap(&o, &(o.stream.buffer)) |
     to_bitmap(&o, &(o.stream.format)) |

src/c/read.d

@@ -1741,7 +1741,7 @@ do_read_delimited_list(int d, cl_object in, bool proper_list)
   cl_object c;
   @
   c = ecl_read_byte(binary_input_stream);
-  if (c == ECL_NIL) {
+  if (c == OBJNULL) {
     if (Null(eof_errorp)) {
       @(return eof_value);
     }

src/c/stream.d

@@ -36,12 +36,15 @@ ecl_alloc_stream(void)
   x->stream.format = ECL_NIL;
   x->stream.flags = 0;
   x->stream.byte_size = 8;
+  x->stream.last_byte = OBJNULL;
   x->stream.buffer = NULL;
   x->stream.encoder = NULL;
   x->stream.decoder = NULL;
+  x->stream.byte_buffer = NULL;
+  x->stream.byte_encoder = NULL;
+  x->stream.byte_decoder = NULL;
   x->stream.last_char = EOF;
   x->stream.byte_stack = ECL_NIL;
-  x->stream.last_code[0] = x->stream.last_code[1] = EOF;
   x->stream.eof_char = EOF;
   return x;
 }
@@ -79,6 +82,30 @@ ecl_write_byte8(cl_object strm, unsigned char *c, cl_index n)
   return ecl_stream_dispatch_table(strm)->write_byte8(strm, c, n);
 }
 
+cl_object
+ecl_read_byte(cl_object strm)
+{
+  return ecl_stream_dispatch_table(strm)->read_byte(strm);
+}
+
+void
+ecl_write_byte(cl_object byte, cl_object strm)
+{
+  ecl_stream_dispatch_table(strm)->write_byte(strm, byte);
+}
+
+void
+ecl_unread_byte(cl_object byte, cl_object strm)
+{
+  ecl_stream_dispatch_table(strm)->unread_byte(strm, byte);
+}
+
+cl_object
+ecl_peek_byte(cl_object strm)
+{
+  return ecl_stream_dispatch_table(strm)->peek_byte(strm);
+}
+
 ecl_character
 ecl_read_char(cl_object strm)
 {
@@ -94,18 +121,6 @@ ecl_read_char_noeof(cl_object strm)
   return c;
 }
 
-cl_object
-ecl_read_byte(cl_object strm)
-{
-  return ecl_stream_dispatch_table(strm)->read_byte(strm);
-}
-
-void
-ecl_write_byte(cl_object byte, cl_object strm)
-{
-  ecl_stream_dispatch_table(strm)->write_byte(strm, byte);
-}
-
 ecl_character
 ecl_write_char(ecl_character c, cl_object strm)
 {
@@ -118,6 +133,12 @@ ecl_unread_char(ecl_character c, cl_object strm)
   ecl_stream_dispatch_table(strm)->unread_char(strm, c);
 }
 
+ecl_character
+ecl_peek_char(cl_object strm)
+{
+  return ecl_stream_dispatch_table(strm)->peek_char(strm);
+}
+
 int
 ecl_listen_stream(cl_object strm)
 {
@@ -214,21 +235,6 @@ ecl_stream_truename(cl_object strm)
   return ecl_stream_dispatch_table(strm)->truename(strm);
 }
 
-/*
- * ecl_read_char(s) tries to read a character from the stream S. It outputs
- * either the code of the character read, or EOF. Whe compiled with
- * CLOS-STREAMS and S is an instance object, STREAM-READ-CHAR is invoked
- * to retrieve the character. Then STREAM-READ-CHAR should either
- * output the character, or NIL, indicating EOF.
- *
- * INV: ecl_read_char(strm) checks the type of STRM.
- */
-ecl_character
-ecl_peek_char(cl_object strm)
-{
-  return ecl_stream_dispatch_table(strm)->peek_char(strm);
-}
-
 /* -- Lisp interface -------------------------------------------------------- */
 
 cl_object
@@ -267,12 +273,10 @@ cl_object
 si_read_byte(cl_object strm, cl_object eof_value)
 {
   cl_env_ptr the_env = ecl_process_env();
-  cl_object c = ecl_read_byte(strm);
+  cl_object byte = ecl_read_byte(strm);
-  ecl_return1(the_env, Null(c) ? eof_value : c);
+  ecl_return1(the_env, (byte == OBJNULL) ? eof_value : byte);
 }
 
-/* These two interfaces are clearly missing in the ANSI standard. */
-#if 0
 cl_object
 si_unread_byte(cl_object strm, cl_object byte)
 {
@@ -286,9 +290,8 @@ si_peek_byte(cl_object strm, cl_object eof_value)
 {
   cl_env_ptr the_env = ecl_process_env();
   cl_object byte = ecl_peek_byte(strm);
-  ecl_return1(the_env, Null(c) ? eof_value : byte);
+  ecl_return1(the_env, (byte == OBJNULL) ? eof_value : byte);
 }
-#endif
 
 cl_object
 si_write_byte(cl_object strm, cl_object byte)

src/c/streams/strm_binary.d

@@ -0,0 +1,162 @@
+/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
+/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
+
+/*
+ * strm_binary.d - Byte encoding/decoding for streams
+ *
+ * Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
+ * Copyright (c) 1990 Giuseppe Attardi
+ * Copyright (c) 2001 Juan Jose Garcia Ripoll
+ * Copyright (c) 2025 Daniel Kochmanski
+ *
+ * See file 'LICENSE' for the copyright details.
+ *
+ */
+
+#include <ecl/ecl.h>
+#include <ecl/internal.h>
+
+/* Binary operators */
+
+cl_object
+ecl_binary_read_byte(cl_object strm)
+{
+  cl_index (*read_byte8)(cl_object, unsigned char *, cl_index);
+  unsigned char *buf = strm->stream.byte_buffer;
+  cl_index nbytes;
+  strm->stream.last_char = EOF;
+  strm->stream.last_byte = OBJNULL;
+  read_byte8 = strm->stream.ops->read_byte8;
+  nbytes = strm->stream.byte_size/8;
+  if (read_byte8(strm, buf, nbytes) < nbytes)
+    return OBJNULL;
+  return strm->stream.byte_decoder(strm, buf);
+}
+
+void
+ecl_binary_write_byte(cl_object strm, cl_object byte)
+{
+  cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n);
+  cl_index nbytes = strm->stream.byte_size/8;
+  unsigned char *buf = strm->stream.byte_buffer;
+  write_byte8 = strm->stream.ops->write_byte8;
+  strm->stream.byte_encoder(strm, buf, byte);
+  write_byte8(strm, buf, nbytes);
+}
+
+void
+ecl_binary_unread_byte(cl_object strm, cl_object byte)
+{
+  unlikely_if (strm->stream.last_char != EOF
+               || strm->stream.last_byte != OBJNULL) {
+    ecl_unread_twice(strm);
+  }
+  strm->stream.last_byte = byte;
+}
+
+/*
+ * 8-bit unsigned
+ */
+
+cl_object
+ecl_binary_u8_decoder(cl_object strm, unsigned char *buf)
+{
+  unsigned char c = buf[0];
+  return ecl_make_fixnum(c);
+}
+
+void
+ecl_binary_u8_encoder(cl_object strm, unsigned char *buf, cl_object byte)
+{
+  unsigned char c = ecl_to_uint8_t(byte);
+  buf[0] = c;
+}
+
+/*
+ * 8-bit signed
+ */
+cl_object
+ecl_binary_s8_decoder(cl_object strm, unsigned char *buf)
+{
+  signed char c = (signed char)buf[0];
+  return ecl_make_fixnum(c);
+}
+
+void
+ecl_binary_s8_encoder(cl_object strm, unsigned char *buf, cl_object byte)
+{
+  signed char c = ecl_to_int8_t(byte);
+  buf[0] = (unsigned char)c;
+}
+
+/*
+ * Big Endian
+ */
+cl_object
+ecl_binary_be_decoder(cl_object strm, unsigned char *buf)
+{
+  cl_index idx, ndx = strm->stream.byte_size/8;
+  cl_object output = OBJNULL;
+  cl_object offset = ecl_make_fixnum(8);
+  unsigned char c;
+  for (idx=0; idx<ndx; idx++) {
+    c = buf[idx];
+    if (output) {
+      output = cl_logior(2, ecl_make_fixnum(c), cl_ash(output, offset));
+    } else  {
+      output = (strm->stream.flags & ECL_STREAM_SIGNED_BYTES)
+        ? ecl_make_fixnum((signed char)c)
+        : ecl_make_fixnum((unsigned char)c);
+    }
+  }
+  return output;
+}
+
+void
+ecl_binary_be_encoder(cl_object strm, unsigned char *buf, cl_object byte)
+{
+  cl_index idx, ndx = strm->stream.byte_size/8;
+  cl_object offset = ecl_make_fixnum(-8);
+  cl_object mask = ecl_make_fixnum(0xFF);
+  for (idx=0; idx<ndx; idx++) {
+    cl_object b = cl_logand(2, byte, mask);
+    buf[ndx-idx-1] = (unsigned char)ecl_fixnum(b);
+    byte = cl_ash(byte, offset);
+  }
+}
+
+/*
+ * Little Endian
+ */
+cl_object
+ecl_binary_le_decoder(cl_object strm, unsigned char *buf)
+{
+  cl_index idx, ndx = strm->stream.byte_size/8;
+  cl_object output = OBJNULL;
+  cl_object offset = ecl_make_fixnum(8);
+  unsigned char c;
+  for (idx=0; idx<ndx; idx++) {
+    c = buf[ndx-idx-1];
+    if (output) {
+      output = cl_logior(2, ecl_make_fixnum(c), cl_ash(output, offset));
+    } else  {
+      output = (strm->stream.flags & ECL_STREAM_SIGNED_BYTES)
+        ? ecl_make_fixnum((signed char)c)
+        : ecl_make_fixnum((unsigned char)c);
+    }
+  }
+  return output;
+}
+
+void
+ecl_binary_le_encoder(cl_object strm, unsigned char *buf, cl_object byte)
+{
+  cl_index idx, ndx = strm->stream.byte_size/8;
+  cl_object offset = ecl_make_fixnum(-8);
+  cl_object mask = ecl_make_fixnum(0xFF);
+  for (idx=0; idx<ndx; idx++) {
+    cl_object b = cl_logand(2, byte, mask);
+    buf[idx] = (unsigned char)ecl_fixnum(b);
+    byte = cl_ash(byte, offset);
+  }
+}

src/c/streams/strm_clos.d

@@ -46,15 +46,29 @@ clos_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n)
 static cl_object
 clos_stream_read_byte(cl_object strm)
 {
-  cl_object b = _ecl_funcall2(@'gray::stream-read-byte', strm);
+  cl_object out = _ecl_funcall2(@'gray::stream-read-byte', strm);
-  if (b == @':eof') b = ECL_NIL;
+  if (out == @':eof') out = OBJNULL;
-  return b;
+  return out;
 }
 
 static void
-clos_stream_write_byte(cl_object strm, cl_object c)
+clos_stream_write_byte(cl_object strm, cl_object byte)
 {
-  _ecl_funcall3(@'gray::stream-write-byte', strm, c);
+  _ecl_funcall3(@'gray::stream-write-byte', strm, byte);
+}
+
+static void
+clos_stream_unread_byte(cl_object strm, cl_object byte)
+{
+  _ecl_funcall3(@'gray::stream-unread-byte', strm, byte);
+}
+
+static cl_object
+clos_stream_peek_byte(cl_object strm)
+{
+  cl_object out = _ecl_funcall2(@'gray::stream-peek-byte', strm);
+  if (out == @':eof') return OBJNULL;
+  return out;
 }
 
 static ecl_character
@@ -88,7 +102,7 @@ clos_stream_unread_char(cl_object strm, ecl_character c)
   _ecl_funcall3(@'gray::stream-unread-char', strm, ECL_CODE_CHAR(c));
 }
 
-static int
+static ecl_character
 clos_stream_peek_char(cl_object strm)
 {
   cl_object out = _ecl_funcall2(@'gray::stream-peek-char', strm);
@@ -217,11 +231,13 @@ clos_stream_close(cl_object strm)
 }
 
 const struct ecl_file_ops clos_stream_ops = {
-  clos_stream_write_byte8,
   clos_stream_read_byte8,
+  clos_stream_write_byte8,
 
-  clos_stream_write_byte,
   clos_stream_read_byte,
+  clos_stream_write_byte,
+  clos_stream_unread_byte,
+  clos_stream_peek_byte,
 
   clos_stream_read_char,
   clos_stream_write_char,

src/c/streams/strm_common.d

@@ -122,6 +122,12 @@ ecl_not_binary_read_byte(cl_object strm)
   return OBJNULL;
 }
 
+void
+ecl_not_input_unread_byte(cl_object strm, cl_object byte)
+{
+  ecl_not_an_input_stream(strm);
+}
+
 ecl_character
 ecl_not_input_read_char(cl_object strm)
 {
@@ -240,6 +246,25 @@ closed_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n)
   return 0;
 }
 
+static cl_object
+closed_stream_read_byte(cl_object strm)
+{
+  FEclosed_stream(strm);
+  return ECL_NIL;
+}
+
+static void
+closed_stream_write_byte(cl_object strm, cl_object byte)
+{
+  FEclosed_stream(strm);
+}
+
+static void
+closed_stream_unread_byte(cl_object strm, cl_object byte)
+{
+  FEclosed_stream(strm);
+}
+
 static ecl_character
 closed_stream_read_char(cl_object strm)
 {
@@ -296,122 +321,13 @@ closed_stream_set_position(cl_object strm, cl_object position)
  *
  * Versions of the methods which are defined in terms of others
  */
-/*
- * Byte operations based on octet operators.
- */
-cl_object
-ecl_generic_read_byte_unsigned8(cl_object strm)
-{
-  unsigned char c;
-  if (strm->stream.ops->read_byte8(strm, &c, 1) < 1) {
-    return ECL_NIL;
-  }
-  return ecl_make_fixnum(c);
-}
-
-void
-ecl_generic_write_byte_unsigned8(cl_object strm, cl_object byte)
-{
-  unsigned char c = ecl_to_uint8_t(byte);
-  strm->stream.ops->write_byte8(strm, &c, 1);
-}
 
 cl_object
-ecl_generic_read_byte_signed8(cl_object strm)
+ecl_generic_peek_byte(cl_object strm)
 {
-  signed char c;
+  cl_object out = ecl_read_byte(strm);
-  if (strm->stream.ops->read_byte8(strm, (unsigned char *)&c, 1) < 1)
+  if (out != OBJNULL) ecl_unread_byte(out, strm);
-    return ECL_NIL;
+  return out;
-  return ecl_make_fixnum(c);
-}
-
-void
-ecl_generic_write_byte_signed8(cl_object strm, cl_object byte)
-{
-  signed char c = ecl_to_int8_t(byte);
-  strm->stream.ops->write_byte8(strm, (unsigned char *)&c, 1);
-}
-
-cl_object
-ecl_generic_read_byte_le(cl_object strm)
-{
-  cl_index (*read_byte8)(cl_object, unsigned char *, cl_index);
-  unsigned char c;
-  cl_index nb, bs;
-  cl_object output = ecl_make_fixnum(0);
-  read_byte8 = strm->stream.ops->read_byte8;
-  bs = strm->stream.byte_size;
-  for (nb = 0; bs >= 8; bs -= 8, nb += 8) {
-    cl_object aux;
-    if (read_byte8(strm, &c, 1) < 1)
-      return ECL_NIL;
-    if (bs <= 8 && (strm->stream.flags & ECL_STREAM_SIGNED_BYTES))
-      aux = ecl_make_fixnum((signed char)c);
-    else
-      aux = ecl_make_fixnum((unsigned char)c);
-    output = cl_logior(2, output, cl_ash(aux, ecl_make_fixnum(nb)));
-  }
-  return output;
-}
-
-void
-ecl_generic_write_byte_le(cl_object strm, cl_object byte)
-{
-  cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n);
-  cl_index bs;
-  write_byte8 = strm->stream.ops->write_byte8;
-  bs = strm->stream.byte_size;
-  do {
-    cl_object b = cl_logand(2, byte, ecl_make_fixnum(0xFF));
-    unsigned char aux = (unsigned char)ecl_fixnum(b);
-    if (write_byte8(strm, &aux, 1) < 1)
-      break;
-    byte = cl_ash(byte, ecl_make_fixnum(-8));
-    bs -= 8;
-  } while (bs);
-}
-
-cl_object
-ecl_generic_read_byte(cl_object strm)
-{
-  cl_index (*read_byte8)(cl_object, unsigned char *, cl_index);
-  unsigned char c;
-  cl_object output = NULL;
-  cl_index bs;
-  read_byte8 = strm->stream.ops->read_byte8;
-  bs = strm->stream.byte_size;
-  for (; bs >= 8; bs -= 8) {
-    if (read_byte8(strm, &c, 1) < 1)
-      return ECL_NIL;
-    if (output) {
-      output = cl_logior(2, ecl_make_fixnum(c),
-                         cl_ash(output, ecl_make_fixnum(8)));
-    } else if (strm->stream.flags & ECL_STREAM_SIGNED_BYTES) {
-      output = ecl_make_fixnum((signed char)c);
-    } else {
-      output = ecl_make_fixnum((unsigned char)c);
-    }
-  }
-  return output;
-}
-
-void
-ecl_generic_write_byte(cl_object strm, cl_object byte)
-{
-  cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n);
-  cl_index bs;
-  write_byte8 = strm->stream.ops->write_byte8;
-  bs = strm->stream.byte_size;
-  do {
-    unsigned char aux;
-    cl_object b;
-    bs -= 8;
-    b = cl_logand(2, ecl_make_fixnum(0xFF),
-                  bs ? cl_ash(byte, ecl_make_fixnum(-bs)) : byte);
-    aux = (unsigned char)ecl_fixnum(b);
-    if (write_byte8(strm, &aux, 1) < 1)
-      break;
-  } while (bs);
 }
 
 ecl_character
@@ -463,13 +379,18 @@ ecl_generic_close(cl_object strm)
   struct ecl_file_ops *ops = strm->stream.ops;
   if (ecl_input_stream_p(strm)) {
     ops->read_byte8 = closed_stream_read_byte8;
+    ops->read_byte = closed_stream_read_byte;
+    ops->peek_byte = closed_stream_read_byte;
+    ops->unread_byte = closed_stream_unread_byte;
     ops->read_char = closed_stream_read_char;
+    ops->peek_char = closed_stream_read_char;
     ops->unread_char = closed_stream_unread_char;
     ops->listen = closed_stream_listen;
     ops->clear_input = closed_stream_clear_input;
   }
   if (ecl_output_stream_p(strm)) {
     ops->write_byte8 = closed_stream_write_byte8;
+    ops->write_byte = closed_stream_write_byte;
     ops->write_char = closed_stream_write_char;
     ops->clear_output = closed_stream_clear_output;
     ops->force_output = closed_stream_force_output;
@@ -479,6 +400,8 @@ ecl_generic_close(cl_object strm)
   ops->set_position = closed_stream_set_position;
   ops->length = closed_stream_length;
   ops->close = ecl_generic_close;
+  strm->stream.last_byte = OBJNULL;
+  strm->stream.byte_buffer = NULL;
   strm->stream.closed = 1;
   return ECL_T;
 }
@@ -530,7 +453,7 @@ ecl_generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index
     cl_object (*read_byte)(cl_object) = ops->read_byte;
     for (; start < end; start++) {
       cl_object x = read_byte(strm);
-      if (Null(x)) break;
+      if (x == OBJNULL) break;
       ecl_elt_set(data, start, x);
     }
   }

src/c/streams/strm_composite.d

@@ -46,6 +46,18 @@ two_way_read_byte(cl_object stream)
   return ecl_read_byte(TWO_WAY_STREAM_INPUT(stream));
 }
 
+static void
+two_way_unread_byte(cl_object strm, cl_object byte)
+{
+  ecl_unread_byte(byte, TWO_WAY_STREAM_INPUT(strm));
+}
+
+static cl_object
+two_way_peek_byte(cl_object strm)
+{
+  return ecl_peek_byte(TWO_WAY_STREAM_INPUT(strm));
+}
+
 static ecl_character
 two_way_read_char(cl_object strm)
 {
@@ -143,11 +155,13 @@ two_way_close(cl_object strm)
 }
 
 const struct ecl_file_ops two_way_ops = {
-  two_way_write_byte8,
   two_way_read_byte8,
+  two_way_write_byte8,
 
-  two_way_write_byte,
   two_way_read_byte,
+  two_way_write_byte,
+  two_way_unread_byte,
+  two_way_peek_byte,
 
   two_way_read_char,
   two_way_write_char,
@@ -341,11 +355,13 @@ broadcast_close(cl_object strm)
 }
 
 const struct ecl_file_ops broadcast_ops = {
-  broadcast_write_byte8,
   ecl_not_input_read_byte8,
+  broadcast_write_byte8,
 
-  broadcast_write_byte,
   ecl_not_input_read_byte,
+  broadcast_write_byte,
+  ecl_not_input_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_not_input_read_char,
   broadcast_write_char,
@@ -423,31 +439,55 @@ echo_write_byte8(cl_object strm, unsigned char *c, cl_index n)
   return ecl_write_byte8(ECHO_STREAM_OUTPUT(strm), c, n);
 }
 
+static cl_object
+echo_read_byte(cl_object strm)
+{
+  cl_object byte = strm->stream.last_byte;
+  if (byte != OBJNULL) {
+    strm->stream.last_byte = OBJNULL;
+    byte = ecl_read_byte(ECHO_STREAM_INPUT(strm));
+  } else {
+    byte = ecl_read_byte(ECHO_STREAM_INPUT(strm));
+    if (byte != OBJNULL)
+      ecl_write_byte(byte, ECHO_STREAM_OUTPUT(strm));
+  }
+  return byte;
+}
+
 static void
 echo_write_byte(cl_object strm, cl_object byte)
 {
   ecl_write_byte(byte, ECHO_STREAM_OUTPUT(strm));
 }
 
-static cl_object
+static void
-echo_read_byte(cl_object strm)
+echo_unread_byte(cl_object strm, cl_object byte)
 {
-  cl_object out = ecl_read_byte(ECHO_STREAM_INPUT(strm));
+  unlikely_if (strm->stream.last_byte != OBJNULL) {
-  if (!Null(out)) ecl_write_byte(out, ECHO_STREAM_OUTPUT(strm));
+    ecl_unread_twice(strm);
-  return out;
+  }
+  strm->stream.last_byte = ECL_T;
+  ecl_unread_byte(byte, ECHO_STREAM_INPUT(strm));
+}
+
+static cl_object
+echo_peek_byte(cl_object strm)
+{
+  return ecl_peek_byte(ECHO_STREAM_INPUT(strm));
 }
 
 static ecl_character
 echo_read_char(cl_object strm)
 {
-  ecl_character c = strm->stream.last_code[0];
+  cl_object byte = strm->stream.last_byte;
-  if (c == EOF) {
+  ecl_character c;
+  if (byte != OBJNULL) {
+    strm->stream.last_byte = OBJNULL;
+    c = ecl_read_char(ECHO_STREAM_INPUT(strm));
+  } else {
     c = ecl_read_char(ECHO_STREAM_INPUT(strm));
     if (c != EOF)
       ecl_write_char(c, ECHO_STREAM_OUTPUT(strm));
-  } else {
-    strm->stream.last_code[0] = EOF;
-    ecl_read_char(ECHO_STREAM_INPUT(strm));
   }
   return c;
 }
@@ -461,21 +501,17 @@ echo_write_char(cl_object strm, ecl_character c)
 static void
 echo_unread_char(cl_object strm, ecl_character c)
 {
-  unlikely_if (strm->stream.last_code[0] != EOF) {
+  unlikely_if (strm->stream.last_byte != OBJNULL) {
     ecl_unread_twice(strm);
   }
-  strm->stream.last_code[0] = c;
+  strm->stream.last_byte = ECL_T;;
   ecl_unread_char(c, ECHO_STREAM_INPUT(strm));
 }
 
 static ecl_character
 echo_peek_char(cl_object strm)
 {
-  ecl_character c = strm->stream.last_code[0];
+  return ecl_peek_char(ECHO_STREAM_INPUT(strm));
-  if (c == EOF) {
-    c = ecl_peek_char(ECHO_STREAM_INPUT(strm));
-  }
-  return c;
 }
 
 static int
@@ -531,11 +567,13 @@ echo_close(cl_object strm)
 }
 
 const struct ecl_file_ops echo_ops = {
-  echo_write_byte8,
   echo_read_byte8,
+  echo_write_byte8,
 
-  echo_write_byte,
   echo_read_byte,
+  echo_write_byte,
+  echo_unread_byte,
+  echo_peek_byte,
 
   echo_read_char,
   echo_write_char,
@@ -625,15 +663,25 @@ static cl_object
 concatenated_read_byte(cl_object strm)
 {
   cl_object l = CONCATENATED_STREAM_LIST(strm);
-  cl_object c = ECL_NIL;
+  cl_object c = OBJNULL;
   while (!Null(l)) {
     c = ecl_read_byte(ECL_CONS_CAR(l));
-    if (c != ECL_NIL) break;
+    if (c != OBJNULL) break;
     CONCATENATED_STREAM_LIST(strm) = l = ECL_CONS_CDR(l);
   }
   return c;
 }
 
+static void
+concatenated_unread_byte(cl_object strm, cl_object byte)
+{
+  cl_object l = CONCATENATED_STREAM_LIST(strm);
+  unlikely_if (Null(l)) {
+    ecl_unread_error(strm);
+  }
+  ecl_unread_byte(byte, ECL_CONS_CAR(l));
+}
+
 static ecl_character
 concatenated_read_char(cl_object strm)
 {
@@ -683,11 +731,13 @@ concatenated_close(cl_object strm)
 }
 
 const struct ecl_file_ops concatenated_ops = {
-  ecl_not_output_write_byte8,
   concatenated_read_byte8,
+  ecl_not_output_write_byte8,
 
-  ecl_not_output_write_byte,
   concatenated_read_byte,
+  ecl_not_output_write_byte,
+  concatenated_unread_byte,
+  ecl_generic_peek_byte,
 
   concatenated_read_char,
   ecl_not_output_write_char,
@@ -780,6 +830,18 @@ synonym_read_byte(cl_object strm)
   return ecl_read_byte(SYNONYM_STREAM_STREAM(strm));
 }
 
+static void
+synonym_unread_byte(cl_object strm, cl_object byte)
+{
+  ecl_unread_byte(SYNONYM_STREAM_STREAM(strm), byte);
+}
+
+static cl_object
+synonym_peek_byte(cl_object strm)
+{
+  return ecl_peek_byte(SYNONYM_STREAM_STREAM(strm));
+}
+
 static ecl_character
 synonym_read_char(cl_object strm)
 {
@@ -915,11 +977,13 @@ synonym_truename(cl_object strm)
 }
 
 const struct ecl_file_ops synonym_ops = {
-  synonym_write_byte8,
   synonym_read_byte8,
+  synonym_write_byte8,
 
-  synonym_write_byte,
   synonym_read_byte,
+  synonym_write_byte,
+  synonym_unread_byte,
+  synonym_peek_byte,
 
   synonym_read_char,
   synonym_write_char,

src/c/streams/strm_eformat.d

@@ -61,11 +61,13 @@ decoding_error(cl_object stream, unsigned char **buffer, int char_length, unsign
 ecl_character
 ecl_eformat_read_char(cl_object strm)
 {
-  unsigned char buffer[ENCODING_BUFFER_MAX_SIZE];
+  unsigned char *buffer = strm->stream.byte_buffer;
   ecl_character c;
   unsigned char *buffer_pos = buffer;
   unsigned char *buffer_end = buffer;
   cl_index byte_size = (strm->stream.byte_size / 8);
+  strm->stream.last_char = EOF;
+  strm->stream.last_byte = OBJNULL;
   do {
     if (ecl_read_byte8(strm, buffer_end, byte_size) < byte_size) {
       c = EOF;
@@ -76,44 +78,23 @@ ecl_eformat_read_char(cl_object strm)
   } while(c == EOF && (buffer_end - buffer) < ENCODING_BUFFER_MAX_SIZE);
   unlikely_if (c == strm->stream.eof_char)
     return EOF;
-  if (c != EOF) {
-    strm->stream.last_char = c;
-    strm->stream.last_code[0] = c;
-    strm->stream.last_code[1] = EOF;
-  }
   return c;
 }
 
 void
 ecl_eformat_unread_char(cl_object strm, ecl_character c)
 {
-  unlikely_if (c != strm->stream.last_char) {
+  unlikely_if (strm->stream.last_char != EOF
+               || strm->stream.last_byte != OBJNULL) {
     ecl_unread_twice(strm);
   }
-  {
+  strm->stream.last_char = c;
-    unsigned char buffer[2*ENCODING_BUFFER_MAX_SIZE];
-    int ndx = 0;
-    cl_object l = strm->stream.byte_stack;
-    cl_fixnum i = strm->stream.last_code[0];
-    if (i != EOF) {
-      ndx += strm->stream.encoder(strm, buffer, i);
-    }
-    i = strm->stream.last_code[1];
-    if (i != EOF) {
-      ndx += strm->stream.encoder(strm, buffer+ndx, i);
-    }
-    while (ndx != 0) {
-      l = CONS(ecl_make_fixnum(buffer[--ndx]), l);
-    }
-    strm->stream.byte_stack = l;
-    strm->stream.last_char = EOF;
-  }
 }
 
 ecl_character
 ecl_eformat_write_char(cl_object strm, ecl_character c)
 {
-  unsigned char buffer[ENCODING_BUFFER_MAX_SIZE];
+  unsigned char *buffer = strm->stream.byte_buffer;
   ecl_character nbytes;
   nbytes = strm->stream.encoder(strm, buffer, c);
   strm->stream.ops->write_byte8(strm, buffer, nbytes);
@@ -127,7 +108,6 @@ eformat_read_char_cr(cl_object strm)
   ecl_character c = ecl_eformat_read_char(strm);
   if (c == ECL_CHAR_CODE_RETURN) {
     c = ECL_CHAR_CODE_NEWLINE;
-    strm->stream.last_char = c;
   }
   return c;
 }
@@ -150,16 +130,11 @@ eformat_read_char_crlf(cl_object strm)
   if (c == ECL_CHAR_CODE_RETURN) {
     c = ecl_eformat_read_char(strm);
     if (c == ECL_CHAR_CODE_LINEFEED) {
-      strm->stream.last_code[0] = ECL_CHAR_CODE_RETURN;
-      strm->stream.last_code[1] = c;
       c = ECL_CHAR_CODE_NEWLINE;
     } else {
       ecl_eformat_unread_char(strm, c);
       c = ECL_CHAR_CODE_RETURN;
-      strm->stream.last_code[0] = c;
-      strm->stream.last_code[1] = EOF;
     }
-    strm->stream.last_char = c;
   }
   return c;
 }
@@ -877,33 +852,37 @@ ecl_set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int flags,
   }
   stream->stream.format = cl_list(2, stream->stream.format, t);
   {
-    cl_object (*read_byte)(cl_object);
-    void (*write_byte)(cl_object,cl_object);
     byte_size = (byte_size+7)&(~(cl_fixnum)7);
     if (byte_size == 8) {
       if (flags & ECL_STREAM_SIGNED_BYTES) {
-        read_byte = ecl_generic_read_byte_signed8;
+        stream->stream.byte_decoder = ecl_binary_s8_decoder;
-        write_byte = ecl_generic_write_byte_signed8;
+        stream->stream.byte_encoder = ecl_binary_s8_encoder;
       } else {
-        read_byte = ecl_generic_read_byte_unsigned8;
+        stream->stream.byte_decoder = ecl_binary_u8_decoder;
-        write_byte = ecl_generic_write_byte_unsigned8;
+        stream->stream.byte_encoder = ecl_binary_u8_encoder;
       }
     } else if (flags & ECL_STREAM_LITTLE_ENDIAN) {
-      read_byte = ecl_generic_read_byte_le;
+      stream->stream.byte_decoder = ecl_binary_le_decoder;
-      write_byte = ecl_generic_write_byte_le;
+      stream->stream.byte_encoder = ecl_binary_le_encoder;
     } else {
-      read_byte = ecl_generic_read_byte;
+      stream->stream.byte_decoder = ecl_binary_be_decoder;
-      write_byte = ecl_generic_write_byte;
+      stream->stream.byte_encoder = ecl_binary_be_encoder;
     }
     if (ecl_input_stream_p(stream)) {
-      stream->stream.ops->read_byte = read_byte;
+      stream->stream.ops->read_byte = ecl_binary_read_byte;
     }
     if (ecl_output_stream_p(stream)) {
-      stream->stream.ops->write_byte = write_byte;
+      stream->stream.ops->write_byte = ecl_binary_write_byte;
     }
   }
   stream->stream.flags = flags;
   stream->stream.byte_size = byte_size;
+  {
+    cl_fixnum buffer_size = byte_size/8;
+    if (buffer_size < ENCODING_BUFFER_MAX_SIZE)
+      buffer_size = ENCODING_BUFFER_MAX_SIZE;
+    stream->stream.byte_buffer = ecl_alloc_atomic(buffer_size);
+  }
 }
 
 cl_object

src/c/streams/strm_os.d

@@ -132,10 +132,7 @@ safe_fclose(FILE *stream)
   return output;
 }
 
-/**********************************************************************
+/* -- Byte stack --------------------------------------------------- */
- * POSIX FILE STREAM
- */
-
 static cl_index
 consume_byte_stack(cl_object strm, unsigned char *c, cl_index n)
 {
@@ -152,6 +149,54 @@ consume_byte_stack(cl_object strm, unsigned char *c, cl_index n)
   return out;
 }
 
+static void
+io_file_unread_char(cl_object strm, ecl_character c)
+{
+  ecl_eformat_unread_char(strm, c);
+  if (c == ECL_CHAR_CODE_NEWLINE) {
+    unsigned char *buffer = strm->stream.byte_buffer;
+    int ndx = 0;
+    cl_object l = strm->stream.byte_stack;
+    int flags = strm->stream.flags;
+    if (flags & ECL_STREAM_CR) {
+      if (flags & ECL_STREAM_LF) {
+        /* Byte stack lands in a reverse order. */
+        ndx = strm->stream.encoder(strm, buffer, ECL_CHAR_CODE_LINEFEED);
+        while (ndx != 0) l = CONS(ecl_make_fixnum(buffer[--ndx]), l);
+      }
+      ndx = strm->stream.encoder(strm, buffer, ECL_CHAR_CODE_RETURN);
+      while (ndx != 0) l = CONS(ecl_make_fixnum(buffer[--ndx]), l);
+    } else {
+      ndx = strm->stream.encoder(strm, buffer, ECL_CHAR_CODE_NEWLINE);
+      while (ndx != 0) l = CONS(ecl_make_fixnum(buffer[--ndx]), l);
+    }
+    strm->stream.byte_stack = l;
+  } else {
+    unsigned char *buffer = strm->stream.byte_buffer;
+    int ndx = 0;
+    cl_object l = strm->stream.byte_stack;
+    ndx = strm->stream.encoder(strm, buffer, c);
+    while (ndx != 0) l = CONS(ecl_make_fixnum(buffer[--ndx]), l);
+    strm->stream.byte_stack = l;
+  }
+}
+
+static void
+io_file_unread_byte(cl_object strm, cl_object byte)
+{
+  int ndx = strm->stream.byte_size/8;
+  cl_object l = strm->stream.byte_stack;
+  unsigned char *buffer = strm->stream.byte_buffer;
+  ecl_binary_unread_byte(strm, byte);
+  strm->stream.byte_encoder(strm, buffer, byte);
+  while (ndx != 0) l = CONS(ecl_make_fixnum(buffer[--ndx]), l);
+  strm->stream.byte_stack = l;
+}
+
+/**********************************************************************
+ * POSIX FILE STREAM
+ */
+
 static cl_index
 io_file_read_byte8(cl_object strm, unsigned char *c, cl_index n)
 {
@@ -372,7 +417,6 @@ static ecl_character io_file_decode_char_from_buffer(cl_object strm, unsigned ch
     /* Ugly handling of line breaks */
     if (crlf) {
       if (c == ECL_CHAR_CODE_LINEFEED) {
-        strm->stream.last_code[1] = c;
         c = ECL_CHAR_CODE_NEWLINE;
       }
       else {
@@ -381,18 +425,12 @@ static ecl_character io_file_decode_char_from_buffer(cl_object strm, unsigned ch
       }
     } else if (strm->stream.flags & ECL_STREAM_CR && c == ECL_CHAR_CODE_RETURN) {
       if (strm->stream.flags & ECL_STREAM_LF) {
-        strm->stream.last_code[0] = c;
         crlf = 1;
         goto AGAIN;
       }
       else
         c = ECL_CHAR_CODE_NEWLINE;
     }
-    if (!crlf) {
-      strm->stream.last_code[0] = c;
-      strm->stream.last_code[1] = EOF;
-    }
-    strm->stream.last_char = c;
     return c;
   } else {
     /* We need more bytes. First copy unconsumed bytes at the
@@ -558,15 +596,17 @@ io_file_truename(cl_object strm)
 }
 
 const struct ecl_file_ops io_file_ops = {
-  io_file_write_byte8,
   io_file_read_byte8,
+  io_file_write_byte8,
 
-  ecl_generic_write_byte,
+  ecl_binary_read_byte,
-  ecl_generic_read_byte,
+  ecl_binary_write_byte,
+  io_file_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_eformat_write_char,
-  ecl_eformat_unread_char,
+  io_file_unread_char,
   ecl_generic_peek_char,
 
   io_file_read_vector,
@@ -596,10 +636,12 @@ const struct ecl_file_ops io_file_ops = {
 };
 
 const struct ecl_file_ops output_file_ops = {
-  output_file_write_byte8,
   ecl_not_input_read_byte8,
+  output_file_write_byte8,
 
-  ecl_generic_write_byte,
+  ecl_not_input_read_byte,
+  ecl_binary_write_byte,
+  ecl_not_input_unread_byte,
   ecl_not_input_read_byte,
 
   ecl_not_input_read_char,
@@ -634,15 +676,17 @@ const struct ecl_file_ops output_file_ops = {
 };
 
 const struct ecl_file_ops input_file_ops = {
-  ecl_not_output_write_byte8,
   io_file_read_byte8,
+  ecl_not_output_write_byte8,
 
+  ecl_binary_read_byte,
   ecl_not_output_write_byte,
-  ecl_generic_read_byte,
+  io_file_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_not_output_write_char,
-  ecl_eformat_unread_char,
+  io_file_unread_char,
   ecl_generic_peek_char,
 
   io_file_read_vector,
@@ -940,15 +984,17 @@ io_stream_close(cl_object strm)
 #define io_stream_write_vector io_file_write_vector
 
 const struct ecl_file_ops io_stream_ops = {
-  io_stream_write_byte8,
   io_stream_read_byte8,
+  io_stream_write_byte8,
 
-  ecl_generic_write_byte,
+  ecl_binary_read_byte,
-  ecl_generic_read_byte,
+  ecl_binary_write_byte,
+  io_file_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_eformat_write_char,
-  ecl_eformat_unread_char,
+  io_file_unread_char,
   ecl_generic_peek_char,
 
   io_file_read_vector,
@@ -978,10 +1024,12 @@ const struct ecl_file_ops io_stream_ops = {
 };
 
 const struct ecl_file_ops output_stream_ops = {
-  output_stream_write_byte8,
   ecl_not_input_read_byte8,
+  output_stream_write_byte8,
 
-  ecl_generic_write_byte,
+  ecl_not_input_read_byte,
+  ecl_binary_write_byte,
+  ecl_not_input_unread_byte,
   ecl_not_input_read_byte,
 
   ecl_not_input_read_char,
@@ -1016,15 +1064,17 @@ const struct ecl_file_ops output_stream_ops = {
 };
 
 const struct ecl_file_ops input_stream_ops = {
-  ecl_not_output_write_byte8,
   input_stream_read_byte8,
+  ecl_not_output_write_byte8,
 
+  ecl_binary_read_byte,
   ecl_not_output_write_byte,
-  ecl_generic_read_byte,
+  io_file_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_not_output_write_char,
-  ecl_eformat_unread_char,
+  io_file_unread_char,
   ecl_generic_peek_char,
 
   io_file_read_vector,
@@ -1165,15 +1215,17 @@ winsock_stream_close(cl_object strm)
 }
 
 const struct ecl_file_ops winsock_stream_io_ops = {
-  winsock_stream_write_byte8,
   winsock_stream_read_byte8,
+  winsock_stream_write_byte8,
 
-  ecl_generic_write_byte,
+  ecl_binary_read_byte,
-  ecl_generic_read_byte,
+  ecl_binary_write_byte,
+  io_file_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_eformat_write_char,
-  ecl_eformat_unread_char,
+  io_file_unread_char,
   ecl_generic_peek_char,
 
   ecl_generic_read_vector,
@@ -1203,16 +1255,18 @@ const struct ecl_file_ops winsock_stream_io_ops = {
 };
 
 const struct ecl_file_ops winsock_stream_output_ops = {
-  winsock_stream_write_byte8,
   ecl_not_input_read_byte8,
+  winsock_stream_write_byte8,
 
-  ecl_generic_write_byte,
+  ecl_not_input_read_byte,
+  ecl_binary_write_byte,
+  ecl_not_input_unread_byte,
   ecl_not_input_read_byte,
 
   ecl_not_input_read_char,
   ecl_eformat_write_char,
   ecl_not_input_unread_char,
-  ecl_generic_peek_char,
+  ecl_not_input_read_char,
 
   ecl_generic_read_vector,
   ecl_generic_write_vector,
@@ -1241,15 +1295,17 @@ const struct ecl_file_ops winsock_stream_output_ops = {
 };
 
 const struct ecl_file_ops winsock_stream_input_ops = {
-  ecl_not_output_write_byte8,
   winsock_stream_read_byte8,
+  ecl_not_output_write_byte8,
 
+  ecl_binary_read_byte,
   ecl_not_output_write_byte,
-  ecl_generic_read_byte,
+  io_file_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_not_output_write_char,
-  ecl_eformat_unread_char,
+  io_file_unread_char,
   ecl_generic_peek_char,
 
   ecl_generic_read_vector,
@@ -1350,15 +1406,17 @@ wcon_stream_force_output(cl_object strm)
 }
 
 const struct ecl_file_ops wcon_stream_io_ops = {
-  wcon_stream_write_byte8,
   wcon_stream_read_byte8,
+  wcon_stream_write_byte8,
 
-  ecl_generic_write_byte,
+  ecl_binary_read_byte,
-  ecl_generic_read_byte,
+  ecl_binary_write_byte,
+  io_file_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_eformat_write_char,
-  ecl_eformat_unread_char,
+  io_file_unread_char,
   ecl_generic_peek_char,
 
   ecl_generic_read_vector,

src/c/streams/strm_sequence.d

@@ -18,21 +18,184 @@
 #define ECL_DEFINE_AET_SIZE
 #include <ecl/internal.h>
 
+/**********************************************************************
+ * Direct vector operations (no conversion, arbitrary element type).
+ */
+
+static cl_object
+seq_read_object(cl_object strm)
+{
+  cl_object vec = SEQ_STREAM_VECTOR(strm);
+  cl_fixnum pos = SEQ_STREAM_POSITION(strm);
+  if (pos < SEQ_INPUT_LIMIT(strm)) {
+    SEQ_STREAM_POSITION(strm)++;
+    return ecl_aref_unsafe(vec, pos);
+  }
+  return OBJNULL;
+}
+
+static cl_object
+seq_peek_object(cl_object strm)
+{
+  cl_object vec = SEQ_STREAM_VECTOR(strm);
+  cl_fixnum pos = SEQ_STREAM_POSITION(strm);
+  if (pos < SEQ_INPUT_LIMIT(strm)) {
+    return ecl_aref_unsafe(vec, pos);
+  }
+  return OBJNULL;
+}
+
+static void
+seq_write_object(cl_object strm, cl_object object)
+{
+  cl_object vec = SEQ_STREAM_VECTOR(strm);
+  cl_fixnum pos = SEQ_STREAM_POSITION(strm);
+  cl_fixnum dim = vec->vector.dim;
+ AGAIN:
+  if (pos >= dim) {
+    cl_object size = ecl_ash(ecl_make_fixnum(dim), 1);
+    SEQ_STREAM_VECTOR(strm) = vec = si_adjust_vector(vec, size);
+    goto AGAIN;
+  }
+  ecl_aset(vec, pos++, object);
+  if (vec->vector.fillp < pos)
+    vec->vector.fillp = pos;
+  SEQ_STREAM_POSITION(strm) = pos;
+}
+
+static void
+seq_unread_object(cl_object strm, cl_object object)
+{
+  unlikely_if (SEQ_STREAM_POSITION(strm) <= 0) {
+    ecl_unread_error(strm);
+  }
+  SEQ_STREAM_POSITION(strm)--;
+}
+
+/* -- Direct byte <- byte ------------------------------------------- */
+static cl_object
+byte_byte(cl_object byte)
+{
+  unlikely_if (byte != OBJNULL && Null(cl_integerp(byte))) {
+    FEwrong_type_argument(@[byte], byte);
+  }
+  return byte;
+}
+
+static cl_object
+seq_byte_read_byte(cl_object strm)
+{ return byte_byte(seq_read_object(strm)); }
+
+static cl_object
+seq_byte_peek_byte(cl_object strm)
+{ return byte_byte(seq_peek_object(strm)); }
+
+static void
+seq_byte_write_byte(cl_object strm, cl_object byte)
+{ seq_write_object(strm, byte_byte(byte)); }
+
+static void
+seq_byte_unread_byte(cl_object strm, cl_object byte)
+{ seq_unread_object(strm, byte_byte(byte)); }
+
+/* -- Direct char <- char ------------------------------------------- */
+static ecl_character
+char_char(cl_object byte)
+{
+  unlikely_if (byte != OBJNULL && !ECL_CHARACTERP(byte)) {
+    FEwrong_type_argument(@[char], byte);
+  }
+  return byte == OBJNULL ? EOF : ECL_CHAR_CODE(byte);
+}
+
+static ecl_character
+seq_char_read_char(cl_object strm)
+{ return char_char(seq_read_object(strm)); }
+
+static ecl_character
+seq_char_peek_char(cl_object strm)
+{ return char_char(seq_peek_object(strm)); }
+
+static ecl_character
+seq_char_write_char(cl_object strm, ecl_character c)
+{ seq_write_object(strm, ECL_CODE_CHAR(c)); return c; }
+
+static void
+seq_char_unread_char(cl_object strm, ecl_character c)
+{ seq_unread_object(strm, ECL_CODE_CHAR(c)); }
+
+/* -- Direct byte <- char ------------------------------------------- */
+static cl_object
+byte_char(cl_object byte)
+{
+  unlikely_if (byte != OBJNULL && !ECL_CHARACTERP(byte)) {
+    FEwrong_type_argument(@[char], byte);
+  }
+  return byte == OBJNULL ? OBJNULL : cl_char_code(byte);
+}
+
+static cl_object
+seq_char_read_byte(cl_object strm)
+{ return byte_char(seq_read_object(strm)); }
+
+static cl_object
+seq_char_peek_byte(cl_object strm)
+{ return byte_char(seq_peek_object(strm)); }
+
+static void
+seq_char_write_byte(cl_object strm, cl_object byte)
+{ seq_write_object(strm, cl_code_char(byte)); }
+
+static void
+seq_char_unread_byte(cl_object strm, cl_object byte)
+{ seq_unread_object(strm, cl_code_char(byte)); }
+
+/* -- Direct char <- byte ------------------------------------------- */
+static ecl_character
+char_byte(cl_object byte)
+{
+  unlikely_if (byte != OBJNULL && Null(cl_integerp(byte))) {
+    FEwrong_type_argument(@[byte], byte);
+  }
+  /* INV cl_code_char can return NIL for bytes outside of the char range.
+     ecl_char_code will signal a condition then. */
+  return byte == OBJNULL ? EOF : ecl_char_code(cl_code_char(byte));
+}
+
+static ecl_character
+seq_byte_read_char(cl_object strm)
+{ return char_byte(seq_read_object(strm)); }
+
+static ecl_character
+seq_byte_peek_char(cl_object strm)
+{ return char_byte(seq_peek_object(strm)); }
+
+static ecl_character
+seq_byte_write_char(cl_object strm, ecl_character c)
+{ seq_write_object(strm, cl_char_code(ECL_CODE_CHAR(c))); return c; }
+
+static void
+seq_byte_unread_char(cl_object strm, ecl_character c)
+{ seq_unread_object(strm, cl_char_code(ECL_CODE_CHAR(c))); }
+
 /**********************************************************************
  * SEQUENCE INPUT STREAMS
  */
 
+/* Keep in mind that this function assumes that the element type is the octet
+   (we'd need to factor the byte size to the change position and test limit),
+   and that for :ucs-2 and :ucs-4 .byte_buffer is NULL. -- jd 2025-07-29 */
 static cl_index
 seq_in_read_byte8(cl_object strm, unsigned char *c, cl_index n)
 {
-  cl_fixnum curr_pos = SEQ_INPUT_POSITION(strm);
+  cl_fixnum curr_pos = SEQ_STREAM_POSITION(strm);
   cl_fixnum last = SEQ_INPUT_LIMIT(strm);
   cl_fixnum delta = last - curr_pos;
   if (delta > 0) {
-    cl_object vector = SEQ_INPUT_VECTOR(strm);
+    cl_object vector = SEQ_STREAM_VECTOR(strm);
     if (delta > n) delta = n;
     ecl_copy(c, vector->vector.self.bc + curr_pos, delta);
-    SEQ_INPUT_POSITION(strm) += delta;
+    SEQ_STREAM_POSITION(strm) += delta;
     return delta;
   }
   return 0;
@@ -41,21 +204,35 @@ seq_in_read_byte8(cl_object strm, unsigned char *c, cl_index n)
 static void
 seq_in_unread_char(cl_object strm, ecl_character c)
 {
+  int flags = strm->stream.flags;
   ecl_eformat_unread_char(strm, c);
-  SEQ_INPUT_POSITION(strm) -= ecl_length(strm->stream.byte_stack);
+  if (c == ECL_CHAR_CODE_NEWLINE
-  strm->stream.byte_stack = ECL_NIL;
+      && (flags & ECL_STREAM_CR)
+      && (flags & ECL_STREAM_LF))
+    SEQ_STREAM_POSITION(strm) -= 2;
+  else
+    SEQ_STREAM_POSITION(strm) -= 1;
+}
+
+static void
+seq_in_unread_byte(cl_object strm, cl_object byte)
+{
+  unlikely_if(SEQ_STREAM_POSITION(strm) <= 0) {
+    ecl_unread_error(strm);
+  }
+  SEQ_STREAM_POSITION(strm) -= 1;
 }
 
 #ifdef ecl_uint16_t
 static ecl_character
 seq_in_ucs2_read_char(cl_object strm)
 {
-  cl_fixnum curr_pos = SEQ_INPUT_POSITION(strm);
+  cl_fixnum curr_pos = SEQ_STREAM_POSITION(strm);
   cl_fixnum last = SEQ_INPUT_LIMIT(strm);
   if (curr_pos >= last) {
     return EOF;
   }
-  cl_object vector = SEQ_INPUT_VECTOR(strm);
+  cl_object vector = SEQ_STREAM_VECTOR(strm);
   ecl_character c = vector->vector.self.b16[curr_pos++];
   cl_object err;
   if (c >= 0xD800 && c <= 0xDBFF) {
@@ -70,7 +247,7 @@ seq_in_ucs2_read_char(cl_object strm)
     }
     c = ((c & 0x3FF) << 10) + (aux & 0x3FF) + 0x10000;
   }
-  SEQ_INPUT_POSITION(strm) = curr_pos;
+  SEQ_STREAM_POSITION(strm) = curr_pos;
   return c;
   cl_object code;
  DECODING_ERROR:
@@ -90,9 +267,9 @@ static void
 seq_in_ucs2_unread_char(cl_object strm, ecl_character c)
 {
   if (c >= 0x10000) {
-    SEQ_INPUT_POSITION(strm) -= 2;
+    SEQ_STREAM_POSITION(strm) -= 2;
   } else {
-    SEQ_INPUT_POSITION(strm) -= 1;
+    SEQ_STREAM_POSITION(strm) -= 1;
   }
 }
 #endif
@@ -101,26 +278,26 @@ seq_in_ucs2_unread_char(cl_object strm, ecl_character c)
 static ecl_character
 seq_in_ucs4_read_char(cl_object strm)
 {
-  cl_fixnum curr_pos = SEQ_INPUT_POSITION(strm);
+  cl_fixnum curr_pos = SEQ_STREAM_POSITION(strm);
   if (curr_pos >= SEQ_INPUT_LIMIT(strm)) {
     return EOF;
   }
-  cl_object vector = SEQ_INPUT_VECTOR(strm);
+  cl_object vector = SEQ_STREAM_VECTOR(strm);
-  SEQ_INPUT_POSITION(strm) += 1;
+  SEQ_STREAM_POSITION(strm) += 1;
   return vector->vector.self.b32[curr_pos];
 }
 
 static void
 seq_in_ucs4_unread_char(cl_object strm, ecl_character c)
 {
-  SEQ_INPUT_POSITION(strm) -= 1;
+  SEQ_STREAM_POSITION(strm) -= 1;
 }
 #endif
 
 static int
 seq_in_listen(cl_object strm)
 {
-  if (SEQ_INPUT_POSITION(strm) < SEQ_INPUT_LIMIT(strm))
+  if (SEQ_STREAM_POSITION(strm) < SEQ_INPUT_LIMIT(strm))
     return ECL_LISTEN_AVAILABLE;
   else
     return ECL_LISTEN_EOF;
@@ -129,7 +306,7 @@ seq_in_listen(cl_object strm)
 static cl_object
 seq_in_get_position(cl_object strm)
 {
-  return ecl_make_unsigned_integer(SEQ_INPUT_POSITION(strm));
+  return ecl_make_unsigned_integer(SEQ_STREAM_POSITION(strm));
 }
 
 static cl_object
@@ -144,7 +321,7 @@ seq_in_set_position(cl_object strm, cl_object pos)
       disp = SEQ_INPUT_LIMIT(strm);
     }
   }
-  SEQ_INPUT_POSITION(strm) = disp;
+  SEQ_STREAM_POSITION(strm) = disp;
   return ECL_T;
 }
 
@@ -155,11 +332,13 @@ seq_file_element_type(cl_object strm)
 }
 
 const struct ecl_file_ops seq_in_ops = {
-  ecl_not_output_write_byte8,
   seq_in_read_byte8,
+  ecl_not_output_write_byte8,
 
+  ecl_binary_read_byte,
   ecl_not_output_write_byte,
-  ecl_generic_read_byte,
+  seq_in_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_eformat_read_char,
   ecl_not_output_write_char,
@@ -206,6 +385,7 @@ make_sequence_input_stream(cl_object vector, cl_index istart, cl_index iend,
   }
   type = ecl_array_elttype(vector);
   type_name = ecl_elttype_to_symbol(type);
+  /* ecl_normalize_stream_element_type errors on illegal element type. */
   byte_size = ecl_normalize_stream_element_type(type_name);
   /* Character streams always get some external format. For binary
    * sequences it has to be explicitly mentioned. */
@@ -215,35 +395,70 @@ make_sequence_input_stream(cl_object vector, cl_index istart, cl_index iend,
   if (!byte_size && Null(external_format)) {
     external_format = @':default';
   }
-  if (ecl_aet_size[type] == 1) {
+  if (ecl_aet_size[type] == 1 && !Null(external_format)) {
     ecl_set_stream_elt_type(strm, byte_size, flags, external_format);
     /* Override byte size */
     if (byte_size) strm->stream.byte_size = 8;
   }
 #ifdef ecl_uint16_t
   else if (ecl_aet_size[type] == 2 && external_format == @':ucs-2') {
-    IO_STREAM_ELT_TYPE(strm) = @'character';
+    SEQ_STREAM_ELT_TYPE(strm) = @'character';
     strm->stream.format = @':ucs-2';
     strm->stream.byte_size = 2*8;
+    /* decoding */
     strm->stream.ops->read_char = seq_in_ucs2_read_char;
     strm->stream.ops->unread_char = seq_in_ucs2_unread_char;
+    /* identity */
+    strm->stream.ops->read_byte = seq_byte_read_byte;
+    strm->stream.ops->peek_byte = seq_byte_peek_byte;
+    strm->stream.ops->unread_byte = seq_byte_unread_byte;
   }
 #endif
 #ifdef ecl_uint32_t
   else if (ecl_aet_size[type] == 4 && external_format == @':ucs-4') {
-    IO_STREAM_ELT_TYPE(strm) = @'character';
+    SEQ_STREAM_ELT_TYPE(strm) = @'character';
     strm->stream.format = @':ucs-4';
     strm->stream.byte_size = 4*8;
+    /* decoding */
     strm->stream.ops->read_char = seq_in_ucs4_read_char;
     strm->stream.ops->unread_char = seq_in_ucs4_unread_char;
+    /* identity */
+    strm->stream.ops->read_byte = seq_byte_read_byte;
+    strm->stream.ops->peek_byte = seq_byte_peek_byte;
+    strm->stream.ops->unread_byte = seq_byte_unread_byte;
   }
 #endif
-  else {
+  else if(!byte_size && external_format == @':default') {
-    FEerror("Illegal combination of external-format ~A and input vector ~A for MAKE-SEQUENCE-INPUT-STREAM.~%", 2, external_format, vector);
+    /* char vector -> native bivalent stream */
+    SEQ_STREAM_ELT_TYPE(strm) = @'character';
+    /* identity */
+    strm->stream.ops->read_char = seq_char_read_char;
+    strm->stream.ops->peek_char = seq_char_peek_char;
+    strm->stream.ops->unread_char = seq_char_unread_char;
+    /* char-code */
+    strm->stream.ops->read_byte = seq_char_read_byte;
+    strm->stream.ops->peek_byte = seq_char_peek_byte;
+    strm->stream.ops->unread_byte = seq_char_unread_byte;
   }
-  SEQ_INPUT_VECTOR(strm) = vector;
+  else if(Null(external_format)) {
-  SEQ_INPUT_POSITION(strm) = istart;
+    /* byte vector -> native bivalent stream */
-  SEQ_INPUT_LIMIT(strm) = iend;
+    ecl_set_stream_elt_type(strm, byte_size, flags, external_format);
+    /* code-char */
+    strm->stream.ops->read_char = seq_byte_read_char;
+    strm->stream.ops->peek_char = seq_byte_peek_char;
+    strm->stream.ops->unread_char = seq_byte_unread_char;
+    /* identity */
+    strm->stream.ops->read_byte = seq_byte_read_byte;
+    strm->stream.ops->peek_byte = seq_byte_peek_byte;
+    strm->stream.ops->unread_byte = seq_byte_unread_byte;
+  }
+  else {
+    FEerror("Illegal combination of external-format ~A and input vector ~A "
+            "for MAKE-SEQUENCE-INPUT-STREAM.~%", 2, external_format, vector);
+  }
+  SEQ_STREAM_VECTOR(strm) = vector;
+  SEQ_STREAM_POSITION(strm) = istart;
+  SEQ_INPUT_VECTOR_END(strm) = iend;
   return strm;
 }
 
@@ -252,11 +467,15 @@ make_sequence_input_stream(cl_object vector, cl_index istart, cl_index iend,
                                          (end ECL_NIL)
                                          (external_format ECL_NIL))
   cl_index_pair p;
+  cl_object strm;
   @
   p = ecl_vector_start_end(@[ext::make-sequence-input-stream],
                            vector, start, end);
-  @(return make_sequence_input_stream(vector, p.start, p.end,
+  strm = make_sequence_input_stream(vector, p.start, p.end,
-                                      external_format))
+                                    external_format);
+  if (Null(end))
+    strm->stream.flags |= ECL_STREAM_USE_VECTOR_FILLP;
+  @(return strm)
   @)
 
 /**********************************************************************
@@ -266,18 +485,21 @@ make_sequence_input_stream(cl_object vector, cl_index istart, cl_index iend,
 static void
 seq_out_enlarge_vector(cl_object strm)
 {
-  cl_object vector = SEQ_OUTPUT_VECTOR(strm);
+  cl_object vector = SEQ_STREAM_VECTOR(strm);
   si_adjust_vector(vector, ecl_ash(ecl_make_fixnum(vector->vector.dim), 1));
-  SEQ_OUTPUT_VECTOR(strm) = vector;
+  SEQ_STREAM_VECTOR(strm) = vector;
 }
 
+/* Keep in mind that this function assumes that the element type is the octet
+   (we'd need to factor the byte size to the change position and test limit),
+   and that for :ucs-2 and :ucs-4 .byte_buffer is NULL. -- jd 2025-07-29 */
 static cl_index
 seq_out_write_byte8(cl_object strm, unsigned char *c, cl_index n)
 {
  AGAIN:
   {
-    cl_object vector = SEQ_OUTPUT_VECTOR(strm);
+    cl_object vector = SEQ_STREAM_VECTOR(strm);
-    cl_fixnum curr_pos = SEQ_OUTPUT_POSITION(strm);
+    cl_fixnum curr_pos = SEQ_STREAM_POSITION(strm);
     cl_fixnum last = vector->vector.dim;
     cl_fixnum delta = last - curr_pos;
     if (delta < n) {
@@ -285,7 +507,7 @@ seq_out_write_byte8(cl_object strm, unsigned char *c, cl_index n)
       goto AGAIN;
     }
     ecl_copy(vector->vector.self.bc + curr_pos, c, n);
-    SEQ_OUTPUT_POSITION(strm) = curr_pos += n;
+    SEQ_STREAM_POSITION(strm) = curr_pos += n;
     if (vector->vector.fillp < curr_pos)
       vector->vector.fillp = curr_pos;
   }
@@ -298,8 +520,8 @@ seq_out_ucs2_write_char(cl_object strm, ecl_character c)
 {
  AGAIN:
   {
-    cl_object vector = SEQ_OUTPUT_VECTOR(strm);
+    cl_object vector = SEQ_STREAM_VECTOR(strm);
-    cl_fixnum curr_pos = SEQ_OUTPUT_POSITION(strm);
+    cl_fixnum curr_pos = SEQ_STREAM_POSITION(strm);
     cl_fixnum n = (c >= 0x10000) ? 2 : 1;
     if (vector->vector.dim - curr_pos < n) {
       seq_out_enlarge_vector(strm);
@@ -312,7 +534,7 @@ seq_out_ucs2_write_char(cl_object strm, ecl_character c)
     } else {
       vector->vector.self.b16[curr_pos++] = c;
     }
-    SEQ_OUTPUT_POSITION(strm) = curr_pos;
+    SEQ_STREAM_POSITION(strm) = curr_pos;
     if (vector->vector.fillp < curr_pos)
       vector->vector.fillp = curr_pos;
   }
@@ -326,14 +548,14 @@ seq_out_ucs4_write_char(cl_object strm, ecl_character c)
 {
  AGAIN:
   {
-    cl_object vector = SEQ_OUTPUT_VECTOR(strm);
+    cl_object vector = SEQ_STREAM_VECTOR(strm);
-    cl_fixnum curr_pos = SEQ_OUTPUT_POSITION(strm);
+    cl_fixnum curr_pos = SEQ_STREAM_POSITION(strm);
     if (vector->vector.dim - curr_pos < 1) {
       seq_out_enlarge_vector(strm);
       goto AGAIN;
     }
     vector->vector.self.b32[curr_pos++] = c;
-    SEQ_OUTPUT_POSITION(strm) = curr_pos;
+    SEQ_STREAM_POSITION(strm) = curr_pos;
     if (vector->vector.fillp < curr_pos)
       vector->vector.fillp = curr_pos;
   }
@@ -344,13 +566,13 @@ seq_out_ucs4_write_char(cl_object strm, ecl_character c)
 static cl_object
 seq_out_get_position(cl_object strm)
 {
-  return ecl_make_unsigned_integer(SEQ_OUTPUT_POSITION(strm));
+  return ecl_make_unsigned_integer(SEQ_STREAM_POSITION(strm));
 }
 
 static cl_object
 seq_out_set_position(cl_object strm, cl_object pos)
 {
-  cl_object vector = SEQ_OUTPUT_VECTOR(strm);
+  cl_object vector = SEQ_STREAM_VECTOR(strm);
   cl_fixnum disp;
   if (Null(pos)) {
     disp = vector->vector.fillp;
@@ -360,16 +582,18 @@ seq_out_set_position(cl_object strm, cl_object pos)
       disp = vector->vector.fillp;
     }
   }
-  SEQ_OUTPUT_POSITION(strm) = disp;
+  SEQ_STREAM_POSITION(strm) = disp;
   return ECL_T;
 }
 
 const struct ecl_file_ops seq_out_ops = {
-  seq_out_write_byte8,
   ecl_not_input_read_byte8,
+  seq_out_write_byte8,
 
-  ecl_generic_write_byte,
   ecl_not_input_read_byte,
+  ecl_binary_write_byte,
+  ecl_not_input_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_not_input_read_char,
   ecl_eformat_write_char,
@@ -415,6 +639,7 @@ make_sequence_output_stream(cl_object vector, cl_object external_format)
   }
   type = ecl_array_elttype(vector);
   type_name = ecl_elttype_to_symbol(type);
+  /* ecl_normalize_stream_element_type errors on illegal element type. */
   byte_size = ecl_normalize_stream_element_type(type_name);
   /* Character streams always get some external format. For binary
    * sequences it has to be explicitly mentioned. */
@@ -424,32 +649,48 @@ make_sequence_output_stream(cl_object vector, cl_object external_format)
   if (!byte_size && Null(external_format)) {
     external_format = @':default';
   }
-  if (ecl_aet_size[type] == 1) {
+  if (ecl_aet_size[type] == 1 && !Null(external_format)) {
+    /* If elements of the stream are byte8, then we can convert them on fly. */
     ecl_set_stream_elt_type(strm, byte_size, flags, external_format);
     /* Override byte size */
     if (byte_size) strm->stream.byte_size = 8;
   }
 #ifdef ecl_uint16_t
   else if (ecl_aet_size[type] == 2 && external_format == @':ucs-2') {
-    IO_STREAM_ELT_TYPE(strm) = @'character';
+    SEQ_STREAM_ELT_TYPE(strm) = @'character';
     strm->stream.format = @':ucs-2';
     strm->stream.byte_size = 2*8;
     strm->stream.ops->write_char = seq_out_ucs2_write_char;
+    strm->stream.ops->write_byte = seq_byte_write_byte;
   }
 #endif
 #ifdef ecl_uint32_t
   else if (ecl_aet_size[type] == 4 && external_format == @':ucs-4') {
-    IO_STREAM_ELT_TYPE(strm) = @'character';
+    SEQ_STREAM_ELT_TYPE(strm) = @'character';
     strm->stream.format = @':ucs-4';
     strm->stream.byte_size = 4*8;
     strm->stream.ops->write_char = seq_out_ucs4_write_char;
+    strm->stream.ops->write_byte = seq_byte_write_byte;
   }
 #endif
-  else {
+  else if(!byte_size && external_format == @':default') {
-    FEerror("Illegal combination of external-format ~A and output vector ~A for MAKE-SEQUENCE-OUTPUT-STREAM.~%", 2, external_format, vector);
+    /* char vector -> native bivalent stream */
+    SEQ_STREAM_ELT_TYPE(strm) = @'character';
+    strm->stream.ops->write_char = seq_char_write_char;
+    strm->stream.ops->write_byte = seq_char_write_byte;
   }
-  SEQ_OUTPUT_VECTOR(strm) = vector;
+  else if(Null(external_format)) {
-  SEQ_OUTPUT_POSITION(strm) = vector->vector.fillp;
+    /* byte vector -> native bivalent stream */
+    ecl_set_stream_elt_type(strm, byte_size, flags, external_format);
+    strm->stream.ops->write_char = seq_byte_write_char;
+    strm->stream.ops->write_byte = seq_byte_write_byte;
+  }
+  else {
+    FEerror("Illegal combination of external-format ~A and output vector ~A "
+            "for MAKE-SEQUENCE-OUTPUT-STREAM.~%", 2, external_format, vector);
+  }
+  SEQ_STREAM_VECTOR(strm) = vector;
+  SEQ_STREAM_POSITION(strm) = vector->vector.fillp;
   return strm;
 }
 
@@ -580,7 +821,7 @@ si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e)
           c = ECL_CODE_CHAR(i);
         } else {
           c = ops->read_byte(stream);
-          if (c == ECL_NIL) goto OUTPUT;
+          if (c == OBJNULL) goto OUTPUT;
         }
         ECL_RPLACA(seq, c);
         start++;

src/c/streams/strm_string.d

@@ -84,11 +84,13 @@ str_out_set_position(cl_object strm, cl_object pos)
 }
 
 const struct ecl_file_ops str_out_ops = {
-  ecl_not_output_write_byte8,
   ecl_not_binary_read_byte8,
+  ecl_not_output_write_byte8,
 
-  ecl_not_binary_write_byte,
   ecl_not_input_read_byte,
+  ecl_not_binary_write_byte,
+  ecl_not_input_unread_byte,
+  ecl_generic_peek_byte,
 
   ecl_not_input_read_char,
   str_out_write_char,
@@ -219,7 +221,7 @@ static void
 str_in_unread_char(cl_object strm, ecl_character c)
 {
   cl_fixnum curr_pos = STRING_INPUT_POSITION(strm);
-  unlikely_if (c <= 0) {
+  unlikely_if (curr_pos <= 0) {
     ecl_unread_error(strm);
   }
   STRING_INPUT_POSITION(strm) = curr_pos - 1;
@@ -277,10 +279,12 @@ str_in_set_position(cl_object strm, cl_object pos)
 }
 
 const struct ecl_file_ops str_in_ops = {
-  ecl_not_output_write_byte8,
   ecl_not_binary_read_byte8,
+  ecl_not_output_write_byte8,
 
+  ecl_not_binary_read_byte,
   ecl_not_output_write_byte,
+  ecl_not_binary_write_byte,
   ecl_not_binary_read_byte,
 
   str_in_read_char,

src/c/symbols_list.h

@@ -748,6 +748,7 @@ cl_symbols[] = {
 {"PATHNAME-TYPE" ECL_FUN("cl_pathname_type", cl_pathname_type, -2) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"PATHNAME-VERSION" ECL_FUN("cl_pathname_version", cl_pathname_version, 1) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"PATHNAMEP" ECL_FUN("cl_pathnamep", cl_pathnamep, 1) ECL_VAR(CL_ORDINARY, OBJNULL)},
+{EXT_ "PEEK-BYTE" ECL_FUN("si_peek_byte", si_peek_byte, 2) ECL_VAR(EXT_ORDINARY, OBJNULL)},
 {"PEEK-CHAR" ECL_FUN("cl_peek_char", cl_peek_char, -1) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"PHASE" ECL_FUN("cl_phase", ECL_NAME(cl_phase), 1) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"PI" ECL_FUN(NULL, NULL, -1) ECL_VAR(CL_CONSTANT, ECL_PI)},
@@ -993,6 +994,7 @@ cl_symbols[] = {
 {"UNINTERN" ECL_FUN("cl_unintern", cl_unintern, -2) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"UNION" ECL_FUN("cl_union", ECL_NAME(cl_union), -3) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"UNLESS" ECL_FUN(NULL, NULL, -1) ECL_VAR(CL_FORM, OBJNULL)},
+{EXT_ "UNREAD-BYTE" ECL_FUN("si_unread_byte", si_unread_byte, 2) ECL_VAR(EXT_ORDINARY, OBJNULL)},
 {"UNREAD-CHAR" ECL_FUN("cl_unread_char", cl_unread_char, -2) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"UNSIGNED-BYTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(CL_ORDINARY, OBJNULL)},
 {"UNTRACE" ECL_FUN(NULL, NULL, -1) ECL_VAR(CL_ORDINARY, OBJNULL)},
@@ -1869,6 +1871,7 @@ cl_symbols[] = {
 {GRAY_ "STREAM-LINE-COLUMN" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-LINE-LENGTH" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-LISTEN" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
+{GRAY_ "STREAM-PEEK-BYTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-PEEK-CHAR" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-READ-BYTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-READ-CHAR" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
@@ -1877,6 +1880,7 @@ cl_symbols[] = {
 {GRAY_ "STREAM-READ-SEQUENCE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-START-LINE-P" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-TERPRI" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
+{GRAY_ "STREAM-UNREAD-BYTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-UNREAD-CHAR" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-WRITE-BYTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
 {GRAY_ "STREAM-WRITE-CHAR" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},

src/clos/streams.lsp

@@ -95,7 +95,6 @@
   (:documentation "Return the stream line length or NIL."))
 
 (defgeneric stream-listen (stream)
-  #+sb-doc
   (:documentation
    "This is used by LISTEN. It returns true or false. The default method uses
   STREAM-READ-CHAR-NO-HANG and STREAM-UNREAD-CHAR. Most streams should
@@ -111,6 +110,13 @@
 (defgeneric output-stream-p (stream)
   (:documentation "Can STREAM perform output operations?"))
 
+;;; Extension
+(defgeneric stream-peek-byte (stream)
+  (:documentation
+   "This is used to implement EXT:PEEK-BYTE.
+  It returns either a byte or :EOF. The default method calls STREAM-READ-BYTE
+  and STREAM-UNREAD-BYTE."))
+
 (defgeneric stream-peek-char (stream)
   (:documentation
    "This is used to implement PEEK-CHAR; this corresponds to PEEK-TYPE of NIL.
@@ -169,6 +175,13 @@
    "Writes an end of line, as for TERPRI. Returns NIL. The default
   method does (STREAM-WRITE-CHAR stream #\NEWLINE)."))
 
+;;; Extension
+(defgeneric stream-unread-byte (stream byte)
+  (:documentation
+   "Un-do the last call to STREAM-READ-BYTE, as in EXT:UNREAD-BYTE.
+  Return NIL. Every subclass of FUNDAMENTAL-BINARY-INPUT-STREAM
+  must define a method for this function."))
+
 (defgeneric stream-unread-char (stream character)
   (:documentation
    "Un-do the last call to STREAM-READ-CHAR, as in UNREAD-CHAR.
@@ -477,6 +490,19 @@
 (defmethod output-stream-p ((stream t))
   (bug-or-error stream 'output-stream-p))
 
+;; PEEK-BYTE
+
+(defmethod stream-peek-byte ((stream fundamental-binary-input-stream))
+  (let ((byte (stream-read-byte stream)))
+    (unless (eq byte :eof)
+      (stream-unread-byte stream byte))
+    byte))
+
+(defmethod stream-peek-byte ((stream ansi-stream))
+  (ext:peek-byte stream :eof))
+
+(defmethod stream-peek-byte ((stream t))
+  (bug-or-error stream 'stream-peek-byte))
 
 ;; PEEK-CHAR
 
@@ -510,13 +536,21 @@
 (defmethod stream-read-char ((stream t))
   (bug-or-error stream 'stream-read-char))
 
+;; UNREAD-BYTE
+
+(defmethod stream-unread-byte ((stream ansi-stream) byte)
+  (ext:unread-byte stream byte))
+
+(defmethod stream-unread-byte ((stream t) byte)
+  (declare (ignore byte))
+  (bug-or-error stream 'stream-unread-byte))
 
 ;; UNREAD-CHAR
 
 (defmethod stream-unread-char ((stream ansi-stream) character)
   (cl:unread-char character stream))
 
-(defmethod stream-unread-char ((stream ansi-stream) character)
+(defmethod stream-unread-char ((stream t) character)
   (declare (ignore character))
   (bug-or-error stream 'stream-unread-char))
 

src/cmp/proclamations.lsp

@@ -1130,6 +1130,8 @@
 (proclamation streamp (t) gen-bool :pure)
 (proclamation read-byte (stream &optional gen-bool t) t)
 (proclamation write-byte (integer stream) integer)
+(proclamation ext:unread-byte (stream integer) null)
+(proclamation ext:peek-byte (stream t) t)
 (proclamation peek-char (&optional (or character boolean)
                                    stream-designator
                                    gen-bool

src/doc/manual/developer-guide/objects.txi

@@ -711,8 +711,6 @@ Buffer for unread bytes.
 File column.
 @item cl_fixnum last_char
 Last character read.
-@item cl_fixnum last_code[2]
-Actual composition of the last character.
 @item cl_fixnum int0 int1
 Some integers (may be used for a specific implementation purposes).
 @item cl_index byte_size

src/doc/manual/extensions/gray-streams.txi

@@ -59,3 +59,17 @@ modification. The default method calls @code{stream-write-char} or
 @code{stream-element-type}. Element access to the sequence is done via
 @code{elt}.
 @end defun
+
+@subsection Gray Stream Extensions
+
+@defun {stream-unread-byte} stream byte
+Un-do the last call to @code{stream-read-byte}, as in @code{ext:unread-byte}.
+Return @code{nil}. Every subclass of @code{fundamental-binary-input-stream}
+should define a method for this function. A default method signals an error.
+@end defun
+
+@defun {stream-peek-byte} stream
+This is used to implement @code{ext:peek-byte}. It returns either a byte
+or @code{:eof}. A default method calls @code{stream-read-byte} and
+@code{stream-unread-byte}.
+@end defun

src/doc/manual/standards/streams.txi

@@ -150,6 +150,20 @@ happen.
 Return the POSIX file descriptor of @var{file-stream} as an integer
 @end defun
 
+@subsubsection Binary Stream Extensions
+
+@lspdef ext:unread-byte
+@defun ext:unread-byte stream byte
+Similar to @code{unread-char} but for unreading the last element to the
+input binary stream. See also @code{gray:stream-unread-byte}.
+@end defun
+
+@lspdef ext:peek-byte
+@defun ext:peek-byte stream eof-value
+Similar to @code{peek-char} but for peeking the next element from the
+output binary stream. See also @code{gray:stream-peek-byte}.
+@end defun
+
 @subsubsection External Format Extensions
 
 @lspdef ext:*default-external-format*
@@ -304,6 +318,9 @@ bytes comprising the character in the given external format.
 @defun ext:make-sequence-input-stream vector &key (start 0) (end nil) (external-format nil)
 Create a sequence input stream with the subsequence bounded by
 @var{start} and @var{end} of the given vector.
+
+When @var{end} is @code{nil}, then the end bound is the vector's length.
+When the vector is adjusted the end bound is updated as well.
 @end defun
 @lspdef ext:make-sequence-output-stream
 @defun ext:make-sequence-output-stream vector &key (external-format nil)

src/h/external.h

@@ -690,6 +690,10 @@ extern ECL_API cl_object ecl_null_terminated_base_string(cl_object s);
 extern ECL_API cl_object ecl_foreign_data_ref_elt(void *p, enum ecl_ffi_tag type);
 extern ECL_API void ecl_foreign_data_set_elt(void *p, enum ecl_ffi_tag type, cl_object value);
 
+/* stream.c */
+cl_object si_unread_byte(cl_object strm, cl_object byte);
+cl_object si_peek_byte(cl_object strm, cl_object eof_value);
+
 /* file.c */
 
 #define ECL_LISTEN_NO_CHAR      0
@@ -747,6 +751,8 @@ extern ECL_API cl_object ecl_make_string_input_stream(cl_object strng, cl_index
 extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length, int extended);
 extern ECL_API cl_object ecl_read_byte(cl_object strm);
 extern ECL_API void ecl_write_byte(cl_object byte, cl_object strm);
+extern ECL_API void ecl_unread_byte(cl_object byte, cl_object strm);
+extern ECL_API cl_object ecl_peek_byte(cl_object strm);
 extern ECL_API ecl_character ecl_read_char_noeof(cl_object strm);
 extern ECL_API ecl_character ecl_read_char(cl_object strm);
 extern ECL_API void ecl_unread_char(ecl_character c, cl_object strm);

src/h/internal.h

@@ -401,7 +401,7 @@ cl_object si_peek_char(cl_object strm, cl_object eof_value);
 cl_object si_write_char(cl_object strm, cl_object c);
 
 cl_object si_read_byte(cl_object strm, cl_object eof_value);
-cl_object si_unread_byte(cl_object strm, cl_object eof_value);
+cl_object si_unread_byte(cl_object strm, cl_object byte);
 cl_object si_peek_byte(cl_object strm, cl_object eof_value);
 cl_object si_write_byte(cl_object strm, cl_object c);
 
@@ -411,8 +411,8 @@ cl_object si_finish_output(cl_object strm);
 cl_object si_force_output(cl_object strm);
 cl_object si_clear_output(cl_object strm);
 
-#define ecl_unread_error(s) FEerror("Error when using UNREAD-CHAR on stream ~D", 1, s)
+#define ecl_unread_error(s) FEerror("Error when unreading to stream ~D", 1, s)
-#define ecl_unread_twice(s) FEerror("Used UNREAD-CHAR twice on stream ~D", 1, s);
+#define ecl_unread_twice(s) FEerror("Unread twice twice to stream ~D", 1, s)
 
 /* streams/strm_common.d */
 cl_object ecl_not_a_file_stream(cl_object strm);
@@ -425,6 +425,7 @@ void ecl_not_output_write_byte(cl_object strm, cl_object byte);
 cl_object ecl_not_input_read_byte(cl_object strm);
 void ecl_not_binary_write_byte(cl_object strm, cl_object byte);
 cl_object ecl_not_binary_read_byte(cl_object strm);
+void ecl_not_input_unread_byte(cl_object strm, cl_object byte);
 ecl_character ecl_not_input_read_char(cl_object strm);
 ecl_character ecl_not_output_write_char(cl_object strm, ecl_character c);
 void ecl_not_input_unread_char(cl_object strm, ecl_character c);
@@ -441,14 +442,7 @@ cl_object ecl_not_output_string_length(cl_object strm, cl_object string);
 cl_object ecl_not_file_string_length(cl_object strm, cl_object string);
 int ecl_unknown_column(cl_object strm);
 
-cl_object ecl_generic_read_byte_unsigned8(cl_object strm);
+cl_object ecl_generic_peek_byte(cl_object strm);
-void ecl_generic_write_byte_unsigned8(cl_object byte, cl_object strm);
-cl_object ecl_generic_read_byte_signed8(cl_object strm);
-void ecl_generic_write_byte_signed8(cl_object byte, cl_object strm);
-cl_object ecl_generic_read_byte_le(cl_object strm);
-void ecl_generic_write_byte_le(cl_object c, cl_object strm);
-cl_object ecl_generic_read_byte(cl_object strm);
-void ecl_generic_write_byte(cl_object c, cl_object strm);
 ecl_character ecl_generic_peek_char(cl_object strm);
 void ecl_generic_void(cl_object strm);
 int ecl_generic_always_true(cl_object strm);
@@ -460,6 +454,20 @@ cl_object ecl_generic_close(cl_object strm);
 cl_index ecl_generic_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end);
 cl_index ecl_generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end);
 
+/* streams/strm_binary.d */
+cl_object ecl_binary_read_byte(cl_object strm);
+void ecl_binary_write_byte(cl_object c, cl_object strm);
+void ecl_binary_unread_byte(cl_object strm, cl_object byte);
+
+cl_object ecl_binary_u8_decoder(cl_object strm, unsigned char *buf);
+void ecl_binary_u8_encoder(cl_object strm, unsigned char *buf, cl_object byte);
+cl_object ecl_binary_s8_decoder(cl_object strm, unsigned char *buf);
+void ecl_binary_s8_encoder(cl_object strm, unsigned char *buf, cl_object byte);
+cl_object ecl_binary_be_decoder(cl_object strm, unsigned char *buf);
+void ecl_binary_be_encoder(cl_object strm, unsigned char *buf, cl_object byte);
+cl_object ecl_binary_le_decoder(cl_object strm, unsigned char *buf);
+void ecl_binary_le_encoder(cl_object strm, unsigned char *buf, cl_object byte);
+
 /* streams/strm_eformat.d */
 ecl_character ecl_eformat_read_char(cl_object strm);
 void ecl_eformat_unread_char(cl_object strm, ecl_character c);
@@ -479,9 +487,10 @@ write_char_increment_column(cl_object strm, ecl_character c)
     strm->stream.column++;
 }
 
-/* Maximum number of bytes required to encode a character.  This currently
+/* Maximum number of octets required to encode a char or a byte. This currently
- * corresponds to (4 + 4) for the UCS-4 encoding with 4 being the byte-order
+ * corresponds to:
- * mark, 4 for the character. */
+ * - (4 + 4) for the UCS-4 with 4 being the byte-order mark, 4 for the char
+ * - (64/ 8) for the EXT:BYTE64 which is the biggest array integer type */
 #define ENCODING_BUFFER_MAX_SIZE 8
 
 /* file.d */
@@ -503,29 +512,40 @@ write_char_increment_column(cl_object strm, ecl_character c)
 
 #define ECL_FILE_STREAM_P(strm) \
         (ECL_ANSI_STREAM_P(strm) && (strm)->stream.mode < ecl_smm_synonym)
+
 #define STRING_OUTPUT_STRING(strm) (strm)->stream.object0
 #define STRING_INPUT_STRING(strm) (strm)->stream.object0
 #define STRING_INPUT_POSITION(strm) (strm)->stream.int0
 #define STRING_INPUT_LIMIT(strm) (strm)->stream.int1
+
 #define TWO_WAY_STREAM_INPUT(strm) (strm)->stream.object0
 #define TWO_WAY_STREAM_OUTPUT(strm) (strm)->stream.object1
+
 #define SYNONYM_STREAM_SYMBOL(strm) (strm)->stream.object0
 #define SYNONYM_STREAM_STREAM(strm) ecl_symbol_value((strm)->stream.object0)
 #define BROADCAST_STREAM_LIST(strm) (strm)->stream.object0
 #define ECHO_STREAM_INPUT(strm) (strm)->stream.object0
 #define ECHO_STREAM_OUTPUT(strm) (strm)->stream.object1
 #define CONCATENATED_STREAM_LIST(strm) (strm)->stream.object0
+
 #define IO_STREAM_FILE(strm) ((strm)->stream.file.stream)
 #define IO_STREAM_ELT_TYPE(strm) (strm)->stream.object0
 #define IO_STREAM_FILENAME(strm) (strm)->stream.object1
+
 #define IO_FILE_DESCRIPTOR(strm) (strm)->stream.file.descriptor
 #define IO_FILE_ELT_TYPE(strm) (strm)->stream.object0
 #define IO_FILE_FILENAME(strm) (strm)->stream.object1
-#define SEQ_OUTPUT_VECTOR(strm) (strm)->stream.object1
+
-#define SEQ_OUTPUT_POSITION(strm) (strm)->stream.int0
+#define SEQ_STREAM_ELT_TYPE(strm) (strm)->stream.object0
-#define SEQ_INPUT_VECTOR(strm) (strm)->stream.object1
+#define SEQ_STREAM_VECTOR(strm) (strm)->stream.object1
-#define SEQ_INPUT_POSITION(strm) (strm)->stream.int0
+#define SEQ_STREAM_POSITION(strm) (strm)->stream.int0
-#define SEQ_INPUT_LIMIT(strm) (strm)->stream.int1
+
+#define SEQ_INPUT_VECTOR_END(strm) (strm)->stream.int1
+#define SEQ_INPUT_LIMIT(strm)                                           \
+        ((strm)->stream.flags & ECL_STREAM_USE_VECTOR_FILLP             \
+         ? SEQ_STREAM_VECTOR(strm)->vector.fillp                        \
+         : SEQ_INPUT_VECTOR_END(strm))
+
 
 #ifndef HAVE_FSEEKO
 #define ecl_off_t int

src/h/object.h

@@ -587,16 +587,18 @@ enum ecl_smmode {               /*  stream mode  */
 };
 
 struct ecl_file_ops {
-        cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n);
         cl_index (*read_byte8)(cl_object strm, unsigned char *c, cl_index n);
+        cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n);
 
-        void (*write_byte)(cl_object strm, cl_object byte);
         cl_object (*read_byte)(cl_object strm);
+        void (*write_byte)(cl_object strm, cl_object byte);
+        void (*unread_byte)(cl_object strm, cl_object byte);
+        cl_object (*peek_byte)(cl_object strm);
 
-        int (*read_char)(cl_object strm);
+        ecl_character (*read_char)(cl_object strm);
-        int (*write_char)(cl_object strm, int c);
+        ecl_character (*write_char)(cl_object strm, ecl_character c);
-        void (*unread_char)(cl_object strm, int c);
+        void (*unread_char)(cl_object strm, ecl_character c);
-        int (*peek_char)(cl_object strm);
+        ecl_character (*peek_char)(cl_object strm);
 
         cl_index (*read_vector)(cl_object strm, cl_object data, cl_index start, cl_index end);
         cl_index (*write_vector)(cl_object strm, cl_object data, cl_index start, cl_index end);
@@ -643,15 +645,19 @@ enum {
         ECL_STREAM_USER_FORMAT = 8,
         ECL_STREAM_US_ASCII = 10,
 #endif
+        /* External Format */
         ECL_STREAM_CR = 16,
         ECL_STREAM_LF = 32,
         ECL_STREAM_SIGNED_BYTES = 64,
         ECL_STREAM_LITTLE_ENDIAN = 128,
+        /* OS Streams */
         ECL_STREAM_C_STREAM = 256,
         ECL_STREAM_MIGHT_SEEK = 512,
-        ECL_STREAM_CLOSE_COMPONENTS = 1024,
+        ECL_STREAM_CLOSE_ON_EXEC = 1024,
-        ECL_STREAM_CLOSE_ON_EXEC = 2048,
+        ECL_STREAM_NONBLOCK = 2048,
-        ECL_STREAM_NONBLOCK = 4096
+        /* Lisp Streams */
+        ECL_STREAM_CLOSE_COMPONENTS = 4096,
+        ECL_STREAM_USE_VECTOR_FILLP = 8192
 };
 
 /* buffer points to an array of bytes ending at buffer_end. Decode one
@@ -663,6 +669,11 @@ typedef ecl_character (*cl_eformat_decoder)(cl_object stream, unsigned char **bu
    number of bytes used */
 typedef int (*cl_eformat_encoder)(cl_object stream, unsigned char *buffer, ecl_character c);
 
+/* Buffer is assumed to be big enough to store whole byte. The byte size is
+   stream->strm.byte_size. Decoder returns an object, encoder fills a buffer. */
+typedef cl_object (*cl_binary_decoder)(cl_object stream, unsigned char *buf);
+typedef void (*cl_binary_encoder)(cl_object stream, unsigned char *buf, cl_object byte);
+
 #define ECL_ANSI_STREAM_P(o) \
         (ECL_IMMEDIATE(o) == 0 && ((o)->d.t == t_stream))
 #define ECL_ANSI_STREAM_TYPE_P(o,m) \
@@ -678,18 +689,21 @@ struct ecl_stream {
         } file;
         cl_object object0;      /*  some object  */
         cl_object object1;      /*  some object */
+        cl_object last_byte;    /*  last byte read  */
+        cl_fixnum last_char;    /*  last character read  */
         cl_object byte_stack;   /*  buffer for unread bytes  */
         cl_index column;        /*  file column  */
-        cl_fixnum last_char;    /*  last character read  */
-        cl_fixnum last_code[2]; /*  actual composition of last character  */
         cl_fixnum int0;         /*  some int  */
         cl_fixnum int1;         /*  some int  */
         cl_index byte_size;     /*  size of byte in binary streams  */
         cl_fixnum last_op;      /*  0: unknown, 1: reading, -1: writing */
         char *buffer;           /*  buffer for FILE  */
+        unsigned char *byte_buffer; /*  buffer for encoding and decoding */
         cl_object format;       /*  external format  */
         cl_eformat_encoder encoder;
         cl_eformat_decoder decoder;
+        cl_binary_encoder byte_encoder;
+        cl_binary_decoder byte_decoder;
         cl_object format_table;
         int flags;              /*  character table, flags, etc  */
         ecl_character eof_char;

src/tests/2am.lisp

@@ -273,13 +273,13 @@
 
 (defmacro finishes (form &rest args)
   (if args
-      `(handler-case (progn ,form (passed))
+      `(handler-case (multiple-value-prog1 ,form (passed))
          (serious-condition (c)
            (failed (make-condition 'test-failure
                                    :name *test-name*
                                    :format-control ,(car args)
                                    :format-arguments (list ,@(cdr args))))))
-      `(handler-case (progn ,form (passed))
+      `(handler-case (multiple-value-prog1 ,form (passed))
          (serious-condition (c)
            (failed (make-condition 'test-failure
                                    :name *test-name*

src/tests/ecl-tests.asd

@@ -28,6 +28,7 @@
                          (:file "external-formats" :if-feature :unicode)
                          (:file "unicode" :if-feature :unicode)
                          (:file "complex")
+                         (:file "stream")
                          (:file "wscl")))
                (:module stress-tests
                         :default-component-class asdf:cl-source-file.lsp

src/tests/normal-tests/run-program.lsp

@@ -91,7 +91,8 @@
               (finishes (ext:terminate-process process))
               (sleep 1)
               #-windows(is-eql :signaled (ext:external-process-wait process nil))
-              #+windows(is-eql :exited (ext:external-process-wait process nil))))
+              #+windows(is-eql :exited (ext:external-process-wait process nil))
+              t))
   (is-equal #-windows `(t :signaled ,ext:+sigkill+)
 	    #+windows `(t :exited -1)
             (with-run-program (terminate nil)
@@ -100,7 +101,8 @@
               (sleep 1)
               #-windows(is-eql :signaled (ext:external-process-wait process nil))
               #+windows(is-eql :exited (ext:external-process-wait process nil))
-              (finishes (ext:external-process-status process)))))
+              (finishes (ext:external-process-status process))
+              t)))
 
 ;;; We may want to craft it into an interface. Suspend/Resume *is* possible on Windows:
 ;;; http://stackoverflow.com/questions/11010165/how-to-suspend-resume-a-process-in-windows
@@ -116,7 +118,8 @@
                 (si:killpid pid ext:+sigcont+)
                 (sleep 2)
                 (is-eql :resumed (ext:external-process-wait process nil))
-                (finishes (ext:terminate-process process t))))))
+                (finishes (ext:terminate-process process t))
+                t))))
 
 ;;; Cygwin programs seems not to react to signals. We use a stub to
 ;;; avoid infintie wait for process termination.

src/tests/normal-tests/stream.lsp

@@ -0,0 +1,214 @@
+;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil -*-
+;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
+
+;;;; Author:   Daniel Kochmański
+;;;; Created:  2025-07-22
+;;;; Contains: Stream tests (for encodings see the suite "eformat")
+
+(in-package #:cl-test)
+
+(suite 'stream)
+
+(deftest stream.unread-signals-error ()
+  (let ((stream (make-string-input-stream "jd")))
+    (signals error (unread-char #\x stream))
+    (is (char= #\j (read-char stream)))
+    (is (char= #\d (read-char stream)))
+    (finishes (unread-char #\d stream))
+    (is (char= #\d (read-char stream)))
+    (is (eql (read-char stream nil :eof) :eof)))
+  (let* ((vector (make-array 2 :element-type 'ext:byte8 :initial-contents '(1 2)))
+         (stream (ext:make-sequence-input-stream vector)))
+    (signals error (ext:unread-byte stream 0))
+    (is (= 1 (read-byte stream)))
+    (is (= 2 (read-byte stream)))
+    (finishes (ext:unread-byte stream 2))
+    (is (= 2 (read-byte stream)))
+    (is (eql (read-byte stream nil :eof) :eof))))
+
+(defun make-input-stream-tester (key read peek back)
+  ;; (READ STREAM EOF-VALUE)
+  ;; (PEEK STREAM EOF-VALUE)
+  ;; (BACK STREAM ELT-VALUE)
+  (lambda (stream vector)
+    (labels ((call (name fun elt &optional (exp elt))
+               (let ((out (funcall fun stream elt)))
+                 (is (eql out exp) "~a: ~s not eql to ~s" name out exp)))
+             (test (elt)
+               (call :peek peek (funcall key elt))
+               (call :read read (funcall key elt))
+               (call :back back (funcall key elt) nil)
+               (call :peek peek (funcall key elt))
+               (call :read read (funcall key elt))))
+      (loop for i across vector
+            do (test i)
+            finally (call :read-eof read :eof)
+                    (call :peek-eof peek :eof)))))
+
+(setf (fdefinition 'test-byte-input-stream)
+      (make-input-stream-tester
+       #'identity
+       (lambda (s i) (cl:read-byte s nil i))
+       (lambda (s i) (ext:peek-byte s i))
+       (lambda (s i) (ext:unread-byte s i))))
+
+(setf (fdefinition 'test-char-input-stream)
+      (make-input-stream-tester
+       #'code-char
+       (lambda (s i) (cl:read-char s nil i))
+       (lambda (s i) (cl:peek-char nil s nil i))
+       (lambda (s i) (cl:unread-char i s))))
+
+(setf (fdefinition 'test-bivalent-input-stream)
+      (make-input-stream-tester
+       #'identity
+       (lambda (s i)
+         (if (zerop (random 2))
+             (cl:read-byte s nil i)
+             (let ((out (cl:read-char s nil i)))
+               (if (characterp out)
+                   (char-code out)
+                   out))))
+       (lambda (s i)
+         (if (zerop (random 2))
+             (ext:peek-byte s i)
+             (let ((out (cl:peek-char nil s nil i)))
+               (if (characterp out)
+                   (char-code out)
+                   out))))
+       (lambda (s i)
+         (if (zerop (random 2))
+             (ext:unread-byte s i)
+             (cl:unread-char (code-char i) s)))))
+
+(defun test-byte-output-stream (stream n)
+  (dotimes (i n)
+    (finishes (cl:write-byte (char-code #\x) stream))))
+
+(defun test-char-output-stream (stream n)
+  (dotimes (i n)
+    (finishes (cl:write-char #\X stream))))
+
+(defun test-bivalent-output-stream (stream n)
+  (dotimes (i n)
+    (if (zerop (random 2))
+        (finishes (cl:write-byte (char-code #\a) stream))
+        (finishes (cl:write-char #\A stream)))))
+
+(defun make-sequence-io-stream (vector &optional format)
+  (make-two-way-stream
+   (ext:make-sequence-input-stream vector :external-format format)
+   (ext:make-sequence-output-stream vector :external-format format)))
+
+;;; Smoke test for extensions EXT:PEEK-BYTE and EXT:UNREAD-BYTE.
+(deftest stream.smoke-read-byte ()
+  (let* ((values (loop repeat 16 collect (random 255)))
+         (vector (make-array 16 :element-type '(unsigned-byte 8)
+                                :initial-contents values
+                                :fill-pointer 8))
+         (stream (make-sequence-io-stream vector)))
+    (test-byte-input-stream stream vector)
+    (test-byte-output-stream stream 8)))
+
+(deftest stream.smoke-read-char ()
+  (let* ((values (map 'vector #'char-code "ABCDEFGHIJKLMNOP"))
+         (vector (make-array 16 :element-type '(unsigned-byte 8)
+                                :initial-contents values
+                                :fill-pointer 8))
+         (stream (make-sequence-io-stream vector :ascii)))
+    (test-char-input-stream stream vector)
+    (test-char-output-stream stream 8)))
+
+(deftest stream.smoke-bivalent ()
+  (let* ((values (map 'vector #'char-code "ABCDEFGHIJKLMNOP"))
+         (vector (make-array 16 :element-type '(unsigned-byte 8)
+                                :initial-contents values
+                                :fill-pointer 8))
+         (stream (make-sequence-io-stream vector :ascii)))
+    (test-bivalent-input-stream stream vector)
+    (test-bivalent-output-stream stream 8)))
+
+;;; Ensure that we make a "clean" error (i.e not a segfault) when bivalent
+;;; stream has bytes that can't be casted to characters.
+(deftest stream.error-bivalent ()
+  (let* ((values (loop repeat 16 collect char-code-limit))
+         (vector (make-array 16 :element-type '(unsigned-byte 64)
+                                :initial-contents values
+                                :fill-pointer 8))
+         (stream (make-sequence-io-stream vector nil)))
+    (signals error (test-char-input-stream stream vector))
+    (finishes (test-byte-input-stream stream vector))
+    (finishes (test-char-output-stream stream 8))
+    (finishes (test-char-input-stream stream (subseq vector 8 16)))))
+
+;;; Ensure that MAKE-SEQUENCE-INPUT-STREAM and MAKE-SEQUENCE-OUTPUT-STREAM can
+;;; take bytes that are larger than any character.
+
+(deftest stream.binary-sequence ()
+  (loop with values = (loop for i from 0 below 16 collect (char-code #\Z))
+        for (elt-type . format) in '(((unsigned-byte 8) . nil)
+                                     ((unsigned-byte 16) . nil)
+                                     ((unsigned-byte 32) . nil)
+                                     ((unsigned-byte 64) . nil)
+                                     ((unsigned-byte 16) . :ucs-2)
+                                     ((unsigned-byte 32) . :ucs-4))
+        for vector = (make-array 16 :element-type elt-type
+                                    :initial-contents values
+                                    :fill-pointer 12)
+        for stream = (finishes (make-sequence-io-stream vector format))
+        when (and stream (null format))
+          do (finishes (test-byte-input-stream stream vector))
+             (finishes (test-byte-output-stream stream 4))))
+
+;;; Ensure that MAKE-SEQUENCE-INPUT-STREAM and MAKE-SEQUENCE-OUTPUT-STREAM can
+;;; take byte and char sequences and use them as bivalent streams.
+
+(deftest stream.bivalent-sequence ()
+  (loop with char-values = "0123456789abcdef"
+        with byte-values = (map 'vector #'char-code char-values)
+        for (elt-type values format) in `(((unsigned-byte  8) ,byte-values nil)
+                                          ((unsigned-byte 16) ,byte-values nil)
+                                          ((unsigned-byte 32) ,byte-values nil)
+                                          ((unsigned-byte 64) ,byte-values nil)
+                                          (character          ,char-values :default))
+        for vector = (make-array 16 :element-type elt-type
+                                    :initial-contents values
+                                    :fill-pointer 12)
+        for result = (subseq byte-values 0 12)
+        for stream = (finishes (make-sequence-io-stream vector format))
+        when stream
+          do (finishes (test-bivalent-input-stream stream result))
+             (finishes (test-bivalent-output-stream stream 4))))
+
+;;; Ensure that we punt on invalid sequence stream types.
+
+(deftest stream.invalid-sequence ()
+  (loop with values = (loop for i from 0 below 16 collect i)
+        for (elt-type . format) in '((t . nil)
+                                     (single-float . nil)
+                                     (double-float . nil)
+                                     (long-float   . nil)
+                                     (si:complex-single-float  . nil)
+                                     (si:complex-double-float  . nil)
+                                     (si:complex-long-float  . nil))
+        for vector = (make-array 16 :element-type elt-type :initial-contents values)
+        do (signals error (make-sequence-io-stream vector format))))
+
+(deftest stream.bidirectional-vector-with-fill-pointer ()
+  (let* ((values (map 'vector #'char-code "ABCDEFGHIJKLMNOP"))
+         (vector (make-array 16 :element-type '(unsigned-byte 8)
+                                :initial-contents values
+                                :fill-pointer 8))
+         (stream (make-sequence-io-stream vector :ascii)))
+    (dotimes (v 8)
+      (finishes (read-char stream)))
+    (signals error (read-char stream))
+    (dotimes (v 4) (write-char #\x stream))
+    (dotimes (v 2) (write-char #\y stream))
+    (dotimes (v 4) (eql #\x (read-char stream)))
+    (dotimes (v 2) (eql #\y (read-char stream)))
+    (signals error (read-char stream))
+    (dotimes (v 2) (finishes (write-char #\z stream)))
+    (signals error (write-char #\z stream))
+    (dotimes (v 2) (eql #\z (read-char stream)))
+    (signals error (read-char stream))))