Implemented SEQUENCE-STREAMs

parent adb519d6
......@@ -116,6 +116,19 @@ ECL 11.7.1:
compiler. The problem is that llvm-gcc disguises itself as GCC but it is
not capable of properly compiling the jump table.
- Implemented SEQUENCE-STREAMs, which are input/output streams defined on some
specialized array type. The functions to create them are
(ext:make-sequence-input-stream vector &key :start :end :external-format)
(ext:make-sequence-output-stream vector &key :external-format)
* If the array is a string, it is a character stream
* If the array is specialized over integers and EXTERNAL-FORMAT is NIL
the stream is a binary stream.
* Otherwise, it is a binary string but READ/WRITE-CHAR may be used on it.
Reading and writing does not preserve the original word size of the array
but rather threads the array as a collection of bytes (octets), writing
sequentially over it. Thus, if you use encodings such as UCS2 and UCS4, make
sure that you choose the right endianness to match the shape of the array.
;;; Local Variables: ***
;;; mode:text ***
;;; fill-column:79 ***
......
......@@ -36,6 +36,7 @@
#include <stdio.h>
#include <ecl/ecl.h>
#include <ecl/ecl-inl.h>
#define ECL_DEFINE_AET_SIZE
#include <ecl/internal.h>
#ifdef HAVE_SELECT
......@@ -3942,6 +3943,256 @@ si_file_stream_fd(cl_object s)
@(return ret);
}
/**********************************************************************
* SEQUENCE INPUT STREAMS
*/
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 last = SEQ_INPUT_LIMIT(strm);
cl_fixnum delta = last - curr_pos;
if (delta > 0) {
cl_object vector = SEQ_INPUT_VECTOR(strm);
if (delta > n) delta = n;
memcpy(c, vector->vector.self.bc, delta);
SEQ_INPUT_POSITION(strm) += delta;
return delta;
}
return 0;
}
static int
seq_in_listen(cl_object strm)
{
if (SEQ_INPUT_POSITION(strm) < SEQ_INPUT_LIMIT(strm))
return ECL_LISTEN_AVAILABLE;
else
return ECL_LISTEN_EOF;
}
static cl_object
seq_in_get_position(cl_object strm)
{
return ecl_make_unsigned_integer(SEQ_INPUT_POSITION(strm));
}
static cl_object
seq_in_set_position(cl_object strm, cl_object pos)
{
cl_fixnum disp;
if (Null(pos)) {
disp = SEQ_INPUT_LIMIT(strm);
} else {
disp = fixnnint(pos);
if (disp >= SEQ_INPUT_LIMIT(strm)) {
disp = SEQ_INPUT_LIMIT(strm);
}
}
SEQ_INPUT_POSITION(strm) = disp;
return Ct;
}
const struct ecl_file_ops seq_in_ops = {
not_output_write_byte8,
seq_in_read_byte8,
not_output_write_byte,
generic_read_byte,
eformat_read_char,
not_output_write_char,
eformat_unread_char,
generic_peek_char,
generic_read_vector,
generic_write_vector,
seq_in_listen,
generic_void, /* clear-input */
not_output_clear_output,
not_output_finish_output,
not_output_force_output,
generic_always_true, /* input_p */
generic_always_false, /* output_p */
generic_always_false,
io_file_element_type,
not_a_file_stream, /* length */
seq_in_get_position,
seq_in_set_position,
generic_column,
generic_close
};
static cl_object
make_sequence_input_stream(cl_object vector, cl_index istart, cl_index iend,
cl_object external_format)
{
cl_object strm;
cl_elttype type;
cl_object type_name;
int byte_size;
if (!ECL_VECTORP(vector) ||
(type = ecl_array_elttype(vector)) < aet_b8 ||
type > aet_bc)
{
FEerror("MAKE-SEQUENCE-INPUT-STREAM only accepts integer arrays or strings.~%~A", 1, vector);
}
type_name = ecl_elttype_to_symbol(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. */
if (Null(external_format) && !byte_size) {
external_format = @':default';
}
strm = alloc_stream();
strm->stream.ops = duplicate_dispatch_table(&seq_in_ops);
strm->stream.mode = (short)smm_sequence_input;
set_stream_elt_type(strm, byte_size, 0, external_format);
/* Override byte size and elt type */
strm->stream.byte_size = byte_size;
SEQ_INPUT_VECTOR(strm) = vector;
SEQ_INPUT_POSITION(strm) = istart * ecl_aet_size[type];
SEQ_INPUT_LIMIT(strm) = iend * ecl_aet_size[type];
return strm;
}
@(defun ext::make_sequence_input_stream (vector &key
(start MAKE_FIXNUM(0))
(end Cnil)
(external_format Cnil))
cl_index_pair p;
@
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))
@)
/**********************************************************************
* SEQUENCE OUTPUT STREAMS
*/
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_fixnum last = SEQ_OUTPUT_LIMIT(strm);
cl_fixnum delta = last - curr_pos;
int size = ecl_aet_size[vector->vector.elttype];
if (delta < n) {
/* Not enough space, enlarge */
cl_object dim = cl_array_total_size(vector);
vector = cl_funcall(3, @'adjust-array', vector, ecl_ash(dim, 1));
SEQ_OUTPUT_VECTOR(strm) = vector;
SEQ_OUTPUT_LIMIT(strm) = vector->vector.dim * size;
goto AGAIN;
}
memcpy(vector->vector.self.bc + curr_pos, c, n);
SEQ_OUTPUT_POSITION(strm) = curr_pos += n;
vector->vector.fillp = curr_pos / size;
}
return n;
}
static cl_object
seq_out_get_position(cl_object strm)
{
return ecl_make_unsigned_integer(SEQ_OUTPUT_POSITION(strm));
}
static cl_object
seq_out_set_position(cl_object strm, cl_object pos)
{
cl_fixnum disp;
if (Null(pos)) {
disp = SEQ_OUTPUT_LIMIT(strm);
} else {
disp = fixnnint(pos);
if (disp >= SEQ_OUTPUT_LIMIT(strm)) {
disp = SEQ_OUTPUT_LIMIT(strm);
}
}
SEQ_OUTPUT_POSITION(strm) = disp;
return Ct;
}
const struct ecl_file_ops seq_out_ops = {
seq_out_write_byte8,
not_input_read_byte8,
generic_write_byte,
not_input_read_byte,
not_input_read_char,
eformat_write_char,
not_input_unread_char,
generic_peek_char,
generic_read_vector,
generic_write_vector,
not_input_listen,
not_input_clear_input,
generic_void, /* clear-output */
generic_void, /* finish-output */
generic_void, /* force-output */
generic_always_false, /* input_p */
generic_always_true, /* output_p */
generic_always_false,
io_file_element_type,
not_a_file_stream, /* length */
seq_out_get_position,
seq_out_set_position,
generic_column,
generic_close
};
static cl_object
make_sequence_output_stream(cl_object vector, cl_object external_format)
{
cl_object strm;
cl_elttype type;
cl_object type_name;
int byte_size;
if (!ECL_VECTORP(vector) ||
(type = ecl_array_elttype(vector)) < aet_b8 ||
type > aet_bc)
{
FEerror("MAKE-SEQUENCE-OUTPUT-STREAM only accepts integer arrays or strings.~%~A", 1, vector);
}
type_name = ecl_elttype_to_symbol(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. */
if (Null(external_format) && !byte_size) {
external_format = @':default';
}
strm = alloc_stream();
strm->stream.ops = duplicate_dispatch_table(&seq_out_ops);
strm->stream.mode = (short)smm_sequence_output;
set_stream_elt_type(strm, byte_size, 0, external_format);
/* Override byte size and elt type */
strm->stream.byte_size = byte_size;
SEQ_OUTPUT_VECTOR(strm) = vector;
SEQ_OUTPUT_POSITION(strm) = vector->vector.fillp * ecl_aet_size[type];
SEQ_OUTPUT_LIMIT(strm) = vector->vector.dim * ecl_aet_size[type];
return strm;
}
@(defun ext::make_sequence_output_stream (vector &key (external_format Cnil))
@
@(return make_sequence_output_stream(vector, external_format))
@)
/**********************************************************************
* MEDIUM LEVEL INTERFACE
*/
......@@ -4647,9 +4898,6 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
}
byte_size = ecl_normalize_stream_element_type(element_type);
if (byte_size != 0) {
if (flags & ECL_STREAM_FORMAT) {
FEerror("Cannot specify a character external format for binary streams.", 0);
}
external_format = Cnil;
}
if (!Null(cstream)) {
......
......@@ -233,6 +233,7 @@ enum ecl_built_in_classes {
ECL_BUILTIN_SYNONYM_STREAM,
ECL_BUILTIN_BROADCAST_STREAM,
ECL_BUILTIN_CONCATENATED_STREAM,
ECL_BUILTIN_SEQUENCE_STREAM,
ECL_BUILTIN_CHARACTER,
ECL_BUILTIN_NUMBER,
ECL_BUILTIN_REAL,
......@@ -327,10 +328,12 @@ cl_class_of(cl_object x)
case smm_synonym: index = ECL_BUILTIN_SYNONYM_STREAM; break;
case smm_broadcast: index = ECL_BUILTIN_BROADCAST_STREAM; break;
case smm_concatenated: index = ECL_BUILTIN_CONCATENATED_STREAM; break;
case smm_two_way: index = ECL_BUILTIN_TWO_WAY_STREAM; break;
case smm_two_way: index = ECL_BUILTIN_TWO_WAY_STREAM; break;
case smm_string_input:
case smm_string_output: index = ECL_BUILTIN_STRING_STREAM; break;
case smm_echo: index = ECL_BUILTIN_ECHO_STREAM; break;
case smm_sequence_input:
case smm_sequence_output: index = ECL_BUILTIN_SEQUENCE_STREAM; break;
default: index = ECL_BUILTIN_FILE_STREAM; break;
}
break;
......
......@@ -265,6 +265,14 @@ write_stream(cl_object x, cl_object stream)
prefix = "closed string-output stream";
tag = Cnil;
break;
case smm_sequence_input:
prefix = "closed sequence-input stream";
tag = Cnil;
break;
case smm_sequence_output:
prefix = "closed sequence-output stream";
tag = Cnil;
break;
default:
ecl_internal_error("illegal stream mode");
}
......
......@@ -2164,5 +2164,9 @@ cl_symbols[] = {
{EXT_ "ARRAY-INDEX-P", EXT_ORDINARY, ECL_NAME(si_array_index_p), 1, OBJNULL},
{EXT_ "SEQUENCE-STREAM", EXT_ORDINARY, NULL, -1, OBJNULL},
{EXT_ "MAKE-SEQUENCE-INPUT-STREAM", EXT_ORDINARY, si_make_sequence_input_stream, -1, OBJNULL},
{EXT_ "MAKE-SEQUENCE-OUTPUT-STREAM", EXT_ORDINARY, si_make_sequence_output_stream, -1, OBJNULL},
/* Tag for end of list */
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
......@@ -2164,5 +2164,9 @@ cl_symbols[] = {
{EXT_ "ARRAY-INDEX-P","ECL_NAME(si_array_index_p)"},
{EXT_ "SEQUENCE-STREAM",NULL},
{EXT_ "MAKE-SEQUENCE-INPUT-STREAM","si_make_sequence_input_stream"},
{EXT_ "MAKE-SEQUENCE-OUTPUT-STREAM","si_make_sequence_output_stream"},
/* Tag for end of list */
{NULL,NULL}};
......@@ -318,6 +318,8 @@ cl_type_of(cl_object x)
case smm_string_input:
case smm_string_output: t = @'string-stream'; break;
case smm_echo: t = @'echo-stream'; break;
case smm_sequence_input:
case smm_sequence_output: t = @'ext::sequence-stream'; break;
default: t = @'file-stream'; break;
}
break;
......
......@@ -60,6 +60,7 @@
(synonym-stream ext:ansi-stream)
(broadcast-stream ext:ansi-stream)
(concatenated-stream ext:ansi-stream)
(ext:sequence-stream ext:ansi-stream)
(character)
(number)
(real number)
......
......@@ -689,6 +689,8 @@ extern ECL_API cl_object cl_broadcast_stream_streams(cl_object strm);
extern ECL_API cl_object cl_make_concatenated_stream _ARGS((cl_narg narg, ...));
extern ECL_API cl_object cl_concatenated_stream_streams(cl_object strm);
extern ECL_API cl_object cl_make_string_input_stream _ARGS((cl_narg narg, cl_object strng, ...));
extern ECL_API cl_object si_make_sequence_input_stream _ARGS((cl_narg narg, cl_object vector, ...));
extern ECL_API cl_object si_make_sequence_output_stream _ARGS((cl_narg narg, cl_object vector, ...));
extern ECL_API cl_object cl_close _ARGS((cl_narg narg, cl_object strm, ...));
extern ECL_API cl_object cl_open _ARGS((cl_narg narg, cl_object filename, ...));
extern ECL_API cl_object cl_file_position _ARGS((cl_narg narg, cl_object file_stream, ...));
......
......@@ -277,6 +277,12 @@ extern void* ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_conv
#define IO_FILE_COLUMN(strm) (strm)->stream.int1
#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_OUTPUT_LIMIT(strm) (strm)->stream.int1
#define SEQ_INPUT_VECTOR(strm) (strm)->stream.object1
#define SEQ_INPUT_POSITION(strm) (strm)->stream.int0
#define SEQ_INPUT_LIMIT(strm) (strm)->stream.int1
#ifndef HAVE_FSEEKO
#define ecl_off_t int
......
......@@ -532,13 +532,14 @@ enum ecl_smmode { /* stream mode */
smm_echo, /* echo */
smm_string_input, /* string input */
smm_string_output, /* string output */
smm_probe /* probe (only used in open_stream()) */
smm_probe, /* probe (only used in open_stream()) */
#if defined(ECL_WSOCK)
,
smm_input_wsock, /* input socket (Win32) */
smm_output_wsock, /* output socket (Win32) */
smm_io_wsock /* input/output socket (Win32) */
smm_io_wsock, /* input/output socket (Win32) */
#endif
smm_sequence_input, /* sequence input */
smm_sequence_output /* sequence output */
};
struct ecl_file_ops {
......
......@@ -1214,9 +1214,11 @@ if not possible."
(STRING-STREAM)
(SYNONYM-STREAM)
(TWO-WAY-STREAM)
(EXT:SEQUENCE-STREAM)
(EXT:ANSI-STREAM (OR BROADCAST-STREAM CONCATENATED-STREAM ECHO-STREAM
FILE-STREAM STRING-STREAM SYNONYM-STREAM TWO-WAY-STREAM
#+clos-streams GRAY:FUNDAMENTAL-STREAM))
FILE-STREAM STRING-STREAM SYNONYM-STREAM TWO-WAY-STREAM
EXT:SEQUENCE-STREAM
#+clos-streams GRAY:FUNDAMENTAL-STREAM))
(STREAM EXT:ANSI-STREAM)
(READTABLE)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment