mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'object-streams' into 'develop'

Browse source 
Bivalent streams improvements

See merge request embeddable-common-lisp/ecl!355
This commit is contained in:
Marius Gerbershagen 2025-08-11 16:41:03 +00:00
commit a2019ce31a
27 changed files with 1171 additions and 377 deletions
Download patch file Download diff file Expand all files Collapse all files

18
CHANGELOG
View file

@ -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

6
msvc/c/Makefile
View file

@ -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 \
strm_clos.obj strm_string.obj strm_composite.obj \
strm_common.obj strm_sequence.obj strm_eformat.obj
STREAM_OBJS = stream.obj file.obj strm_os.obj strm_clos.obj \
strm_string.obj strm_composite.obj strm_common.obj \
strm_sequence.obj strm_eformat.obj strm_binary.obj
FFI_OBJS = ffi.obj libraries.obj backtrace.obj mmap.obj cdata.obj

6
src/c/Makefile.in
View file

@ -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 \
streams/strm_clos.o streams/strm_string.o streams/strm_composite.o \
streams/strm_common.o streams/strm_sequence.o streams/strm_eformat.o
STREAM_OBJS = stream.o file.o streams/strm_os.o streams/strm_clos.o \
streams/strm_string.o streams/strm_composite.o streams/strm_common.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

1
src/c/alloc_2.d
View file

@ -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)) |

2
src/c/read.d
View file

@ -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);
}

71
src/c/stream.d
View file

@ -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);
ecl_return1(the_env, Null(c) ? eof_value : c);
cl_object byte = ecl_read_byte(strm);
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)

162
src/c/streams/strm_binary.d Normal file
View file

@ -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);
}
}

32
src/c/streams/strm_clos.d
View file

@ -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);
if (b == @':eof') b = ECL_NIL;
return b;
cl_object out = _ecl_funcall2(@'gray::stream-read-byte', strm);
if (out == @':eof') out = OBJNULL;
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,

151
src/c/streams/strm_common.d
View file

@ -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;
if (strm->stream.ops->read_byte8(strm, (unsigned char *)&c, 1) < 1)
return ECL_NIL;
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);
cl_object out = ecl_read_byte(strm);
if (out != OBJNULL) ecl_unread_byte(out, strm);
return out;
}
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);
}
}

122
src/c/streams/strm_composite.d
View file

@ -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
echo_read_byte(cl_object strm)
static void
echo_unread_byte(cl_object strm, cl_object byte)
{
cl_object out = ecl_read_byte(ECHO_STREAM_INPUT(strm));
if (!Null(out)) ecl_write_byte(out, ECHO_STREAM_OUTPUT(strm));
return out;
unlikely_if (strm->stream.last_byte != OBJNULL) {
ecl_unread_twice(strm);
}
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];
if (c == EOF) {
cl_object byte = strm->stream.last_byte;
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];
if (c == EOF) {
c = ecl_peek_char(ECHO_STREAM_INPUT(strm));
}
return c;
return ecl_peek_char(ECHO_STREAM_INPUT(strm));
}
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,

67
src/c/streams/strm_eformat.d
View file

@ -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);
}
{
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;
}
strm->stream.last_char = c;
}
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;
write_byte = ecl_generic_write_byte_signed8;
stream->stream.byte_decoder = ecl_binary_s8_decoder;
stream->stream.byte_encoder = ecl_binary_s8_encoder;
} else {
read_byte = ecl_generic_read_byte_unsigned8;
write_byte = ecl_generic_write_byte_unsigned8;
stream->stream.byte_decoder = ecl_binary_u8_decoder;
stream->stream.byte_encoder = ecl_binary_u8_encoder;
}
} else if (flags & ECL_STREAM_LITTLE_ENDIAN) {
read_byte = ecl_generic_read_byte_le;
write_byte = ecl_generic_write_byte_le;
stream->stream.byte_decoder = ecl_binary_le_decoder;
stream->stream.byte_encoder = ecl_binary_le_encoder;
} else {
read_byte = ecl_generic_read_byte;
write_byte = ecl_generic_write_byte;
stream->stream.byte_decoder = ecl_binary_be_decoder;
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

144
src/c/streams/strm_os.d
View file

@ -132,10 +132,7 @@ safe_fclose(FILE *stream)
return output;
}
/**********************************************************************
* POSIX FILE STREAM
*/
/* -- Byte stack --------------------------------------------------- */
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_generic_read_byte,
ecl_binary_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_generic_read_byte,
ecl_binary_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_generic_read_byte,
ecl_binary_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_generic_read_byte,
ecl_binary_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,

