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.

diff --git a/src/fns.c b/src/fns.c
index f30b2f6fb3c672ccefba920dddca00fccbd51cb7..f4ba67b40e7179dcd07f34ef217eaf86ebc5beef 100644 (file)
--- 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 */
 }
 \f
-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;
 }