mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-12 16:00:31 -07:00
Merge branch 'refactor-streams' into 'develop'
Split file.d into various stream implementations See merge request embeddable-common-lisp/ecl!351
This commit is contained in:
Marius Gerbershagen
commit
a7126313d9
16 changed files with 6614 additions and 6274 deletions
|
|
@ -13,7 +13,7 @@ ECL_FPE_CODE=fpe_x86.c
|
|||
!if "$(ECL_THREADS)" != ""
|
||||
ECL_THREADS_FLAG=1
|
||||
THREADS_OBJ= thread.obj mutex.obj condition_variable.obj rwlock.obj \
|
||||
semaphore.obj barrier.obj mailbox.obj atomic.obj
|
||||
semaphore.obj barrier.obj mailbox.obj
|
||||
!else
|
||||
ECL_THREADS_FLAG=0
|
||||
THREADS_OBJ=
|
||||
|
|
@ -79,40 +79,42 @@ HFILES = ..\ecl\config.h ..\ecl\config-internal.h ..\ecl\atomic_ops.h \
|
|||
$(HDIR)\cache.h $(HDIR)\stack-resize.h \
|
||||
$(HDIR)\ecl_atomics.h
|
||||
|
||||
OBJS = main.obj symbol.obj package.obj cons.obj list.obj\
|
||||
apply.obj eval.obj \
|
||||
interpreter.obj compiler.obj disassembler.obj \
|
||||
instance.obj gfun.obj cache.obj accessor.obj \
|
||||
reference.obj character.obj\
|
||||
file.obj read.obj print.obj error.obj string.obj cfun.obj\
|
||||
parse_integer.obj parse_number.obj \
|
||||
float_to_digits.obj float_to_string.obj \
|
||||
integer_to_string.obj write_ugly.obj \
|
||||
write_object.obj write_symbol.obj \
|
||||
write_array.obj write_list.obj write_code.obj \
|
||||
write_sse.obj print_unreadable.obj \
|
||||
libraries.obj backtrace.obj mmap.obj cdata.obj \
|
||||
cos.obj sin.obj tan.obj atan.obj \
|
||||
cosh.obj sinh.obj tanh.obj \
|
||||
exp.obj expt.obj log.obj \
|
||||
sqrt.obj abs.obj \
|
||||
zerop.obj plusp.obj minusp.obj \
|
||||
negate.obj conjugate.obj \
|
||||
one_plus.obj one_minus.obj \
|
||||
CLOS_OBJS = cache.obj accessor.obj instance.obj gfun.obj
|
||||
|
||||
NUM_OBJS = number.obj num_pred.obj num_arith.obj num_co.obj num_log.obj num_rand.obj \
|
||||
cos.obj sin.obj tan.obj atan.obj \
|
||||
cosh.obj sinh.obj tanh.obj exp.obj \
|
||||
expt.obj log.obj sqrt.obj abs.obj \
|
||||
zerop.obj plusp.obj minusp.obj negate.obj \
|
||||
conjugate.obj one_plus.obj one_minus.obj \
|
||||
plus.obj minus.obj times.obj divide.obj \
|
||||
number_compare.obj number_equalp.obj minmax.obj \
|
||||
floor.obj ceiling.obj round.obj truncate.obj \
|
||||
typespec.obj assignment.obj \
|
||||
predicate.obj big.obj number.obj\
|
||||
num_pred.obj num_arith.obj num_co.obj\
|
||||
num_log.obj num_rand.obj array.obj vector_push.obj \
|
||||
sequence.obj cmpaux.obj\
|
||||
macros.obj backq.obj stacks.obj \
|
||||
time.obj unixint.obj memory.obj \
|
||||
mapfun.obj multival.obj hash.obj format.obj pathname.obj\
|
||||
structure.obj load.obj unixfsys.obj unixsys.obj \
|
||||
ffi.obj alloc_2.obj tcp.obj $(THREADS_OBJ) process.obj serialize.obj \
|
||||
$(ECL_UCD_OBJ) $(ECL_SSE_OBJ)
|
||||
floor.obj ceiling.obj round.obj truncate.obj
|
||||
|
||||
WRITER_OBJS = print.obj float_to_digits.obj float_to_string.obj \
|
||||
integer_to_string.obj write_ugly.obj \
|
||||
write_object.obj write_symbol.obj write_array.obj \
|
||||
write_list.obj write_code.obj write_sse.obj \
|
||||
print_unreadable.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
|
||||
|
||||
FFI_OBJS = ffi.obj libraries.obj backtrace.obj mmap.obj cdata.obj
|
||||
|
||||
OBJS = main.obj symbol.obj package.obj cons.obj list.obj apply.obj eval.obj \
|
||||
interpreter.obj compiler.obj disassembler.obj reference.obj character.obj \
|
||||
error.obj string.obj cfun.obj typespec.obj assignment.obj memory.obj \
|
||||
predicate.obj array.obj vector_push.obj sequence.obj cmpaux.obj macros.obj \
|
||||
backq.obj stacks.obj time.obj unixint.obj mapfun.obj multival.obj hash.obj \
|
||||
format.obj pathname.obj structure.obj load.obj unixfsys.obj unixsys.obj \
|
||||
serialize.obj atomic.obj process.obj \
|
||||
big.obj alloc_2.obj tcp.obj \
|
||||
$(BOOT_OBJS) $(NUM_OBJS) $(WRITER_OBJS) $(READER_OBJS) $(STREAM_OBJS) \
|
||||
$(CLOS_OBJS) $(FFI_OBJS) $(THREADS_OBJ) $(ECL_UCD_OBJ) $(ECL_SSE_OBJ)
|
||||
|
||||
all: $(DPP) ..\eclmin.lib ..\cinit.obj
|
||||
|
||||
|
|
@ -126,6 +128,8 @@ all: $(DPP) ..\eclmin.lib ..\cinit.obj
|
|||
$(DPP) $< $@
|
||||
{$(srcdir:\=/)/reader}.d{}.c:
|
||||
$(DPP) $< $@
|
||||
{$(srcdir:\=/)/streams}.d{}.c:
|
||||
$(DPP) $< $@
|
||||
{$(srcdir:\=/)/printer}.d{}.c:
|
||||
$(DPP) $< $@
|
||||
{$(srcdir:\=/)/ffi}.d{}.c:
|
||||
|
|
|
|||
|
|
@ -40,42 +40,52 @@ includedir=@includedir@
|
|||
# Files
|
||||
|
||||
HDIR = ../ecl
|
||||
HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h \
|
||||
$(HDIR)/object.h $(HDIR)/cs.h $(HDIR)/stacks.h \
|
||||
$(HDIR)/external.h $(HDIR)/cons.h $(HDIR)/legacy.h \
|
||||
$(HDIR)/number.h $(HDIR)/page.h $(HDIR)/bytecodes.h \
|
||||
$(HDIR)/cache.h $(HDIR)/config-internal.h $(HDIR)/ecl_atomics.h \
|
||||
$(HDIR)/ecl-inl.h $(HDIR)/internal.h $(HDIR)/stack-resize.h \
|
||||
$(HDIR)/threads.h $(HDIR)/impl/math_dispatch2.h \
|
||||
$(HDIR)/impl/math_dispatch.h $(HDIR)/impl/math_fenv.h \
|
||||
$(HDIR)/impl/math_fenv_msvc.h
|
||||
|
||||
HFILES = $(HDIR)/config.h $(HDIR)/ecl.h $(HDIR)/ecl-cmp.h $(HDIR)/object.h \
|
||||
$(HDIR)/cs.h $(HDIR)/stacks.h $(HDIR)/external.h $(HDIR)/cons.h \
|
||||
$(HDIR)/legacy.h $(HDIR)/number.h $(HDIR)/page.h $(HDIR)/bytecodes.h \
|
||||
$(HDIR)/cache.h $(HDIR)/config-internal.h $(HDIR)/ecl_atomics.h \
|
||||
$(HDIR)/ecl-inl.h $(HDIR)/internal.h $(HDIR)/stack-resize.h \
|
||||
$(HDIR)/threads.h $(HDIR)/impl/math_dispatch2.h \
|
||||
$(HDIR)/impl/math_dispatch.h $(HDIR)/impl/math_fenv.h \
|
||||
$(HDIR)/impl/math_fenv_msvc.h $(HDIR)/nucleus.h
|
||||
|
||||
BOOT_OBJS =
|
||||
|
||||
CLOS_OBJS = clos/cache.o clos/accessor.o clos/instance.o clos/gfun.o
|
||||
OBJS = main.o symbol.o package.o cons.o list.o apply.o eval.o \
|
||||
interpreter.o compiler.o disassembler.o $(CLOS_OBJS) \
|
||||
reference.o character.o file.o read.o print.o error.o \
|
||||
string.o cfun.o reader/parse_integer.o reader/parse_number.o \
|
||||
printer/float_to_digits.o printer/float_to_string.o \
|
||||
printer/integer_to_string.o printer/write_ugly.o \
|
||||
printer/write_object.o printer/write_symbol.o \
|
||||
printer/write_array.o printer/write_list.o \
|
||||
printer/write_code.o printer/write_sse.o \
|
||||
printer/print_unreadable.o ffi/libraries.o ffi/backtrace.o \
|
||||
ffi/mmap.o ffi/cdata.o numbers/cos.o numbers/sin.o \
|
||||
numbers/tan.o numbers/atan.o numbers/cosh.o numbers/sinh.o \
|
||||
numbers/tanh.o numbers/exp.o numbers/expt.o numbers/log.o \
|
||||
numbers/sqrt.o numbers/abs.o numbers/zerop.o numbers/plusp.o \
|
||||
numbers/minusp.o numbers/negate.o numbers/conjugate.o \
|
||||
numbers/one_plus.o numbers/one_minus.o numbers/plus.o \
|
||||
numbers/minus.o numbers/times.o numbers/divide.o \
|
||||
numbers/number_compare.o numbers/number_equalp.o \
|
||||
numbers/minmax.o numbers/floor.o numbers/ceiling.o \
|
||||
numbers/round.o numbers/truncate.o typespec.o assignment.o \
|
||||
memory.o predicate.o number.o num_pred.o num_arith.o num_co.o \
|
||||
num_log.o num_rand.o array.o vector_push.o sequence.o \
|
||||
cmpaux.o macros.o backq.o stacks.o time.o unixint.o mapfun.o \
|
||||
multival.o hash.o format.o pathname.o structure.o load.o \
|
||||
unixfsys.o unixsys.o serialize.o ffi.o sse2.o @EXTRA_OBJS@ \
|
||||
threads/atomic.o process.o
|
||||
|
||||
NUM_OBJS = number.o num_pred.o num_arith.o num_co.o num_log.o num_rand.o \
|
||||
numbers/cos.o numbers/sin.o numbers/tan.o numbers/atan.o \
|
||||
numbers/cosh.o numbers/sinh.o numbers/tanh.o numbers/exp.o \
|
||||
numbers/expt.o numbers/log.o numbers/sqrt.o numbers/abs.o \
|
||||
numbers/zerop.o numbers/plusp.o numbers/minusp.o numbers/negate.o \
|
||||
numbers/conjugate.o numbers/one_plus.o numbers/one_minus.o \
|
||||
numbers/plus.o numbers/minus.o numbers/times.o numbers/divide.o \
|
||||
numbers/number_compare.o numbers/number_equalp.o numbers/minmax.o \
|
||||
numbers/floor.o numbers/ceiling.o numbers/round.o numbers/truncate.o
|
||||
|
||||
WRITER_OBJS = print.o printer/float_to_digits.o printer/float_to_string.o \
|
||||
printer/integer_to_string.o printer/write_ugly.o \
|
||||
printer/write_object.o printer/write_symbol.o printer/write_array.o \
|
||||
printer/write_list.o printer/write_code.o printer/write_sse.o \
|
||||
printer/print_unreadable.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
|
||||
|
||||
FFI_OBJS = ffi.o ffi/libraries.o ffi/backtrace.o ffi/mmap.o ffi/cdata.o
|
||||
|
||||
OBJS = main.o symbol.o package.o cons.o list.o apply.o eval.o interpreter.o \
|
||||
compiler.o disassembler.o reference.o character.o error.o \
|
||||
string.o cfun.o typespec.o assignment.o memory.o predicate.o array.o \
|
||||
vector_push.o sequence.o cmpaux.o macros.o backq.o stacks.o time.o \
|
||||
unixint.o mapfun.o multival.o hash.o format.o pathname.o structure.o \
|
||||
load.o unixfsys.o unixsys.o serialize.o sse2.o atomic.o process.o \
|
||||
$(BOOT_OBJS) $(NUM_OBJS) $(WRITER_OBJS) $(READER_OBJS) $(STREAM_OBJS) \
|
||||
$(CLOS_OBJS) $(FFI_OBJS) @EXTRA_OBJS@
|
||||
|
||||
.PHONY: all
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* atomic.d - atomic operations
|
||||
* atomic.c - atomic operations
|
||||
*
|
||||
* Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
|
||||
* Copyright (c) 1990 Giuseppe Attardi
|
||||
|
|
@ -27,14 +27,15 @@ ecl_atomic_get(cl_object *slot)
|
|||
return old;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_atomic_push(cl_object *slot, cl_object c)
|
||||
cl_object
|
||||
ecl_atomic_psh(cl_object *slot, cl_object cons)
|
||||
{
|
||||
cl_object cons = ecl_list1(c), car;
|
||||
cl_object cdr;
|
||||
do {
|
||||
car = (cl_object)AO_load((AO_t*)slot);
|
||||
ECL_RPLACD(cons, car);
|
||||
} while (!AO_compare_and_swap_full((AO_t*)slot, (AO_t)car, (AO_t)cons));
|
||||
cdr = (cl_object)AO_load((AO_t*)slot);
|
||||
ECL_RPLACD(cons, cdr);
|
||||
} while (!AO_compare_and_swap_full((AO_t*)slot, (AO_t)cdr, (AO_t)cons));
|
||||
return cdr;
|
||||
}
|
||||
|
||||
cl_object
|
||||
6195
src/c/file.d
6195
src/c/file.d
File diff suppressed because it is too large
Load diff
492
src/c/stream.d
Normal file
492
src/c/stream.d
Normal file
|
|
@ -0,0 +1,492 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* stream.d - stream interface
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*/
|
||||
|
||||
/* -- imports --------------------------------------------------------------- */
|
||||
|
||||
#include <ecl/ecl.h>
|
||||
#include <ecl/internal.h>
|
||||
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
extern const struct ecl_file_ops clos_stream_ops;
|
||||
#endif
|
||||
|
||||
/* -- implementation -------------------------------------------------------- */
|
||||
|
||||
cl_object
|
||||
ecl_alloc_stream(void)
|
||||
{
|
||||
cl_object x = ecl_alloc_object(t_stream);
|
||||
x->stream.closed = 0;
|
||||
x->stream.file.descriptor = -1;
|
||||
x->stream.object0 =
|
||||
x->stream.object1 = OBJNULL;
|
||||
x->stream.int0 = x->stream.int1 = 0;
|
||||
x->stream.format = ECL_NIL;
|
||||
x->stream.flags = 0;
|
||||
x->stream.byte_size = 8;
|
||||
x->stream.buffer = NULL;
|
||||
x->stream.encoder = NULL;
|
||||
x->stream.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;
|
||||
}
|
||||
|
||||
struct ecl_file_ops *
|
||||
ecl_duplicate_dispatch_table(const struct ecl_file_ops *ops)
|
||||
{
|
||||
struct ecl_file_ops *new_ops = ecl_alloc_atomic(sizeof(*ops));
|
||||
*new_ops = *ops;
|
||||
return new_ops;
|
||||
}
|
||||
|
||||
const struct ecl_file_ops *
|
||||
ecl_stream_dispatch_table(cl_object strm)
|
||||
{
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (ECL_INSTANCEP(strm)) {
|
||||
return &clos_stream_ops;
|
||||
}
|
||||
#endif
|
||||
if (!ECL_ANSI_STREAM_P(strm))
|
||||
FEwrong_type_argument(@[stream], strm);
|
||||
return (const struct ecl_file_ops *)strm->stream.ops;
|
||||
}
|
||||
|
||||
cl_index
|
||||
ecl_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->read_byte8(strm, c, n);
|
||||
}
|
||||
|
||||
cl_index
|
||||
ecl_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->write_byte8(strm, c, n);
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_read_char(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->read_char(strm);
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_read_char_noeof(cl_object strm)
|
||||
{
|
||||
ecl_character c = ecl_read_char(strm);
|
||||
if (c == EOF)
|
||||
FEend_of_file(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)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->write_char(strm, c);
|
||||
}
|
||||
|
||||
void
|
||||
ecl_unread_char(ecl_character c, cl_object strm)
|
||||
{
|
||||
ecl_stream_dispatch_table(strm)->unread_char(strm, c);
|
||||
}
|
||||
|
||||
int
|
||||
ecl_listen_stream(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->listen(strm);
|
||||
}
|
||||
|
||||
void
|
||||
ecl_clear_input(cl_object strm)
|
||||
{
|
||||
ecl_stream_dispatch_table(strm)->clear_input(strm);
|
||||
}
|
||||
|
||||
void
|
||||
ecl_clear_output(cl_object strm)
|
||||
{
|
||||
ecl_stream_dispatch_table(strm)->clear_output(strm);
|
||||
}
|
||||
|
||||
void
|
||||
ecl_force_output(cl_object strm)
|
||||
{
|
||||
ecl_stream_dispatch_table(strm)->force_output(strm);
|
||||
}
|
||||
|
||||
void
|
||||
ecl_finish_output(cl_object strm)
|
||||
{
|
||||
ecl_stream_dispatch_table(strm)->finish_output(strm);
|
||||
}
|
||||
|
||||
int
|
||||
ecl_file_column(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->column(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_file_length(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->length(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_file_position(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->get_position(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_file_position_set(cl_object strm, cl_object pos)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->set_position(strm, pos);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_file_string_length(cl_object strm, cl_object string)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->string_length(strm, string);
|
||||
}
|
||||
|
||||
bool
|
||||
ecl_input_stream_p(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->input_p(strm);
|
||||
}
|
||||
|
||||
bool
|
||||
ecl_output_stream_p(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->output_p(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_stream_element_type(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->element_type(strm);
|
||||
}
|
||||
|
||||
bool
|
||||
ecl_interactive_stream_p(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->interactive_p(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_stream_pathname(cl_object strm)
|
||||
{
|
||||
return ecl_stream_dispatch_table(strm)->pathname(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
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
|
||||
si_read_char(cl_object strm, cl_object eof_value)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_character c = ecl_read_char(strm);
|
||||
ecl_return1(the_env, (c==EOF) ? eof_value : ECL_CODE_CHAR(c));
|
||||
}
|
||||
|
||||
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_return1(the_env, ECL_NIL);
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_peek_char(cl_object strm, cl_object eof_value)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_character c = ecl_peek_char(strm);
|
||||
ecl_return1(the_env, (c==EOF)? eof_value : ECL_CODE_CHAR(c));
|
||||
}
|
||||
|
||||
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_return1(the_env, c);
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
/* These two interfaces are clearly missing in the ANSI standard. */
|
||||
#if 0
|
||||
cl_object
|
||||
si_unread_byte(cl_object strm, cl_object byte)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_unread_byte(byte, strm);
|
||||
ecl_return1(the_env, ECL_NIL);
|
||||
}
|
||||
|
||||
cl_object
|
||||
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);
|
||||
}
|
||||
#endif
|
||||
|
||||
cl_object
|
||||
si_write_byte(cl_object strm, cl_object byte)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_write_byte(byte, strm);
|
||||
ecl_return1(the_env, byte);
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_listen(cl_object strm)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_return1(the_env, ((ecl_listen_stream(strm) == ECL_LISTEN_AVAILABLE)
|
||||
? ECL_T : ECL_NIL));
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_clear_input(cl_object strm)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_clear_input(strm);
|
||||
ecl_return1(the_env, ECL_NIL);
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_finish_output(cl_object strm)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_finish_output(strm);
|
||||
ecl_return1(the_env, ECL_NIL);
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_force_output(cl_object strm)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_force_output(strm);
|
||||
ecl_return1(the_env, ECL_NIL);
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_clear_output(cl_object strm)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_process_env();
|
||||
ecl_clear_output(strm);
|
||||
ecl_return1(the_env, ECL_NIL);
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_file_column(cl_object strm)
|
||||
{
|
||||
int column = ecl_file_column(strm);
|
||||
@(return (column >= 0 ? ecl_make_fixnum(column) : ECL_NIL));
|
||||
}
|
||||
|
||||
cl_object
|
||||
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
|
||||
cl_input_stream_p(cl_object strm)
|
||||
{
|
||||
@(return (ecl_input_stream_p(strm) ? ECL_T : ECL_NIL));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_output_stream_p(cl_object strm)
|
||||
{
|
||||
@(return (ecl_output_stream_p(strm) ? ECL_T : ECL_NIL));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_interactive_stream_p(cl_object strm)
|
||||
{
|
||||
@(return (ecl_stream_dispatch_table(strm)->interactive_p(strm)? ECL_T : ECL_NIL));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_open_stream_p(cl_object strm)
|
||||
{
|
||||
/* ANSI and Cltl2 specify that open-stream-p should work
|
||||
on closed streams, and that a stream is only closed
|
||||
when #'close has been applied on it */
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (ECL_INSTANCEP(strm)) {
|
||||
return _ecl_funcall2(@'gray::open-stream-p', strm);
|
||||
}
|
||||
#endif
|
||||
unlikely_if (!ECL_ANSI_STREAM_P(strm))
|
||||
FEwrong_type_only_arg(@'open-stream-p', strm, @'stream');
|
||||
@(return (strm->stream.closed ? ECL_NIL : ECL_T));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_stream_element_type(cl_object strm)
|
||||
{
|
||||
@(return ecl_stream_element_type(strm));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_stream_external_format(cl_object strm)
|
||||
{
|
||||
cl_object output;
|
||||
cl_type t;
|
||||
AGAIN:
|
||||
t= ecl_t_of(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (t == t_instance)
|
||||
output = @':default';
|
||||
else
|
||||
#endif
|
||||
unlikely_if (t != t_stream)
|
||||
FEwrong_type_only_arg(@[stream-external-format], strm, @[stream]);
|
||||
if (strm->stream.mode == ecl_smm_synonym) {
|
||||
strm = SYNONYM_STREAM_STREAM(strm);
|
||||
goto AGAIN;
|
||||
}
|
||||
output = strm->stream.format;
|
||||
@(return output);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_streamp(cl_object strm)
|
||||
{
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (ECL_INSTANCEP(strm)) {
|
||||
return _ecl_funcall2(@'gray::streamp', strm);
|
||||
}
|
||||
#endif
|
||||
@(return (ECL_ANSI_STREAM_P(strm) ? ECL_T : ECL_NIL));
|
||||
}
|
||||
|
||||
/* -- Miscellaneous --------------------------------------------------------- */
|
||||
|
||||
cl_object
|
||||
si_copy_stream(cl_object in, cl_object out, cl_object wait)
|
||||
{
|
||||
ecl_character c;
|
||||
if ((wait == ECL_NIL) && !ecl_listen_stream(in)) {
|
||||
return ECL_NIL;
|
||||
}
|
||||
for (c = ecl_read_char(in); c != EOF; c = ecl_read_char(in)) {
|
||||
ecl_write_char(c, out);
|
||||
if ((wait == ECL_NIL) && !ecl_listen_stream(in)) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
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);
|
||||
}
|
||||
256
src/c/streams/strm_clos.d
Normal file
256
src/c/streams/strm_clos.d
Normal file
|
|
@ -0,0 +1,256 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* strm_clos.d - Gray Streams dispatch table
|
||||
*
|
||||
* 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>
|
||||
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
static cl_index
|
||||
clos_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
cl_index i;
|
||||
for (i = 0; i < n; i++) {
|
||||
cl_object byte = _ecl_funcall2(@'gray::stream-read-byte', strm);
|
||||
if (!ECL_FIXNUMP(byte))
|
||||
break;
|
||||
c[i] = ecl_fixnum(byte);
|
||||
}
|
||||
return i;
|
||||
}
|
||||
|
||||
static cl_index
|
||||
clos_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
cl_index i;
|
||||
for (i = 0; i < n; i++) {
|
||||
cl_object byte = _ecl_funcall3(@'gray::stream-write-byte', strm,
|
||||
ecl_make_fixnum(c[i]));
|
||||
if (!ECL_FIXNUMP(byte))
|
||||
break;
|
||||
}
|
||||
return i;
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
static void
|
||||
clos_stream_write_byte(cl_object strm, cl_object c)
|
||||
{
|
||||
_ecl_funcall3(@'gray::stream-write-byte', strm, c);
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
clos_stream_read_char(cl_object strm)
|
||||
{
|
||||
cl_object output = _ecl_funcall2(@'gray::stream-read-char', strm);
|
||||
cl_fixnum value;
|
||||
if (ECL_CHARACTERP(output))
|
||||
value = ECL_CHAR_CODE(output);
|
||||
else if (ECL_FIXNUMP(output))
|
||||
value = ecl_fixnum(output);
|
||||
else if (output == ECL_NIL || output == @':eof')
|
||||
return EOF;
|
||||
else
|
||||
value = -1;
|
||||
unlikely_if (value < 0 || value > ECL_CHAR_CODE_LIMIT)
|
||||
FEerror("Unknown character ~A", 1, output);
|
||||
return value;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
clos_stream_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
_ecl_funcall3(@'gray::stream-write-char', strm, ECL_CODE_CHAR(c));
|
||||
return c;
|
||||
}
|
||||
|
||||
static void
|
||||
clos_stream_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
_ecl_funcall3(@'gray::stream-unread-char', strm, ECL_CODE_CHAR(c));
|
||||
}
|
||||
|
||||
static int
|
||||
clos_stream_peek_char(cl_object strm)
|
||||
{
|
||||
cl_object out = _ecl_funcall2(@'gray::stream-peek-char', strm);
|
||||
if (out == @':eof') return EOF;
|
||||
return ecl_char_code(out);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
clos_stream_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end)
|
||||
{
|
||||
return fixnnint(_ecl_funcall5(@'gray::stream-read-sequence', strm, data, ecl_make_fixnum(start), ecl_make_fixnum(end)));
|
||||
}
|
||||
|
||||
static cl_index
|
||||
clos_stream_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end)
|
||||
{
|
||||
_ecl_funcall5(@'gray::stream-write-sequence', strm, data, ecl_make_fixnum(start), ecl_make_fixnum(end));
|
||||
if (start >= end)
|
||||
return start;
|
||||
return end;
|
||||
}
|
||||
|
||||
static int
|
||||
clos_stream_listen(cl_object strm)
|
||||
{
|
||||
return !Null(_ecl_funcall2(@'gray::stream-listen', strm));
|
||||
}
|
||||
|
||||
static void
|
||||
clos_stream_clear_input(cl_object strm)
|
||||
{
|
||||
_ecl_funcall2(@'gray::stream-clear-input', strm);
|
||||
}
|
||||
|
||||
static void
|
||||
clos_stream_clear_output(cl_object strm)
|
||||
{
|
||||
_ecl_funcall2(@'gray::stream-clear-output', strm);
|
||||
return;
|
||||
}
|
||||
|
||||
static void
|
||||
clos_stream_force_output(cl_object strm)
|
||||
{
|
||||
_ecl_funcall2(@'gray::stream-force-output', strm);
|
||||
}
|
||||
|
||||
static void
|
||||
clos_stream_finish_output(cl_object strm)
|
||||
{
|
||||
_ecl_funcall2(@'gray::stream-finish-output', strm);
|
||||
}
|
||||
|
||||
static int
|
||||
clos_stream_input_p(cl_object strm)
|
||||
{
|
||||
return !Null(_ecl_funcall2(@'gray::input-stream-p', strm));
|
||||
}
|
||||
|
||||
static int
|
||||
clos_stream_output_p(cl_object strm)
|
||||
{
|
||||
return !Null(_ecl_funcall2(@'gray::output-stream-p', strm));
|
||||
}
|
||||
|
||||
static int
|
||||
clos_stream_interactive_p(cl_object strm)
|
||||
{
|
||||
return !Null(_ecl_funcall2(@'gray::stream-interactive-p', strm));
|
||||
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_element_type(cl_object strm)
|
||||
{
|
||||
return _ecl_funcall2(@'gray::stream-element-type', strm);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_length(cl_object strm)
|
||||
{
|
||||
return _ecl_funcall2(@'gray::stream-file-length', strm);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_get_position(cl_object strm)
|
||||
{
|
||||
return _ecl_funcall2(@'gray::stream-file-position', strm);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_set_position(cl_object strm, cl_object pos)
|
||||
{
|
||||
return _ecl_funcall3(@'gray::stream-file-position', strm, pos);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_string_length(cl_object strm, cl_object string)
|
||||
{
|
||||
return _ecl_funcall3(@'gray::stream-file-string-length', strm, string);
|
||||
}
|
||||
|
||||
static int
|
||||
clos_stream_column(cl_object strm)
|
||||
{
|
||||
cl_object col = _ecl_funcall2(@'gray::stream-line-column', strm);
|
||||
return Null(col)? -1 : ecl_to_size(ecl_floor1(col));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_pathname(cl_object strm)
|
||||
{
|
||||
return _ecl_funcall2(@'gray::pathname', strm);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_truename(cl_object strm)
|
||||
{
|
||||
return _ecl_funcall2(@'gray::truename', strm);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
clos_stream_close(cl_object strm)
|
||||
{
|
||||
return _ecl_funcall2(@'gray::close', strm);
|
||||
}
|
||||
|
||||
const struct ecl_file_ops clos_stream_ops = {
|
||||
clos_stream_write_byte8,
|
||||
clos_stream_read_byte8,
|
||||
|
||||
clos_stream_write_byte,
|
||||
clos_stream_read_byte,
|
||||
|
||||
clos_stream_read_char,
|
||||
clos_stream_write_char,
|
||||
clos_stream_unread_char,
|
||||
clos_stream_peek_char,
|
||||
|
||||
clos_stream_read_vector,
|
||||
clos_stream_write_vector,
|
||||
|
||||
clos_stream_listen,
|
||||
clos_stream_clear_input,
|
||||
clos_stream_clear_output,
|
||||
clos_stream_finish_output,
|
||||
clos_stream_force_output,
|
||||
|
||||
clos_stream_input_p,
|
||||
clos_stream_output_p,
|
||||
clos_stream_interactive_p,
|
||||
clos_stream_element_type,
|
||||
|
||||
clos_stream_length,
|
||||
clos_stream_get_position,
|
||||
clos_stream_set_position,
|
||||
clos_stream_string_length,
|
||||
clos_stream_column,
|
||||
|
||||
clos_stream_pathname,
|
||||
clos_stream_truename,
|
||||
|
||||
clos_stream_close
|
||||
};
|
||||
#endif /* ECL_CLOS_STREAMS */
|
||||
539
src/c/streams/strm_common.d
Normal file
539
src/c/streams/strm_common.d
Normal file
|
|
@ -0,0 +1,539 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* strm_common.d - common functions and helpers 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>
|
||||
|
||||
/**********************************************************************
|
||||
* NOT A #<stream-type> STREAM
|
||||
*/
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
static void
|
||||
not_a_character_stream(cl_object s)
|
||||
{
|
||||
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));
|
||||
}
|
||||
|
||||
static void
|
||||
not_a_binary_stream(cl_object s)
|
||||
{
|
||||
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));
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* NOT IMPLEMENTED or NOT APPLICABLE OPERATIONS
|
||||
*/
|
||||
|
||||
cl_index
|
||||
ecl_not_output_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
ecl_not_an_output_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
cl_index
|
||||
ecl_not_input_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
ecl_not_an_input_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
cl_index
|
||||
ecl_not_binary_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
not_a_binary_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_not_output_write_byte(cl_object strm, cl_object byte)
|
||||
{
|
||||
ecl_not_an_output_stream(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_not_input_read_byte(cl_object strm)
|
||||
{
|
||||
ecl_not_an_input_stream(strm);
|
||||
return OBJNULL;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_not_binary_write_byte(cl_object strm, cl_object byte)
|
||||
{
|
||||
not_a_binary_stream(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_not_binary_read_byte(cl_object strm)
|
||||
{
|
||||
not_a_binary_stream(strm);
|
||||
return OBJNULL;
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_not_input_read_char(cl_object strm)
|
||||
{
|
||||
ecl_not_an_input_stream(strm);
|
||||
return -1;
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_not_output_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
ecl_not_an_output_stream(strm);
|
||||
return c;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_not_input_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
ecl_not_an_input_stream(strm);
|
||||
}
|
||||
|
||||
int
|
||||
ecl_not_input_listen(cl_object strm)
|
||||
{
|
||||
ecl_not_an_input_stream(strm);
|
||||
return -1;
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_not_character_read_char(cl_object strm)
|
||||
{
|
||||
not_a_character_stream(strm);
|
||||
return -1;
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_not_character_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
not_a_character_stream(strm);
|
||||
return c;
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_not_character_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
not_a_character_stream(stream);
|
||||
return EOF;
|
||||
}
|
||||
|
||||
int
|
||||
ecl_not_character_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
not_a_character_stream(stream);
|
||||
return 0;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_not_input_clear_input(cl_object strm)
|
||||
{
|
||||
ecl_not_an_input_stream(strm);
|
||||
return;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_not_output_clear_output(cl_object strm)
|
||||
{
|
||||
ecl_not_an_output_stream(strm);
|
||||
}
|
||||
|
||||
void
|
||||
ecl_not_output_force_output(cl_object strm)
|
||||
{
|
||||
ecl_not_an_output_stream(strm);
|
||||
}
|
||||
|
||||
void
|
||||
ecl_not_output_finish_output(cl_object strm)
|
||||
{
|
||||
ecl_not_an_output_stream(strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_not_output_string_length(cl_object strm, cl_object string)
|
||||
{
|
||||
ecl_not_an_output_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_not_file_string_length(cl_object strm, cl_object string)
|
||||
{
|
||||
ecl_not_a_file_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
int
|
||||
ecl_unknown_column(cl_object strm)
|
||||
{
|
||||
return -1;
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* CLOSED STREAM OPS
|
||||
*/
|
||||
|
||||
static cl_index
|
||||
closed_stream_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static cl_index
|
||||
closed_stream_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
closed_stream_read_char(cl_object strm)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
closed_stream_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
return c;
|
||||
}
|
||||
|
||||
static void
|
||||
closed_stream_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
}
|
||||
|
||||
static int
|
||||
closed_stream_listen(cl_object strm)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void
|
||||
closed_stream_clear_input(cl_object strm)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
}
|
||||
|
||||
#define closed_stream_clear_output closed_stream_clear_input
|
||||
#define closed_stream_force_output closed_stream_clear_input
|
||||
#define closed_stream_finish_output closed_stream_clear_input
|
||||
|
||||
static cl_object
|
||||
closed_stream_length(cl_object strm)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
}
|
||||
|
||||
#define closed_stream_get_position closed_stream_length
|
||||
|
||||
static cl_object
|
||||
closed_stream_set_position(cl_object strm, cl_object position)
|
||||
{
|
||||
FEclosed_stream(strm);
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* GENERIC OPERATIONS
|
||||
*
|
||||
* 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)
|
||||
{
|
||||
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);
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_generic_peek_char(cl_object strm)
|
||||
{
|
||||
ecl_character out = ecl_read_char(strm);
|
||||
if (out != EOF) ecl_unread_char(out, strm);
|
||||
return out;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_generic_void(cl_object strm)
|
||||
{
|
||||
}
|
||||
|
||||
int
|
||||
ecl_generic_always_true(cl_object strm)
|
||||
{
|
||||
return 1;
|
||||
}
|
||||
|
||||
int
|
||||
ecl_generic_always_false(cl_object strm)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_generic_always_nil(cl_object strm)
|
||||
{
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
int
|
||||
ecl_generic_column(cl_object strm)
|
||||
{
|
||||
return strm->stream.column;
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_generic_set_position(cl_object strm, cl_object pos)
|
||||
{
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
cl_object
|
||||
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_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_char = closed_stream_write_char;
|
||||
ops->clear_output = closed_stream_clear_output;
|
||||
ops->force_output = closed_stream_force_output;
|
||||
ops->finish_output = closed_stream_finish_output;
|
||||
}
|
||||
ops->get_position = closed_stream_get_position;
|
||||
ops->set_position = closed_stream_set_position;
|
||||
ops->length = closed_stream_length;
|
||||
ops->close = ecl_generic_close;
|
||||
strm->stream.closed = 1;
|
||||
return ECL_T;
|
||||
}
|
||||
|
||||
cl_index
|
||||
ecl_generic_write_vector(cl_object strm, cl_object data, cl_index start, cl_index end)
|
||||
{
|
||||
cl_elttype elttype;
|
||||
const struct ecl_file_ops *ops;
|
||||
if (start >= end)
|
||||
return start;
|
||||
ops = ecl_stream_dispatch_table(strm);
|
||||
elttype = ecl_array_elttype(data);
|
||||
if (elttype == ecl_aet_bc ||
|
||||
#ifdef ECL_UNICODE
|
||||
elttype == ecl_aet_ch ||
|
||||
#endif
|
||||
(elttype == ecl_aet_object && ECL_CHARACTERP(ecl_elt(data, 0)))) {
|
||||
ecl_character (*write_char)(cl_object, ecl_character) = ops->write_char;
|
||||
for (; start < end; start++) {
|
||||
write_char(strm, ecl_char_code(ecl_elt(data, start)));
|
||||
}
|
||||
} else {
|
||||
void (*write_byte)(cl_object, cl_object) = ops->write_byte;
|
||||
for (; start < end; start++) {
|
||||
write_byte(strm, ecl_elt(data, start));
|
||||
}
|
||||
}
|
||||
return start;
|
||||
}
|
||||
|
||||
cl_index
|
||||
ecl_generic_read_vector(cl_object strm, cl_object data, cl_index start, cl_index end)
|
||||
{
|
||||
const struct ecl_file_ops *ops;
|
||||
cl_object expected_type;
|
||||
if (start >= end)
|
||||
return start;
|
||||
expected_type = ecl_stream_element_type(strm);
|
||||
ops = ecl_stream_dispatch_table(strm);
|
||||
if (expected_type == @'base-char' || expected_type == @'character') {
|
||||
ecl_character (*read_char)(cl_object) = ops->read_char;
|
||||
for (; start < end; start++) {
|
||||
ecl_character c = read_char(strm);
|
||||
if (c == EOF) break;
|
||||
ecl_elt_set(data, start, ECL_CODE_CHAR(c));
|
||||
}
|
||||
} else {
|
||||
cl_object (*read_byte)(cl_object) = ops->read_byte;
|
||||
for (; start < end; start++) {
|
||||
cl_object x = read_byte(strm);
|
||||
if (Null(x)) break;
|
||||
ecl_elt_set(data, start, x);
|
||||
}
|
||||
}
|
||||
return start;
|
||||
}
|
||||
|
||||
975
src/c/streams/strm_composite.d
Normal file
975
src/c/streams/strm_composite.d
Normal file
|
|
@ -0,0 +1,975 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* strm_composite.d - Composite Streams dispatch tables
|
||||
*
|
||||
* 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>
|
||||
|
||||
/**********************************************************************
|
||||
* TWO WAY STREAM
|
||||
*/
|
||||
|
||||
static cl_index
|
||||
two_way_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
if (strm == cl_core.terminal_io)
|
||||
ecl_force_output(TWO_WAY_STREAM_OUTPUT(cl_core.terminal_io));
|
||||
return ecl_read_byte8(TWO_WAY_STREAM_INPUT(strm), c, n);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
two_way_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
return ecl_write_byte8(TWO_WAY_STREAM_OUTPUT(strm), c, n);
|
||||
}
|
||||
|
||||
static void
|
||||
two_way_write_byte(cl_object strm, cl_object byte)
|
||||
{
|
||||
ecl_write_byte(byte, TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
two_way_read_byte(cl_object stream)
|
||||
{
|
||||
return ecl_read_byte(TWO_WAY_STREAM_INPUT(stream));
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
two_way_read_char(cl_object strm)
|
||||
{
|
||||
return ecl_read_char(TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
two_way_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
return ecl_write_char(c, TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
two_way_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
ecl_unread_char(c, TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
two_way_peek_char(cl_object strm)
|
||||
{
|
||||
return ecl_peek_char(TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static cl_index
|
||||
two_way_read_vector(cl_object strm, cl_object data, cl_index start, cl_index n)
|
||||
{
|
||||
strm = TWO_WAY_STREAM_INPUT(strm);
|
||||
return ecl_stream_dispatch_table(strm)->read_vector(strm, data, start, n);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
two_way_write_vector(cl_object strm, cl_object data, cl_index start, cl_index n)
|
||||
{
|
||||
strm = TWO_WAY_STREAM_OUTPUT(strm);
|
||||
return ecl_stream_dispatch_table(strm)->write_vector(strm, data, start, n);
|
||||
}
|
||||
|
||||
static int
|
||||
two_way_listen(cl_object strm)
|
||||
{
|
||||
return ecl_listen_stream(TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
two_way_clear_input(cl_object strm)
|
||||
{
|
||||
ecl_clear_input(TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
two_way_clear_output(cl_object strm)
|
||||
{
|
||||
ecl_clear_output(TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
two_way_force_output(cl_object strm)
|
||||
{
|
||||
ecl_force_output(TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
two_way_finish_output(cl_object strm)
|
||||
{
|
||||
ecl_finish_output(TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static int
|
||||
two_way_interactive_p(cl_object strm)
|
||||
{
|
||||
return ecl_interactive_stream_p(TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
two_way_element_type(cl_object strm)
|
||||
{
|
||||
return ecl_stream_element_type(TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static int
|
||||
two_way_column(cl_object strm)
|
||||
{
|
||||
return ecl_file_column(TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
two_way_close(cl_object strm)
|
||||
{
|
||||
if (strm->stream.flags & ECL_STREAM_CLOSE_COMPONENTS) {
|
||||
cl_close(1, TWO_WAY_STREAM_INPUT(strm));
|
||||
cl_close(1, TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
return ecl_generic_close(strm);
|
||||
}
|
||||
|
||||
const struct ecl_file_ops two_way_ops = {
|
||||
two_way_write_byte8,
|
||||
two_way_read_byte8,
|
||||
|
||||
two_way_write_byte,
|
||||
two_way_read_byte,
|
||||
|
||||
two_way_read_char,
|
||||
two_way_write_char,
|
||||
two_way_unread_char,
|
||||
two_way_peek_char,
|
||||
|
||||
two_way_read_vector,
|
||||
two_way_write_vector,
|
||||
|
||||
two_way_listen,
|
||||
two_way_clear_input,
|
||||
two_way_clear_output,
|
||||
two_way_finish_output,
|
||||
two_way_force_output,
|
||||
|
||||
ecl_generic_always_true, /* input_p */
|
||||
ecl_generic_always_true, /* output_p */
|
||||
two_way_interactive_p,
|
||||
two_way_element_type,
|
||||
|
||||
ecl_not_a_file_stream, /* length */
|
||||
ecl_generic_always_nil, /* get_position */
|
||||
ecl_generic_set_position,
|
||||
ecl_not_file_string_length,
|
||||
two_way_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
two_way_close
|
||||
};
|
||||
|
||||
|
||||
cl_object
|
||||
cl_make_two_way_stream(cl_object istrm, cl_object ostrm)
|
||||
{
|
||||
cl_object strm;
|
||||
if (!ecl_input_stream_p(istrm))
|
||||
ecl_not_an_input_stream(istrm);
|
||||
if (!ecl_output_stream_p(ostrm))
|
||||
ecl_not_an_output_stream(ostrm);
|
||||
strm = ecl_alloc_stream();
|
||||
strm->stream.format = cl_stream_external_format(istrm);
|
||||
strm->stream.mode = (short)ecl_smm_two_way;
|
||||
strm->stream.ops = ecl_duplicate_dispatch_table(&two_way_ops);
|
||||
TWO_WAY_STREAM_INPUT(strm) = istrm;
|
||||
TWO_WAY_STREAM_OUTPUT(strm) = ostrm;
|
||||
@(return strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_two_way_stream_input_stream(cl_object strm)
|
||||
{
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm,ecl_smm_two_way))
|
||||
FEwrong_type_only_arg(@[two-way-stream-input-stream],
|
||||
strm, @[two-way-stream]);
|
||||
@(return TWO_WAY_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_two_way_stream_output_stream(cl_object strm)
|
||||
{
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, ecl_smm_two_way))
|
||||
FEwrong_type_only_arg(@[two-way-stream-output-stream],
|
||||
strm, @[two-way-stream]);
|
||||
@(return TWO_WAY_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* BROADCAST STREAM
|
||||
*/
|
||||
|
||||
static cl_index
|
||||
broadcast_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
cl_object l;
|
||||
cl_index out = n;
|
||||
for (l = BROADCAST_STREAM_LIST(strm); !Null(l); l = ECL_CONS_CDR(l)) {
|
||||
out = ecl_write_byte8(ECL_CONS_CAR(l), c, n);
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
broadcast_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
cl_object l;
|
||||
for (l = BROADCAST_STREAM_LIST(strm); !Null(l); l = ECL_CONS_CDR(l)) {
|
||||
ecl_write_char(c, ECL_CONS_CAR(l));
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
static void
|
||||
broadcast_write_byte(cl_object strm, cl_object byte)
|
||||
{
|
||||
cl_object l;
|
||||
for (l = BROADCAST_STREAM_LIST(strm); !Null(l); l = ECL_CONS_CDR(l)) {
|
||||
ecl_write_byte(byte, ECL_CONS_CAR(l));
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
broadcast_clear_output(cl_object strm)
|
||||
{
|
||||
cl_object l;
|
||||
for (l = BROADCAST_STREAM_LIST(strm); !Null(l); l = ECL_CONS_CDR(l)) {
|
||||
ecl_clear_output(ECL_CONS_CAR(l));
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
broadcast_force_output(cl_object strm)
|
||||
{
|
||||
cl_object l;
|
||||
for (l = BROADCAST_STREAM_LIST(strm); !Null(l); l = ECL_CONS_CDR(l)) {
|
||||
ecl_force_output(ECL_CONS_CAR(l));
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
broadcast_finish_output(cl_object strm)
|
||||
{
|
||||
cl_object l;
|
||||
for (l = BROADCAST_STREAM_LIST(strm); !Null(l); l = ECL_CONS_CDR(l)) {
|
||||
ecl_finish_output(ECL_CONS_CAR(l));
|
||||
}
|
||||
}
|
||||
|
||||
static cl_object
|
||||
broadcast_element_type(cl_object strm)
|
||||
{
|
||||
cl_object l = BROADCAST_STREAM_LIST(strm);
|
||||
if (Null(l))
|
||||
return ECL_T;
|
||||
return ecl_stream_element_type(ECL_CONS_CAR(l));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
broadcast_length(cl_object strm)
|
||||
{
|
||||
cl_object l = BROADCAST_STREAM_LIST(strm);
|
||||
if (Null(l))
|
||||
return ecl_make_fixnum(0);
|
||||
return ecl_file_length(ECL_CONS_CAR(ecl_last(l, 1)));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
broadcast_get_position(cl_object strm)
|
||||
{
|
||||
cl_object l = BROADCAST_STREAM_LIST(strm);
|
||||
if (Null(l))
|
||||
return ecl_make_fixnum(0);
|
||||
return ecl_file_position(ECL_CONS_CAR(ecl_last(l, 1)));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
broadcast_set_position(cl_object strm, cl_object pos)
|
||||
{
|
||||
cl_object l = BROADCAST_STREAM_LIST(strm);
|
||||
if (Null(l))
|
||||
return ECL_NIL;
|
||||
return ecl_file_position_set(ECL_CONS_CAR(l), pos);
|
||||
}
|
||||
|
||||
cl_object
|
||||
broadcast_string_length(cl_object strm, cl_object string)
|
||||
{
|
||||
cl_object l = BROADCAST_STREAM_LIST(strm);
|
||||
if (Null(l))
|
||||
return ecl_make_fixnum(1);
|
||||
return ecl_file_string_length(ECL_CONS_CAR(ecl_last(l, 1)), string);
|
||||
}
|
||||
|
||||
static int
|
||||
broadcast_column(cl_object strm)
|
||||
{
|
||||
cl_object l = BROADCAST_STREAM_LIST(strm);
|
||||
if (Null(l))
|
||||
return 0;
|
||||
return ecl_file_column(ECL_CONS_CAR(l));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
broadcast_close(cl_object strm)
|
||||
{
|
||||
if (strm->stream.flags & ECL_STREAM_CLOSE_COMPONENTS) {
|
||||
cl_mapc(2, @'close', BROADCAST_STREAM_LIST(strm));
|
||||
}
|
||||
return ecl_generic_close(strm);
|
||||
}
|
||||
|
||||
const struct ecl_file_ops broadcast_ops = {
|
||||
broadcast_write_byte8,
|
||||
ecl_not_input_read_byte8,
|
||||
|
||||
broadcast_write_byte,
|
||||
ecl_not_input_read_byte,
|
||||
|
||||
ecl_not_input_read_char,
|
||||
broadcast_write_char,
|
||||
ecl_not_input_unread_char,
|
||||
ecl_generic_peek_char,
|
||||
|
||||
ecl_generic_read_vector,
|
||||
ecl_generic_write_vector,
|
||||
|
||||
ecl_not_input_listen,
|
||||
broadcast_force_output, /* clear_input */ /* FIXME! This is legacy behaviour */
|
||||
broadcast_clear_output,
|
||||
broadcast_finish_output,
|
||||
broadcast_force_output,
|
||||
|
||||
ecl_generic_always_false, /* input_p */
|
||||
ecl_generic_always_true, /* output_p */
|
||||
ecl_generic_always_false,
|
||||
broadcast_element_type,
|
||||
|
||||
broadcast_length,
|
||||
broadcast_get_position,
|
||||
broadcast_set_position,
|
||||
broadcast_string_length,
|
||||
broadcast_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
broadcast_close
|
||||
};
|
||||
|
||||
@(defun make_broadcast_stream (&rest ap)
|
||||
cl_object x, streams;
|
||||
int i;
|
||||
@
|
||||
streams = ECL_NIL;
|
||||
for (i = 0; i < narg; i++) {
|
||||
x = ecl_va_arg(ap);
|
||||
unlikely_if (!ecl_output_stream_p(x))
|
||||
ecl_not_an_output_stream(x);
|
||||
streams = CONS(x, streams);
|
||||
}
|
||||
x = ecl_alloc_stream();
|
||||
x->stream.format = @':default';
|
||||
x->stream.ops = ecl_duplicate_dispatch_table(&broadcast_ops);
|
||||
x->stream.mode = (short)ecl_smm_broadcast;
|
||||
BROADCAST_STREAM_LIST(x) = cl_nreverse(streams);
|
||||
@(return x);
|
||||
@)
|
||||
|
||||
cl_object
|
||||
cl_broadcast_stream_streams(cl_object strm)
|
||||
{
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, ecl_smm_broadcast))
|
||||
FEwrong_type_only_arg(@[broadcast-stream-streams],
|
||||
strm, @[broadcast-stream]);
|
||||
return cl_copy_list(BROADCAST_STREAM_LIST(strm));
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* ECHO STREAM
|
||||
*/
|
||||
|
||||
static cl_index
|
||||
echo_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
cl_index out = ecl_read_byte8(ECHO_STREAM_INPUT(strm), c, n);
|
||||
return ecl_write_byte8(ECHO_STREAM_OUTPUT(strm), c, out);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
echo_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
return ecl_write_byte8(ECHO_STREAM_OUTPUT(strm), c, n);
|
||||
}
|
||||
|
||||
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)
|
||||
{
|
||||
cl_object out = ecl_read_byte(ECHO_STREAM_INPUT(strm));
|
||||
if (!Null(out)) ecl_write_byte(out, ECHO_STREAM_OUTPUT(strm));
|
||||
return out;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
echo_read_char(cl_object strm)
|
||||
{
|
||||
ecl_character c = strm->stream.last_code[0];
|
||||
if (c == EOF) {
|
||||
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;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
echo_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
return ecl_write_char(c, ECHO_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
echo_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
unlikely_if (strm->stream.last_code[0] != EOF) {
|
||||
ecl_unread_twice(strm);
|
||||
}
|
||||
strm->stream.last_code[0] = c;
|
||||
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;
|
||||
}
|
||||
|
||||
static int
|
||||
echo_listen(cl_object strm)
|
||||
{
|
||||
return ecl_listen_stream(ECHO_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
echo_clear_input(cl_object strm)
|
||||
{
|
||||
ecl_clear_input(ECHO_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
echo_clear_output(cl_object strm)
|
||||
{
|
||||
ecl_clear_output(ECHO_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
echo_force_output(cl_object strm)
|
||||
{
|
||||
ecl_force_output(ECHO_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
echo_finish_output(cl_object strm)
|
||||
{
|
||||
ecl_finish_output(ECHO_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
echo_element_type(cl_object strm)
|
||||
{
|
||||
return ecl_stream_element_type(ECHO_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
static int
|
||||
echo_column(cl_object strm)
|
||||
{
|
||||
return ecl_file_column(ECHO_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
echo_close(cl_object strm)
|
||||
{
|
||||
if (strm->stream.flags & ECL_STREAM_CLOSE_COMPONENTS) {
|
||||
cl_close(1, ECHO_STREAM_INPUT(strm));
|
||||
cl_close(1, ECHO_STREAM_OUTPUT(strm));
|
||||
}
|
||||
return ecl_generic_close(strm);
|
||||
}
|
||||
|
||||
const struct ecl_file_ops echo_ops = {
|
||||
echo_write_byte8,
|
||||
echo_read_byte8,
|
||||
|
||||
echo_write_byte,
|
||||
echo_read_byte,
|
||||
|
||||
echo_read_char,
|
||||
echo_write_char,
|
||||
echo_unread_char,
|
||||
echo_peek_char,
|
||||
|
||||
ecl_generic_read_vector,
|
||||
ecl_generic_write_vector,
|
||||
|
||||
echo_listen,
|
||||
echo_clear_input,
|
||||
echo_clear_output,
|
||||
echo_finish_output,
|
||||
echo_force_output,
|
||||
|
||||
ecl_generic_always_true, /* input_p */
|
||||
ecl_generic_always_true, /* output_p */
|
||||
ecl_generic_always_false,
|
||||
echo_element_type,
|
||||
|
||||
ecl_not_a_file_stream, /* length */
|
||||
ecl_generic_always_nil, /* get_position */
|
||||
ecl_generic_set_position,
|
||||
ecl_not_file_string_length,
|
||||
echo_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
echo_close
|
||||
};
|
||||
|
||||
cl_object
|
||||
cl_make_echo_stream(cl_object strm1, cl_object strm2)
|
||||
{
|
||||
cl_object strm;
|
||||
unlikely_if (!ecl_input_stream_p(strm1))
|
||||
ecl_not_an_input_stream(strm1);
|
||||
unlikely_if (!ecl_output_stream_p(strm2))
|
||||
ecl_not_an_output_stream(strm2);
|
||||
strm = ecl_alloc_stream();
|
||||
strm->stream.format = cl_stream_external_format(strm1);
|
||||
strm->stream.mode = (short)ecl_smm_echo;
|
||||
strm->stream.ops = ecl_duplicate_dispatch_table(&echo_ops);
|
||||
ECHO_STREAM_INPUT(strm) = strm1;
|
||||
ECHO_STREAM_OUTPUT(strm) = strm2;
|
||||
@(return strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_echo_stream_input_stream(cl_object strm)
|
||||
{
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, ecl_smm_echo))
|
||||
FEwrong_type_only_arg(@[echo-stream-input-stream],
|
||||
strm, @[echo-stream]);
|
||||
@(return ECHO_STREAM_INPUT(strm));
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_echo_stream_output_stream(cl_object strm)
|
||||
{
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, ecl_smm_echo))
|
||||
FEwrong_type_only_arg(@[echo-stream-output-stream],
|
||||
strm, @[echo-stream]);
|
||||
@(return ECHO_STREAM_OUTPUT(strm));
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* CONCATENATED STREAM
|
||||
*/
|
||||
|
||||
static cl_index
|
||||
concatenated_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
cl_object l = CONCATENATED_STREAM_LIST(strm);
|
||||
cl_index out = 0;
|
||||
while (out < n && !Null(l)) {
|
||||
cl_index delta = ecl_read_byte8(ECL_CONS_CAR(l), c + out, n - out);
|
||||
out += delta;
|
||||
if (out == n) break;
|
||||
CONCATENATED_STREAM_LIST(strm) = l = ECL_CONS_CDR(l);
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
concatenated_read_byte(cl_object strm)
|
||||
{
|
||||
cl_object l = CONCATENATED_STREAM_LIST(strm);
|
||||
cl_object c = ECL_NIL;
|
||||
while (!Null(l)) {
|
||||
c = ecl_read_byte(ECL_CONS_CAR(l));
|
||||
if (c != ECL_NIL) break;
|
||||
CONCATENATED_STREAM_LIST(strm) = l = ECL_CONS_CDR(l);
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
concatenated_read_char(cl_object strm)
|
||||
{
|
||||
cl_object l = CONCATENATED_STREAM_LIST(strm);
|
||||
ecl_character c = EOF;
|
||||
while (!Null(l)) {
|
||||
c = ecl_read_char(ECL_CONS_CAR(l));
|
||||
if (c != EOF) break;
|
||||
CONCATENATED_STREAM_LIST(strm) = l = ECL_CONS_CDR(l);
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
static void
|
||||
concatenated_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
cl_object l = CONCATENATED_STREAM_LIST(strm);
|
||||
unlikely_if (Null(l)) {
|
||||
ecl_unread_error(strm);
|
||||
}
|
||||
ecl_unread_char(c, ECL_CONS_CAR(l));
|
||||
}
|
||||
|
||||
static int
|
||||
concatenated_listen(cl_object strm)
|
||||
{
|
||||
cl_object l = CONCATENATED_STREAM_LIST(strm);
|
||||
while (!Null(l)) {
|
||||
int f = ecl_listen_stream(ECL_CONS_CAR(l));
|
||||
l = ECL_CONS_CDR(l);
|
||||
if (f == ECL_LISTEN_EOF) {
|
||||
CONCATENATED_STREAM_LIST(strm) = l;
|
||||
} else {
|
||||
return f;
|
||||
}
|
||||
}
|
||||
return ECL_LISTEN_EOF;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
concatenated_close(cl_object strm)
|
||||
{
|
||||
if (strm->stream.flags & ECL_STREAM_CLOSE_COMPONENTS) {
|
||||
cl_mapc(2, @'close', CONCATENATED_STREAM_LIST(strm));
|
||||
}
|
||||
return ecl_generic_close(strm);
|
||||
}
|
||||
|
||||
const struct ecl_file_ops concatenated_ops = {
|
||||
ecl_not_output_write_byte8,
|
||||
concatenated_read_byte8,
|
||||
|
||||
ecl_not_output_write_byte,
|
||||
concatenated_read_byte,
|
||||
|
||||
concatenated_read_char,
|
||||
ecl_not_output_write_char,
|
||||
concatenated_unread_char,
|
||||
ecl_generic_peek_char,
|
||||
|
||||
ecl_generic_read_vector,
|
||||
ecl_generic_write_vector,
|
||||
|
||||
concatenated_listen,
|
||||
ecl_generic_void, /* clear_input */
|
||||
ecl_not_output_clear_output,
|
||||
ecl_not_output_finish_output,
|
||||
ecl_not_output_force_output,
|
||||
|
||||
ecl_generic_always_true, /* input_p */
|
||||
ecl_generic_always_false, /* output_p */
|
||||
ecl_generic_always_false,
|
||||
broadcast_element_type,
|
||||
|
||||
ecl_not_a_file_stream, /* length */
|
||||
ecl_generic_always_nil, /* get_position */
|
||||
ecl_generic_set_position,
|
||||
ecl_not_output_string_length,
|
||||
ecl_unknown_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
concatenated_close
|
||||
};
|
||||
|
||||
@(defun make_concatenated_stream (&rest ap)
|
||||
cl_object x, streams;
|
||||
int i;
|
||||
@
|
||||
streams = ECL_NIL;
|
||||
for (i = 0; i < narg; i++) {
|
||||
x = ecl_va_arg(ap);
|
||||
unlikely_if (!ecl_input_stream_p(x))
|
||||
ecl_not_an_input_stream(x);
|
||||
streams = CONS(x, streams);
|
||||
}
|
||||
x = ecl_alloc_stream();
|
||||
if (Null(streams)) {
|
||||
x->stream.format = @':pass-through';
|
||||
} else {
|
||||
x->stream.format = cl_stream_external_format(ECL_CONS_CAR(streams));
|
||||
}
|
||||
x->stream.mode = (short)ecl_smm_concatenated;
|
||||
x->stream.ops = ecl_duplicate_dispatch_table(&concatenated_ops);
|
||||
CONCATENATED_STREAM_LIST(x) = cl_nreverse(streams);
|
||||
@(return x);
|
||||
@)
|
||||
|
||||
cl_object
|
||||
cl_concatenated_stream_streams(cl_object strm)
|
||||
{
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, ecl_smm_concatenated))
|
||||
FEwrong_type_only_arg(@[concatenated-stream-streams],
|
||||
strm, @[concatenated-stream]);
|
||||
return cl_copy_list(CONCATENATED_STREAM_LIST(strm));
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* SYNONYM STREAM
|
||||
*/
|
||||
|
||||
static cl_index
|
||||
synonym_read_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
return ecl_read_byte8(SYNONYM_STREAM_STREAM(strm), c, n);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
synonym_write_byte8(cl_object strm, unsigned char *c, cl_index n)
|
||||
{
|
||||
return ecl_write_byte8(SYNONYM_STREAM_STREAM(strm), c, n);
|
||||
}
|
||||
|
||||
static void
|
||||
synonym_write_byte(cl_object strm, cl_object byte)
|
||||
{
|
||||
ecl_write_byte(byte, SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_read_byte(cl_object strm)
|
||||
{
|
||||
return ecl_read_byte(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
synonym_read_char(cl_object strm)
|
||||
{
|
||||
return ecl_read_char(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
synonym_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
return ecl_write_char(c, SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
synonym_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
ecl_unread_char(c, SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
synonym_peek_char(cl_object strm)
|
||||
{
|
||||
return ecl_peek_char(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_index
|
||||
synonym_read_vector(cl_object strm, cl_object data, cl_index start, cl_index n)
|
||||
{
|
||||
strm = SYNONYM_STREAM_STREAM(strm);
|
||||
return ecl_stream_dispatch_table(strm)->read_vector(strm, data, start, n);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
synonym_write_vector(cl_object strm, cl_object data, cl_index start, cl_index n)
|
||||
{
|
||||
strm = SYNONYM_STREAM_STREAM(strm);
|
||||
return ecl_stream_dispatch_table(strm)->write_vector(strm, data, start, n);
|
||||
}
|
||||
|
||||
static int
|
||||
synonym_listen(cl_object strm)
|
||||
{
|
||||
return ecl_listen_stream(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
synonym_clear_input(cl_object strm)
|
||||
{
|
||||
ecl_clear_input(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
synonym_clear_output(cl_object strm)
|
||||
{
|
||||
ecl_clear_output(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
synonym_force_output(cl_object strm)
|
||||
{
|
||||
ecl_force_output(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static void
|
||||
synonym_finish_output(cl_object strm)
|
||||
{
|
||||
ecl_finish_output(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static int
|
||||
synonym_input_p(cl_object strm)
|
||||
{
|
||||
return ecl_input_stream_p(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static int
|
||||
synonym_output_p(cl_object strm)
|
||||
{
|
||||
return ecl_output_stream_p(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static int
|
||||
synonym_interactive_p(cl_object strm)
|
||||
{
|
||||
return ecl_interactive_stream_p(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_element_type(cl_object strm)
|
||||
{
|
||||
return ecl_stream_element_type(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_length(cl_object strm)
|
||||
{
|
||||
return ecl_file_length(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_get_position(cl_object strm)
|
||||
{
|
||||
return ecl_file_position(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_set_position(cl_object strm, cl_object pos)
|
||||
{
|
||||
return ecl_file_position_set(SYNONYM_STREAM_STREAM(strm), pos);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_string_length(cl_object strm, cl_object string)
|
||||
{
|
||||
return ecl_file_string_length(SYNONYM_STREAM_STREAM(strm), string);
|
||||
}
|
||||
|
||||
static int
|
||||
synonym_column(cl_object strm)
|
||||
{
|
||||
return ecl_file_column(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_pathname(cl_object strm)
|
||||
{
|
||||
return ecl_stream_pathname(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
synonym_truename(cl_object strm)
|
||||
{
|
||||
return ecl_stream_truename(SYNONYM_STREAM_STREAM(strm));
|
||||
}
|
||||
|
||||
const struct ecl_file_ops synonym_ops = {
|
||||
synonym_write_byte8,
|
||||
synonym_read_byte8,
|
||||
|
||||
synonym_write_byte,
|
||||
synonym_read_byte,
|
||||
|
||||
synonym_read_char,
|
||||
synonym_write_char,
|
||||
synonym_unread_char,
|
||||
synonym_peek_char,
|
||||
|
||||
synonym_read_vector,
|
||||
synonym_write_vector,
|
||||
|
||||
synonym_listen,
|
||||
synonym_clear_input,
|
||||
synonym_clear_output,
|
||||
synonym_finish_output,
|
||||
synonym_force_output,
|
||||
|
||||
synonym_input_p,
|
||||
synonym_output_p,
|
||||
synonym_interactive_p,
|
||||
synonym_element_type,
|
||||
|
||||
synonym_length,
|
||||
synonym_get_position,
|
||||
synonym_set_position,
|
||||
synonym_string_length,
|
||||
synonym_column,
|
||||
|
||||
synonym_pathname,
|
||||
synonym_truename,
|
||||
|
||||
ecl_generic_close
|
||||
};
|
||||
|
||||
cl_object
|
||||
cl_make_synonym_stream(cl_object sym)
|
||||
{
|
||||
cl_object x;
|
||||
|
||||
sym = ecl_check_cl_type(@'make-synonym-stream',sym,t_symbol);
|
||||
x = ecl_alloc_stream();
|
||||
x->stream.ops = ecl_duplicate_dispatch_table(&synonym_ops);
|
||||
x->stream.mode = (short)ecl_smm_synonym;
|
||||
SYNONYM_STREAM_SYMBOL(x) = sym;
|
||||
@(return x);
|
||||
}
|
||||
|
||||
cl_object
|
||||
cl_synonym_stream_symbol(cl_object strm)
|
||||
{
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, ecl_smm_synonym))
|
||||
FEwrong_type_only_arg(@[synonym-stream-symbol],
|
||||
strm, @[synonym-stream]);
|
||||
@(return SYNONYM_STREAM_SYMBOL(strm));
|
||||
}
|
||||
987
src/c/streams/strm_eformat.d
Normal file
987
src/c/streams/strm_eformat.d
Normal file
|
|
@ -0,0 +1,987 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* strm_eformat.d - External formats 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>
|
||||
|
||||
/* -- errors ---------------------------------------------------------------- */
|
||||
|
||||
#ifdef ECL_UNICODE
|
||||
static cl_index
|
||||
encoding_error(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
cl_object code = _ecl_funcall4(@'ext::encoding-error', stream,
|
||||
cl_stream_external_format(stream),
|
||||
ecl_make_integer(c));
|
||||
if (Null(code)) {
|
||||
/* Output nothing */
|
||||
return 0;
|
||||
} else {
|
||||
/* Try with supplied character */
|
||||
return stream->stream.encoder(stream, buffer, ecl_char_code(code));
|
||||
}
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
decoding_error(cl_object stream, unsigned char **buffer, int char_length, unsigned char *buffer_end)
|
||||
{
|
||||
cl_object octets = ECL_NIL, code;
|
||||
for (; char_length > 0; char_length--) {
|
||||
octets = CONS(ecl_make_fixnum(*((*buffer)++)), octets);
|
||||
}
|
||||
code = _ecl_funcall4(@'ext::decoding-error', stream,
|
||||
cl_stream_external_format(stream),
|
||||
octets);
|
||||
if (Null(code)) {
|
||||
/* Go for next character */
|
||||
return stream->stream.decoder(stream, buffer, buffer_end);
|
||||
} else {
|
||||
/* Return supplied character */
|
||||
return ecl_char_code(code);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/**********************************************************************
|
||||
* CHARACTER AND EXTERNAL FORMAT SUPPORT
|
||||
*/
|
||||
|
||||
ecl_character
|
||||
ecl_eformat_read_char(cl_object strm)
|
||||
{
|
||||
unsigned char buffer[ENCODING_BUFFER_MAX_SIZE];
|
||||
ecl_character c;
|
||||
unsigned char *buffer_pos = buffer;
|
||||
unsigned char *buffer_end = buffer;
|
||||
cl_index byte_size = (strm->stream.byte_size / 8);
|
||||
do {
|
||||
if (ecl_read_byte8(strm, buffer_end, byte_size) < byte_size) {
|
||||
c = EOF;
|
||||
break;
|
||||
}
|
||||
buffer_end += byte_size;
|
||||
c = strm->stream.decoder(strm, &buffer_pos, buffer_end);
|
||||
} 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) {
|
||||
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;
|
||||
}
|
||||
}
|
||||
|
||||
ecl_character
|
||||
ecl_eformat_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
unsigned char buffer[ENCODING_BUFFER_MAX_SIZE];
|
||||
ecl_character nbytes;
|
||||
nbytes = strm->stream.encoder(strm, buffer, c);
|
||||
strm->stream.ops->write_byte8(strm, buffer, nbytes);
|
||||
write_char_increment_column(strm, c);
|
||||
return c;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
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;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
eformat_write_char_cr(cl_object strm, ecl_character c)
|
||||
{
|
||||
if (c == ECL_CHAR_CODE_NEWLINE) {
|
||||
ecl_eformat_write_char(strm, ECL_CHAR_CODE_RETURN);
|
||||
strm->stream.column = 0;
|
||||
return c;
|
||||
}
|
||||
return ecl_eformat_write_char(strm, c);
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
eformat_read_char_crlf(cl_object strm)
|
||||
{
|
||||
ecl_character c = ecl_eformat_read_char(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;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
eformat_write_char_crlf(cl_object strm, ecl_character c)
|
||||
{
|
||||
if (c == ECL_CHAR_CODE_NEWLINE) {
|
||||
ecl_eformat_write_char(strm, ECL_CHAR_CODE_RETURN);
|
||||
ecl_eformat_write_char(strm, ECL_CHAR_CODE_LINEFEED);
|
||||
strm->stream.column = 0;
|
||||
return c;
|
||||
}
|
||||
return ecl_eformat_write_char(strm, c);
|
||||
}
|
||||
|
||||
/*
|
||||
* If we use Unicode, this is LATIN-1, ISO-8859-1, that is the 256
|
||||
* lowest codes of Unicode. Otherwise, we simply assume the file and
|
||||
* the strings use the same format.
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
passthrough_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
if (*buffer >= buffer_end)
|
||||
return EOF;
|
||||
return *((*buffer)++);
|
||||
}
|
||||
|
||||
static int
|
||||
passthrough_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
#ifdef ECL_UNICODE
|
||||
unlikely_if (c > 0xFF) {
|
||||
return encoding_error(stream, buffer, c);
|
||||
}
|
||||
#endif
|
||||
buffer[0] = c;
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifdef ECL_UNICODE
|
||||
/*
|
||||
* US ASCII, that is the 128 (0-127) lowest codes of Unicode
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
ascii_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
if (*buffer >= buffer_end)
|
||||
return EOF;
|
||||
if (**buffer > 127) {
|
||||
return decoding_error(stream, buffer, 1, buffer_end);
|
||||
} else {
|
||||
return *((*buffer)++);
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
ascii_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
unlikely_if (c > 127) {
|
||||
return encoding_error(stream, buffer, c);
|
||||
}
|
||||
buffer[0] = c;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* UCS-4 BIG ENDIAN
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
ucs_4be_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
ecl_character aux;
|
||||
if ((*buffer)+3 >= buffer_end)
|
||||
return EOF;
|
||||
aux = (*buffer)[3]+((*buffer)[2]<<8)+((*buffer)[1]<<16)+((*buffer)[0]<<24);
|
||||
*buffer += 4;
|
||||
return aux;
|
||||
}
|
||||
|
||||
static int
|
||||
ucs_4be_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
buffer[3] = c & 0xFF; c >>= 8;
|
||||
buffer[2] = c & 0xFF; c >>= 8;
|
||||
buffer[1] = c & 0xFF; c >>= 8;
|
||||
buffer[0] = c;
|
||||
return 4;
|
||||
}
|
||||
|
||||
/*
|
||||
* UCS-4 LITTLE ENDIAN
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
ucs_4le_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
ecl_character aux;
|
||||
if ((*buffer)+3 >= buffer_end)
|
||||
return EOF;
|
||||
aux = (*buffer)[0]+((*buffer)[1]<<8)+((*buffer)[2]<<16)+((*buffer)[3]<<24);
|
||||
*buffer += 4;
|
||||
return aux;
|
||||
}
|
||||
|
||||
static int
|
||||
ucs_4le_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
buffer[0] = c & 0xFF; c >>= 8;
|
||||
buffer[1] = c & 0xFF; c >>= 8;
|
||||
buffer[2] = c & 0xFF; c >>= 8;
|
||||
buffer[3] = c;
|
||||
return 4;
|
||||
}
|
||||
|
||||
/*
|
||||
* UCS-4 BOM ENDIAN
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
ucs_4_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
cl_fixnum c = ucs_4be_decoder(stream, buffer, buffer_end);
|
||||
if (c == EOF)
|
||||
return c;
|
||||
if (c == 0xFEFF) {
|
||||
stream->stream.decoder = ucs_4be_decoder;
|
||||
stream->stream.encoder = ucs_4be_encoder;
|
||||
return ucs_4be_decoder(stream, buffer, buffer_end);
|
||||
} else if (c == 0xFFFE0000) {
|
||||
stream->stream.decoder = ucs_4le_decoder;
|
||||
stream->stream.encoder = ucs_4le_encoder;
|
||||
return ucs_4le_decoder(stream, buffer, buffer_end);
|
||||
} else {
|
||||
stream->stream.decoder = ucs_4be_decoder;
|
||||
stream->stream.encoder = ucs_4be_encoder;
|
||||
return c;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
ucs_4_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
stream->stream.decoder = ucs_4be_decoder;
|
||||
stream->stream.encoder = ucs_4be_encoder;
|
||||
buffer[0] = buffer[1] = 0;
|
||||
buffer[2] = 0xFE;
|
||||
buffer[3] = 0xFF;
|
||||
return 4 + ucs_4be_encoder(stream, buffer+4, c);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* UTF-16 BIG ENDIAN
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
ucs_2be_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
if ((*buffer)+1 >= buffer_end) {
|
||||
return EOF;
|
||||
} else {
|
||||
ecl_character c = ((ecl_character)(*buffer)[0] << 8) | (*buffer)[1];
|
||||
if (((*buffer)[0] & 0xFC) == 0xD8) {
|
||||
if ((*buffer)+3 >= buffer_end) {
|
||||
return EOF;
|
||||
} else {
|
||||
ecl_character aux;
|
||||
if (((*buffer)[2] & 0xFC) != 0xDC) {
|
||||
return decoding_error(stream, buffer, 4, buffer_end);
|
||||
}
|
||||
aux = ((ecl_character)(*buffer)[2] << 8) | (*buffer)[3];
|
||||
*buffer += 4;
|
||||
return ((c & 0x3FF) << 10) + (aux & 0x3FF) + 0x10000;
|
||||
}
|
||||
}
|
||||
*buffer += 2;
|
||||
return c;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
ucs_2be_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
if (c >= 0x10000) {
|
||||
c -= 0x10000;
|
||||
ucs_2be_encoder(stream, buffer, (c >> 10) | 0xD800);
|
||||
ucs_2be_encoder(stream, buffer+2, (c & 0x3FF) | 0xDC00);
|
||||
return 4;
|
||||
} else {
|
||||
buffer[1] = c & 0xFF; c >>= 8;
|
||||
buffer[0] = c;
|
||||
return 2;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* UTF-16 LITTLE ENDIAN
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
ucs_2le_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
if ((*buffer)+1 >= buffer_end) {
|
||||
return EOF;
|
||||
} else {
|
||||
ecl_character c = ((ecl_character)(*buffer)[1] << 8) | (*buffer)[0];
|
||||
if (((*buffer)[1] & 0xFC) == 0xD8) {
|
||||
if ((*buffer)+3 >= buffer_end) {
|
||||
return EOF;
|
||||
} else {
|
||||
ecl_character aux;
|
||||
if (((*buffer)[3] & 0xFC) != 0xDC) {
|
||||
return decoding_error(stream, buffer, 4, buffer_end);
|
||||
}
|
||||
aux = ((ecl_character)(*buffer)[3] << 8) | (*buffer)[2];
|
||||
*buffer += 4;
|
||||
return ((c & 0x3FF) << 10) + (aux & 0x3FF) + 0x10000;
|
||||
}
|
||||
}
|
||||
*buffer += 2;
|
||||
return c;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
ucs_2le_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
if (c >= 0x10000) {
|
||||
c -= 0x10000;
|
||||
ucs_2le_encoder(stream, buffer, (c >> 10) | 0xD800);
|
||||
ucs_2le_encoder(stream, buffer+2, (c & 0x3FF) | 0xDC00);
|
||||
return 4;
|
||||
} else {
|
||||
buffer[0] = c & 0xFF; c >>= 8;
|
||||
buffer[1] = c & 0xFF;
|
||||
return 2;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* UTF-16 BOM ENDIAN
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
ucs_2_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
ecl_character c = ucs_2be_decoder(stream, buffer, buffer_end);
|
||||
if (c == EOF)
|
||||
return c;
|
||||
if (c == 0xFEFF) {
|
||||
stream->stream.decoder = ucs_2be_decoder;
|
||||
stream->stream.encoder = ucs_2be_encoder;
|
||||
return ucs_2be_decoder(stream, buffer, buffer_end);
|
||||
} else if (c == 0xFFFE) {
|
||||
stream->stream.decoder = ucs_2le_decoder;
|
||||
stream->stream.encoder = ucs_2le_encoder;
|
||||
return ucs_2le_decoder(stream, buffer, buffer_end);
|
||||
} else {
|
||||
stream->stream.decoder = ucs_2be_decoder;
|
||||
stream->stream.encoder = ucs_2be_encoder;
|
||||
return c;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
ucs_2_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
stream->stream.decoder = ucs_2be_decoder;
|
||||
stream->stream.encoder = ucs_2be_encoder;
|
||||
buffer[0] = 0xFE;
|
||||
buffer[1] = 0xFF;
|
||||
return 2 + ucs_2be_encoder(stream, buffer+2, c);
|
||||
}
|
||||
|
||||
/*
|
||||
* USER DEFINED ENCODINGS. SIMPLE CASE.
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
user_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
cl_object table = stream->stream.format_table;
|
||||
cl_object character;
|
||||
if (*buffer >= buffer_end) {
|
||||
return EOF;
|
||||
}
|
||||
character = ecl_gethash_safe(ecl_make_fixnum((*buffer)[0]), table, ECL_NIL);
|
||||
unlikely_if (Null(character)) {
|
||||
return decoding_error(stream, buffer, 1, buffer_end);
|
||||
}
|
||||
if (character == ECL_T) {
|
||||
if ((*buffer)+1 >= buffer_end) {
|
||||
return EOF;
|
||||
} else {
|
||||
cl_fixnum byte = ((*buffer)[0]<<8) + (*buffer)[1];
|
||||
character = ecl_gethash_safe(ecl_make_fixnum(byte), table, ECL_NIL);
|
||||
unlikely_if (Null(character)) {
|
||||
return decoding_error(stream, buffer, 2, buffer_end);
|
||||
}
|
||||
}
|
||||
(*buffer)++;
|
||||
}
|
||||
(*buffer)++;
|
||||
return ECL_CHAR_CODE(character);
|
||||
}
|
||||
|
||||
static int
|
||||
user_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
cl_object byte = ecl_gethash_safe(ECL_CODE_CHAR(c), stream->stream.format_table, ECL_NIL);
|
||||
if (Null(byte)) {
|
||||
return encoding_error(stream, buffer, c);
|
||||
} else {
|
||||
cl_fixnum code = ecl_fixnum(byte);
|
||||
if (code > 0xFF) {
|
||||
buffer[1] = code & 0xFF; code >>= 8;
|
||||
buffer[0] = code;
|
||||
return 2;
|
||||
} else {
|
||||
buffer[0] = code;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* USER DEFINED ENCODINGS. SIMPLE CASE.
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
user_multistate_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
cl_object table_list = stream->stream.format_table;
|
||||
cl_object table = ECL_CONS_CAR(table_list);
|
||||
cl_object character;
|
||||
cl_fixnum i, j;
|
||||
for (i = j = 0; i < ENCODING_BUFFER_MAX_SIZE; ) {
|
||||
if ((*buffer)+i >= buffer_end) {
|
||||
return EOF;
|
||||
}
|
||||
j = (j << 8) | (*buffer)[i];
|
||||
character = ecl_gethash_safe(ecl_make_fixnum(j), table, ECL_NIL);
|
||||
if (ECL_CHARACTERP(character)) {
|
||||
*buffer += i+1;
|
||||
return ECL_CHAR_CODE(character);
|
||||
}
|
||||
unlikely_if (Null(character)) {
|
||||
return decoding_error(stream, buffer, i+1, buffer_end);
|
||||
}
|
||||
if (character == ECL_T) {
|
||||
/* Need more characters */
|
||||
i++;
|
||||
continue;
|
||||
}
|
||||
if (CONSP(character)) {
|
||||
/* Changed the state. */
|
||||
stream->stream.format_table = table_list = character;
|
||||
table = ECL_CONS_CAR(table_list);
|
||||
*buffer += i+1;
|
||||
i = j = 0;
|
||||
continue;
|
||||
}
|
||||
break;
|
||||
}
|
||||
FEerror("Internal error in decoder table.", 0);
|
||||
}
|
||||
|
||||
static int
|
||||
user_multistate_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
cl_object table_list = stream->stream.format_table;
|
||||
cl_object p = table_list;
|
||||
do {
|
||||
cl_object table = ECL_CONS_CAR(p);
|
||||
cl_object byte = ecl_gethash_safe(ECL_CODE_CHAR(c), table, ECL_NIL);
|
||||
if (!Null(byte)) {
|
||||
cl_fixnum code = ecl_fixnum(byte);
|
||||
ecl_character n = 0;
|
||||
if (p != table_list) {
|
||||
/* Must output a escape sequence */
|
||||
cl_object x = ecl_gethash_safe(ECL_T, table, ECL_NIL);
|
||||
while (!Null(x)) {
|
||||
buffer[0] = ecl_fixnum(ECL_CONS_CAR(x));
|
||||
buffer++;
|
||||
x = ECL_CONS_CDR(x);
|
||||
n++;
|
||||
}
|
||||
stream->stream.format_table = p;
|
||||
}
|
||||
if (code > 0xFF) {
|
||||
buffer[1] = code & 0xFF; code >>= 8;
|
||||
buffer[0] = code;
|
||||
return n+2;
|
||||
} else {
|
||||
buffer[0] = code;
|
||||
return n+1;
|
||||
}
|
||||
}
|
||||
p = ECL_CONS_CDR(p);
|
||||
} while (p != table_list);
|
||||
/* Exhausted all lists */
|
||||
return encoding_error(stream, buffer, c);
|
||||
}
|
||||
|
||||
/*
|
||||
* UTF-8
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
utf_8_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end)
|
||||
{
|
||||
/* In understanding this code:
|
||||
* 0x8 = 1000, 0xC = 1100, 0xE = 1110, 0xF = 1111
|
||||
* 0x1 = 0001, 0x3 = 0011, 0x7 = 0111, 0xF = 1111
|
||||
*/
|
||||
ecl_character cum = 0;
|
||||
int nbytes, i;
|
||||
unsigned char aux;
|
||||
if (*buffer >= buffer_end)
|
||||
return EOF;
|
||||
aux = (*buffer)[0];
|
||||
if ((aux & 0x80) == 0) {
|
||||
(*buffer)++;
|
||||
return aux;
|
||||
}
|
||||
unlikely_if ((aux & 0x40) == 0) {
|
||||
return decoding_error(stream, buffer, 1, buffer_end);
|
||||
}
|
||||
if ((aux & 0x20) == 0) {
|
||||
cum = aux & 0x1F;
|
||||
nbytes = 1;
|
||||
} else if ((aux & 0x10) == 0) {
|
||||
cum = aux & 0x0F;
|
||||
nbytes = 2;
|
||||
} else if ((aux & 0x08) == 0) {
|
||||
cum = aux & 0x07;
|
||||
nbytes = 3;
|
||||
} else {
|
||||
return decoding_error(stream, buffer, 1, buffer_end);
|
||||
}
|
||||
if ((*buffer)+nbytes >= buffer_end)
|
||||
return EOF;
|
||||
for (i = 1; i <= nbytes; i++) {
|
||||
unsigned char c = (*buffer)[i];
|
||||
unlikely_if ((c & 0xC0) != 0x80) {
|
||||
return decoding_error(stream, buffer, nbytes+1, buffer_end);
|
||||
}
|
||||
cum = (cum << 6) | (c & 0x3F);
|
||||
unlikely_if (cum == 0) {
|
||||
return decoding_error(stream, buffer, nbytes+1, buffer_end);
|
||||
}
|
||||
}
|
||||
if (cum >= 0xd800) {
|
||||
unlikely_if (cum <= 0xdfff) {
|
||||
return decoding_error(stream, buffer, nbytes+1, buffer_end);
|
||||
}
|
||||
unlikely_if (cum >= 0xFFFE && cum <= 0xFFFF) {
|
||||
return decoding_error(stream, buffer, nbytes+1, buffer_end);
|
||||
}
|
||||
}
|
||||
*buffer += nbytes+1;
|
||||
return cum;
|
||||
}
|
||||
|
||||
static int
|
||||
utf_8_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
|
||||
{
|
||||
int nbytes = 0;
|
||||
if (c <= 0x7F) {
|
||||
buffer[0] = c;
|
||||
nbytes = 1;
|
||||
} else if (c <= 0x7ff) {
|
||||
buffer[1] = (c & 0x3f) | 0x80; c >>= 6;
|
||||
buffer[0] = c | 0xC0;
|
||||
/*printf("\n; %04x ;: %04x :: %04x :\n", c_orig, buffer[0], buffer[1]);*/
|
||||
nbytes = 2;
|
||||
} else if (c <= 0xFFFF) {
|
||||
buffer[2] = (c & 0x3f) | 0x80; c >>= 6;
|
||||
buffer[1] = (c & 0x3f) | 0x80; c >>= 6;
|
||||
buffer[0] = c | 0xE0;
|
||||
nbytes = 3;
|
||||
} else if (c <= 0x1FFFFFL) {
|
||||
buffer[3] = (c & 0x3f) | 0x80; c >>= 6;
|
||||
buffer[2] = (c & 0x3f) | 0x80; c >>= 6;
|
||||
buffer[1] = (c & 0x3f) | 0x80; c >>= 6;
|
||||
buffer[0] = c | 0xF0;
|
||||
nbytes = 4;
|
||||
}
|
||||
return nbytes;
|
||||
}
|
||||
#endif
|
||||
|
||||
static int
|
||||
parse_external_format(cl_object stream, cl_object format, int flags)
|
||||
{
|
||||
if (format == @':default') {
|
||||
format = ecl_symbol_value(@'ext::*default-external-format*');
|
||||
}
|
||||
if (CONSP(format)) {
|
||||
flags = parse_external_format(stream, ECL_CONS_CDR(format), flags);
|
||||
format = ECL_CONS_CAR(format);
|
||||
}
|
||||
if (format == ECL_T) {
|
||||
#ifdef ECL_UNICODE
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UTF_8;
|
||||
#else
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_DEFAULT_FORMAT;
|
||||
#endif
|
||||
}
|
||||
if (format == ECL_NIL) {
|
||||
return flags;
|
||||
}
|
||||
if (format == @':CR') {
|
||||
return (flags | ECL_STREAM_CR) & ~ECL_STREAM_LF;
|
||||
}
|
||||
if (format == @':LF') {
|
||||
return (flags | ECL_STREAM_LF) & ~ECL_STREAM_CR;
|
||||
}
|
||||
if (format == @':CRLF') {
|
||||
return flags | (ECL_STREAM_CR+ECL_STREAM_LF);
|
||||
}
|
||||
if (format == @':LITTLE-ENDIAN') {
|
||||
return flags | ECL_STREAM_LITTLE_ENDIAN;
|
||||
}
|
||||
if (format == @':BIG-ENDIAN') {
|
||||
return flags & ~ECL_STREAM_LITTLE_ENDIAN;
|
||||
}
|
||||
if (format == @':pass-through') {
|
||||
#ifdef ECL_UNICODE
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_LATIN_1;
|
||||
#else
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_DEFAULT_FORMAT;
|
||||
#endif
|
||||
}
|
||||
#ifdef ECL_UNICODE
|
||||
PARSE_SYMBOLS:
|
||||
if (format == @':UTF-8') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UTF_8;
|
||||
}
|
||||
if (format == @':UCS-2') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UCS_2;
|
||||
}
|
||||
if (format == @':UCS-2BE') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UCS_2BE;
|
||||
}
|
||||
if (format == @':UCS-2LE') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UCS_2LE;
|
||||
}
|
||||
if (format == @':UCS-4') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UCS_4;
|
||||
}
|
||||
if (format == @':UCS-4BE') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UCS_4BE;
|
||||
}
|
||||
if (format == @':UCS-4LE') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_UCS_4LE;
|
||||
}
|
||||
if (format == @':ISO-8859-1') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_ISO_8859_1;
|
||||
}
|
||||
if (format == @':LATIN-1') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_LATIN_1;
|
||||
}
|
||||
if (format == @':US-ASCII') {
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_US_ASCII;
|
||||
}
|
||||
if (ECL_HASH_TABLE_P(format)) {
|
||||
stream->stream.format_table = format;
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_USER_FORMAT;
|
||||
}
|
||||
if (ECL_SYMBOLP(format)) {
|
||||
format = _ecl_funcall2(@'ext::make-encoding', format);
|
||||
if (ECL_SYMBOLP(format))
|
||||
goto PARSE_SYMBOLS;
|
||||
stream->stream.format_table = format;
|
||||
return (flags & ~ECL_STREAM_FORMAT) | ECL_STREAM_USER_FORMAT;
|
||||
}
|
||||
#endif
|
||||
FEerror("Unknown or unsupported external format: ~A", 1, format);
|
||||
return ECL_STREAM_DEFAULT_FORMAT;
|
||||
}
|
||||
|
||||
void
|
||||
ecl_set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int flags,
|
||||
cl_object external_format)
|
||||
{
|
||||
cl_object t;
|
||||
if (byte_size < 0) {
|
||||
byte_size = -byte_size;
|
||||
flags |= ECL_STREAM_SIGNED_BYTES;
|
||||
t = @'signed-byte';
|
||||
} else {
|
||||
flags &= ~ECL_STREAM_SIGNED_BYTES;
|
||||
t = @'unsigned-byte';
|
||||
}
|
||||
if (external_format != ECL_NIL) {
|
||||
flags = parse_external_format(stream, external_format, flags);
|
||||
}
|
||||
stream->stream.ops->read_char = ecl_eformat_read_char;
|
||||
stream->stream.ops->write_char = ecl_eformat_write_char;
|
||||
switch (flags & ECL_STREAM_FORMAT) {
|
||||
case ECL_STREAM_BINARY:
|
||||
IO_STREAM_ELT_TYPE(stream) = cl_list(2, t, ecl_make_fixnum(byte_size));
|
||||
stream->stream.format = t;
|
||||
stream->stream.ops->read_char = ecl_not_character_read_char;
|
||||
stream->stream.ops->write_char = ecl_not_character_write_char;
|
||||
stream->stream.decoder = ecl_not_character_decoder;
|
||||
stream->stream.encoder = ecl_not_character_encoder;
|
||||
break;
|
||||
#ifdef ECL_UNICODE
|
||||
/*case ECL_ISO_8859_1:*/
|
||||
case ECL_STREAM_LATIN_1:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'base-char';
|
||||
byte_size = 8;
|
||||
stream->stream.format = @':latin-1';
|
||||
stream->stream.encoder = passthrough_encoder;
|
||||
stream->stream.decoder = passthrough_decoder;
|
||||
break;
|
||||
case ECL_STREAM_UTF_8:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'character';
|
||||
byte_size = 8;
|
||||
stream->stream.format = @':utf-8';
|
||||
stream->stream.encoder = utf_8_encoder;
|
||||
stream->stream.decoder = utf_8_decoder;
|
||||
break;
|
||||
case ECL_STREAM_UCS_2:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'character';
|
||||
byte_size = 8*2;
|
||||
stream->stream.format = @':ucs-2';
|
||||
stream->stream.encoder = ucs_2_encoder;
|
||||
stream->stream.decoder = ucs_2_decoder;
|
||||
break;
|
||||
case ECL_STREAM_UCS_2BE:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'character';
|
||||
byte_size = 8*2;
|
||||
if (flags & ECL_STREAM_LITTLE_ENDIAN) {
|
||||
stream->stream.format = @':ucs-2le';
|
||||
stream->stream.encoder = ucs_2le_encoder;
|
||||
stream->stream.decoder = ucs_2le_decoder;
|
||||
} else {
|
||||
stream->stream.format = @':ucs-2be';
|
||||
stream->stream.encoder = ucs_2be_encoder;
|
||||
stream->stream.decoder = ucs_2be_decoder;
|
||||
}
|
||||
break;
|
||||
case ECL_STREAM_UCS_4:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'character';
|
||||
byte_size = 8*4;
|
||||
stream->stream.format = @':ucs-4be';
|
||||
stream->stream.encoder = ucs_4_encoder;
|
||||
stream->stream.decoder = ucs_4_decoder;
|
||||
break;
|
||||
case ECL_STREAM_UCS_4BE:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'character';
|
||||
byte_size = 8*4;
|
||||
if (flags & ECL_STREAM_LITTLE_ENDIAN) {
|
||||
stream->stream.format = @':ucs-4le';
|
||||
stream->stream.encoder = ucs_4le_encoder;
|
||||
stream->stream.decoder = ucs_4le_decoder;
|
||||
} else {
|
||||
stream->stream.format = @':ucs-4be';
|
||||
stream->stream.encoder = ucs_4be_encoder;
|
||||
stream->stream.decoder = ucs_4be_decoder;
|
||||
}
|
||||
break;
|
||||
case ECL_STREAM_USER_FORMAT:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'character';
|
||||
byte_size = 8;
|
||||
stream->stream.format = stream->stream.format_table;
|
||||
if (CONSP(stream->stream.format)) {
|
||||
stream->stream.encoder = user_multistate_encoder;
|
||||
stream->stream.decoder = user_multistate_decoder;
|
||||
} else {
|
||||
stream->stream.encoder = user_encoder;
|
||||
stream->stream.decoder = user_decoder;
|
||||
}
|
||||
break;
|
||||
case ECL_STREAM_US_ASCII:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'base-char';
|
||||
byte_size = 8;
|
||||
stream->stream.format = @':us-ascii';
|
||||
stream->stream.encoder = ascii_encoder;
|
||||
stream->stream.decoder = ascii_decoder;
|
||||
break;
|
||||
#else
|
||||
case ECL_STREAM_DEFAULT_FORMAT:
|
||||
IO_STREAM_ELT_TYPE(stream) = @'base-char';
|
||||
byte_size = 8;
|
||||
stream->stream.format = @':pass-through';
|
||||
stream->stream.encoder = passthrough_encoder;
|
||||
stream->stream.decoder = passthrough_decoder;
|
||||
break;
|
||||
#endif
|
||||
default:
|
||||
FEerror("Invalid or unsupported external format ~A with code ~D",
|
||||
2, external_format, ecl_make_fixnum(flags));
|
||||
}
|
||||
t = @':LF';
|
||||
if (stream->stream.ops->write_char == ecl_eformat_write_char &&
|
||||
(flags & ECL_STREAM_CR)) {
|
||||
if (flags & ECL_STREAM_LF) {
|
||||
stream->stream.ops->read_char = eformat_read_char_crlf;
|
||||
stream->stream.ops->write_char = eformat_write_char_crlf;
|
||||
t = @':CRLF';
|
||||
} else {
|
||||
stream->stream.ops->read_char = eformat_read_char_cr;
|
||||
stream->stream.ops->write_char = eformat_write_char_cr;
|
||||
t = @':CR';
|
||||
}
|
||||
}
|
||||
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;
|
||||
} else {
|
||||
read_byte = ecl_generic_read_byte_unsigned8;
|
||||
write_byte = ecl_generic_write_byte_unsigned8;
|
||||
}
|
||||
} else if (flags & ECL_STREAM_LITTLE_ENDIAN) {
|
||||
read_byte = ecl_generic_read_byte_le;
|
||||
write_byte = ecl_generic_write_byte_le;
|
||||
} else {
|
||||
read_byte = ecl_generic_read_byte;
|
||||
write_byte = ecl_generic_write_byte;
|
||||
}
|
||||
if (ecl_input_stream_p(stream)) {
|
||||
stream->stream.ops->read_byte = read_byte;
|
||||
}
|
||||
if (ecl_output_stream_p(stream)) {
|
||||
stream->stream.ops->write_byte = write_byte;
|
||||
}
|
||||
}
|
||||
stream->stream.flags = flags;
|
||||
stream->stream.byte_size = byte_size;
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_stream_external_format_set(cl_object stream, cl_object format)
|
||||
{
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
unlikely_if (ECL_INSTANCEP(stream)) {
|
||||
FEerror("Cannot change external format of stream ~A", 1, stream);
|
||||
}
|
||||
#endif
|
||||
switch (stream->stream.mode) {
|
||||
case ecl_smm_input:
|
||||
case ecl_smm_input_file:
|
||||
case ecl_smm_output:
|
||||
case ecl_smm_output_file:
|
||||
case ecl_smm_io:
|
||||
case ecl_smm_io_file:
|
||||
#ifdef ECL_WSOCK
|
||||
case ecl_smm_input_wsock:
|
||||
case ecl_smm_output_wsock:
|
||||
case ecl_smm_io_wsock:
|
||||
case ecl_smm_io_wcon:
|
||||
#endif
|
||||
{
|
||||
cl_object elt_type = ecl_stream_element_type(stream);
|
||||
unlikely_if (elt_type != @'character' && elt_type != @'base-char') {
|
||||
FEerror("Cannot change external format of binary stream ~A", 1, stream);
|
||||
}
|
||||
ecl_set_stream_elt_type(stream, stream->stream.byte_size, stream->stream.flags, format);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
FEerror("Cannot change external format of stream ~A", 1, stream);
|
||||
}
|
||||
@(return);
|
||||
}
|
||||
|
||||
static cl_index
|
||||
compute_char_size(cl_object stream, ecl_character c)
|
||||
{
|
||||
unsigned char buffer[5];
|
||||
int l = 0;
|
||||
if (c == ECL_CHAR_CODE_NEWLINE) {
|
||||
int flags = stream->stream.flags;
|
||||
if (flags & ECL_STREAM_CR) {
|
||||
l += stream->stream.encoder(stream, buffer, ECL_CHAR_CODE_RETURN);
|
||||
if (flags & ECL_STREAM_LF)
|
||||
l += stream->stream.encoder(stream, buffer,
|
||||
ECL_CHAR_CODE_LINEFEED);
|
||||
} else {
|
||||
l += stream->stream.encoder(stream, buffer, ECL_CHAR_CODE_LINEFEED);
|
||||
}
|
||||
} else {
|
||||
l += stream->stream.encoder(stream, buffer, c);
|
||||
}
|
||||
return l;
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_eformat_file_string_length(cl_object stream, cl_object string)
|
||||
{
|
||||
cl_fixnum l = 0;
|
||||
switch (ecl_t_of(string)) {
|
||||
#ifdef ECL_UNICODE
|
||||
case t_string:
|
||||
#endif
|
||||
case t_base_string: {
|
||||
cl_index i;
|
||||
for (i = 0; i < string->base_string.fillp; i++) {
|
||||
l += compute_char_size(stream, ecl_char(string, i));
|
||||
}
|
||||
break;
|
||||
}
|
||||
case t_character:
|
||||
l = compute_char_size(stream, ECL_CHAR_CODE(string));
|
||||
break;
|
||||
default:
|
||||
FEwrong_type_nth_arg(@[file-string-length], 2, string, @[string]);
|
||||
}
|
||||
return ecl_make_fixnum(l);
|
||||
}
|
||||
2211
src/c/streams/strm_os.d
Normal file
2211
src/c/streams/strm_os.d
Normal file
File diff suppressed because it is too large
Load diff
594
src/c/streams/strm_sequence.d
Normal file
594
src/c/streams/strm_sequence.d
Normal file
|
|
@ -0,0 +1,594 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* strm_sequence.d - Sequence Stream dispatch tables
|
||||
*
|
||||
* 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/ecl-inl.h>
|
||||
#define ECL_DEFINE_AET_SIZE
|
||||
#include <ecl/internal.h>
|
||||
|
||||
/**********************************************************************
|
||||
* 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;
|
||||
ecl_copy(c, vector->vector.self.bc + curr_pos, delta);
|
||||
SEQ_INPUT_POSITION(strm) += delta;
|
||||
return delta;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void
|
||||
seq_in_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
ecl_eformat_unread_char(strm, c);
|
||||
SEQ_INPUT_POSITION(strm) -= ecl_length(strm->stream.byte_stack);
|
||||
strm->stream.byte_stack = ECL_NIL;
|
||||
}
|
||||
|
||||
#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 last = SEQ_INPUT_LIMIT(strm);
|
||||
if (curr_pos >= last) {
|
||||
return EOF;
|
||||
}
|
||||
cl_object vector = SEQ_INPUT_VECTOR(strm);
|
||||
ecl_character c = vector->vector.self.b16[curr_pos++];
|
||||
cl_object err;
|
||||
if (c >= 0xD800 && c <= 0xDBFF) {
|
||||
if (curr_pos >= last) {
|
||||
err = ecl_list1(ecl_make_fixnum(c));
|
||||
goto DECODING_ERROR;
|
||||
}
|
||||
ecl_character aux = vector->vector.self.b16[curr_pos++];
|
||||
if (aux < 0xDC00 || aux > 0xDFFF) {
|
||||
err = cl_list(2, ecl_make_fixnum(c), ecl_make_fixnum(aux));
|
||||
goto DECODING_ERROR;
|
||||
}
|
||||
c = ((c & 0x3FF) << 10) + (aux & 0x3FF) + 0x10000;
|
||||
}
|
||||
SEQ_INPUT_POSITION(strm) = curr_pos;
|
||||
return c;
|
||||
cl_object code;
|
||||
DECODING_ERROR:
|
||||
code = _ecl_funcall4(@'ext::decoding-error', strm,
|
||||
cl_stream_external_format(strm),
|
||||
err);
|
||||
if (Null(code)) {
|
||||
/* Go for next character */
|
||||
return seq_in_ucs2_read_char(strm);
|
||||
} else {
|
||||
/* Return supplied character */
|
||||
return ecl_char_code(code);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
seq_in_ucs2_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
if (c >= 0x10000) {
|
||||
SEQ_INPUT_POSITION(strm) -= 2;
|
||||
} else {
|
||||
SEQ_INPUT_POSITION(strm) -= 1;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef ecl_uint32_t
|
||||
static ecl_character
|
||||
seq_in_ucs4_read_char(cl_object strm)
|
||||
{
|
||||
cl_fixnum curr_pos = SEQ_INPUT_POSITION(strm);
|
||||
if (curr_pos >= SEQ_INPUT_LIMIT(strm)) {
|
||||
return EOF;
|
||||
}
|
||||
cl_object vector = SEQ_INPUT_VECTOR(strm);
|
||||
SEQ_INPUT_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;
|
||||
}
|
||||
#endif
|
||||
|
||||
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 = ecl_to_size(pos);
|
||||
if (disp >= SEQ_INPUT_LIMIT(strm)) {
|
||||
disp = SEQ_INPUT_LIMIT(strm);
|
||||
}
|
||||
}
|
||||
SEQ_INPUT_POSITION(strm) = disp;
|
||||
return ECL_T;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
seq_file_element_type(cl_object strm)
|
||||
{
|
||||
return IO_FILE_ELT_TYPE(strm);
|
||||
}
|
||||
|
||||
const struct ecl_file_ops seq_in_ops = {
|
||||
ecl_not_output_write_byte8,
|
||||
seq_in_read_byte8,
|
||||
|
||||
ecl_not_output_write_byte,
|
||||
ecl_generic_read_byte,
|
||||
|
||||
ecl_eformat_read_char,
|
||||
ecl_not_output_write_char,
|
||||
seq_in_unread_char,
|
||||
ecl_generic_peek_char,
|
||||
|
||||
ecl_generic_read_vector,
|
||||
ecl_generic_write_vector,
|
||||
|
||||
seq_in_listen,
|
||||
ecl_generic_void, /* clear-input */
|
||||
ecl_not_output_clear_output,
|
||||
ecl_not_output_finish_output,
|
||||
ecl_not_output_force_output,
|
||||
|
||||
ecl_generic_always_true, /* input_p */
|
||||
ecl_generic_always_false, /* output_p */
|
||||
ecl_generic_always_false,
|
||||
seq_file_element_type,
|
||||
|
||||
ecl_not_a_file_stream, /* length */
|
||||
seq_in_get_position,
|
||||
seq_in_set_position,
|
||||
ecl_not_output_string_length,
|
||||
ecl_unknown_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
ecl_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;
|
||||
int flags = 0;
|
||||
if (!ECL_VECTORP(vector)) {
|
||||
FEwrong_type_nth_arg(@[ext::make-sequence-input-stream], 1, vector, @[vector]);
|
||||
}
|
||||
type = ecl_array_elttype(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. */
|
||||
strm = ecl_alloc_stream();
|
||||
strm->stream.ops = ecl_duplicate_dispatch_table(&seq_in_ops);
|
||||
strm->stream.mode = (short)ecl_smm_sequence_input;
|
||||
if (!byte_size && Null(external_format)) {
|
||||
external_format = @':default';
|
||||
}
|
||||
if (ecl_aet_size[type] == 1) {
|
||||
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';
|
||||
strm->stream.format = @':ucs-2';
|
||||
strm->stream.byte_size = 2*8;
|
||||
strm->stream.ops->read_char = seq_in_ucs2_read_char;
|
||||
strm->stream.ops->unread_char = seq_in_ucs2_unread_char;
|
||||
}
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
else if (ecl_aet_size[type] == 4 && external_format == @':ucs-4') {
|
||||
IO_STREAM_ELT_TYPE(strm) = @'character';
|
||||
strm->stream.format = @':ucs-4';
|
||||
strm->stream.byte_size = 4*8;
|
||||
strm->stream.ops->read_char = seq_in_ucs4_read_char;
|
||||
strm->stream.ops->unread_char = seq_in_ucs4_unread_char;
|
||||
}
|
||||
#endif
|
||||
else {
|
||||
FEerror("Illegal combination of external-format ~A and input vector ~A for MAKE-SEQUENCE-INPUT-STREAM.~%", 2, external_format, vector);
|
||||
}
|
||||
SEQ_INPUT_VECTOR(strm) = vector;
|
||||
SEQ_INPUT_POSITION(strm) = istart;
|
||||
SEQ_INPUT_LIMIT(strm) = iend;
|
||||
return strm;
|
||||
}
|
||||
|
||||
@(defun ext::make_sequence_input_stream (vector &key
|
||||
(start ecl_make_fixnum(0))
|
||||
(end ECL_NIL)
|
||||
(external_format ECL_NIL))
|
||||
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 void
|
||||
seq_out_enlarge_vector(cl_object strm)
|
||||
{
|
||||
cl_object vector = SEQ_OUTPUT_VECTOR(strm);
|
||||
si_adjust_vector(vector, ecl_ash(ecl_make_fixnum(vector->vector.dim), 1));
|
||||
SEQ_OUTPUT_VECTOR(strm) = vector;
|
||||
}
|
||||
|
||||
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 = vector->vector.dim;
|
||||
cl_fixnum delta = last - curr_pos;
|
||||
if (delta < n) {
|
||||
seq_out_enlarge_vector(strm);
|
||||
goto AGAIN;
|
||||
}
|
||||
ecl_copy(vector->vector.self.bc + curr_pos, c, n);
|
||||
SEQ_OUTPUT_POSITION(strm) = curr_pos += n;
|
||||
if (vector->vector.fillp < curr_pos)
|
||||
vector->vector.fillp = curr_pos;
|
||||
}
|
||||
return n;
|
||||
}
|
||||
|
||||
#ifdef ecl_uint16_t
|
||||
static ecl_character
|
||||
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_fixnum n = (c >= 0x10000) ? 2 : 1;
|
||||
if (vector->vector.dim - curr_pos < n) {
|
||||
seq_out_enlarge_vector(strm);
|
||||
goto AGAIN;
|
||||
}
|
||||
if (c >= 0x10000) {
|
||||
c -= 0x10000;
|
||||
vector->vector.self.b16[curr_pos++] = (c >> 10) | 0xD800;
|
||||
vector->vector.self.b16[curr_pos++] = (c & 0x3FF) | 0xDC00;
|
||||
} else {
|
||||
vector->vector.self.b16[curr_pos++] = c;
|
||||
}
|
||||
SEQ_OUTPUT_POSITION(strm) = curr_pos;
|
||||
if (vector->vector.fillp < curr_pos)
|
||||
vector->vector.fillp = curr_pos;
|
||||
}
|
||||
return c;
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef ecl_uint32_t
|
||||
static ecl_character
|
||||
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);
|
||||
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;
|
||||
if (vector->vector.fillp < curr_pos)
|
||||
vector->vector.fillp = curr_pos;
|
||||
}
|
||||
return c;
|
||||
}
|
||||
#endif
|
||||
|
||||
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_object vector = SEQ_OUTPUT_VECTOR(strm);
|
||||
cl_fixnum disp;
|
||||
if (Null(pos)) {
|
||||
disp = vector->vector.fillp;
|
||||
} else {
|
||||
disp = ecl_to_size(pos);
|
||||
if (disp >= vector->vector.dim) {
|
||||
disp = vector->vector.fillp;
|
||||
}
|
||||
}
|
||||
SEQ_OUTPUT_POSITION(strm) = disp;
|
||||
return ECL_T;
|
||||
}
|
||||
|
||||
const struct ecl_file_ops seq_out_ops = {
|
||||
seq_out_write_byte8,
|
||||
ecl_not_input_read_byte8,
|
||||
|
||||
ecl_generic_write_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_generic_read_vector,
|
||||
ecl_generic_write_vector,
|
||||
|
||||
ecl_not_input_listen,
|
||||
ecl_not_input_clear_input,
|
||||
ecl_generic_void, /* clear-output */
|
||||
ecl_generic_void, /* finish-output */
|
||||
ecl_generic_void, /* force-output */
|
||||
|
||||
ecl_generic_always_false, /* input_p */
|
||||
ecl_generic_always_true, /* output_p */
|
||||
ecl_generic_always_false,
|
||||
seq_file_element_type,
|
||||
|
||||
ecl_not_a_file_stream, /* length */
|
||||
seq_out_get_position,
|
||||
seq_out_set_position,
|
||||
ecl_not_output_string_length,
|
||||
ecl_generic_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
ecl_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;
|
||||
int flags = 0;
|
||||
if (!ECL_VECTORP(vector)) {
|
||||
FEwrong_type_nth_arg(@[ext::make-sequence-output-stream], 1, vector, @[vector]);
|
||||
}
|
||||
type = ecl_array_elttype(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. */
|
||||
strm = ecl_alloc_stream();
|
||||
strm->stream.ops = ecl_duplicate_dispatch_table(&seq_out_ops);
|
||||
strm->stream.mode = (short)ecl_smm_sequence_output;
|
||||
if (!byte_size && Null(external_format)) {
|
||||
external_format = @':default';
|
||||
}
|
||||
if (ecl_aet_size[type] == 1) {
|
||||
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';
|
||||
strm->stream.format = @':ucs-2';
|
||||
strm->stream.byte_size = 2*8;
|
||||
strm->stream.ops->write_char = seq_out_ucs2_write_char;
|
||||
}
|
||||
#endif
|
||||
#ifdef ecl_uint32_t
|
||||
else if (ecl_aet_size[type] == 4 && external_format == @':ucs-4') {
|
||||
IO_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;
|
||||
}
|
||||
#endif
|
||||
else {
|
||||
FEerror("Illegal combination of external-format ~A and output vector ~A for MAKE-SEQUENCE-OUTPUT-STREAM.~%", 2, external_format, vector);
|
||||
}
|
||||
SEQ_OUTPUT_VECTOR(strm) = vector;
|
||||
SEQ_OUTPUT_POSITION(strm) = vector->vector.fillp;
|
||||
return strm;
|
||||
}
|
||||
|
||||
@(defun ext::make_sequence_output_stream (vector &key (external_format ECL_NIL))
|
||||
@
|
||||
@(return make_sequence_output_stream(vector, external_format));
|
||||
@)
|
||||
|
||||
/*******************************tl***************************************
|
||||
* SEQUENCES I/O
|
||||
*/
|
||||
|
||||
void
|
||||
writestr_stream(const char *s, cl_object strm)
|
||||
{
|
||||
cl_object buffer = si_get_buffer_string();
|
||||
cl_index size = ecl_fixnum(cl_array_total_size(buffer));
|
||||
cl_index i = 0;
|
||||
while (*s != '\0') {
|
||||
ecl_char_set(buffer, i++, (ecl_character) *s++);
|
||||
if (i >= size) {
|
||||
si_fill_pointer_set(buffer, ecl_make_fixnum(size));
|
||||
si_do_write_sequence(buffer, strm, ecl_make_fixnum(0), ECL_NIL);
|
||||
i = 0;
|
||||
}
|
||||
}
|
||||
si_fill_pointer_set(buffer, ecl_make_fixnum(i));
|
||||
si_do_write_sequence(buffer, strm, ecl_make_fixnum(0), ECL_NIL);
|
||||
si_put_buffer_string(buffer);
|
||||
}
|
||||
|
||||
|
||||
cl_object
|
||||
si_do_write_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e)
|
||||
{
|
||||
const struct ecl_file_ops *ops;
|
||||
cl_fixnum start,limit,end;
|
||||
|
||||
/* Since we have called ecl_length(), we know that SEQ is a valid
|
||||
sequence. Therefore, we only need to check the type of the
|
||||
object, and seq == ECL_NIL i.f.f. t = t_symbol */
|
||||
limit = ecl_length(seq);
|
||||
if (ecl_unlikely(!ECL_FIXNUMP(s) ||
|
||||
((start = ecl_fixnum(s)) < 0) ||
|
||||
(start > limit))) {
|
||||
FEwrong_type_key_arg(@[write-sequence], @[:start], s,
|
||||
ecl_make_integer_type(ecl_make_fixnum(0),
|
||||
ecl_make_fixnum(limit-1)));
|
||||
}
|
||||
if (e == ECL_NIL) {
|
||||
end = limit;
|
||||
} else if (ecl_unlikely(!ECL_FIXNUMP(e) ||
|
||||
((end = ecl_fixnum(e)) < 0) ||
|
||||
(end > limit))) {
|
||||
FEwrong_type_key_arg(@[write-sequence], @[:end], e,
|
||||
ecl_make_integer_type(ecl_make_fixnum(0),
|
||||
ecl_make_fixnum(limit)));
|
||||
}
|
||||
if (end <= start) {
|
||||
goto OUTPUT;
|
||||
}
|
||||
ops = ecl_stream_dispatch_table(stream);
|
||||
if (LISTP(seq)) {
|
||||
cl_object elt_type = cl_stream_element_type(stream);
|
||||
bool ischar = (elt_type == @'base-char') || (elt_type == @'character');
|
||||
cl_object s = ecl_nthcdr(start, seq);
|
||||
loop_for_in(s) {
|
||||
if (start < end) {
|
||||
cl_object elt = CAR(s);
|
||||
if (ischar)
|
||||
ops->write_char(stream, ecl_char_code(elt));
|
||||
else
|
||||
ops->write_byte(stream, elt);
|
||||
start++;
|
||||
} else {
|
||||
goto OUTPUT;
|
||||
}
|
||||
} end_loop_for_in;
|
||||
} else {
|
||||
ops->write_vector(stream, seq, start, end);
|
||||
}
|
||||
OUTPUT:
|
||||
@(return seq);
|
||||
}
|
||||
|
||||
cl_object
|
||||
si_do_read_sequence(cl_object seq, cl_object stream, cl_object s, cl_object e)
|
||||
{
|
||||
const struct ecl_file_ops *ops;
|
||||
cl_fixnum start,limit,end;
|
||||
|
||||
/* Since we have called ecl_length(), we know that SEQ is a valid
|
||||
sequence. Therefore, we only need to check the type of the
|
||||
object, and seq == ECL_NIL i.f.f. t = t_symbol */
|
||||
limit = ecl_length(seq);
|
||||
if (ecl_unlikely(!ECL_FIXNUMP(s) ||
|
||||
((start = ecl_fixnum(s)) < 0) ||
|
||||
(start > limit))) {
|
||||
FEwrong_type_key_arg(@[read-sequence], @[:start], s,
|
||||
ecl_make_integer_type(ecl_make_fixnum(0),
|
||||
ecl_make_fixnum(limit-1)));
|
||||
}
|
||||
if (e == ECL_NIL) {
|
||||
end = limit;
|
||||
} else if (ecl_unlikely(!ECL_FIXNUMP(e) ||
|
||||
((end = ecl_fixnum(e)) < 0) ||
|
||||
(end > limit))) {
|
||||
FEwrong_type_key_arg(@[read-sequence], @[:end], e,
|
||||
ecl_make_integer_type(ecl_make_fixnum(0),
|
||||
ecl_make_fixnum(limit)));
|
||||
}
|
||||
if (end <= start) {
|
||||
goto OUTPUT;
|
||||
}
|
||||
ops = ecl_stream_dispatch_table(stream);
|
||||
if (LISTP(seq)) {
|
||||
cl_object elt_type = cl_stream_element_type(stream);
|
||||
bool ischar = (elt_type == @'base-char') || (elt_type == @'character');
|
||||
seq = ecl_nthcdr(start, seq);
|
||||
loop_for_in(seq) {
|
||||
if (start >= end) {
|
||||
goto OUTPUT;
|
||||
} else {
|
||||
cl_object c;
|
||||
if (ischar) {
|
||||
int i = ops->read_char(stream);
|
||||
if (i < 0) goto OUTPUT;
|
||||
c = ECL_CODE_CHAR(i);
|
||||
} else {
|
||||
c = ops->read_byte(stream);
|
||||
if (c == ECL_NIL) goto OUTPUT;
|
||||
}
|
||||
ECL_RPLACA(seq, c);
|
||||
start++;
|
||||
}
|
||||
} end_loop_for_in;
|
||||
} else {
|
||||
start = ops->read_vector(stream, seq, start, end);
|
||||
}
|
||||
OUTPUT:
|
||||
@(return ecl_make_fixnum(start));
|
||||
}
|
||||
352
src/c/streams/strm_string.d
Normal file
352
src/c/streams/strm_string.d
Normal file
|
|
@ -0,0 +1,352 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* strm_string.d - String Streams dispatch tables
|
||||
*
|
||||
* 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>
|
||||
|
||||
/**********************************************************************
|
||||
* STRING OUTPUT STREAMS
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
str_out_write_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
write_char_increment_column(strm, c);
|
||||
ecl_string_push_extend(STRING_OUTPUT_STRING(strm), c);
|
||||
return c;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
str_out_element_type(cl_object strm)
|
||||
{
|
||||
cl_object string = STRING_OUTPUT_STRING(strm);
|
||||
if (ECL_BASE_STRING_P(string))
|
||||
return @'base-char';
|
||||
return @'character';
|
||||
}
|
||||
|
||||
static cl_object
|
||||
str_out_get_position(cl_object strm)
|
||||
{
|
||||
return ecl_make_unsigned_integer(STRING_OUTPUT_STRING(strm)->base_string.fillp);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
str_out_string_length(cl_object strm, cl_object string)
|
||||
{
|
||||
cl_fixnum l = 0;
|
||||
switch (ecl_t_of(string)) {
|
||||
#ifdef ECL_UNICODE
|
||||
case t_string:
|
||||
#endif
|
||||
case t_base_string:
|
||||
l = string->base_string.fillp;
|
||||
break;
|
||||
case t_character:
|
||||
l = 1;
|
||||
break;
|
||||
default:
|
||||
FEwrong_type_nth_arg(@[file-string-length], 2, string, @[string]);
|
||||
}
|
||||
return ecl_make_fixnum(l);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
str_out_set_position(cl_object strm, cl_object pos)
|
||||
{
|
||||
cl_object string = STRING_OUTPUT_STRING(strm);
|
||||
cl_fixnum disp;
|
||||
if (Null(pos)) {
|
||||
disp = strm->base_string.dim;
|
||||
} else {
|
||||
disp = ecl_to_size(pos);
|
||||
}
|
||||
if (disp < string->base_string.fillp) {
|
||||
string->base_string.fillp = disp;
|
||||
} else {
|
||||
disp -= string->base_string.fillp;
|
||||
while (disp-- > 0)
|
||||
ecl_write_char(' ', strm);
|
||||
}
|
||||
return ECL_T;
|
||||
}
|
||||
|
||||
const struct ecl_file_ops str_out_ops = {
|
||||
ecl_not_output_write_byte8,
|
||||
ecl_not_binary_read_byte8,
|
||||
|
||||
ecl_not_binary_write_byte,
|
||||
ecl_not_input_read_byte,
|
||||
|
||||
ecl_not_input_read_char,
|
||||
str_out_write_char,
|
||||
ecl_not_input_unread_char,
|
||||
ecl_generic_peek_char,
|
||||
|
||||
ecl_generic_read_vector,
|
||||
ecl_generic_write_vector,
|
||||
|
||||
ecl_not_input_listen,
|
||||
ecl_not_input_clear_input,
|
||||
ecl_generic_void, /* clear-output */
|
||||
ecl_generic_void, /* finish-output */
|
||||
ecl_generic_void, /* force-output */
|
||||
|
||||
ecl_generic_always_false, /* input_p */
|
||||
ecl_generic_always_true, /* output_p */
|
||||
ecl_generic_always_false,
|
||||
str_out_element_type,
|
||||
|
||||
ecl_not_a_file_stream, /* length */
|
||||
str_out_get_position,
|
||||
str_out_set_position,
|
||||
str_out_string_length,
|
||||
ecl_generic_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
ecl_generic_close
|
||||
};
|
||||
|
||||
|
||||
cl_object
|
||||
si_make_string_output_stream_from_string(cl_object s)
|
||||
{
|
||||
cl_object strm = ecl_alloc_stream();
|
||||
unlikely_if (!ECL_STRINGP(s) || !ECL_ARRAY_HAS_FILL_POINTER_P(s))
|
||||
FEerror("~S is not a -string with a fill-pointer.", 1, s);
|
||||
strm->stream.ops = ecl_duplicate_dispatch_table(&str_out_ops);
|
||||
strm->stream.mode = (short)ecl_smm_string_output;
|
||||
STRING_OUTPUT_STRING(strm) = s;
|
||||
strm->stream.column = 0;
|
||||
#if !defined(ECL_UNICODE)
|
||||
strm->stream.format = @':pass-through';
|
||||
strm->stream.flags = ECL_STREAM_DEFAULT_FORMAT;
|
||||
strm->stream.byte_size = 8;
|
||||
#else
|
||||
if (ECL_BASE_STRING_P(s)) {
|
||||
strm->stream.format = @':latin-1';
|
||||
strm->stream.flags = ECL_STREAM_LATIN_1;
|
||||
strm->stream.byte_size = 8;
|
||||
} else {
|
||||
strm->stream.format = @':ucs-4';
|
||||
strm->stream.flags = ECL_STREAM_UCS_4;
|
||||
strm->stream.byte_size = 32;
|
||||
}
|
||||
#endif
|
||||
@(return strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_make_string_output_stream(cl_index line_length, int extended)
|
||||
{
|
||||
#ifdef ECL_UNICODE
|
||||
cl_object s = extended?
|
||||
ecl_alloc_adjustable_extended_string(line_length) :
|
||||
ecl_alloc_adjustable_base_string(line_length);
|
||||
#else
|
||||
cl_object s = ecl_alloc_adjustable_base_string(line_length);
|
||||
#endif
|
||||
return si_make_string_output_stream_from_string(s);
|
||||
}
|
||||
|
||||
@(defun make-string-output-stream (&key (element_type @'character'))
|
||||
int extended = 0;
|
||||
@
|
||||
if (element_type == @'base-char') {
|
||||
(void)0;
|
||||
} else if (element_type == @'character') {
|
||||
#ifdef ECL_UNICODE
|
||||
extended = 1;
|
||||
#endif
|
||||
} else if (!Null(_ecl_funcall3(@'subtypep', element_type, @'base-char'))) {
|
||||
(void)0;
|
||||
} else if (!Null(_ecl_funcall3(@'subtypep', element_type, @'character'))) {
|
||||
#ifdef ECL_UNICODE
|
||||
extended = 1;
|
||||
#endif
|
||||
} else {
|
||||
FEerror("In MAKE-STRING-OUTPUT-STREAM, the argument :ELEMENT-TYPE (~A) must be a subtype of character",
|
||||
1, element_type);
|
||||
}
|
||||
@(return ecl_make_string_output_stream(128, extended));
|
||||
@)
|
||||
|
||||
cl_object
|
||||
cl_get_output_stream_string(cl_object strm)
|
||||
{
|
||||
cl_object strng;
|
||||
unlikely_if (!ECL_ANSI_STREAM_TYPE_P(strm, ecl_smm_string_output))
|
||||
FEwrong_type_only_arg(@[get-output-stream-string],
|
||||
strm, @[string-stream]);
|
||||
strng = cl_copy_seq(STRING_OUTPUT_STRING(strm));
|
||||
STRING_OUTPUT_STRING(strm)->base_string.fillp = 0;
|
||||
@(return strng);
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* STRING INPUT STREAMS
|
||||
*/
|
||||
|
||||
static ecl_character
|
||||
str_in_read_char(cl_object strm)
|
||||
{
|
||||
cl_fixnum curr_pos = STRING_INPUT_POSITION(strm);
|
||||
ecl_character c;
|
||||
if (curr_pos >= STRING_INPUT_LIMIT(strm)) {
|
||||
c = EOF;
|
||||
} else {
|
||||
c = ecl_char(STRING_INPUT_STRING(strm), curr_pos);
|
||||
STRING_INPUT_POSITION(strm) = curr_pos+1;
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
static void
|
||||
str_in_unread_char(cl_object strm, ecl_character c)
|
||||
{
|
||||
cl_fixnum curr_pos = STRING_INPUT_POSITION(strm);
|
||||
unlikely_if (c <= 0) {
|
||||
ecl_unread_error(strm);
|
||||
}
|
||||
STRING_INPUT_POSITION(strm) = curr_pos - 1;
|
||||
}
|
||||
|
||||
static ecl_character
|
||||
str_in_peek_char(cl_object strm)
|
||||
{
|
||||
cl_index pos = STRING_INPUT_POSITION(strm);
|
||||
if (pos >= STRING_INPUT_LIMIT(strm)) {
|
||||
return EOF;
|
||||
} else {
|
||||
return ecl_char(STRING_INPUT_STRING(strm), pos);
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
str_in_listen(cl_object strm)
|
||||
{
|
||||
if (STRING_INPUT_POSITION(strm) < STRING_INPUT_LIMIT(strm))
|
||||
return ECL_LISTEN_AVAILABLE;
|
||||
else
|
||||
return ECL_LISTEN_EOF;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
str_in_element_type(cl_object strm)
|
||||
{
|
||||
cl_object string = STRING_INPUT_STRING(strm);
|
||||
if (ECL_BASE_STRING_P(string))
|
||||
return @'base-char';
|
||||
return @'character';
|
||||
}
|
||||
|
||||
static cl_object
|
||||
str_in_get_position(cl_object strm)
|
||||
{
|
||||
return ecl_make_unsigned_integer(STRING_INPUT_POSITION(strm));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
str_in_set_position(cl_object strm, cl_object pos)
|
||||
{
|
||||
cl_fixnum disp;
|
||||
if (Null(pos)) {
|
||||
disp = STRING_INPUT_LIMIT(strm);
|
||||
} else {
|
||||
disp = ecl_to_size(pos);
|
||||
if (disp >= STRING_INPUT_LIMIT(strm)) {
|
||||
disp = STRING_INPUT_LIMIT(strm);
|
||||
}
|
||||
}
|
||||
STRING_INPUT_POSITION(strm) = disp;
|
||||
return ECL_T;
|
||||
}
|
||||
|
||||
const struct ecl_file_ops str_in_ops = {
|
||||
ecl_not_output_write_byte8,
|
||||
ecl_not_binary_read_byte8,
|
||||
|
||||
ecl_not_output_write_byte,
|
||||
ecl_not_binary_read_byte,
|
||||
|
||||
str_in_read_char,
|
||||
ecl_not_output_write_char,
|
||||
str_in_unread_char,
|
||||
str_in_peek_char,
|
||||
|
||||
ecl_generic_read_vector,
|
||||
ecl_generic_write_vector,
|
||||
|
||||
str_in_listen,
|
||||
ecl_generic_void, /* clear-input */
|
||||
ecl_not_output_clear_output,
|
||||
ecl_not_output_finish_output,
|
||||
ecl_not_output_force_output,
|
||||
|
||||
ecl_generic_always_true, /* input_p */
|
||||
ecl_generic_always_false, /* output_p */
|
||||
ecl_generic_always_false,
|
||||
str_in_element_type,
|
||||
|
||||
ecl_not_a_file_stream, /* length */
|
||||
str_in_get_position,
|
||||
str_in_set_position,
|
||||
ecl_not_output_string_length,
|
||||
ecl_unknown_column,
|
||||
|
||||
ecl_not_a_file_stream,
|
||||
ecl_not_a_file_stream,
|
||||
|
||||
ecl_generic_close
|
||||
};
|
||||
|
||||
cl_object
|
||||
ecl_make_string_input_stream(cl_object strng, cl_index istart, cl_index iend)
|
||||
{
|
||||
cl_object strm;
|
||||
|
||||
strm = ecl_alloc_stream();
|
||||
strm->stream.ops = ecl_duplicate_dispatch_table(&str_in_ops);
|
||||
strm->stream.mode = (short)ecl_smm_string_input;
|
||||
STRING_INPUT_STRING(strm) = strng;
|
||||
STRING_INPUT_POSITION(strm) = istart;
|
||||
STRING_INPUT_LIMIT(strm) = iend;
|
||||
#if !defined(ECL_UNICODE)
|
||||
strm->stream.format = @':pass-through';
|
||||
strm->stream.flags = ECL_STREAM_DEFAULT_FORMAT;
|
||||
strm->stream.byte_size = 8;
|
||||
#else
|
||||
if (ECL_BASE_STRING_P(strng)) {
|
||||
strm->stream.format = @':latin-1';
|
||||
strm->stream.flags = ECL_STREAM_LATIN_1;
|
||||
strm->stream.byte_size = 8;
|
||||
} else {
|
||||
strm->stream.format = @':ucs-4';
|
||||
strm->stream.flags = ECL_STREAM_UCS_4;
|
||||
strm->stream.byte_size = 32;
|
||||
}
|
||||
#endif
|
||||
return strm;
|
||||
}
|
||||
|
||||
@(defun make_string_input_stream (strng &o (istart ecl_make_fixnum(0)) iend)
|
||||
cl_index_pair p;
|
||||
@
|
||||
strng = cl_string(strng);
|
||||
p = ecl_vector_start_end(@[make-string-input-stream], strng, istart, iend);
|
||||
@(return (ecl_make_string_input_stream(strng, p.start, p.end)));
|
||||
@)
|
||||
|
|
@ -318,6 +318,14 @@ extern ECL_API cl_index cl_num_symbols_in_core;
|
|||
extern ECL_API cl_object APPLY_fixed(cl_narg n, cl_object (*f)(), cl_object *x);
|
||||
extern ECL_API cl_object APPLY(cl_narg n, cl_objectfn, cl_object *x);
|
||||
|
||||
/* atomic.d */
|
||||
|
||||
extern ECL_API cl_object ecl_atomic_get(cl_object *slot);
|
||||
extern ECL_API cl_object ecl_atomic_psh(cl_object *slot, cl_object cons);
|
||||
extern ECL_API cl_object ecl_atomic_pop(cl_object *slot);
|
||||
extern ECL_API cl_index ecl_atomic_index_incf(cl_index *slot);
|
||||
#define ecl_atomic_push(slot, obj) ecl_atomic_psh(slot, ecl_list1(obj));
|
||||
|
||||
/* stack.c */
|
||||
extern ECL_API cl_object ecl_make_stack(cl_index dim);
|
||||
extern ECL_API cl_object ecl_stack_push(cl_object stack, cl_object elt);
|
||||
|
|
@ -1841,13 +1849,6 @@ extern ECL_API cl_object mp_mailbox_try_read(cl_object mailbox);
|
|||
extern ECL_API cl_object mp_mailbox_send(cl_object mailbox, cl_object msg);
|
||||
extern ECL_API cl_object mp_mailbox_try_send(cl_object mailbox, cl_object msg);
|
||||
|
||||
/* threads/atomic.c */
|
||||
|
||||
extern ECL_API cl_object ecl_atomic_get(cl_object *slot);
|
||||
extern ECL_API void ecl_atomic_push(cl_object *slot, cl_object o);
|
||||
extern ECL_API cl_object ecl_atomic_pop(cl_object *slot);
|
||||
extern ECL_API cl_index ecl_atomic_index_incf(cl_index *slot);
|
||||
|
||||
/* threads/mutex.c */
|
||||
|
||||
extern ECL_API cl_object mp_make_lock _ECL_ARGS((cl_narg narg, ...));
|
||||
|
|
|
|||
|
|
@ -388,6 +388,102 @@ extern void _ecl_dump_c_backtrace();
|
|||
|
||||
extern enum ecl_ffi_tag ecl_foreign_type_code(cl_object type);
|
||||
|
||||
/* stream.d */
|
||||
cl_object ecl_alloc_stream(void);
|
||||
struct ecl_file_ops *ecl_duplicate_dispatch_table(const struct ecl_file_ops *ops);
|
||||
const struct ecl_file_ops *ecl_stream_dispatch_table(cl_object strm);
|
||||
cl_index ecl_read_byte8(cl_object stream, unsigned char *c, cl_index n);
|
||||
cl_index ecl_write_byte8(cl_object stream, unsigned char *c, cl_index n);
|
||||
|
||||
cl_object si_read_char(cl_object strm, cl_object eof_value);
|
||||
cl_object si_unread_char(cl_object strm, cl_object eof_value);
|
||||
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_peek_byte(cl_object strm, cl_object eof_value);
|
||||
cl_object si_write_byte(cl_object strm, cl_object c);
|
||||
|
||||
cl_object si_listen(cl_object strm);
|
||||
cl_object si_clear_input(cl_object strm);
|
||||
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);
|
||||
|
||||
/* streams/strm_common.d */
|
||||
cl_object ecl_not_a_file_stream(cl_object strm);
|
||||
void ecl_not_an_input_stream(cl_object strm);
|
||||
void ecl_not_an_output_stream(cl_object strm);
|
||||
cl_index ecl_not_output_write_byte8(cl_object strm, unsigned char *c, cl_index n);
|
||||
cl_index ecl_not_input_read_byte8(cl_object strm, unsigned char *c, cl_index n);
|
||||
cl_index ecl_not_binary_read_byte8(cl_object strm, unsigned char *c, cl_index n);
|
||||
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);
|
||||
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);
|
||||
int ecl_not_input_listen(cl_object strm);
|
||||
ecl_character ecl_not_character_read_char(cl_object strm);
|
||||
ecl_character ecl_not_character_write_char(cl_object strm, ecl_character c);
|
||||
ecl_character ecl_not_character_decoder(cl_object stream, unsigned char **buffer, unsigned char *buffer_end);
|
||||
int ecl_not_character_encoder(cl_object stream, unsigned char *buffer, ecl_character c);
|
||||
void ecl_not_input_clear_input(cl_object strm);
|
||||
void ecl_not_output_clear_output(cl_object strm);
|
||||
void ecl_not_output_force_output(cl_object strm);
|
||||
void ecl_not_output_finish_output(cl_object strm);
|
||||
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);
|
||||
ecl_character ecl_generic_peek_char(cl_object strm);
|
||||
void ecl_generic_void(cl_object strm);
|
||||
int ecl_generic_always_true(cl_object strm);
|
||||
int ecl_generic_always_false(cl_object strm);
|
||||
cl_object ecl_generic_always_nil(cl_object strm);
|
||||
int ecl_generic_column(cl_object strm);
|
||||
cl_object ecl_generic_set_position(cl_object strm, cl_object pos);
|
||||
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_eformat.d */
|
||||
ecl_character ecl_eformat_read_char(cl_object strm);
|
||||
void ecl_eformat_unread_char(cl_object strm, ecl_character c);
|
||||
ecl_character ecl_eformat_write_char(cl_object strm, ecl_character c);
|
||||
void ecl_set_stream_elt_type(cl_object stream, cl_fixnum byte_size, int flags,
|
||||
cl_object external_format);
|
||||
cl_object ecl_eformat_file_string_length(cl_object stream, cl_object string);
|
||||
|
||||
static inline void
|
||||
write_char_increment_column(cl_object strm, ecl_character c)
|
||||
{
|
||||
if (c == '\n')
|
||||
strm->stream.column = 0;
|
||||
else if (c == '\t')
|
||||
strm->stream.column = (strm->stream.column & ~((cl_index)07)) + 8;
|
||||
else
|
||||
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. */
|
||||
#define ENCODING_BUFFER_MAX_SIZE 8
|
||||
|
||||
/* file.d */
|
||||
|
||||
/* Windows does not have this flag (POSIX thing) */
|
||||
|
|
|
|||
9
src/h/nucleus.h
Normal file
9
src/h/nucleus.h
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
|
||||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
#ifndef ECL_NUCLEUS_H
|
||||
#define ECL_NUCLEUS_H
|
||||
|
||||
#include "external.h"
|
||||
|
||||
#endif /* ECL_NUCLEUS_H */
|
||||
|
|
@ -590,7 +590,7 @@ 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);
|
||||
|
||||
void (*write_byte)(cl_object c, cl_object strm);
|
||||
void (*write_byte)(cl_object strm, cl_object byte);
|
||||
cl_object (*read_byte)(cl_object strm);
|
||||
|
||||
int (*read_char)(cl_object strm);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue