mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-27 11:40:45 -07:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'develop' into 'develop'

Browse source 
Fix for #403

Closes #403

See merge request embeddable-common-lisp/ecl!109
This commit is contained in:
Daniel Kochmański 2018-05-25 05:11:26 +00:00
commit 5de18683ac
6 changed files with 123 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/character.d
View file

@ -487,8 +487,10 @@ cl_char_name(cl_object c)
cl_object output;
if (code <= 127) {
output = ecl_gethash_safe(ecl_make_fixnum(code), cl_core.char_names, ECL_NIL);
#ifdef ECL_UNICODE
} else if (!Null(output = _ecl_ucd_code_to_name(code))) {
(void)0;
#endif
} else {
ecl_base_char name[8];
ecl_base_char *start;
@ -521,10 +523,12 @@ cl_name_char(cl_object name)
if (c != ECL_NIL) {
ecl_return1(the_env, ECL_CODE_CHAR(ecl_fixnum(c)));
}
#ifdef ECL_UNICODE
c = _ecl_ucd_name_to_code(name);
if (c != ECL_NIL) {
ecl_return1(the_env, cl_code_char(c));
}
#endif
if (ecl_stringp(name) && (l = ecl_length(name))) {
c = cl_char(name, ecl_make_fixnum(0));
if (l == 1) {

78
src/c/file.d
View file

@ -60,6 +60,8 @@
* with 4 being the charset prefix, 2 for the character.
*/
#define ENCODING_BUFFER_MAX_SIZE 6
/* Size of the encoding buffer for vectors */
#define VECTOR_ENCODING_BUFFER_SIZE 2048
static cl_index ecl_read_byte8(cl_object stream, unsigned char *c, cl_index n);
static cl_index ecl_write_byte8(cl_object stream, unsigned char *c, cl_index n);
@ -583,6 +585,17 @@ eformat_read_char(cl_object strm)
return c;
}
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++;
}
static ecl_character
eformat_write_char(cl_object strm, ecl_character c)
{
@ -590,13 +603,7 @@ eformat_write_char(cl_object strm, ecl_character c)
ecl_character nbytes;
nbytes = strm->stream.encoder(strm, buffer, c);
strm->stream.ops->write_byte8(strm, buffer, nbytes);
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++;
fflush(stdout);
write_char_increment_column(strm, c);
return c;
}
@ -1335,13 +1342,7 @@ const struct ecl_file_ops clos_stream_ops = {
static ecl_character
str_out_write_char(cl_object strm, ecl_character c)
{
int column = strm->stream.column;
if (c == '\n')
strm->stream.column = 0;
else if (c == '\t')
strm->stream.column = (column&~(cl_index)7) + 8;
else
strm->stream.column++;
write_char_increment_column(strm, c);
ecl_string_push_extend(STRING_OUTPUT_STRING(strm), c);
return c;
}
@ -2892,7 +2893,40 @@ io_file_write_vector(cl_object strm, cl_object data, cl_index start, cl_index en
bytes = strm->stream.ops->write_byte8(strm, aux, bytes);
return start + bytes / sizeof(cl_fixnum);
}
} else if (t == ecl_aet_bc) {
unsigned char buffer[VECTOR_ENCODING_BUFFER_SIZE + ENCODING_BUFFER_MAX_SIZE];
cl_index nbytes = 0;
cl_index i;
for (i = start; i < end; i++) {
ecl_character c = *(data->vector.self.bc + i);
nbytes += strm->stream.encoder(strm, buffer + nbytes, c);
write_char_increment_column(strm, c);
if (nbytes >= VECTOR_ENCODING_BUFFER_SIZE) {
strm->stream.ops->write_byte8(strm, buffer, nbytes);
nbytes = 0;
}
}
strm->stream.ops->write_byte8(strm, buffer, nbytes);
return end;
}
#ifdef ECL_UNICODE
else if (t == ecl_aet_ch) {
unsigned char buffer[VECTOR_ENCODING_BUFFER_SIZE + ENCODING_BUFFER_MAX_SIZE];
cl_index nbytes = 0;
cl_index i;
for (i = start; i < end; i++) {
ecl_character c = *(data->vector.self.c + i);
nbytes += strm->stream.encoder(strm, buffer + nbytes, c);
write_char_increment_column(strm, c);
if (nbytes >= VECTOR_ENCODING_BUFFER_SIZE) {
strm->stream.ops->write_byte8(strm, buffer, nbytes);
nbytes = 0;
}
}
strm->stream.ops->write_byte8(strm, buffer, nbytes);
return end;
}
#endif
return generic_write_vector(strm, data, start, end);
}
@ -4699,8 +4733,20 @@ ecl_peek_char(cl_object strm)
void
writestr_stream(const char *s, cl_object strm)
{
while (*s != '\0')
ecl_write_char(*s++, 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));
cl_write_string(2, buffer, strm);
i = 0;
}
}
si_fill_pointer_set(buffer, ecl_make_fixnum(i));
cl_write_string(2, buffer, strm);
si_put_buffer_string(buffer);
}
static cl_index

23
src/c/print.d
View file

@ -220,7 +220,7 @@ ecl_print_circle(void)
@(defun write-string (strng &o strm &k (start ecl_make_fixnum(0)) end)
@
unlikely_if (!ECL_STRINGP(strng))
FEwrong_type_nth_arg(@[write-string], 1, strng, @[string]);
FEwrong_type_nth_arg(@[write-string], 1, strng, @[string]);
strm = _ecl_stream_or_default_output(strm);
#ifdef ECL_CLOS_STREAMS
if (!ECL_ANSI_STREAM_P(strm))
@ -234,7 +234,7 @@ ecl_print_circle(void)
@(defun write-line (strng &o strm &k (start ecl_make_fixnum(0)) end)
@
unlikely_if (!ECL_STRINGP(strng))
FEwrong_type_nth_arg(@[write-line], 1, strng, @[string]);
FEwrong_type_nth_arg(@[write-line], 1, strng, @[string]);
strm = _ecl_stream_or_default_output(strm);
#ifdef ECL_CLOS_STREAMS
if (!ECL_ANSI_STREAM_P(strm))
@ -364,24 +364,7 @@ ecl_terpri(cl_object strm)
void
ecl_write_string(cl_object strng, cl_object strm)
{
cl_index i;
strm = _ecl_stream_or_default_output(strm);
switch(ecl_t_of(strng)) {
#ifdef ECL_UNICODE
case t_string:
for (i = 0; i < strng->string.fillp; i++)
ecl_write_char(strng->string.self[i], strm);
break;
#endif
case t_base_string:
for (i = 0; i < strng->base_string.fillp; i++)
ecl_write_char(strng->base_string.self[i], strm);
break;
default:
FEwrong_type_nth_arg(@[write-string], 1, strng, @[string]);
}
cl_write_string(2, strng, strm);
ecl_force_output(strm);
}

23
src/c/printer/print_unreadable.d
View file

@ -26,18 +26,31 @@ _ecl_write_addr(void *x, cl_object stream)
return;
}
writestr_stream("0x", stream);
cl_object buffer = si_get_buffer_string();
cl_index buffer_size = ecl_fixnum(cl_array_total_size(buffer));
cl_index buffer_ndx = 0;
for (j = sizeof(i)*8-4; j >= 0; j -= 4) {
int k = (i>>j) & 0xf;
if (!print_zeros && k == 0) {
;
} else if (k < 10) {
print_zeros = 1;
ecl_write_char('0' + k, stream);
} else {
print_zeros = 1;
ecl_write_char('a' + k - 10, stream);
if (k < 10) {
print_zeros = 1;
ecl_char_set(buffer, buffer_ndx++, '0' + k);
} else {
print_zeros = 1;
ecl_char_set(buffer, buffer_ndx++, 'a' + k - 10);
}
if (buffer_ndx >= buffer_size) {
si_fill_pointer_set(buffer, ecl_make_fixnum(buffer_size));
cl_write_string(2, buffer, stream);
buffer_ndx = 0;
}
}
}
si_fill_pointer_set(buffer, ecl_make_fixnum(buffer_ndx));
cl_write_string(2, buffer, stream);
si_put_buffer_string(buffer);
}
void

30
src/c/printer/write_array.d
View file

