+/* Using PRED to compare, return whether A and B are in order.
+ Compare stably when A appeared before B in the input. */
+static bool
+inorder (Lisp_Object pred, Lisp_Object a, Lisp_Object b)
+{
+ return NILP (call2 (pred, b, a));
+}
+
+/* Using PRED to compare, merge from ALEN-length A and BLEN-length B
+ into DEST. Argument arrays must be nonempty and must not overlap,
+ except that B might be the last part of DEST. */
+static void
+merge_vectors (Lisp_Object pred,
+ ptrdiff_t alen, Lisp_Object const a[restrict VLA_ELEMS (alen)],
+ ptrdiff_t blen, Lisp_Object const b[VLA_ELEMS (blen)],
+ Lisp_Object dest[VLA_ELEMS (alen + blen)])
+{
+ eassume (0 < alen && 0 < blen);
+ Lisp_Object const *alim = a + alen;
+ Lisp_Object const *blim = b + blen;
+
+ while (true)
+ {
+ if (inorder (pred, a[0], b[0]))
+ {
+ *dest++ = *a++;
+ if (a == alim)
+ {
+ if (dest != b)
+ memcpy (dest, b, (blim - b) * sizeof *dest);
+ return;
+ }
+ }
+ else
+ {
+ *dest++ = *b++;
+ if (b == blim)
+ {
+ memcpy (dest, a, (alim - a) * sizeof *dest);
+ return;
+ }
+ }
+ }
+}
+
+/* Using PRED to compare, sort LEN-length VEC in place, using TMP for
+ temporary storage. LEN must be at least 2. */
+static void
+sort_vector_inplace (Lisp_Object pred, ptrdiff_t len,
+ Lisp_Object vec[restrict VLA_ELEMS (len)],
+ Lisp_Object tmp[restrict VLA_ELEMS (len >> 1)])
+{
+ eassume (2 <= len);
+ ptrdiff_t halflen = len >> 1;
+ sort_vector_copy (pred, halflen, vec, tmp);
+ if (1 < len - halflen)
+ sort_vector_inplace (pred, len - halflen, vec + halflen, vec);
+ merge_vectors (pred, halflen, tmp, len - halflen, vec + halflen, vec);
+}
+
+/* Using PRED to compare, sort from LEN-length SRC into DST.
+ Len must be positive. */
+static void
+sort_vector_copy (Lisp_Object pred, ptrdiff_t len,
+ Lisp_Object src[restrict VLA_ELEMS (len)],
+ Lisp_Object dest[restrict VLA_ELEMS (len)])
+{
+ eassume (0 < len);
+ ptrdiff_t halflen = len >> 1;
+ if (halflen < 1)
+ dest[0] = src[0];
+ else
+ {
+ if (1 < halflen)
+ sort_vector_inplace (pred, halflen, src, dest);
+ if (1 < len - halflen)
+ sort_vector_inplace (pred, len - halflen, src + halflen, dest);
+ merge_vectors (pred, halflen, src, len - halflen, src + halflen, dest);
+ }
+}
+
+/* Sort VECTOR in place using PREDICATE, preserving original order of
+ elements considered as equal. */
+
+static void
+sort_vector (Lisp_Object vector, Lisp_Object predicate)
+{
+ ptrdiff_t len = ASIZE (vector);
+ if (len < 2)
+ return;
+ ptrdiff_t halflen = len >> 1;
+ Lisp_Object *tmp;
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (vector, predicate);
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA_LISP (tmp, halflen);
+ for (ptrdiff_t i = 0; i < halflen; i++)
+ tmp[i] = make_number (0);
+ sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp);
+ SAFE_FREE ();
+ UNGCPRO;
+}
+
+DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
+ doc: /* Sort SEQ, stably, comparing elements using PREDICATE.
+Returns the sorted sequence. SEQ should be a list or vector. SEQ is
+modified by side effects. PREDICATE is called with two elements of
+SEQ, and should return non-nil if the first element should sort before
+the second. */)
+ (Lisp_Object seq, Lisp_Object predicate)
+{
+ if (CONSP (seq))
+ seq = sort_list (seq, predicate);
+ else if (VECTORP (seq))
+ sort_vector (seq, predicate);
+ else if (!NILP (seq))
+ wrong_type_argument (Qsequencep, seq);
+ return seq;
+}
+