aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorAlan Mackenzie2017-02-12 10:59:03 +0000
committerAlan Mackenzie2017-02-12 10:59:03 +0000
commitf4d5b687150810129b7a1d5b006e31ccf82b691b (patch)
tree4229b13800349032697daae3904dc3773e6b7a80 /src
parentd5514332d4a6092673ce1f78fadcae0c57f7be64 (diff)
parent148100d98319499f0ac6f57b8be08cbd14884a5c (diff)
downloademacs-f4d5b687150810129b7a1d5b006e31ccf82b691b.tar.gz
emacs-f4d5b687150810129b7a1d5b006e31ccf82b691b.zip
Merge branch 'master' into comment-cachecomment-cache
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c299
-rw-r--r--src/atimer.c1
-rw-r--r--src/buffer.c13
-rw-r--r--src/bytecode.c22
-rw-r--r--src/callint.c2
-rw-r--r--src/callproc.c18
-rw-r--r--src/category.c2
-rw-r--r--src/ccl.c2
-rw-r--r--src/decompress.c2
-rw-r--r--src/dired.c9
-rw-r--r--src/dispextern.h1
-rw-r--r--src/doc.c9
-rw-r--r--src/editfns.c12
-rw-r--r--src/emacs-module.c2
-rw-r--r--src/emacs.c2
-rw-r--r--src/eval.c51
-rw-r--r--src/fileio.c94
-rw-r--r--src/filelock.c9
-rw-r--r--src/fns.c377
-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.c13
-rw-r--r--src/insdel.c12
-rw-r--r--src/keyboard.c109
-rw-r--r--src/keyboard.h2
-rw-r--r--src/keymap.c12
-rw-r--r--src/lisp.h64
-rw-r--r--src/lread.c16
-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.c13
-rw-r--r--src/search.c105
-rw-r--r--src/syntax.c250
-rw-r--r--src/sysdep.c131
-rw-r--r--src/textprop.c2
-rw-r--r--src/w32fns.c15
-rw-r--r--src/w32notify.c2
-rw-r--r--src/w32proc.c2
-rw-r--r--src/window.c62
-rw-r--r--src/window.h2
-rw-r--r--src/xdisp.c106
-rw-r--r--src/xselect.c4
-rw-r--r--src/xterm.c4
49 files changed, 906 insertions, 1031 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 1a6d4e2d565..62f43669f2a 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 rarely_quit (size);
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;
@@ -4917,12 +4887,19 @@ mark_memory (void *start, void *end)
4917 } 4887 }
4918} 4888}
4919 4889
4920#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS 4890#ifndef HAVE___BUILTIN_UNWIND_INIT
4891
4892# ifdef GC_SETJMP_WORKS
4893static void
4894test_setjmp (void)
4895{
4896}
4897# else
4921 4898
4922static bool setjmp_tested_p; 4899static bool setjmp_tested_p;
4923static int longjmps_done; 4900static int longjmps_done;
4924 4901
4925#define SETJMP_WILL_LIKELY_WORK "\ 4902# define SETJMP_WILL_LIKELY_WORK "\
4926\n\ 4903\n\
4927Emacs garbage collector has been changed to use conservative stack\n\ 4904Emacs garbage collector has been changed to use conservative stack\n\
4928marking. Emacs has determined that the method it uses to do the\n\ 4905marking. Emacs has determined that the method it uses to do the\n\
@@ -4935,7 +4912,7 @@ verify that the methods used are appropriate for your system.\n\
4935Please mail the result to <emacs-devel@gnu.org>.\n\ 4912Please mail the result to <emacs-devel@gnu.org>.\n\
4936" 4913"
4937 4914
4938#define SETJMP_WILL_NOT_WORK "\ 4915# define SETJMP_WILL_NOT_WORK "\
4939\n\ 4916\n\
4940Emacs garbage collector has been changed to use conservative stack\n\ 4917Emacs garbage collector has been changed to use conservative stack\n\
4941marking. Emacs has determined that the default method it uses to do the\n\ 4918marking. Emacs has determined that the default method it uses to do the\n\
@@ -4961,6 +4938,9 @@ Please mail the result to <emacs-devel@gnu.org>.\n\
4961static void 4938static void
4962test_setjmp (void) 4939test_setjmp (void)
4963{ 4940{
4941 if (setjmp_tested_p)
4942 return;
4943 setjmp_tested_p = true;
4964 char buf[10]; 4944 char buf[10];
4965 register int x; 4945 register int x;
4966 sys_jmp_buf jbuf; 4946 sys_jmp_buf jbuf;
@@ -4997,9 +4977,60 @@ test_setjmp (void)
4997 if (longjmps_done == 1) 4977 if (longjmps_done == 1)
4998 sys_longjmp (jbuf, 1); 4978 sys_longjmp (jbuf, 1);
4999} 4979}
4980# endif /* ! GC_SETJMP_WORKS */
4981#endif /* ! HAVE___BUILTIN_UNWIND_INIT */
5000 4982
5001#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */ 4983/* The type of an object near the stack top, whose address can be used
4984 as a stack scan limit. */
4985typedef union
4986{
4987 /* Align the stack top properly. Even if !HAVE___BUILTIN_UNWIND_INIT,
4988 jmp_buf may not be aligned enough on darwin-ppc64. */
4989 max_align_t o;
4990#ifndef HAVE___BUILTIN_UNWIND_INIT
4991 sys_jmp_buf j;
4992 char c;
4993#endif
4994} stacktop_sentry;
4995
4996/* Force callee-saved registers and register windows onto the stack.
4997 Use the platform-defined __builtin_unwind_init if available,
4998 obviating the need for machine dependent methods. */
4999#ifndef HAVE___BUILTIN_UNWIND_INIT
5000# ifdef __sparc__
5001 /* This trick flushes the register windows so that all the state of
5002 the process is contained in the stack.
5003 FreeBSD does not have a ta 3 handler, so handle it specially.
5004 FIXME: Code in the Boehm GC suggests flushing (with 'flushrs') is
5005 needed on ia64 too. See mach_dep.c, where it also says inline
5006 assembler doesn't work with relevant proprietary compilers. */
5007# if defined __sparc64__ && defined __FreeBSD__
5008# define __builtin_unwind_init() asm ("flushw")
5009# else
5010# define __builtin_unwind_init() asm ("ta 3")
5011# endif
5012# else
5013# define __builtin_unwind_init() ((void) 0)
5014# endif
5015#endif
5002 5016
5017/* Set *P to the address of the top of the stack. This must be a
5018 macro, not a function, so that it is executed in the caller’s
5019 environment. It is not inside a do-while so that its storage
5020 survives the macro. */
5021#ifdef HAVE___BUILTIN_UNWIND_INIT
5022# define SET_STACK_TOP_ADDRESS(p) \
5023 stacktop_sentry sentry; \
5024 __builtin_unwind_init (); \
5025 *(p) = &sentry
5026#else
5027# define SET_STACK_TOP_ADDRESS(p) \
5028 stacktop_sentry sentry; \
5029 __builtin_unwind_init (); \
5030 test_setjmp (); \
5031 sys_setjmp (sentry.j); \
5032 *(p) = &sentry + (stack_bottom < &sentry.c)
5033#endif
5003 5034
5004/* Mark live Lisp objects on the C stack. 5035/* Mark live Lisp objects on the C stack.
5005 5036
@@ -5011,12 +5042,7 @@ test_setjmp (void)
5011 We have to mark Lisp objects in CPU registers that can hold local 5042 We have to mark Lisp objects in CPU registers that can hold local
5012 variables or are used to pass parameters. 5043 variables or are used to pass parameters.
5013 5044
5014 If GC_SAVE_REGISTERS_ON_STACK is defined, it should expand to 5045 This code assumes that calling setjmp saves registers we need
5015 something that either saves relevant registers on the stack, or
5016 calls mark_maybe_object passing it each register's contents.
5017
5018 If GC_SAVE_REGISTERS_ON_STACK is not defined, the current
5019 implementation assumes that calling setjmp saves registers we need
5020 to see in a jmp_buf which itself lies on the stack. This doesn't 5046 to see in a jmp_buf which itself lies on the stack. This doesn't
5021 have to be true! It must be verified for each system, possibly 5047 have to be true! It must be verified for each system, possibly
5022 by taking a look at the source code of setjmp. 5048 by taking a look at the source code of setjmp.
@@ -5080,62 +5106,9 @@ flush_stack_call_func (void (*func) (void *arg), void *arg)
5080{ 5106{
5081 void *end; 5107 void *end;
5082 struct thread_state *self = current_thread; 5108 struct thread_state *self = current_thread;
5083 5109 SET_STACK_TOP_ADDRESS (&end);
5084#ifdef HAVE___BUILTIN_UNWIND_INIT
5085 /* Force callee-saved registers and register windows onto the stack.
5086 This is the preferred method if available, obviating the need for
5087 machine dependent methods. */
5088 __builtin_unwind_init ();
5089 end = &end;
5090#else /* not HAVE___BUILTIN_UNWIND_INIT */
5091#ifndef GC_SAVE_REGISTERS_ON_STACK
5092 /* jmp_buf may not be aligned enough on darwin-ppc64 */
5093 union aligned_jmpbuf {
5094 Lisp_Object o;
5095 sys_jmp_buf j;
5096 } j;
5097 volatile bool stack_grows_down_p = (char *) &j > (char *) stack_bottom;
5098#endif
5099 /* This trick flushes the register windows so that all the state of
5100 the process is contained in the stack. */
5101 /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
5102 needed on ia64 too. See mach_dep.c, where it also says inline
5103 assembler doesn't work with relevant proprietary compilers. */
5104#ifdef __sparc__
5105#if defined (__sparc64__) && defined (__FreeBSD__)
5106 /* FreeBSD does not have a ta 3 handler. */
5107 asm ("flushw");
5108#else
5109 asm ("ta 3");
5110#endif
5111#endif
5112
5113 /* Save registers that we need to see on the stack. We need to see
5114 registers used to hold register variables and registers used to
5115 pass parameters. */
5116#ifdef GC_SAVE_REGISTERS_ON_STACK
5117 GC_SAVE_REGISTERS_ON_STACK (end);
5118#else /* not GC_SAVE_REGISTERS_ON_STACK */
5119
5120#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that
5121 setjmp will definitely work, test it
5122 and print a message with the result
5123 of the test. */
5124 if (!setjmp_tested_p)
5125 {
5126 setjmp_tested_p = 1;
5127 test_setjmp ();
5128 }
5129#endif /* GC_SETJMP_WORKS */
5130
5131 sys_setjmp (j.j);
5132 end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
5133#endif /* not GC_SAVE_REGISTERS_ON_STACK */
5134#endif /* not HAVE___BUILTIN_UNWIND_INIT */
5135
5136 self->stack_top = end; 5110 self->stack_top = end;
5137 (*func) (arg); 5111 func (arg);
5138
5139 eassert (current_thread == self); 5112 eassert (current_thread == self);
5140} 5113}
5141 5114
@@ -5464,6 +5437,38 @@ make_pure_vector (ptrdiff_t len)
5464 return new; 5437 return new;
5465} 5438}
5466 5439
5440/* Copy all contents and parameters of TABLE to a new table allocated
5441 from pure space, return the purified table. */
5442static struct Lisp_Hash_Table *
5443purecopy_hash_table (struct Lisp_Hash_Table *table)
5444{
5445 eassert (NILP (table->weak));
5446 eassert (!NILP (table->pure));
5447
5448 struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
5449 struct hash_table_test pure_test = table->test;
5450
5451 /* Purecopy the hash table test. */
5452 pure_test.name = purecopy (table->test.name);
5453 pure_test.user_hash_function = purecopy (table->test.user_hash_function);
5454 pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
5455
5456 pure->test = pure_test;
5457 pure->header = table->header;
5458 pure->weak = purecopy (Qnil);
5459 pure->rehash_size = purecopy (table->rehash_size);
5460 pure->rehash_threshold = purecopy (table->rehash_threshold);
5461 pure->hash = purecopy (table->hash);
5462 pure->next = purecopy (table->next);
5463 pure->next_free = purecopy (table->next_free);
5464 pure->index = purecopy (table->index);
5465 pure->count = table->count;
5466 pure->key_and_value = purecopy (table->key_and_value);
5467 pure->pure = purecopy (table->pure);
5468
5469 return pure;
5470}
5471
5467DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, 5472DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
5468 doc: /* Make a copy of object OBJ in pure storage. 5473 doc: /* Make a copy of object OBJ in pure storage.
5469Recursively copies contents of vectors and cons cells. 5474Recursively copies contents of vectors and cons cells.
@@ -5472,14 +5477,20 @@ Does not copy symbols. Copies strings without text properties. */)
5472{ 5477{
5473 if (NILP (Vpurify_flag)) 5478 if (NILP (Vpurify_flag))
5474 return obj; 5479 return obj;
5475 else if (MARKERP (obj) || OVERLAYP (obj) 5480 else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj))
5476 || HASH_TABLE_P (obj) || SYMBOLP (obj))
5477 /* Can't purify those. */ 5481 /* Can't purify those. */
5478 return obj; 5482 return obj;
5479 else 5483 else
5480 return purecopy (obj); 5484 return purecopy (obj);
5481} 5485}
5482 5486
5487/* Pinned objects are marked before every GC cycle. */
5488static struct pinned_object
5489{
5490 Lisp_Object object;
5491 struct pinned_object *next;
5492} *pinned_objects;
5493
5483static Lisp_Object 5494static Lisp_Object
5484purecopy (Lisp_Object obj) 5495purecopy (Lisp_Object obj)
5485{ 5496{
@@ -5507,7 +5518,27 @@ purecopy (Lisp_Object obj)
5507 obj = make_pure_string (SSDATA (obj), SCHARS (obj), 5518 obj = make_pure_string (SSDATA (obj), SCHARS (obj),
5508 SBYTES (obj), 5519 SBYTES (obj),
5509 STRING_MULTIBYTE (obj)); 5520 STRING_MULTIBYTE (obj));
5510 else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj)) 5521 else if (HASH_TABLE_P (obj))
5522 {
5523 struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
5524 /* Do not purify hash tables which haven't been defined with
5525 :purecopy as non-nil or are weak - they aren't guaranteed to
5526 not change. */
5527 if (!NILP (table->weak) || NILP (table->pure))
5528 {
5529 /* Instead, add the hash table to the list of pinned objects,
5530 so that it will be marked during GC. */
5531 struct pinned_object *o = xmalloc (sizeof *o);
5532 o->object = obj;
5533 o->next = pinned_objects;
5534 pinned_objects = o;
5535 return obj; /* Don't hash cons it. */
5536 }
5537
5538 struct Lisp_Hash_Table *h = purecopy_hash_table (table);
5539 XSET_HASH_TABLE (obj, h);
5540 }
5541 else if (COMPILEDP (obj) || VECTORP (obj))
5511 { 5542 {
5512 struct Lisp_Vector *objp = XVECTOR (obj); 5543 struct Lisp_Vector *objp = XVECTOR (obj);
5513 ptrdiff_t nbytes = vector_nbytes (objp); 5544 ptrdiff_t nbytes = vector_nbytes (objp);
@@ -5724,6 +5755,13 @@ compact_undo_list (Lisp_Object list)
5724} 5755}
5725 5756
5726static void 5757static void
5758mark_pinned_objects (void)
5759{
5760 for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next)
5761 mark_object (pobj->object);
5762}
5763
5764static void
5727mark_pinned_symbols (void) 5765mark_pinned_symbols (void)
5728{ 5766{
5729 struct symbol_block *sblk; 5767 struct symbol_block *sblk;
@@ -5843,6 +5881,7 @@ garbage_collect_1 (void *end)
5843 for (i = 0; i < staticidx; i++) 5881 for (i = 0; i < staticidx; i++)
5844 mark_object (*staticvec[i]); 5882 mark_object (*staticvec[i]);
5845 5883
5884 mark_pinned_objects ();
5846 mark_pinned_symbols (); 5885 mark_pinned_symbols ();
5847 mark_terminals (); 5886 mark_terminals ();
5848 mark_kboards (); 5887 mark_kboards ();
@@ -6011,58 +6050,7 @@ See Info node `(elisp)Garbage Collection'. */)
6011 (void) 6050 (void)
6012{ 6051{
6013 void *end; 6052 void *end;
6014 6053 SET_STACK_TOP_ADDRESS (&end);
6015#ifdef HAVE___BUILTIN_UNWIND_INIT
6016 /* Force callee-saved registers and register windows onto the stack.
6017 This is the preferred method if available, obviating the need for
6018 machine dependent methods. */
6019 __builtin_unwind_init ();
6020 end = &end;
6021#else /* not HAVE___BUILTIN_UNWIND_INIT */
6022#ifndef GC_SAVE_REGISTERS_ON_STACK
6023 /* jmp_buf may not be aligned enough on darwin-ppc64 */
6024 union aligned_jmpbuf {
6025 Lisp_Object o;
6026 sys_jmp_buf j;
6027 } j;
6028 volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base;
6029#endif
6030 /* This trick flushes the register windows so that all the state of
6031 the process is contained in the stack. */
6032 /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
6033 needed on ia64 too. See mach_dep.c, where it also says inline
6034 assembler doesn't work with relevant proprietary compilers. */
6035#ifdef __sparc__
6036#if defined (__sparc64__) && defined (__FreeBSD__)
6037 /* FreeBSD does not have a ta 3 handler. */
6038 asm ("flushw");
6039#else
6040 asm ("ta 3");
6041#endif
6042#endif
6043
6044 /* Save registers that we need to see on the stack. We need to see
6045 registers used to hold register variables and registers used to
6046 pass parameters. */
6047#ifdef GC_SAVE_REGISTERS_ON_STACK
6048 GC_SAVE_REGISTERS_ON_STACK (end);
6049#else /* not GC_SAVE_REGISTERS_ON_STACK */
6050
6051#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that
6052 setjmp will definitely work, test it
6053 and print a message with the result
6054 of the test. */
6055 if (!setjmp_tested_p)
6056 {
6057 setjmp_tested_p = 1;
6058 test_setjmp ();
6059 }
6060#endif /* GC_SETJMP_WORKS */
6061
6062 sys_setjmp (j.j);
6063 end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
6064#endif /* not GC_SAVE_REGISTERS_ON_STACK */
6065#endif /* not HAVE___BUILTIN_UNWIND_INIT */
6066 return garbage_collect_1 (end); 6054 return garbage_collect_1 (end);
6067} 6055}
6068 6056
@@ -7372,9 +7360,6 @@ init_alloc_once (void)
7372void 7360void
7373init_alloc (void) 7361init_alloc (void)
7374{ 7362{
7375#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
7376 setjmp_tested_p = longjmps_done = 0;
7377#endif
7378 Vgc_elapsed = make_float (0.0); 7363 Vgc_elapsed = make_float (0.0);
7379 gcs_done = 0; 7364 gcs_done = 0;
7380 7365
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 0a317ad7d98..713c1e5b944 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -420,19 +420,16 @@ followed by the rest of the buffers. */)
420} 420}
421 421
422/* Like Fassoc, but use Fstring_equal to compare 422/* Like Fassoc, but use Fstring_equal to compare
423 (which ignores text properties), 423 (which ignores text properties), and don't ever quit. */
424 and don't ever QUIT. */
425 424
426static Lisp_Object 425static Lisp_Object
427assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list) 426assoc_ignore_text_properties (Lisp_Object key, Lisp_Object list)
428{ 427{
429 register Lisp_Object tail; 428 Lisp_Object tail;
430 for (tail = list; CONSP (tail); tail = XCDR (tail)) 429 for (tail = list; CONSP (tail); tail = XCDR (tail))
431 { 430 {
432 register Lisp_Object elt, tem; 431 Lisp_Object elt = XCAR (tail);
433 elt = XCAR (tail); 432 if (!NILP (Fstring_equal (Fcar (elt), key)))
434 tem = Fstring_equal (Fcar (elt), key);
435 if (!NILP (tem))
436 return elt; 433 return elt;
437 } 434 }
438 return Qnil; 435 return Qnil;
diff --git a/src/bytecode.c b/src/bytecode.c
index a64bc171d14..0f7420c19ee 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -679,7 +679,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
679 { 679 {
680 quitcounter = 1; 680 quitcounter = 1;
681 maybe_gc (); 681 maybe_gc ();
682 QUIT; 682 maybe_quit ();
683 } 683 }
684 pc += op; 684 pc += op;
685 NEXT; 685 NEXT;
@@ -841,11 +841,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
841 { 841 {
842 Lisp_Object v2 = POP, v1 = TOP; 842 Lisp_Object v2 = POP, v1 = TOP;
843 CHECK_NUMBER (v1); 843 CHECK_NUMBER (v1);
844 EMACS_INT n = XINT (v1); 844 for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--)
845 immediate_quit = true; 845 {
846 while (--n >= 0 && CONSP (v2)) 846 v2 = XCDR (v2);
847 v2 = XCDR (v2); 847 rarely_quit (n);
848 immediate_quit = false; 848 }
849 TOP = CAR (v2); 849 TOP = CAR (v2);
850 NEXT; 850 NEXT;
851 } 851 }
@@ -1275,11 +1275,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1275 /* Exchange args and then do nth. */ 1275 /* Exchange args and then do nth. */
1276 Lisp_Object v2 = POP, v1 = TOP; 1276 Lisp_Object v2 = POP, v1 = TOP;
1277 CHECK_NUMBER (v2); 1277 CHECK_NUMBER (v2);
1278 EMACS_INT n = XINT (v2); 1278 for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
1279 immediate_quit = true; 1279 {
1280 while (--n >= 0 && CONSP (v1)) 1280 v1 = XCDR (v1);
1281 v1 = XCDR (v1); 1281 rarely_quit (n);
1282 immediate_quit = false; 1282 }
1283 TOP = CAR (v1); 1283 TOP = CAR (v1);
1284 } 1284 }
1285 else 1285 else
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..84324c48dcf 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
202 QUIT; 202 /* This will quit on C-g. */
203 wait_for_termination (synch_process_pid, 0, 1); 203 wait_for_termination (synch_process_pid, 0, 1);
204
204 synch_process_pid = 0; 205 synch_process_pid = 0;
205 immediate_quit = 0;
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,9 +726,6 @@ 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;
730 QUIT;
731
732 if (0 <= fd0) 729 if (0 <= fd0)
733 { 730 {
734 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 }; 731 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
@@ -749,8 +746,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
749 nread = carryover; 746 nread = carryover;
750 while (nread < bufsize - 1024) 747 while (nread < bufsize - 1024)
751 { 748 {
752 int this_read = emacs_read (fd0, buf + nread, 749 int this_read = emacs_read_quit (fd0, buf + nread,
753 bufsize - nread); 750 bufsize - nread);
754 751
755 if (this_read < 0) 752 if (this_read < 0)
756 goto give_up; 753 goto give_up;
@@ -769,7 +766,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
769 } 766 }
770 767
771 /* Now NREAD is the total amount of data in the buffer. */ 768 /* Now NREAD is the total amount of data in the buffer. */
772 immediate_quit = 0;
773 769
774 if (!nread) 770 if (!nread)
775 ; 771 ;
@@ -842,8 +838,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
842 we should have already detected a coding system. */ 838 we should have already detected a coding system. */
843 display_on_the_fly = true; 839 display_on_the_fly = true;
844 } 840 }
845 immediate_quit = true;
846 QUIT;
847 } 841 }
848 give_up: ; 842 give_up: ;
849 843
@@ -860,8 +854,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
860 wait_for_termination (pid, &status, fd0 < 0); 854 wait_for_termination (pid, &status, fd0 < 0);
861#endif 855#endif
862 856
863 immediate_quit = 0;
864
865 /* Don't kill any children that the subprocess may have left behind 857 /* Don't kill any children that the subprocess may have left behind
866 when exiting. */ 858 when exiting. */
867 synch_process_pid = 0; 859 synch_process_pid = 0;
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..5ea00fb8db4 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,14 +248,11 @@ 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 maybe_quit ();
252 QUIT;
253 252
254 bool wanted = (NILP (match) 253 bool wanted = (NILP (match)
255 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); 254 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
256 255
257 immediate_quit = 0;
258
259 if (wanted) 256 if (wanted)
260 { 257 {
261 if (!NILP (full)) 258 if (!NILP (full))
@@ -508,7 +505,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
508 ptrdiff_t len = dirent_namelen (dp); 505 ptrdiff_t len = dirent_namelen (dp);
509 bool canexclude = 0; 506 bool canexclude = 0;
510 507
511 QUIT; 508 maybe_quit ();
512 if (len < SCHARS (encoded_file) 509 if (len < SCHARS (encoded_file)
513 || (scmp (dp->d_name, SSDATA (encoded_file), 510 || (scmp (dp->d_name, SSDATA (encoded_file),
514 SCHARS (encoded_file)) 511 SCHARS (encoded_file))
diff --git a/src/dispextern.h b/src/dispextern.h
index 51222e636be..eb71a82311c 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3263,6 +3263,7 @@ void move_it_past_eol (struct it *);
3263void move_it_in_display_line (struct it *it, 3263void move_it_in_display_line (struct it *it,
3264 ptrdiff_t to_charpos, int to_x, 3264 ptrdiff_t to_charpos, int to_x,
3265 enum move_operation_enum op); 3265 enum move_operation_enum op);
3266int partial_line_height (struct it *it_origin);
3266bool in_display_vector_p (struct it *); 3267bool in_display_vector_p (struct it *);
3267int frame_mode_line_height (struct frame *); 3268int frame_mode_line_height (struct frame *);
3268extern bool redisplaying_p; 3269extern bool redisplaying_p;
diff --git a/src/doc.c b/src/doc.c
index 361d09a0878..1e7e3fcf6a6 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -186,7 +186,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
186 If we read the same block last time, maybe skip this? */ 186 If we read the same block last time, maybe skip this? */
187 if (space_left > 1024 * 8) 187 if (space_left > 1024 * 8)
188 space_left = 1024 * 8; 188 space_left = 1024 * 8;
189 nread = emacs_read (fd, p, space_left); 189 nread = emacs_read_quit (fd, p, space_left);
190 if (nread < 0) 190 if (nread < 0)
191 report_file_error ("Read error on documentation file", file); 191 report_file_error ("Read error on documentation file", file);
192 p[nread] = 0; 192 p[nread] = 0;
@@ -590,16 +590,15 @@ the same file name is found in the `doc-directory'. */)
590 Vdoc_file_name = filename; 590 Vdoc_file_name = filename;
591 filled = 0; 591 filled = 0;
592 pos = 0; 592 pos = 0;
593 while (1) 593 while (true)
594 { 594 {
595 register char *end;
596 if (filled < 512) 595 if (filled < 512)
597 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled); 596 filled += emacs_read_quit (fd, &buf[filled], sizeof buf - 1 - filled);
598 if (!filled) 597 if (!filled)
599 break; 598 break;
600 599
601 buf[filled] = 0; 600 buf[filled] = 0;
602 end = buf + (filled < 512 ? filled : filled - 128); 601 char *end = buf + (filled < 512 ? filled : filled - 128);
603 p = memchr (buf, '\037', end - buf); 602 p = memchr (buf, '\037', end - buf);
604 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */ 603 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
605 if (p) 604 if (p)
diff --git a/src/editfns.c b/src/editfns.c
index bee3bbc2cdd..4618164d008 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
@@ -3060,8 +3060,6 @@ determines whether case is significant or ignored. */)
3060 characters, not just the bytes. */ 3060 characters, not just the bytes. */
3061 int c1, c2; 3061 int c1, c2;
3062 3062
3063 QUIT;
3064
3065 if (! NILP (BVAR (bp1, enable_multibyte_characters))) 3063 if (! NILP (BVAR (bp1, enable_multibyte_characters)))
3066 { 3064 {
3067 c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); 3065 c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
@@ -3093,12 +3091,12 @@ determines whether case is significant or ignored. */)
3093 c1 = char_table_translate (trt, c1); 3091 c1 = char_table_translate (trt, c1);
3094 c2 = char_table_translate (trt, c2); 3092 c2 = char_table_translate (trt, c2);
3095 } 3093 }
3096 if (c1 < c2) 3094
3097 return make_number (- 1 - chars); 3095 if (c1 != c2)
3098 if (c1 > c2) 3096 return make_number (c1 < c2 ? -1 - chars : chars + 1);
3099 return make_number (chars + 1);
3100 3097
3101 chars++; 3098 chars++;
3099 rarely_quit (chars);
3102 } 3100 }
3103 3101
3104 /* The strings match as far as they go. 3102 /* The strings match as far as they go.
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/emacs.c b/src/emacs.c
index 28b395c4fb4..3083d0df302 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -688,7 +688,7 @@ main (int argc, char **argv)
688 dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0 688 dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0
689 || strcmp (argv[argc - 1], "bootstrap") == 0 ); 689 || strcmp (argv[argc - 1], "bootstrap") == 0 );
690 690
691 generating_ldefs_boot = getenv ("GENERATE_LDEFS_BOOT"); 691 generating_ldefs_boot = !!getenv ("GENERATE_LDEFS_BOOT");
692 692
693 693
694 /* True if address randomization interferes with memory allocation. */ 694 /* True if address randomization interferes with memory allocation. */
diff --git a/src/eval.c b/src/eval.c
index c05c8d8f8de..22b02b49521 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -856,11 +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 CHECK_LIST (varlist);
861 while (CONSP (varlist))
862 { 860 {
863 QUIT; 861 maybe_quit ();
864 862
865 elt = XCAR (varlist); 863 elt = XCAR (varlist);
866 if (SYMBOLP (elt)) 864 if (SYMBOLP (elt))
@@ -894,9 +892,8 @@ usage: (let* VARLIST BODY...) */)
894 } 892 }
895 else 893 else
896 specbind (var, val); 894 specbind (var, val);
897
898 varlist = XCDR (varlist);
899 } 895 }
896 CHECK_LIST_END (varlist, XCAR (args));
900 897
901 val = Fprogn (XCDR (args)); 898 val = Fprogn (XCDR (args));
902 return unbind_to (count, val); 899 return unbind_to (count, val);
@@ -928,7 +925,7 @@ usage: (let VARLIST BODY...) */)
928 925
929 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) 926 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
930 { 927 {
931 QUIT; 928 maybe_quit ();
932 elt = XCAR (varlist); 929 elt = XCAR (varlist);
933 if (SYMBOLP (elt)) 930 if (SYMBOLP (elt))
934 temps [argnum++] = Qnil; 931 temps [argnum++] = Qnil;
@@ -981,7 +978,7 @@ usage: (while TEST BODY...) */)
981 body = XCDR (args); 978 body = XCDR (args);
982 while (!NILP (eval_sub (test))) 979 while (!NILP (eval_sub (test)))
983 { 980 {
984 QUIT; 981 maybe_quit ();
985 prog_ignore (body); 982 prog_ignore (body);
986 } 983 }
987 984
@@ -1014,7 +1011,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1014 until we get a symbol that is not an alias. */ 1011 until we get a symbol that is not an alias. */
1015 while (SYMBOLP (def)) 1012 while (SYMBOLP (def))
1016 { 1013 {
1017 QUIT; 1014 maybe_quit ();
1018 sym = def; 1015 sym = def;
1019 tem = Fassq (sym, environment); 1016 tem = Fassq (sym, environment);
1020 if (NILP (tem)) 1017 if (NILP (tem))
@@ -1134,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
1134 /* Restore certain special C variables. */ 1131 /* Restore certain special C variables. */
1135 set_poll_suppress_count (catch->poll_suppress_count); 1132 set_poll_suppress_count (catch->poll_suppress_count);
1136 unblock_input_to (catch->interrupt_input_blocked); 1133 unblock_input_to (catch->interrupt_input_blocked);
1137 immediate_quit = 0;
1138 1134
1139 do 1135 do
1140 { 1136 {
@@ -1453,7 +1449,7 @@ static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
1453static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, 1449static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
1454 Lisp_Object data); 1450 Lisp_Object data);
1455 1451
1456void 1452static void
1457process_quit_flag (void) 1453process_quit_flag (void)
1458{ 1454{
1459 Lisp_Object flag = Vquit_flag; 1455 Lisp_Object flag = Vquit_flag;
@@ -1465,6 +1461,28 @@ process_quit_flag (void)
1465 quit (); 1461 quit ();
1466} 1462}
1467 1463
1464/* Check quit-flag and quit if it is non-nil. Typing C-g does not
1465 directly cause a quit; it only sets Vquit_flag. So the program
1466 needs to call maybe_quit at times when it is safe to quit. Every
1467 loop that might run for a long time or might not exit ought to call
1468 maybe_quit at least once, at a safe place. Unless that is
1469 impossible, of course. But it is very desirable to avoid creating
1470 loops where maybe_quit is impossible.
1471
1472 If quit-flag is set to `kill-emacs' the SIGINT handler has received
1473 a request to exit Emacs when it is safe to do.
1474
1475 When not quitting, process any pending signals. */
1476
1477void
1478maybe_quit (void)
1479{
1480 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
1481 process_quit_flag ();
1482 else if (pending_signals)
1483 process_pending_signals ();
1484}
1485
1468DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, 1486DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
1469 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. 1487 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
1470This function does not return. 1488This function does not return.
@@ -1508,10 +1526,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
1508 Lisp_Object string; 1526 Lisp_Object string;
1509 Lisp_Object real_error_symbol 1527 Lisp_Object real_error_symbol
1510 = (NILP (error_symbol) ? Fcar (data) : error_symbol); 1528 = (NILP (error_symbol) ? Fcar (data) : error_symbol);
1511 register Lisp_Object clause = Qnil; 1529 Lisp_Object clause = Qnil;
1512 struct handler *h; 1530 struct handler *h;
1513 1531
1514 immediate_quit = 0;
1515 if (gc_in_progress || waiting_for_input) 1532 if (gc_in_progress || waiting_for_input)
1516 emacs_abort (); 1533 emacs_abort ();
1517 1534
@@ -2129,7 +2146,7 @@ eval_sub (Lisp_Object form)
2129 if (!CONSP (form)) 2146 if (!CONSP (form))
2130 return form; 2147 return form;
2131 2148
2132 QUIT; 2149 maybe_quit ();
2133 2150
2134 maybe_gc (); 2151 maybe_gc ();
2135 2152
@@ -2715,7 +2732,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2715 Lisp_Object val; 2732 Lisp_Object val;
2716 ptrdiff_t count; 2733 ptrdiff_t count;
2717 2734
2718 QUIT; 2735 maybe_quit ();
2719 2736
2720 if (++lisp_eval_depth > max_lisp_eval_depth) 2737 if (++lisp_eval_depth > max_lisp_eval_depth)
2721 { 2738 {
@@ -2960,7 +2977,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
2960 bool previous_optional_or_rest = false; 2977 bool previous_optional_or_rest = false;
2961 for (; CONSP (syms_left); syms_left = XCDR (syms_left)) 2978 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
2962 { 2979 {
2963 QUIT; 2980 maybe_quit ();
2964 2981
2965 next = XCAR (syms_left); 2982 next = XCAR (syms_left);
2966 if (!SYMBOLP (next)) 2983 if (!SYMBOLP (next))
@@ -3098,7 +3115,7 @@ lambda_arity (Lisp_Object fun)
3098 if (EQ (XCAR (fun), Qclosure)) 3115 if (EQ (XCAR (fun), Qclosure))
3099 { 3116 {
3100 fun = XCDR (fun); /* Drop `closure'. */ 3117 fun = XCDR (fun); /* Drop `closure'. */
3101 CHECK_LIST_CONS (fun, fun); 3118 CHECK_CONS (fun);
3102 } 3119 }
3103 syms_left = XCDR (fun); 3120 syms_left = XCDR (fun);
3104 if (CONSP (syms_left)) 3121 if (CONSP (syms_left))
diff --git a/src/fileio.c b/src/fileio.c
index 8c8cba9e49c..38400623793 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,7 @@ 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;
1964 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); 1963 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
1965 immediate_quit = 0;
1966 1964
1967 if (ifd < 0) 1965 if (ifd < 0)
1968 report_file_error ("Opening input file", file); 1966 report_file_error ("Opening input file", file);
@@ -2024,8 +2022,7 @@ permissions. */)
2024 oldsize = out_st.st_size; 2022 oldsize = out_st.st_size;
2025 } 2023 }
2026 2024
2027 immediate_quit = 1; 2025 maybe_quit ();
2028 QUIT;
2029 2026
2030 if (clone_file (ofd, ifd)) 2027 if (clone_file (ofd, ifd))
2031 newsize = st.st_size; 2028 newsize = st.st_size;
@@ -2033,9 +2030,9 @@ permissions. */)
2033 { 2030 {
2034 char buf[MAX_ALLOCA]; 2031 char buf[MAX_ALLOCA];
2035 ptrdiff_t n; 2032 ptrdiff_t n;
2036 for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf)); 2033 for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf));
2037 newsize += n) 2034 newsize += n)
2038 if (emacs_write_sig (ofd, buf, n) != n) 2035 if (emacs_write_quit (ofd, buf, n) != n)
2039 report_file_error ("Write error", newname); 2036 report_file_error ("Write error", newname);
2040 if (n < 0) 2037 if (n < 0)
2041 report_file_error ("Read error", file); 2038 report_file_error ("Read error", file);
@@ -2047,8 +2044,6 @@ permissions. */)
2047 if (newsize < oldsize && ftruncate (ofd, newsize) != 0) 2044 if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
2048 report_file_error ("Truncating output file", newname); 2045 report_file_error ("Truncating output file", newname);
2049 2046
2050 immediate_quit = 0;
2051
2052#ifndef MSDOS 2047#ifndef MSDOS
2053 /* Preserve the original file permissions, and if requested, also its 2048 /* Preserve the original file permissions, and if requested, also its
2054 owner and group. */ 2049 owner and group. */
@@ -2682,7 +2677,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2682 2677
2683DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0, 2678DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2684 doc: /* Access file FILENAME, and get an error if that does not work. 2679 doc: /* Access file FILENAME, and get an error if that does not work.
2685The second argument STRING is used in the error message. 2680The second argument STRING is prepended to the error message.
2686If there is no error, returns nil. */) 2681If there is no error, returns nil. */)
2687 (Lisp_Object filename, Lisp_Object string) 2682 (Lisp_Object filename, Lisp_Object string)
2688{ 2683{
@@ -2815,7 +2810,17 @@ really is a readable and searchable directory. */)
2815 if (!NILP (handler)) 2810 if (!NILP (handler))
2816 { 2811 {
2817 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname); 2812 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2818 errno = 0; 2813
2814 /* Set errno in case the handler failed. EACCES might be a lie
2815 (e.g., the directory might not exist, or be a regular file),
2816 but at least it does TRT in the "usual" case of an existing
2817 directory that is not accessible by the current user, and
2818 avoids reporting "Success" for a failed operation. Perhaps
2819 someday we can fix this in a better way, by improving
2820 file-accessible-directory-p's API; see Bug#25419. */
2821 if (!EQ (r, Qt))
2822 errno = EACCES;
2823
2819 return r; 2824 return r;
2820 } 2825 }
2821 2826
@@ -3391,15 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data)
3391static Lisp_Object 3396static Lisp_Object
3392read_non_regular (Lisp_Object state) 3397read_non_regular (Lisp_Object state)
3393{ 3398{
3394 int nbytes; 3399 int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
3395 3400 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3396 immediate_quit = 1; 3401 + XSAVE_INTEGER (state, 1)),
3397 QUIT; 3402 XSAVE_INTEGER (state, 2));
3398 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3399 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3400 + XSAVE_INTEGER (state, 1)),
3401 XSAVE_INTEGER (state, 2));
3402 immediate_quit = 0;
3403 /* Fast recycle this object for the likely next call. */ 3403 /* Fast recycle this object for the likely next call. */
3404 free_misc (state); 3404 free_misc (state);
3405 return make_number (nbytes); 3405 return make_number (nbytes);
@@ -3743,17 +3743,17 @@ by calling `format-decode', which see. */)
3743 int nread; 3743 int nread;
3744 3744
3745 if (st.st_size <= (1024 * 4)) 3745 if (st.st_size <= (1024 * 4))
3746 nread = emacs_read (fd, read_buf, 1024 * 4); 3746 nread = emacs_read_quit (fd, read_buf, 1024 * 4);
3747 else 3747 else
3748 { 3748 {
3749 nread = emacs_read (fd, read_buf, 1024); 3749 nread = emacs_read_quit (fd, read_buf, 1024);
3750 if (nread == 1024) 3750 if (nread == 1024)
3751 { 3751 {
3752 int ntail; 3752 int ntail;
3753 if (lseek (fd, - (1024 * 3), SEEK_END) < 0) 3753 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3754 report_file_error ("Setting file position", 3754 report_file_error ("Setting file position",
3755 orig_filename); 3755 orig_filename);
3756 ntail = emacs_read (fd, read_buf + nread, 1024 * 3); 3756 ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
3757 nread = ntail < 0 ? ntail : nread + ntail; 3757 nread = ntail < 0 ? ntail : nread + ntail;
3758 } 3758 }
3759 } 3759 }
@@ -3858,15 +3858,11 @@ by calling `format-decode', which see. */)
3858 report_file_error ("Setting file position", orig_filename); 3858 report_file_error ("Setting file position", orig_filename);
3859 } 3859 }
3860 3860
3861 immediate_quit = 1;
3862 QUIT;
3863 /* Count how many chars at the start of the file 3861 /* Count how many chars at the start of the file
3864 match the text at the beginning of the buffer. */ 3862 match the text at the beginning of the buffer. */
3865 while (1) 3863 while (true)
3866 { 3864 {
3867 int nread, bufpos; 3865 int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
3868
3869 nread = emacs_read (fd, read_buf, sizeof read_buf);
3870 if (nread < 0) 3866 if (nread < 0)
3871 report_file_error ("Read error", orig_filename); 3867 report_file_error ("Read error", orig_filename);
3872 else if (nread == 0) 3868 else if (nread == 0)
@@ -3888,7 +3884,7 @@ by calling `format-decode', which see. */)
3888 break; 3884 break;
3889 } 3885 }
3890 3886
3891 bufpos = 0; 3887 int bufpos = 0;
3892 while (bufpos < nread && same_at_start < ZV_BYTE 3888 while (bufpos < nread && same_at_start < ZV_BYTE
3893 && FETCH_BYTE (same_at_start) == read_buf[bufpos]) 3889 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3894 same_at_start++, bufpos++; 3890 same_at_start++, bufpos++;
@@ -3897,7 +3893,6 @@ by calling `format-decode', which see. */)
3897 if (bufpos != nread) 3893 if (bufpos != nread)
3898 break; 3894 break;
3899 } 3895 }
3900 immediate_quit = false;
3901 /* If the file matches the buffer completely, 3896 /* If the file matches the buffer completely,
3902 there's no need to replace anything. */ 3897 there's no need to replace anything. */
3903 if (same_at_start - BEGV_BYTE == end_offset - beg_offset) 3898 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
@@ -3909,8 +3904,7 @@ by calling `format-decode', which see. */)
3909 del_range_1 (same_at_start, same_at_end, 0, 0); 3904 del_range_1 (same_at_start, same_at_end, 0, 0);
3910 goto handled; 3905 goto handled;
3911 } 3906 }
3912 immediate_quit = true; 3907
3913 QUIT;
3914 /* Count how many chars at the end of the file 3908 /* Count how many chars at the end of the file
3915 match the text at the end of the buffer. But, if we have 3909 match the text at the end of the buffer. But, if we have
3916 already found that decoding is necessary, don't waste time. */ 3910 already found that decoding is necessary, don't waste time. */
@@ -3932,7 +3926,8 @@ by calling `format-decode', which see. */)
3932 total_read = nread = 0; 3926 total_read = nread = 0;
3933 while (total_read < trial) 3927 while (total_read < trial)
3934 { 3928 {
3935 nread = emacs_read (fd, read_buf + total_read, trial - total_read); 3929 nread = emacs_read_quit (fd, read_buf + total_read,
3930 trial - total_read);
3936 if (nread < 0) 3931 if (nread < 0)
3937 report_file_error ("Read error", orig_filename); 3932 report_file_error ("Read error", orig_filename);
3938 else if (nread == 0) 3933 else if (nread == 0)
@@ -3967,7 +3962,6 @@ by calling `format-decode', which see. */)
3967 if (nread == 0) 3962 if (nread == 0)
3968 break; 3963 break;
3969 } 3964 }
3970 immediate_quit = 0;
3971 3965
3972 if (! giveup_match_end) 3966 if (! giveup_match_end)
3973 { 3967 {
@@ -4059,18 +4053,13 @@ by calling `format-decode', which see. */)
4059 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ 4053 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
4060 unprocessed = 0; /* Bytes not processed in previous loop. */ 4054 unprocessed = 0; /* Bytes not processed in previous loop. */
4061 4055
4062 while (1) 4056 while (true)
4063 { 4057 {
4064 /* Read at most READ_BUF_SIZE bytes at a time, to allow 4058 /* Read at most READ_BUF_SIZE bytes at a time, to allow
4065 quitting while reading a huge file. */ 4059 quitting while reading a huge file. */
4066 4060
4067 /* Allow quitting out of the actual I/O. */ 4061 this = emacs_read_quit (fd, read_buf + unprocessed,
4068 immediate_quit = 1; 4062 READ_BUF_SIZE - unprocessed);
4069 QUIT;
4070 this = emacs_read (fd, read_buf + unprocessed,
4071 READ_BUF_SIZE - unprocessed);
4072 immediate_quit = 0;
4073
4074 if (this <= 0) 4063 if (this <= 0)
4075 break; 4064 break;
4076 4065
@@ -4284,13 +4273,10 @@ by calling `format-decode', which see. */)
4284 /* Allow quitting out of the actual I/O. We don't make text 4273 /* 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 4274 part of the buffer until all the reading is done, so a C-g
4286 here doesn't do any harm. */ 4275 here doesn't do any harm. */
4287 immediate_quit = 1; 4276 this = emacs_read_quit (fd,
4288 QUIT; 4277 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4289 this = emacs_read (fd, 4278 + inserted),
4290 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 4279 trytry);
4291 + inserted),
4292 trytry);
4293 immediate_quit = 0;
4294 } 4280 }
4295 4281
4296 if (this <= 0) 4282 if (this <= 0)
@@ -4602,7 +4588,7 @@ by calling `format-decode', which see. */)
4602 } 4588 }
4603 } 4589 }
4604 4590
4605 QUIT; 4591 maybe_quit ();
4606 p = XCDR (p); 4592 p = XCDR (p);
4607 } 4593 }
4608 4594
@@ -4992,8 +4978,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4992 } 4978 }
4993 } 4979 }
4994 4980
4995 immediate_quit = 1;
4996
4997 if (STRINGP (start)) 4981 if (STRINGP (start))
4998 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); 4982 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
4999 else if (XINT (start) != XINT (end)) 4983 else if (XINT (start) != XINT (end))
@@ -5016,8 +5000,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5016 save_errno = errno; 5000 save_errno = errno;
5017 } 5001 }
5018 5002
5019 immediate_quit = 0;
5020
5021 /* fsync is not crucial for temporary files. Nor for auto-save 5003 /* fsync is not crucial for temporary files. Nor for auto-save
5022 files, since they might lose some work anyway. */ 5004 files, since they might lose some work anyway. */
5023 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) 5005 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
@@ -5407,7 +5389,7 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5407 : (STRINGP (coding->dst_object) 5389 : (STRINGP (coding->dst_object)
5408 ? SSDATA (coding->dst_object) 5390 ? SSDATA (coding->dst_object)
5409 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); 5391 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5410 coding->produced -= emacs_write_sig (desc, buf, coding->produced); 5392 coding->produced -= emacs_write_quit (desc, buf, coding->produced);
5411 5393
5412 if (coding->raw_destination) 5394 if (coding->raw_destination)
5413 { 5395 {
diff --git a/src/filelock.c b/src/filelock.c
index 886ab61c7aa..67e8dbd34ed 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -407,9 +407,7 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
407 fcntl (fd, F_SETFD, FD_CLOEXEC); 407 fcntl (fd, F_SETFD, FD_CLOEXEC);
408 lock_info_len = strlen (lock_info_str); 408 lock_info_len = strlen (lock_info_str);
409 err = 0; 409 err = 0;
410 /* Use 'write', not 'emacs_write', as garbage collection 410 if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
411 might signal an error, which would leak FD. */
412 if (write (fd, lock_info_str, lock_info_len) != lock_info_len
413 || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0) 411 || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
414 err = errno; 412 err = errno;
415 /* There is no need to call fsync here, as the contents of 413 /* There is no need to call fsync here, as the contents of
@@ -490,8 +488,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
490 int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0); 488 int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0);
491 if (0 <= fd) 489 if (0 <= fd)
492 { 490 {
493 /* Use read, not emacs_read, since FD isn't unwind-protected. */ 491 ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
494 ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
495 int read_errno = errno; 492 int read_errno = errno;
496 if (emacs_close (fd) != 0) 493 if (emacs_close (fd) != 0)
497 return -1; 494 return -1;
@@ -505,7 +502,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
505 /* readlinkat saw a non-symlink, but emacs_open saw a symlink. 502 /* readlinkat saw a non-symlink, but emacs_open saw a symlink.
506 The former must have been removed and replaced by the latter. 503 The former must have been removed and replaced by the latter.
507 Try again. */ 504 Try again. */
508 QUIT; 505 maybe_quit ();
509 } 506 }
510 507
511 return nbytes; 508 return nbytes;
diff --git a/src/fns.c b/src/fns.c
index 00fa65886f0..ac7c1f265a4 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);
@@ -83,18 +84,8 @@ See Info node `(elisp)Random Numbers' for more details. */)
83 return make_number (val); 84 return make_number (val);
84} 85}
85 86
86/* 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. */
88enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
89
90/* Random data-structure functions. */ 87/* Random data-structure functions. */
91 88
92static void
93CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
94{
95 CHECK_TYPE (NILP (x), Qlistp, y);
96}
97
98DEFUN ("length", Flength, Slength, 1, 1, 0, 89DEFUN ("length", Flength, Slength, 1, 1, 0,
99 doc: /* Return the length of vector, list or string SEQUENCE. 90 doc: /* Return the length of vector, list or string SEQUENCE.
100A byte-code function object is also allowed. 91A byte-code function object is also allowed.
@@ -126,7 +117,7 @@ To get the number of bytes, use `string-bytes'. */)
126 { 117 {
127 if (MOST_POSITIVE_FIXNUM < i) 118 if (MOST_POSITIVE_FIXNUM < i)
128 error ("List too long"); 119 error ("List too long");
129 QUIT; 120 maybe_quit ();
130 } 121 }
131 sequence = XCDR (sequence); 122 sequence = XCDR (sequence);
132 } 123 }
@@ -172,7 +163,7 @@ which is at least the number of distinct elements. */)
172 halftail = XCDR (halftail); 163 halftail = XCDR (halftail);
173 if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0) 164 if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
174 { 165 {
175 QUIT; 166 maybe_quit ();
176 if (lolen == 0) 167 if (lolen == 0)
177 hilen += UINTMAX_MAX + 1.0; 168 hilen += UINTMAX_MAX + 1.0;
178 } 169 }
@@ -1202,17 +1193,12 @@ are shared, however.
1202Elements of ALIST that are not conses are also shared. */) 1193Elements of ALIST that are not conses are also shared. */)
1203 (Lisp_Object alist) 1194 (Lisp_Object alist)
1204{ 1195{
1205 register Lisp_Object tem;
1206
1207 CHECK_LIST (alist);
1208 if (NILP (alist)) 1196 if (NILP (alist))
1209 return alist; 1197 return alist;
1210 alist = concat (1, &alist, Lisp_Cons, 0); 1198 alist = concat (1, &alist, Lisp_Cons, false);
1211 for (tem = alist; CONSP (tem); tem = XCDR (tem)) 1199 for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem))
1212 { 1200 {
1213 register Lisp_Object car; 1201 Lisp_Object car = XCAR (tem);
1214 car = XCAR (tem);
1215
1216 if (CONSP (car)) 1202 if (CONSP (car))
1217 XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); 1203 XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
1218 } 1204 }
@@ -1356,16 +1342,19 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1356 doc: /* Take cdr N times on LIST, return the result. */) 1342 doc: /* Take cdr N times on LIST, return the result. */)
1357 (Lisp_Object n, Lisp_Object list) 1343 (Lisp_Object n, Lisp_Object list)
1358{ 1344{
1359 EMACS_INT i, num;
1360 CHECK_NUMBER (n); 1345 CHECK_NUMBER (n);
1361 num = XINT (n); 1346 Lisp_Object tail = list;
1362 for (i = 0; i < num && !NILP (list); i++) 1347 for (EMACS_INT num = XINT (n); 0 < num; num--)
1363 { 1348 {
1364 QUIT; 1349 if (! CONSP (tail))
1365 CHECK_LIST_CONS (list, list); 1350 {
1366 list = XCDR (list); 1351 CHECK_LIST_END (tail, list);
1352 return Qnil;
1353 }
1354 tail = XCDR (tail);
1355 rarely_quit (num);
1367 } 1356 }
1368 return list; 1357 return tail;
1369} 1358}
1370 1359
1371DEFUN ("nth", Fnth, Snth, 2, 2, 0, 1360DEFUN ("nth", Fnth, Snth, 2, 2, 0,
@@ -1392,66 +1381,55 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
1392DEFUN ("member", Fmember, Smember, 2, 2, 0, 1381DEFUN ("member", Fmember, Smember, 2, 2, 0,
1393 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. 1382 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. */) 1383The value is actually the tail of LIST whose car is ELT. */)
1395 (register Lisp_Object elt, Lisp_Object list) 1384 (Lisp_Object elt, Lisp_Object list)
1396{ 1385{
1397 register Lisp_Object tail; 1386 unsigned short int quit_count = 0;
1398 for (tail = list; !NILP (tail); tail = XCDR (tail)) 1387 Lisp_Object tail;
1388 for (tail = list; CONSP (tail); tail = XCDR (tail))
1399 { 1389 {
1400 register Lisp_Object tem; 1390 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; 1391 return tail;
1405 QUIT; 1392 rarely_quit (++quit_count);
1406 } 1393 }
1394 CHECK_LIST_END (tail, list);
1407 return Qnil; 1395 return Qnil;
1408} 1396}
1409 1397
1410DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, 1398DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1411 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. 1399 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. */) 1400The value is actually the tail of LIST whose car is ELT. */)
1413 (register Lisp_Object elt, Lisp_Object list) 1401 (Lisp_Object elt, Lisp_Object list)
1414{ 1402{
1415 while (1) 1403 unsigned short int quit_count = 0;
1404 Lisp_Object tail;
1405 for (tail = list; CONSP (tail); tail = XCDR (tail))
1416 { 1406 {
1417 if (!CONSP (list) || EQ (XCAR (list), elt)) 1407 if (EQ (XCAR (tail), elt))
1418 break; 1408 return tail;
1419 1409 rarely_quit (++quit_count);
1420 list = XCDR (list);
1421 if (!CONSP (list) || EQ (XCAR (list), elt))
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 } 1410 }
1431 1411 CHECK_LIST_END (tail, list);
1432 CHECK_LIST (list); 1412 return Qnil;
1433 return list;
1434} 1413}
1435 1414
1436DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, 1415DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
1437 doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. 1416 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. */) 1417The value is actually the tail of LIST whose car is ELT. */)
1439 (register Lisp_Object elt, Lisp_Object list) 1418 (Lisp_Object elt, Lisp_Object list)
1440{ 1419{
1441 register Lisp_Object tail;
1442
1443 if (!FLOATP (elt)) 1420 if (!FLOATP (elt))
1444 return Fmemq (elt, list); 1421 return Fmemq (elt, list);
1445 1422
1446 for (tail = list; !NILP (tail); tail = XCDR (tail)) 1423 unsigned short int quit_count = 0;
1424 Lisp_Object tail;
1425 for (tail = list; CONSP (tail); tail = XCDR (tail))
1447 { 1426 {
1448 register Lisp_Object tem; 1427 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)) 1428 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
1452 return tail; 1429 return tail;
1453 QUIT; 1430 rarely_quit (++quit_count);
1454 } 1431 }
1432 CHECK_LIST_END (tail, list);
1455 return Qnil; 1433 return Qnil;
1456} 1434}
1457 1435
@@ -1461,44 +1439,28 @@ The value is actually the first element of LIST whose car is KEY.
1461Elements of LIST that are not conses are ignored. */) 1439Elements of LIST that are not conses are ignored. */)
1462 (Lisp_Object key, Lisp_Object list) 1440 (Lisp_Object key, Lisp_Object list)
1463{ 1441{
1464 while (1) 1442 unsigned short int quit_count = 0;
1443 Lisp_Object tail;
1444 for (tail = list; CONSP (tail); tail = XCDR (tail))
1465 { 1445 {
1466 if (!CONSP (list) 1446 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1467 || (CONSP (XCAR (list)) 1447 return XCAR (tail);
1468 && EQ (XCAR (XCAR (list)), key))) 1448 rarely_quit (++quit_count);
1469 break;
1470
1471 list = XCDR (list);
1472 if (!CONSP (list)
1473 || (CONSP (XCAR (list))
1474 && EQ (XCAR (XCAR (list)), key)))
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 } 1449 }
1486 1450 CHECK_LIST_END (tail, list);
1487 return CAR (list); 1451 return Qnil;
1488} 1452}
1489 1453
1490/* Like Fassq but never report an error and do not allow quits. 1454/* Like Fassq but never report an error and do not allow quits.
1491 Use only on lists known never to be circular. */ 1455 Use only on objects known to be non-circular lists. */
1492 1456
1493Lisp_Object 1457Lisp_Object
1494assq_no_quit (Lisp_Object key, Lisp_Object list) 1458assq_no_quit (Lisp_Object key, Lisp_Object list)
1495{ 1459{
1496 while (CONSP (list) 1460 for (; ! NILP (list); list = XCDR (list))
1497 && (!CONSP (XCAR (list)) 1461 if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key))
1498 || !EQ (XCAR (XCAR (list)), key))) 1462 return XCAR (list);
1499 list = XCDR (list); 1463 return Qnil;
1500
1501 return CAR_SAFE (list);
1502} 1464}
1503 1465
1504DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, 1466DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
@@ -1506,81 +1468,51 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
1506The value is actually the first element of LIST whose car equals KEY. */) 1468The value is actually the first element of LIST whose car equals KEY. */)
1507 (Lisp_Object key, Lisp_Object list) 1469 (Lisp_Object key, Lisp_Object list)
1508{ 1470{
1509 Lisp_Object car; 1471 unsigned short int quit_count = 0;
1510 1472 Lisp_Object tail;
1511 while (1) 1473 for (tail = list; CONSP (tail); tail = XCDR (tail))
1512 { 1474 {
1513 if (!CONSP (list) 1475 Lisp_Object car = XCAR (tail);
1514 || (CONSP (XCAR (list)) 1476 if (CONSP (car)
1515 && (car = XCAR (XCAR (list)), 1477 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1516 EQ (car, key) || !NILP (Fequal (car, key))))) 1478 return car;
1517 break; 1479 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 } 1480 }
1536 1481 CHECK_LIST_END (tail, list);
1537 return CAR (list); 1482 return Qnil;
1538} 1483}
1539 1484
1540/* Like Fassoc but never report an error and do not allow quits. 1485/* Like Fassoc but never report an error and do not allow quits.
1541 Use only on lists known never to be circular. */ 1486 Use only on objects known to be non-circular lists. */
1542 1487
1543Lisp_Object 1488Lisp_Object
1544assoc_no_quit (Lisp_Object key, Lisp_Object list) 1489assoc_no_quit (Lisp_Object key, Lisp_Object list)
1545{ 1490{
1546 while (CONSP (list) 1491 for (; ! NILP (list); list = XCDR (list))
1547 && (!CONSP (XCAR (list)) 1492 {
1548 || (!EQ (XCAR (XCAR (list)), key) 1493 Lisp_Object car = XCAR (list);
1549 && NILP (Fequal (XCAR (XCAR (list)), key))))) 1494 if (CONSP (car)
1550 list = XCDR (list); 1495 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1551 1496 return car;
1552 return CONSP (list) ? XCAR (list) : Qnil; 1497 }
1498 return Qnil;
1553} 1499}
1554 1500
1555DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, 1501DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
1556 doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. 1502 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. */) 1503The value is actually the first element of LIST whose cdr is KEY. */)
1558 (register Lisp_Object key, Lisp_Object list) 1504 (Lisp_Object key, Lisp_Object list)
1559{ 1505{
1560 while (1) 1506 unsigned short int quit_count = 0;
1507 Lisp_Object tail;
1508 for (tail = list; CONSP (tail); tail = XCDR (tail))
1561 { 1509 {
1562 if (!CONSP (list) 1510 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
1563 || (CONSP (XCAR (list)) 1511 return XCAR (tail);
1564 && EQ (XCDR (XCAR (list)), key))) 1512 rarely_quit (++quit_count);
1565 break;
1566
1567 list = XCDR (list);
1568 if (!CONSP (list)
1569 || (CONSP (XCAR (list))
1570 && EQ (XCDR (XCAR (list)), key)))
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 } 1513 }
1582 1514 CHECK_LIST_END (tail, list);
1583 return CAR (list); 1515 return Qnil;
1584} 1516}
1585 1517
1586DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, 1518DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
@@ -1588,35 +1520,18 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
1588The value is actually the first element of LIST whose cdr equals KEY. */) 1520The value is actually the first element of LIST whose cdr equals KEY. */)
1589 (Lisp_Object key, Lisp_Object list) 1521 (Lisp_Object key, Lisp_Object list)
1590{ 1522{
1591 Lisp_Object cdr; 1523 unsigned short int quit_count = 0;
1592 1524 Lisp_Object tail;
1593 while (1) 1525 for (tail = list; CONSP (tail); tail = XCDR (tail))
1594 { 1526 {
1595 if (!CONSP (list) 1527 Lisp_Object car = XCAR (tail);
1596 || (CONSP (XCAR (list)) 1528 if (CONSP (car)
1597 && (cdr = XCDR (XCAR (list)), 1529 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
1598 EQ (cdr, key) || !NILP (Fequal (cdr, key))))) 1530 return car;
1599 break; 1531 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 } 1532 }
1618 1533 CHECK_LIST_END (tail, list);
1619 return CAR (list); 1534 return Qnil;
1620} 1535}
1621 1536
1622DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, 1537DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
@@ -1647,6 +1562,7 @@ argument. */)
1647 else 1562 else
1648 prev = tail; 1563 prev = tail;
1649 } 1564 }
1565 CHECK_LIST_END (tail, list);
1650 return list; 1566 return list;
1651} 1567}
1652 1568
@@ -1754,12 +1670,11 @@ changing the value of a sequence `foo'. */)
1754 } 1670 }
1755 else 1671 else
1756 { 1672 {
1673 unsigned short int quit_count = 0;
1757 Lisp_Object tail, prev; 1674 Lisp_Object tail, prev;
1758 1675
1759 for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) 1676 for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
1760 { 1677 {
1761 CHECK_LIST_CONS (tail, seq);
1762
1763 if (!NILP (Fequal (elt, XCAR (tail)))) 1678 if (!NILP (Fequal (elt, XCAR (tail))))
1764 { 1679 {
1765 if (NILP (prev)) 1680 if (NILP (prev))
@@ -1769,8 +1684,9 @@ changing the value of a sequence `foo'. */)
1769 } 1684 }
1770 else 1685 else
1771 prev = tail; 1686 prev = tail;
1772 QUIT; 1687 rarely_quit (++quit_count);
1773 } 1688 }
1689 CHECK_LIST_END (tail, seq);
1774 } 1690 }
1775 1691
1776 return seq; 1692 return seq;
@@ -1788,16 +1704,17 @@ This function may destructively modify SEQ to produce the value. */)
1788 return Freverse (seq); 1704 return Freverse (seq);
1789 else if (CONSP (seq)) 1705 else if (CONSP (seq))
1790 { 1706 {
1707 unsigned short int quit_count = 0;
1791 Lisp_Object prev, tail, next; 1708 Lisp_Object prev, tail, next;
1792 1709
1793 for (prev = Qnil, tail = seq; !NILP (tail); tail = next) 1710 for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
1794 { 1711 {
1795 QUIT;
1796 CHECK_LIST_CONS (tail, tail);
1797 next = XCDR (tail); 1712 next = XCDR (tail);
1798 Fsetcdr (tail, prev); 1713 Fsetcdr (tail, prev);
1799 prev = tail; 1714 prev = tail;
1715 rarely_quit (++quit_count);
1800 } 1716 }
1717 CHECK_LIST_END (tail, seq);
1801 seq = prev; 1718 seq = prev;
1802 } 1719 }
1803 else if (VECTORP (seq)) 1720 else if (VECTORP (seq))
@@ -1838,10 +1755,11 @@ See also the function `nreverse', which is used more often. */)
1838 return Qnil; 1755 return Qnil;
1839 else if (CONSP (seq)) 1756 else if (CONSP (seq))
1840 { 1757 {
1758 unsigned short int quit_count = 0;
1841 for (new = Qnil; CONSP (seq); seq = XCDR (seq)) 1759 for (new = Qnil; CONSP (seq); seq = XCDR (seq))
1842 { 1760 {
1843 QUIT;
1844 new = Fcons (XCAR (seq), new); 1761 new = Fcons (XCAR (seq), new);
1762 rarely_quit (++quit_count);
1845 } 1763 }
1846 CHECK_LIST_END (seq, seq); 1764 CHECK_LIST_END (seq, seq);
1847 } 1765 }
@@ -2130,12 +2048,11 @@ 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; 2048otherwise 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. 2049use `(setq x (plist-put x prop val))' to be sure to use the new value.
2132The PLIST is modified by side effects. */) 2050The PLIST is modified by side effects. */)
2133 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) 2051 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2134{ 2052{
2135 register Lisp_Object tail, prev; 2053 unsigned short int quit_count = 0;
2136 Lisp_Object newcell; 2054 Lisp_Object prev = Qnil;
2137 prev = Qnil; 2055 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2138 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2139 tail = XCDR (XCDR (tail))) 2056 tail = XCDR (XCDR (tail)))
2140 { 2057 {
2141 if (EQ (prop, XCAR (tail))) 2058 if (EQ (prop, XCAR (tail)))
@@ -2145,13 +2062,13 @@ The PLIST is modified by side effects. */)
2145 } 2062 }
2146 2063
2147 prev = tail; 2064 prev = tail;
2148 QUIT; 2065 rarely_quit (++quit_count);
2149 } 2066 }
2150 newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); 2067 Lisp_Object newcell
2068 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
2151 if (NILP (prev)) 2069 if (NILP (prev))
2152 return newcell; 2070 return newcell;
2153 else 2071 Fsetcdr (XCDR (prev), newcell);
2154 Fsetcdr (XCDR (prev), newcell);
2155 return plist; 2072 return plist;
2156} 2073}
2157 2074
@@ -2174,6 +2091,7 @@ corresponding to the given PROP, or nil if PROP is not
2174one of the properties on the list. */) 2091one of the properties on the list. */)
2175 (Lisp_Object plist, Lisp_Object prop) 2092 (Lisp_Object plist, Lisp_Object prop)
2176{ 2093{
2094 unsigned short int quit_count = 0;
2177 Lisp_Object tail; 2095 Lisp_Object tail;
2178 2096
2179 for (tail = plist; 2097 for (tail = plist;
@@ -2182,8 +2100,7 @@ one of the properties on the list. */)
2182 { 2100 {
2183 if (! NILP (Fequal (prop, XCAR (tail)))) 2101 if (! NILP (Fequal (prop, XCAR (tail))))
2184 return XCAR (XCDR (tail)); 2102 return XCAR (XCDR (tail));
2185 2103 rarely_quit (++quit_count);
2186 QUIT;
2187 } 2104 }
2188 2105
2189 CHECK_LIST_END (tail, prop); 2106 CHECK_LIST_END (tail, prop);
@@ -2199,12 +2116,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; 2116otherwise 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. 2117use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
2201The PLIST is modified by side effects. */) 2118The PLIST is modified by side effects. */)
2202 (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val) 2119 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2203{ 2120{
2204 register Lisp_Object tail, prev; 2121 unsigned short int quit_count = 0;
2205 Lisp_Object newcell; 2122 Lisp_Object prev = Qnil;
2206 prev = Qnil; 2123 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2207 for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2208 tail = XCDR (XCDR (tail))) 2124 tail = XCDR (XCDR (tail)))
2209 { 2125 {
2210 if (! NILP (Fequal (prop, XCAR (tail)))) 2126 if (! NILP (Fequal (prop, XCAR (tail))))
@@ -2214,13 +2130,12 @@ The PLIST is modified by side effects. */)
2214 } 2130 }
2215 2131
2216 prev = tail; 2132 prev = tail;
2217 QUIT; 2133 rarely_quit (++quit_count);
2218 } 2134 }
2219 newcell = list2 (prop, val); 2135 Lisp_Object newcell = list2 (prop, val);
2220 if (NILP (prev)) 2136 if (NILP (prev))
2221 return newcell; 2137 return newcell;
2222 else 2138 Fsetcdr (XCDR (prev), newcell);
2223 Fsetcdr (XCDR (prev), newcell);
2224 return plist; 2139 return plist;
2225} 2140}
2226 2141
@@ -2293,8 +2208,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2293 } 2208 }
2294 } 2209 }
2295 2210
2211 unsigned short int quit_count = 0;
2296 tail_recurse: 2212 tail_recurse:
2297 QUIT; 2213 rarely_quit (++quit_count);
2298 if (EQ (o1, o2)) 2214 if (EQ (o1, o2))
2299 return 1; 2215 return 1;
2300 if (XTYPE (o1) != XTYPE (o2)) 2216 if (XTYPE (o1) != XTYPE (o2))
@@ -2483,14 +2399,12 @@ Only the last argument is not altered, and need not be a list.
2483usage: (nconc &rest LISTS) */) 2399usage: (nconc &rest LISTS) */)
2484 (ptrdiff_t nargs, Lisp_Object *args) 2400 (ptrdiff_t nargs, Lisp_Object *args)
2485{ 2401{
2486 ptrdiff_t argnum; 2402 unsigned short int quit_count = 0;
2487 register Lisp_Object tail, tem, val; 2403 Lisp_Object val = Qnil;
2488
2489 val = tail = Qnil;
2490 2404
2491 for (argnum = 0; argnum < nargs; argnum++) 2405 for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
2492 { 2406 {
2493 tem = args[argnum]; 2407 Lisp_Object tem = args[argnum];
2494 if (NILP (tem)) continue; 2408 if (NILP (tem)) continue;
2495 2409
2496 if (NILP (val)) 2410 if (NILP (val))
@@ -2498,14 +2412,16 @@ usage: (nconc &rest LISTS) */)
2498 2412
2499 if (argnum + 1 == nargs) break; 2413 if (argnum + 1 == nargs) break;
2500 2414
2501 CHECK_LIST_CONS (tem, tem); 2415 CHECK_CONS (tem);
2502 2416
2503 while (CONSP (tem)) 2417 Lisp_Object tail;
2418 do
2504 { 2419 {
2505 tail = tem; 2420 tail = tem;
2506 tem = XCDR (tail); 2421 tem = XCDR (tail);
2507 QUIT; 2422 rarely_quit (++quit_count);
2508 } 2423 }
2424 while (CONSP (tem));
2509 2425
2510 tem = args[argnum + 1]; 2426 tem = args[argnum + 1];
2511 Fsetcdr (tail, tem); 2427 Fsetcdr (tail, tem);
@@ -2927,11 +2843,12 @@ property and a property with the value nil.
2927The value is actually the tail of PLIST whose car is PROP. */) 2843The value is actually the tail of PLIST whose car is PROP. */)
2928 (Lisp_Object plist, Lisp_Object prop) 2844 (Lisp_Object plist, Lisp_Object prop)
2929{ 2845{
2846 unsigned short int quit_count = 0;
2930 while (CONSP (plist) && !EQ (XCAR (plist), prop)) 2847 while (CONSP (plist) && !EQ (XCAR (plist), prop))
2931 { 2848 {
2932 plist = XCDR (plist); 2849 plist = XCDR (plist);
2933 plist = CDR (plist); 2850 plist = CDR (plist);
2934 QUIT; 2851 rarely_quit (++quit_count);
2935 } 2852 }
2936 return plist; 2853 return plist;
2937} 2854}
@@ -3804,12 +3721,17 @@ allocate_hash_table (void)
3804 (table size) is >= REHASH_THRESHOLD. 3721 (table size) is >= REHASH_THRESHOLD.
3805 3722
3806 WEAK specifies the weakness of the table. If non-nil, it must be 3723 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'. */ 3724 one of the symbols `key', `value', `key-or-value', or `key-and-value'.
3725
3726 If PURECOPY is non-nil, the table can be copied to pure storage via
3727 `purecopy' when Emacs is being dumped. Such tables can no longer be
3728 changed after purecopy. */
3808 3729
3809Lisp_Object 3730Lisp_Object
3810make_hash_table (struct hash_table_test test, 3731make_hash_table (struct hash_table_test test,
3811 Lisp_Object size, Lisp_Object rehash_size, 3732 Lisp_Object size, Lisp_Object rehash_size,
3812 Lisp_Object rehash_threshold, Lisp_Object weak) 3733 Lisp_Object rehash_threshold, Lisp_Object weak,
3734 Lisp_Object pure)
3813{ 3735{
3814 struct Lisp_Hash_Table *h; 3736 struct Lisp_Hash_Table *h;
3815 Lisp_Object table; 3737 Lisp_Object table;
@@ -3850,6 +3772,7 @@ make_hash_table (struct hash_table_test test,
3850 h->hash = Fmake_vector (size, Qnil); 3772 h->hash = Fmake_vector (size, Qnil);
3851 h->next = Fmake_vector (size, Qnil); 3773 h->next = Fmake_vector (size, Qnil);
3852 h->index = Fmake_vector (make_number (index_size), Qnil); 3774 h->index = Fmake_vector (make_number (index_size), Qnil);
3775 h->pure = pure;
3853 3776
3854 /* Set up the free list. */ 3777 /* Set up the free list. */
3855 for (i = 0; i < sz - 1; ++i) 3778 for (i = 0; i < sz - 1; ++i)
@@ -4514,10 +4437,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 4437WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
4515is nil. 4438is nil.
4516 4439
4440:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied
4441to pure storage when Emacs is being dumped, making the contents of the
4442table read only. Any further changes to purified tables will result
4443in an error.
4444
4517usage: (make-hash-table &rest KEYWORD-ARGS) */) 4445usage: (make-hash-table &rest KEYWORD-ARGS) */)
4518 (ptrdiff_t nargs, Lisp_Object *args) 4446 (ptrdiff_t nargs, Lisp_Object *args)
4519{ 4447{
4520 Lisp_Object test, size, rehash_size, rehash_threshold, weak; 4448 Lisp_Object test, size, rehash_size, rehash_threshold, weak, pure;
4521 struct hash_table_test testdesc; 4449 struct hash_table_test testdesc;
4522 ptrdiff_t i; 4450 ptrdiff_t i;
4523 USE_SAFE_ALLOCA; 4451 USE_SAFE_ALLOCA;
@@ -4551,6 +4479,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
4551 testdesc.cmpfn = cmpfn_user_defined; 4479 testdesc.cmpfn = cmpfn_user_defined;
4552 } 4480 }
4553 4481
4482 /* See if there's a `:purecopy PURECOPY' argument. */
4483 i = get_key_arg (QCpurecopy, nargs, args, used);
4484 pure = i ? args[i] : Qnil;
4554 /* See if there's a `:size SIZE' argument. */ 4485 /* See if there's a `:size SIZE' argument. */
4555 i = get_key_arg (QCsize, nargs, args, used); 4486 i = get_key_arg (QCsize, nargs, args, used);
4556 size = i ? args[i] : Qnil; 4487 size = i ? args[i] : Qnil;
@@ -4592,7 +4523,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
4592 signal_error ("Invalid argument list", args[i]); 4523 signal_error ("Invalid argument list", args[i]);
4593 4524
4594 SAFE_FREE (); 4525 SAFE_FREE ();
4595 return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak); 4526 return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
4527 pure);
4596} 4528}
4597 4529
4598 4530
@@ -4671,7 +4603,9 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
4671 doc: /* Clear hash table TABLE and return it. */) 4603 doc: /* Clear hash table TABLE and return it. */)
4672 (Lisp_Object table) 4604 (Lisp_Object table)
4673{ 4605{
4674 hash_clear (check_hash_table (table)); 4606 struct Lisp_Hash_Table *h = check_hash_table (table);
4607 CHECK_IMPURE (table, h);
4608 hash_clear (h);
4675 /* Be compatible with XEmacs. */ 4609 /* Be compatible with XEmacs. */
4676 return table; 4610 return table;
4677} 4611}
@@ -4695,9 +4629,10 @@ VALUE. In any case, return VALUE. */)
4695 (Lisp_Object key, Lisp_Object value, Lisp_Object table) 4629 (Lisp_Object key, Lisp_Object value, Lisp_Object table)
4696{ 4630{
4697 struct Lisp_Hash_Table *h = check_hash_table (table); 4631 struct Lisp_Hash_Table *h = check_hash_table (table);
4632 CHECK_IMPURE (table, h);
4633
4698 ptrdiff_t i; 4634 ptrdiff_t i;
4699 EMACS_UINT hash; 4635 EMACS_UINT hash;
4700
4701 i = hash_lookup (h, key, &hash); 4636 i = hash_lookup (h, key, &hash);
4702 if (i >= 0) 4637 if (i >= 0)
4703 set_hash_value_slot (h, i, value); 4638 set_hash_value_slot (h, i, value);
@@ -4713,6 +4648,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
4713 (Lisp_Object key, Lisp_Object table) 4648 (Lisp_Object key, Lisp_Object table)
4714{ 4649{
4715 struct Lisp_Hash_Table *h = check_hash_table (table); 4650 struct Lisp_Hash_Table *h = check_hash_table (table);
4651 CHECK_IMPURE (table, h);
4716 hash_remove_from_table (h, key); 4652 hash_remove_from_table (h, key);
4717 return Qnil; 4653 return Qnil;
4718} 4654}
@@ -5083,6 +5019,7 @@ syms_of_fns (void)
5083 DEFSYM (Qequal, "equal"); 5019 DEFSYM (Qequal, "equal");
5084 DEFSYM (QCtest, ":test"); 5020 DEFSYM (QCtest, ":test");
5085 DEFSYM (QCsize, ":size"); 5021 DEFSYM (QCsize, ":size");
5022 DEFSYM (QCpurecopy, ":purecopy");
5086 DEFSYM (QCrehash_size, ":rehash-size"); 5023 DEFSYM (QCrehash_size, ":rehash-size");
5087 DEFSYM (QCrehash_threshold, ":rehash-threshold"); 5024 DEFSYM (QCrehash_threshold, ":rehash-threshold");
5088 DEFSYM (QCweakness, ":weakness"); 5025 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..f630ebb847c 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,9 +1200,6 @@ 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;
1204 QUIT;
1205
1206 /* It's just impossible to be too paranoid here. */ 1203 /* It's just impossible to be too paranoid here. */
1207 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); 1204 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
1208 1205
@@ -1214,8 +1211,12 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1214 cmp_it.id = -1; 1211 cmp_it.id = -1;
1215 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); 1212 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil);
1216 1213
1217 while (1) 1214 unsigned short int quit_count = 0;
1215
1216 while (true)
1218 { 1217 {
1218 rarely_quit (++quit_count);
1219
1219 while (pos == next_boundary) 1220 while (pos == next_boundary)
1220 { 1221 {
1221 ptrdiff_t pos_here = pos; 1222 ptrdiff_t pos_here = pos;
@@ -1280,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1280 pos = newpos; 1281 pos = newpos;
1281 pos_byte = CHAR_TO_BYTE (pos); 1282 pos_byte = CHAR_TO_BYTE (pos);
1282 } 1283 }
1284
1285 rarely_quit (++quit_count);
1283 } 1286 }
1284 1287
1285 /* Handle right margin. */ 1288 /* Handle right margin. */
@@ -1602,6 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1602 pos = find_before_next_newline (pos, to, 1, &pos_byte); 1605 pos = find_before_next_newline (pos, to, 1, &pos_byte);
1603 if (pos < to) 1606 if (pos < to)
1604 INC_BOTH (pos, pos_byte); 1607 INC_BOTH (pos, pos_byte);
1608 rarely_quit (++quit_count);
1605 } 1609 }
1606 while (pos < to 1610 while (pos < to
1607 && indented_beyond_p (pos, pos_byte, 1611 && indented_beyond_p (pos, pos_byte,
@@ -1694,7 +1698,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1694 /* Nonzero if have just continued a line */ 1698 /* Nonzero if have just continued a line */
1695 val_compute_motion.contin = (contin_hpos && prev_hpos == 0); 1699 val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
1696 1700
1697 immediate_quit = 0;
1698 return &val_compute_motion; 1701 return &val_compute_motion;
1699} 1702}
1700 1703
diff --git a/src/insdel.c b/src/insdel.c
index ce4960447f2..4627bd54b0b 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..a86e7c5f8e4 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
@@ -169,9 +169,6 @@ struct kboard *echo_kboard;
169 169
170Lisp_Object echo_message_buffer; 170Lisp_Object echo_message_buffer;
171 171
172/* True means C-g should cause immediate error-signal. */
173bool immediate_quit;
174
175/* Character that causes a quit. Normally C-g. 172/* Character that causes a quit. Normally C-g.
176 173
177 If we are running on an ordinary terminal, this must be an ordinary 174 If we are running on an ordinary terminal, this must be an ordinary
@@ -1416,7 +1413,7 @@ command_loop_1 (void)
1416 if (!NILP (Vquit_flag)) 1413 if (!NILP (Vquit_flag))
1417 { 1414 {
1418 Vexecuting_kbd_macro = Qt; 1415 Vexecuting_kbd_macro = Qt;
1419 QUIT; /* Make some noise. */ 1416 maybe_quit (); /* Make some noise. */
1420 /* Will return since macro now empty. */ 1417 /* Will return since macro now empty. */
1421 } 1418 }
1422 } 1419 }
@@ -3584,16 +3581,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
3584 as input, set quit-flag to cause an interrupt. */ 3581 as input, set quit-flag to cause an interrupt. */
3585 if (!NILP (Vthrow_on_input) 3582 if (!NILP (Vthrow_on_input)
3586 && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) 3583 && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)))
3587 { 3584 Vquit_flag = Vthrow_on_input;
3588 Vquit_flag = Vthrow_on_input;
3589 /* If we're inside a function that wants immediate quits,
3590 do it now. */
3591 if (immediate_quit && NILP (Vinhibit_quit))
3592 {
3593 immediate_quit = false;
3594 QUIT;
3595 }
3596 }
3597} 3585}
3598 3586
3599 3587
@@ -7053,40 +7041,22 @@ tty_read_avail_input (struct terminal *terminal,
7053 7041
7054 /* Now read; for one reason or another, this will not block. 7042 /* Now read; for one reason or another, this will not block.
7055 NREAD is set to the number of chars read. */ 7043 NREAD is set to the number of chars read. */
7056 do 7044 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
7057 { 7045 /* POSIX infers that processes which are not in the session leader's
7058 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); 7046 process group won't get SIGHUPs at logout time. BSDI adheres to
7059 /* POSIX infers that processes which are not in the session leader's 7047 this part standard and returns -1 from read (0) with errno==EIO
7060 process group won't get SIGHUPs at logout time. BSDI adheres to 7048 when the control tty is taken away.
7061 this part standard and returns -1 from read (0) with errno==EIO 7049 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7062 when the control tty is taken away. 7050 if (nread == -1 && errno == EIO)
7063 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */ 7051 return -2; /* Close this terminal. */
7064 if (nread == -1 && errno == EIO) 7052#if defined AIX && defined _BSD
7065 return -2; /* Close this terminal. */ 7053 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7066#if defined (AIX) && defined (_BSD) 7054 This looks incorrect, but it isn't, because _BSD causes
7067 /* The kernel sometimes fails to deliver SIGHUP for ptys. 7055 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7068 This looks incorrect, but it isn't, because _BSD causes 7056 and that causes a value other than 0 when there is no input. */
7069 O_NDELAY to be defined in fcntl.h as O_NONBLOCK, 7057 if (nread == 0)
7070 and that causes a value other than 0 when there is no input. */ 7058 return -2; /* Close this terminal. */
7071 if (nread == 0)
7072 return -2; /* Close this terminal. */
7073#endif
7074 }
7075 while (
7076 /* We used to retry the read if it was interrupted.
7077 But this does the wrong thing when O_NONBLOCK causes
7078 an EAGAIN error. Does anybody know of a situation
7079 where a retry is actually needed? */
7080#if 0
7081 nread < 0 && (errno == EAGAIN || errno == EFAULT
7082#ifdef EBADSLT
7083 || errno == EBADSLT
7084#endif
7085 )
7086#else
7087 0
7088#endif 7059#endif
7089 );
7090 7060
7091#ifndef USABLE_FIONREAD 7061#ifndef USABLE_FIONREAD
7092#if defined (USG) || defined (CYGWIN) 7062#if defined (USG) || defined (CYGWIN)
@@ -7426,7 +7396,7 @@ menu_bar_items (Lisp_Object old)
7426 USE_SAFE_ALLOCA; 7396 USE_SAFE_ALLOCA;
7427 7397
7428 /* In order to build the menus, we need to call the keymap 7398 /* In order to build the menus, we need to call the keymap
7429 accessors. They all call QUIT. But this function is called 7399 accessors. They all call maybe_quit. But this function is called
7430 during redisplay, during which a quit is fatal. So inhibit 7400 during redisplay, during which a quit is fatal. So inhibit
7431 quitting while building the menus. 7401 quitting while building the menus.
7432 We do this instead of specbind because (1) errors will clear it anyway 7402 We do this instead of specbind because (1) errors will clear it anyway
@@ -7987,7 +7957,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems)
7987 *nitems = 0; 7957 *nitems = 0;
7988 7958
7989 /* In order to build the menus, we need to call the keymap 7959 /* In order to build the menus, we need to call the keymap
7990 accessors. They all call QUIT. But this function is called 7960 accessors. They all call maybe_quit. But this function is called
7991 during redisplay, during which a quit is fatal. So inhibit 7961 during redisplay, during which a quit is fatal. So inhibit
7992 quitting while building the menus. We do this instead of 7962 quitting while building the menus. We do this instead of
7993 specbind because (1) errors will clear it anyway and (2) this 7963 specbind because (1) errors will clear it anyway and (2) this
@@ -9806,7 +9776,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9806 9776
9807 if (!NILP (prompt)) 9777 if (!NILP (prompt))
9808 CHECK_STRING (prompt); 9778 CHECK_STRING (prompt);
9809 QUIT; 9779 maybe_quit ();
9810 9780
9811 specbind (Qinput_method_exit_on_first_char, 9781 specbind (Qinput_method_exit_on_first_char,
9812 (NILP (cmd_loop) ? Qt : Qnil)); 9782 (NILP (cmd_loop) ? Qt : Qnil));
@@ -9840,7 +9810,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9840 if (i == -1) 9810 if (i == -1)
9841 { 9811 {
9842 Vquit_flag = Qt; 9812 Vquit_flag = Qt;
9843 QUIT; 9813 maybe_quit ();
9844 } 9814 }
9845 9815
9846 return unbind_to (count, 9816 return unbind_to (count,
@@ -10278,7 +10248,7 @@ clear_waiting_for_input (void)
10278 10248
10279 If we have a frame on the controlling tty, we assume that the 10249 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. 10250 SIGINT was generated by C-g, so we call handle_interrupt.
10281 Otherwise, tell QUIT to kill Emacs. */ 10251 Otherwise, tell maybe_quit to kill Emacs. */
10282 10252
10283static void 10253static void
10284handle_interrupt_signal (int sig) 10254handle_interrupt_signal (int sig)
@@ -10289,7 +10259,7 @@ handle_interrupt_signal (int sig)
10289 { 10259 {
10290 /* If there are no frames there, let's pretend that we are a 10260 /* 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 10261 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 10262 in a signal handler, so tell maybe_quit to exit when it is
10293 safe. */ 10263 safe. */
10294 Vquit_flag = Qkill_emacs; 10264 Vquit_flag = Qkill_emacs;
10295 } 10265 }
@@ -10445,30 +10415,12 @@ handle_interrupt (bool in_signal_handler)
10445 } 10415 }
10446 else 10416 else
10447 { 10417 {
10448 /* If executing a function that wants to be interrupted out of 10418 /* Request quit when it's safe. */
10449 and the user has not deferred quitting by binding `inhibit-quit' 10419 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
10450 then quit right away. */ 10420 force_quit_count = count;
10451 if (immediate_quit && NILP (Vinhibit_quit)) 10421 if (count == 3)
10452 { 10422 Vinhibit_quit = Qnil;
10453 struct gl_state_s saved; 10423 Vquit_flag = Qt;
10454
10455 immediate_quit = false;
10456 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10457 saved = gl_state;
10458 quit ();
10459 gl_state = saved;
10460 }
10461 else
10462 { /* Else request quit when it's safe. */
10463 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
10464 force_quit_count = count;
10465 if (count == 3)
10466 {
10467 immediate_quit = true;
10468 Vinhibit_quit = Qnil;
10469 }
10470 Vquit_flag = Qt;
10471 }
10472 } 10424 }
10473 10425
10474 pthread_sigmask (SIG_SETMASK, &empty_mask, 0); 10426 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
@@ -10907,7 +10859,6 @@ init_keyboard (void)
10907{ 10859{
10908 /* This is correct before outermost invocation of the editor loop. */ 10860 /* This is correct before outermost invocation of the editor loop. */
10909 command_loop_level = -1; 10861 command_loop_level = -1;
10910 immediate_quit = false;
10911 quit_char = Ctl ('g'); 10862 quit_char = Ctl ('g');
10912 Vunread_command_events = Qnil; 10863 Vunread_command_events = Qnil;
10913 timer_idleness_start_time = invalid_timespec (); 10864 timer_idleness_start_time = invalid_timespec ();
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 005d1e7c746..2a32db62326 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. The table cannot be
1999 changed afterwards. */
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,38 +3123,28 @@ 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. 3126extern void maybe_quit (void);
3125 Typing C-g does not directly cause a quit; it only sets Vquit_flag.
3126 So the program needs to do QUIT at times when it is safe to quit.
3127 Every loop that might run for a long time or might not exit
3128 ought to do QUIT at least once, at a safe place.
3129 Unless that is impossible, of course.
3130 But it is very desirable to avoid creating loops where QUIT is impossible.
3131
3132 Exception: if you set immediate_quit to true,
3133 then the handler that responds to the C-g does the quit itself.
3134 This is a good thing to do around a loop that has no side effects
3135 and (in particular) cannot call arbitrary Lisp code.
3136 3127
3137 If quit-flag is set to `kill-emacs' the SIGINT handler has received 3128/* True if ought to quit now. */
3138 a request to exit Emacs when it is safe to do. */
3139 3129
3140extern void process_pending_signals (void); 3130#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
3141extern bool volatile pending_signals;
3142 3131
3143extern void process_quit_flag (void); 3132/* Heuristic on how many iterations of a tight loop can be safely done
3144#define QUIT \ 3133 before it's time to do a quit. This must be a power of 2. It
3145 do { \ 3134 is nice but not necessary for it to equal USHRT_MAX + 1. */
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 3135
3136enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
3152 3137
3153/* True if ought to quit now. */ 3138/* Process a quit rarely, based on a counter COUNT, for efficiency.
3139 "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1
3140 times, whichever is smaller (somewhat arbitrary, but often faster). */
3154 3141
3155#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) 3142INLINE void
3143rarely_quit (unsigned short int count)
3144{
3145 if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
3146 maybe_quit ();
3147}
3156 3148
3157extern Lisp_Object Vascii_downcase_table; 3149extern Lisp_Object Vascii_downcase_table;
3158extern Lisp_Object Vascii_canon_table; 3150extern Lisp_Object Vascii_canon_table;
@@ -3375,7 +3367,7 @@ extern void sweep_weak_hash_tables (void);
3375EMACS_UINT hash_string (char const *, ptrdiff_t); 3367EMACS_UINT hash_string (char const *, ptrdiff_t);
3376EMACS_UINT sxhash (Lisp_Object, int); 3368EMACS_UINT sxhash (Lisp_Object, int);
3377Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, 3369Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
3378 Lisp_Object, Lisp_Object); 3370 Lisp_Object, Lisp_Object, Lisp_Object);
3379ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); 3371ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
3380ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, 3372ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
3381 EMACS_UINT); 3373 EMACS_UINT);
@@ -4233,8 +4225,10 @@ extern int emacs_open (const char *, int, int);
4233extern int emacs_pipe (int[2]); 4225extern int emacs_pipe (int[2]);
4234extern int emacs_close (int); 4226extern int emacs_close (int);
4235extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); 4227extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
4228extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t);
4236extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); 4229extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
4237extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); 4230extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
4231extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
4238extern void emacs_perror (char const *); 4232extern void emacs_perror (char const *);
4239 4233
4240extern void unlock_all_files (void); 4234extern void unlock_all_files (void);
@@ -4360,9 +4354,6 @@ extern char my_edata[];
4360extern char my_endbss[]; 4354extern char my_endbss[];
4361extern char *my_endbss_static; 4355extern char *my_endbss_static;
4362 4356
4363/* True means ^G can quit instantly. */
4364extern bool immediate_quit;
4365
4366extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); 4357extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
4367extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); 4358extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
4368extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); 4359extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
@@ -4549,7 +4540,7 @@ enum
4549 use these only in macros like AUTO_CONS that declare a local 4540 use these only in macros like AUTO_CONS that declare a local
4550 variable whose lifetime will be clear to the programmer. */ 4541 variable whose lifetime will be clear to the programmer. */
4551#define STACK_CONS(a, b) \ 4542#define STACK_CONS(a, b) \
4552 make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons) 4543 make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons)
4553#define AUTO_CONS_EXPR(a, b) \ 4544#define AUTO_CONS_EXPR(a, b) \
4554 (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) 4545 (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b))
4555 4546
@@ -4595,8 +4586,7 @@ enum
4595 Lisp_Object name = \ 4586 Lisp_Object name = \
4596 (USE_STACK_STRING \ 4587 (USE_STACK_STRING \
4597 ? (make_lisp_ptr \ 4588 ? (make_lisp_ptr \
4598 ((&(union Aligned_String) \ 4589 ((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \
4599 {{len, -1, 0, (unsigned char *) (str)}}.s), \
4600 Lisp_String)) \ 4590 Lisp_String)) \
4601 : make_unibyte_string (str, len)) 4591 : make_unibyte_string (str, len))
4602 4592
diff --git a/src/lread.c b/src/lread.c
index 284fd1aafbc..094aa628eec 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);
@@ -910,7 +910,7 @@ safe_to_load_version (int fd)
910 910
911 /* Read the first few bytes from the file, and look for a line 911 /* Read the first few bytes from the file, and look for a line
912 specifying the byte compiler version used. */ 912 specifying the byte compiler version used. */
913 nbytes = emacs_read (fd, buf, sizeof buf); 913 nbytes = emacs_read_quit (fd, buf, sizeof buf);
914 if (nbytes > 0) 914 if (nbytes > 0)
915 { 915 {
916 /* Skip to the next newline, skipping over the initial `ELC' 916 /* Skip to the next newline, skipping over the initial `ELC'
@@ -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..434a3955b2c 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,16 +3431,14 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3431 break; 3431 break;
3432 } 3432 }
3433 3433
3434 immediate_quit = 1; 3434 maybe_quit ();
3435 QUIT;
3436 3435
3437 ret = connect (s, sa, addrlen); 3436 ret = connect (s, sa, addrlen);
3438 xerrno = errno; 3437 xerrno = errno;
3439 3438
3440 if (ret == 0 || xerrno == EISCONN) 3439 if (ret == 0 || xerrno == EISCONN)
3441 { 3440 {
3442 /* The unwind-protect will be discarded afterwards. 3441 /* The unwind-protect will be discarded afterwards. */
3443 Likewise for immediate_quit. */
3444 break; 3442 break;
3445 } 3443 }
3446 3444
@@ -3459,7 +3457,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3459 retry_select: 3457 retry_select:
3460 FD_ZERO (&fdset); 3458 FD_ZERO (&fdset);
3461 FD_SET (s, &fdset); 3459 FD_SET (s, &fdset);
3462 QUIT; 3460 maybe_quit ();
3463 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL); 3461 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3464 if (sc == -1) 3462 if (sc == -1)
3465 { 3463 {
@@ -3481,8 +3479,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3481 } 3479 }
3482#endif /* !WINDOWSNT */ 3480#endif /* !WINDOWSNT */
3483 3481
3484 immediate_quit = 0;
3485
3486 /* Discard the unwind protect closing S. */ 3482 /* Discard the unwind protect closing S. */
3487 specpdl_ptr = specpdl + count; 3483 specpdl_ptr = specpdl + count;
3488 emacs_close (s); 3484 emacs_close (s);
@@ -3539,8 +3535,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3539#endif 3535#endif
3540 } 3536 }
3541 3537
3542 immediate_quit = 0;
3543
3544 if (s < 0) 3538 if (s < 0)
3545 { 3539 {
3546 /* If non-blocking got this far - and failed - assume non-blocking is 3540 /* If non-blocking got this far - and failed - assume non-blocking is
@@ -4012,8 +4006,7 @@ usage: (make-network-process &rest ARGS) */)
4012 struct addrinfo *res, *lres; 4006 struct addrinfo *res, *lres;
4013 int ret; 4007 int ret;
4014 4008
4015 immediate_quit = 1; 4009 maybe_quit ();
4016 QUIT;
4017 4010
4018 struct addrinfo hints; 4011 struct addrinfo hints;
4019 memset (&hints, 0, sizeof hints); 4012 memset (&hints, 0, sizeof hints);
@@ -4034,7 +4027,6 @@ usage: (make-network-process &rest ARGS) */)
4034#else 4027#else
4035 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); 4028 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4036#endif 4029#endif
4037 immediate_quit = 0;
4038 4030
4039 for (lres = res; lres; lres = lres->ai_next) 4031 for (lres = res; lres; lres = lres->ai_next)
4040 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); 4032 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
@@ -5020,7 +5012,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. 5012 since we want to return C-g as an input character.
5021 Otherwise, do pending quit if requested. */ 5013 Otherwise, do pending quit if requested. */
5022 if (read_kbd >= 0) 5014 if (read_kbd >= 0)
5023 QUIT; 5015 maybe_quit ();
5024 else if (pending_signals) 5016 else if (pending_signals)
5025 process_pending_signals (); 5017 process_pending_signals ();
5026 5018
@@ -5748,7 +5740,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
5748 { 5740 {
5749 /* Prevent input_pending from remaining set if we quit. */ 5741 /* Prevent input_pending from remaining set if we quit. */
5750 clear_input_pending (); 5742 clear_input_pending ();
5751 QUIT; 5743 maybe_quit ();
5752 } 5744 }
5753 5745
5754 return got_some_output; 5746 return got_some_output;
@@ -7486,7 +7478,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. 7478 since we want to return C-g as an input character.
7487 Otherwise, do pending quit if requested. */ 7479 Otherwise, do pending quit if requested. */
7488 if (read_kbd >= 0) 7480 if (read_kbd >= 0)
7489 QUIT; 7481 maybe_quit ();
7490 7482
7491 /* Exit now if the cell we're waiting for became non-nil. */ 7483 /* Exit now if the cell we're waiting for became non-nil. */
7492 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) 7484 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..796f868d1c2 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1728,13 +1728,8 @@ typedef struct
1728 1728
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#ifndef emacs
1732# define IMMEDIATE_QUIT_CHECK \ 1732static void maybe_quit (void) {}
1733 do { \
1734 if (immediate_quit) QUIT; \
1735 } while (0)
1736#else
1737# define IMMEDIATE_QUIT_CHECK ((void)0)
1738#endif 1733#endif
1739 1734
1740/* Structure to manage work area for range table. */ 1735/* Structure to manage work area for range table. */
@@ -5823,7 +5818,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
5823 /* Unconditionally jump (without popping any failure points). */ 5818 /* Unconditionally jump (without popping any failure points). */
5824 case jump: 5819 case jump:
5825 unconditional_jump: 5820 unconditional_jump:
5826 IMMEDIATE_QUIT_CHECK; 5821 maybe_quit ();
5827 EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ 5822 EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */
5828 DEBUG_PRINT ("EXECUTING jump %d ", mcnt); 5823 DEBUG_PRINT ("EXECUTING jump %d ", mcnt);
5829 p += mcnt; /* Do the jump. */ 5824 p += mcnt; /* Do the jump. */
@@ -6171,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6171 6166
6172 /* We goto here if a matching operation fails. */ 6167 /* We goto here if a matching operation fails. */
6173 fail: 6168 fail:
6174 IMMEDIATE_QUIT_CHECK; 6169 maybe_quit ();
6175 if (!FAIL_STACK_EMPTY ()) 6170 if (!FAIL_STACK_EMPTY ())
6176 { 6171 {
6177 re_char *str, *pat; 6172 re_char *str, *pat;
diff --git a/src/search.c b/src/search.c
index d3045108705..33cb02aa7af 100644
--- a/src/search.c
+++ b/src/search.c
@@ -99,6 +99,25 @@ matcher_overflow (void)
99 error ("Stack overflow in regexp matcher"); 99 error ("Stack overflow in regexp matcher");
100} 100}
101 101
102static void
103freeze_buffer_relocation (void)
104{
105#ifdef REL_ALLOC
106 /* Prevent ralloc.c from relocating the current buffer while
107 searching it. */
108 r_alloc_inhibit_buffer_relocation (1);
109 record_unwind_protect_int (r_alloc_inhibit_buffer_relocation, 0);
110#endif
111}
112
113static void
114thaw_buffer_relocation (void)
115{
116#ifdef REL_ALLOC
117 unbind_to (SPECPDL_INDEX () - 1, Qnil);
118#endif
119}
120
102/* Compile a regexp and signal a Lisp error if anything goes wrong. 121/* Compile a regexp and signal a Lisp error if anything goes wrong.
103 PATTERN is the pattern to compile. 122 PATTERN is the pattern to compile.
104 CP is the place to put the result. 123 CP is the place to put the result.
@@ -276,8 +295,8 @@ looking_at_1 (Lisp_Object string, bool posix)
276 posix, 295 posix,
277 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 296 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
278 297
279 immediate_quit = 1; 298 /* Do a pending quit right away, to avoid paradoxical behavior */
280 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ 299 maybe_quit ();
281 300
282 /* Get pointers and sizes of the two strings 301 /* Get pointers and sizes of the two strings
283 that make up the visible portion of the buffer. */ 302 that make up the visible portion of the buffer. */
@@ -300,20 +319,13 @@ looking_at_1 (Lisp_Object string, bool posix)
300 319
301 re_match_object = Qnil; 320 re_match_object = Qnil;
302 321
303#ifdef REL_ALLOC 322 freeze_buffer_relocation ();
304 /* Prevent ralloc.c from relocating the current buffer while
305 searching it. */
306 r_alloc_inhibit_buffer_relocation (1);
307#endif
308 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, 323 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
309 PT_BYTE - BEGV_BYTE, 324 PT_BYTE - BEGV_BYTE,
310 (NILP (Vinhibit_changing_match_data) 325 (NILP (Vinhibit_changing_match_data)
311 ? &search_regs : NULL), 326 ? &search_regs : NULL),
312 ZV_BYTE - BEGV_BYTE); 327 ZV_BYTE - BEGV_BYTE);
313 immediate_quit = 0; 328 thaw_buffer_relocation ();
314#ifdef REL_ALLOC
315 r_alloc_inhibit_buffer_relocation (0);
316#endif
317 329
318 if (i == -2) 330 if (i == -2)
319 matcher_overflow (); 331 matcher_overflow ();
@@ -398,7 +410,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
398 ? BVAR (current_buffer, case_canon_table) : Qnil), 410 ? BVAR (current_buffer, case_canon_table) : Qnil),
399 posix, 411 posix,
400 STRING_MULTIBYTE (string)); 412 STRING_MULTIBYTE (string));
401 immediate_quit = 1;
402 re_match_object = string; 413 re_match_object = string;
403 414
404 val = re_search (bufp, SSDATA (string), 415 val = re_search (bufp, SSDATA (string),
@@ -406,7 +417,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
406 SBYTES (string) - pos_byte, 417 SBYTES (string) - pos_byte,
407 (NILP (Vinhibit_changing_match_data) 418 (NILP (Vinhibit_changing_match_data)
408 ? &search_regs : NULL)); 419 ? &search_regs : NULL));
409 immediate_quit = 0;
410 420
411 /* Set last_thing_searched only when match data is changed. */ 421 /* Set last_thing_searched only when match data is changed. */
412 if (NILP (Vinhibit_changing_match_data)) 422 if (NILP (Vinhibit_changing_match_data))
@@ -470,13 +480,11 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string,
470 480
471 bufp = compile_pattern (regexp, 0, table, 481 bufp = compile_pattern (regexp, 0, table,
472 0, STRING_MULTIBYTE (string)); 482 0, STRING_MULTIBYTE (string));
473 immediate_quit = 1;
474 re_match_object = string; 483 re_match_object = string;
475 484
476 val = re_search (bufp, SSDATA (string), 485 val = re_search (bufp, SSDATA (string),
477 SBYTES (string), 0, 486 SBYTES (string), 0,
478 SBYTES (string), 0); 487 SBYTES (string), 0);
479 immediate_quit = 0;
480 return val; 488 return val;
481} 489}
482 490
@@ -497,9 +505,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
497 bufp = compile_pattern (regexp, 0, 505 bufp = compile_pattern (regexp, 0,
498 Vascii_canon_table, 0, 506 Vascii_canon_table, 0,
499 0); 507 0);
500 immediate_quit = 1;
501 val = re_search (bufp, string, len, 0, len, 0); 508 val = re_search (bufp, string, len, 0, len, 0);
502 immediate_quit = 0;
503 return val; 509 return val;
504} 510}
505 511
@@ -560,18 +566,10 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
560 } 566 }
561 567
562 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); 568 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
563 immediate_quit = 1; 569 freeze_buffer_relocation ();
564#ifdef REL_ALLOC
565 /* Prevent ralloc.c from relocating the current buffer while
566 searching it. */
567 r_alloc_inhibit_buffer_relocation (1);
568#endif
569 len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, 570 len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2,
570 pos_byte, NULL, limit_byte); 571 pos_byte, NULL, limit_byte);
571#ifdef REL_ALLOC 572 thaw_buffer_relocation ();
572 r_alloc_inhibit_buffer_relocation (0);
573#endif
574 immediate_quit = 0;
575 573
576 return len; 574 return len;
577} 575}
@@ -648,7 +646,7 @@ newline_cache_on_off (struct buffer *buf)
648 If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding 646 If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding
649 to the returned character position. 647 to the returned character position.
650 648
651 If ALLOW_QUIT, set immediate_quit. That's good to do 649 If ALLOW_QUIT, check for quitting. That's good to do
652 except when inside redisplay. */ 650 except when inside redisplay. */
653 651
654ptrdiff_t 652ptrdiff_t
@@ -684,8 +682,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
684 if (shortage != 0) 682 if (shortage != 0)
685 *shortage = 0; 683 *shortage = 0;
686 684
687 immediate_quit = allow_quit;
688
689 if (count > 0) 685 if (count > 0)
690 while (start != end) 686 while (start != end)
691 { 687 {
@@ -703,7 +699,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
703 ptrdiff_t next_change; 699 ptrdiff_t next_change;
704 int result = 1; 700 int result = 1;
705 701
706 immediate_quit = 0;
707 while (start < end && result) 702 while (start < end && result)
708 { 703 {
709 ptrdiff_t lim1; 704 ptrdiff_t lim1;
@@ -756,7 +751,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
756 start_byte = end_byte; 751 start_byte = end_byte;
757 break; 752 break;
758 } 753 }
759 immediate_quit = allow_quit;
760 754
761 /* START should never be after END. */ 755 /* START should never be after END. */
762 if (start_byte > ceiling_byte) 756 if (start_byte > ceiling_byte)
@@ -809,11 +803,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
809 803
810 if (--count == 0) 804 if (--count == 0)
811 { 805 {
812 immediate_quit = 0;
813 if (bytepos) 806 if (bytepos)
814 *bytepos = lim_byte + next; 807 *bytepos = lim_byte + next;
815 return BYTE_TO_CHAR (lim_byte + next); 808 return BYTE_TO_CHAR (lim_byte + next);
816 } 809 }
810 if (allow_quit)
811 maybe_quit ();
817 } 812 }
818 813
819 start_byte = lim_byte; 814 start_byte = lim_byte;
@@ -832,7 +827,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
832 ptrdiff_t next_change; 827 ptrdiff_t next_change;
833 int result = 1; 828 int result = 1;
834 829
835 immediate_quit = 0;
836 while (start > end && result) 830 while (start > end && result)
837 { 831 {
838 ptrdiff_t lim1; 832 ptrdiff_t lim1;
@@ -869,7 +863,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
869 start_byte = end_byte; 863 start_byte = end_byte;
870 break; 864 break;
871 } 865 }
872 immediate_quit = allow_quit;
873 866
874 /* Start should never be at or before end. */ 867 /* Start should never be at or before end. */
875 if (start_byte <= ceiling_byte) 868 if (start_byte <= ceiling_byte)
@@ -917,11 +910,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
917 910
918 if (++count >= 0) 911 if (++count >= 0)
919 { 912 {
920 immediate_quit = 0;
921 if (bytepos) 913 if (bytepos)
922 *bytepos = ceiling_byte + prev + 1; 914 *bytepos = ceiling_byte + prev + 1;
923 return BYTE_TO_CHAR (ceiling_byte + prev + 1); 915 return BYTE_TO_CHAR (ceiling_byte + prev + 1);
924 } 916 }
917 if (allow_quit)
918 maybe_quit ();
925 } 919 }
926 920
927 start_byte = ceiling_byte; 921 start_byte = ceiling_byte;
@@ -929,7 +923,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
929 } 923 }
930 } 924 }
931 925
932 immediate_quit = 0;
933 if (shortage) 926 if (shortage)
934 *shortage = count * direction; 927 *shortage = count * direction;
935 if (bytepos) 928 if (bytepos)
@@ -953,7 +946,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
953 the number of line boundaries left unfound, and position at 946 the number of line boundaries left unfound, and position at
954 the limit we bumped up against. 947 the limit we bumped up against.
955 948
956 If ALLOW_QUIT, set immediate_quit. That's good to do 949 If ALLOW_QUIT, check for quitting. That's good to do
957 except in special cases. */ 950 except in special cases. */
958 951
959ptrdiff_t 952ptrdiff_t
@@ -1196,10 +1189,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1196 trt, posix, 1189 trt, posix,
1197 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 1190 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
1198 1191
1199 immediate_quit = 1; /* Quit immediately if user types ^G, 1192 maybe_quit (); /* Do a pending quit right away,
1200 because letting this function finish
1201 can take too long. */
1202 QUIT; /* Do a pending quit right away,
1203 to avoid paradoxical behavior */ 1193 to avoid paradoxical behavior */
1204 /* Get pointers and sizes of the two strings 1194 /* Get pointers and sizes of the two strings
1205 that make up the visible portion of the buffer. */ 1195 that make up the visible portion of the buffer. */
@@ -1221,11 +1211,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1221 } 1211 }
1222 re_match_object = Qnil; 1212 re_match_object = Qnil;
1223 1213
1224#ifdef REL_ALLOC 1214 freeze_buffer_relocation ();
1225 /* Prevent ralloc.c from relocating the current buffer while
1226 searching it. */
1227 r_alloc_inhibit_buffer_relocation (1);
1228#endif
1229 1215
1230 while (n < 0) 1216 while (n < 0)
1231 { 1217 {
@@ -1267,13 +1253,11 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1267 } 1253 }
1268 else 1254 else
1269 { 1255 {
1270 immediate_quit = 0; 1256 thaw_buffer_relocation ();
1271#ifdef REL_ALLOC
1272 r_alloc_inhibit_buffer_relocation (0);
1273#endif
1274 return (n); 1257 return (n);
1275 } 1258 }
1276 n++; 1259 n++;
1260 maybe_quit ();
1277 } 1261 }
1278 while (n > 0) 1262 while (n > 0)
1279 { 1263 {
@@ -1312,18 +1296,13 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1312 } 1296 }
1313 else 1297 else
1314 { 1298 {
1315 immediate_quit = 0; 1299 thaw_buffer_relocation ();
1316#ifdef REL_ALLOC
1317 r_alloc_inhibit_buffer_relocation (0);
1318#endif
1319 return (0 - n); 1300 return (0 - n);
1320 } 1301 }
1321 n--; 1302 n--;
1303 maybe_quit ();
1322 } 1304 }
1323 immediate_quit = 0; 1305 thaw_buffer_relocation ();
1324#ifdef REL_ALLOC
1325 r_alloc_inhibit_buffer_relocation (0);
1326#endif
1327 return (pos); 1306 return (pos);
1328 } 1307 }
1329 else /* non-RE case */ 1308 else /* non-RE case */
@@ -1927,7 +1906,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
1927 < 0) 1906 < 0)
1928 return (n * (0 - direction)); 1907 return (n * (0 - direction));
1929 /* First we do the part we can by pointers (maybe nothing) */ 1908 /* First we do the part we can by pointers (maybe nothing) */
1930 QUIT; 1909 maybe_quit ();
1931 pat = base_pat; 1910 pat = base_pat;
1932 limit = pos_byte - dirlen + direction; 1911 limit = pos_byte - dirlen + direction;
1933 if (direction > 0) 1912 if (direction > 0)
@@ -3230,8 +3209,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3230 if (shortage != 0) 3209 if (shortage != 0)
3231 *shortage = 0; 3210 *shortage = 0;
3232 3211
3233 immediate_quit = allow_quit;
3234
3235 if (count > 0) 3212 if (count > 0)
3236 while (start != end) 3213 while (start != end)
3237 { 3214 {
@@ -3274,11 +3251,12 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3274 3251
3275 if (--count == 0) 3252 if (--count == 0)
3276 { 3253 {
3277 immediate_quit = 0;
3278 if (bytepos) 3254 if (bytepos)
3279 *bytepos = lim_byte + next; 3255 *bytepos = lim_byte + next;
3280 return BYTE_TO_CHAR (lim_byte + next); 3256 return BYTE_TO_CHAR (lim_byte + next);
3281 } 3257 }
3258 if (allow_quit)
3259 maybe_quit ();
3282 } 3260 }
3283 3261
3284 start_byte = lim_byte; 3262 start_byte = lim_byte;
@@ -3286,7 +3264,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3286 } 3264 }
3287 } 3265 }
3288 3266
3289 immediate_quit = 0;
3290 if (shortage) 3267 if (shortage)
3291 *shortage = count; 3268 *shortage = count;
3292 if (bytepos) 3269 if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index 5bc0efa8a41..34a9e632b3c 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1672,29 +1672,23 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
1672 COUNT negative means scan backward and stop at word beginning. */ 1672 COUNT negative means scan backward and stop at word beginning. */
1673 1673
1674ptrdiff_t 1674ptrdiff_t
1675scan_words (register ptrdiff_t from, register EMACS_INT count) 1675scan_words (ptrdiff_t from, EMACS_INT count)
1676{ 1676{
1677 register ptrdiff_t beg = BEGV; 1677 ptrdiff_t beg = BEGV;
1678 register ptrdiff_t end = ZV; 1678 ptrdiff_t end = ZV;
1679 register ptrdiff_t from_byte = CHAR_TO_BYTE (from); 1679 ptrdiff_t from_byte = CHAR_TO_BYTE (from);
1680 register enum syntaxcode code; 1680 enum syntaxcode code;
1681 int ch0, ch1; 1681 int ch0, ch1;
1682 Lisp_Object func, pos; 1682 Lisp_Object func, pos;
1683 1683
1684 immediate_quit = 1;
1685 QUIT;
1686
1687 SETUP_SYNTAX_TABLE (from, count); 1684 SETUP_SYNTAX_TABLE (from, count);
1688 1685
1689 while (count > 0) 1686 while (count > 0)
1690 { 1687 {
1691 while (1) 1688 while (true)
1692 { 1689 {
1693 if (from == end) 1690 if (from == end)
1694 { 1691 return 0;
1695 immediate_quit = 0;
1696 return 0;
1697 }
1698 UPDATE_SYNTAX_TABLE_FORWARD (from); 1692 UPDATE_SYNTAX_TABLE_FORWARD (from);
1699 ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); 1693 ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
1700 code = SYNTAX (ch0); 1694 code = SYNTAX (ch0);
@@ -1704,6 +1698,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1704 break; 1698 break;
1705 if (code == Sword) 1699 if (code == Sword)
1706 break; 1700 break;
1701 rarely_quit (from);
1707 } 1702 }
1708 /* Now CH0 is a character which begins a word and FROM is the 1703 /* Now CH0 is a character which begins a word and FROM is the
1709 position of the next character. */ 1704 position of the next character. */
@@ -1732,19 +1727,17 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1732 break; 1727 break;
1733 INC_BOTH (from, from_byte); 1728 INC_BOTH (from, from_byte);
1734 ch0 = ch1; 1729 ch0 = ch1;
1730 rarely_quit (from);
1735 } 1731 }
1736 } 1732 }
1737 count--; 1733 count--;
1738 } 1734 }
1739 while (count < 0) 1735 while (count < 0)
1740 { 1736 {
1741 while (1) 1737 while (true)
1742 { 1738 {
1743 if (from == beg) 1739 if (from == beg)
1744 { 1740 return 0;
1745 immediate_quit = 0;
1746 return 0;
1747 }
1748 DEC_BOTH (from, from_byte); 1741 DEC_BOTH (from, from_byte);
1749 UPDATE_SYNTAX_TABLE_BACKWARD (from); 1742 UPDATE_SYNTAX_TABLE_BACKWARD (from);
1750 ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); 1743 ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -1754,6 +1747,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1754 break; 1747 break;
1755 if (code == Sword) 1748 if (code == Sword)
1756 break; 1749 break;
1750 rarely_quit (from);
1757 } 1751 }
1758 /* Now CH1 is a character which ends a word and FROM is the 1752 /* Now CH1 is a character which ends a word and FROM is the
1759 position of it. */ 1753 position of it. */
@@ -1786,13 +1780,12 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1786 break; 1780 break;
1787 } 1781 }
1788 ch1 = ch0; 1782 ch1 = ch0;
1783 rarely_quit (from);
1789 } 1784 }
1790 } 1785 }
1791 count++; 1786 count++;
1792 } 1787 }
1793 1788
1794 immediate_quit = 0;
1795
1796 return from; 1789 return from;
1797} 1790}
1798 1791
@@ -2176,7 +2169,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2176 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; 2169 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
2177 } 2170 }
2178 2171
2179 immediate_quit = 1;
2180 /* This code may look up syntax tables using functions that rely on the 2172 /* This code may look up syntax tables using functions that rely on the
2181 gl_state object. To make sure this object is not out of date, 2173 gl_state object. To make sure this object is not out of date,
2182 let's initialize it manually. 2174 let's initialize it manually.
@@ -2226,9 +2218,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2226 } 2218 }
2227 fwd_ok: 2219 fwd_ok:
2228 p += nbytes, pos++, pos_byte += nbytes; 2220 p += nbytes, pos++, pos_byte += nbytes;
2221 rarely_quit (pos);
2229 } 2222 }
2230 else 2223 else
2231 while (1) 2224 while (true)
2232 { 2225 {
2233 if (p >= stop) 2226 if (p >= stop)
2234 { 2227 {
@@ -2250,15 +2243,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2250 break; 2243 break;
2251 fwd_unibyte_ok: 2244 fwd_unibyte_ok:
2252 p++, pos++, pos_byte++; 2245 p++, pos++, pos_byte++;
2246 rarely_quit (pos);
2253 } 2247 }
2254 } 2248 }
2255 else 2249 else
2256 { 2250 {
2257 if (multibyte) 2251 if (multibyte)
2258 while (1) 2252 while (true)
2259 { 2253 {
2260 unsigned char *prev_p;
2261
2262 if (p <= stop) 2254 if (p <= stop)
2263 { 2255 {
2264 if (p <= endp) 2256 if (p <= endp)
@@ -2266,8 +2258,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2266 p = GPT_ADDR; 2258 p = GPT_ADDR;
2267 stop = endp; 2259 stop = endp;
2268 } 2260 }
2269 prev_p = p; 2261 unsigned char *prev_p = p;
2270 while (--p >= stop && ! CHAR_HEAD_P (*p)); 2262 do
2263 p--;
2264 while (stop <= p && ! CHAR_HEAD_P (*p));
2265
2271 c = STRING_CHAR (p); 2266 c = STRING_CHAR (p);
2272 2267
2273 if (! NILP (iso_classes) && in_classes (c, iso_classes)) 2268 if (! NILP (iso_classes) && in_classes (c, iso_classes))
@@ -2291,9 +2286,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2291 } 2286 }
2292 back_ok: 2287 back_ok:
2293 pos--, pos_byte -= prev_p - p; 2288 pos--, pos_byte -= prev_p - p;
2289 rarely_quit (pos);
2294 } 2290 }
2295 else 2291 else
2296 while (1) 2292 while (true)
2297 { 2293 {
2298 if (p <= stop) 2294 if (p <= stop)
2299 { 2295 {
@@ -2315,11 +2311,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2315 break; 2311 break;
2316 back_unibyte_ok: 2312 back_unibyte_ok:
2317 p--, pos--, pos_byte--; 2313 p--, pos--, pos_byte--;
2314 rarely_quit (pos);
2318 } 2315 }
2319 } 2316 }
2320 2317
2321 SET_PT_BOTH (pos, pos_byte); 2318 SET_PT_BOTH (pos, pos_byte);
2322 immediate_quit = 0;
2323 2319
2324 SAFE_FREE (); 2320 SAFE_FREE ();
2325 return make_number (PT - start_point); 2321 return make_number (PT - start_point);
@@ -2393,7 +2389,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2393 ptrdiff_t pos_byte = PT_BYTE; 2389 ptrdiff_t pos_byte = PT_BYTE;
2394 unsigned char *p, *endp, *stop; 2390 unsigned char *p, *endp, *stop;
2395 2391
2396 immediate_quit = 1;
2397 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); 2392 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
2398 2393
2399 if (forwardp) 2394 if (forwardp)
@@ -2422,6 +2417,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2422 if (! fastmap[SYNTAX (c)]) 2417 if (! fastmap[SYNTAX (c)])
2423 goto done; 2418 goto done;
2424 p += nbytes, pos++, pos_byte += nbytes; 2419 p += nbytes, pos++, pos_byte += nbytes;
2420 rarely_quit (pos);
2425 } 2421 }
2426 while (!parse_sexp_lookup_properties 2422 while (!parse_sexp_lookup_properties
2427 || pos < gl_state.e_property); 2423 || pos < gl_state.e_property);
@@ -2438,10 +2434,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2438 2434
2439 if (multibyte) 2435 if (multibyte)
2440 { 2436 {
2441 while (1) 2437 while (true)
2442 { 2438 {
2443 unsigned char *prev_p;
2444
2445 if (p <= stop) 2439 if (p <= stop)
2446 { 2440 {
2447 if (p <= endp) 2441 if (p <= endp)
@@ -2450,17 +2444,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2450 stop = endp; 2444 stop = endp;
2451 } 2445 }
2452 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); 2446 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
2453 prev_p = p; 2447
2454 while (--p >= stop && ! CHAR_HEAD_P (*p)); 2448 unsigned char *prev_p = p;
2449 do
2450 p--;
2451 while (stop <= p && ! CHAR_HEAD_P (*p));
2452
2455 c = STRING_CHAR (p); 2453 c = STRING_CHAR (p);
2456 if (! fastmap[SYNTAX (c)]) 2454 if (! fastmap[SYNTAX (c)])
2457 break; 2455 break;
2458 pos--, pos_byte -= prev_p - p; 2456 pos--, pos_byte -= prev_p - p;
2457 rarely_quit (pos);
2459 } 2458 }
2460 } 2459 }
2461 else 2460 else
2462 { 2461 {
2463 while (1) 2462 while (true)
2464 { 2463 {
2465 if (p <= stop) 2464 if (p <= stop)
2466 { 2465 {
@@ -2473,13 +2472,13 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2473 if (! fastmap[SYNTAX (p[-1])]) 2472 if (! fastmap[SYNTAX (p[-1])])
2474 break; 2473 break;
2475 p--, pos--, pos_byte--; 2474 p--, pos--, pos_byte--;
2475 rarely_quit (pos);
2476 } 2476 }
2477 } 2477 }
2478 } 2478 }
2479 2479
2480 done: 2480 done:
2481 SET_PT_BOTH (pos, pos_byte); 2481 SET_PT_BOTH (pos, pos_byte);
2482 immediate_quit = 0;
2483 2482
2484 return make_number (PT - start_point); 2483 return make_number (PT - start_point);
2485 } 2484 }
@@ -2541,9 +2540,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2541 ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, 2540 ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
2542 EMACS_INT *incomment_ptr, int *last_syntax_ptr) 2541 EMACS_INT *incomment_ptr, int *last_syntax_ptr)
2543{ 2542{
2544 register int c, c1; 2543 unsigned short int quit_count = 0;
2545 register enum syntaxcode code; 2544 int c, c1;
2546 register int syntax, other_syntax; 2545 enum syntaxcode code;
2546 int syntax, other_syntax;
2547 2547
2548 if (nesting <= 0) nesting = -1; 2548 if (nesting <= 0) nesting = -1;
2549 2549
@@ -2635,6 +2635,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2635 UPDATE_SYNTAX_TABLE_FORWARD (from); 2635 UPDATE_SYNTAX_TABLE_FORWARD (from);
2636 nesting++; 2636 nesting++;
2637 } 2637 }
2638
2639 rarely_quit (++quit_count);
2638 } 2640 }
2639 *charpos_ptr = from; 2641 *charpos_ptr = from;
2640 *bytepos_ptr = from_byte; 2642 *bytepos_ptr = from_byte;
@@ -2662,14 +2664,12 @@ between them, return t; otherwise return nil. */)
2662 ptrdiff_t out_charpos, out_bytepos; 2664 ptrdiff_t out_charpos, out_bytepos;
2663 EMACS_INT dummy; 2665 EMACS_INT dummy;
2664 int dummy2; 2666 int dummy2;
2667 unsigned short int quit_count = 0;
2665 2668
2666 CHECK_NUMBER (count); 2669 CHECK_NUMBER (count);
2667 count1 = XINT (count); 2670 count1 = XINT (count);
2668 stop = count1 > 0 ? ZV : BEGV; 2671 stop = count1 > 0 ? ZV : BEGV;
2669 2672
2670 immediate_quit = 1;
2671 QUIT;
2672
2673 from = PT; 2673 from = PT;
2674 from_byte = PT_BYTE; 2674 from_byte = PT_BYTE;
2675 2675
@@ -2684,7 +2684,6 @@ between them, return t; otherwise return nil. */)
2684 if (from == stop) 2684 if (from == stop)
2685 { 2685 {
2686 SET_PT_BOTH (from, from_byte); 2686 SET_PT_BOTH (from, from_byte);
2687 immediate_quit = 0;
2688 return Qnil; 2687 return Qnil;
2689 } 2688 }
2690 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2689 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2711,6 +2710,7 @@ between them, return t; otherwise return nil. */)
2711 INC_BOTH (from, from_byte); 2710 INC_BOTH (from, from_byte);
2712 UPDATE_SYNTAX_TABLE_FORWARD (from); 2711 UPDATE_SYNTAX_TABLE_FORWARD (from);
2713 } 2712 }
2713 rarely_quit (++quit_count);
2714 } 2714 }
2715 while (code == Swhitespace || (code == Sendcomment && c == '\n')); 2715 while (code == Swhitespace || (code == Sendcomment && c == '\n'));
2716 2716
@@ -2718,7 +2718,6 @@ between them, return t; otherwise return nil. */)
2718 comstyle = ST_COMMENT_STYLE; 2718 comstyle = ST_COMMENT_STYLE;
2719 else if (code != Scomment) 2719 else if (code != Scomment)
2720 { 2720 {
2721 immediate_quit = 0;
2722 DEC_BOTH (from, from_byte); 2721 DEC_BOTH (from, from_byte);
2723 SET_PT_BOTH (from, from_byte); 2722 SET_PT_BOTH (from, from_byte);
2724 return Qnil; 2723 return Qnil;
@@ -2729,7 +2728,6 @@ between them, return t; otherwise return nil. */)
2729 from = out_charpos; from_byte = out_bytepos; 2728 from = out_charpos; from_byte = out_bytepos;
2730 if (!found) 2729 if (!found)
2731 { 2730 {
2732 immediate_quit = 0;
2733 SET_PT_BOTH (from, from_byte); 2731 SET_PT_BOTH (from, from_byte);
2734 return Qnil; 2732 return Qnil;
2735 } 2733 }
@@ -2741,23 +2739,19 @@ between them, return t; otherwise return nil. */)
2741 2739
2742 while (count1 < 0) 2740 while (count1 < 0)
2743 { 2741 {
2744 while (1) 2742 while (true)
2745 { 2743 {
2746 bool quoted;
2747 int syntax;
2748
2749 if (from <= stop) 2744 if (from <= stop)
2750 { 2745 {
2751 SET_PT_BOTH (BEGV, BEGV_BYTE); 2746 SET_PT_BOTH (BEGV, BEGV_BYTE);
2752 immediate_quit = 0;
2753 return Qnil; 2747 return Qnil;
2754 } 2748 }
2755 2749
2756 DEC_BOTH (from, from_byte); 2750 DEC_BOTH (from, from_byte);
2757 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ 2751 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
2758 quoted = char_quoted (from, from_byte); 2752 bool quoted = char_quoted (from, from_byte);
2759 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2753 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2760 syntax = SYNTAX_WITH_FLAGS (c); 2754 int syntax = SYNTAX_WITH_FLAGS (c);
2761 code = SYNTAX (c); 2755 code = SYNTAX (c);
2762 comstyle = 0; 2756 comstyle = 0;
2763 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); 2757 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
@@ -2800,6 +2794,7 @@ between them, return t; otherwise return nil. */)
2800 } 2794 }
2801 else if (from == stop) 2795 else if (from == stop)
2802 break; 2796 break;
2797 rarely_quit (++quit_count);
2803 } 2798 }
2804 if (fence_found == 0) 2799 if (fence_found == 0)
2805 { 2800 {
@@ -2842,18 +2837,18 @@ between them, return t; otherwise return nil. */)
2842 else if (code != Swhitespace || quoted) 2837 else if (code != Swhitespace || quoted)
2843 { 2838 {
2844 leave: 2839 leave:
2845 immediate_quit = 0;
2846 INC_BOTH (from, from_byte); 2840 INC_BOTH (from, from_byte);
2847 SET_PT_BOTH (from, from_byte); 2841 SET_PT_BOTH (from, from_byte);
2848 return Qnil; 2842 return Qnil;
2849 } 2843 }
2844
2845 rarely_quit (++quit_count);
2850 } 2846 }
2851 2847
2852 count1++; 2848 count1++;
2853 } 2849 }
2854 2850
2855 SET_PT_BOTH (from, from_byte); 2851 SET_PT_BOTH (from, from_byte);
2856 immediate_quit = 0;
2857 return Qt; 2852 return Qt;
2858} 2853}
2859 2854
@@ -2887,6 +2882,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2887 EMACS_INT dummy; 2882 EMACS_INT dummy;
2888 int dummy2; 2883 int dummy2;
2889 bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; 2884 bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
2885 unsigned short int quit_count = 0;
2890 2886
2891 if (depth > 0) min_depth = 0; 2887 if (depth > 0) min_depth = 0;
2892 2888
@@ -2895,14 +2891,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2895 2891
2896 from_byte = CHAR_TO_BYTE (from); 2892 from_byte = CHAR_TO_BYTE (from);
2897 2893
2898 immediate_quit = 1; 2894 maybe_quit ();
2899 QUIT;
2900 2895
2901 SETUP_SYNTAX_TABLE (from, count); 2896 SETUP_SYNTAX_TABLE (from, count);
2902 while (count > 0) 2897 while (count > 0)
2903 { 2898 {
2904 while (from < stop) 2899 while (from < stop)
2905 { 2900 {
2901 rarely_quit (++quit_count);
2906 bool comstart_first, prefix; 2902 bool comstart_first, prefix;
2907 int syntax, other_syntax; 2903 int syntax, other_syntax;
2908 UPDATE_SYNTAX_TABLE_FORWARD (from); 2904 UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -2971,6 +2967,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2971 goto done; 2967 goto done;
2972 } 2968 }
2973 INC_BOTH (from, from_byte); 2969 INC_BOTH (from, from_byte);
2970 rarely_quit (++quit_count);
2974 } 2971 }
2975 goto done; 2972 goto done;
2976 2973
@@ -3042,6 +3039,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3042 if (c_code == Scharquote || c_code == Sescape) 3039 if (c_code == Scharquote || c_code == Sescape)
3043 INC_BOTH (from, from_byte); 3040 INC_BOTH (from, from_byte);
3044 INC_BOTH (from, from_byte); 3041 INC_BOTH (from, from_byte);
3042 rarely_quit (++quit_count);
3045 } 3043 }
3046 INC_BOTH (from, from_byte); 3044 INC_BOTH (from, from_byte);
3047 if (!depth && sexpflag) goto done; 3045 if (!depth && sexpflag) goto done;
@@ -3056,7 +3054,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3056 if (depth) 3054 if (depth)
3057 goto lose; 3055 goto lose;
3058 3056
3059 immediate_quit = 0;
3060 return Qnil; 3057 return Qnil;
3061 3058
3062 /* End of object reached */ 3059 /* End of object reached */
@@ -3068,11 +3065,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3068 { 3065 {
3069 while (from > stop) 3066 while (from > stop)
3070 { 3067 {
3071 int syntax; 3068 rarely_quit (++quit_count);
3072 DEC_BOTH (from, from_byte); 3069 DEC_BOTH (from, from_byte);
3073 UPDATE_SYNTAX_TABLE_BACKWARD (from); 3070 UPDATE_SYNTAX_TABLE_BACKWARD (from);
3074 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 3071 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
3075 syntax= SYNTAX_WITH_FLAGS (c); 3072 int syntax = SYNTAX_WITH_FLAGS (c);
3076 code = syntax_multibyte (c, multibyte_symbol_p); 3073 code = syntax_multibyte (c, multibyte_symbol_p);
3077 if (depth == min_depth) 3074 if (depth == min_depth)
3078 last_good = from; 3075 last_good = from;
@@ -3144,6 +3141,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3144 default: goto done2; 3141 default: goto done2;
3145 } 3142 }
3146 DEC_BOTH (from, from_byte); 3143 DEC_BOTH (from, from_byte);
3144 rarely_quit (++quit_count);
3147 } 3145 }
3148 goto done2; 3146 goto done2;
3149 3147
@@ -3206,13 +3204,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3206 if (syntax_multibyte (c, multibyte_symbol_p) == code) 3204 if (syntax_multibyte (c, multibyte_symbol_p) == code)
3207 break; 3205 break;
3208 } 3206 }
3207 rarely_quit (++quit_count);
3209 } 3208 }
3210 if (code == Sstring_fence && !depth && sexpflag) goto done2; 3209 if (code == Sstring_fence && !depth && sexpflag) goto done2;
3211 break; 3210 break;
3212 3211
3213 case Sstring: 3212 case Sstring:
3214 stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); 3213 stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
3215 while (1) 3214 while (true)
3216 { 3215 {
3217 if (from == stop) 3216 if (from == stop)
3218 goto lose; 3217 goto lose;
@@ -3226,6 +3225,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3226 == Sstring)) 3225 == Sstring))
3227 break; 3226 break;
3228 } 3227 }
3228 rarely_quit (++quit_count);
3229 } 3229 }
3230 if (!depth && sexpflag) goto done2; 3230 if (!depth && sexpflag) goto done2;
3231 break; 3231 break;
@@ -3239,7 +3239,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3239 if (depth) 3239 if (depth)
3240 goto lose; 3240 goto lose;
3241 3241
3242 immediate_quit = 0;
3243 return Qnil; 3242 return Qnil;
3244 3243
3245 done2: 3244 done2:
@@ -3247,7 +3246,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
3247 } 3246 }
3248 3247
3249 3248
3250 immediate_quit = 0;
3251 XSETFASTINT (val, from); 3249 XSETFASTINT (val, from);
3252 return val; 3250 return val;
3253 3251
@@ -3340,6 +3338,7 @@ the prefix syntax flag (p). */)
3340 if (pos <= beg) 3338 if (pos <= beg)
3341 break; 3339 break;
3342 DEC_BOTH (pos, pos_byte); 3340 DEC_BOTH (pos, pos_byte);
3341 rarely_quit (pos);
3343 } 3342 }
3344 3343
3345 SET_PT_BOTH (opoint, opoint_byte); 3344 SET_PT_BOTH (opoint, opoint_byte);
@@ -3347,6 +3346,36 @@ the prefix syntax flag (p). */)
3347 return Qnil; 3346 return Qnil;
3348} 3347}
3349 3348
3349
3350/* If the character at FROM_BYTE is the second part of a 2-character
3351 comment opener based on PREV_FROM_SYNTAX, update STATE and return
3352 true. */
3353static bool
3354in_2char_comment_start (struct lisp_parse_state *state,
3355 int prev_from_syntax,
3356 ptrdiff_t prev_from,
3357 ptrdiff_t from_byte)
3358{
3359 int c1, syntax;
3360 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3361 && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
3362 syntax = SYNTAX_WITH_FLAGS (c1),
3363 SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
3364 {
3365 /* Record the comment style we have entered so that only
3366 the comment-end sequence of the same style actually
3367 terminates the comment section. */
3368 state->comstyle
3369 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3370 bool comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3371 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3372 state->incomment = comnested ? 1 : -1;
3373 state->comstr_start = prev_from;
3374 return true;
3375 }
3376 return false;
3377}
3378
3350/* Parse forward from FROM / FROM_BYTE to END, 3379/* Parse forward from FROM / FROM_BYTE to END,
3351 assuming that FROM has state STATE, 3380 assuming that FROM has state STATE,
3352 and return a description of the state of the parse at END. 3381 and return a description of the state of the parse at END.
@@ -3362,8 +3391,6 @@ scan_sexps_forward (struct lisp_parse_state *state,
3362 int commentstop) 3391 int commentstop)
3363{ 3392{
3364 enum syntaxcode code; 3393 enum syntaxcode code;
3365 int c1;
3366 bool comnested;
3367 struct level { ptrdiff_t last, prev; }; 3394 struct level { ptrdiff_t last, prev; };
3368 struct level levelstart[100]; 3395 struct level levelstart[100];
3369 struct level *curlevel = levelstart; 3396 struct level *curlevel = levelstart;
@@ -3377,12 +3404,12 @@ scan_sexps_forward (struct lisp_parse_state *state,
3377 ptrdiff_t prev_from; /* Keep one character before FROM. */ 3404 ptrdiff_t prev_from; /* Keep one character before FROM. */
3378 ptrdiff_t prev_from_byte; 3405 ptrdiff_t prev_from_byte;
3379 int prev_from_syntax, prev_prev_from_syntax; 3406 int prev_from_syntax, prev_prev_from_syntax;
3380 int syntax;
3381 bool boundary_stop = commentstop == -1; 3407 bool boundary_stop = commentstop == -1;
3382 bool nofence; 3408 bool nofence;
3383 bool found; 3409 bool found;
3384 ptrdiff_t out_bytepos, out_charpos; 3410 ptrdiff_t out_bytepos, out_charpos;
3385 int temp; 3411 int temp;
3412 unsigned short int quit_count = 0;
3386 3413
3387 prev_from = from; 3414 prev_from = from;
3388 prev_from_byte = from_byte; 3415 prev_from_byte = from_byte;
@@ -3401,8 +3428,7 @@ do { prev_from = from; \
3401 UPDATE_SYNTAX_TABLE_FORWARD (from); \ 3428 UPDATE_SYNTAX_TABLE_FORWARD (from); \
3402 } while (0) 3429 } while (0)
3403 3430
3404 immediate_quit = 1; 3431 maybe_quit ();
3405 QUIT;
3406 3432
3407 depth = state->depth; 3433 depth = state->depth;
3408 start_quoted = state->quoted; 3434 start_quoted = state->quoted;
@@ -3442,53 +3468,32 @@ do { prev_from = from; \
3442 } 3468 }
3443 else if (start_quoted) 3469 else if (start_quoted)
3444 goto startquoted; 3470 goto startquoted;
3471 else if ((from < end)
3472 && (in_2char_comment_start (state, prev_from_syntax,
3473 prev_from, from_byte)))
3474 {
3475 INC_FROM;
3476 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3477 goto atcomment;
3478 }
3445 3479
3446 while (from < end) 3480 while (from < end)
3447 { 3481 {
3448 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) 3482 rarely_quit (++quit_count);
3449 && (c1 = FETCH_CHAR (from_byte), 3483 INC_FROM;
3450 syntax = SYNTAX_WITH_FLAGS (c1), 3484
3451 SYNTAX_FLAGS_COMSTART_SECOND (syntax))) 3485 if ((from < end)
3452 { 3486 && (in_2char_comment_start (state, prev_from_syntax,
3453 /* Record the comment style we have entered so that only 3487 prev_from, from_byte)))
3454 the comment-end sequence of the same style actually
3455 terminates the comment section. */
3456 state->comstyle
3457 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3458 comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3459 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3460 state->incomment = comnested ? 1 : -1;
3461 state->comstr_start = prev_from;
3462 INC_FROM;
3463 prev_from_syntax = Smax; /* the syntax has already been
3464 "used up". */
3465 code = Scomment;
3466 }
3467 else
3468 { 3488 {
3469 INC_FROM; 3489 INC_FROM;
3470 code = prev_from_syntax & 0xff; 3490 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3471 if (code == Scomment_fence) 3491 goto atcomment;
3472 {
3473 /* Record the comment style we have entered so that only
3474 the comment-end sequence of the same style actually
3475 terminates the comment section. */
3476 state->comstyle = ST_COMMENT_STYLE;
3477 state->incomment = -1;
3478 state->comstr_start = prev_from;
3479 code = Scomment;
3480 }
3481 else if (code == Scomment)
3482 {
3483 state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
3484 state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3485 1 : -1);
3486 state->comstr_start = prev_from;
3487 }
3488 } 3492 }
3489 3493
3490 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) 3494 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
3491 continue; 3495 continue;
3496 code = prev_from_syntax & 0xff;
3492 switch (code) 3497 switch (code)
3493 { 3498 {
3494 case Sescape: 3499 case Sescape:
@@ -3507,24 +3512,15 @@ do { prev_from = from; \
3507 symstarted: 3512 symstarted:
3508 while (from < end) 3513 while (from < end)
3509 { 3514 {
3510 int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); 3515 if (in_2char_comment_start (state, prev_from_syntax,
3511 3516 prev_from, from_byte))
3512 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3513 && (syntax = SYNTAX_WITH_FLAGS (symchar),
3514 SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
3515 { 3517 {
3516 state->comstyle
3517 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3518 comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3519 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3520 state->incomment = comnested ? 1 : -1;
3521 state->comstr_start = prev_from;
3522 INC_FROM; 3518 INC_FROM;
3523 prev_from_syntax = Smax; 3519 prev_from_syntax = Smax; /* the syntax has already been "used up". */
3524 code = Scomment;
3525 goto atcomment; 3520 goto atcomment;
3526 } 3521 }
3527 3522
3523 int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte);
3528 switch (SYNTAX (symchar)) 3524 switch (SYNTAX (symchar))
3529 { 3525 {
3530 case Scharquote: 3526 case Scharquote:
@@ -3540,13 +3536,25 @@ do { prev_from = from; \
3540 goto symdone; 3536 goto symdone;
3541 } 3537 }
3542 INC_FROM; 3538 INC_FROM;
3539 rarely_quit (++quit_count);
3543 } 3540 }
3544 symdone: 3541 symdone:
3545 curlevel->prev = curlevel->last; 3542 curlevel->prev = curlevel->last;
3546 break; 3543 break;
3547 3544
3548 case Scomment_fence: /* Can't happen because it's handled above. */ 3545 case Scomment_fence:
3546 /* Record the comment style we have entered so that only
3547 the comment-end sequence of the same style actually
3548 terminates the comment section. */
3549 state->comstyle = ST_COMMENT_STYLE;
3550 state->incomment = -1;
3551 state->comstr_start = prev_from;
3552 goto atcomment;
3549 case Scomment: 3553 case Scomment:
3554 state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
3555 state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3556 1 : -1);
3557 state->comstr_start = prev_from;
3550 atcomment: 3558 atcomment:
3551 if (commentstop || boundary_stop) goto done; 3559 if (commentstop || boundary_stop) goto done;
3552 startincomment: 3560 startincomment:
@@ -3639,6 +3647,7 @@ do { prev_from = from; \
3639 break; 3647 break;
3640 } 3648 }
3641 INC_FROM; 3649 INC_FROM;
3650 rarely_quit (++quit_count);
3642 } 3651 }
3643 } 3652 }
3644 string_end: 3653 string_end:
@@ -3680,7 +3689,6 @@ do { prev_from = from; \
3680 state->levelstarts); 3689 state->levelstarts);
3681 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) 3690 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
3682 || state->quoted) ? prev_from_syntax : Smax; 3691 || state->quoted) ? prev_from_syntax : Smax;
3683 immediate_quit = 0;
3684} 3692}
3685 3693
3686/* Convert a (lisp) parse state to the internal form used in 3694/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/sysdep.c b/src/sysdep.c
index 4316c21a1c7..91b2a5cb943 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -382,19 +382,23 @@ get_child_status (pid_t child, int *status, int options, bool interruptible)
382 so that another thread running glib won't find them. */ 382 so that another thread running glib won't find them. */
383 eassert (child > 0); 383 eassert (child > 0);
384 384
385 while ((pid = waitpid (child, status, options)) < 0) 385 while (true)
386 { 386 {
387 /* Note: the MS-Windows emulation of waitpid calls maybe_quit
388 internally. */
389 if (interruptible)
390 maybe_quit ();
391
392 pid = waitpid (child, status, options);
393 if (0 <= pid)
394 break;
395
387 /* Check that CHILD is a child process that has not been reaped, 396 /* Check that CHILD is a child process that has not been reaped,
388 and that STATUS and OPTIONS are valid. Otherwise abort, 397 and that STATUS and OPTIONS are valid. Otherwise abort,
389 as continuing after this internal error could cause Emacs to 398 as continuing after this internal error could cause Emacs to
390 become confused and kill innocent-victim processes. */ 399 become confused and kill innocent-victim processes. */
391 if (errno != EINTR) 400 if (errno != EINTR)
392 emacs_abort (); 401 emacs_abort ();
393
394 /* Note: the MS-Windows emulation of waitpid calls QUIT
395 internally. */
396 if (interruptible)
397 QUIT;
398 } 402 }
399 403
400 /* If successful and status is requested, tell wait_reading_process_output 404 /* If successful and status is requested, tell wait_reading_process_output
@@ -2383,7 +2387,7 @@ emacs_open (const char *file, int oflags, int mode)
2383 oflags |= O_BINARY; 2387 oflags |= O_BINARY;
2384 oflags |= O_CLOEXEC; 2388 oflags |= O_CLOEXEC;
2385 while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) 2389 while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR)
2386 QUIT; 2390 maybe_quit ();
2387 if (! O_CLOEXEC && 0 <= fd) 2391 if (! O_CLOEXEC && 0 <= fd)
2388 fcntl (fd, F_SETFD, FD_CLOEXEC); 2392 fcntl (fd, F_SETFD, FD_CLOEXEC);
2389 return fd; 2393 return fd;
@@ -2503,78 +2507,113 @@ emacs_close (int fd)
2503#define MAX_RW_COUNT (INT_MAX >> 18 << 18) 2507#define MAX_RW_COUNT (INT_MAX >> 18 << 18)
2504#endif 2508#endif
2505 2509
2506/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted. 2510/* Read from FD to a buffer BUF with size NBYTE.
2511 If interrupted, process any quits and pending signals immediately
2512 if INTERRUPTIBLE, and then retry the read unless quitting.
2507 Return the number of bytes read, which might be less than NBYTE. 2513 Return the number of bytes read, which might be less than NBYTE.
2508 On error, set errno and return -1. */ 2514 On error, set errno to a value other than EINTR, and return -1. */
2509ptrdiff_t 2515static ptrdiff_t
2510emacs_read (int fildes, void *buf, ptrdiff_t nbyte) 2516emacs_intr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible)
2511{ 2517{
2512 ssize_t rtnval; 2518 ssize_t result;
2513 2519
2514 /* There is no need to check against MAX_RW_COUNT, since no caller ever 2520 /* There is no need to check against MAX_RW_COUNT, since no caller ever
2515 passes a size that large to emacs_read. */ 2521 passes a size that large to emacs_read. */
2522 do
2523 {
2524 if (interruptible)
2525 maybe_quit ();
2526 result = read (fd, buf, nbyte);
2527 }
2528 while (result < 0 && errno == EINTR);
2516 2529
2517 while ((rtnval = read (fildes, buf, nbyte)) == -1 2530 return result;
2518 && (errno == EINTR))
2519 QUIT;
2520 return (rtnval);
2521} 2531}
2522 2532
2523/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted 2533/* Read from FD to a buffer BUF with size NBYTE.
2524 or if a partial write occurs. If interrupted, process pending 2534 If interrupted, retry the read. Return the number of bytes read,
2525 signals if PROCESS SIGNALS. Return the number of bytes written, setting 2535 which might be less than NBYTE. On error, set errno to a value
2526 errno if this is less than NBYTE. */ 2536 other than EINTR, and return -1. */
2537ptrdiff_t
2538emacs_read (int fd, void *buf, ptrdiff_t nbyte)
2539{
2540 return emacs_intr_read (fd, buf, nbyte, false);
2541}
2542
2543/* Like emacs_read, but also process quits and pending signals. */
2544ptrdiff_t
2545emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte)
2546{
2547 return emacs_intr_read (fd, buf, nbyte, true);
2548}
2549
2550/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if
2551 interrupted or if a partial write occurs. Process any quits
2552 immediately if INTERRUPTIBLE is positive, and process any pending
2553 signals immediately if INTERRUPTIBLE is nonzero. Return the number
2554 of bytes written; if this is less than NBYTE, set errno to a value
2555 other than EINTR. */
2527static ptrdiff_t 2556static ptrdiff_t
2528emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte, 2557emacs_full_write (int fd, char const *buf, ptrdiff_t nbyte,
2529 bool process_signals) 2558 int interruptible)
2530{ 2559{
2531 ptrdiff_t bytes_written = 0; 2560 ptrdiff_t bytes_written = 0;
2532 2561
2533 while (nbyte > 0) 2562 while (nbyte > 0)
2534 { 2563 {
2535 ssize_t n = write (fildes, buf, min (nbyte, MAX_RW_COUNT)); 2564 ssize_t n = write (fd, buf, min (nbyte, MAX_RW_COUNT));
2536 2565
2537 if (n < 0) 2566 if (n < 0)
2538 { 2567 {
2539 if (errno == EINTR) 2568 if (errno != EINTR)
2569 break;
2570
2571 if (interruptible)
2540 { 2572 {
2541 /* I originally used `QUIT' but that might cause files to 2573 if (0 < interruptible)
2542 be truncated if you hit C-g in the middle of it. --Stef */ 2574 maybe_quit ();
2543 if (process_signals && pending_signals) 2575 if (pending_signals)
2544 process_pending_signals (); 2576 process_pending_signals ();
2545 continue;
2546 } 2577 }
2547 else
2548 break;
2549 } 2578 }
2550 2579 else
2551 buf += n; 2580 {
2552 nbyte -= n; 2581 buf += n;
2553 bytes_written += n; 2582 nbyte -= n;
2583 bytes_written += n;
2584 }
2554 } 2585 }
2555 2586
2556 return bytes_written; 2587 return bytes_written;
2557} 2588}
2558 2589
2559/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if 2590/* Write to FD from a buffer BUF with size NBYTE, retrying if
2560 interrupted or if a partial write occurs. Return the number of 2591 interrupted or if a partial write occurs. Do not process quits or
2561 bytes written, setting errno if this is less than NBYTE. */ 2592 pending signals. Return the number of bytes written, setting errno
2593 if this is less than NBYTE. */
2594ptrdiff_t
2595emacs_write (int fd, void const *buf, ptrdiff_t nbyte)
2596{
2597 return emacs_full_write (fd, buf, nbyte, 0);
2598}
2599
2600/* Like emacs_write, but also process pending signals. */
2562ptrdiff_t 2601ptrdiff_t
2563emacs_write (int fildes, void const *buf, ptrdiff_t nbyte) 2602emacs_write_sig (int fd, void const *buf, ptrdiff_t nbyte)
2564{ 2603{
2565 return emacs_full_write (fildes, buf, nbyte, 0); 2604 return emacs_full_write (fd, buf, nbyte, -1);
2566} 2605}
2567 2606
2568/* Like emacs_write, but also process pending signals if interrupted. */ 2607/* Like emacs_write, but also process quits and pending signals. */
2569ptrdiff_t 2608ptrdiff_t
2570emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte) 2609emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte)
2571{ 2610{
2572 return emacs_full_write (fildes, buf, nbyte, 1); 2611 return emacs_full_write (fd, buf, nbyte, 1);
2573} 2612}
2574 2613
2575/* Write a diagnostic to standard error that contains MESSAGE and a 2614/* Write a diagnostic to standard error that contains MESSAGE and a
2576 string derived from errno. Preserve errno. Do not buffer stderr. 2615 string derived from errno. Preserve errno. Do not buffer stderr.
2577 Do not process pending signals if interrupted. */ 2616 Do not process quits or pending signals if interrupted. */
2578void 2617void
2579emacs_perror (char const *message) 2618emacs_perror (char const *message)
2580{ 2619{
@@ -3168,7 +3207,7 @@ system_process_attributes (Lisp_Object pid)
3168 else 3207 else
3169 { 3208 {
3170 record_unwind_protect_int (close_file_unwind, fd); 3209 record_unwind_protect_int (close_file_unwind, fd);
3171 nread = emacs_read (fd, procbuf, sizeof procbuf - 1); 3210 nread = emacs_read_quit (fd, procbuf, sizeof procbuf - 1);
3172 } 3211 }
3173 if (0 < nread) 3212 if (0 < nread)
3174 { 3213 {
@@ -3289,7 +3328,7 @@ system_process_attributes (Lisp_Object pid)
3289 /* Leave room even if every byte needs escaping below. */ 3328 /* Leave room even if every byte needs escaping below. */
3290 readsize = (cmdline_size >> 1) - nread; 3329 readsize = (cmdline_size >> 1) - nread;
3291 3330
3292 nread_incr = emacs_read (fd, cmdline + nread, readsize); 3331 nread_incr = emacs_read_quit (fd, cmdline + nread, readsize);
3293 nread += max (0, nread_incr); 3332 nread += max (0, nread_incr);
3294 } 3333 }
3295 while (nread_incr == readsize); 3334 while (nread_incr == readsize);
@@ -3402,7 +3441,7 @@ system_process_attributes (Lisp_Object pid)
3402 else 3441 else
3403 { 3442 {
3404 record_unwind_protect_int (close_file_unwind, fd); 3443 record_unwind_protect_int (close_file_unwind, fd);
3405 nread = emacs_read (fd, &pinfo, sizeof pinfo); 3444 nread = emacs_read_quit (fd, &pinfo, sizeof pinfo);
3406 } 3445 }
3407 3446
3408 if (nread == sizeof pinfo) 3447 if (nread == sizeof pinfo)
diff --git a/src/textprop.c b/src/textprop.c
index bf77f84ab79..116bf3f2c93 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -212,7 +212,7 @@ validate_plist (Lisp_Object list)
212 if (! CONSP (tail)) 212 if (! CONSP (tail))
213 error ("Odd length text property list"); 213 error ("Odd length text property list");
214 tail = XCDR (tail); 214 tail = XCDR (tail);
215 QUIT; 215 maybe_quit ();
216 } 216 }
217 while (CONSP (tail)); 217 while (CONSP (tail));
218 218
diff --git a/src/w32fns.c b/src/w32fns.c
index c24fce11fc8..1b628b0b42e 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,18 +3166,9 @@ 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. */
3172#if 0
3173 /* If we're inside a function that wants immediate quits,
3174 do it now. */
3175 if (immediate_quit && NILP (Vinhibit_quit))
3176 {
3177 immediate_quit = 0;
3178 QUIT;
3179 }
3180#endif
3181 } 3172 }
3182} 3173}
3183 3174
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..95690443f8e 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;
@@ -4769,7 +4770,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
4769{ 4770{
4770 ptrdiff_t count = SPECPDL_INDEX (); 4771 ptrdiff_t count = SPECPDL_INDEX ();
4771 4772
4772 immediate_quit = true;
4773 n = clip_to_bounds (INT_MIN, n, INT_MAX); 4773 n = clip_to_bounds (INT_MIN, n, INT_MAX);
4774 4774
4775 wset_redisplay (XWINDOW (window)); 4775 wset_redisplay (XWINDOW (window));
@@ -4788,7 +4788,36 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
4788 4788
4789 /* Bug#15957. */ 4789 /* Bug#15957. */
4790 XWINDOW (window)->window_end_valid = false; 4790 XWINDOW (window)->window_end_valid = false;
4791 immediate_quit = false; 4791}
4792
4793/* Compute scroll margin for WINDOW.
4794 We scroll when point is within this distance from the top or bottom
4795 of the window. The result is measured in lines or in pixels
4796 depending on the second parameter. */
4797int
4798window_scroll_margin (struct window *window, enum margin_unit unit)
4799{
4800 if (scroll_margin > 0)
4801 {
4802 int frame_line_height = default_line_pixel_height (window);
4803 int window_lines = window_box_height (window) / frame_line_height;
4804
4805 double ratio = 0.25;
4806 if (FLOATP (Vmaximum_scroll_margin))
4807 {
4808 ratio = XFLOAT_DATA (Vmaximum_scroll_margin);
4809 ratio = max (0.0, ratio);
4810 ratio = min (ratio, 0.5);
4811 }
4812 int max_margin = min ((window_lines - 1)/2,
4813 (int) (window_lines * ratio));
4814 int margin = clip_to_bounds (0, scroll_margin, max_margin);
4815 return (unit == MARGIN_IN_PIXELS)
4816 ? margin * frame_line_height
4817 : margin;
4818 }
4819 else
4820 return 0;
4792} 4821}
4793 4822
4794 4823
@@ -4807,7 +4836,6 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
4807 bool vscrolled = false; 4836 bool vscrolled = false;
4808 int x, y, rtop, rbot, rowh, vpos; 4837 int x, y, rtop, rbot, rowh, vpos;
4809 void *itdata = NULL; 4838 void *itdata = NULL;
4810 int window_total_lines;
4811 int frame_line_height = default_line_pixel_height (w); 4839 int frame_line_height = default_line_pixel_height (w);
4812 bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window), 4840 bool adjust_old_pointm = !NILP (Fequal (Fwindow_point (window),
4813 Fwindow_old_point (window))); 4841 Fwindow_old_point (window)));
@@ -5063,12 +5091,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
5063 /* Move PT out of scroll margins. 5091 /* Move PT out of scroll margins.
5064 This code wants current_y to be zero at the window start position 5092 This code wants current_y to be zero at the window start position
5065 even if there is a header line. */ 5093 even if there is a header line. */
5066 window_total_lines 5094 this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
5067 = w->total_lines * WINDOW_FRAME_LINE_HEIGHT (w) / frame_line_height;
5068 this_scroll_margin = max (0, scroll_margin);
5069 this_scroll_margin
5070 = min (this_scroll_margin, window_total_lines / 4);
5071 this_scroll_margin *= frame_line_height;
5072 5095
5073 if (n > 0) 5096 if (n > 0)
5074 { 5097 {
@@ -5124,7 +5147,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
5124 in the scroll margin at the bottom. */ 5147 in the scroll margin at the bottom. */
5125 move_it_to (&it, PT, -1, 5148 move_it_to (&it, PT, -1,
5126 (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w) 5149 (it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w)
5127 - this_scroll_margin - 1), 5150 - partial_line_height (&it) - this_scroll_margin - 1),
5128 -1, 5151 -1,
5129 MOVE_TO_POS | MOVE_TO_Y); 5152 MOVE_TO_POS | MOVE_TO_Y);
5130 5153
@@ -5291,9 +5314,7 @@ window_scroll_line_based (Lisp_Object window, int n, bool whole, bool noerror)
5291 5314
5292 if (pos < ZV) 5315 if (pos < ZV)
5293 { 5316 {
5294 /* Don't use a scroll margin that is negative or too large. */ 5317 int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES);
5295 int this_scroll_margin =
5296 max (0, min (scroll_margin, w->total_lines / 4));
5297 5318
5298 set_marker_restricted_both (w->start, w->contents, pos, pos_byte); 5319 set_marker_restricted_both (w->start, w->contents, pos, pos_byte);
5299 w->start_at_line_beg = !NILP (bolp); 5320 w->start_at_line_beg = !NILP (bolp);
@@ -5723,8 +5744,7 @@ and redisplay normally--don't erase and redraw the frame. */)
5723 5744
5724 /* Do this after making BUF current 5745 /* Do this after making BUF current
5725 in case scroll_margin is buffer-local. */ 5746 in case scroll_margin is buffer-local. */
5726 this_scroll_margin 5747 this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES);
5727 = max (0, min (scroll_margin, w->total_lines / 4));
5728 5748
5729 /* Don't use redisplay code for initial frames, as the necessary 5749 /* Don't use redisplay code for initial frames, as the necessary
5730 data structures might not be set up yet then. */ 5750 data structures might not be set up yet then. */
@@ -5963,10 +5983,6 @@ from the top of the window. */)
5963 5983
5964 lines = displayed_window_lines (w); 5984 lines = displayed_window_lines (w);
5965 5985
5966#if false
5967 this_scroll_margin = max (0, min (scroll_margin, lines / 4));
5968#endif
5969
5970 if (NILP (arg)) 5986 if (NILP (arg))
5971 XSETFASTINT (arg, lines / 2); 5987 XSETFASTINT (arg, lines / 2);
5972 else 5988 else
@@ -5982,6 +5998,8 @@ from the top of the window. */)
5982 it is probably better not to install it. However, it is here 5998 it is probably better not to install it. However, it is here
5983 inside #if false so as not to lose it. -- rms. */ 5999 inside #if false so as not to lose it. -- rms. */
5984 6000
6001 this_scroll_margin = window_scroll_margin (w, MARGIN_IN_LINES);
6002
5985 /* Don't let it get into the margin at either top or bottom. */ 6003 /* Don't let it get into the margin at either top or bottom. */
5986 iarg = max (iarg, this_scroll_margin); 6004 iarg = max (iarg, this_scroll_margin);
5987 iarg = min (iarg, lines - this_scroll_margin - 1); 6005 iarg = min (iarg, lines - this_scroll_margin - 1);
diff --git a/src/window.h b/src/window.h
index 061cf244943..acb8a5cabfa 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1120,6 +1120,8 @@ extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
1120extern void mark_window_cursors_off (struct window *); 1120extern void mark_window_cursors_off (struct window *);
1121extern int window_internal_height (struct window *); 1121extern int window_internal_height (struct window *);
1122extern int window_body_width (struct window *w, bool); 1122extern int window_body_width (struct window *w, bool);
1123enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS };
1124extern int window_scroll_margin (struct window *, enum margin_unit);
1123extern void temp_output_buffer_show (Lisp_Object); 1125extern void temp_output_buffer_show (Lisp_Object);
1124extern void replace_buffer_in_windows (Lisp_Object); 1126extern void replace_buffer_in_windows (Lisp_Object);
1125extern void replace_buffer_in_windows_safely (Lisp_Object); 1127extern void replace_buffer_in_windows_safely (Lisp_Object);
diff --git a/src/xdisp.c b/src/xdisp.c
index 168922ef06b..0e329dfe6e9 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -9859,6 +9859,32 @@ move_it_by_lines (struct it *it, ptrdiff_t dvpos)
9859 } 9859 }
9860} 9860}
9861 9861
9862int
9863partial_line_height (struct it *it_origin)
9864{
9865 int partial_height;
9866 void *it_data = NULL;
9867 struct it it;
9868 SAVE_IT (it, *it_origin, it_data);
9869 move_it_to (&it, ZV, -1, it.last_visible_y, -1,
9870 MOVE_TO_POS | MOVE_TO_Y);
9871 if (it.what == IT_EOB)
9872 {
9873 int vis_height = it.last_visible_y - it.current_y;
9874 int height = it.ascent + it.descent;
9875 partial_height = (vis_height < height) ? vis_height : 0;
9876 }
9877 else
9878 {
9879 int last_line_y = it.current_y;
9880 move_it_by_lines (&it, 1);
9881 partial_height = (it.current_y > it.last_visible_y)
9882 ? it.last_visible_y - last_line_y : 0;
9883 }
9884 RESTORE_IT (&it, &it, it_data);
9885 return partial_height;
9886}
9887
9862/* Return true if IT points into the middle of a display vector. */ 9888/* Return true if IT points into the middle of a display vector. */
9863 9889
9864bool 9890bool
@@ -15316,7 +15342,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
15316 bool temp_scroll_step, bool last_line_misfit) 15342 bool temp_scroll_step, bool last_line_misfit)
15317{ 15343{
15318 struct window *w = XWINDOW (window); 15344 struct window *w = XWINDOW (window);
15319 struct frame *f = XFRAME (w->frame);
15320 struct text_pos pos, startp; 15345 struct text_pos pos, startp;
15321 struct it it; 15346 struct it it;
15322 int this_scroll_margin, scroll_max, rc, height; 15347 int this_scroll_margin, scroll_max, rc, height;
@@ -15327,8 +15352,6 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
15327 /* We will never try scrolling more than this number of lines. */ 15352 /* We will never try scrolling more than this number of lines. */
15328 int scroll_limit = SCROLL_LIMIT; 15353 int scroll_limit = SCROLL_LIMIT;
15329 int frame_line_height = default_line_pixel_height (w); 15354 int frame_line_height = default_line_pixel_height (w);
15330 int window_total_lines
15331 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height;
15332 15355
15333#ifdef GLYPH_DEBUG 15356#ifdef GLYPH_DEBUG
15334 debug_method_add (w, "try_scrolling"); 15357 debug_method_add (w, "try_scrolling");
@@ -15336,13 +15359,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
15336 15359
15337 SET_TEXT_POS_FROM_MARKER (startp, w->start); 15360 SET_TEXT_POS_FROM_MARKER (startp, w->start);
15338 15361
15339 /* Compute scroll margin height in pixels. We scroll when point is 15362 this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
15340 within this distance from the top or bottom of the window. */
15341 if (scroll_margin > 0)
15342 this_scroll_margin = min (scroll_margin, window_total_lines / 4)
15343 * frame_line_height;
15344 else
15345 this_scroll_margin = 0;
15346 15363
15347 /* Force arg_scroll_conservatively to have a reasonable value, to 15364 /* Force arg_scroll_conservatively to have a reasonable value, to
15348 avoid scrolling too far away with slow move_it_* functions. Note 15365 avoid scrolling too far away with slow move_it_* functions. Note
@@ -15377,7 +15394,8 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
15377 /* Compute the pixel ypos of the scroll margin, then move IT to 15394 /* Compute the pixel ypos of the scroll margin, then move IT to
15378 either that ypos or PT, whichever comes first. */ 15395 either that ypos or PT, whichever comes first. */
15379 start_display (&it, w, startp); 15396 start_display (&it, w, startp);
15380 scroll_margin_y = it.last_visible_y - this_scroll_margin 15397 scroll_margin_y = it.last_visible_y - partial_line_height (&it)
15398 - this_scroll_margin
15381 - frame_line_height * extra_scroll_margin_lines; 15399 - frame_line_height * extra_scroll_margin_lines;
15382 move_it_to (&it, PT, -1, scroll_margin_y - 1, -1, 15400 move_it_to (&it, PT, -1, scroll_margin_y - 1, -1,
15383 (MOVE_TO_POS | MOVE_TO_Y)); 15401 (MOVE_TO_POS | MOVE_TO_Y));
@@ -15816,23 +15834,12 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
15816 { 15834 {
15817 int this_scroll_margin, top_scroll_margin; 15835 int this_scroll_margin, top_scroll_margin;
15818 struct glyph_row *row = NULL; 15836 struct glyph_row *row = NULL;
15819 int frame_line_height = default_line_pixel_height (w);
15820 int window_total_lines
15821 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height;
15822 15837
15823#ifdef GLYPH_DEBUG 15838#ifdef GLYPH_DEBUG
15824 debug_method_add (w, "cursor movement"); 15839 debug_method_add (w, "cursor movement");
15825#endif 15840#endif
15826 15841
15827 /* Scroll if point within this distance from the top or bottom 15842 this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
15828 of the window. This is a pixel value. */
15829 if (scroll_margin > 0)
15830 {
15831 this_scroll_margin = min (scroll_margin, window_total_lines / 4);
15832 this_scroll_margin *= frame_line_height;
15833 }
15834 else
15835 this_scroll_margin = 0;
15836 15843
15837 top_scroll_margin = this_scroll_margin; 15844 top_scroll_margin = this_scroll_margin;
15838 if (WINDOW_WANTS_HEADER_LINE_P (w)) 15845 if (WINDOW_WANTS_HEADER_LINE_P (w))
@@ -16280,7 +16287,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16280 int centering_position = -1; 16287 int centering_position = -1;
16281 bool last_line_misfit = false; 16288 bool last_line_misfit = false;
16282 ptrdiff_t beg_unchanged, end_unchanged; 16289 ptrdiff_t beg_unchanged, end_unchanged;
16283 int frame_line_height; 16290 int frame_line_height, margin;
16284 bool use_desired_matrix; 16291 bool use_desired_matrix;
16285 void *itdata = NULL; 16292 void *itdata = NULL;
16286 16293
@@ -16310,6 +16317,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16310 restart: 16317 restart:
16311 reconsider_clip_changes (w); 16318 reconsider_clip_changes (w);
16312 frame_line_height = default_line_pixel_height (w); 16319 frame_line_height = default_line_pixel_height (w);
16320 margin = window_scroll_margin (w, MARGIN_IN_LINES);
16321
16313 16322
16314 /* Has the mode line to be updated? */ 16323 /* Has the mode line to be updated? */
16315 update_mode_line = (w->update_mode_line 16324 update_mode_line = (w->update_mode_line
@@ -16614,10 +16623,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16614 /* Some people insist on not letting point enter the scroll 16623 /* Some people insist on not letting point enter the scroll
16615 margin, even though this part handles windows that didn't 16624 margin, even though this part handles windows that didn't
16616 scroll at all. */ 16625 scroll at all. */
16617 int window_total_lines 16626 int pixel_margin = margin * frame_line_height;
16618 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height;
16619 int margin = min (scroll_margin, window_total_lines / 4);
16620 int pixel_margin = margin * frame_line_height;
16621 bool header_line = WINDOW_WANTS_HEADER_LINE_P (w); 16627 bool header_line = WINDOW_WANTS_HEADER_LINE_P (w);
16622 16628
16623 /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop 16629 /* Note: We add an extra FRAME_LINE_HEIGHT, because the loop
@@ -16901,12 +16907,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16901 it.current_y = it.last_visible_y; 16907 it.current_y = it.last_visible_y;
16902 if (centering_position < 0) 16908 if (centering_position < 0)
16903 { 16909 {
16904 int window_total_lines
16905 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height;
16906 int margin
16907 = scroll_margin > 0
16908 ? min (scroll_margin, window_total_lines / 4)
16909 : 0;
16910 ptrdiff_t margin_pos = CHARPOS (startp); 16910 ptrdiff_t margin_pos = CHARPOS (startp);
16911 Lisp_Object aggressive; 16911 Lisp_Object aggressive;
16912 bool scrolling_up; 16912 bool scrolling_up;
@@ -17150,10 +17150,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
17150 { 17150 {
17151 int window_total_lines 17151 int window_total_lines
17152 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height; 17152 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height;
17153 int margin =
17154 scroll_margin > 0
17155 ? min (scroll_margin, window_total_lines / 4)
17156 : 0;
17157 bool move_down = w->cursor.vpos >= window_total_lines / 2; 17153 bool move_down = w->cursor.vpos >= window_total_lines / 2;
17158 17154
17159 move_it_by_lines (&it, move_down ? margin + 1 : -(margin + 1)); 17155 move_it_by_lines (&it, move_down ? margin + 1 : -(margin + 1));
@@ -17359,7 +17355,6 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
17359 struct it it; 17355 struct it it;
17360 struct glyph_row *last_text_row = NULL; 17356 struct glyph_row *last_text_row = NULL;
17361 struct frame *f = XFRAME (w->frame); 17357 struct frame *f = XFRAME (w->frame);
17362 int frame_line_height = default_line_pixel_height (w);
17363 17358
17364 /* Make POS the new window start. */ 17359 /* Make POS the new window start. */
17365 set_marker_both (w->start, Qnil, CHARPOS (pos), BYTEPOS (pos)); 17360 set_marker_both (w->start, Qnil, CHARPOS (pos), BYTEPOS (pos));
@@ -17385,17 +17380,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
17385 if ((flags & TRY_WINDOW_CHECK_MARGINS) 17380 if ((flags & TRY_WINDOW_CHECK_MARGINS)
17386 && !MINI_WINDOW_P (w)) 17381 && !MINI_WINDOW_P (w))
17387 { 17382 {
17388 int this_scroll_margin; 17383 int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
17389 int window_total_lines
17390 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (f) / frame_line_height;
17391
17392 if (scroll_margin > 0)
17393 {
17394 this_scroll_margin = min (scroll_margin, window_total_lines / 4);
17395 this_scroll_margin *= frame_line_height;
17396 }
17397 else
17398 this_scroll_margin = 0;
17399 17384
17400 if ((w->cursor.y >= 0 /* not vscrolled */ 17385 if ((w->cursor.y >= 0 /* not vscrolled */
17401 && w->cursor.y < this_scroll_margin 17386 && w->cursor.y < this_scroll_margin
@@ -18679,15 +18664,8 @@ try_window_id (struct window *w)
18679 18664
18680 /* Don't let the cursor end in the scroll margins. */ 18665 /* Don't let the cursor end in the scroll margins. */
18681 { 18666 {
18682 int this_scroll_margin, cursor_height; 18667 int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
18683 int frame_line_height = default_line_pixel_height (w); 18668 int cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height;
18684 int window_total_lines
18685 = WINDOW_TOTAL_LINES (w) * FRAME_LINE_HEIGHT (it.f) / frame_line_height;
18686
18687 this_scroll_margin =
18688 max (0, min (scroll_margin, window_total_lines / 4));
18689 this_scroll_margin *= frame_line_height;
18690 cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height;
18691 18669
18692 if ((w->cursor.y < this_scroll_margin 18670 if ((w->cursor.y < this_scroll_margin
18693 && CHARPOS (start) > BEGV) 18671 && CHARPOS (start) > BEGV)
@@ -22635,7 +22613,7 @@ move_elt_to_front (Lisp_Object elt, Lisp_Object list)
22635 else 22613 else
22636 prev = tail; 22614 prev = tail;
22637 tail = XCDR (tail); 22615 tail = XCDR (tail);
22638 QUIT; 22616 maybe_quit ();
22639 } 22617 }
22640 22618
22641 /* Not found--return unchanged LIST. */ 22619 /* Not found--return unchanged LIST. */
@@ -31569,6 +31547,14 @@ Recenter the window whenever point gets within this many lines
31569of the top or bottom of the window. */); 31547of the top or bottom of the window. */);
31570 scroll_margin = 0; 31548 scroll_margin = 0;
31571 31549
31550 DEFVAR_LISP ("maximum-scroll-margin", Vmaximum_scroll_margin,
31551 doc: /* Maximum effective value of `scroll-margin'.
31552Given as a fraction of the current window's lines. The value should
31553be a floating point number between 0.0 and 0.5. The effective maximum
31554is limited to (/ (1- window-lines) 2). Non-float values for this
31555variable are ignored and the default 0.25 is used instead. */);
31556 Vmaximum_scroll_margin = make_float (0.25);
31557
31572 DEFVAR_LISP ("display-pixels-per-inch", Vdisplay_pixels_per_inch, 31558 DEFVAR_LISP ("display-pixels-per-inch", Vdisplay_pixels_per_inch,
31573 doc: /* Pixels per inch value for non-window system displays. 31559 doc: /* Pixels per inch value for non-window system displays.
31574Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */); 31560Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */);
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 db561c902a6..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
@@ -12877,7 +12877,7 @@ keysyms. The default is nil, which is the same as `super'. */);
12877 Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900), 12877 Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
12878 make_float (DEFAULT_REHASH_SIZE), 12878 make_float (DEFAULT_REHASH_SIZE),
12879 make_float (DEFAULT_REHASH_THRESHOLD), 12879 make_float (DEFAULT_REHASH_THRESHOLD),
12880 Qnil); 12880 Qnil, Qnil);
12881 12881
12882 DEFVAR_BOOL ("x-frame-normalize-before-maximize", 12882 DEFVAR_BOOL ("x-frame-normalize-before-maximize",
12883 x_frame_normalize_before_maximize, 12883 x_frame_normalize_before_maximize,
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-12 13:13:29 +0000