@ -148,18 +148,20 @@ _ecl_write_vector(cl_object x, cl_object stream)
void
_ecl_write_string(cl_object x, cl_object stream)
{
cl_index ndx;
if (!ecl_print_escape() && !ecl_print_readably()) {
for (ndx = 0; ndx < x->string.fillp; ndx++)
ecl_write_char(x->string.self[ndx], stream);
cl_write_string(2, x, stream);
} else {
cl_index ndx, ndx_start;
ecl_write_char('"', stream);
for (ndx = 0; ndx < x->string.fillp; ndx++) {
for (ndx = ndx_start = 0; ndx < x->string.fillp; ndx++) {
ecl_character c = x->string.self[ndx];
if (c == '"' || c == '\\')
if (c == '"' || c == '\\') {
cl_write_string(6, x, stream, @':start', ecl_make_fixnum(ndx_start), @':end', ecl_make_fixnum(ndx));
ecl_write_char('\\', stream);
ecl_write_char(c, stream);
ndx_start = ndx;
}
}
cl_write_string(4, x, stream, @':start', ecl_make_fixnum(ndx_start));
ecl_write_char('"', stream);
}
}
@ -168,18 +170,20 @@ _ecl_write_string(cl_object x, cl_object stream)
void
_ecl_write_base_string(cl_object x, cl_object stream)
{
cl_index ndx;
if (!ecl_print_escape() && !ecl_print_readably()) {
for (ndx = 0; ndx < x->base_string.fillp; ndx++)
ecl_write_char(x->base_string.self[ndx], stream);
cl_write_string(2, x, stream);
} else {
cl_index ndx, ndx_start;
ecl_write_char('"', stream);
for (ndx = 0; ndx < x->base_string.fillp; ndx++) {
int c = x->base_string.self[ndx];
if (c == '"' || c == '\\')
for (ndx = ndx_start = 0; ndx < x->base_string.fillp; ndx++) {
ecl_character c = x->base_string.self[ndx];
if (c == '"' || c == '\\') {
cl_write_string(6, x, stream, @':start', ecl_make_fixnum(ndx_start), @':end', ecl_make_fixnum(ndx));
ecl_write_char('\\', stream);
ecl_write_char(c, stream);
ndx_start = ndx;
}
}
cl_write_string(4, x, stream, @':start', ecl_make_fixnum(ndx_start));
ecl_write_char('"', stream);
}
}

24
src/c/printer/write_symbol.d
View file

@ -102,6 +102,14 @@ needs_to_be_escaped(cl_object s, cl_object readtable, cl_object print_case)
return 0;
}
#define buffer_write_char(c, buffer, stream, buffer_ndx, buffer_size) \
ecl_char_set(buffer, buffer_ndx++, c); \
if (buffer_ndx >= buffer_size) { \
si_fill_pointer_set(buffer, ecl_make_fixnum(buffer_size)); \
cl_write_string(2, buffer, stream); \
buffer_ndx = 0; \
}
static void
write_symbol_string(cl_object s, int action, cl_object print_case,
cl_object stream, bool escape)
@ -112,14 +120,17 @@ write_symbol_string(cl_object s, int action, cl_object print_case,
if (!needs_to_be_inverted(s))
action = ecl_case_preserve;
}
cl_object buffer = si_get_buffer_string();
cl_index buffer_size = ecl_fixnum(cl_array_total_size(buffer));
cl_index buffer_ndx = 0;
if (escape)
ecl_write_char('|', stream);
buffer_write_char('|', buffer, stream, buffer_ndx, buffer_size);
capitalize = 1;
for (i = 0; i < s->base_string.fillp; i++) {
int c = ecl_char(s, i);
ecl_character c = ecl_char(s, i);
if (escape) {
if (c == '|' || c == '\\') {
ecl_write_char('\\', stream);
buffer_write_char('\\', buffer, stream, buffer_ndx, buffer_size);
}
} else if (action != ecl_case_preserve) {
if (ecl_upper_case_p(c)) {
@ -144,10 +155,13 @@ write_symbol_string(cl_object s, int action, cl_object print_case,
capitalize = !ecl_alphanumericp(c);
}
}
ecl_write_char(c, stream);
buffer_write_char(c, buffer, stream, buffer_ndx, buffer_size);
}
if (escape)
ecl_write_char('|', stream);
buffer_write_char('|', buffer, stream, buffer_ndx, buffer_size);
si_fill_pointer_set(buffer, ecl_make_fixnum(buffer_ndx));
cl_write_string(2, buffer, stream);
si_put_buffer_string(buffer);
}
static bool