From 14dd9101ec4838f75addf25bf6b06ef33f8a7e97 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 5 Feb 2017 13:25:37 -0800 Subject: [PATCH] =?utf8?q?Signal=20list=20cycles=20in=20=E2=80=98length?= =?utf8?q?=E2=80=99=20etc.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Use macros like FOR_EACH_TAIL instead of maybe_quit to catch list cycles automatically instead of relying on the user becoming impatient and typing C-g (Bug#25606). * src/fns.c (Flength, Fmember, Fmemq, Fmemql, Fassq, Fassoc, Frassq) (Frassoc, Fdelete, Freverse): Use FOR_EACH_TAIL instead of maybe_quit. (Fnreverse): Use simple EQ to check for circular list instead of rarely_quit, as this suffices in this unusual case. (Fplist_put, Flax_plist_put, Flax_plist_put): Use FOR_EACH_TAIL_CONS instead of maybe_quit. (internal_equal): Use FOR_EACH_TAIL_CONS to check lists, instead of by-hand tail recursion that did not catch cycles. * src/fns.c (Fsafe_length, Fplist_get): * src/xdisp.c (display_mode_element): Use FOR_EACH_TAIL_SAFE instead of by-hand Floyd’s algorithm. * src/lisp.h (QUIT_COUNT_HEURISTIC): Remove; no longer needed. (rarely_quit): Simply count toward USHRT_MAX + 1, since the fancier versions are no longer needed. (FOR_EACH_TAIL_CONS, FOR_EACH_TAIL_SAFE) (FOR_EACH_TAIL_INTERNAL): New macros, the last with definiens mostly taken from FOR_EACH_TAIL. (FOR_EACH_TAIL): Rewrite in terms of FOR_EACH_TAIL_INTERNAL. --- etc/NEWS | 3 + src/fns.c | 290 +++++++++++++++++++++++------------------------------------- src/lisp.h | 35 +++++--- src/xdisp.c | 37 +++----- 4 files changed, 149 insertions(+), 216 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index cbf2b70c821..4d8ae091a7c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -900,6 +900,9 @@ collection). ** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. The incumbent 'if-let' and 'when-let' are now aliases. +** Low-level list functions like 'length' and 'member' now do a better +job of signaling list cycles instead of looping indefinitely. + +++ ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' can be used for creation of temporary files of remote or mounted directories. diff --git a/src/fns.c b/src/fns.c index 4de74a5967f..b5508fb56ab 100644 --- a/src/fns.c +++ b/src/fns.c @@ -108,23 +108,11 @@ To get the number of bytes, use `string-bytes'. */) XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); else if (CONSP (sequence)) { - EMACS_INT i = 0; - - do - { - ++i; - if ((i & (QUIT_COUNT_HEURISTIC - 1)) == 0) - { - if (MOST_POSITIVE_FIXNUM < i) - error ("List too long"); - maybe_quit (); - } - sequence = XCDR (sequence); - } - while (CONSP (sequence)); - - CHECK_LIST_END (sequence, sequence); - + intptr_t i = 0; + FOR_EACH_TAIL (sequence) + i++; + if (MOST_POSITIVE_FIXNUM < i) + error ("List too long"); val = make_number (i); } else if (NILP (sequence)) @@ -142,38 +130,10 @@ 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; - double hilen = 0; - uintmax_t lolen = 1; - - if (! CONSP (list)) - return make_number (0); - - /* halftail is used to detect circular lists. */ - for (tail = halftail = list; ; ) - { - tail = XCDR (tail); - if (! CONSP (tail)) - break; - if (EQ (tail, halftail)) - break; - lolen++; - if ((lolen & 1) == 0) - { - halftail = XCDR (halftail); - if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0) - { - maybe_quit (); - if (lolen == 0) - hilen += UINTMAX_MAX + 1.0; - } - } - } - - /* 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); + intptr_t len = 0; + FOR_EACH_TAIL_SAFE (list) + len++; + return make_fixnum_or_float (len); } DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, @@ -1383,15 +1343,9 @@ DEFUN ("member", Fmember, Smember, 2, 2, 0, The value is actually the tail of LIST whose car is ELT. */) (Lisp_Object elt, Lisp_Object list) { - unsigned short int quit_count = 0; - Lisp_Object tail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - if (! NILP (Fequal (elt, XCAR (tail)))) - return tail; - rarely_quit (++quit_count); - } - CHECK_LIST_END (tail, list); + FOR_EACH_TAIL (list) + if (! NILP (Fequal (elt, XCAR (li.tail)))) + return li.tail; return Qnil; } @@ -1400,15 +1354,9 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, The value is actually the tail of LIST whose car is ELT. */) (Lisp_Object elt, Lisp_Object list) { - unsigned short int quit_count = 0; - Lisp_Object tail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - if (EQ (XCAR (tail), elt)) - return tail; - rarely_quit (++quit_count); - } - CHECK_LIST_END (tail, list); + FOR_EACH_TAIL (list) + if (EQ (XCAR (li.tail), elt)) + return li.tail; return Qnil; } @@ -1420,16 +1368,12 @@ The value is actually the tail of LIST whose car is ELT. */) if (!FLOATP (elt)) return Fmemq (elt, list); - unsigned short int quit_count = 0; - Lisp_Object tail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) + FOR_EACH_TAIL (list) { - Lisp_Object tem = XCAR (tail); + Lisp_Object tem = XCAR (li.tail); if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) - return tail; - rarely_quit (++quit_count); + return li.tail; } - CHECK_LIST_END (tail, list); return Qnil; } @@ -1439,15 +1383,9 @@ The value is actually the first element of LIST whose car is KEY. Elements of LIST that are not conses are ignored. */) (Lisp_Object key, Lisp_Object list) { - unsigned short int quit_count = 0; - Lisp_Object tail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) - return XCAR (tail); - rarely_quit (++quit_count); - } - CHECK_LIST_END (tail, list); + FOR_EACH_TAIL (list) + if (CONSP (XCAR (li.tail)) && EQ (XCAR (XCAR (li.tail)), key)) + return XCAR (li.tail); return Qnil; } @@ -1468,17 +1406,13 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, The value is actually the first element of LIST whose car equals KEY. */) (Lisp_Object key, Lisp_Object list) { - unsigned short int quit_count = 0; - Lisp_Object tail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) + FOR_EACH_TAIL (list) { - Lisp_Object car = XCAR (tail); + Lisp_Object car = XCAR (li.tail); if (CONSP (car) && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) return car; - rarely_quit (++quit_count); } - CHECK_LIST_END (tail, list); return Qnil; } @@ -1503,15 +1437,9 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, The value is actually the first element of LIST whose cdr is KEY. */) (Lisp_Object key, Lisp_Object list) { - unsigned short int quit_count = 0; - Lisp_Object tail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) - return XCAR (tail); - rarely_quit (++quit_count); - } - CHECK_LIST_END (tail, list); + FOR_EACH_TAIL (list) + if (CONSP (XCAR (li.tail)) && EQ (XCDR (XCAR (li.tail)), key)) + return XCAR (li.tail); return Qnil; } @@ -1520,17 +1448,13 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, The value is actually the first element of LIST whose cdr equals KEY. */) (Lisp_Object key, Lisp_Object list) { - unsigned short int quit_count = 0; - Lisp_Object tail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) + FOR_EACH_TAIL (list) { - Lisp_Object car = XCAR (tail); + Lisp_Object car = XCAR (li.tail); if (CONSP (car) && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) return car; - rarely_quit (++quit_count); } - CHECK_LIST_END (tail, list); return Qnil; } @@ -1668,23 +1592,20 @@ changing the value of a sequence `foo'. */) } else { - unsigned short int quit_count = 0; - Lisp_Object tail, prev; + Lisp_Object prev = Qnil; - for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail)) + FOR_EACH_TAIL (seq) { - if (!NILP (Fequal (elt, XCAR (tail)))) + if (!NILP (Fequal (elt, (XCAR (li.tail))))) { if (NILP (prev)) - seq = XCDR (tail); + seq = XCDR (li.tail); else - Fsetcdr (prev, XCDR (tail)); + Fsetcdr (prev, XCDR (li.tail)); } else - prev = tail; - rarely_quit (++quit_count); + prev = li.tail; } - CHECK_LIST_END (tail, seq); } return seq; @@ -1702,15 +1623,17 @@ This function may destructively modify SEQ to produce the value. */) return Freverse (seq); else if (CONSP (seq)) { - unsigned short int quit_count = 0; Lisp_Object prev, tail, next; for (prev = Qnil, tail = seq; CONSP (tail); tail = next) { next = XCDR (tail); + /* If SEQ contains a cycle, attempting to reverse it + in-place will inevitably come back to SEQ. */ + if (EQ (next, seq)) + circular_list (seq); Fsetcdr (tail, prev); prev = tail; - rarely_quit (++quit_count); } CHECK_LIST_END (tail, seq); seq = prev; @@ -1753,13 +1676,9 @@ See also the function `nreverse', which is used more often. */) return Qnil; else if (CONSP (seq)) { - unsigned short int quit_count = 0; - for (new = Qnil; CONSP (seq); seq = XCDR (seq)) - { - new = Fcons (XCAR (seq), new); - rarely_quit (++quit_count); - } - CHECK_LIST_END (seq, seq); + new = Qnil; + FOR_EACH_TAIL (seq) + new = Fcons (XCAR (li.tail), new); } else if (VECTORP (seq)) { @@ -2011,18 +1930,14 @@ corresponding to the given PROP, or nil if PROP is not one of the properties on the list. This function never signals an error. */) (Lisp_Object plist, Lisp_Object prop) { - Lisp_Object tail, halftail; - - /* halftail is used to detect circular lists. */ - tail = halftail = plist; - while (CONSP (tail) && CONSP (XCDR (tail))) + FOR_EACH_TAIL_SAFE (plist) { - if (EQ (prop, XCAR (tail))) - return XCAR (XCDR (tail)); - - tail = XCDR (XCDR (tail)); - halftail = XCDR (halftail); - if (EQ (tail, halftail)) + if (! CONSP (XCDR (li.tail))) + break; + if (EQ (prop, XCAR (li.tail))) + return XCAR (XCDR (li.tail)); + li.tail = XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) break; } @@ -2048,19 +1963,22 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. */) (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) { - unsigned short int quit_count = 0; Lisp_Object prev = Qnil; - for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); - tail = XCDR (XCDR (tail))) + FOR_EACH_TAIL_CONS (plist) { - if (EQ (prop, XCAR (tail))) + if (! CONSP (XCDR (li.tail))) + break; + + if (EQ (prop, XCAR (li.tail))) { - Fsetcar (XCDR (tail), val); + Fsetcar (XCDR (li.tail), val); return plist; } - prev = tail; - rarely_quit (++quit_count); + prev = li.tail; + li.tail = XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } Lisp_Object newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); @@ -2089,20 +2007,16 @@ corresponding to the given PROP, or nil if PROP is not one of the properties on the list. */) (Lisp_Object plist, Lisp_Object prop) { - unsigned short int quit_count = 0; - Lisp_Object tail; - - for (tail = plist; - CONSP (tail) && CONSP (XCDR (tail)); - tail = XCDR (XCDR (tail))) + FOR_EACH_TAIL_CONS (plist) { - if (! NILP (Fequal (prop, XCAR (tail)))) - return XCAR (XCDR (tail)); - rarely_quit (++quit_count); + if (! CONSP (XCDR (li.tail))) + break; + if (! NILP (Fequal (prop, XCAR (li.tail)))) + return XCAR (XCDR (li.tail)); + li.tail = XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } - - CHECK_LIST_END (tail, prop); - return Qnil; } @@ -2116,19 +2030,22 @@ use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. The PLIST is modified by side effects. */) (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) { - unsigned short int quit_count = 0; Lisp_Object prev = Qnil; - for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); - tail = XCDR (XCDR (tail))) + FOR_EACH_TAIL_CONS (plist) { - if (! NILP (Fequal (prop, XCAR (tail)))) + if (! CONSP (XCDR (li.tail))) + break; + + if (! NILP (Fequal (prop, XCAR (li.tail)))) { - Fsetcar (XCDR (tail), val); + Fsetcar (XCDR (li.tail), val); return plist; } - prev = tail; - rarely_quit (++quit_count); + prev = li.tail; + li.tail = XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } Lisp_Object newcell = list2 (prop, val); if (NILP (prev)) @@ -2206,9 +2123,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, } } - unsigned short int quit_count = 0; tail_recurse: - rarely_quit (++quit_count); if (EQ (o1, o2)) return 1; if (XTYPE (o1) != XTYPE (o2)) @@ -2228,12 +2143,24 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, } case Lisp_Cons: - if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht)) - return 0; - o1 = XCDR (o1); - o2 = XCDR (o2); - /* FIXME: This inf-loops in a circular list! */ - goto tail_recurse; + { + Lisp_Object tail1 = o1; + FOR_EACH_TAIL_CONS (o1) + { + if (! CONSP (o2)) + return false; + if (! internal_equal (XCAR (li.tail), XCAR (o2), depth + 1, + props, ht)) + return false; + tail1 = XCDR (li.tail); + o2 = XCDR (o2); + if (EQ (tail1, o2)) + return true; + } + o1 = tail1; + depth++; + goto tail_recurse; + } case Lisp_Misc: if (XMISCTYPE (o1) != XMISCTYPE (o2)) @@ -2247,6 +2174,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props, return 0; o1 = XOVERLAY (o1)->plist; o2 = XOVERLAY (o2)->plist; + depth++; goto tail_recurse; } if (MARKERP (o1)) @@ -2397,7 +2325,6 @@ Only the last argument is not altered, and need not be a list. usage: (nconc &rest LISTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - unsigned short int quit_count = 0; Lisp_Object val = Qnil; for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) @@ -2413,13 +2340,8 @@ usage: (nconc &rest LISTS) */) CHECK_CONS (tem); Lisp_Object tail; - do - { - tail = tem; - tem = XCDR (tail); - rarely_quit (++quit_count); - } - while (CONSP (tem)); + FOR_EACH_TAIL_CONS (tem) + tail = li.tail; tem = args[argnum + 1]; Fsetcdr (tail, tem); @@ -2841,14 +2763,20 @@ property and a property with the value nil. The value is actually the tail of PLIST whose car is PROP. */) (Lisp_Object plist, Lisp_Object prop) { - unsigned short int quit_count = 0; - while (CONSP (plist) && !EQ (XCAR (plist), prop)) + FOR_EACH_TAIL (plist) { - plist = XCDR (plist); - plist = CDR (plist); - rarely_quit (++quit_count); + if (EQ (XCAR (li.tail), prop)) + return li.tail; + if (!CONSP (XCDR (li.tail))) + { + CHECK_LIST_END (XCDR (li.tail), plist); + return Qnil; + } + li.tail = XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } - return plist; + return Qnil; } DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, diff --git a/src/lisp.h b/src/lisp.h index 102e8bd70ef..13fca0b29e0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3129,20 +3129,14 @@ extern void maybe_quit (void); #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) -/* 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. It - is nice but not necessary for it to equal USHRT_MAX + 1. */ - -enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; - /* Process a quit rarely, based on a counter COUNT, for efficiency. - "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 - times, whichever is smaller (somewhat arbitrary, but often faster). */ + "Rarely" means once per USHRT_MAX + 1 times; this is somewhat + arbitrary, but efficient. */ INLINE void rarely_quit (unsigned short int count) { - if (! (count & (QUIT_COUNT_HEURISTIC - 1))) + if (! count) maybe_quit (); } @@ -4598,13 +4592,32 @@ enum http://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf */ #define FOR_EACH_TAIL(list) \ + FOR_EACH_TAIL_INTERNAL (list, CHECK_LIST_END (li.tail, list), \ + circular_list (list)) + +/* Like FOR_EACH_TAIL (LIST), except check only for cycles. */ + +#define FOR_EACH_TAIL_CONS(list) \ + FOR_EACH_TAIL_INTERNAL (list, (void) 0, circular_list (list)) + +/* Like FOR_EACH_TAIL (LIST), except check for neither dotted lists + nor cycles. */ + +#define FOR_EACH_TAIL_SAFE(list) \ + FOR_EACH_TAIL_INTERNAL (list, (void) 0, (void) (li.tail = Qnil)) + +/* Like FOR_EACH_TAIL (LIST), except evaluate DOTTED or CYCLE, + respectively, if a dotted list or cycle is found. This is an + internal macro intended for use only by the above macros. */ + +#define FOR_EACH_TAIL_INTERNAL(list, dotted, cycle) \ for (struct { Lisp_Object tail, tortoise; intptr_t n, max; } li \ = { list, list, 2, 2 }; \ - CONSP (li.tail) || (CHECK_LIST_END (li.tail, list), false); \ + CONSP (li.tail) || (dotted, false); \ (li.tail = XCDR (li.tail), \ (li.n-- == 0 \ ? (void) (li.n = li.max <<= 1, li.tortoise = li.tail) \ - : EQ (li.tail, li.tortoise) ? circular_list (list) : (void) 0))) + : EQ (li.tail, li.tortoise) ? (cycle) : (void) 0))) /* Do a `for' loop over alist values. */ diff --git a/src/xdisp.c b/src/xdisp.c index 0e329dfe6e9..5e1207f29e3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -23033,30 +23033,19 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, goto tail_recurse; } else if (STRINGP (car) || CONSP (car)) - { - Lisp_Object halftail = elt; - int len = 0; - - while (CONSP (elt) - && (precision <= 0 || n < precision)) - { - n += display_mode_element (it, depth, - /* Do padding only after the last - element in the list. */ - (! CONSP (XCDR (elt)) - ? field_width - n - : 0), - precision - n, XCAR (elt), - props, risky); - elt = XCDR (elt); - len++; - if ((len & 1) == 0) - halftail = XCDR (halftail); - /* Check for cycle. */ - if (EQ (halftail, elt)) - break; - } - } + FOR_EACH_TAIL_SAFE (elt) + { + if (0 < precision && precision <= n) + break; + n += display_mode_element (it, depth, + /* Pad after only the last + list element. */ + (! CONSP (XCDR (li.tail)) + ? field_width - n + : 0), + precision - n, XCAR (li.tail), + props, risky); + } } break; -- 2.11.4.GIT