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

msvc/ecl-threads.def

@@ -1419,4 +1419,3 @@ EXPORTS
 	clos_standard_instance_set
 	assert_type_base_string
 	; unicode
-	; si_extended_string_concatenate

msvc/ecl.def

@@ -1401,4 +1401,3 @@ EXPORTS
 	clos_standard_instance_set
 	assert_type_base_string
 	; unicode
-	; si_extended_string_concatenate

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().
 

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)
 {

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)

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},

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},

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