347
src/c/streams/strm_sequence.d
View file

@ -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);
strm->stream.byte_stack = ECL_NIL;
if (c == ECL_CHAR_CODE_NEWLINE
&& (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);
SEQ_INPUT_POSITION(strm) += 1;
cl_object vector = SEQ_STREAM_VECTOR(strm);
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 {
FEerror("Illegal combination of external-format ~A and input vector ~A for MAKE-SEQUENCE-INPUT-STREAM.~%", 2, external_format, vector);
else if(!byte_size && external_format == @':default') {
/* 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;
SEQ_INPUT_POSITION(strm) = istart;
SEQ_INPUT_LIMIT(strm) = iend;
else if(Null(external_format)) {
/* byte vector -> native bivalent stream */
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,
external_format))
strm = make_sequence_input_stream(vector, p.start, p.end,
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_fixnum curr_pos = SEQ_OUTPUT_POSITION(strm);
cl_object vector = SEQ_STREAM_VECTOR(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_fixnum curr_pos = SEQ_OUTPUT_POSITION(strm);
cl_object vector = SEQ_STREAM_VECTOR(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_fixnum curr_pos = SEQ_OUTPUT_POSITION(strm);
cl_object vector = SEQ_STREAM_VECTOR(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 {
FEerror("Illegal combination of external-format ~A and output vector ~A for MAKE-SEQUENCE-OUTPUT-STREAM.~%", 2, external_format, vector);
else if(!byte_size && external_format == @':default') {
/* 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;
SEQ_OUTPUT_POSITION(strm) = vector->vector.fillp;
else if(Null(external_format)) {
/* 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++;

12
src/c/streams/strm_string.d
View file

@ -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,

4
src/c/symbols_list.h
View file

@ -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)},

38
src/clos/streams.lsp
View file

@ -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))

2
src/cmp/proclamations.lsp
View file

@ -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

2
src/doc/manual/developer-guide/objects.txi
View file

@ -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

14
src/doc/manual/extensions/gray-streams.txi
View file

@ -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

17
src/doc/manual/standards/streams.txi
View file

@ -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)

6
src/h/external.h
View file

@ -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);

58
src/h/internal.h
View file

@ -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_twice(s) FEerror("Used UNREAD-CHAR twice 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("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);
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);
cl_object ecl_generic_peek_byte(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
* corresponds to (4 + 4) for the UCS-4 encoding with 4 being the byte-order
* mark, 4 for the character. */
/* Maximum number of octets required to encode a char or a byte. This currently
* corresponds to:
* - (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_INPUT_VECTOR(strm) (strm)->stream.object1
#define SEQ_INPUT_POSITION(strm) (strm)->stream.int0
#define SEQ_INPUT_LIMIT(strm) (strm)->stream.int1
#define SEQ_STREAM_ELT_TYPE(strm) (strm)->stream.object0
#define SEQ_STREAM_VECTOR(strm) (strm)->stream.object1
#define SEQ_STREAM_POSITION(strm) (strm)->stream.int0
#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

36
src/h/object.h
View file

@ -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);
int (*write_char)(cl_object strm, int c);
void (*unread_char)(cl_object strm, int c);
int (*peek_char)(cl_object strm);
ecl_character (*read_char)(cl_object strm);
ecl_character (*write_char)(cl_object strm, ecl_character c);
void (*unread_char)(cl_object strm, ecl_character c);
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 = 2048,
ECL_STREAM_NONBLOCK = 4096
ECL_STREAM_CLOSE_ON_EXEC = 1024,
ECL_STREAM_NONBLOCK = 2048,
/* 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;

4
src/tests/2am.lisp
View file

@ -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*

1
src/tests/ecl-tests.asd
View file

@ -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

9
src/tests/normal-tests/run-program.lsp
View file

@ -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.

214
src/tests/normal-tests/stream.lsp Normal file
View file

@ -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))))