From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.bugs Subject: bug#25606: [DRAFT PATCH 2/2] Signal list cycles in =?UTF-8?Q?=E2=80=98length=E2=80=99?= etc. Date: Wed, 1 Feb 2017 15:56:22 -0800 Message-ID: <20170201235622.30836-2-eggert@cs.ucla.edu> References: <20170201235622.30836-1-eggert@cs.ucla.edu> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable X-Trace: blaine.gmane.org 1485993457 15723 195.159.176.226 (1 Feb 2017 23:57:37 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 1 Feb 2017 23:57:37 +0000 (UTC) Cc: Paul Eggert To: 25606@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Feb 02 00:57:31 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cZ4mI-0003tX-66 for geb-bug-gnu-emacs@m.gmane.org; Thu, 02 Feb 2017 00:57:30 +0100 Original-Received: from localhost ([::1]:53583 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cZ4mN-0001OW-QB for geb-bug-gnu-emacs@m.gmane.org; Wed, 01 Feb 2017 18:57:35 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:54830) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cZ4lu-000188-JR for bug-gnu-emacs@gnu.org; Wed, 01 Feb 2017 18:57:09 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cZ4lr-0007ud-Of for bug-gnu-emacs@gnu.org; Wed, 01 Feb 2017 18:57:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:55500) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cZ4lr-0007uW-L7 for bug-gnu-emacs@gnu.org; Wed, 01 Feb 2017 18:57:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cZ4lr-0007Vz-EY for bug-gnu-emacs@gnu.org; Wed, 01 Feb 2017 18:57:03 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Paul Eggert Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 01 Feb 2017 23:57:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 25606 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.148599341228854 (code B ref -1); Wed, 01 Feb 2017 23:57:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 1 Feb 2017 23:56:52 +0000 Original-Received: from localhost ([127.0.0.1]:53697 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cZ4lf-0007VJ-Gw for submit@debbugs.gnu.org; Wed, 01 Feb 2017 18:56:52 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:35468) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cZ4lb-0007Us-DH for submit@debbugs.gnu.org; Wed, 01 Feb 2017 18:56:48 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cZ4lU-0007mM-02 for submit@debbugs.gnu.org; Wed, 01 Feb 2017 18:56:42 -0500 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:51161) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cZ4lT-0007mE-Sg for submit@debbugs.gnu.org; Wed, 01 Feb 2017 18:56:39 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:54631) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cZ4lR-0000EM-0D for bug-gnu-emacs@gnu.org; Wed, 01 Feb 2017 18:56:39 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cZ4lO-0007jr-Fe for bug-gnu-emacs@gnu.org; Wed, 01 Feb 2017 18:56:37 -0500 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:48756) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cZ4lO-0007j9-1m for bug-gnu-emacs@gnu.org; Wed, 01 Feb 2017 18:56:34 -0500 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 0A9F716007E for ; Wed, 1 Feb 2017 15:56:33 -0800 (PST) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id OedU0LGLpn20; Wed, 1 Feb 2017 15:56:31 -0800 (PST) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 23D6216007A; Wed, 1 Feb 2017 15:56:31 -0800 (PST) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id BoS2Qto1nznb; Wed, 1 Feb 2017 15:56:31 -0800 (PST) Original-Received: from Penguin.CS.UCLA.EDU (Penguin.CS.UCLA.EDU [131.179.64.200]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id ECF32160061; Wed, 1 Feb 2017 15:56:30 -0800 (PST) X-Mailer: git-send-email 2.9.3 In-Reply-To: <20170201235622.30836-1-eggert@cs.ucla.edu> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:128877 Archived-At: 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. * 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=E2=80=99s 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 86a8385..23e5111 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -872,6 +872,9 @@ collection). +++ ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Eli= sp. =20 +** 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-directo= ry' can be used for creation of temporary files of remote or mounted directo= ries. diff --git a/src/fns.c b/src/fns.c index 4de74a5..b5508fb 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 =3D 0; - - do - { - ++i; - if ((i & (QUIT_COUNT_HEURISTIC - 1)) =3D=3D 0) - { - if (MOST_POSITIVE_FIXNUM < i) - error ("List too long"); - maybe_quit (); - } - sequence =3D XCDR (sequence); - } - while (CONSP (sequence)); - - CHECK_LIST_END (sequence, sequence); - + intptr_t i =3D 0; + FOR_EACH_TAIL (sequence) + i++; + if (MOST_POSITIVE_FIXNUM < i) + error ("List too long"); val =3D make_number (i); } else if (NILP (sequence)) @@ -142,38 +130,10 @@ it returns 0. If LIST is circular, it returns a fi= nite value which is at least the number of distinct elements. */) (Lisp_Object list) { - Lisp_Object tail, halftail; - double hilen =3D 0; - uintmax_t lolen =3D 1; - - if (! CONSP (list)) - return make_number (0); - - /* halftail is used to detect circular lists. */ - for (tail =3D halftail =3D list; ; ) - { - tail =3D XCDR (tail); - if (! CONSP (tail)) - break; - if (EQ (tail, halftail)) - break; - lolen++; - if ((lolen & 1) =3D=3D 0) - { - halftail =3D XCDR (halftail); - if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) =3D=3D 0) - { - maybe_quit (); - if (lolen =3D=3D 0) - hilen +=3D 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 (lole= n); + intptr_t len =3D 0; + FOR_EACH_TAIL_SAFE (list) + len++; + return make_fixnum_or_float (len); } =20 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 =3D 0; - Lisp_Object tail; - for (tail =3D list; CONSP (tail); tail =3D 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; } =20 @@ -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 =3D 0; - Lisp_Object tail; - for (tail =3D list; CONSP (tail); tail =3D 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; } =20 @@ -1420,16 +1368,12 @@ The value is actually the tail of LIST whose car = is ELT. */) if (!FLOATP (elt)) return Fmemq (elt, list); =20 - unsigned short int quit_count =3D 0; - Lisp_Object tail; - for (tail =3D list; CONSP (tail); tail =3D XCDR (tail)) + FOR_EACH_TAIL (list) { - Lisp_Object tem =3D XCAR (tail); + Lisp_Object tem =3D 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; } =20 @@ -1439,15 +1383,9 @@ The value is actually the first element of LIST wh= ose car is KEY. Elements of LIST that are not conses are ignored. */) (Lisp_Object key, Lisp_Object list) { - unsigned short int quit_count =3D 0; - Lisp_Object tail; - for (tail =3D list; CONSP (tail); tail =3D 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; } =20 @@ -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 =3D 0; - Lisp_Object tail; - for (tail =3D list; CONSP (tail); tail =3D XCDR (tail)) + FOR_EACH_TAIL (list) { - Lisp_Object car =3D XCAR (tail); + Lisp_Object car =3D 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; } =20 @@ -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 =3D 0; - Lisp_Object tail; - for (tail =3D list; CONSP (tail); tail =3D 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; } =20 @@ -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 =3D 0; - Lisp_Object tail; - for (tail =3D list; CONSP (tail); tail =3D XCDR (tail)) + FOR_EACH_TAIL (list) { - Lisp_Object car =3D XCAR (tail); + Lisp_Object car =3D 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; } =0C @@ -1668,23 +1592,20 @@ changing the value of a sequence `foo'. */) } else { - unsigned short int quit_count =3D 0; - Lisp_Object tail, prev; + Lisp_Object prev =3D Qnil; =20 - for (tail =3D seq, prev =3D Qnil; CONSP (tail); tail =3D XCDR (tai= l)) + FOR_EACH_TAIL (seq) { - if (!NILP (Fequal (elt, XCAR (tail)))) + if (!NILP (Fequal (elt, (XCAR (li.tail))))) { if (NILP (prev)) - seq =3D XCDR (tail); + seq =3D XCDR (li.tail); else - Fsetcdr (prev, XCDR (tail)); + Fsetcdr (prev, XCDR (li.tail)); } else - prev =3D tail; - rarely_quit (++quit_count); + prev =3D li.tail; } - CHECK_LIST_END (tail, seq); } =20 return seq; @@ -1702,15 +1623,17 @@ This function may destructively modify SEQ to pro= duce the value. */) return Freverse (seq); else if (CONSP (seq)) { - unsigned short int quit_count =3D 0; Lisp_Object prev, tail, next; =20 for (prev =3D Qnil, tail =3D seq; CONSP (tail); tail =3D next) { next =3D 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 =3D tail; - rarely_quit (++quit_count); } CHECK_LIST_END (tail, seq); seq =3D prev; @@ -1753,13 +1676,9 @@ See also the function `nreverse', which is used mo= re often. */) return Qnil; else if (CONSP (seq)) { - unsigned short int quit_count =3D 0; - for (new =3D Qnil; CONSP (seq); seq =3D XCDR (seq)) - { - new =3D Fcons (XCAR (seq), new); - rarely_quit (++quit_count); - } - CHECK_LIST_END (seq, seq); + new =3D Qnil; + FOR_EACH_TAIL (seq) + new =3D Fcons (XCAR (li.tail), new); } else if (VECTORP (seq)) { @@ -2011,18 +1930,14 @@ corresponding to the given PROP, or nil if PROP i= s 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 =3D halftail =3D plist; - while (CONSP (tail) && CONSP (XCDR (tail))) + FOR_EACH_TAIL_SAFE (plist) { - if (EQ (prop, XCAR (tail))) - return XCAR (XCDR (tail)); - - tail =3D XCDR (XCDR (tail)); - halftail =3D 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 =3D XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) break; } =20 @@ -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 =3D 0; Lisp_Object prev =3D Qnil; - for (Lisp_Object tail =3D plist; CONSP (tail) && CONSP (XCDR (tail)); - tail =3D 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; } =20 - prev =3D tail; - rarely_quit (++quit_count); + prev =3D li.tail; + li.tail =3D XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } Lisp_Object newcell =3D Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)= ))); @@ -2089,20 +2007,16 @@ corresponding to the given PROP, or nil if PROP i= s not one of the properties on the list. */) (Lisp_Object plist, Lisp_Object prop) { - unsigned short int quit_count =3D 0; - Lisp_Object tail; - - for (tail =3D plist; - CONSP (tail) && CONSP (XCDR (tail)); - tail =3D 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 =3D XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } - - CHECK_LIST_END (tail, prop); - return Qnil; } =20 @@ -2116,19 +2030,22 @@ use `(setq x (lax-plist-put x prop val))' to be s= ure 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 =3D 0; Lisp_Object prev =3D Qnil; - for (Lisp_Object tail =3D plist; CONSP (tail) && CONSP (XCDR (tail)); - tail =3D 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; } =20 - prev =3D tail; - rarely_quit (++quit_count); + prev =3D li.tail; + li.tail =3D XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } Lisp_Object newcell =3D list2 (prop, val); if (NILP (prev)) @@ -2206,9 +2123,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int= depth, bool props, } } =20 - unsigned short int quit_count =3D 0; tail_recurse: - rarely_quit (++quit_count); if (EQ (o1, o2)) return 1; if (XTYPE (o1) !=3D XTYPE (o2)) @@ -2228,12 +2143,24 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, i= nt depth, bool props, } =20 case Lisp_Cons: - if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1, props, ht)) - return 0; - o1 =3D XCDR (o1); - o2 =3D XCDR (o2); - /* FIXME: This inf-loops in a circular list! */ - goto tail_recurse; + { + Lisp_Object tail1 =3D 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 =3D XCDR (li.tail); + o2 =3D XCDR (o2); + if (EQ (tail1, o2)) + return true; + } + o1 =3D tail1; + depth++; + goto tail_recurse; + } =20 case Lisp_Misc: if (XMISCTYPE (o1) !=3D XMISCTYPE (o2)) @@ -2247,6 +2174,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int= depth, bool props, return 0; o1 =3D XOVERLAY (o1)->plist; o2 =3D 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 =3D 0; Lisp_Object val =3D Qnil; =20 for (ptrdiff_t argnum =3D 0; argnum < nargs; argnum++) @@ -2413,13 +2340,8 @@ usage: (nconc &rest LISTS) */) CHECK_CONS (tem); =20 Lisp_Object tail; - do - { - tail =3D tem; - tem =3D XCDR (tail); - rarely_quit (++quit_count); - } - while (CONSP (tem)); + FOR_EACH_TAIL_CONS (tem) + tail =3D li.tail; =20 tem =3D 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 =3D 0; - while (CONSP (plist) && !EQ (XCAR (plist), prop)) + FOR_EACH_TAIL (plist) { - plist =3D XCDR (plist); - plist =3D 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 =3D XCDR (li.tail); + if (EQ (li.tail, li.tortoise)) + circular_list (plist); } - return plist; + return Qnil; } =20 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, diff --git a/src/lisp.h b/src/lisp.h index 2d74d44..275e0fc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3129,20 +3129,14 @@ extern void maybe_quit (void); =20 #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) =20 -/* 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 =3D 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. */ =20 INLINE void rarely_quit (unsigned short int count) { - if (! (count & (QUIT_COUNT_HEURISTIC - 1))) + if (! count) maybe_quit (); } =0C @@ -4599,13 +4593,32 @@ enum http://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf */ =20 #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 =3D 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 \ =3D { list, list, 2, 2 }; \ - CONSP (li.tail) || (CHECK_LIST_END (li.tail, list), false); \ + CONSP (li.tail) || (dotted, false); \ (li.tail =3D XCDR (li.tail), \ (li.n-- =3D=3D 0 \ ? (void) (li.n =3D li.max <<=3D 1, li.tortoise =3D li.tail) \ - : EQ (li.tail, li.tortoise) ? circular_list (list) : (void) 0))) + : EQ (li.tail, li.tortoise) ? (cycle) : (void) 0))) =20 /* Do a `for' loop over alist values. */ =20 diff --git a/src/xdisp.c b/src/xdisp.c index 33661c8..31c1fe1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -23055,30 +23055,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 =3D elt; - int len =3D 0; - - while (CONSP (elt) - && (precision <=3D 0 || n < precision)) - { - n +=3D 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 =3D XCDR (elt); - len++; - if ((len & 1) =3D=3D 0) - halftail =3D XCDR (halftail); - /* Check for cycle. */ - if (EQ (halftail, elt)) - break; - } - } + FOR_EACH_TAIL_SAFE (elt) + { + if (0 < precision && precision <=3D n) + break; + n +=3D 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; =20 --=20 2.9.3