summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog14
-rw-r--r--src/fns.c42
2 files changed, 40 insertions, 16 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 5d70c56cc5c..3c690a5cae0 100644
--- 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 7d5d1bd5d99..10af162cfc4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -99,6 +99,10 @@ Other values of LIMIT are ignored. */)
return lispy_val;
}
+/* 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,