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

stream: port stream.d so it can be used with early env

Browse source 
This is a step towards introducing the I/O system.
This commit is contained in:
Daniel Kochmański 2025-05-24 08:55:18 +02:00
parent 98b887a7ea
commit 69b8ef4842
10 changed files with 193 additions and 96 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/Makefile.in
View file

@ -55,7 +55,7 @@ NUCL_CFLG = -DECL_NUCL -DECL_BUILD -DGC_NO_THREAD_REDIRECTS \
-I$(builddir) -I$(srcdir) -g3 -rdynamic
NUCL_SRCS = boot.c escape.c module.c stacks.c eql.c \
memory.c atomic.c process.c apply.c interpreter.c
memory.c atomic.c process.c apply.c interpreter.c stream.c
BOOT_OBJS = boot.o escape.o module.o stacks.o eql.o

60
src/c/error.d
View file

@ -62,6 +62,7 @@ ecl_exception_handler(cl_object o)
if (ECL_EXCEPTIONP(o)) {
cl_object arg1 = o->exception.arg1;
cl_object arg2 = o->exception.arg2;
cl_object arg3 = o->exception.arg3;
cl_object hand = @'si::universal-error-handler';
switch (o->exception.ex_type) {
/* General conditions */
@ -71,6 +72,34 @@ ecl_exception_handler(cl_object o)
case ECL_EX_CERROR:
ecl_enable_interrupts();
return _ecl_funcall4(hand, ECL_T, arg1, arg2);
/* Specific conditions */
case ECL_EX_BADARG:
FEwrong_type_argument(arg1, arg2);
break;
case ECL_EX_BADARG_ONLY:
FEwrong_type_only_arg(arg1, arg2, arg3);
break;
case ECL_EX_UNSATISFIED:
FEwrong_type_pred_arg(arg1, arg2);
break;
case ECL_EX_STRM_BADELT:
FEwrong_type_strm_elt(arg1, arg2);
break;
case ECL_EX_STRM_CLOSED:
FEclosed_stream(arg1);
break;
case ECL_EX_STRM_UNREAD:
FEunread_stream(arg1, arg2);
break;
case ECL_EX_EOF:
FEend_of_file(arg1);
break;
case ECL_EX_NIY:
FEerror("The operation is not implemented yet.", 0);
break;
case ECL_EX_NAO:
FEerror("The operation is not applicable to ~A.", 1, arg1);
break;
/* Stack conditions */
case ECL_EX_CS_OVR:
CEstack_overflow(@'ext::c-stack', arg1, arg2);
@ -273,7 +302,7 @@ FEreader_error(const char *s, cl_object stream, int narg, ...)
} else {
/* Actual reader error */
cl_object prefix = @"Reader error in file ~S, position ~D:~%";
cl_object position = cl_file_position(1, stream);
cl_object position = ecl_file_position(stream);
message = si_base_string_concatenate(2, prefix, message);
args_list = cl_listX(3, stream, position, args_list);
si_signal_simple_error(6,
@ -313,6 +342,16 @@ FEclosed_stream(cl_object strm)
cl_error(3, @'stream-error', @':stream', strm);
}
void
FEunread_stream(cl_object strm, cl_object twice)
{
if(Null(twice)) {
FEerror("Error when using UNREAD-CHAR on stream ~D", 1, strm);
} else {
FEerror("Used UNREAD-CHAR twice on stream ~D", 1, strm);
}
}
cl_object
si_signal_type_error(cl_object value, cl_object type)
{
@ -326,6 +365,25 @@ FEwrong_type_argument(cl_object type, cl_object value)
si_signal_type_error(value, cl_symbol_or_object(type));
}
void
FEwrong_type_pred_arg(cl_object type, cl_object value)
{
cl_object predicate = cl_symbol_or_object(type);
cl_object expected = cl_list(2, @'satisfies', predicate);
si_signal_type_error(value, expected);
}
void
FEwrong_type_strm_elt(cl_object type, cl_object value)
{
cl_object expected = cl_symbol_or_object(type);
cl_error(9, @'simple-type-error', @':format-control',
@"~A stream element type is not ~S.",
@':format-arguments', cl_list(2, value, expected),
@':expected-type', expected,
@':datum', cl_stream_element_type(value));
}
void
FEwrong_type_only_arg(cl_object function, cl_object value, cl_object type)
{

42
src/c/file.d
View file

@ -151,3 +151,45 @@ ecl_normalize_stream_element_type(cl_object element_type)
@
@(return ecl_stream_dispatch_table(strm)->close(strm));
@)
cl_object
si_file_stream_fd(cl_object s)
{
cl_object ret;
unlikely_if (!ECL_FILE_STREAM_P(s)) {
ecl_not_a_file_stream(s);
}
switch ((enum ecl_smmode)s->stream.mode) {
case ecl_smm_input:
case ecl_smm_output:
case ecl_smm_io:
ret = ecl_make_fixnum(fileno(IO_STREAM_FILE(s)));
break;
case ecl_smm_input_file:
case ecl_smm_output_file:
case ecl_smm_io_file:
ret = ecl_make_fixnum(IO_FILE_DESCRIPTOR(s));
break;
default:
ecl_internal_error("not a file stream");
}
@(return ret);
}
@(defun file-position (file_stream &o position)
cl_object output;
@
if (Null(position)) {
output = ecl_file_position(file_stream);
} else {
if (position == @':start') {
position = ecl_make_fixnum(0);
} else if (position == @':end') {
position = ECL_NIL;
}
output = ecl_file_position_set(file_stream, position);
}
@(return output);
@)

91
src/c/stream.d
View file

@ -18,6 +18,21 @@
#include <ecl/ecl.h>
#include <ecl/internal.h>
/* FIXME for now we break the dependency chain for NUCL, but later we want to
bring proto-clos into the early runtime and pull clos streams with it. */
#ifdef ECL_NUCL
# undef ECL_CLOS_STREAMS
#endif
static ecl_character
_ecl_char_code(cl_object c)
{
if (ecl_unlikely(!ECL_CHARACTERP(c))) {
ecl_ferror(ECL_EX_BADARG, @[character], c);
}
return ECL_CHAR_CODE(c);
}
#ifdef ECL_CLOS_STREAMS
extern const struct ecl_file_ops clos_stream_ops;
#endif
@ -66,7 +81,7 @@ ecl_stream_dispatch_table(cl_object strm)
}
#endif
if (!ECL_ANSI_STREAM_P(strm))
FEwrong_type_argument(@[stream], strm);
ecl_ferror(ECL_EX_BADARG, @[stream], strm);
return (const struct ecl_file_ops *)strm->stream.ops;
}
@ -117,7 +132,7 @@ ecl_read_char_noeof(cl_object strm)
{
ecl_character c = ecl_read_char(strm);
if (c == EOF)
FEend_of_file(strm);
ecl_ferror(ECL_EX_EOF, strm, ECL_NIL);
return c;
}
@ -249,7 +264,7 @@ cl_object
si_unread_char(cl_object strm, cl_object c)
{
cl_env_ptr the_env = ecl_process_env();
ecl_unread_char(ecl_char_code(c), strm);
ecl_unread_char(_ecl_char_code(c), strm);
ecl_return1(the_env, ECL_NIL);
}
@ -265,7 +280,7 @@ cl_object
si_write_char(cl_object strm, cl_object c)
{
cl_env_ptr the_env = ecl_process_env();
ecl_write_char(ecl_char_code(c), strm);
ecl_write_char(_ecl_char_code(c), strm);
ecl_return1(the_env, c);
}
@ -354,28 +369,25 @@ cl_file_length(cl_object strm)
@(return ecl_file_length(strm));
}
@(defun file-position (file_stream &o position)
cl_object output;
@
if (Null(position)) {
output = ecl_file_position(file_stream);
} else {
if (position == @':start') {
position = ecl_make_fixnum(0);
} else if (position == @':end') {
position = ECL_NIL;
}
output = ecl_file_position_set(file_stream, position);
}
@(return output);
@)
cl_object
cl_file_string_length(cl_object stream, cl_object string)
{
@(return ecl_file_string_length(stream, string));
}
cl_object
si_file_position_get(cl_object strm)
{
@(return ecl_file_position(strm));
}
cl_object
si_file_position_set(cl_object strm, cl_object position)
{
@(return ecl_file_position_set(strm, position));
}
cl_object
cl_input_stream_p(cl_object strm)
{
@ -406,7 +418,7 @@ cl_open_stream_p(cl_object strm)
}
#endif
unlikely_if (!ECL_ANSI_STREAM_P(strm))
FEwrong_type_only_arg(@'open-stream-p', strm, @'stream');
ecl_ferror(ECL_EX_UNSATISFIED, @[output-stream-p], strm);
@(return (strm->stream.closed ? ECL_NIL : ECL_T));
}
@ -429,11 +441,14 @@ cl_stream_external_format(cl_object strm)
else
#endif
unlikely_if (t != t_stream)
FEwrong_type_only_arg(@[stream-external-format], strm, @[stream]);
ecl_ferror4(ECL_EX_BADARG_ONLY, @[stream-external-format], strm, @[stream]);
if (strm->stream.mode == ecl_smm_synonym) {
strm = SYNONYM_STREAM_STREAM(strm);
goto AGAIN;
}
cl_env_ptr the_env = ecl_process_env();
cl_object sym = SYNONYM_STREAM_SYMBOL(strm);
strm = Null(sym) ? sym : ECL_SYM_VAL(the_env, sym);
if(strm==OBJNULL)
ecl_ferror2(ECL_EX_V_UNBND, sym);
goto AGAIN; }
output = strm->stream.format;
@(return output);
}
@ -467,29 +482,3 @@ si_copy_stream(cl_object in, cl_object out, cl_object wait)
ecl_force_output(out);
@(return ((c==EOF) ? ECL_T : ECL_NIL));
}
cl_object
si_file_stream_fd(cl_object s)
{
cl_object ret;
unlikely_if (!ECL_FILE_STREAM_P(s)) {
ecl_not_a_file_stream(s);
}
switch ((enum ecl_smmode)s->stream.mode) {
case ecl_smm_input:
case ecl_smm_output:
case ecl_smm_io:
ret = ecl_make_fixnum(fileno(IO_STREAM_FILE(s)));
break;
case ecl_smm_input_file:
case ecl_smm_output_file:
case ecl_smm_io_file:
ret = ecl_make_fixnum(IO_FILE_DESCRIPTOR(s));
break;
default:
ecl_internal_error("not a file stream");
}
@(return ret);
}

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

