mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-12 16:00:31 -07:00
Code Issues Projects Releases Packages Wiki Activity

reader: open-code token-specific version of ecl_push_string_extend

Browse source 
This way we make the reader independent of string.d and array.d while still
enabling adjustable token buffers.
This commit is contained in:
Daniel Kochmański 2026-03-07 09:06:26 +01:00
parent dd839fdea2
commit 730ff85112
1 changed files with 80 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

111
src/c/reader.d
View file

@ -92,34 +92,7 @@ ecl_invalid_character_p(int c)
return (c <= 32) || (c == 127);
}
/* -- tokens ---------------------------------------------------------------- */
static cl_object
ecl_make_token()
{
cl_object o = ecl_alloc_object(t_token);
o->token.escaped = 0;
o->token.string = si_get_buffer_string();
o->token.escape = ecl_make_stack(0);
return o;
}
cl_object
si_token_string(cl_object token)
{
cl_env_ptr the_env = ecl_process_env();
cl_object object = token->token.string;
ecl_return1(the_env, object);
}
cl_object
si_token_escape(cl_object token)
{
cl_env_ptr the_env = ecl_process_env();
cl_object object = token->token.escape;
ecl_return1(the_env, object);
}
/* -- buffer ---------------------------------------------------------------- */
cl_object
si_get_buffer_string()
{
@ -160,6 +133,82 @@ si_put_buffer_string(cl_object string)
@(return);
}
/* INV the buffer is never simultenaously used nor does it have displacements,
so we can open-code PUSH-EXTEND and eagerly deallocate the underlying array.
-- jd 2026-03-08 */
static ecl_character
_ecl_string_push_extend(cl_object s, ecl_character c)
{
cl_index dim, fillp;
switch(ecl_t_of(s)) {
#ifdef ECL_UNICODE
case t_string:
fillp = s->string.fillp;
dim = s->string.dim;
if (fillp >= dim) {
cl_index new_size = dim + dim/2 + 1;
cl_index old_bytes = sizeof(ecl_character) * dim;
cl_index new_bytes = sizeof(ecl_character) * new_size;
ecl_character *old_self = s->string.self;
ecl_character *new_self = (ecl_character *)ecl_alloc_atomic(new_bytes);
ecl_copy(new_self, old_self, old_bytes);
s->string.self = new_self;
s->string.dim = new_size;
ecl_dealloc(old_self);
}
s->string.fillp++;
return s->string.self[fillp] = c;
#endif
case t_base_string:
fillp = s->base_string.fillp;
dim = s->base_string.dim;
if (fillp >= dim) {
cl_index new_size = dim + dim/2 + 1;
cl_index old_bytes = sizeof(ecl_base_char) * dim;
cl_index new_bytes = sizeof(ecl_base_char) * new_size;
ecl_base_char *old_self = s->base_string.self;
ecl_base_char *new_self = (ecl_base_char *)ecl_alloc_atomic(new_bytes+1);
new_self[new_bytes] = 0;
ecl_copy(new_self, old_self, old_bytes);
s->base_string.self = new_self;
s->base_string.dim = new_size;
ecl_dealloc(old_self);
}
s->base_string.fillp++;
return s->base_string.self[fillp] = c;
default:
ecl_internal_error("BUFFER-STRING is not a string.");
}
}
/* -- tokens ---------------------------------------------------------------- */
static cl_object
ecl_make_token()
{
cl_object o = ecl_alloc_object(t_token);
o->token.escaped = 0;
o->token.string = si_get_buffer_string();
o->token.escape = ecl_make_stack(0);
return o;
}
cl_object
si_token_string(cl_object token)
{
cl_env_ptr the_env = ecl_process_env();
cl_object object = token->token.string;
ecl_return1(the_env, object);
}
cl_object
si_token_escape(cl_object token)
{
cl_env_ptr the_env = ecl_process_env();
cl_object object = token->token.escape;
ecl_return1(the_env, object);
}
/* FIXME pools should be resizeable stacks. */
cl_object
ecl_get_reader_token(void)
@ -237,7 +286,7 @@ ecl_read_token(cl_object rtbl, cl_object in, int flags)
if (a == cat_single_escape) {
c = ecl_read_char_noeof(in);
a = cat_constituent;
ecl_string_push_extend(string, c);
_ecl_string_push_extend(string, c);
length++;
ecl_stack_push(escape, ecl_make_fixnum(length-1));
ecl_stack_push(escape, ecl_make_fixnum(length));
@ -253,7 +302,7 @@ ecl_read_token(cl_object rtbl, cl_object in, int flags)
a = cat_constituent;
} else if (a == cat_multiple_escape)
break;
ecl_string_push_extend(string, c);
_ecl_string_push_extend(string, c);
length++;
}
ecl_stack_push(escape, ecl_make_fixnum(begin));
@ -280,7 +329,7 @@ ecl_read_token(cl_object rtbl, cl_object in, int flags)
c = ecl_char_upcase(c);
}
}
ecl_string_push_extend(string, c);
_ecl_string_push_extend(string, c);
length++;
NEXT:
c = ecl_read_char(in);