mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-27 23:11:18 -08:00
Code Issues Projects Releases Packages Wiki Activity

Remove ad-hoc limit in the number of strings SI:BASE-STRING-CONCATENATE can handle. New macros for copying and finishing arguments lists.

Browse source
This commit is contained in:
jgarcia 2006-10-27 22:16:45 +00:00
parent 8958390eae
commit aee133c4b5
8 changed files with 39 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

14
src/c/eval.d
View file

@ -41,6 +41,20 @@ cl__va_start(cl_va_list args, int narg_before)
}
}
void
cl_va_copy(cl_va_list dest, cl_va_list orig)
{
dest[0].narg = orig[0].narg;
dest[0].sp = orig[0].sp;
va_copy(dest[0].args, orig[0].args);
}
void
cl_va_end(cl_va_list args)
{
va_end(args[0].args);
}
cl_object
cl_va_arg(cl_va_list args)
{

66
src/c/string.d
View file

@ -1007,61 +1007,27 @@ nstring_case(cl_narg narg, int (*casefun)(int, bool *), cl_va_list ARGS)
@(defun si::base_string_concatenate (&rest args)
cl_index l;
int i;
char *vself;
#ifdef __GNUC__
cl_object v, strings[narg];
#else
#define NARG_MAX 64
cl_object v, strings[NARG_MAX];
#endif
cl_object output;
@
#ifndef __GNUC__
if (narg > NARG_MAX)
FEerror("si::string_concatenate: Too many arguments, limited to ~A", 1, MAKE_FIXNUM(NARG_MAX));
#endif
/* FIXME! We should use cl_va_start() instead of this ugly trick */
for (i = 0, l = 0; i < narg; i++) {
strings[i] = si_coerce_to_base_string(cl_va_arg(args));
l += strings[i]->base_string.fillp;
/* Compute final size and store NONEMPTY coerced strings. */
for (i = 0, l = 0; i < narg; i++) {
cl_object s = si_coerce_to_base_string(cl_va_arg(args));
if (s->base_string.fillp) {
cl_stack_push(s);
l += s->base_string.fillp;
}
}
v = cl_alloc_simple_base_string(l);
for (i = 0, vself = v->base_string.self; i < narg; i++, vself += l) {
l = strings[i]->base_string.fillp;
memcpy(vself, strings[i]->base_string.self, l);
/* Do actual copying by recovering those strings */
output = cl_alloc_simple_base_string(l);
while (l) {
cl_object s = cl_stack_pop();
size_t bytes = s->base_string.fillp;
l -= bytes;
memcpy(output->base_string.self + l, s->base_string.self, bytes);
}
@(return v)
@(return output);
@)
#ifdef ECL_UNICODE
@(defun si::extended_string_concatenate (&rest args)
cl_index l;
int i;
char *vself;
#ifdef __GNUC__
cl_object v, strings[narg];
#else
#define NARG_MAX 64
cl_object v, strings[NARG_MAX];
#endif
@
#ifndef __GNUC__
if (narg > NARG_MAX)
FEerror("si::string_concatenate: Too many arguments, limited to ~A", 1, MAKE_FIXNUM(NARG_MAX));
#endif
/* FIXME! We should use cl_va_start() instead of this ugly trick */
for (i = 0, l = 0; i < narg; i++) {
strings[i] = si_coerce_to_extended_string(cl_va_arg(args));
l += strings[i]->string.fillp;
}
v = cl_alloc_simple_extended_string(l);
for (i = 0, vself = v->string.self; i < narg; i++, vself += l) {
l = strings[i]->string.fillp;
memcpy(vself, strings[i]->string.self, l);
}
@(return v)
@)
#endif
#ifdef ECL_UNICODE
int
ecl_string_push_extend(cl_object s, int c)

3
src/c/symbols_list.h
View file

@ -1183,9 +1183,6 @@ cl_symbols[] = {
{SYS_ "STANDARD-READTABLE", SI_ORDINARY, si_standard_readtable, 0, OBJNULL},
{SYS_ "STEPPER", SI_ORDINARY, OBJNULL, -1, OBJNULL},
{SYS_ "BASE-STRING-CONCATENATE", SI_ORDINARY, si_base_string_concatenate, -1, OBJNULL},
#ifdef ECL_UNICODE
{SYS_ "EXTENDED-STRING-CONCATENATE", SI_ORDINARY, si_extended_string_concatenate, -1, OBJNULL},
#endif
{SYS_ "STRING-TO-OBJECT", SI_ORDINARY, si_string_to_object, 1, OBJNULL},
{SYS_ "STRUCTURE-NAME", SI_ORDINARY, si_structure_name, 1, OBJNULL},
{SYS_ "STRUCTURE-PRINT-FUNCTION", SI_ORDINARY, NULL, -1, OBJNULL},

3
src/c/symbols_list2.h
View file

@ -1183,9 +1183,6 @@ cl_symbols[] = {
{SYS_ "STANDARD-READTABLE","si_standard_readtable"},
{SYS_ "STEPPER","OBJNULL"},
{SYS_ "BASE-STRING-CONCATENATE","si_base_string_concatenate"},
#ifdef ECL_UNICODE
{SYS_ "EXTENDED-STRING-CONCATENATE","si_extended_string_concatenate"},
#endif
{SYS_ "STRING-TO-OBJECT","si_string_to_object"},
{SYS_ "STRUCTURE-NAME","si_structure_name"},
{SYS_ "STRUCTURE-PRINT-FUNCTION",NULL},