aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorVibhav Pant2017-01-30 18:35:43 +0530
committerVibhav Pant2017-01-30 18:35:43 +0530
commitbf7f7c0d82a56ed1b76358657e74ca2833b19fe2 (patch)
tree90f357b4a735ca7c90d1881ef9948186b9f919df /src
parent25d38a06eceb0853190a2d9acf53d85686f524bd (diff)
parent9c4dfdd1af9f97c6a8d7e922b68a39052116790c (diff)
downloademacs-bf7f7c0d82a56ed1b76358657e74ca2833b19fe2.tar.gz
emacs-bf7f7c0d82a56ed1b76358657e74ca2833b19fe2.zip
Merge remote-tracking branch 'origin/master' into feature/byte-switch
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c114
-rw-r--r--src/atimer.c1
-rw-r--r--src/buffer.c13
-rw-r--r--src/bytecode.c2
-rw-r--r--src/callint.c2
-rw-r--r--src/callproc.c16
-rw-r--r--src/category.c2
-rw-r--r--src/ccl.c2
-rw-r--r--src/decompress.c2
-rw-r--r--src/dired.c10
-rw-r--r--src/editfns.c16
-rw-r--r--src/emacs-module.c2
-rw-r--r--src/eval.c40
-rw-r--r--src/fileio.c73
-rw-r--r--src/filelock.c2
-rw-r--r--src/fns.c405
-rw-r--r--src/fontset.c8
-rw-r--r--src/frame.c5
-rw-r--r--src/gfilenotify.c8
-rw-r--r--src/gnutls.c13
-rw-r--r--src/image.c2
-rw-r--r--src/indent.c6
-rw-r--r--src/insdel.c12
-rw-r--r--src/keyboard.c18
-rw-r--r--src/keyboard.h2
-rw-r--r--src/keymap.c12
-rw-r--r--src/lisp.h49
-rw-r--r--src/lread.c14
-rw-r--r--src/macros.c2
-rw-r--r--src/minibuf.c2
-rw-r--r--src/print.c16
-rw-r--r--src/process.c22
-rw-r--r--src/profiler.c6
-rw-r--r--src/regex.c7
-rw-r--r--src/search.c49
-rw-r--r--src/syntax.c167
-rw-r--r--src/sysdep.c10
-rw-r--r--src/textprop.c2
-rw-r--r--src/thread.c61
-rw-r--r--src/w32fns.c8
-rw-r--r--src/w32notify.c2
-rw-r--r--src/w32proc.c2
-rw-r--r--src/window.c7
-rw-r--r--src/xdisp.c2
-rw-r--r--src/xselect.c4
-rw-r--r--src/xterm.c62
46 files changed, 652 insertions, 630 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 1a6d4e2d565..dd2b688f91e 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2872,45 +2872,15 @@ usage: (list &rest OBJECTS) */)
2872 2872
2873DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, 2873DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2874 doc: /* Return a newly created list of length LENGTH, with each element being INIT. */) 2874 doc: /* Return a newly created list of length LENGTH, with each element being INIT. */)
2875 (register Lisp_Object length, Lisp_Object init) 2875 (Lisp_Object length, Lisp_Object init)
2876{ 2876{
2877 register Lisp_Object val; 2877 Lisp_Object val = Qnil;
2878 register EMACS_INT size;
2879
2880 CHECK_NATNUM (length); 2878 CHECK_NATNUM (length);
2881 size = XFASTINT (length);
2882 2879
2883 val = Qnil; 2880 for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
2884 while (size > 0)
2885 { 2881 {
2886 val = Fcons (init, val); 2882 val = Fcons (init, val);
2887 --size; 2883 maybe_quit ();
2888
2889 if (size > 0)
2890 {
2891 val = Fcons (init, val);
2892 --size;
2893
2894 if (size > 0)
2895 {
2896 val = Fcons (init, val);
2897 --size;
2898
2899 if (size > 0)
2900 {
2901 val = Fcons (init, val);
2902 --size;
2903
2904 if (size > 0)
2905 {
2906 val = Fcons (init, val);
2907 --size;
2908 }
2909 }
2910 }
2911 }
2912
2913 QUIT;
2914 } 2884 }
2915 2885
2916 return val; 2886 return val;
@@ -5464,6 +5434,37 @@ make_pure_vector (ptrdiff_t len)
5464 return new; 5434 return new;
5465} 5435}
5466 5436
5437/* Copy all contents and parameters of TABLE to a new table allocated
5438 from pure space, return the purified table. */
5439static struct Lisp_Hash_Table *
5440purecopy_hash_table (struct Lisp_Hash_Table *table) {
5441 eassert (NILP (table->weak));
5442 eassert (!NILP (table->pure));
5443
5444 struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
5445 struct hash_table_test pure_test = table->test;
5446
5447 /* Purecopy the hash table test. */
5448 pure_test.name = purecopy (table->test.name);
5449 pure_test.user_hash_function = purecopy (table->test.user_hash_function);
5450 pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
5451
5452 pure->test = pure_test;
5453 pure->header = table->header;
5454 pure->weak = purecopy (Qnil);
5455 pure->rehash_size = purecopy (table->rehash_size);
5456 pure->rehash_threshold = purecopy (table->rehash_threshold);
5457 pure->hash = purecopy (table->hash);
5458 pure->next = purecopy (table->next);
5459 pure->next_free = purecopy (table->next_free);
5460 pure->index = purecopy (table->index);
5461 pure->count = table->count;
5462 pure->key_and_value = purecopy (table->key_and_value);
5463 pure->pure = purecopy (table->pure);
5464
5465 return pure;
5466}
5467
5467DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, 5468DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
5468 doc: /* Make a copy of object OBJ in pure storage. 5469 doc: /* Make a copy of object OBJ in pure storage.
5469Recursively copies contents of vectors and cons cells. 5470Recursively copies contents of vectors and cons cells.
@@ -5472,14 +5473,22 @@ Does not copy symbols. Copies strings without text properties. */)
5472{ 5473{
5473 if (NILP (Vpurify_flag)) 5474 if (NILP (Vpurify_flag))
5474 return obj; 5475 return obj;
5475 else if (MARKERP (obj) || OVERLAYP (obj) 5476 else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj))
5476 || HASH_TABLE_P (obj) || SYMBOLP (obj))
5477 /* Can't purify those. */ 5477 /* Can't purify those. */
5478 return obj; 5478 return obj;
5479 else 5479 else
5480 return purecopy (obj); 5480 return purecopy (obj);
5481} 5481}
5482 5482
5483struct pinned_object
5484{
5485 Lisp_Object object;
5486 struct pinned_object *next;
5487};
5488
5489/* Pinned objects are marked before every GC cycle. */
5490static struct pinned_object *pinned_objects;
5491
5483static Lisp_Object 5492static Lisp_Object
5484purecopy (Lisp_Object obj) 5493purecopy (Lisp_Object obj)
5485{ 5494{
@@ -5507,7 +5516,27 @@ purecopy (Lisp_Object obj)
5507 obj = make_pure_string (SSDATA (obj), SCHARS (obj), 5516 obj = make_pure_string (SSDATA (obj), SCHARS (obj),
5508 SBYTES (obj), 5517 SBYTES (obj),
5509 STRING_MULTIBYTE (obj)); 5518 STRING_MULTIBYTE (obj));
5510 else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj)) 5519 else if (HASH_TABLE_P (obj))
5520 {
5521 struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
5522 /* We cannot purify hash tables which haven't been defined with
5523 :purecopy as non-nil or are weak - they aren't guaranteed to
5524 not change. */
5525 if (!NILP (table->weak) || NILP (table->pure))
5526 {
5527 /* Instead, the hash table is added to the list of pinned objects,
5528 and is marked before GC. */
5529 struct pinned_object *o = xmalloc (sizeof *o);
5530 o->object = obj;
5531 o->next = pinned_objects;
5532 pinned_objects = o;
5533 return obj; /* Don't hash cons it. */
5534 }
5535
5536 struct Lisp_Hash_Table *h = purecopy_hash_table (table);
5537 XSET_HASH_TABLE (obj, h);
5538 }
5539 else if (COMPILEDP (obj) || VECTORP (obj))
5511 { 5540 {
5512 struct Lisp_Vector *objp = XVECTOR (obj); 5541 struct Lisp_Vector *objp = XVECTOR (obj);
5513 ptrdiff_t nbytes = vector_nbytes (objp); 5542 ptrdiff_t nbytes = vector_nbytes (objp);
@@ -5724,6 +5753,16 @@ compact_undo_list (Lisp_Object list)
5724} 5753}
5725 5754
5726static void 5755static void
5756mark_pinned_objects (void)
5757{
5758 struct pinned_object *pobj;
5759 for (pobj = pinned_objects; pobj; pobj = pobj->next)
5760 {
5761 mark_object (pobj->object);
5762 }
5763}
5764
5765static void
5727mark_pinned_symbols (void) 5766mark_pinned_symbols (void)
5728{ 5767{
5729 struct symbol_block *sblk; 5768 struct symbol_block *sblk;
@@ -5843,6 +5882,7 @@ garbage_collect_1 (void *end)
5843 for (i = 0; i < staticidx; i++) 5882 for (i = 0; i < staticidx; i++)
5844 mark_object (*staticvec[i]); 5883 mark_object (*staticvec[i]);
5845 5884
5885 mark_pinned_objects ();
5846 mark_pinned_symbols (); 5886 mark_pinned_symbols ();
5847 mark_terminals (); 5887 mark_terminals ();
5848 mark_kboards (); 5888 mark_kboards ();
diff --git a/src/atimer.c b/src/atimer.c
index 7f099809d3c..5feb1f6777d 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20#include <stdio.h> 20#include <stdio.h>
21 21
22#include "lisp.h" 22#include "lisp.h"
23#include "keyboard.h"
23#include "syssignal.h" 24#include "syssignal.h"
24#include "systime.h" 25#include "systime.h"
25#include "atimer.h" 26#include "atimer.h"
diff --git a/src/buffer.c b/src/buffer.c
index fde23cace1a..c00cc40d6f2 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -415,19 +415,16 @@ followed by the rest of the buffers. */)
415} 415}
416 416
417/* Like Fassoc, but use Fstring_equal to compare 417/* Like Fassoc, but use Fstring_equal to compare
418 (which ignores text properties), 418 (which ignores text properties), and don't ever quit. */
419 and don't ever QUIT. */
420 419
421static Lisp_Object 420static Lisp_Object
422assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list) 421assoc_ignore_text_properties (Lisp_Object key, Lisp_Object list)
423{ 422{
424 register Lisp_Object tail; 423 Lisp_Object tail;
425 for (tail = list; CONSP (tail); tail = XCDR (tail)) 424 for (tail = list; CONSP (tail); tail = XCDR (tail))
426 { 425 {
427 register Lisp_Object elt, tem; 426 Lisp_Object elt = XCAR (tail);
428 elt = XCAR (tail); 427 if (!NILP (Fstring_equal (Fcar (elt), key)))
429 tem = Fstring_equal (Fcar (elt), key);
430 if (!NILP (tem))
431 return elt; 428 return elt;
432 } 429 }
433 return Qnil; 430 return Qnil;
diff --git a/src/bytecode.c b/src/bytecode.c
index f4540e94c9c..288d78efe41 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -681,7 +681,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
681 { 681 {
682 quitcounter = 1; 682 quitcounter = 1;
683 maybe_gc (); 683 maybe_gc ();
684 QUIT; 684 maybe_quit ();
685 } 685 }
686 pc += op; 686 pc += op;
687 NEXT; 687 NEXT;
diff --git a/src/callint.c b/src/callint.c
index 565fac8a451..d96454883cf 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -794,7 +794,7 @@ invoke it. If KEYS is omitted or nil, the return value of
794 } 794 }
795 unbind_to (speccount, Qnil); 795 unbind_to (speccount, Qnil);
796 796
797 QUIT; 797 maybe_quit ();
798 798
799 args[0] = Qfuncall_interactively; 799 args[0] = Qfuncall_interactively;
800 args[1] = function; 800 args[1] = function;
diff --git a/src/callproc.c b/src/callproc.c
index 90c15de2913..301ccf383b5 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,11 +198,11 @@ call_process_cleanup (Lisp_Object buffer)
198 { 198 {
199 kill (-synch_process_pid, SIGINT); 199 kill (-synch_process_pid, SIGINT);
200 message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); 200 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
201 immediate_quit = 1; 201 immediate_quit = true;
202 QUIT; 202 maybe_quit ();
203 wait_for_termination (synch_process_pid, 0, 1); 203 wait_for_termination (synch_process_pid, 0, 1);
204 synch_process_pid = 0; 204 synch_process_pid = 0;
205 immediate_quit = 0; 205 immediate_quit = false;
206 message1 ("Waiting for process to die...done"); 206 message1 ("Waiting for process to die...done");
207 } 207 }
208#endif /* !MSDOS */ 208#endif /* !MSDOS */
@@ -726,8 +726,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
726 process_coding.src_multibyte = 0; 726 process_coding.src_multibyte = 0;
727 } 727 }
728 728
729 immediate_quit = 1; 729 immediate_quit = true;
730 QUIT; 730 maybe_quit ();
731 731
732 if (0 <= fd0) 732 if (0 <= fd0)
733 { 733 {
@@ -769,7 +769,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
769 } 769 }
770 770
771 /* Now NREAD is the total amount of data in the buffer. */ 771 /* Now NREAD is the total amount of data in the buffer. */
772 immediate_quit = 0; 772 immediate_quit = false;
773 773
774 if (!nread) 774 if (!nread)
775 ; 775 ;
@@ -843,7 +843,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
843 display_on_the_fly = true; 843 display_on_the_fly = true;
844 } 844 }
845 immediate_quit = true; 845 immediate_quit = true;
846 QUIT; 846 maybe_quit ();
847 } 847 }
848 give_up: ; 848 give_up: ;
849 849
@@ -860,7 +860,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
860 wait_for_termination (pid, &status, fd0 < 0); 860 wait_for_termination (pid, &status, fd0 < 0);
861#endif 861#endif
862 862
863 immediate_quit = 0; 863 immediate_quit = false;
864 864
865 /* Don't kill any children that the subprocess may have left behind 865 /* Don't kill any children that the subprocess may have left behind
866 when exiting. */ 866 when exiting. */
diff --git a/src/category.c b/src/category.c
index e5d261c1cff..ff287a4af3d 100644
--- a/src/category.c
+++ b/src/category.c
@@ -67,7 +67,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
67 make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE), 67 make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
68 make_float (DEFAULT_REHASH_SIZE), 68 make_float (DEFAULT_REHASH_SIZE),
69 make_float (DEFAULT_REHASH_THRESHOLD), 69 make_float (DEFAULT_REHASH_THRESHOLD),
70 Qnil)); 70 Qnil, Qnil));
71 h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); 71 h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
72 i = hash_lookup (h, category_set, &hash); 72 i = hash_lookup (h, category_set, &hash);
73 if (i >= 0) 73 if (i >= 0)
diff --git a/src/ccl.c b/src/ccl.c
index c172fc66811..90bd2f46794 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1993,7 +1993,7 @@ programs. */)
1993 : 0); 1993 : 0);
1994 1994
1995 ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil); 1995 ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil);
1996 QUIT; 1996 maybe_quit ();
1997 if (ccl.status != CCL_STAT_SUCCESS) 1997 if (ccl.status != CCL_STAT_SUCCESS)
1998 error ("Error in CCL program at %dth code", ccl.ic); 1998 error ("Error in CCL program at %dth code", ccl.ic);
1999 1999
diff --git a/src/decompress.c b/src/decompress.c
index f6628d5ddd9..a53a66df187 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -186,7 +186,7 @@ This function can be called only in unibyte buffers. */)
186 decompressed = avail_out - stream.avail_out; 186 decompressed = avail_out - stream.avail_out;
187 insert_from_gap (decompressed, decompressed, 0); 187 insert_from_gap (decompressed, decompressed, 0);
188 unwind_data.nbytes += decompressed; 188 unwind_data.nbytes += decompressed;
189 QUIT; 189 maybe_quit ();
190 } 190 }
191 while (inflate_status == Z_OK); 191 while (inflate_status == Z_OK);
192 192
diff --git a/src/dired.c b/src/dired.c
index bf10f1710ff..52e81fb380b 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -139,7 +139,7 @@ read_dirent (DIR *dir, Lisp_Object dirname)
139#endif 139#endif
140 report_file_error ("Reading directory", dirname); 140 report_file_error ("Reading directory", dirname);
141 } 141 }
142 QUIT; 142 maybe_quit ();
143 } 143 }
144} 144}
145 145
@@ -248,13 +248,13 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
248 248
249 /* Now that we have unwind_protect in place, we might as well 249 /* Now that we have unwind_protect in place, we might as well
250 allow matching to be interrupted. */ 250 allow matching to be interrupted. */
251 immediate_quit = 1; 251 immediate_quit = true;
252 QUIT; 252 maybe_quit ();
253 253
254 bool wanted = (NILP (match) 254 bool wanted = (NILP (match)
255 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); 255 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
256 256
257 immediate_quit = 0; 257 immediate_quit = false;
258 258
259 if (wanted) 259 if (wanted)
260 { 260 {
@@ -508,7 +508,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
508 ptrdiff_t len = dirent_namelen (dp); 508 ptrdiff_t len = dirent_namelen (dp);
509 bool canexclude = 0; 509 bool canexclude = 0;
510 510
511 QUIT; 511 maybe_quit ();
512 if (len < SCHARS (encoded_file) 512 if (len < SCHARS (encoded_file)
513 || (scmp (dp->d_name, SSDATA (encoded_file), 513 || (scmp (dp->d_name, SSDATA (encoded_file),
514 SCHARS (encoded_file)) 514 SCHARS (encoded_file))
diff --git a/src/editfns.c b/src/editfns.c
index bee3bbc2cdd..82c6abb9987 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2695,7 +2695,7 @@ called interactively, INHERIT is t. */)
2695 string[i] = str[i % len]; 2695 string[i] = str[i % len];
2696 while (n > stringlen) 2696 while (n > stringlen)
2697 { 2697 {
2698 QUIT; 2698 maybe_quit ();
2699 if (!NILP (inherit)) 2699 if (!NILP (inherit))
2700 insert_and_inherit (string, stringlen); 2700 insert_and_inherit (string, stringlen);
2701 else 2701 else
@@ -3053,6 +3053,7 @@ determines whether case is significant or ignored. */)
3053 i2 = begp2; 3053 i2 = begp2;
3054 i1_byte = buf_charpos_to_bytepos (bp1, i1); 3054 i1_byte = buf_charpos_to_bytepos (bp1, i1);
3055 i2_byte = buf_charpos_to_bytepos (bp2, i2); 3055 i2_byte = buf_charpos_to_bytepos (bp2, i2);
3056 immediate_quit = true;
3056 3057
3057 while (i1 < endp1 && i2 < endp2) 3058 while (i1 < endp1 && i2 < endp2)
3058 { 3059 {
@@ -3060,8 +3061,6 @@ determines whether case is significant or ignored. */)
3060 characters, not just the bytes. */ 3061 characters, not just the bytes. */
3061 int c1, c2; 3062 int c1, c2;
3062 3063
3063 QUIT;
3064
3065 if (! NILP (BVAR (bp1, enable_multibyte_characters))) 3064 if (! NILP (BVAR (bp1, enable_multibyte_characters)))
3066 { 3065 {
3067 c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); 3066 c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
@@ -3093,14 +3092,17 @@ determines whether case is significant or ignored. */)
3093 c1 = char_table_translate (trt, c1); 3092 c1 = char_table_translate (trt, c1);
3094 c2 = char_table_translate (trt, c2); 3093 c2 = char_table_translate (trt, c2);
3095 } 3094 }
3096 if (c1 < c2) 3095 if (c1 != c2)
3097 return make_number (- 1 - chars); 3096 {
3098 if (c1 > c2) 3097 immediate_quit = false;
3099 return make_number (chars + 1); 3098 return make_number (c1 < c2 ? -1 - chars : chars + 1);
3099 }
3100 3100
3101 chars++; 3101 chars++;
3102 } 3102 }
3103 3103
3104 immediate_quit = false;
3105
3104 /* The strings match as far as they go. 3106 /* The strings match as far as they go.
3105 If one is shorter, that one is less. */ 3107 If one is shorter, that one is less. */
3106 if (chars < endp1 - begp1) 3108 if (chars < endp1 - begp1)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e22c7dc5b72..69fa5c8e64c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1016,7 +1016,7 @@ syms_of_module (void)
1016 = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE), 1016 = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
1017 make_float (DEFAULT_REHASH_SIZE), 1017 make_float (DEFAULT_REHASH_SIZE),
1018 make_float (DEFAULT_REHASH_THRESHOLD), 1018 make_float (DEFAULT_REHASH_THRESHOLD),
1019 Qnil); 1019 Qnil, Qnil);
1020 Funintern (Qmodule_refs_hash, Qnil); 1020 Funintern (Qmodule_refs_hash, Qnil);
1021 1021
1022 DEFSYM (Qmodule_environments, "module-environments"); 1022 DEFSYM (Qmodule_environments, "module-environments");
diff --git a/src/eval.c b/src/eval.c
index 1f8d4099324..62d4af15e27 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -856,10 +856,9 @@ usage: (let* VARLIST BODY...) */)
856 856
857 lexenv = Vinternal_interpreter_environment; 857 lexenv = Vinternal_interpreter_environment;
858 858
859 varlist = XCAR (args); 859 for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
860 while (CONSP (varlist))
861 { 860 {
862 QUIT; 861 maybe_quit ();
863 862
864 elt = XCAR (varlist); 863 elt = XCAR (varlist);
865 if (SYMBOLP (elt)) 864 if (SYMBOLP (elt))
@@ -893,9 +892,8 @@ usage: (let* VARLIST BODY...) */)
893 } 892 }
894 else 893 else
895 specbind (var, val); 894 specbind (var, val);
896
897 varlist = XCDR (varlist);
898 } 895 }
896 CHECK_LIST_END (varlist, XCAR (args));
899 897
900 val = Fprogn (XCDR (args)); 898 val = Fprogn (XCDR (args));
901 return unbind_to (count, val); 899 return unbind_to (count, val);
@@ -917,6 +915,7 @@ usage: (let VARLIST BODY...) */)
917 USE_SAFE_ALLOCA; 915 USE_SAFE_ALLOCA;
918 916
919 varlist = XCAR (args); 917 varlist = XCAR (args);
918 CHECK_LIST (varlist);
920 919
921 /* Make space to hold the values to give the bound variables. */ 920 /* Make space to hold the values to give the bound variables. */
922 elt = Flength (varlist); 921 elt = Flength (varlist);
@@ -926,7 +925,7 @@ usage: (let VARLIST BODY...) */)
926 925
927 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) 926 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
928 { 927 {
929 QUIT; 928 maybe_quit ();
930 elt = XCAR (varlist); 929 elt = XCAR (varlist);
931 if (SYMBOLP (elt)) 930 if (SYMBOLP (elt))
932 temps [argnum++] = Qnil; 931 temps [argnum++] = Qnil;
@@ -979,7 +978,7 @@ usage: (while TEST BODY...) */)
979 body = XCDR (args); 978 body = XCDR (args);
980 while (!NILP (eval_sub (test))) 979 while (!NILP (eval_sub (test)))
981 { 980 {
982 QUIT; 981 maybe_quit ();
983 prog_ignore (body); 982 prog_ignore (body);
984 } 983 }
985 984
@@ -1012,7 +1011,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1012 until we get a symbol that is not an alias. */ 1011 until we get a symbol that is not an alias. */
1013 while (SYMBOLP (def)) 1012 while (SYMBOLP (def))
1014 { 1013 {
1015 QUIT; 1014 maybe_quit ();
1016 sym = def; 1015 sym = def;
1017 tem = Fassq (sym, environment); 1016 tem = Fassq (sym, environment);
1018 if (NILP (tem)) 1017 if (NILP (tem))
@@ -1132,7 +1131,7 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
1132 /* Restore certain special C variables. */ 1131 /* Restore certain special C variables. */
1133 set_poll_suppress_count (catch->poll_suppress_count); 1132 set_poll_suppress_count (catch->poll_suppress_count);
1134 unblock_input_to (catch->interrupt_input_blocked); 1133 unblock_input_to (catch->interrupt_input_blocked);
1135 immediate_quit = 0; 1134 immediate_quit = false;
1136 1135
1137 do 1136 do
1138 { 1137 {
@@ -1451,7 +1450,7 @@ static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
1451static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, 1450static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
1452 Lisp_Object data); 1451 Lisp_Object data);
1453 1452
1454void 1453static void
1455process_quit_flag (void) 1454process_quit_flag (void)
1456{ 1455{
1457 Lisp_Object flag = Vquit_flag; 1456 Lisp_Object flag = Vquit_flag;
@@ -1463,6 +1462,15 @@ process_quit_flag (void)
1463 quit (); 1462 quit ();
1464} 1463}
1465 1464
1465void
1466maybe_quit (void)
1467{
1468 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
1469 process_quit_flag ();
1470 else if (pending_signals)
1471 process_pending_signals ();
1472}
1473
1466DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, 1474DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
1467 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. 1475 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1468This function does not return. 1476This function does not return.
@@ -1506,10 +1514,10 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
1506 Lisp_Object string; 1514 Lisp_Object string;
1507 Lisp_Object real_error_symbol 1515 Lisp_Object real_error_symbol
1508 = (NILP (error_symbol) ? Fcar (data) : error_symbol); 1516 = (NILP (error_symbol) ? Fcar (data) : error_symbol);
1509 register Lisp_Object clause = Qnil; 1517 Lisp_Object clause = Qnil;
1510 struct handler *h; 1518 struct handler *h;
1511 1519
1512 immediate_quit = 0; 1520 immediate_quit = false;
1513 if (gc_in_progress || waiting_for_input) 1521 if (gc_in_progress || waiting_for_input)
1514 emacs_abort (); 1522 emacs_abort ();
1515 1523
@@ -2127,7 +2135,7 @@ eval_sub (Lisp_Object form)
2127 if (!CONSP (form)) 2135 if (!CONSP (form))
2128 return form; 2136 return form;
2129 2137
2130 QUIT; 2138 maybe_quit ();
2131 2139
2132 maybe_gc (); 2140 maybe_gc ();
2133 2141
@@ -2713,7 +2721,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2713 Lisp_Object val; 2721 Lisp_Object val;
2714 ptrdiff_t count; 2722 ptrdiff_t count;
2715 2723
2716 QUIT; 2724 maybe_quit ();
2717 2725
2718 if (++lisp_eval_depth > max_lisp_eval_depth) 2726 if (++lisp_eval_depth > max_lisp_eval_depth)
2719 { 2727 {
@@ -2958,7 +2966,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
2958 bool previous_optional_or_rest = false; 2966 bool previous_optional_or_rest = false;
2959 for (; CONSP (syms_left); syms_left = XCDR (syms_left)) 2967 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
2960 { 2968 {
2961 QUIT; 2969 maybe_quit ();
2962 2970
2963 next = XCAR (syms_left); 2971 next = XCAR (syms_left);
2964 if (!SYMBOLP (next)) 2972 if (!SYMBOLP (next))
@@ -3096,7 +3104,7 @@ lambda_arity (Lisp_Object fun)
3096 if (EQ (XCAR (fun), Qclosure)) 3104 if (EQ (XCAR (fun), Qclosure))
3097 { 3105 {
3098 fun = XCDR (fun); /* Drop `closure'. */ 3106 fun = XCDR (fun); /* Drop `closure'. */
3099 CHECK_LIST_CONS (fun, fun); 3107 CHECK_CONS (fun);
3100 } 3108 }
3101 syms_left = XCDR (fun); 3109 syms_left = XCDR (fun);
3102 if (CONSP (syms_left)) 3110 if (CONSP (syms_left))
diff --git a/src/fileio.c b/src/fileio.c
index be52d0f3d0e..a46cfc7ac69 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -316,7 +316,7 @@ use the standard functions without calling themselves recursively. */)
316 } 316 }
317 } 317 }
318 318
319 QUIT; 319 maybe_quit ();
320 } 320 }
321 return result; 321 return result;
322} 322}
@@ -1960,9 +1960,9 @@ permissions. */)
1960 report_file_error ("Copying permissions to", newname); 1960 report_file_error ("Copying permissions to", newname);
1961 } 1961 }
1962#else /* not WINDOWSNT */ 1962#else /* not WINDOWSNT */
1963 immediate_quit = 1; 1963 immediate_quit = true;
1964 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); 1964 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
1965 immediate_quit = 0; 1965 immediate_quit = false;
1966 1966
1967 if (ifd < 0) 1967 if (ifd < 0)
1968 report_file_error ("Opening input file", file); 1968 report_file_error ("Opening input file", file);
@@ -2024,8 +2024,8 @@ permissions. */)
2024 oldsize = out_st.st_size; 2024 oldsize = out_st.st_size;
2025 } 2025 }
2026 2026
2027 immediate_quit = 1; 2027 immediate_quit = true;
2028 QUIT; 2028 maybe_quit ();
2029 2029
2030 if (clone_file (ofd, ifd)) 2030 if (clone_file (ofd, ifd))
2031 newsize = st.st_size; 2031 newsize = st.st_size;
@@ -2047,7 +2047,7 @@ permissions. */)
2047 if (newsize < oldsize && ftruncate (ofd, newsize) != 0) 2047 if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
2048 report_file_error ("Truncating output file", newname); 2048 report_file_error ("Truncating output file", newname);
2049 2049
2050 immediate_quit = 0; 2050 immediate_quit = false;
2051 2051
2052#ifndef MSDOS 2052#ifndef MSDOS
2053 /* Preserve the original file permissions, and if requested, also its 2053 /* Preserve the original file permissions, and if requested, also its
@@ -2682,7 +2682,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2682 2682
2683DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, 2683DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2684 doc: /* Access file FILENAME, and get an error if that does not work. 2684 doc: /* Access file FILENAME, and get an error if that does not work.
2685The second argument STRING is used in the error message. 2685The second argument STRING is prepended to the error message.
2686If there is no error, returns nil. */) 2686If there is no error, returns nil. */)
2687 (Lisp_Object filename, Lisp_Object string) 2687 (Lisp_Object filename, Lisp_Object string)
2688{ 2688{
@@ -2815,7 +2815,17 @@ really is a readable and searchable directory. */)
2815 if (!NILP (handler)) 2815 if (!NILP (handler))
2816 { 2816 {
2817 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname); 2817 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2818 errno = 0; 2818
2819 /* Set errno in case the handler failed. EACCES might be a lie
2820 (e.g., the directory might not exist, or be a regular file),
2821 but at least it does TRT in the "usual" case of an existing
2822 directory that is not accessible by the current user, and
2823 avoids reporting "Success" for a failed operation. Perhaps
2824 someday we can fix this in a better way, by improving
2825 file-accessible-directory-p's API; see Bug#25419. */
2826 if (!EQ (r, Qt))
2827 errno = EACCES;
2828
2819 return r; 2829 return r;
2820 } 2830 }
2821 2831
@@ -3393,13 +3403,13 @@ read_non_regular (Lisp_Object state)
3393{ 3403{
3394 int nbytes; 3404 int nbytes;
3395 3405
3396 immediate_quit = 1; 3406 immediate_quit = true;
3397 QUIT; 3407 maybe_quit ();
3398 nbytes = emacs_read (XSAVE_INTEGER (state, 0), 3408 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3399 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 3409 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3400 + XSAVE_INTEGER (state, 1)), 3410 + XSAVE_INTEGER (state, 1)),
3401 XSAVE_INTEGER (state, 2)); 3411 XSAVE_INTEGER (state, 2));
3402 immediate_quit = 0; 3412 immediate_quit = false;
3403 /* Fast recycle this object for the likely next call. */ 3413 /* Fast recycle this object for the likely next call. */
3404 free_misc (state); 3414 free_misc (state);
3405 return make_number (nbytes); 3415 return make_number (nbytes);
@@ -3858,8 +3868,8 @@ by calling `format-decode', which see. */)
3858 report_file_error ("Setting file position", orig_filename); 3868 report_file_error ("Setting file position", orig_filename);
3859 } 3869 }
3860 3870
3861 immediate_quit = 1; 3871 immediate_quit = true;
3862 QUIT; 3872 maybe_quit ();
3863 /* Count how many chars at the start of the file 3873 /* Count how many chars at the start of the file
3864 match the text at the beginning of the buffer. */ 3874 match the text at the beginning of the buffer. */
3865 while (1) 3875 while (1)
@@ -3910,7 +3920,7 @@ by calling `format-decode', which see. */)
3910 goto handled; 3920 goto handled;
3911 } 3921 }
3912 immediate_quit = true; 3922 immediate_quit = true;
3913 QUIT; 3923 maybe_quit ();
3914 /* Count how many chars at the end of the file 3924 /* Count how many chars at the end of the file
3915 match the text at the end of the buffer. But, if we have 3925 match the text at the end of the buffer. But, if we have
3916 already found that decoding is necessary, don't waste time. */ 3926 already found that decoding is necessary, don't waste time. */
@@ -3967,7 +3977,7 @@ by calling `format-decode', which see. */)
3967 if (nread == 0) 3977 if (nread == 0)
3968 break; 3978 break;
3969 } 3979 }
3970 immediate_quit = 0; 3980 immediate_quit = false;
3971 3981
3972 if (! giveup_match_end) 3982 if (! giveup_match_end)
3973 { 3983 {
@@ -4065,11 +4075,11 @@ by calling `format-decode', which see. */)
4065 quitting while reading a huge file. */ 4075 quitting while reading a huge file. */
4066 4076
4067 /* Allow quitting out of the actual I/O. */ 4077 /* Allow quitting out of the actual I/O. */
4068 immediate_quit = 1; 4078 immediate_quit = true;
4069 QUIT; 4079 maybe_quit ();
4070 this = emacs_read (fd, read_buf + unprocessed, 4080 this = emacs_read (fd, read_buf + unprocessed,
4071 READ_BUF_SIZE - unprocessed); 4081 READ_BUF_SIZE - unprocessed);
4072 immediate_quit = 0; 4082 immediate_quit = false;
4073 4083
4074 if (this <= 0) 4084 if (this <= 0)
4075 break; 4085 break;
@@ -4284,13 +4294,13 @@ by calling `format-decode', which see. */)
4284 /* Allow quitting out of the actual I/O. We don't make text 4294 /* Allow quitting out of the actual I/O. We don't make text
4285 part of the buffer until all the reading is done, so a C-g 4295 part of the buffer until all the reading is done, so a C-g
4286 here doesn't do any harm. */ 4296 here doesn't do any harm. */
4287 immediate_quit = 1; 4297 immediate_quit = true;
4288 QUIT; 4298 maybe_quit ();
4289 this = emacs_read (fd, 4299 this = emacs_read (fd,
4290 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 4300 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4291 + inserted), 4301 + inserted),
4292 trytry); 4302 trytry);
4293 immediate_quit = 0; 4303 immediate_quit = false;
4294 } 4304 }
4295 4305
4296 if (this <= 0) 4306 if (this <= 0)
@@ -4602,7 +4612,7 @@ by calling `format-decode', which see. */)
4602 } 4612 }
4603 } 4613 }
4604 4614
4605 QUIT; 4615 maybe_quit ();
4606 p = XCDR (p); 4616 p = XCDR (p);
4607 } 4617 }
4608 4618
@@ -4992,7 +5002,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4992 } 5002 }
4993 } 5003 }
4994 5004
4995 immediate_quit = 1; 5005 immediate_quit = true;
4996 5006
4997 if (STRINGP (start)) 5007 if (STRINGP (start))
4998 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); 5008 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
@@ -5016,7 +5026,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5016 save_errno = errno; 5026 save_errno = errno;
5017 } 5027 }
5018 5028
5019 immediate_quit = 0; 5029 immediate_quit = false;
5020 5030
5021 /* fsync is not crucial for temporary files. Nor for auto-save 5031 /* fsync is not crucial for temporary files. Nor for auto-save
5022 files, since they might lose some work anyway. */ 5032 files, since they might lose some work anyway. */
@@ -5142,19 +5152,26 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5142 if (! ok) 5152 if (! ok)
5143 report_file_errno ("Write error", filename, save_errno); 5153 report_file_errno ("Write error", filename, save_errno);
5144 5154
5155 bool auto_saving_into_visited_file =
5156 auto_saving
5157 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
5158 BVAR (current_buffer, auto_save_file_name)));
5145 if (visiting) 5159 if (visiting)
5146 { 5160 {
5147 SAVE_MODIFF = MODIFF; 5161 SAVE_MODIFF = MODIFF;
5148 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); 5162 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5149 bset_filename (current_buffer, visit_file); 5163 bset_filename (current_buffer, visit_file);
5150 update_mode_lines = 14; 5164 update_mode_lines = 14;
5165 if (auto_saving_into_visited_file)
5166 unlock_file (lockname);
5151 } 5167 }
5152 else if (quietly) 5168 else if (quietly)
5153 { 5169 {
5154 if (auto_saving 5170 if (auto_saving_into_visited_file)
5155 && ! NILP (Fstring_equal (BVAR (current_buffer, filename), 5171 {
5156 BVAR (current_buffer, auto_save_file_name)))) 5172 SAVE_MODIFF = MODIFF;
5157 SAVE_MODIFF = MODIFF; 5173 unlock_file (lockname);
5174 }
5158 5175
5159 return Qnil; 5176 return Qnil;
5160 } 5177 }
diff --git a/src/filelock.c b/src/filelock.c
index 886ab61c7aa..de65c52efa1 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -505,7 +505,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
505 /* readlinkat saw a non-symlink, but emacs_open saw a symlink. 505 /* readlinkat saw a non-symlink, but emacs_open saw a symlink.
506 The former must have been removed and replaced by the latter. 506 The former must have been removed and replaced by the latter.
507 Try again. */ 507 Try again. */
508 QUIT; 508 maybe_quit ();
509 } 509 }
510 510
511 return nbytes; 511 return nbytes;
diff --git a/src/fns.c b/src/fns.c
index 00fa65886f0..5769eac9987 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
34#include "buffer.h" 34#include "buffer.h"
35#include "intervals.h" 35#include "intervals.h"
36#include "window.h" 36#include "window.h"
37#include "puresize.h"
37 38
38static void sort_vector_copy (Lisp_Object, ptrdiff_t, 39static void sort_vector_copy (Lisp_Object, ptrdiff_t,
39 Lisp_Object *restrict, Lisp_Object *restrict); 40 Lisp_Object *restrict, Lisp_Object *restrict);
@@ -84,17 +85,23 @@ See Info node `(elisp)Random Numbers' for more details. */)
84} 85}
85 86
86/* Heuristic on how many iterations of a tight loop can be safely done 87/* Heuristic on how many iterations of a tight loop can be safely done
87 before it's time to do a QUIT. This must be a power of 2. */ 88 before it's time to do a quit. This must be a power of 2. It
89 is nice but not necessary for it to equal USHRT_MAX + 1. */
88enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; 90enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
89 91
90/* Random data-structure functions. */ 92/* Process a quit, but do it only rarely, for efficiency. "Rarely"
93 means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
94 whichever is smaller. Use *QUIT_COUNT to count this. */
91 95
92static void 96static void
93CHECK_LIST_END (Lisp_Object x, Lisp_Object y) 97rarely_quit (unsigned short int *quit_count)
94{ 98{
95 CHECK_TYPE (NILP (x), Qlistp, y); 99 if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
100 maybe_quit ();
96} 101}
97 102
103/* Random data-structure functions. */
104
98DEFUN ("length", Flength, Slength, 1, 1, 0, 105DEFUN ("length", Flength, Slength, 1, 1, 0,
99 doc: /* Return the length of vector, list or string SEQUENCE. 106 doc: /* Return the length of vector, list or string SEQUENCE.
100A byte-code function object is also allowed. 107A byte-code function object is also allowed.
@@ -126,7 +133,7 @@ To get the number of bytes, use `string-bytes'. */)
126 { 133 {
127 if (MOST_POSITIVE_FIXNUM < i) 134 if (MOST_POSITIVE_FIXNUM < i)
128 error ("List too long"); 135 error ("List too long");
129 QUIT; 136 maybe_quit ();
130 } 137 }
131 sequence = XCDR (sequence); 138 sequence = XCDR (sequence);
132 } 139 }
@@ -172,7 +179,7 @@ which is at least the number of distinct elements. */)
172 halftail = XCDR (halftail); 179 halftail = XCDR (halftail);
173 if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0) 180 if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
174 { 181 {
175 QUIT; 182 maybe_quit ();
176 if (lolen == 0) 183 if (lolen == 0)
177 hilen += UINTMAX_MAX + 1.0; 184 hilen += UINTMAX_MAX + 1.0;
178 } 185 }
@@ -1202,17 +1209,12 @@ are shared, however.
1202Elements of ALIST that are not conses are also shared. */) 1209Elements of ALIST that are not conses are also shared. */)
1203 (Lisp_Object alist) 1210 (Lisp_Object alist)
1204{ 1211{
1205 register Lisp_Object tem;
1206
1207 CHECK_LIST (alist);
1208 if (NILP (alist)) 1212 if (NILP (alist))
1209 return alist; 1213 return alist;
1210 alist = concat (1, &alist, Lisp_Cons, 0); 1214 alist = concat (1, &alist, Lisp_Cons, false);
1211 for (tem = alist; CONSP (tem); tem = XCDR (tem)) 1215 for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem))
1212 { 1216 {
1213 register Lisp_Object car; 1217 Lisp_Object car = XCAR (tem);
1214 car = XCAR (tem);
1215
1216 if (CONSP (car)) 1218 if (CONSP (car))
1217 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); 1219 XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
1218 } 1220 }
@@ -1356,16 +1358,22 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1356 doc: /* Take cdr N times on LIST, return the result. */) 1358 doc: /* Take cdr N times on LIST, return the result. */)
1357 (Lisp_Object n, Lisp_Object list) 1359 (Lisp_Object n, Lisp_Object list)
1358{ 1360{
1359 EMACS_INT i, num;
1360 CHECK_NUMBER (n); 1361 CHECK_NUMBER (n);
1361 num = XINT (n); 1362 EMACS_INT num = XINT (n);
1362 for (i = 0; i < num && !NILP (list); i++) 1363 Lisp_Object tail = list;
1364 immediate_quit = true;
1365 for (EMACS_INT i = 0; i < num; i++)
1363 { 1366 {
1364 QUIT; 1367 if (! CONSP (tail))
1365 CHECK_LIST_CONS (list, list); 1368 {
1366 list = XCDR (list); 1369 immediate_quit = false;
1370 CHECK_LIST_END (tail, list);
1371 return Qnil;
1372 }
1373 tail = XCDR (tail);
1367 } 1374 }
1368 return list; 1375 immediate_quit = false;
1376 return tail;
1369} 1377}
1370 1378
1371DEFUN ("nth", Fnth, Snth, 2, 2, 0, 1379DEFUN ("nth", Fnth, Snth, 2, 2, 0,
@@ -1392,66 +1400,61 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
1392DEFUN ("member", Fmember, Smember, 2, 2, 0, 1400DEFUN ("member", Fmember, Smember, 2, 2, 0,
1393 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. 1401 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1394The value is actually the tail of LIST whose car is ELT. */) 1402The value is actually the tail of LIST whose car is ELT. */)
1395 (register Lisp_Object elt, Lisp_Object list) 1403 (Lisp_Object elt, Lisp_Object list)
1396{ 1404{
1397 register Lisp_Object tail; 1405 unsigned short int quit_count = 0;
1398 for (tail = list; !NILP (tail); tail = XCDR (tail)) 1406 Lisp_Object tail;
1407 for (tail = list; CONSP (tail); tail = XCDR (tail))
1399 { 1408 {
1400 register Lisp_Object tem; 1409 if (! NILP (Fequal (elt, XCAR (tail))))
1401 CHECK_LIST_CONS (tail, list);
1402 tem = XCAR (tail);
1403 if (! NILP (Fequal (elt, tem)))
1404 return tail; 1410 return tail;
1405 QUIT; 1411 rarely_quit (&quit_count);
1406 } 1412 }
1413 CHECK_LIST_END (tail, list);
1407 return Qnil; 1414 return Qnil;
1408} 1415}
1409 1416
1410DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, 1417DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1411 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. 1418 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
1412The value is actually the tail of LIST whose car is ELT. */) 1419The value is actually the tail of LIST whose car is ELT. */)
1413 (register Lisp_Object elt, Lisp_Object list) 1420 (Lisp_Object elt, Lisp_Object list)
1414{ 1421{
1415 while (1) 1422 immediate_quit = true;
1423 Lisp_Object tail;
1424 for (tail = list; CONSP (tail); tail = XCDR (tail))
1416 { 1425 {
1417 if (!CONSP (list) || EQ (XCAR (list), elt)) 1426 if (EQ (XCAR (tail), elt))
1418 break; 1427 {
1419 1428 immediate_quit = false;
1420 list = XCDR (list); 1429 return tail;
1421 if (!CONSP (list) || EQ (XCAR (list), elt)) 1430 }
1422 break;
1423
1424 list = XCDR (list);
1425 if (!CONSP (list) || EQ (XCAR (list), elt))
1426 break;
1427
1428 list = XCDR (list);
1429 QUIT;
1430 } 1431 }
1431 1432 immediate_quit = false;
1432 CHECK_LIST (list); 1433 CHECK_LIST_END (tail, list);
1433 return list; 1434 return Qnil;
1434} 1435}
1435 1436
1436DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, 1437DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
1437 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. 1438 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'.
1438The value is actually the tail of LIST whose car is ELT. */) 1439The value is actually the tail of LIST whose car is ELT. */)
1439 (register Lisp_Object elt, Lisp_Object list) 1440 (Lisp_Object elt, Lisp_Object list)
1440{ 1441{
1441 register Lisp_Object tail;
1442
1443 if (!FLOATP (elt)) 1442 if (!FLOATP (elt))
1444 return Fmemq (elt, list); 1443 return Fmemq (elt, list);
1445 1444
1446 for (tail = list; !NILP (tail); tail = XCDR (tail)) 1445 immediate_quit = true;
1446 Lisp_Object tail;
1447 for (tail = list; CONSP (tail); tail = XCDR (tail))
1447 { 1448 {
1448 register Lisp_Object tem; 1449 Lisp_Object tem = XCAR (tail);
1449 CHECK_LIST_CONS (tail, list);
1450 tem = XCAR (tail);
1451 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) 1450 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
1452 return tail; 1451 {
1453 QUIT; 1452 immediate_quit = false;
1453 return tail;
1454 }
1454 } 1455 }
1456 immediate_quit = false;
1457 CHECK_LIST_END (tail, list);
1455 return Qnil; 1458 return Qnil;
1456} 1459}
1457 1460
@@ -1461,44 +1464,29 @@ The value is actually the first element of LIST whose car is KEY.
1461Elements of LIST that are not conses are ignored. */) 1464Elements of LIST that are not conses are ignored. */)
1462 (Lisp_Object key, Lisp_Object list) 1465 (Lisp_Object key, Lisp_Object list)
1463{ 1466{
1464 while (1) 1467 immediate_quit = true;
1465 { 1468 Lisp_Object tail;
1466 if (!CONSP (list) 1469 for (tail = list; CONSP (tail); tail = XCDR (tail))
1467 || (CONSP (XCAR (list)) 1470 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1468 && EQ (XCAR (XCAR (list)), key))) 1471 {
1469 break; 1472 immediate_quit = false;
1470 1473 return XCAR (tail);
1471 list = XCDR (list); 1474 }
1472 if (!CONSP (list) 1475 immediate_quit = true;
1473 || (CONSP (XCAR (list)) 1476 CHECK_LIST_END (tail, list);
1474 && EQ (XCAR (XCAR (list)), key))) 1477 return Qnil;
1475 break;
1476
1477 list = XCDR (list);
1478 if (!CONSP (list)
1479 || (CONSP (XCAR (list))
1480 && EQ (XCAR (XCAR (list)), key)))
1481 break;
1482
1483 list = XCDR (list);
1484 QUIT;
1485 }
1486
1487 return CAR (list);
1488} 1478}
1489 1479
1490/* Like Fassq but never report an error and do not allow quits. 1480/* Like Fassq but never report an error and do not allow quits.
1491 Use only on lists known never to be circular. */ 1481 Use only on objects known to be non-circular lists. */
1492 1482
1493Lisp_Object 1483Lisp_Object
1494assq_no_quit (Lisp_Object key, Lisp_Object list) 1484assq_no_quit (Lisp_Object key, Lisp_Object list)
1495{ 1485{
1496 while (CONSP (list) 1486 for (; ! NILP (list); list = XCDR (list))
1497 && (!CONSP (XCAR (list)) 1487 if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key))
1498 || !EQ (XCAR (XCAR (list)), key))) 1488 return XCAR (list);
1499 list = XCDR (list); 1489 return Qnil;
1500
1501 return CAR_SAFE (list);
1502} 1490}
1503 1491
1504DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, 1492DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
@@ -1506,81 +1494,52 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
1506The value is actually the first element of LIST whose car equals KEY. */) 1494The value is actually the first element of LIST whose car equals KEY. */)
1507 (Lisp_Object key, Lisp_Object list) 1495 (Lisp_Object key, Lisp_Object list)
1508{ 1496{
1509 Lisp_Object car; 1497 unsigned short int quit_count = 0;
1510 1498 Lisp_Object tail;
1511 while (1) 1499 for (tail = list; CONSP (tail); tail = XCDR (tail))
1512 { 1500 {
1513 if (!CONSP (list) 1501 Lisp_Object car = XCAR (tail);
1514 || (CONSP (XCAR (list)) 1502 if (CONSP (car)
1515 && (car = XCAR (XCAR (list)), 1503 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1516 EQ (car, key) || !NILP (Fequal (car, key))))) 1504 return car;
1517 break; 1505 rarely_quit (&quit_count);
1518
1519 list = XCDR (list);
1520 if (!CONSP (list)
1521 || (CONSP (XCAR (list))
1522 && (car = XCAR (XCAR (list)),
1523 EQ (car, key) || !NILP (Fequal (car, key)))))
1524 break;
1525
1526 list = XCDR (list);
1527 if (!CONSP (list)
1528 || (CONSP (XCAR (list))
1529 && (car = XCAR (XCAR (list)),
1530 EQ (car, key) || !NILP (Fequal (car, key)))))
1531 break;
1532
1533 list = XCDR (list);
1534 QUIT;
1535 } 1506 }
1536 1507 CHECK_LIST_END (tail, list);
1537 return CAR (list); 1508 return Qnil;
1538} 1509}
1539 1510
1540/* Like Fassoc but never report an error and do not allow quits. 1511/* Like Fassoc but never report an error and do not allow quits.
1541 Use only on lists known never to be circular. */ 1512 Use only on objects known to be non-circular lists. */
1542 1513
1543Lisp_Object 1514Lisp_Object
1544assoc_no_quit (Lisp_Object key, Lisp_Object list) 1515assoc_no_quit (Lisp_Object key, Lisp_Object list)
1545{ 1516{
1546 while (CONSP (list) 1517 for (; ! NILP (list); list = XCDR (list))
1547 && (!CONSP (XCAR (list)) 1518 {
1548 || (!EQ (XCAR (XCAR (list)), key) 1519 Lisp_Object car = XCAR (list);
1549 && NILP (Fequal (XCAR (XCAR (list)), key))))) 1520 if (CONSP (car)
1550 list = XCDR (list); 1521 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1551 1522 return car;
1552 return CONSP (list) ? XCAR (list) : Qnil; 1523 }
1524 return Qnil;
1553} 1525}
1554 1526
1555DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, 1527DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
1556 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. 1528 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
1557The value is actually the first element of LIST whose cdr is KEY. */) 1529The value is actually the first element of LIST whose cdr is KEY. */)
1558 (register Lisp_Object key, Lisp_Object list) 1530 (Lisp_Object key, Lisp_Object list)
1559{ 1531{
1560 while (1) 1532 immediate_quit = true;
1561 { 1533 Lisp_Object tail;
1562 if (!CONSP (list) 1534 for (tail = list; CONSP (tail); tail = XCDR (tail))
1563 || (CONSP (XCAR (list)) 1535 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
1564 && EQ (XCDR (XCAR (list)), key))) 1536 {
1565 break; 1537 immediate_quit = false;
1566 1538 return XCAR (tail);
1567 list = XCDR (list); 1539 }
1568 if (!CONSP (list) 1540 immediate_quit = true;
1569 || (CONSP (XCAR (list)) 1541 CHECK_LIST_END (tail, list);
1570 && EQ (XCDR (XCAR (list)), key))) 1542 return Qnil;
1571 break;
1572
1573 list = XCDR (list);
1574 if (!CONSP (list)
1575 || (CONSP (XCAR (list))
1576 && EQ (XCDR (XCAR (list)), key)))
1577 break;
1578
1579 list = XCDR (list);
1580 QUIT;
1581 }
1582
1583 return CAR (list);
1584} 1543}
1585 1544
1586DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, 1545DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
@@ -1588,35 +1547,18 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
1588The value is actually the first element of LIST whose cdr equals KEY. */) 1547The value is actually the first element of LIST whose cdr equals KEY. */)
1589 (Lisp_Object key, Lisp_Object list) 1548 (Lisp_Object key, Lisp_Object list)
1590{ 1549{
1591 Lisp_Object cdr; 1550 unsigned short int quit_count = 0;
1592 1551 Lisp_Object tail;
1593 while (1) 1552 for (tail = list; CONSP (tail); tail = XCDR (tail))
1594 { 1553 {
1595 if (!CONSP (list) 1554 Lisp_Object car = XCAR (tail);
1596 || (CONSP (XCAR (list)) 1555 if (CONSP (car)
1597 && (cdr = XCDR (XCAR (list)), 1556 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
1598 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) 1557 return car;
1599 break; 1558 rarely_quit (&quit_count);
1600
1601 list = XCDR (list);
1602 if (!CONSP (list)
1603 || (CONSP (XCAR (list))
1604 && (cdr = XCDR (XCAR (list)),
1605 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
1606 break;
1607
1608 list = XCDR (list);
1609 if (!CONSP (list)
1610 || (CONSP (XCAR (list))
1611 && (cdr = XCDR (XCAR (list)),
1612 EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
1613 break;
1614
1615 list = XCDR (list);
1616 QUIT;
1617 } 1559 }
1618 1560 CHECK_LIST_END (tail, list);
1619 return CAR (list); 1561 return Qnil;
1620} 1562}
1621 1563
1622DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, 1564DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
@@ -1754,12 +1696,11 @@ changing the value of a sequence `foo'. */)
1754 } 1696 }
1755 else 1697 else
1756 { 1698 {
1699 unsigned short int quit_count = 0;
1757 Lisp_Object tail, prev; 1700 Lisp_Object tail, prev;
1758 1701
1759 for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) 1702 for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
1760 { 1703 {
1761 CHECK_LIST_CONS (tail, seq);
1762
1763 if (!NILP (Fequal (elt, XCAR (tail)))) 1704 if (!NILP (Fequal (elt, XCAR (tail))))
1764 { 1705 {
1765 if (NILP (prev)) 1706 if (NILP (prev))
@@ -1769,8 +1710,9 @@ changing the value of a sequence `foo'. */)
1769 } 1710 }
1770 else 1711 else
1771 prev = tail; 1712 prev = tail;
1772 QUIT; 1713 rarely_quit (&quit_count);
1773 } 1714 }
1715 CHECK_LIST_END (tail, seq);
1774 } 1716 }
1775 1717
1776 return seq; 1718 return seq;
@@ -1788,16 +1730,17 @@ This function may destructively modify SEQ to produce the value. */)
1788 return Freverse (seq); 1730 return Freverse (seq);
1789 else if (CONSP (seq)) 1731 else if (CONSP (seq))
1790 { 1732 {
1733 unsigned short int quit_count = 0;
1791 Lisp_Object prev, tail, next; 1734 Lisp_Object prev, tail, next;
1792 1735
1793 for (prev = Qnil, tail = seq; !NILP (tail); tail = next) 1736 for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
1794 { 1737 {
1795 QUIT; 1738 rarely_quit (&quit_count);
1796 CHECK_LIST_CONS (tail, tail);
1797 next = XCDR (tail); 1739 next = XCDR (tail);
1798 Fsetcdr (tail, prev); 1740 Fsetcdr (tail, prev);
1799 prev = tail; 1741 prev = tail;
1800 } 1742 }
1743 CHECK_LIST_END (tail, seq);
1801 seq = prev; 1744 seq = prev;
1802 } 1745 }
1803 else if (VECTORP (seq)) 1746 else if (VECTORP (seq))
@@ -1838,9 +1781,10 @@ See also the function `nreverse', which is used more often. */)
1838 return Qnil; 1781 return Qnil;
1839 else if (CONSP (seq)) 1782 else if (CONSP (seq))
1840 { 1783 {
1784 unsigned short int quit_count = 0;
1841 for (new = Qnil; CONSP (seq); seq = XCDR (seq)) 1785 for (new = Qnil; CONSP (seq); seq = XCDR (seq))
1842 { 1786 {
1843 QUIT; 1787 rarely_quit (&quit_count);
1844 new = Fcons (XCAR (seq), new); 1788 new = Fcons (XCAR (seq), new);
1845 } 1789 }
1846 CHECK_LIST_END (seq, seq); 1790 CHECK_LIST_END (seq, seq);
@@ -2130,28 +2074,28 @@ If PROP is already a property on the list, its value is set to VAL,
2130otherwise the new PROP VAL pair is added. The new plist is returned; 2074otherwise the new PROP VAL pair is added. The new plist is returned;
2131use `(setq x (plist-put x prop val))' to be sure to use the new value. 2075use `(setq x (plist-put x prop val))' to be sure to use the new value.
2132The PLIST is modified by side effects. */) 2076The PLIST is modified by side effects. */)
2133 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) 2077 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2134{ 2078{
2135 register Lisp_Object tail, prev; 2079 immediate_quit = true;
2136 Lisp_Object newcell; 2080 Lisp_Object prev = Qnil;
2137 prev = Qnil; 2081 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2138 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2139 tail = XCDR (XCDR (tail))) 2082 tail = XCDR (XCDR (tail)))
2140 { 2083 {
2141 if (EQ (prop, XCAR (tail))) 2084 if (EQ (prop, XCAR (tail)))
2142 { 2085 {
2086 immediate_quit = false;
2143 Fsetcar (XCDR (tail), val); 2087 Fsetcar (XCDR (tail), val);
2144 return plist; 2088 return plist;
2145 } 2089 }
2146 2090
2147 prev = tail; 2091 prev = tail;
2148 QUIT;
2149 } 2092 }
2150 newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); 2093 immediate_quit = true;
2094 Lisp_Object newcell
2095 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
2151 if (NILP (prev)) 2096 if (NILP (prev))
2152 return newcell; 2097 return newcell;
2153 else 2098 Fsetcdr (XCDR (prev), newcell);
2154 Fsetcdr (XCDR (prev), newcell);
2155 return plist; 2099 return plist;
2156} 2100}
2157 2101
@@ -2174,6 +2118,7 @@ corresponding to the given PROP, or nil if PROP is not
2174one of the properties on the list. */) 2118one of the properties on the list. */)
2175 (Lisp_Object plist, Lisp_Object prop) 2119 (Lisp_Object plist, Lisp_Object prop)
2176{ 2120{
2121 unsigned short int quit_count = 0;
2177 Lisp_Object tail; 2122 Lisp_Object tail;
2178 2123
2179 for (tail = plist; 2124 for (tail = plist;
@@ -2182,8 +2127,7 @@ one of the properties on the list. */)
2182 { 2127 {
2183 if (! NILP (Fequal (prop, XCAR (tail)))) 2128 if (! NILP (Fequal (prop, XCAR (tail))))
2184 return XCAR (XCDR (tail)); 2129 return XCAR (XCDR (tail));
2185 2130 rarely_quit (&quit_count);
2186 QUIT;
2187 } 2131 }
2188 2132
2189 CHECK_LIST_END (tail, prop); 2133 CHECK_LIST_END (tail, prop);
@@ -2199,12 +2143,11 @@ If PROP is already a property on the list, its value is set to VAL,
2199otherwise the new PROP VAL pair is added. The new plist is returned; 2143otherwise the new PROP VAL pair is added. The new plist is returned;
2200use `(setq x (lax-plist-put x prop val))' to be sure to use the new value. 2144use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
2201The PLIST is modified by side effects. */) 2145The PLIST is modified by side effects. */)
2202 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) 2146 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2203{ 2147{
2204 register Lisp_Object tail, prev; 2148 unsigned short int quit_count = 0;
2205 Lisp_Object newcell; 2149 Lisp_Object prev = Qnil;
2206 prev = Qnil; 2150 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2207 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2208 tail = XCDR (XCDR (tail))) 2151 tail = XCDR (XCDR (tail)))
2209 { 2152 {
2210 if (! NILP (Fequal (prop, XCAR (tail)))) 2153 if (! NILP (Fequal (prop, XCAR (tail))))
@@ -2214,13 +2157,12 @@ The PLIST is modified by side effects. */)
2214 } 2157 }
2215 2158
2216 prev = tail; 2159 prev = tail;
2217 QUIT; 2160 rarely_quit (&quit_count);
2218 } 2161 }
2219 newcell = list2 (prop, val); 2162 Lisp_Object newcell = list2 (prop, val);
2220 if (NILP (prev)) 2163 if (NILP (prev))
2221 return newcell; 2164 return newcell;
2222 else 2165 Fsetcdr (XCDR (prev), newcell);
2223 Fsetcdr (XCDR (prev), newcell);
2224 return plist; 2166 return plist;
2225} 2167}
2226 2168
@@ -2293,8 +2235,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2293 } 2235 }
2294 } 2236 }
2295 2237
2238 unsigned short int quit_count = 0;
2296 tail_recurse: 2239 tail_recurse:
2297 QUIT; 2240 rarely_quit (&quit_count);
2298 if (EQ (o1, o2)) 2241 if (EQ (o1, o2))
2299 return 1; 2242 return 1;
2300 if (XTYPE (o1) != XTYPE (o2)) 2243 if (XTYPE (o1) != XTYPE (o2))
@@ -2483,14 +2426,12 @@ Only the last argument is not altered, and need not be a list.
2483usage: (nconc &rest LISTS) */) 2426usage: (nconc &rest LISTS) */)
2484 (ptrdiff_t nargs, Lisp_Object *args) 2427 (ptrdiff_t nargs, Lisp_Object *args)
2485{ 2428{
2486 ptrdiff_t argnum; 2429 unsigned short int quit_count = 0;
2487 register Lisp_Object tail, tem, val; 2430 Lisp_Object val = Qnil;
2488 2431
2489 val = tail = Qnil; 2432 for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
2490
2491 for (argnum = 0; argnum < nargs; argnum++)
2492 { 2433 {
2493 tem = args[argnum]; 2434 Lisp_Object tem = args[argnum];
2494 if (NILP (tem)) continue; 2435 if (NILP (tem)) continue;
2495 2436
2496 if (NILP (val)) 2437 if (NILP (val))
@@ -2498,14 +2439,19 @@ usage: (nconc &rest LISTS) */)
2498 2439
2499 if (argnum + 1 == nargs) break; 2440 if (argnum + 1 == nargs) break;
2500 2441
2501 CHECK_LIST_CONS (tem, tem); 2442 CHECK_CONS (tem);
2502 2443
2503 while (CONSP (tem)) 2444 immediate_quit = true;
2445 Lisp_Object tail;
2446 do
2504 { 2447 {
2505 tail = tem; 2448 tail = tem;
2506 tem = XCDR (tail); 2449 tem = XCDR (tail);
2507 QUIT;
2508 } 2450 }
2451 while (CONSP (tem));
2452
2453 immediate_quit = false;
2454 rarely_quit (&quit_count);
2509 2455
2510 tem = args[argnum + 1]; 2456 tem = args[argnum + 1];
2511 Fsetcdr (tail, tem); 2457 Fsetcdr (tail, tem);
@@ -2927,12 +2873,13 @@ property and a property with the value nil.
2927The value is actually the tail of PLIST whose car is PROP. */) 2873The value is actually the tail of PLIST whose car is PROP. */)
2928 (Lisp_Object plist, Lisp_Object prop) 2874 (Lisp_Object plist, Lisp_Object prop)
2929{ 2875{
2876 immediate_quit = true;
2930 while (CONSP (plist) && !EQ (XCAR (plist), prop)) 2877 while (CONSP (plist) && !EQ (XCAR (plist), prop))
2931 { 2878 {
2932 plist = XCDR (plist); 2879 plist = XCDR (plist);
2933 plist = CDR (plist); 2880 plist = CDR (plist);
2934 QUIT;
2935 } 2881 }
2882 immediate_quit = false;
2936 return plist; 2883 return plist;
2937} 2884}
2938 2885
@@ -3804,12 +3751,17 @@ allocate_hash_table (void)
3804 (table size) is >= REHASH_THRESHOLD. 3751 (table size) is >= REHASH_THRESHOLD.
3805 3752
3806 WEAK specifies the weakness of the table. If non-nil, it must be 3753 WEAK specifies the weakness of the table. If non-nil, it must be
3807 one of the symbols `key', `value', `key-or-value', or `key-and-value'. */ 3754 one of the symbols `key', `value', `key-or-value', or `key-and-value'.
3755
3756 If PURECOPY is non-nil, the table can be copied to pure storage via
3757 `purecopy' when Emacs is being dumped. Such tables can no longer be
3758 changed after purecopy. */
3808 3759
3809Lisp_Object 3760Lisp_Object
3810make_hash_table (struct hash_table_test test, 3761make_hash_table (struct hash_table_test test,
3811 Lisp_Object size, Lisp_Object rehash_size, 3762 Lisp_Object size, Lisp_Object rehash_size,
3812 Lisp_Object rehash_threshold, Lisp_Object weak) 3763 Lisp_Object rehash_threshold, Lisp_Object weak,
3764 Lisp_Object pure)
3813{ 3765{
3814 struct Lisp_Hash_Table *h; 3766 struct Lisp_Hash_Table *h;
3815 Lisp_Object table; 3767 Lisp_Object table;
@@ -3850,6 +3802,7 @@ make_hash_table (struct hash_table_test test,
3850 h->hash = Fmake_vector (size, Qnil); 3802 h->hash = Fmake_vector (size, Qnil);
3851 h->next = Fmake_vector (size, Qnil); 3803 h->next = Fmake_vector (size, Qnil);
3852 h->index = Fmake_vector (make_number (index_size), Qnil); 3804 h->index = Fmake_vector (make_number (index_size), Qnil);
3805 h->pure = pure;
3853 3806
3854 /* Set up the free list. */ 3807 /* Set up the free list. */
3855 for (i = 0; i < sz - 1; ++i) 3808 for (i = 0; i < sz - 1; ++i)
@@ -4514,10 +4467,15 @@ key, value, one of key or value, or both key and value, depending on
4514WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK 4467WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
4515is nil. 4468is nil.
4516 4469
4470:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied
4471to pure storage when Emacs is being dumped, making the contents of the
4472table read only. Any further changes to purified tables will result
4473in an error.
4474
4517usage: (make-hash-table &rest KEYWORD-ARGS) */) 4475usage: (make-hash-table &rest KEYWORD-ARGS) */)
4518 (ptrdiff_t nargs, Lisp_Object *args) 4476 (ptrdiff_t nargs, Lisp_Object *args)
4519{ 4477{
4520 Lisp_Object test, size, rehash_size, rehash_threshold, weak; 4478 Lisp_Object test, size, rehash_size, rehash_threshold, weak, pure;
4521 struct hash_table_test testdesc; 4479 struct hash_table_test testdesc;
4522 ptrdiff_t i; 4480 ptrdiff_t i;
4523 USE_SAFE_ALLOCA; 4481 USE_SAFE_ALLOCA;
@@ -4551,6 +4509,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
4551 testdesc.cmpfn = cmpfn_user_defined; 4509 testdesc.cmpfn = cmpfn_user_defined;
4552 } 4510 }
4553 4511
4512 /* See if there's a `:purecopy PURECOPY' argument. */
4513 i = get_key_arg (QCpurecopy, nargs, args, used);
4514 pure = i ? args[i] : Qnil;
4554 /* See if there's a `:size SIZE' argument. */ 4515 /* See if there's a `:size SIZE' argument. */
4555 i = get_key_arg (QCsize, nargs, args, used); 4516 i = get_key_arg (QCsize, nargs, args, used);
4556 size = i ? args[i] : Qnil; 4517 size = i ? args[i] : Qnil;
@@ -4592,7 +4553,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
4592 signal_error ("Invalid argument list", args[i]); 4553 signal_error ("Invalid argument list", args[i]);
4593 4554
4594 SAFE_FREE (); 4555 SAFE_FREE ();
4595 return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak); 4556 return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
4557 pure);
4596} 4558}
4597 4559
4598 4560
@@ -4671,7 +4633,9 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
4671 doc: /* Clear hash table TABLE and return it. */) 4633 doc: /* Clear hash table TABLE and return it. */)
4672 (Lisp_Object table) 4634 (Lisp_Object table)
4673{ 4635{
4674 hash_clear (check_hash_table (table)); 4636 struct Lisp_Hash_Table *h = check_hash_table (table);
4637 CHECK_IMPURE (table, h);
4638 hash_clear (h);
4675 /* Be compatible with XEmacs. */ 4639 /* Be compatible with XEmacs. */
4676 return table; 4640 return table;
4677} 4641}
@@ -4695,9 +4659,10 @@ VALUE. In any case, return VALUE. */)
4695 (Lisp_Object key, Lisp_Object value, Lisp_Object table) 4659 (Lisp_Object key, Lisp_Object value, Lisp_Object table)
4696{ 4660{
4697 struct Lisp_Hash_Table *h = check_hash_table (table); 4661 struct Lisp_Hash_Table *h = check_hash_table (table);
4662 CHECK_IMPURE (table, h);
4663
4698 ptrdiff_t i; 4664 ptrdiff_t i;
4699 EMACS_UINT hash; 4665 EMACS_UINT hash;
4700
4701 i = hash_lookup (h, key, &hash); 4666 i = hash_lookup (h, key, &hash);
4702 if (i >= 0) 4667 if (i >= 0)
4703 set_hash_value_slot (h, i, value); 4668 set_hash_value_slot (h, i, value);
@@ -4713,6 +4678,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
4713 (Lisp_Object key, Lisp_Object table) 4678 (Lisp_Object key, Lisp_Object table)
4714{ 4679{
4715 struct Lisp_Hash_Table *h = check_hash_table (table); 4680 struct Lisp_Hash_Table *h = check_hash_table (table);
4681 CHECK_IMPURE (table, h);
4716 hash_remove_from_table (h, key); 4682 hash_remove_from_table (h, key);
4717 return Qnil; 4683 return Qnil;
4718} 4684}
@@ -5083,6 +5049,7 @@ syms_of_fns (void)
5083 DEFSYM (Qequal, "equal"); 5049 DEFSYM (Qequal, "equal");
5084 DEFSYM (QCtest, ":test"); 5050 DEFSYM (QCtest, ":test");
5085 DEFSYM (QCsize, ":size"); 5051 DEFSYM (QCsize, ":size");
5052 DEFSYM (QCpurecopy, ":purecopy");
5086 DEFSYM (QCrehash_size, ":rehash-size"); 5053 DEFSYM (QCrehash_size, ":rehash-size");
5087 DEFSYM (QCrehash_threshold, ":rehash-threshold"); 5054 DEFSYM (QCrehash_threshold, ":rehash-threshold");
5088 DEFSYM (QCweakness, ":weakness"); 5055 DEFSYM (QCweakness, ":weakness");
diff --git a/src/fontset.c b/src/fontset.c
index 33d1d24e5b3..850558b08a0 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1677,11 +1677,10 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
1677`set-fontset-font' for the meaning. */) 1677`set-fontset-font' for the meaning. */)
1678 (Lisp_Object name, Lisp_Object fontlist) 1678 (Lisp_Object name, Lisp_Object fontlist)
1679{ 1679{
1680 Lisp_Object fontset; 1680 Lisp_Object fontset, tail;
1681 int id; 1681 int id;
1682 1682
1683 CHECK_STRING (name); 1683 CHECK_STRING (name);
1684 CHECK_LIST (fontlist);
1685 1684
1686 name = Fdowncase (name); 1685 name = Fdowncase (name);
1687 id = fs_query_fontset (name, 0); 1686 id = fs_query_fontset (name, 0);
@@ -1714,11 +1713,11 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
1714 Fset_char_table_range (fontset, Qt, Qnil); 1713 Fset_char_table_range (fontset, Qt, Qnil);
1715 } 1714 }
1716 1715
1717 for (; CONSP (fontlist); fontlist = XCDR (fontlist)) 1716 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
1718 { 1717 {
1719 Lisp_Object elt, script; 1718 Lisp_Object elt, script;
1720 1719
1721 elt = XCAR (fontlist); 1720 elt = XCAR (tail);
1722 script = Fcar (elt); 1721 script = Fcar (elt);
1723 elt = Fcdr (elt); 1722 elt = Fcdr (elt);
1724 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt)))) 1723 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
@@ -1727,6 +1726,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
1727 else 1726 else
1728 Fset_fontset_font (name, script, elt, Qnil, Qappend); 1727 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1729 } 1728 }
1729 CHECK_LIST_END (tail, fontlist);
1730 return name; 1730 return name;
1731} 1731}
1732 1732
diff --git a/src/frame.c b/src/frame.c
index 2c2c1e150d4..d0f653fc762 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -2691,9 +2691,7 @@ list, but are otherwise ignored. */)
2691 (Lisp_Object frame, Lisp_Object alist) 2691 (Lisp_Object frame, Lisp_Object alist)
2692{ 2692{
2693 struct frame *f = decode_live_frame (frame); 2693 struct frame *f = decode_live_frame (frame);
2694 register Lisp_Object prop, val; 2694 Lisp_Object prop, val;
2695
2696 CHECK_LIST (alist);
2697 2695
2698 /* I think this should be done with a hook. */ 2696 /* I think this should be done with a hook. */
2699#ifdef HAVE_WINDOW_SYSTEM 2697#ifdef HAVE_WINDOW_SYSTEM
@@ -3142,6 +3140,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3142 3140
3143 for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail)) 3141 for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
3144 size++; 3142 size++;
3143 CHECK_LIST_END (tail, alist);
3145 3144
3146 USE_SAFE_ALLOCA; 3145 USE_SAFE_ALLOCA;
3147 SAFE_ALLOCA_LISP (parms, 2 * size); 3146 SAFE_ALLOCA_LISP (parms, 2 * size);
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index 6ec5c642825..285a253733d 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -178,20 +178,18 @@ will be reported only in case of the `moved' event. */)
178 if (NILP (Ffile_exists_p (file))) 178 if (NILP (Ffile_exists_p (file)))
179 report_file_error ("File does not exist", file); 179 report_file_error ("File does not exist", file);
180 180
181 CHECK_LIST (flags);
182
183 if (!FUNCTIONP (callback)) 181 if (!FUNCTIONP (callback))
184 wrong_type_argument (Qinvalid_function, callback); 182 wrong_type_argument (Qinvalid_function, callback);
185 183
186 /* Create GFile name. */
187 gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
188
189 /* Assemble flags. */ 184 /* Assemble flags. */
190 if (!NILP (Fmember (Qwatch_mounts, flags))) 185 if (!NILP (Fmember (Qwatch_mounts, flags)))
191 gflags |= G_FILE_MONITOR_WATCH_MOUNTS; 186 gflags |= G_FILE_MONITOR_WATCH_MOUNTS;
192 if (!NILP (Fmember (Qsend_moved, flags))) 187 if (!NILP (Fmember (Qsend_moved, flags)))
193 gflags |= G_FILE_MONITOR_SEND_MOVED; 188 gflags |= G_FILE_MONITOR_SEND_MOVED;
194 189
190 /* Create GFile name. */
191 gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
192
195 /* Enable watch. */ 193 /* Enable watch. */
196 monitor = g_file_monitor (gfile, gflags, NULL, &gerror); 194 monitor = g_file_monitor (gfile, gflags, NULL, &gerror);
197 g_object_unref (gfile); 195 g_object_unref (gfile);
diff --git a/src/gnutls.c b/src/gnutls.c
index 735d2e35810..d0d7f2dfc84 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -390,7 +390,7 @@ gnutls_try_handshake (struct Lisp_Process *proc)
390 { 390 {
391 ret = gnutls_handshake (state); 391 ret = gnutls_handshake (state);
392 emacs_gnutls_handle_error (state, ret); 392 emacs_gnutls_handle_error (state, ret);
393 QUIT; 393 maybe_quit ();
394 } 394 }
395 while (ret < 0 395 while (ret < 0
396 && gnutls_error_is_fatal (ret) == 0 396 && gnutls_error_is_fatal (ret) == 0
@@ -582,8 +582,17 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
582 582
583 if (gnutls_error_is_fatal (err)) 583 if (gnutls_error_is_fatal (err))
584 { 584 {
585 int level = 1;
586 /* Mostly ignore "The TLS connection was non-properly
587 terminated" message which just means that the peer closed the
588 connection. */
589#ifdef HAVE_GNUTLS3
590 if (err == GNUTLS_E_PREMATURE_TERMINATION)
591 level = 3;
592#endif
593
594 GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
585 ret = 0; 595 ret = 0;
586 GNUTLS_LOG2 (1, max_log_level, "fatal error:", str);
587 } 596 }
588 else 597 else
589 { 598 {
diff --git a/src/image.c b/src/image.c
index 39677d2add9..ad0143be48b 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4020,7 +4020,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int,
4020 return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE), 4020 return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
4021 make_float (DEFAULT_REHASH_SIZE), 4021 make_float (DEFAULT_REHASH_SIZE),
4022 make_float (DEFAULT_REHASH_THRESHOLD), 4022 make_float (DEFAULT_REHASH_THRESHOLD),
4023 Qnil); 4023 Qnil, Qnil);
4024} 4024}
4025 4025
4026static void 4026static void
diff --git a/src/indent.c b/src/indent.c
index 34449955a6c..23951a16eb6 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,8 +1200,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1200 continuation_glyph_width = 0; /* In the fringe. */ 1200 continuation_glyph_width = 0; /* In the fringe. */
1201#endif 1201#endif
1202 1202
1203 immediate_quit = 1; 1203 immediate_quit = true;
1204 QUIT; 1204 maybe_quit ();
1205 1205
1206 /* It's just impossible to be too paranoid here. */ 1206 /* It's just impossible to be too paranoid here. */
1207 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); 1207 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
@@ -1694,7 +1694,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1694 /* Nonzero if have just continued a line */ 1694 /* Nonzero if have just continued a line */
1695 val_compute_motion.contin = (contin_hpos && prev_hpos == 0); 1695 val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
1696 1696
1697 immediate_quit = 0; 1697 immediate_quit = false;
1698 return &val_compute_motion; 1698 return &val_compute_motion;
1699} 1699}
1700 1700
diff --git a/src/insdel.c b/src/insdel.c
index b93606ced85..3f933b0ad85 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -129,7 +129,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
129 Change BYTEPOS to be where we have actually moved the gap to. 129 Change BYTEPOS to be where we have actually moved the gap to.
130 Note that this cannot happen when we are called to make the 130 Note that this cannot happen when we are called to make the
131 gap larger or smaller, since make_gap_larger and 131 gap larger or smaller, since make_gap_larger and
132 make_gap_smaller prevent QUIT by setting inhibit-quit. */ 132 make_gap_smaller set inhibit-quit. */
133 if (QUITP) 133 if (QUITP)
134 { 134 {
135 bytepos = new_s1; 135 bytepos = new_s1;
@@ -151,7 +151,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
151 GPT = charpos; 151 GPT = charpos;
152 eassert (charpos <= bytepos); 152 eassert (charpos <= bytepos);
153 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ 153 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
154 QUIT; 154 maybe_quit ();
155} 155}
156 156
157/* Move the gap to a position greater than the current GPT. 157/* Move the gap to a position greater than the current GPT.
@@ -185,7 +185,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
185 Change BYTEPOS to be where we have actually moved the gap to. 185 Change BYTEPOS to be where we have actually moved the gap to.
186 Note that this cannot happen when we are called to make the 186 Note that this cannot happen when we are called to make the
187 gap larger or smaller, since make_gap_larger and 187 gap larger or smaller, since make_gap_larger and
188 make_gap_smaller prevent QUIT by setting inhibit-quit. */ 188 make_gap_smaller set inhibit-quit. */
189 if (QUITP) 189 if (QUITP)
190 { 190 {
191 bytepos = new_s1; 191 bytepos = new_s1;
@@ -204,7 +204,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
204 GPT_BYTE = bytepos; 204 GPT_BYTE = bytepos;
205 eassert (charpos <= bytepos); 205 eassert (charpos <= bytepos);
206 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ 206 if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
207 QUIT; 207 maybe_quit ();
208} 208}
209 209
210/* If the selected window's old pointm is adjacent or covered by the 210/* If the selected window's old pointm is adjacent or covered by the
@@ -464,7 +464,7 @@ make_gap_larger (ptrdiff_t nbytes_added)
464 464
465 enlarge_buffer_text (current_buffer, nbytes_added); 465 enlarge_buffer_text (current_buffer, nbytes_added);
466 466
467 /* Prevent quitting in gap_left. We cannot allow a QUIT there, 467 /* Prevent quitting in gap_left. We cannot allow a quit there,
468 because that would leave the buffer text in an inconsistent 468 because that would leave the buffer text in an inconsistent
469 state, with 2 gap holes instead of just one. */ 469 state, with 2 gap holes instead of just one. */
470 tem = Vinhibit_quit; 470 tem = Vinhibit_quit;
@@ -512,7 +512,7 @@ make_gap_smaller (ptrdiff_t nbytes_removed)
512 if (GAP_SIZE - nbytes_removed < GAP_BYTES_MIN) 512 if (GAP_SIZE - nbytes_removed < GAP_BYTES_MIN)
513 nbytes_removed = GAP_SIZE - GAP_BYTES_MIN; 513 nbytes_removed = GAP_SIZE - GAP_BYTES_MIN;
514 514
515 /* Prevent quitting in gap_right. We cannot allow a QUIT there, 515 /* Prevent quitting in gap_right. We cannot allow a quit there,
516 because that would leave the buffer text in an inconsistent 516 because that would leave the buffer text in an inconsistent
517 state, with 2 gap holes instead of just one. */ 517 state, with 2 gap holes instead of just one. */
518 tem = Vinhibit_quit; 518 tem = Vinhibit_quit;
diff --git a/src/keyboard.c b/src/keyboard.c
index 6aad0acc656..d41603b2e50 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -87,7 +87,7 @@ char const DEV_TTY[] = "/dev/tty";
87volatile int interrupt_input_blocked; 87volatile int interrupt_input_blocked;
88 88
89/* True means an input interrupt or alarm signal has arrived. 89/* True means an input interrupt or alarm signal has arrived.
90 The QUIT macro checks this. */ 90 The maybe_quit function checks this. */
91volatile bool pending_signals; 91volatile bool pending_signals;
92 92
93#define KBD_BUFFER_SIZE 4096 93#define KBD_BUFFER_SIZE 4096
@@ -1416,7 +1416,7 @@ command_loop_1 (void)
1416 if (!NILP (Vquit_flag)) 1416 if (!NILP (Vquit_flag))
1417 { 1417 {
1418 Vexecuting_kbd_macro = Qt; 1418 Vexecuting_kbd_macro = Qt;
1419 QUIT; /* Make some noise. */ 1419 maybe_quit (); /* Make some noise. */
1420 /* Will return since macro now empty. */ 1420 /* Will return since macro now empty. */
1421 } 1421 }
1422 } 1422 }
@@ -3591,7 +3591,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
3591 if (immediate_quit && NILP (Vinhibit_quit)) 3591 if (immediate_quit && NILP (Vinhibit_quit))
3592 { 3592 {
3593 immediate_quit = false; 3593 immediate_quit = false;
3594 QUIT; 3594 maybe_quit ();
3595 } 3595 }
3596 } 3596 }
3597} 3597}
@@ -7426,7 +7426,7 @@ menu_bar_items (Lisp_Object old)
7426 USE_SAFE_ALLOCA; 7426 USE_SAFE_ALLOCA;
7427 7427
7428 /* In order to build the menus, we need to call the keymap 7428 /* In order to build the menus, we need to call the keymap
7429 accessors. They all call QUIT. But this function is called 7429 accessors. They all call maybe_quit. But this function is called
7430 during redisplay, during which a quit is fatal. So inhibit 7430 during redisplay, during which a quit is fatal. So inhibit
7431 quitting while building the menus. 7431 quitting while building the menus.
7432 We do this instead of specbind because (1) errors will clear it anyway 7432 We do this instead of specbind because (1) errors will clear it anyway
@@ -7987,7 +7987,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems)
7987 *nitems = 0; 7987 *nitems = 0;
7988 7988
7989 /* In order to build the menus, we need to call the keymap 7989 /* In order to build the menus, we need to call the keymap
7990 accessors. They all call QUIT. But this function is called 7990 accessors. They all call maybe_quit. But this function is called
7991 during redisplay, during which a quit is fatal. So inhibit 7991 during redisplay, during which a quit is fatal. So inhibit
7992 quitting while building the menus. We do this instead of 7992 quitting while building the menus. We do this instead of
7993 specbind because (1) errors will clear it anyway and (2) this 7993 specbind because (1) errors will clear it anyway and (2) this
@@ -9806,7 +9806,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9806 9806
9807 if (!NILP (prompt)) 9807 if (!NILP (prompt))
9808 CHECK_STRING (prompt); 9808 CHECK_STRING (prompt);
9809 QUIT; 9809 maybe_quit ();
9810 9810
9811 specbind (Qinput_method_exit_on_first_char, 9811 specbind (Qinput_method_exit_on_first_char,
9812 (NILP (cmd_loop) ? Qt : Qnil)); 9812 (NILP (cmd_loop) ? Qt : Qnil));
@@ -9840,7 +9840,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9840 if (i == -1) 9840 if (i == -1)
9841 { 9841 {
9842 Vquit_flag = Qt; 9842 Vquit_flag = Qt;
9843 QUIT; 9843 maybe_quit ();
9844 } 9844 }
9845 9845
9846 return unbind_to (count, 9846 return unbind_to (count,
@@ -10278,7 +10278,7 @@ clear_waiting_for_input (void)
10278 10278
10279 If we have a frame on the controlling tty, we assume that the 10279 If we have a frame on the controlling tty, we assume that the
10280 SIGINT was generated by C-g, so we call handle_interrupt. 10280 SIGINT was generated by C-g, so we call handle_interrupt.
10281 Otherwise, tell QUIT to kill Emacs. */ 10281 Otherwise, tell maybe_quit to kill Emacs. */
10282 10282
10283static void 10283static void
10284handle_interrupt_signal (int sig) 10284handle_interrupt_signal (int sig)
@@ -10289,7 +10289,7 @@ handle_interrupt_signal (int sig)
10289 { 10289 {
10290 /* If there are no frames there, let's pretend that we are a 10290 /* If there are no frames there, let's pretend that we are a
10291 well-behaving UN*X program and quit. We must not call Lisp 10291 well-behaving UN*X program and quit. We must not call Lisp
10292 in a signal handler, so tell QUIT to exit when it is 10292 in a signal handler, so tell maybe_quit to exit when it is
10293 safe. */ 10293 safe. */
10294 Vquit_flag = Qkill_emacs; 10294 Vquit_flag = Qkill_emacs;
10295 } 10295 }
diff --git a/src/keyboard.h b/src/keyboard.h
index 7cd41ae55b6..2219c011352 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -486,6 +486,8 @@ extern bool kbd_buffer_events_waiting (void);
486extern void add_user_signal (int, const char *); 486extern void add_user_signal (int, const char *);
487 487
488extern int tty_read_avail_input (struct terminal *, struct input_event *); 488extern int tty_read_avail_input (struct terminal *, struct input_event *);
489extern bool volatile pending_signals;
490extern void process_pending_signals (void);
489extern struct timespec timer_check (void); 491extern struct timespec timer_check (void);
490extern void mark_kboards (void); 492extern void mark_kboards (void);
491 493
diff --git a/src/keymap.c b/src/keymap.c
index 9e759478518..9caf55f98fb 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -523,7 +523,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
523 retval = Fcons (Qkeymap, Fcons (retval, retval_tail)); 523 retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
524 } 524 }
525 } 525 }
526 QUIT; 526 maybe_quit ();
527 } 527 }
528 528
529 return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval; 529 return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
@@ -877,7 +877,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
877 should be inserted before it. */ 877 should be inserted before it. */
878 goto keymap_end; 878 goto keymap_end;
879 879
880 QUIT; 880 maybe_quit ();
881 } 881 }
882 882
883 keymap_end: 883 keymap_end:
@@ -1250,7 +1250,7 @@ recognize the default bindings, just as `read-key-sequence' does. */)
1250 if (!CONSP (keymap)) 1250 if (!CONSP (keymap))
1251 return make_number (idx); 1251 return make_number (idx);
1252 1252
1253 QUIT; 1253 maybe_quit ();
1254 } 1254 }
1255} 1255}
1256 1256
@@ -2466,7 +2466,7 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2466 non-ascii prefixes like `C-down-mouse-2'. */ 2466 non-ascii prefixes like `C-down-mouse-2'. */
2467 continue; 2467 continue;
2468 2468
2469 QUIT; 2469 maybe_quit ();
2470 2470
2471 data.definition = definition; 2471 data.definition = definition;
2472 data.noindirect = noindirect; 2472 data.noindirect = noindirect;
@@ -3173,7 +3173,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
3173 3173
3174 for (tail = map; CONSP (tail); tail = XCDR (tail)) 3174 for (tail = map; CONSP (tail); tail = XCDR (tail))
3175 { 3175 {
3176 QUIT; 3176 maybe_quit ();
3177 3177
3178 if (VECTORP (XCAR (tail)) 3178 if (VECTORP (XCAR (tail))
3179 || CHAR_TABLE_P (XCAR (tail))) 3179 || CHAR_TABLE_P (XCAR (tail)))
@@ -3426,7 +3426,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3426 int range_beg, range_end; 3426 int range_beg, range_end;
3427 Lisp_Object val; 3427 Lisp_Object val;
3428 3428
3429 QUIT; 3429 maybe_quit ();
3430 3430
3431 if (i == stop) 3431 if (i == stop)
3432 { 3432 {
diff --git a/src/lisp.h b/src/lisp.h
index e7747563085..91c430fe98d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -310,7 +310,6 @@ error !;
310# define lisp_h_XLI(o) (o) 310# define lisp_h_XLI(o) (o)
311# define lisp_h_XIL(i) (i) 311# define lisp_h_XIL(i) (i)
312#endif 312#endif
313#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y)
314#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) 313#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
315#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) 314#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
316#define lisp_h_CHECK_TYPE(ok, predicate, x) \ 315#define lisp_h_CHECK_TYPE(ok, predicate, x) \
@@ -367,7 +366,6 @@ error !;
367#if DEFINE_KEY_OPS_AS_MACROS 366#if DEFINE_KEY_OPS_AS_MACROS
368# define XLI(o) lisp_h_XLI (o) 367# define XLI(o) lisp_h_XLI (o)
369# define XIL(i) lisp_h_XIL (i) 368# define XIL(i) lisp_h_XIL (i)
370# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
371# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) 369# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
372# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) 370# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
373# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) 371# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
@@ -1997,6 +1995,10 @@ struct Lisp_Hash_Table
1997 hash table size to reduce collisions. */ 1995 hash table size to reduce collisions. */
1998 Lisp_Object index; 1996 Lisp_Object index;
1999 1997
1998 /* Non-nil if the table can be purecopied. Any changes the table after
1999 purecopy will result in an error. */
2000 Lisp_Object pure;
2001
2000 /* Only the fields above are traced normally by the GC. The ones below 2002 /* Only the fields above are traced normally by the GC. The ones below
2001 `count' are special and are either ignored by the GC or traced in 2003 `count' are special and are either ignored by the GC or traced in
2002 a special way (e.g. because of weakness). */ 2004 a special way (e.g. because of weakness). */
@@ -2751,9 +2753,9 @@ CHECK_LIST (Lisp_Object x)
2751} 2753}
2752 2754
2753INLINE void 2755INLINE void
2754(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) 2756CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
2755{ 2757{
2756 lisp_h_CHECK_LIST_CONS (x, y); 2758 CHECK_TYPE (NILP (x), Qlistp, y);
2757} 2759}
2758 2760
2759INLINE void 2761INLINE void
@@ -3121,34 +3123,25 @@ struct handler
3121 3123
3122extern Lisp_Object memory_signal_data; 3124extern Lisp_Object memory_signal_data;
3123 3125
3124/* Check quit-flag and quit if it is non-nil. 3126/* Check quit-flag and quit if it is non-nil. Typing C-g does not
3125 Typing C-g does not directly cause a quit; it only sets Vquit_flag. 3127 directly cause a quit; it only sets Vquit_flag. So the program
3126 So the program needs to do QUIT at times when it is safe to quit. 3128 needs to call maybe_quit at times when it is safe to quit. Every
3127 Every loop that might run for a long time or might not exit 3129 loop that might run for a long time or might not exit ought to call
3128 ought to do QUIT at least once, at a safe place. 3130 maybe_quit at least once, at a safe place. Unless that is
3129 Unless that is impossible, of course. 3131 impossible, of course. But it is very desirable to avoid creating
3130 But it is very desirable to avoid creating loops where QUIT is impossible. 3132 loops where maybe_quit is impossible.
3131 3133
3132 Exception: if you set immediate_quit to true, 3134 Exception: if you set immediate_quit, the handler that responds to
3133 then the handler that responds to the C-g does the quit itself. 3135 the C-g does the quit itself. This is a good thing to do around a
3134 This is a good thing to do around a loop that has no side effects 3136 loop that has no side effects and (in particular) cannot call
3135 and (in particular) cannot call arbitrary Lisp code. 3137 arbitrary Lisp code.
3136 3138
3137 If quit-flag is set to `kill-emacs' the SIGINT handler has received 3139 If quit-flag is set to `kill-emacs' the SIGINT handler has received
3138 a request to exit Emacs when it is safe to do. */ 3140 a request to exit Emacs when it is safe to do.
3139
3140extern void process_pending_signals (void);
3141extern bool volatile pending_signals;
3142 3141
3143extern void process_quit_flag (void); 3142 When not quitting, process any pending signals. */
3144#define QUIT \
3145 do { \
3146 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
3147 process_quit_flag (); \
3148 else if (pending_signals) \
3149 process_pending_signals (); \
3150 } while (false)
3151 3143
3144extern void maybe_quit (void);
3152 3145
3153/* True if ought to quit now. */ 3146/* True if ought to quit now. */
3154 3147
@@ -3375,7 +3368,7 @@ extern void sweep_weak_hash_tables (void);
3375EMACS_UINT hash_string (char const *, ptrdiff_t); 3368EMACS_UINT hash_string (char const *, ptrdiff_t);
3376EMACS_UINT sxhash (Lisp_Object, int); 3369EMACS_UINT sxhash (Lisp_Object, int);
3377Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, 3370Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
3378 Lisp_Object, Lisp_Object); 3371 Lisp_Object, Lisp_Object, Lisp_Object);
3379ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); 3372ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
3380ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, 3373ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
3381 EMACS_UINT); 3374 EMACS_UINT);
diff --git a/src/lread.c b/src/lread.c
index 284fd1aafbc..17806922a8c 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -451,7 +451,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
451 while (c == EOF && ferror (instream) && errno == EINTR) 451 while (c == EOF && ferror (instream) && errno == EINTR)
452 { 452 {
453 unblock_input (); 453 unblock_input ();
454 QUIT; 454 maybe_quit ();
455 block_input (); 455 block_input ();
456 clearerr (instream); 456 clearerr (instream);
457 c = getc (instream); 457 c = getc (instream);
@@ -1702,14 +1702,14 @@ build_load_history (Lisp_Object filename, bool entire)
1702 Fcons (newelt, XCDR (tem)))); 1702 Fcons (newelt, XCDR (tem))));
1703 1703
1704 tem2 = XCDR (tem2); 1704 tem2 = XCDR (tem2);
1705 QUIT; 1705 maybe_quit ();
1706 } 1706 }
1707 } 1707 }
1708 } 1708 }
1709 else 1709 else
1710 prev = tail; 1710 prev = tail;
1711 tail = XCDR (tail); 1711 tail = XCDR (tail);
1712 QUIT; 1712 maybe_quit ();
1713 } 1713 }
1714 1714
1715 /* If we're loading an entire file, cons the new assoc onto the 1715 /* If we're loading an entire file, cons the new assoc onto the
@@ -2599,7 +2599,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2599 Lisp_Object val = Qnil; 2599 Lisp_Object val = Qnil;
2600 /* The size is 2 * number of allowed keywords to 2600 /* The size is 2 * number of allowed keywords to
2601 make-hash-table. */ 2601 make-hash-table. */
2602 Lisp_Object params[10]; 2602 Lisp_Object params[12];
2603 Lisp_Object ht; 2603 Lisp_Object ht;
2604 Lisp_Object key = Qnil; 2604 Lisp_Object key = Qnil;
2605 int param_count = 0; 2605 int param_count = 0;
@@ -2636,6 +2636,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2636 if (!NILP (params[param_count + 1])) 2636 if (!NILP (params[param_count + 1]))
2637 param_count += 2; 2637 param_count += 2;
2638 2638
2639 params[param_count] = QCpurecopy;
2640 params[param_count + 1] = Fplist_get (tmp, Qpurecopy);
2641 if (!NILP (params[param_count + 1]))
2642 param_count += 2;
2643
2639 /* This is the hash table data. */ 2644 /* This is the hash table data. */
2640 data = Fplist_get (tmp, Qdata); 2645 data = Fplist_get (tmp, Qdata);
2641 2646
@@ -4849,6 +4854,7 @@ that are loaded before your customizations are read! */);
4849 DEFSYM (Qdata, "data"); 4854 DEFSYM (Qdata, "data");
4850 DEFSYM (Qtest, "test"); 4855 DEFSYM (Qtest, "test");
4851 DEFSYM (Qsize, "size"); 4856 DEFSYM (Qsize, "size");
4857 DEFSYM (Qpurecopy, "purecopy");
4852 DEFSYM (Qweakness, "weakness"); 4858 DEFSYM (Qweakness, "weakness");
4853 DEFSYM (Qrehash_size, "rehash-size"); 4859 DEFSYM (Qrehash_size, "rehash-size");
4854 DEFSYM (Qrehash_threshold, "rehash-threshold"); 4860 DEFSYM (Qrehash_threshold, "rehash-threshold");
diff --git a/src/macros.c b/src/macros.c
index 3b29cc67cf8..f0ffda3f441 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -325,7 +325,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
325 325
326 executing_kbd_macro_iterations = ++success_count; 326 executing_kbd_macro_iterations = ++success_count;
327 327
328 QUIT; 328 maybe_quit ();
329 } 329 }
330 while (--repeat 330 while (--repeat
331 && (STRINGP (Vexecuting_kbd_macro) || VECTORP (Vexecuting_kbd_macro))); 331 && (STRINGP (Vexecuting_kbd_macro) || VECTORP (Vexecuting_kbd_macro)));
diff --git a/src/minibuf.c b/src/minibuf.c
index d44bb44baee..1bbe276776e 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1865,7 +1865,7 @@ single string, rather than a cons cell whose car is a string. */)
1865 case_fold); 1865 case_fold);
1866 if (EQ (tem, Qt)) 1866 if (EQ (tem, Qt))
1867 return elt; 1867 return elt;
1868 QUIT; 1868 maybe_quit ();
1869 } 1869 }
1870 return Qnil; 1870 return Qnil;
1871} 1871}
diff --git a/src/print.c b/src/print.c
index dfaa489a98d..db3d00f51f2 100644
--- a/src/print.c
+++ b/src/print.c
@@ -279,7 +279,7 @@ printchar (unsigned int ch, Lisp_Object fun)
279 unsigned char str[MAX_MULTIBYTE_LENGTH]; 279 unsigned char str[MAX_MULTIBYTE_LENGTH];
280 int len = CHAR_STRING (ch, str); 280 int len = CHAR_STRING (ch, str);
281 281
282 QUIT; 282 maybe_quit ();
283 283
284 if (NILP (fun)) 284 if (NILP (fun))
285 { 285 {
@@ -1352,7 +1352,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1352 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t), 1352 max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
1353 40))]; 1353 40))];
1354 1354
1355 QUIT; 1355 maybe_quit ();
1356 1356
1357 /* Detect circularities and truncate them. */ 1357 /* Detect circularities and truncate them. */
1358 if (NILP (Vprint_circle)) 1358 if (NILP (Vprint_circle))
@@ -1446,7 +1446,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1446 1446
1447 FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte); 1447 FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
1448 1448
1449 QUIT; 1449 maybe_quit ();
1450 1450
1451 if (multibyte 1451 if (multibyte
1452 ? (CHAR_BYTE8_P (c) && (c = CHAR_TO_BYTE8 (c), true)) 1452 ? (CHAR_BYTE8_P (c) && (c = CHAR_TO_BYTE8 (c), true))
@@ -1550,7 +1550,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1550 /* Here, we must convert each multi-byte form to the 1550 /* Here, we must convert each multi-byte form to the
1551 corresponding character code before handing it to PRINTCHAR. */ 1551 corresponding character code before handing it to PRINTCHAR. */
1552 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte); 1552 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1553 QUIT; 1553 maybe_quit ();
1554 1554
1555 if (escapeflag) 1555 if (escapeflag)
1556 { 1556 {
@@ -1707,7 +1707,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1707 1707
1708 for (i = 0; i < size_in_chars; i++) 1708 for (i = 0; i < size_in_chars; i++)
1709 { 1709 {
1710 QUIT; 1710 maybe_quit ();
1711 c = bool_vector_uchar_data (obj)[i]; 1711 c = bool_vector_uchar_data (obj)[i];
1712 if (c == '\n' && print_escape_newlines) 1712 if (c == '\n' && print_escape_newlines)
1713 print_c_string ("\\n", printcharfun); 1713 print_c_string ("\\n", printcharfun);
@@ -1818,6 +1818,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1818 print_object (h->rehash_threshold, printcharfun, escapeflag); 1818 print_object (h->rehash_threshold, printcharfun, escapeflag);
1819 } 1819 }
1820 1820
1821 if (!NILP (h->pure))
1822 {
1823 print_c_string (" purecopy ", printcharfun);
1824 print_object (h->pure, printcharfun, escapeflag);
1825 }
1826
1821 print_c_string (" data ", printcharfun); 1827 print_c_string (" data ", printcharfun);
1822 1828
1823 /* Print the data here as a plist. */ 1829 /* Print the data here as a plist. */
diff --git a/src/process.c b/src/process.c
index ab9657b15a4..dbd4358dd1a 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,8 +3431,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3431 break; 3431 break;
3432 } 3432 }
3433 3433
3434 immediate_quit = 1; 3434 immediate_quit = true;
3435 QUIT; 3435 maybe_quit ();
3436 3436
3437 ret = connect (s, sa, addrlen); 3437 ret = connect (s, sa, addrlen);
3438 xerrno = errno; 3438 xerrno = errno;
@@ -3459,7 +3459,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3459 retry_select: 3459 retry_select:
3460 FD_ZERO (&fdset); 3460 FD_ZERO (&fdset);
3461 FD_SET (s, &fdset); 3461 FD_SET (s, &fdset);
3462 QUIT; 3462 maybe_quit ();
3463 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL); 3463 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3464 if (sc == -1) 3464 if (sc == -1)
3465 { 3465 {
@@ -3481,7 +3481,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3481 } 3481 }
3482#endif /* !WINDOWSNT */ 3482#endif /* !WINDOWSNT */
3483 3483
3484 immediate_quit = 0; 3484 immediate_quit = false;
3485 3485
3486 /* Discard the unwind protect closing S. */ 3486 /* Discard the unwind protect closing S. */
3487 specpdl_ptr = specpdl + count; 3487 specpdl_ptr = specpdl + count;
@@ -3539,7 +3539,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3539#endif 3539#endif
3540 } 3540 }
3541 3541
3542 immediate_quit = 0; 3542 immediate_quit = false;
3543 3543
3544 if (s < 0) 3544 if (s < 0)
3545 { 3545 {
@@ -4012,8 +4012,8 @@ usage: (make-network-process &rest ARGS) */)
4012 struct addrinfo *res, *lres; 4012 struct addrinfo *res, *lres;
4013 int ret; 4013 int ret;
4014 4014
4015 immediate_quit = 1; 4015 immediate_quit = true;
4016 QUIT; 4016 maybe_quit ();
4017 4017
4018 struct addrinfo hints; 4018 struct addrinfo hints;
4019 memset (&hints, 0, sizeof hints); 4019 memset (&hints, 0, sizeof hints);
@@ -4034,7 +4034,7 @@ usage: (make-network-process &rest ARGS) */)
4034#else 4034#else
4035 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); 4035 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4036#endif 4036#endif
4037 immediate_quit = 0; 4037 immediate_quit = false;
4038 4038
4039 for (lres = res; lres; lres = lres->ai_next) 4039 for (lres = res; lres; lres = lres->ai_next)
4040 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); 4040 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
@@ -5020,7 +5020,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
5020 since we want to return C-g as an input character. 5020 since we want to return C-g as an input character.
5021 Otherwise, do pending quit if requested. */ 5021 Otherwise, do pending quit if requested. */
5022 if (read_kbd >= 0) 5022 if (read_kbd >= 0)
5023 QUIT; 5023 maybe_quit ();
5024 else if (pending_signals) 5024 else if (pending_signals)
5025 process_pending_signals (); 5025 process_pending_signals ();
5026 5026
@@ -5748,7 +5748,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
5748 { 5748 {
5749 /* Prevent input_pending from remaining set if we quit. */ 5749 /* Prevent input_pending from remaining set if we quit. */
5750 clear_input_pending (); 5750 clear_input_pending ();
5751 QUIT; 5751 maybe_quit ();
5752 } 5752 }
5753 5753
5754 return got_some_output; 5754 return got_some_output;
@@ -7486,7 +7486,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7486 since we want to return C-g as an input character. 7486 since we want to return C-g as an input character.
7487 Otherwise, do pending quit if requested. */ 7487 Otherwise, do pending quit if requested. */
7488 if (read_kbd >= 0) 7488 if (read_kbd >= 0)
7489 QUIT; 7489 maybe_quit ();
7490 7490
7491 /* Exit now if the cell we're waiting for became non-nil. */ 7491 /* Exit now if the cell we're waiting for became non-nil. */
7492 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 7492 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
diff --git a/src/profiler.c b/src/profiler.c
index efc0cb316fc..a223a7e7c07 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -48,7 +48,7 @@ make_log (EMACS_INT heap_size, EMACS_INT max_stack_depth)
48 make_number (heap_size), 48 make_number (heap_size),
49 make_float (DEFAULT_REHASH_SIZE), 49 make_float (DEFAULT_REHASH_SIZE),
50 make_float (DEFAULT_REHASH_THRESHOLD), 50 make_float (DEFAULT_REHASH_THRESHOLD),
51 Qnil); 51 Qnil, Qnil);
52 struct Lisp_Hash_Table *h = XHASH_TABLE (log); 52 struct Lisp_Hash_Table *h = XHASH_TABLE (log);
53 53
54 /* What is special about our hash-tables is that the keys are pre-filled 54 /* What is special about our hash-tables is that the keys are pre-filled
@@ -174,8 +174,8 @@ record_backtrace (log_t *log, EMACS_INT count)
174 some global flag so that some Elisp code can offload its 174 some global flag so that some Elisp code can offload its
175 data elsewhere, so as to avoid the eviction code. 175 data elsewhere, so as to avoid the eviction code.
176 There are 2 ways to do that, AFAICT: 176 There are 2 ways to do that, AFAICT:
177 - Set a flag checked in QUIT, such that QUIT can then call 177 - Set a flag checked in maybe_quit, such that maybe_quit can then
178 Fprofiler_cpu_log and stash the full log for later use. 178 call Fprofiler_cpu_log and stash the full log for later use.
179 - Set a flag check in post-gc-hook, so that Elisp code can call 179 - Set a flag check in post-gc-hook, so that Elisp code can call
180 profiler-cpu-log. That gives us more flexibility since that 180 profiler-cpu-log. That gives us more flexibility since that
181 Elisp code can then do all kinds of fun stuff like write 181 Elisp code can then do all kinds of fun stuff like write
diff --git a/src/regex.c b/src/regex.c
index db3f0c16a2d..f6e67afef4c 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1729,12 +1729,9 @@ typedef struct
1729/* Explicit quit checking is needed for Emacs, which uses polling to 1729/* Explicit quit checking is needed for Emacs, which uses polling to
1730 process input events. */ 1730 process input events. */
1731#ifdef emacs 1731#ifdef emacs
1732# define IMMEDIATE_QUIT_CHECK \ 1732# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0)
1733 do { \
1734 if (immediate_quit) QUIT; \
1735 } while (0)
1736#else 1733#else
1737# define IMMEDIATE_QUIT_CHECK ((void)0) 1734# define IMMEDIATE_QUIT_CHECK ((void) 0)
1738#endif 1735#endif
1739 1736
1740/* Structure to manage work area for range table. */ 1737/* Structure to manage work area for range table. */
diff --git a/src/search.c b/src/search.c
index d3045108705..f54f44c8818 100644
--- a/src/search.c
+++ b/src/search.c
@@ -276,8 +276,9 @@ looking_at_1 (Lisp_Object string, bool posix)
276 posix, 276 posix,
277 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 277 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
278 278
279 immediate_quit = 1; 279 /* Do a pending quit right away, to avoid paradoxical behavior */
280 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ 280 immediate_quit = true;
281 maybe_quit ();
281 282
282 /* Get pointers and sizes of the two strings 283 /* Get pointers and sizes of the two strings
283 that make up the visible portion of the buffer. */ 284 that make up the visible portion of the buffer. */
@@ -310,7 +311,7 @@ looking_at_1 (Lisp_Object string, bool posix)
310 (NILP (Vinhibit_changing_match_data) 311 (NILP (Vinhibit_changing_match_data)
311 ? &search_regs : NULL), 312 ? &search_regs : NULL),
312 ZV_BYTE - BEGV_BYTE); 313 ZV_BYTE - BEGV_BYTE);
313 immediate_quit = 0; 314 immediate_quit = false;
314#ifdef REL_ALLOC 315#ifdef REL_ALLOC
315 r_alloc_inhibit_buffer_relocation (0); 316 r_alloc_inhibit_buffer_relocation (0);
316#endif 317#endif
@@ -398,7 +399,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
398 ? BVAR (current_buffer, case_canon_table) : Qnil), 399 ? BVAR (current_buffer, case_canon_table) : Qnil),
399 posix, 400 posix,
400 STRING_MULTIBYTE (string)); 401 STRING_MULTIBYTE (string));
401 immediate_quit = 1; 402 immediate_quit = true;
402 re_match_object = string; 403 re_match_object = string;
403 404
404 val = re_search (bufp, SSDATA (string), 405 val = re_search (bufp, SSDATA (string),
@@ -406,7 +407,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
406 SBYTES (string) - pos_byte, 407 SBYTES (string) - pos_byte,
407 (NILP (Vinhibit_changing_match_data) 408 (NILP (Vinhibit_changing_match_data)
408 ? &search_regs : NULL)); 409 ? &search_regs : NULL));
409 immediate_quit = 0; 410 immediate_quit = false;
410 411
411 /* Set last_thing_searched only when match data is changed. */ 412 /* Set last_thing_searched only when match data is changed. */
412 if (NILP (Vinhibit_changing_match_data)) 413 if (NILP (Vinhibit_changing_match_data))
@@ -470,13 +471,13 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string,
470 471
471 bufp = compile_pattern (regexp, 0, table, 472 bufp = compile_pattern (regexp, 0, table,
472 0, STRING_MULTIBYTE (string)); 473 0, STRING_MULTIBYTE (string));
473 immediate_quit = 1; 474 immediate_quit = true;
474 re_match_object = string; 475 re_match_object = string;
475 476
476 val = re_search (bufp, SSDATA (string), 477 val = re_search (bufp, SSDATA (string),
477 SBYTES (string), 0, 478 SBYTES (string), 0,
478 SBYTES (string), 0); 479 SBYTES (string), 0);
479 immediate_quit = 0; 480 immediate_quit = false;
480 return val; 481 return val;
481} 482}
482 483
@@ -497,9 +498,9 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
497 bufp = compile_pattern (regexp, 0, 498 bufp = compile_pattern (regexp, 0,
498 Vascii_canon_table, 0, 499 Vascii_canon_table, 0,
499 0); 500 0);
500 immediate_quit = 1; 501 immediate_quit = true;
501 val = re_search (bufp, string, len, 0, len, 0); 502 val = re_search (bufp, string, len, 0, len, 0);
502 immediate_quit = 0; 503 immediate_quit = false;
503 return val; 504 return val;
504} 505}
505 506
@@ -560,7 +561,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
560 } 561 }
561 562
562 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); 563 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
563 immediate_quit = 1; 564 immediate_quit = true;
564#ifdef REL_ALLOC 565#ifdef REL_ALLOC
565 /* Prevent ralloc.c from relocating the current buffer while 566 /* Prevent ralloc.c from relocating the current buffer while
566 searching it. */ 567 searching it. */
@@ -571,7 +572,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
571#ifdef REL_ALLOC 572#ifdef REL_ALLOC
572 r_alloc_inhibit_buffer_relocation (0); 573 r_alloc_inhibit_buffer_relocation (0);
573#endif 574#endif
574 immediate_quit = 0; 575 immediate_quit = false;
575 576
576 return len; 577 return len;
577} 578}
@@ -703,7 +704,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
703 ptrdiff_t next_change; 704 ptrdiff_t next_change;
704 int result = 1; 705 int result = 1;
705 706
706 immediate_quit = 0; 707 immediate_quit = false;
707 while (start < end && result) 708 while (start < end && result)
708 { 709 {
709 ptrdiff_t lim1; 710 ptrdiff_t lim1;
@@ -809,7 +810,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
809 810
810 if (--count == 0) 811 if (--count == 0)
811 { 812 {
812 immediate_quit = 0; 813 immediate_quit = false;
813 if (bytepos) 814 if (bytepos)
814 *bytepos = lim_byte + next; 815 *bytepos = lim_byte + next;
815 return BYTE_TO_CHAR (lim_byte + next); 816 return BYTE_TO_CHAR (lim_byte + next);
@@ -832,7 +833,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
832 ptrdiff_t next_change; 833 ptrdiff_t next_change;
833 int result = 1; 834 int result = 1;
834 835
835 immediate_quit = 0; 836 immediate_quit = false;
836 while (start > end && result) 837 while (start > end && result)
837 { 838 {
838 ptrdiff_t lim1; 839 ptrdiff_t lim1;
@@ -917,7 +918,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
917 918
918 if (++count >= 0) 919 if (++count >= 0)
919 { 920 {
920 immediate_quit = 0; 921 immediate_quit = false;
921 if (bytepos) 922 if (bytepos)
922 *bytepos = ceiling_byte + prev + 1; 923 *bytepos = ceiling_byte + prev + 1;
923 return BYTE_TO_CHAR (ceiling_byte + prev + 1); 924 return BYTE_TO_CHAR (ceiling_byte + prev + 1);
@@ -929,7 +930,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
929 } 930 }
930 } 931 }
931 932
932 immediate_quit = 0; 933 immediate_quit = false;
933 if (shortage) 934 if (shortage)
934 *shortage = count * direction; 935 *shortage = count * direction;
935 if (bytepos) 936 if (bytepos)
@@ -1196,10 +1197,10 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1196 trt, posix, 1197 trt, posix,
1197 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 1198 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
1198 1199
1199 immediate_quit = 1; /* Quit immediately if user types ^G, 1200 immediate_quit = true; /* Quit immediately if user types ^G,
1200 because letting this function finish 1201 because letting this function finish
1201 can take too long. */ 1202 can take too long. */
1202 QUIT; /* Do a pending quit right away, 1203 maybe_quit (); /* Do a pending quit right away,
1203 to avoid paradoxical behavior */ 1204 to avoid paradoxical behavior */
1204 /* Get pointers and sizes of the two strings 1205 /* Get pointers and sizes of the two strings
1205 that make up the visible portion of the buffer. */ 1206 that make up the visible portion of the buffer. */
@@ -1267,7 +1268,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1267 } 1268 }
1268 else 1269 else
1269 { 1270 {
1270 immediate_quit = 0; 1271 immediate_quit = false;
1271#ifdef REL_ALLOC 1272#ifdef REL_ALLOC
1272 r_alloc_inhibit_buffer_relocation (0); 1273 r_alloc_inhibit_buffer_relocation (0);
1273#endif 1274#endif
@@ -1312,7 +1313,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1312 } 1313 }
1313 else 1314 else
1314 { 1315 {
1315 immediate_quit = 0; 1316 immediate_quit = false;
1316#ifdef REL_ALLOC 1317#ifdef REL_ALLOC
1317 r_alloc_inhibit_buffer_relocation (0); 1318 r_alloc_inhibit_buffer_relocation (0);
1318#endif 1319#endif
@@ -1320,7 +1321,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1320 } 1321 }
1321 n--; 1322 n--;
1322 } 1323 }
1323 immediate_quit = 0; 1324 immediate_quit = false;
1324#ifdef REL_ALLOC 1325#ifdef REL_ALLOC
1325 r_alloc_inhibit_buffer_relocation (0); 1326 r_alloc_inhibit_buffer_relocation (0);
1326#endif 1327#endif
@@ -1927,7 +1928,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
1927 < 0) 1928 < 0)
1928 return (n * (0 - direction)); 1929 return (n * (0 - direction));
1929 /* First we do the part we can by pointers (maybe nothing) */ 1930 /* First we do the part we can by pointers (maybe nothing) */
1930 QUIT; 1931 maybe_quit ();
1931 pat = base_pat; 1932 pat = base_pat;
1932 limit = pos_byte - dirlen + direction; 1933 limit = pos_byte - dirlen + direction;
1933 if (direction > 0) 1934 if (direction > 0)
@@ -3274,7 +3275,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3274 3275
3275 if (--count == 0) 3276 if (--count == 0)
3276 { 3277 {
3277 immediate_quit = 0; 3278 immediate_quit = false;
3278 if (bytepos) 3279 if (bytepos)
3279 *bytepos = lim_byte + next; 3280 *bytepos = lim_byte + next;
3280 return BYTE_TO_CHAR (lim_byte + next); 3281 return BYTE_TO_CHAR (lim_byte + next);
@@ -3286,7 +3287,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3286 } 3287 }
3287 } 3288 }
3288 3289
3289 immediate_quit = 0; 3290 immediate_quit = false;
3290 if (shortage) 3291 if (shortage)
3291 *shortage = count; 3292 *shortage = count;
3292 if (bytepos) 3293 if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index 84147a2dc15..f9e4093765c 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1426,8 +1426,8 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1426 int ch0, ch1; 1426 int ch0, ch1;
1427 Lisp_Object func, pos; 1427 Lisp_Object func, pos;
1428 1428
1429 immediate_quit = 1; 1429 immediate_quit = true;
1430 QUIT; 1430 maybe_quit ();
1431 1431
1432 SETUP_SYNTAX_TABLE (from, count); 1432 SETUP_SYNTAX_TABLE (from, count);
1433 1433
@@ -1437,7 +1437,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1437 { 1437 {
1438 if (from == end) 1438 if (from == end)
1439 { 1439 {
1440 immediate_quit = 0; 1440 immediate_quit = false;
1441 return 0; 1441 return 0;
1442 } 1442 }
1443 UPDATE_SYNTAX_TABLE_FORWARD (from); 1443 UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -1487,7 +1487,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1487 { 1487 {
1488 if (from == beg) 1488 if (from == beg)
1489 { 1489 {
1490 immediate_quit = 0; 1490 immediate_quit = false;
1491 return 0; 1491 return 0;
1492 } 1492 }
1493 DEC_BOTH (from, from_byte); 1493 DEC_BOTH (from, from_byte);
@@ -1536,7 +1536,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1536 count++; 1536 count++;
1537 } 1537 }
1538 1538
1539 immediate_quit = 0; 1539 immediate_quit = false;
1540 1540
1541 return from; 1541 return from;
1542} 1542}
@@ -1921,7 +1921,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1921 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; 1921 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
1922 } 1922 }
1923 1923
1924 immediate_quit = 1; 1924 immediate_quit = true;
1925 /* This code may look up syntax tables using functions that rely on the 1925 /* This code may look up syntax tables using functions that rely on the
1926 gl_state object. To make sure this object is not out of date, 1926 gl_state object. To make sure this object is not out of date,
1927 let's initialize it manually. 1927 let's initialize it manually.
@@ -2064,7 +2064,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2064 } 2064 }
2065 2065
2066 SET_PT_BOTH (pos, pos_byte); 2066 SET_PT_BOTH (pos, pos_byte);
2067 immediate_quit = 0; 2067 immediate_quit = false;
2068 2068
2069 SAFE_FREE (); 2069 SAFE_FREE ();
2070 return make_number (PT - start_point); 2070 return make_number (PT - start_point);
@@ -2138,7 +2138,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2138 ptrdiff_t pos_byte = PT_BYTE; 2138 ptrdiff_t pos_byte = PT_BYTE;
2139 unsigned char *p, *endp, *stop; 2139 unsigned char *p, *endp, *stop;
2140 2140
2141 immediate_quit = 1; 2141 immediate_quit = true;
2142 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); 2142 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
2143 2143
2144 if (forwardp) 2144 if (forwardp)
@@ -2224,7 +2224,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2224 2224
2225 done: 2225 done:
2226 SET_PT_BOTH (pos, pos_byte); 2226 SET_PT_BOTH (pos, pos_byte);
2227 immediate_quit = 0; 2227 immediate_quit = false;
2228 2228
2229 return make_number (PT - start_point); 2229 return make_number (PT - start_point);
2230 } 2230 }
@@ -2412,8 +2412,8 @@ between them, return t; otherwise return nil. */)
2412 count1 = XINT (count); 2412 count1 = XINT (count);
2413 stop = count1 > 0 ? ZV : BEGV; 2413 stop = count1 > 0 ? ZV : BEGV;
2414 2414
2415 immediate_quit = 1; 2415 immediate_quit = true;
2416 QUIT; 2416 maybe_quit ();
2417 2417
2418 from = PT; 2418 from = PT;
2419 from_byte = PT_BYTE; 2419 from_byte = PT_BYTE;
@@ -2429,7 +2429,7 @@ between them, return t; otherwise return nil. */)
2429 if (from == stop) 2429 if (from == stop)
2430 { 2430 {
2431 SET_PT_BOTH (from, from_byte); 2431 SET_PT_BOTH (from, from_byte);
2432 immediate_quit = 0; 2432 immediate_quit = false;
2433 return Qnil; 2433 return Qnil;
2434 } 2434 }
2435 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2435 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2463,7 +2463,7 @@ between them, return t; otherwise return nil. */)
2463 comstyle = ST_COMMENT_STYLE; 2463 comstyle = ST_COMMENT_STYLE;
2464 else if (code != Scomment) 2464 else if (code != Scomment)
2465 { 2465 {
2466 immediate_quit = 0; 2466 immediate_quit = false;
2467 DEC_BOTH (from, from_byte); 2467 DEC_BOTH (from, from_byte);
2468 SET_PT_BOTH (from, from_byte); 2468 SET_PT_BOTH (from, from_byte);
2469 return Qnil; 2469 return Qnil;
@@ -2474,7 +2474,7 @@ between them, return t; otherwise return nil. */)
2474 from = out_charpos; from_byte = out_bytepos; 2474 from = out_charpos; from_byte = out_bytepos;
2475 if (!found) 2475 if (!found)
2476 { 2476 {
2477 immediate_quit = 0; 2477 immediate_quit = false;
2478 SET_PT_BOTH (from, from_byte); 2478 SET_PT_BOTH (from, from_byte);
2479 return Qnil; 2479 return Qnil;
2480 } 2480 }
@@ -2494,7 +2494,7 @@ between them, return t; otherwise return nil. */)
2494 if (from <= stop) 2494 if (from <= stop)
2495 { 2495 {
2496 SET_PT_BOTH (BEGV, BEGV_BYTE); 2496 SET_PT_BOTH (BEGV, BEGV_BYTE);
2497 immediate_quit = 0; 2497 immediate_quit = false;
2498 return Qnil; 2498 return Qnil;
2499 } 2499 }
2500 2500
@@ -2587,7 +2587,7 @@ between them, return t; otherwise return nil. */)
2587 else if (code != Swhitespace || quoted) 2587 else if (code != Swhitespace || quoted)
2588 { 2588 {
2589 leave: 2589 leave:
2590 immediate_quit = 0; 2590 immediate_quit = false;
2591 INC_BOTH (from, from_byte); 2591 INC_BOTH (from, from_byte);
2592 SET_PT_BOTH (from, from_byte); 2592 SET_PT_BOTH (from, from_byte);
2593 return Qnil; 2593 return Qnil;
@@ -2598,7 +2598,7 @@ between them, return t; otherwise return nil. */)
2598 } 2598 }
2599 2599
2600 SET_PT_BOTH (from, from_byte); 2600 SET_PT_BOTH (from, from_byte);
2601 immediate_quit = 0; 2601 immediate_quit = false;
2602 return Qt; 2602 return Qt;
2603} 2603}
2604 2604
@@ -2640,8 +2640,8 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2640 2640
2641 from_byte = CHAR_TO_BYTE (from); 2641 from_byte = CHAR_TO_BYTE (from);
2642 2642
2643 immediate_quit = 1; 2643 immediate_quit = true;
2644 QUIT; 2644 maybe_quit ();
2645 2645
2646 SETUP_SYNTAX_TABLE (from, count); 2646 SETUP_SYNTAX_TABLE (from, count);
2647 while (count > 0) 2647 while (count > 0)
@@ -2801,7 +2801,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2801 if (depth) 2801 if (depth)
2802 goto lose; 2802 goto lose;
2803 2803
2804 immediate_quit = 0; 2804 immediate_quit = false;
2805 return Qnil; 2805 return Qnil;
2806 2806
2807 /* End of object reached */ 2807 /* End of object reached */
@@ -2984,7 +2984,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2984 if (depth) 2984 if (depth)
2985 goto lose; 2985 goto lose;
2986 2986
2987 immediate_quit = 0; 2987 immediate_quit = false;
2988 return Qnil; 2988 return Qnil;
2989 2989
2990 done2: 2990 done2:
@@ -2992,7 +2992,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2992 } 2992 }
2993 2993
2994 2994
2995 immediate_quit = 0; 2995 immediate_quit = false;
2996 XSETFASTINT (val, from); 2996 XSETFASTINT (val, from);
2997 return val; 2997 return val;
2998 2998
@@ -3092,6 +3092,36 @@ the prefix syntax flag (p). */)
3092 return Qnil; 3092 return Qnil;
3093} 3093}
3094 3094
3095
3096/* If the character at FROM_BYTE is the second part of a 2-character
3097 comment opener based on PREV_FROM_SYNTAX, update STATE and return
3098 true. */
3099static bool
3100in_2char_comment_start (struct lisp_parse_state *state,
3101 int prev_from_syntax,
3102 ptrdiff_t prev_from,
3103 ptrdiff_t from_byte)
3104{
3105 int c1, syntax;
3106 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3107 && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
3108 syntax = SYNTAX_WITH_FLAGS (c1),
3109 SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
3110 {
3111 /* Record the comment style we have entered so that only
3112 the comment-end sequence of the same style actually
3113 terminates the comment section. */
3114 state->comstyle
3115 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3116 bool comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3117 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3118 state->incomment = comnested ? 1 : -1;
3119 state->comstr_start = prev_from;
3120 return true;
3121 }
3122 return false;
3123}
3124
3095/* Parse forward from FROM / FROM_BYTE to END, 3125/* Parse forward from FROM / FROM_BYTE to END,
3096 assuming that FROM has state STATE, 3126 assuming that FROM has state STATE,
3097 and return a description of the state of the parse at END. 3127 and return a description of the state of the parse at END.
@@ -3107,8 +3137,6 @@ scan_sexps_forward (struct lisp_parse_state *state,
3107 int commentstop) 3137 int commentstop)
3108{ 3138{
3109 enum syntaxcode code; 3139 enum syntaxcode code;
3110 int c1;
3111 bool comnested;
3112 struct level { ptrdiff_t last, prev; }; 3140 struct level { ptrdiff_t last, prev; };
3113 struct level levelstart[100]; 3141 struct level levelstart[100];
3114 struct level *curlevel = levelstart; 3142 struct level *curlevel = levelstart;
@@ -3122,7 +3150,6 @@ scan_sexps_forward (struct lisp_parse_state *state,
3122 ptrdiff_t prev_from; /* Keep one character before FROM. */ 3150 ptrdiff_t prev_from; /* Keep one character before FROM. */
3123 ptrdiff_t prev_from_byte; 3151 ptrdiff_t prev_from_byte;
3124 int prev_from_syntax, prev_prev_from_syntax; 3152 int prev_from_syntax, prev_prev_from_syntax;
3125 int syntax;
3126 bool boundary_stop = commentstop == -1; 3153 bool boundary_stop = commentstop == -1;
3127 bool nofence; 3154 bool nofence;
3128 bool found; 3155 bool found;
@@ -3146,8 +3173,8 @@ do { prev_from = from; \
3146 UPDATE_SYNTAX_TABLE_FORWARD (from); \ 3173 UPDATE_SYNTAX_TABLE_FORWARD (from); \
3147 } while (0) 3174 } while (0)
3148 3175
3149 immediate_quit = 1; 3176 immediate_quit = true;
3150 QUIT; 3177 maybe_quit ();
3151 3178
3152 depth = state->depth; 3179 depth = state->depth;
3153 start_quoted = state->quoted; 3180 start_quoted = state->quoted;
@@ -3187,53 +3214,31 @@ do { prev_from = from; \
3187 } 3214 }
3188 else if (start_quoted) 3215 else if (start_quoted)
3189 goto startquoted; 3216 goto startquoted;
3217 else if ((from < end)
3218 && (in_2char_comment_start (state, prev_from_syntax,
3219 prev_from, from_byte)))
3220 {
3221 INC_FROM;
3222 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3223 goto atcomment;
3224 }
3190 3225
3191 while (from < end) 3226 while (from < end)
3192 { 3227 {
3193 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) 3228 INC_FROM;
3194 && (c1 = FETCH_CHAR (from_byte), 3229
3195 syntax = SYNTAX_WITH_FLAGS (c1), 3230 if ((from < end)
3196 SYNTAX_FLAGS_COMSTART_SECOND (syntax))) 3231 && (in_2char_comment_start (state, prev_from_syntax,
3197 { 3232 prev_from, from_byte)))
3198 /* Record the comment style we have entered so that only
3199 the comment-end sequence of the same style actually
3200 terminates the comment section. */
3201 state->comstyle
3202 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3203 comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3204 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3205 state->incomment = comnested ? 1 : -1;
3206 state->comstr_start = prev_from;
3207 INC_FROM;
3208 prev_from_syntax = Smax; /* the syntax has already been
3209 "used up". */
3210 code = Scomment;
3211 }
3212 else
3213 { 3233 {
3214 INC_FROM; 3234 INC_FROM;
3215 code = prev_from_syntax & 0xff; 3235 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3216 if (code == Scomment_fence) 3236 goto atcomment;
3217 {
3218 /* Record the comment style we have entered so that only
3219 the comment-end sequence of the same style actually
3220 terminates the comment section. */
3221 state->comstyle = ST_COMMENT_STYLE;
3222 state->incomment = -1;
3223 state->comstr_start = prev_from;
3224 code = Scomment;
3225 }
3226 else if (code == Scomment)
3227 {
3228 state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
3229 state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3230 1 : -1);
3231 state->comstr_start = prev_from;
3232 }
3233 } 3237 }
3234 3238
3235 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) 3239 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
3236 continue; 3240 continue;
3241 code = prev_from_syntax & 0xff;
3237 switch (code) 3242 switch (code)
3238 { 3243 {
3239 case Sescape: 3244 case Sescape:
@@ -3252,24 +3257,15 @@ do { prev_from = from; \
3252 symstarted: 3257 symstarted:
3253 while (from < end) 3258 while (from < end)
3254 { 3259 {
3255 int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); 3260 if (in_2char_comment_start (state, prev_from_syntax,
3256 3261 prev_from, from_byte))
3257 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3258 && (syntax = SYNTAX_WITH_FLAGS (symchar),
3259 SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
3260 { 3262 {
3261 state->comstyle
3262 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3263 comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3264 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3265 state->incomment = comnested ? 1 : -1;
3266 state->comstr_start = prev_from;
3267 INC_FROM; 3263 INC_FROM;
3268 prev_from_syntax = Smax; 3264 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3269 code = Scomment;
3270 goto atcomment; 3265 goto atcomment;
3271 } 3266 }
3272 3267
3268 int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte);
3273 switch (SYNTAX (symchar)) 3269 switch (SYNTAX (symchar))
3274 { 3270 {
3275 case Scharquote: 3271 case Scharquote:
@@ -3290,8 +3286,19 @@ do { prev_from = from; \
3290 curlevel->prev = curlevel->last; 3286 curlevel->prev = curlevel->last;
3291 break; 3287 break;
3292 3288
3293 case Scomment_fence: /* Can't happen because it's handled above. */ 3289 case Scomment_fence:
3290 /* Record the comment style we have entered so that only
3291 the comment-end sequence of the same style actually
3292 terminates the comment section. */
3293 state->comstyle = ST_COMMENT_STYLE;
3294 state->incomment = -1;
3295 state->comstr_start = prev_from;
3296 goto atcomment;
3294 case Scomment: 3297 case Scomment:
3298 state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
3299 state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3300 1 : -1);
3301 state->comstr_start = prev_from;
3295 atcomment: 3302 atcomment:
3296 if (commentstop || boundary_stop) goto done; 3303 if (commentstop || boundary_stop) goto done;
3297 startincomment: 3304 startincomment:
@@ -3425,7 +3432,7 @@ do { prev_from = from; \
3425 state->levelstarts); 3432 state->levelstarts);
3426 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) 3433 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
3427 || state->quoted) ? prev_from_syntax : Smax; 3434 || state->quoted) ? prev_from_syntax : Smax;
3428 immediate_quit = 0; 3435 immediate_quit = false;
3429} 3436}
3430 3437
3431/* Convert a (lisp) parse state to the internal form used in 3438/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/sysdep.c b/src/sysdep.c
index 4316c21a1c7..e172dc0aed4 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -391,10 +391,10 @@ get_child_status (pid_t child, int *status, int options, bool interruptible)
391 if (errno != EINTR) 391 if (errno != EINTR)
392 emacs_abort (); 392 emacs_abort ();
393 393
394 /* Note: the MS-Windows emulation of waitpid calls QUIT 394 /* Note: the MS-Windows emulation of waitpid calls maybe_quit
395 internally. */ 395 internally. */
396 if (interruptible) 396 if (interruptible)
397 QUIT; 397 maybe_quit ();
398 } 398 }
399 399
400 /* If successful and status is requested, tell wait_reading_process_output 400 /* If successful and status is requested, tell wait_reading_process_output
@@ -2383,7 +2383,7 @@ emacs_open (const char *file, int oflags, int mode)
2383 oflags |= O_BINARY; 2383 oflags |= O_BINARY;
2384 oflags |= O_CLOEXEC; 2384 oflags |= O_CLOEXEC;
2385 while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) 2385 while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR)
2386 QUIT; 2386 maybe_quit ();
2387 if (! O_CLOEXEC && 0 <= fd) 2387 if (! O_CLOEXEC && 0 <= fd)
2388 fcntl (fd, F_SETFD, FD_CLOEXEC); 2388 fcntl (fd, F_SETFD, FD_CLOEXEC);
2389 return fd; 2389 return fd;
@@ -2516,7 +2516,7 @@ emacs_read (int fildes, void *buf, ptrdiff_t nbyte)
2516 2516
2517 while ((rtnval = read (fildes, buf, nbyte)) == -1 2517 while ((rtnval = read (fildes, buf, nbyte)) == -1
2518 && (errno == EINTR)) 2518 && (errno == EINTR))
2519 QUIT; 2519 maybe_quit ();
2520 return (rtnval); 2520 return (rtnval);
2521} 2521}
2522 2522
@@ -2538,7 +2538,7 @@ emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte,
2538 { 2538 {
2539 if (errno == EINTR) 2539 if (errno == EINTR)
2540 { 2540 {
2541 /* I originally used `QUIT' but that might cause files to 2541 /* I originally used maybe_quit but that might cause files to
2542 be truncated if you hit C-g in the middle of it. --Stef */ 2542 be truncated if you hit C-g in the middle of it. --Stef */
2543 if (process_signals && pending_signals) 2543 if (process_signals && pending_signals)
2544 process_pending_signals (); 2544 process_pending_signals ();
diff --git a/src/textprop.c b/src/textprop.c
index 7cb3d3c38e6..225ff28e57e 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -211,7 +211,7 @@ validate_plist (Lisp_Object list)
211 if (! CONSP (tail)) 211 if (! CONSP (tail))
212 error ("Odd length text property list"); 212 error ("Odd length text property list");
213 tail = XCDR (tail); 213 tail = XCDR (tail);
214 QUIT; 214 maybe_quit ();
215 } 215 }
216 while (CONSP (tail)); 216 while (CONSP (tail));
217 217
diff --git a/src/thread.c b/src/thread.c
index 5498fe5efcb..9ea7e121a82 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -128,11 +128,11 @@ lisp_mutex_init (lisp_mutex_t *mutex)
128 sys_cond_init (&mutex->condition); 128 sys_cond_init (&mutex->condition);
129} 129}
130 130
131/* Lock MUTEX setting its count to COUNT, if non-zero, or to 1 131/* Lock MUTEX for thread LOCKER, setting its lock count to COUNT, if
132 otherwise. 132 non-zero, or to 1 otherwise.
133 133
134 If MUTEX is locked by the current thread, COUNT must be zero, and 134 If MUTEX is locked by LOCKER, COUNT must be zero, and the MUTEX's
135 the MUTEX's lock count will be incremented. 135 lock count will be incremented.
136 136
137 If MUTEX is locked by another thread, this function will release 137 If MUTEX is locked by another thread, this function will release
138 the global lock, giving other threads a chance to run, and will 138 the global lock, giving other threads a chance to run, and will
@@ -143,24 +143,25 @@ lisp_mutex_init (lisp_mutex_t *mutex)
143 unlocked (meaning other threads could have run during the wait), 143 unlocked (meaning other threads could have run during the wait),
144 zero otherwise. */ 144 zero otherwise. */
145static int 145static int
146lisp_mutex_lock (lisp_mutex_t *mutex, int new_count) 146lisp_mutex_lock_for_thread (lisp_mutex_t *mutex, struct thread_state *locker,
147 int new_count)
147{ 148{
148 struct thread_state *self; 149 struct thread_state *self;
149 150
150 if (mutex->owner == NULL) 151 if (mutex->owner == NULL)
151 { 152 {
152 mutex->owner = current_thread; 153 mutex->owner = locker;
153 mutex->count = new_count == 0 ? 1 : new_count; 154 mutex->count = new_count == 0 ? 1 : new_count;
154 return 0; 155 return 0;
155 } 156 }
156 if (mutex->owner == current_thread) 157 if (mutex->owner == locker)
157 { 158 {
158 eassert (new_count == 0); 159 eassert (new_count == 0);
159 ++mutex->count; 160 ++mutex->count;
160 return 0; 161 return 0;
161 } 162 }
162 163
163 self = current_thread; 164 self = locker;
164 self->wait_condvar = &mutex->condition; 165 self->wait_condvar = &mutex->condition;
165 while (mutex->owner != NULL && (new_count != 0 166 while (mutex->owner != NULL && (new_count != 0
166 || NILP (self->error_symbol))) 167 || NILP (self->error_symbol)))
@@ -176,6 +177,12 @@ lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
176 return 1; 177 return 1;
177} 178}
178 179
180static int
181lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
182{
183 return lisp_mutex_lock_for_thread (mutex, current_thread, new_count);
184}
185
179/* Decrement MUTEX's lock count. If the lock count becomes zero after 186/* Decrement MUTEX's lock count. If the lock count becomes zero after
180 decrementing it, meaning the mutex is now unlocked, broadcast that 187 decrementing it, meaning the mutex is now unlocked, broadcast that
181 to all the threads that might be waiting to lock the mutex. This 188 to all the threads that might be waiting to lock the mutex. This
@@ -398,16 +405,16 @@ condition_wait_callback (void *arg)
398 self->wait_condvar = NULL; 405 self->wait_condvar = NULL;
399 } 406 }
400 self->event_object = Qnil; 407 self->event_object = Qnil;
401 /* Since sys_cond_wait could switch threads, we need to re-establish 408 /* Since sys_cond_wait could switch threads, we need to lock the
402 ourselves as the current thread, otherwise lisp_mutex_lock will 409 mutex for the thread which was the current when we were called,
403 record the wrong thread as the owner of the mutex lock. */ 410 otherwise lisp_mutex_lock will record the wrong thread as the
404 post_acquire_global_lock (self); 411 owner of the mutex lock. */
405 /* Calling lisp_mutex_lock might yield to other threads while this 412 lisp_mutex_lock_for_thread (&mutex->mutex, self, saved_count);
406 one waits for the mutex to become unlocked, so we need to 413 /* Calling lisp_mutex_lock_for_thread might yield to other threads
407 announce us as the current thread by calling 414 while this one waits for the mutex to become unlocked, so we need
415 to announce us as the current thread by calling
408 post_acquire_global_lock. */ 416 post_acquire_global_lock. */
409 if (lisp_mutex_lock (&mutex->mutex, saved_count)) 417 post_acquire_global_lock (self);
410 post_acquire_global_lock (self);
411} 418}
412 419
413DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0, 420DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0,
@@ -663,10 +670,13 @@ invoke_thread_function (void)
663 return unbind_to (count, Qnil); 670 return unbind_to (count, Qnil);
664} 671}
665 672
673static Lisp_Object last_thread_error;
674
666static Lisp_Object 675static Lisp_Object
667do_nothing (Lisp_Object whatever) 676record_thread_error (Lisp_Object error_form)
668{ 677{
669 return whatever; 678 last_thread_error = error_form;
679 return error_form;
670} 680}
671 681
672static void * 682static void *
@@ -695,7 +705,7 @@ run_thread (void *state)
695 handlerlist_sentinel->next = NULL; 705 handlerlist_sentinel->next = NULL;
696 706
697 /* It might be nice to do something with errors here. */ 707 /* It might be nice to do something with errors here. */
698 internal_condition_case (invoke_thread_function, Qt, do_nothing); 708 internal_condition_case (invoke_thread_function, Qt, record_thread_error);
699 709
700 update_processes_for_thread_death (Fcurrent_thread ()); 710 update_processes_for_thread_death (Fcurrent_thread ());
701 711
@@ -944,6 +954,13 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
944 return result; 954 return result;
945} 955}
946 956
957DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0,
958 doc: /* Return the last error form recorded by a dying thread. */)
959 (void)
960{
961 return last_thread_error;
962}
963
947 964
948 965
949bool 966bool
@@ -1028,6 +1045,10 @@ syms_of_threads (void)
1028 defsubr (&Scondition_notify); 1045 defsubr (&Scondition_notify);
1029 defsubr (&Scondition_mutex); 1046 defsubr (&Scondition_mutex);
1030 defsubr (&Scondition_name); 1047 defsubr (&Scondition_name);
1048 defsubr (&Sthread_last_error);
1049
1050 staticpro (&last_thread_error);
1051 last_thread_error = Qnil;
1031 } 1052 }
1032 1053
1033 DEFSYM (Qthreadp, "threadp"); 1054 DEFSYM (Qthreadp, "threadp");
diff --git a/src/w32fns.c b/src/w32fns.c
index c24fce11fc8..6a576fcec27 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -778,7 +778,7 @@ w32_color_map_lookup (const char *colorname)
778 break; 778 break;
779 } 779 }
780 780
781 QUIT; 781 maybe_quit ();
782 } 782 }
783 783
784 unblock_input (); 784 unblock_input ();
@@ -3166,7 +3166,7 @@ signal_user_input (void)
3166 if (!NILP (Vthrow_on_input)) 3166 if (!NILP (Vthrow_on_input))
3167 { 3167 {
3168 Vquit_flag = Vthrow_on_input; 3168 Vquit_flag = Vthrow_on_input;
3169 /* Doing a QUIT from this thread is a bad idea, since this 3169 /* Calling maybe_quit from this thread is a bad idea, since this
3170 unwinds the stack of the Lisp thread, and the Windows runtime 3170 unwinds the stack of the Lisp thread, and the Windows runtime
3171 rightfully barfs. Disabled. */ 3171 rightfully barfs. Disabled. */
3172#if 0 3172#if 0
@@ -3174,8 +3174,8 @@ signal_user_input (void)
3174 do it now. */ 3174 do it now. */
3175 if (immediate_quit && NILP (Vinhibit_quit)) 3175 if (immediate_quit && NILP (Vinhibit_quit))
3176 { 3176 {
3177 immediate_quit = 0; 3177 immediate_quit = false;
3178 QUIT; 3178 maybe_quit ();
3179 } 3179 }
3180#endif 3180#endif
3181 } 3181 }
diff --git a/src/w32notify.c b/src/w32notify.c
index 1f4cbe2df47..25205816bae 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -664,7 +664,7 @@ w32_get_watch_object (void *desc)
664 Lisp_Object descriptor = make_pointer_integer (desc); 664 Lisp_Object descriptor = make_pointer_integer (desc);
665 665
666 /* This is called from the input queue handling code, inside a 666 /* This is called from the input queue handling code, inside a
667 critical section, so we cannot possibly QUIT if watch_list is not 667 critical section, so we cannot possibly quit if watch_list is not
668 in the right condition. */ 668 in the right condition. */
669 return NILP (watch_list) ? Qnil : assoc_no_quit (descriptor, watch_list); 669 return NILP (watch_list) ? Qnil : assoc_no_quit (descriptor, watch_list);
670} 670}
diff --git a/src/w32proc.c b/src/w32proc.c
index a7f2b4a9950..0aa248a6f7b 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1449,7 +1449,7 @@ waitpid (pid_t pid, int *status, int options)
1449 1449
1450 do 1450 do
1451 { 1451 {
1452 QUIT; 1452 maybe_quit ();
1453 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); 1453 active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
1454 } while (active == WAIT_TIMEOUT && !dont_wait); 1454 } while (active == WAIT_TIMEOUT && !dont_wait);
1455 1455
diff --git a/src/window.c b/src/window.c
index 0a6b94d4d1d..71a82b522c4 100644
--- a/src/window.c
+++ b/src/window.c
@@ -521,9 +521,10 @@ select_window (Lisp_Object window, Lisp_Object norecord,
521 bset_last_selected_window (XBUFFER (w->contents), window); 521 bset_last_selected_window (XBUFFER (w->contents), window);
522 522
523 record_and_return: 523 record_and_return:
524 /* record_buffer can run QUIT, so make sure it is run only after we have 524 /* record_buffer can call maybe_quit, so make sure it is run only
525 re-established the invariant between selected_window and selected_frame, 525 after we have re-established the invariant between
526 otherwise the temporary broken invariant might "escape" (bug#14161). */ 526 selected_window and selected_frame, otherwise the temporary
527 broken invariant might "escape" (Bug#14161). */
527 if (NILP (norecord)) 528 if (NILP (norecord))
528 { 529 {
529 w->use_time = ++window_select_count; 530 w->use_time = ++window_select_count;
diff --git a/src/xdisp.c b/src/xdisp.c
index 168922ef06b..33661c882cd 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -22635,7 +22635,7 @@ move_elt_to_front (Lisp_Object elt, Lisp_Object list)
22635 else 22635 else
22636 prev = tail; 22636 prev = tail;
22637 tail = XCDR (tail); 22637 tail = XCDR (tail);
22638 QUIT; 22638 maybe_quit ();
22639 } 22639 }
22640 22640
22641 /* Not found--return unchanged LIST. */ 22641 /* Not found--return unchanged LIST. */
diff --git a/src/xselect.c b/src/xselect.c
index 47ccf6886bf..2249828fb4e 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -329,7 +329,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
329 Fcons (selection_data, dpyinfo->terminal->Vselection_alist)); 329 Fcons (selection_data, dpyinfo->terminal->Vselection_alist));
330 330
331 /* If we already owned the selection, remove the old selection 331 /* If we already owned the selection, remove the old selection
332 data. Don't use Fdelq as that may QUIT. */ 332 data. Don't use Fdelq as that may quit. */
333 if (!NILP (prev_value)) 333 if (!NILP (prev_value))
334 { 334 {
335 /* We know it's not the CAR, so it's easy. */ 335 /* We know it's not the CAR, so it's easy. */
@@ -929,7 +929,7 @@ x_handle_selection_clear (struct selection_input_event *event)
929 && local_selection_time > changed_owner_time) 929 && local_selection_time > changed_owner_time)
930 return; 930 return;
931 931
932 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */ 932 /* Otherwise, really clear. Don't use Fdelq as that may quit. */
933 Vselection_alist = dpyinfo->terminal->Vselection_alist; 933 Vselection_alist = dpyinfo->terminal->Vselection_alist;
934 if (EQ (local_selection_data, CAR (Vselection_alist))) 934 if (EQ (local_selection_data, CAR (Vselection_alist)))
935 Vselection_alist = XCDR (Vselection_alist); 935 Vselection_alist = XCDR (Vselection_alist);
diff --git a/src/xterm.c b/src/xterm.c
index adc02e2768d..38229a5f31f 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -635,7 +635,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type)
635 (*surface_set_size_func) (surface, width, height); 635 (*surface_set_size_func) (surface, width, height);
636 636
637 unblock_input (); 637 unblock_input ();
638 QUIT; 638 maybe_quit ();
639 block_input (); 639 block_input ();
640 } 640 }
641 641
@@ -10993,19 +10993,12 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg,
10993 10993
10994/* Change of visibility. */ 10994/* Change of visibility. */
10995 10995
10996/* This tries to wait until the frame is really visible. 10996/* This function sends the request to make the frame visible, but may
10997 However, if the window manager asks the user where to position 10997 return before it the frame's visibility is changed. */
10998 the frame, this will return before the user finishes doing that.
10999 The frame will not actually be visible at that time,
11000 but it will become visible later when the window manager
11001 finishes with it. */
11002 10998
11003void 10999void
11004x_make_frame_visible (struct frame *f) 11000x_make_frame_visible (struct frame *f)
11005{ 11001{
11006 int original_top, original_left;
11007 int tries = 0;
11008
11009 block_input (); 11002 block_input ();
11010 11003
11011 x_set_bitmap_icon (f); 11004 x_set_bitmap_icon (f);
@@ -11052,16 +11045,13 @@ x_make_frame_visible (struct frame *f)
11052 before we do anything else. We do this loop with input not blocked 11045 before we do anything else. We do this loop with input not blocked
11053 so that incoming events are handled. */ 11046 so that incoming events are handled. */
11054 { 11047 {
11055 Lisp_Object frame;
11056 /* This must be before UNBLOCK_INPUT 11048 /* This must be before UNBLOCK_INPUT
11057 since events that arrive in response to the actions above 11049 since events that arrive in response to the actions above
11058 will set it when they are handled. */ 11050 will set it when they are handled. */
11059 bool previously_visible = f->output_data.x->has_been_visible; 11051 bool previously_visible = f->output_data.x->has_been_visible;
11060 11052
11061 XSETFRAME (frame, f); 11053 int original_left = f->left_pos;
11062 11054 int original_top = f->top_pos;
11063 original_left = f->left_pos;
11064 original_top = f->top_pos;
11065 11055
11066 /* This must come after we set COUNT. */ 11056 /* This must come after we set COUNT. */
11067 unblock_input (); 11057 unblock_input ();
@@ -11105,46 +11095,6 @@ x_make_frame_visible (struct frame *f)
11105 11095
11106 unblock_input (); 11096 unblock_input ();
11107 } 11097 }
11108
11109 /* Process X events until a MapNotify event has been seen. */
11110 while (!FRAME_VISIBLE_P (f))
11111 {
11112 /* Force processing of queued events. */
11113 x_sync (f);
11114
11115 /* If on another desktop, the deiconify/map may be ignored and the
11116 frame never becomes visible. XMonad does this.
11117 Prevent an endless loop. */
11118 if (FRAME_ICONIFIED_P (f) && ++tries > 100)
11119 break;
11120
11121 /* This hack is still in use at least for Cygwin. See
11122 http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00351.html.
11123
11124 Machines that do polling rather than SIGIO have been
11125 observed to go into a busy-wait here. So we'll fake an
11126 alarm signal to let the handler know that there's something
11127 to be read. We used to raise a real alarm, but it seems
11128 that the handler isn't always enabled here. This is
11129 probably a bug. */
11130 if (input_polling_used ())
11131 {
11132 /* It could be confusing if a real alarm arrives while
11133 processing the fake one. Turn it off and let the
11134 handler reset it. */
11135 int old_poll_suppress_count = poll_suppress_count;
11136 poll_suppress_count = 1;
11137 poll_for_input_1 ();
11138 poll_suppress_count = old_poll_suppress_count;
11139 }
11140
11141 if (XPending (FRAME_X_DISPLAY (f)))
11142 {
11143 XEvent xev;
11144 XNextEvent (FRAME_X_DISPLAY (f), &xev);
11145 x_dispatch_event (&xev, FRAME_X_DISPLAY (f));
11146 }
11147 }
11148 } 11098 }
11149} 11099}
11150 11100
@@ -12927,7 +12877,7 @@ keysyms. The default is nil, which is the same as `super'. */);
12927 Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900), 12877 Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
12928 make_float (DEFAULT_REHASH_SIZE), 12878 make_float (DEFAULT_REHASH_SIZE),
12929 make_float (DEFAULT_REHASH_THRESHOLD), 12879 make_float (DEFAULT_REHASH_THRESHOLD),
12930 Qnil); 12880 Qnil, Qnil);
12931 12881
12932 DEFVAR_BOOL ("x-frame-normalize-before-maximize", 12882 DEFVAR_BOOL ("x-frame-normalize-before-maximize",
12933 x_frame_normalize_before_maximize, 12883 x_frame_normalize_before_maximize,
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-16 02:12:36 +0000