diff --git a/msvc/ecl-threads.def b/msvc/ecl-threads.def index c30959c02..cd6f315e0 100755 --- a/msvc/ecl-threads.def +++ b/msvc/ecl-threads.def @@ -1419,4 +1419,3 @@ EXPORTS clos_standard_instance_set assert_type_base_string ; unicode - ; si_extended_string_concatenate diff --git a/msvc/ecl.def b/msvc/ecl.def index dd6c94c10..661118187 100644 --- a/msvc/ecl.def +++ b/msvc/ecl.def @@ -1401,4 +1401,3 @@ EXPORTS clos_standard_instance_set assert_type_base_string ; unicode - ; si_extended_string_concatenate diff --git a/src/CHANGELOG b/src/CHANGELOG index 7e8a976c3..9b0f073b5 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -99,6 +99,9 @@ ECL 1.0: - In OS X, ECL can now load shared libraries (Extension *.dylib) thanks to using dlopen() instead of the obsolete NSLinkModule() function. + - (CONCATENATE 'STRING ...) does no longer have an ad-hoc limit in the number + of strings. + * Unicode: - MAKE-STRING only allowed :ELEMENT-TYPE to be one of CHARACTER, BASE-CHAR, or @@ -134,9 +137,11 @@ ECL 1.0: - Support for hierarchical package names, as in Allegro Common-Lisp. - - C functions which disappear: si_set_compiled_function_name() + - C functions which disappear: si_set_compiled_function_name(), + si_extended_string_concatenate() - - Lisp functions which disappear: si-set-compiled-function-name. + - Lisp functions which disappear: si:set-compiled-function-name, + si:extended-string-concatenate. - New C functions: ecl_stream_to_handle(), ecl_base_char_code(). diff --git a/src/c/eval.d b/src/c/eval.d index 533d16a76..dd9ae6de7 100644 --- a/src/c/eval.d +++ b/src/c/eval.d @@ -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) { diff --git a/src/c/string.d b/src/c/string.d index 9dc86f244..c806eb3cb 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -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) diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 9884b7517..2244bb4ba 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -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}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index fcefb7ae8..a58a1fd23 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -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}, diff --git a/src/h/external.h b/src/h/external.h index dee035c01..3f22a25cc 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -477,6 +477,8 @@ extern cl_object si_safe_eval _ARGS((cl_narg narg, cl_object form, cl_object env #define cl_va_start(a,p,n,k) (va_start(a[0].args,p),a[0].narg=n,cl__va_start(a,k)) extern void cl__va_start(cl_va_list args, int args_before); +extern void cl_va_copy(cl_va_list dest, cl_va_list orig); +#define cl_va_end(args) (va_end((args)[0].args)) extern cl_object cl_va_arg(cl_va_list args); extern cl_object si_unlink_symbol(cl_object s); @@ -1477,7 +1479,6 @@ extern cl_object si_base_char_p(cl_object x); extern cl_object si_base_string_p(cl_object x); extern cl_object si_coerce_to_base_string(cl_object x); extern cl_object si_coerce_to_extended_string(cl_object x); -extern cl_object si_extended_string_concatenate _ARGS((cl_narg narg, ...)); extern cl_object cl_alloc_simple_extended_string(cl_index l); #else #define si_base_char_p cl_characterp