Faster append and vconcat

By separating the code paths for append and vconcat, each becomes
simpler and faster.

* src/fns.c (concat_strings): Rename to...
(concat_to_string): ...this.
(concat): Split into concat_to_list and concat_to_vector.
(concat_to_list, concat_to_vector): New, specialised and
streamlined from earlier combined code.
(concat2, concat3, Fappend, Fconcat, Fvconcat): Adjust calls.

1 files changed, 139 insertions, 86 deletions

diff --git a/src/fns.c b/src/fns.c
index f30b2f6fb3c..f4ba67b40e7 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -589,20 +589,21 @@ Do NOT use this function to compare file names for equality.  */)
 #endif /* !__STDC_ISO_10646__, !WINDOWSNT */
 }
 
-static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args,
-                           Lisp_Object last_tail, bool vector_target);
-static Lisp_Object concat_strings (ptrdiff_t nargs, Lisp_Object *args);
+static Lisp_Object concat_to_list (ptrdiff_t nargs, Lisp_Object *args,
+                                   Lisp_Object last_tail);
+static Lisp_Object concat_to_vector (ptrdiff_t nargs, Lisp_Object *args);
+static Lisp_Object concat_to_string (ptrdiff_t nargs, Lisp_Object *args);
 
 Lisp_Object
 concat2 (Lisp_Object s1, Lisp_Object s2)
 {
-  return concat_strings (2, ((Lisp_Object []) {s1, s2}));
+  return concat_to_string (2, ((Lisp_Object []) {s1, s2}));
 }
 
 Lisp_Object
 concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3)
 {
-  return concat_strings (3, ((Lisp_Object []) {s1, s2, s3}));
+  return concat_to_string (3, ((Lisp_Object []) {s1, s2, s3}));
 }
 
 DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
@@ -615,7 +616,7 @@ usage: (append &rest SEQUENCES)  */)
 {
   if (nargs == 0)
     return Qnil;
-  return concat (nargs - 1, args, args[nargs - 1], false);
+  return concat_to_list (nargs - 1, args, args[nargs - 1]);
 }
 
 DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
@@ -628,7 +629,7 @@ to be `eq'.
 usage: (concat &rest SEQUENCES)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return concat_strings (nargs, args);
+  return concat_to_string (nargs, args);
 }
 
 DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
@@ -638,7 +639,7 @@ Each argument may be a list, vector or string.
 usage: (vconcat &rest SEQUENCES)   */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return concat (nargs, args, Qnil, true);
+  return concat_to_vector (nargs, args);
 }
 
 
@@ -706,8 +707,8 @@ the same empty object instead of its copy.  */)
   wrong_type_argument (Qsequencep, arg);
 }
 
-/* This structure holds information of an argument of `concat_strings' that is
-   a string and has text properties to be copied.  */
+/* This structure holds information of an argument of `concat_to_string'
+   that is a string and has text properties to be copied.  */
 struct textprop_rec
 {
   ptrdiff_t argnum;             /* refer to ARGS (arguments of `concat') */
@@ -716,7 +717,7 @@ struct textprop_rec
 };
 
 static Lisp_Object
-concat_strings (ptrdiff_t nargs, Lisp_Object *args)
+concat_to_string (ptrdiff_t nargs, Lisp_Object *args)
 {
   USE_SAFE_ALLOCA;
 
@@ -912,19 +913,100 @@ concat_strings (ptrdiff_t nargs, Lisp_Object *args)
   return result;
 }
 
-/* Concatenate sequences into a list or vector. */
+/* Concatenate sequences into a list. */
+Lisp_Object
+concat_to_list (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail)
+{
+  /* Copy the contents of the args into the result.  */
+  Lisp_Object result = Qnil;
+  Lisp_Object last = Qnil;      /* Last cons in result if nonempty.  */
+
+  for (ptrdiff_t i = 0; i < nargs; i++)
+    {
+      Lisp_Object arg = args[i];
+      /* List arguments are treated specially since this is the common case.  */
+      if (CONSP (arg))
+        {
+          Lisp_Object head = Fcons (XCAR (arg), Qnil);
+          Lisp_Object prev = head;
+          arg = XCDR (arg);
+          FOR_EACH_TAIL (arg)
+            {
+              Lisp_Object next = Fcons (XCAR (arg), Qnil);
+              XSETCDR (prev, next);
+              prev = next;
+            }
+          CHECK_LIST_END (arg, arg);
+          if (NILP (result))
+            result = head;
+          else
+            XSETCDR (last, head);
+          last = prev;
+        }
+      else if (NILP (arg))
+        ;
+      else if (VECTORP (arg) || STRINGP (arg)
+               || BOOL_VECTOR_P (arg) || COMPILEDP (arg))
+        {
+          ptrdiff_t arglen = XFIXNUM (Flength (arg));
+          ptrdiff_t argindex_byte = 0;
 
+          /* Copy element by element.  */
+          for (ptrdiff_t argindex = 0; argindex < arglen; argindex++)
+            {
+              /* Fetch next element of `arg' arg into `elt', or break if
+                 `arg' is exhausted. */
+              Lisp_Object elt;
+              if (STRINGP (arg))
+                {
+                  int c;
+                  if (STRING_MULTIBYTE (arg))
+                    {
+                      ptrdiff_t char_idx = argindex;
+                      c = fetch_string_char_advance_no_check (arg, &char_idx,
+                                                              &argindex_byte);
+                    }
+                  else
+                    c = SREF (arg, argindex);
+                  elt = make_fixed_natnum (c);
+                }
+              else if (BOOL_VECTOR_P (arg))
+                elt = bool_vector_ref (arg, argindex);
+              else
+                elt = AREF (arg, argindex);
+
+              /* Store this element into the result.  */
+              Lisp_Object node = Fcons (elt, Qnil);
+              if (NILP (result))
+                result = node;
+              else
+                XSETCDR (last, node);
+              last = node;
+            }
+        }
+      else
+        wrong_type_argument (Qsequencep, arg);
+    }
+
+  if (NILP (result))
+    result = last_tail;
+  else
+    XSETCDR (last, last_tail);
+
+  return result;
+}
+
+/* Concatenate sequences into a vector.  */
 Lisp_Object
