* fns.c: Don't overflow int when computing a list length.

(Fsafe_length): Return a float if the value is not representable
as a fixnum.  This shouldn't happen except in contrived situations.
Use same QUIT_COUNT_HEURISTIC as Flength now does.

diff --git a/src/ChangeLog b/src/ChangeLog
index 5d70c56cc5cc26f5b76c4f255c3e2a3ea64793a5..3c690a5cae071f9f11b08cd5139ecba016f1cc8c 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,10 +1,14 @@
 2011-06-14  Paul Eggert  <eggert@cs.ucla.edu>
 
-       * fns.c (Flength): Don't overflow int when computing a list length.
-       Use EMACS_INT, not int, to avoid unwanted truncation on 64-bit hosts.
-       Check for QUIT every 1024 entries rather than every other entry;
-       that's faster and is responsive enough.  Report an error instead of
-       overflowing an integer.
+       * fns.c: Don't overflow int when computing a list length.
+       * fns.c (QUIT_COUNT_HEURISTIC): New constant.
+       (Flength, Fsafe_length): Use EMACS_INT, not int, to avoid unwanted
+       truncation on 64-bit hosts.  Check for QUIT every
+       QUIT_COUNT_HEURISTIC entries rather than every other entry; that's
+       faster and is responsive enough.
+       (Flength): Report an error instead of overflowing an integer.
+       (Fsafe_length): Return a float if the value is not representable
+       as a fixnum.  This shouldn't happen except in contrived situations.
 
        * alloc.c: Check that resized vectors' lengths fit in fixnums.
        (header_size, word_size): New constants.

diff --git a/src/fns.c b/src/fns.c
index 7d5d1bd5d997f92ce1cd5fd5ae6b4369445bdf02..10af162cfc46bc33935fd0747864cc0f6e3d2cde 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -99,6 +99,10 @@ Other values of LIMIT are ignored.  */)
   return lispy_val;
 }
 \f
+/* Heuristic on how many iterations of a tight loop can be safely done
+   before it's time to do a QUIT.  This must be a power of 2.  */
+enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
+
 /* Random data-structure functions */
 
 DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -128,7 +132,7 @@ To get the number of bytes, use `string-bytes'.  */)
       do
        {
          ++i;
-         if ((i & ((1 << 10) - 1)) == 0)
+         if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0)
            {
              if (MOST_POSITIVE_FIXNUM < i)
                error ("List too long");
@@ -159,22 +163,38 @@ it returns 0.  If LIST is circular, it returns a finite value
 which is at least the number of distinct elements.  */)
   (Lisp_Object list)
 {
-  Lisp_Object tail, halftail, length;
-  int len = 0;
+  Lisp_Object tail, halftail;
+  double hilen = 0;
+  uintmax_t lolen = 1;
+
+  if (! CONSP (list))
+    return 0;
 
   /* halftail is used to detect circular lists.  */
-  halftail = list;
-  for (tail = list; CONSP (tail); tail = XCDR (tail))
+  for (tail = halftail = list; ; )
     {
-      if (EQ (tail, halftail) && len != 0)
+      tail = XCDR (tail);
+      if (! CONSP (tail))
        break;
-      len++;
-      if ((len & 1) == 0)
-       halftail = XCDR (halftail);
+      if (EQ (tail, halftail))
+       break;
+      lolen++;
+      if ((lolen & 1) == 0)
+       {
+         halftail = XCDR (halftail);
+         if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
+           {
+             QUIT;
+             if (lolen == 0)
+               hilen += UINTMAX_MAX + 1.0;
+           }
+       }
     }
 
-  XSETINT (length, len);
-  return length;
+  /* If the length does not fit into a fixnum, return a float.
+     On all known practical machines this returns an upper bound on
+     the true length.  */
+  return hilen ? make_float (hilen + lolen) : make_fixnum_or_float (lolen);
 }
 
 DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,