>From eb83344fc7c08ec08b51e7700f1ac2632afa462c Mon Sep 17 00:00:00 2001
From: Paul Eggert <address@hidden>
Date: Mon, 20 Aug 2018 15:52:29 -0700
Subject: [PATCH] Speed up (nthcdr N L) when L is circular

Also, fix bug when N is a positive bignum, a problem reported
by Eli Zaretskii and Pip Cet in:
https://lists.gnu.org/r/emacs-devel/2018-08/msg00690.html
* src/fns.c (Fnthcdr): If a cycle is found, reduce the count
modulo the cycle length before continuing.  This reduces the
worst-case cost of (nthcdr N L) from N to min(N, C) where C is
the number of distinct cdrs of L.  Reducing modulo the cycle
length also allows us to do arithmetic with machine words
instead of with GMP.
* test/src/fns-tests.el (test-nthcdr-circular): New test.
---
 src/fns.c             | 58 ++++++++++++++++++++++++++++++++++++++-----
 test/src/fns-tests.el | 16 ++++++++++++
 2 files changed, 68 insertions(+), 6 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index aeb9308d22..8cff6b1b6c 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1403,7 +1403,12 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
   (Lisp_Object n, Lisp_Object list)
 {
   CHECK_INTEGER (n);
-  Lisp_Object tail = list;
+
+  /* A huge but in-range EMACS_INT that can be substituted for a
+     positive bignum while counting down.  It does not introduce
+     miscounts because a list or cycle cannot possibly be this long,
+     and any counting error is fixed up later.  */
+  EMACS_INT large_num = EMACS_INT_MAX;
 
   EMACS_INT num;
   if (FIXNUMP (n))
@@ -1412,16 +1417,57 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
     {
       num = mpz_sgn (XBIGNUM (n)->value);
       if (0 < num)
-	num = EMACS_INT_MAX;  /* LIST cannot possibly be this long.  */
+	num = large_num;
     }
 
-  for (; 0 < num; num--)
+  EMACS_INT tortoise_num = num;
+  Lisp_Object tail = list, saved_tail = tail;
+  FOR_EACH_TAIL_SAFE (tail)
     {
-      if (! CONSP (tail))
+      if (num <= 0)
+	return tail;
+      if (tail == li.tortoise)
+	tortoise_num = num;
+      saved_tail = XCDR (tail);
+      num--;
+      rarely_quit (num);
+    }
+
+  tail = saved_tail;
+  if (! CONSP (tail))
+    {
+      CHECK_LIST_END (tail, list);
+      return Qnil;
+    }
+
+  /* TAIL is part of a cycle.  Reduce NUM modulo the cycle length to
+     avoid going around this cycle repeatedly.  */
+  intptr_t cycle_length = tortoise_num - num;
+  if (! FIXNUMP (n))
+    {
+      /* Undo any error introduced when LARGE_NUM was substituted for
+	 N, by adding N - LARGE_NUM to NUM, using arithmetic modulo
+	 CYCLE_LENGTH.  */
+      mpz_t z; /* N mod CYCLE_LENGTH.  */
+      mpz_init (z);
+      if (cycle_length <= ULONG_MAX)
+	num += mpz_mod_ui (z, XBIGNUM (n)->value, cycle_length);
+      else
 	{
-	  CHECK_LIST_END (tail, list);
-	  return Qnil;
+	  mpz_set_intmax (z, cycle_length);
+	  mpz_mod (z, XBIGNUM (n)->value, z);
+	  intptr_t iz;
+	  mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, z);
+	  num += iz;
 	}
+      mpz_clear (z);
+      num += cycle_length - large_num % cycle_length;
+    }
+  num %= cycle_length;
+
+  /* One last time through the cycle.  */
+  for (; 0 < num; num--)
+    {
       tail = XCDR (tail);
       rarely_quit (num);
     }
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index f722ed6333..92dc18fa03 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -624,4 +624,20 @@ dot2
         (should (eq (gethash b2 hash)
                     (funcall test b1 b2)))))))
 
+(ert-deftest test-nthcdr-circular ()
+  (dolist (len '(1 2 5 37 120 997 1024))
+    (let ((cycle (make-list len nil)))
+      (setcdr (last cycle) cycle)
+      (dolist (n (list (1- most-negative-fixnum) most-negative-fixnum
+                       -1 0 1
+                       (1- len) len (1+ len)
+                       most-positive-fixnum (1+ most-positive-fixnum)
+                       (* 2 most-positive-fixnum)
+                       (* most-positive-fixnum most-positive-fixnum)
+                       (ash 1 12345)))
+        (let ((a (nthcdr n cycle))
+              (b (if (<= n 0) cycle (nthcdr (mod n len) cycle))))
+          (should (equal (list (eq a b) n len)
+                         (list t n len))))))))
+
 (provide 'fns-tests)
-- 
2.17.1