-concat (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail,
-        bool vector_target)
+concat_to_vector (ptrdiff_t nargs, Lisp_Object *args)
 {
   /* Check argument types and compute total length of arguments.  */
   EMACS_INT result_len = 0;
   for (ptrdiff_t i = 0; i < nargs; i++)
     {
       Lisp_Object arg = args[i];
-      if (!(CONSP (arg) || NILP (arg) || VECTORP (arg) || STRINGP (arg)
-            || COMPILEDP (arg) || BOOL_VECTOR_P (arg)))
+      if (!(VECTORP (arg) || CONSP (arg) || NILP (arg) || STRINGP (arg)
+            || BOOL_VECTOR_P (arg) || COMPILEDP (arg)))
         wrong_type_argument (Qsequencep, arg);
       EMACS_INT len = XFIXNAT (Flength (arg));
       result_len += len;
@@ -932,90 +1014,61 @@ concat (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail,
         memory_full (SIZE_MAX);
     }
 
-  /* When the target is a list, return the tail directly if all other
-     arguments are empty.  */
-  if (!vector_target && result_len == 0)
-    return last_tail;
-
-  /* Create the output object.  */
-  Lisp_Object result = vector_target
-    ? make_nil_vector (result_len)
-    : Fmake_list (make_fixnum (result_len), Qnil);
+  /* Create the output vector.  */
+  Lisp_Object result = make_uninit_vector (result_len);
+  Lisp_Object *dst = XVECTOR (result)->contents;
 
   /* Copy the contents of the args into the result.  */
-  Lisp_Object tail = Qnil;
-  ptrdiff_t toindex = 0;
-  if (CONSP (result))
-    {
-      tail = result;
-      toindex = -1;   /* -1 in toindex is flag we are making a list */
-    }
-
-  Lisp_Object prev = Qnil;
 
   for (ptrdiff_t i = 0; i < nargs; i++)
     {
-      ptrdiff_t arglen = 0;
-      ptrdiff_t argindex = 0;
-      ptrdiff_t argindex_byte = 0;
-
       Lisp_Object arg = args[i];
-      if (!CONSP (arg))
-        arglen = XFIXNUM (Flength (arg));
-
-      /* Copy element by element.  */
-      while (1)
+      if (VECTORP (arg))
         {
-          /* Fetch next element of `arg' arg into `elt', or break if
-             `arg' is exhausted. */
-          Lisp_Object elt;
-          if (CONSP (arg))
-            {
-              elt = XCAR (arg);
-              arg = XCDR (arg);
-            }
-          else if (NILP (arg) || argindex >= arglen)
-            break;
-          else if (STRINGP (arg))
+          ptrdiff_t size = ASIZE (arg);
+          memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst);
+          dst += size;
+        }
+      else if (CONSP (arg))
+        do
+          {
+            *dst++ = XCAR (arg);
+            arg = XCDR (arg);
+          }
+        while (!NILP (arg));
+      else if (NILP (arg))
+        ;
+      else if (STRINGP (arg))
+        {
+          ptrdiff_t size = SCHARS (arg);
+          if (STRING_MULTIBYTE (arg))
             {
-              int c;
-              if (STRING_MULTIBYTE (arg))
-                c = fetch_string_char_advance_no_check (arg, &argindex,
-                                                        &argindex_byte);
-              else
+              ptrdiff_t byte = 0;
+              for (ptrdiff_t i = 0; i < size;)
                 {
-                  c = SREF (arg, argindex);
-                  argindex++;
+                  int c = fetch_string_char_advance_no_check (arg, &i, &byte);
+                  *dst++ = make_fixnum (c);
                 }
-              XSETFASTINT (elt, c);
-            }
-          else if (BOOL_VECTOR_P (arg))
-            {
-              elt = bool_vector_ref (arg, argindex);
-              argindex++;
-            }
-          else
-            {
-              elt = AREF (arg, argindex);
-              argindex++;
-            }
-
-          /* Store this element into the result.  */
-          if (toindex < 0)
-            {
-              XSETCAR (tail, elt);
-              prev = tail;
-              tail = XCDR (tail);
             }
           else
-            {
-              ASET (result, toindex, elt);
-              toindex++;
-            }
+            for (ptrdiff_t i = 0; i < size; i++)
+              *dst++ = make_fixnum (SREF (arg, i));
+        }
+      else if (BOOL_VECTOR_P (arg))
+        {
+          ptrdiff_t size = bool_vector_size (arg);
+          for (ptrdiff_t i = 0; i < size; i++)
+            *dst++ = bool_vector_ref (arg, i);
+        }
+      else
+        {
+          eassert (COMPILEDP (arg));
+          ptrdiff_t size = PVSIZE (arg);
+          memcpy (dst, XVECTOR (arg)->contents, size * sizeof *dst);
+          dst += size;
         }
     }
-  if (!NILP (prev))
-    XSETCDR (prev, last_tail);
+  eassert (dst == XVECTOR (result)->contents + result_len);
 
   return result;
 }