@ -23,52 +23,31 @@
cl_object
ecl_not_a_file_stream(cl_object strm)
{
cl_error(9, @'simple-type-error', @':format-control',
@"~A is not an file stream",
@':format-arguments', cl_list(1, strm),
@':expected-type', @'file-stream',
@':datum', strm);
ecl_ferror(ECL_EX_BADARG, @[file-stream], strm);
}
void
ecl_not_an_input_stream(cl_object strm)
{
cl_error(9, @'simple-type-error', @':format-control',
@"~A is not an input stream",
@':format-arguments', cl_list(1, strm),
@':expected-type',
cl_list(2, @'satisfies', @'input-stream-p'),
@':datum', strm);
ecl_ferror(ECL_EX_UNSATISFIED, @[input-stream-p], strm);
}
void
ecl_not_an_output_stream(cl_object strm)
{
cl_error(9, @'simple-type-error', @':format-control',
@"~A is not an output stream",
@':format-arguments', cl_list(1, strm),
@':expected-type', cl_list(2, @'satisfies', @'output-stream-p'),
@':datum', strm);
ecl_ferror(ECL_EX_UNSATISFIED, @[output-stream-p], strm);
}
static void
not_a_character_stream(cl_object s)
not_a_character_stream(cl_object strm)
{
cl_error(9, @'simple-type-error', @':format-control',
@"~A is not a character stream",
@':format-arguments', cl_list(1, s),
@':expected-type', @'character',
@':datum', cl_stream_element_type(s));
ecl_ferror(ECL_EX_STRM_BADELT, @[character], strm);
}
static void
not_a_binary_stream(cl_object s)
not_a_binary_stream(cl_object strm)
{
cl_error(9, @'simple-type-error', @':format-control',
@"~A is not a binary stream",
@':format-arguments', cl_list(1, s),
@':expected-type', @'integer',
@':datum', cl_stream_element_type(s));
ecl_ferror(ECL_EX_STRM_BADELT, @[integer], strm);
}
/**********************************************************************
@ -235,14 +214,14 @@ ecl_unknown_column(cl_object strm)
static cl_index
closed_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
return 0;
}
static cl_index
closed_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
return 0;
}
@ -268,34 +247,34 @@ closed_stream_unread_byte(cl_object strm, cl_object byte)
static ecl_character
closed_stream_read_char(cl_object strm)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
return 0;
}
static ecl_character
closed_stream_write_char(cl_object strm, ecl_character c)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
return c;
}
static void
closed_stream_unread_char(cl_object strm, ecl_character c)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
}
static int
closed_stream_listen(cl_object strm)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
return 0;
}
static void
closed_stream_clear_input(cl_object strm)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
}
#define closed_stream_clear_output closed_stream_clear_input
@ -305,7 +284,7 @@ closed_stream_clear_input(cl_object strm)
static cl_object
closed_stream_length(cl_object strm)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
}
#define closed_stream_get_position closed_stream_length
@ -313,7 +292,7 @@ closed_stream_length(cl_object strm)
static cl_object
closed_stream_set_position(cl_object strm, cl_object position)
{
FEclosed_stream(strm);
ecl_ferror(ECL_EX_STRM_CLOSED, strm, ECL_NIL);
}
/**********************************************************************
@ -459,4 +438,3 @@ ecl_generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index
}
return start;
}

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

@ -194,7 +194,6 @@ const struct ecl_file_ops two_way_ops = {
two_way_close
};
cl_object
cl_make_two_way_stream(cl_object istrm, cl_object ostrm)
{

2
src/c/symbols_list.h
View file

@ -1187,6 +1187,8 @@ cl_symbols[] = {
{SYS_ "EXPAND-DEFMACRO" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "FILE-COLUMN" ECL_FUN("si_file_column", si_file_column, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{EXT_ "FILE-KIND" ECL_FUN("si_file_kind", si_file_kind, 2) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{SYS_ "FILE-POSITION-GET" ECL_FUN("si_file_position_get", si_file_position_get, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "FILE-POSITION-SET" ECL_FUN("si_file_position_set", si_file_position_set, 2) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "FILL-POINTER-SET" ECL_FUN("si_fill_pointer_set", si_fill_pointer_set, 2) ECL_VAR(SI_ORDINARY, OBJNULL)},
{EXT_ "FILE-STREAM-FD" ECL_FUN("si_file_stream_fd", si_file_stream_fd, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{EXT_ "MAKE-STREAM-FROM-FD" ECL_FUN(NULL, NULL, -1) ECL_VAR(EXT_ORDINARY, OBJNULL)},

23
src/h/external.h
View file

@ -568,7 +568,10 @@ extern ECL_API void FEerror(const char *s, int narg, ...) ecl_attr_noreturn;
extern ECL_API void FEcannot_open(cl_object fn) ecl_attr_noreturn;
extern ECL_API void FEend_of_file(cl_object strm) ecl_attr_noreturn;
extern ECL_API void FEclosed_stream(cl_object strm) ecl_attr_noreturn;
extern ECL_API void FEunread_stream(cl_object strm, cl_object twice) ecl_attr_noreturn;
extern ECL_API void FEwrong_type_argument(cl_object type, cl_object value) ecl_attr_noreturn;
extern ECL_API void FEwrong_type_pred_arg(cl_object type, cl_object value) ecl_attr_noreturn;
extern ECL_API void FEwrong_type_strm_elt(cl_object type, cl_object value) ecl_attr_noreturn;
extern ECL_API void FEwrong_type_only_arg(cl_object function, cl_object type, cl_object value) ecl_attr_noreturn;
extern ECL_API void FEwrong_type_nth_arg(cl_object function, cl_narg narg, cl_object value, cl_object type) ecl_attr_noreturn;
extern ECL_API void FEwrong_type_key_arg(cl_object function, cl_object keyo, cl_object type, cl_object value) ecl_attr_noreturn;
@ -672,8 +675,20 @@ 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);
extern ECL_API cl_object si_write_char(cl_object strm, cl_object c);
extern ECL_API cl_object si_write_byte(cl_object strm, cl_object c);
extern ECL_API cl_object si_read_char(cl_object strm, cl_object eof_value);
extern ECL_API cl_object si_read_byte(cl_object strm, cl_object eof_value);
extern ECL_API cl_object si_peek_char(cl_object strm, cl_object eof_value);
extern ECL_API cl_object si_peek_byte(cl_object strm, cl_object eof_value);
extern ECL_API cl_object si_unread_char(cl_object strm, cl_object c);
extern ECL_API cl_object si_unread_byte(cl_object strm, cl_object byte);
extern ECL_API cl_object si_listen(cl_object strm);
extern ECL_API cl_object si_clear_input(cl_object strm);
extern ECL_API cl_object si_finish_output(cl_object strm);
extern ECL_API cl_object si_force_output(cl_object strm);
extern ECL_API cl_object si_clear_output(cl_object strm);
/* file.c */
@ -716,6 +731,8 @@ extern ECL_API cl_object cl_file_string_length(cl_object stream, cl_object strin
extern ECL_API cl_object si_do_write_sequence(cl_object string, cl_object stream, cl_object start, cl_object end);
extern ECL_API cl_object si_do_read_sequence(cl_object string, cl_object stream, cl_object start, cl_object end);
extern ECL_API cl_object si_file_column(cl_object strm);
extern ECL_API cl_object si_file_position_get(cl_object strm);
extern ECL_API cl_object si_file_position_set(cl_object strm, cl_object position);
extern ECL_API cl_object cl_interactive_stream_p(cl_object strm);
#if defined(ECL_MS_WINDOWS_HOST)
extern ECL_API cl_object si_windows_codepage_encoding();
@ -730,6 +747,8 @@ extern ECL_API bool ecl_interactive_stream_p(cl_object strm);
extern ECL_API cl_object ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist, cl_fixnum byte_size, int flags, cl_object external_format);
extern ECL_API cl_object ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend);
extern ECL_API cl_object ecl_make_string_output_stream(cl_index line_length, int extended);
extern ECL_API cl_index ecl_read_byte8(cl_object strm, unsigned char *c, cl_index n);
extern ECL_API cl_index ecl_write_byte8(cl_object strm, unsigned char *c, cl_index n);
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);

