bug#69709: `sort` interface improvement and universal ordering predicate

[Aris Spathis <agspathis@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1170 bytes --]

Thank you for your excellent work on `sort` and related functionality!

Unfortunately, the new `sort` implementation occasionally crashes with a
segfault. The following code reproduces that in current master:

(dotimes (i 500)
  (sort (make-list 128 42)
        :key (lambda (n) (make-list i n))))

It happens for inputs of length >= `MERGESTATE_TEMP_SIZE / 2` (= 128
currently) along with a non-NIL `:key` function. In such cases, a
`Lisp_Object` array is explicitly heap-allocated to store the keys, which is
never marked against GC. This would not be a problem if not for the fact
that
the `:key` function call may trigger GC.

I'm attaching a patch with a proposed solution, consisting of three changes:

1. Allocate with `xzalloc` to have the new array initialized to `Qnil`. This
   ensures its objects can be marked properly.

2. Mark `ms->allocated_keys` in `merge_markmem`. We don't need to check that
   `ms->allocated_keys != NULL`, as `merge_register_cleanup` is only called
   under this exact condition.

3. Move the computation of keys (which may trigger a GC) after `merge_init`,
   which registers `merge_markmem`.

I hope this is useful.

Cheers,
Aris

[-- Attachment #1.2: Type: text/html, Size: 1327 bytes --]

[-- Attachment #2: sort-segfault-fix.patch --]
[-- Type: text/x-patch, Size: 1664 bytes --]

diff --git a/src/sort.c b/src/sort.c
index 527d5550342..562f88ede3c 100644
--- a/src/sort.c
+++ b/src/sort.c
@@ -532,6 +532,8 @@ merge_markmem (void *arg)
   merge_state *ms = arg;
   eassume (ms != NULL);
 
+  mark_objects (ms->allocated_keys, ms->listlen);
+
   if (ms->reloc.size != NULL && *ms->reloc.size > 0)
     {
       Lisp_Object *src = (ms->reloc.src->values
@@ -1107,21 +1109,29 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
       if (length < MERGESTATE_TEMP_SIZE / 2)
 	keys = &ms.temparray[length + 1];
       else
-	keys = allocated_keys = xmalloc (length * word_size);
-
-      for (ptrdiff_t i = 0; i < length; i++)
-	keys[i] = call1 (keyfunc, seq[i]);
+	{
+	  /* Allocate with xzalloc to obtain an array of valid
+	     Lisp_Objects (Qnils), so that they can be marked. */
+	  verify (NIL_IS_ZERO);
+	  keys = allocated_keys = xzalloc (length * word_size);
+	}
 
       lo.keys = keys;
       lo.values = seq;
     }
 
+  merge_init (&ms, length, allocated_keys, &lo, predicate);
+
+  /* Compute keys after merge_markmem has been registered by merge_init
+     (any call to keyfunc might trigger a GC). */
+  if (!NILP (keyfunc))
+    for (ptrdiff_t i = 0; i < length; i++)
+      keys[i] = call1 (keyfunc, seq[i]);
+
   /* FIXME: This is where we would check the keys for interesting
      properties for more optimised comparison (such as all being fixnums
      etc).  */
 
-  merge_init (&ms, length, allocated_keys, &lo, predicate);
-
   /* March over the array once, left to right, finding natural runs,
      and extending short natural runs to minrun elements.  */
   const ptrdiff_t minrun = merge_compute_minrun (length);