4
src/h/internal.h
View file

@ -416,8 +416,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 unreading to stream ~D", 1, s)
#define ecl_unread_twice(s) FEerror("Unread twice twice to stream ~D", 1, s)
#define ecl_unread_error(s) ecl_ferror(ECL_EX_STRM_UNREAD, strm, ECL_NIL);
#define ecl_unread_twice(s) ecl_ferror(ECL_EX_STRM_UNREAD, strm, ECL_T);
/* streams/strm_common.d */
cl_object ecl_not_a_file_stream(cl_object strm);

10
src/h/object.h
View file

@ -598,6 +598,7 @@ enum ecl_smmode { /* stream mode */
ecl_smm_string_input, /* string input */
ecl_smm_string_output, /* string output */
ecl_smm_probe, /* probe (only used in open_stream()) */
ecl_smm_other, /* custom stream implementation */
#if defined(ECL_WSOCK)
ecl_smm_input_wsock, /* input socket (Win32) */
ecl_smm_output_wsock, /* output socket (Win32) */
@ -976,6 +977,15 @@ typedef enum {
ECL_EX_CS_OVR, /* stack overflow */
ECL_EX_FRS_OVR, /* stack overflow */
ECL_EX_BDS_OVR, /* stack overflow */
ECL_EX_BADARG, /* wrong type of argument */
ECL_EX_BADARG_ONLY, /* wrong type of the only argument */
ECL_EX_UNSATISFIED, /* wrong type of argument (predicate) */
ECL_EX_EOF, /* end of file */
ECL_EX_NIY, /* not implemented yet */
ECL_EX_NAO, /* not applicable operation */
ECL_EX_STRM_BADELT, /* invalid stream element type */
ECL_EX_STRM_CLOSED, /* the stream is closed */
ECL_EX_STRM_UNREAD, /* error while unreading into the stream */
/* Kludges for the bytecodes VM */
ECL_EX_VM_BADARG_EXCD,
ECL_EX_VM_BADARG_UNKK,