aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2017-02-01 15:18:44 -0800
committerPaul Eggert2017-02-01 15:23:19 -0800
commitb01ac672be1277833964d2d53f6dd26560c70343 (patch)
tree31b886a5084f20135bec50fe831dcfeed229c619
parent33be50037c2b4cdb002538534e9915c6bad253b7 (diff)
downloademacs-b01ac672be1277833964d2d53f6dd26560c70343.tar.gz
emacs-b01ac672be1277833964d2d53f6dd26560c70343.zip
Revamp quitting and fix infloops
This fixes some infinite loops that cannot be quitted out of, e.g., (defun foo () (nth most-positive-fixnum '#1=(1 . #1#))) when byte-compiled and when run under X. See: http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00577.html This also attempts to keep the performance improvements I recently added, as much as possible under the constraint that the infloops must be caught. In some cases this fixes infloop bugs recently introduced when I removed immediate_quit. * src/alloc.c (Fmake_list): Use rarely_quit, not maybe_quit, for speed in the usual case. * src/bytecode.c (exec_byte_code): * src/editfns.c (Fcompare_buffer_substrings): * src/fns.c (Fnthcdr): * src/syntax.c (scan_words, skip_chars, skip_syntaxes) (Fbackward_prefix_chars): Use rarely_quit so that users can C-g out of long loops. * src/callproc.c (call_process_cleanup, call_process): * src/fileio.c (read_non_regular, Finsert_file_contents): * src/indent.c (compute_motion): * src/syntax.c (scan_words, Fforward_comment): Remove now-unnecessary maybe_quit calls. * src/callproc.c (call_process): * src/doc.c (get_doc_string, Fsnarf_documentation): * src/fileio.c (Fcopy_file, read_non_regular, Finsert_file_contents): * src/lread.c (safe_to_load_version): * src/sysdep.c (system_process_attributes) [GNU_LINUX]: Use emacs_read_quit instead of emacs_read in places where C-g handling is safe. * src/eval.c (maybe_quit): Move comment here from lisp.h. * src/fileio.c (Fcopy_file, e_write): Use emacs_write_quit instead of emacs_write_sig in places where C-g handling is safe. * src/filelock.c (create_lock_file): Use emacs_write, not plain write, as emacs_write no longer has a problem. (read_lock_data): Use emacs_read, not read, as emacs_read no longer has a problem. * src/fns.c (rarely_quit): Move to lisp.h and rename to incr_rarely_quit. All uses changed.. * src/fns.c (Fmemq, Fmemql, Fassq, Frassq, Fplist_put, Fplist_member): * src/indent.c (compute_motion): * src/syntax.c (find_defun_start, back_comment, forw_comment) (Fforward_comment, scan_lists, scan_sexps_forward): Use incr_rarely_quit so that users can C-g out of long loops. * src/fns.c (Fnconc): Move incr_rarely_quit call to within inner loop, so that it catches C-g there too. * src/keyboard.c (tty_read_avail_input): Remove commented-out and now-obsolete code dealing with interrupts. * src/lisp.h (rarely_quit, incr_rarely_quit): New functions, the latter moved here from fns.c and renamed from rarely_quit. (emacs_read_quit, emacs_write_quit): New decls. * src/search.c (find_newline, search_buffer, find_newline1): Add maybe_quit to catch C-g. * src/sysdep.c (get_child_status): Always invoke maybe_quit if interruptible, so that the caller need not bother. (emacs_nointr_read, emacs_read_quit, emacs_write_quit): New functions. (emacs_read): Rewrite in terms of emacs_nointr_read. Do not handle C-g or signals; that is now for emacs_read_quit. (emacs_full_write): Replace PROCESS_SIGNALS two-way arg with INTERRUPTIBLE three-way arg. All uses changed.
-rw-r--r--src/alloc.c2
-rw-r--r--src/bytecode.c16
-rw-r--r--src/callproc.c9
-rw-r--r--src/doc.c9
-rw-r--r--src/editfns.c1
-rw-r--r--src/eval.c13
-rw-r--r--src/fileio.c55
-rw-r--r--src/filelock.c7
-rw-r--r--src/fns.c53
-rw-r--r--src/indent.c11
-rw-r--r--src/keyboard.c48
-rw-r--r--src/lisp.h40
-rw-r--r--src/lread.c2
-rw-r--r--src/search.c8
-rw-r--r--src/syntax.c112
-rw-r--r--src/sysdep.c129
16 files changed, 295 insertions, 220 deletions
diff --git a/src/alloc.c b/src/alloc.c
index b59220c5d84..e909d312c4e 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2880,7 +2880,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2880 for (EMACS_INT size = XFASTINT (length); 0 < size; size--) 2880 for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
2881 { 2881 {
2882 val = Fcons (init, val); 2882 val = Fcons (init, val);
2883 maybe_quit (); 2883 rarely_quit (size);
2884 } 2884 }
2885 2885
2886 return val; 2886 return val;
diff --git a/src/bytecode.c b/src/bytecode.c
index ed58d18c618..0f7420c19ee 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -841,9 +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 while (--n >= 0 && CONSP (v2)) 845 {
846 v2 = XCDR (v2); 846 v2 = XCDR (v2);
847 rarely_quit (n);
848 }
847 TOP = CAR (v2); 849 TOP = CAR (v2);
848 NEXT; 850 NEXT;
849 } 851 }
@@ -1273,9 +1275,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1273 /* Exchange args and then do nth. */ 1275 /* Exchange args and then do nth. */
1274 Lisp_Object v2 = POP, v1 = TOP; 1276 Lisp_Object v2 = POP, v1 = TOP;
1275 CHECK_NUMBER (v2); 1277 CHECK_NUMBER (v2);
1276 EMACS_INT n = XINT (v2); 1278 for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
1277 while (--n >= 0 && CONSP (v1)) 1279 {
1278 v1 = XCDR (v1); 1280 v1 = XCDR (v1);
1281 rarely_quit (n);
1282 }
1279 TOP = CAR (v1); 1283 TOP = CAR (v1);
1280 } 1284 }
1281 else 1285 else
diff --git a/src/callproc.c b/src/callproc.c
index 85674bb7d9b..710174c46b0 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,7 +198,6 @@ 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 maybe_quit ();
202 wait_for_termination (synch_process_pid, 0, 1); 201 wait_for_termination (synch_process_pid, 0, 1);
203 synch_process_pid = 0; 202 synch_process_pid = 0;
204 message1 ("Waiting for process to die...done"); 203 message1 ("Waiting for process to die...done");
@@ -724,8 +723,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
724 process_coding.src_multibyte = 0; 723 process_coding.src_multibyte = 0;
725 } 724 }
726 725
727 maybe_quit ();
728
729 if (0 <= fd0) 726 if (0 <= fd0)
730 { 727 {
731 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 }; 728 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
@@ -746,8 +743,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
746 nread = carryover; 743 nread = carryover;
747 while (nread < bufsize - 1024) 744 while (nread < bufsize - 1024)
748 { 745 {
749 int this_read = emacs_read (fd0, buf + nread, 746 int this_read = emacs_read_quit (fd0, buf + nread,
750 bufsize - nread); 747 bufsize - nread);
751 748
752 if (this_read < 0) 749 if (this_read < 0)
753 goto give_up; 750 goto give_up;
@@ -838,8 +835,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
838 we should have already detected a coding system. */ 835 we should have already detected a coding system. */
839 display_on_the_fly = true; 836 display_on_the_fly = true;
840 } 837 }
841
842 maybe_quit ();
843 } 838 }
844 give_up: ; 839 give_up: ;
845 840
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 b60543702f1..4618164d008 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3096,6 +3096,7 @@ determines whether case is significant or ignored. */)
3096 return make_number (c1 < c2 ? -1 - chars : chars + 1); 3096 return make_number (c1 < c2 ? -1 - chars : chars + 1);
3097 3097
3098 chars++; 3098 chars++;
3099 rarely_quit (chars);
3099 } 3100 }
3100 3101
3101 /* The strings match as far as they go. 3102 /* The strings match as far as they go.
diff --git a/src/eval.c b/src/eval.c
index 844879d6a2d..22b02b49521 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1461,6 +1461,19 @@ process_quit_flag (void)
1461 quit (); 1461 quit ();
1462} 1462}
1463 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
1464void 1477void
1465maybe_quit (void) 1478maybe_quit (void)
1466{ 1479{
diff --git a/src/fileio.c b/src/fileio.c
index a109737240f..38400623793 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2030,9 +2030,9 @@ permissions. */)
2030 { 2030 {
2031 char buf[MAX_ALLOCA]; 2031 char buf[MAX_ALLOCA];
2032 ptrdiff_t n; 2032 ptrdiff_t n;
2033 for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf)); 2033 for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf));
2034 newsize += n) 2034 newsize += n)
2035 if (emacs_write_sig (ofd, buf, n) != n) 2035 if (emacs_write_quit (ofd, buf, n) != n)
2036 report_file_error ("Write error", newname); 2036 report_file_error ("Write error", newname);
2037 if (n < 0) 2037 if (n < 0)
2038 report_file_error ("Read error", file); 2038 report_file_error ("Read error", file);
@@ -3396,13 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data)
3396static Lisp_Object 3396static Lisp_Object
3397read_non_regular (Lisp_Object state) 3397read_non_regular (Lisp_Object state)
3398{ 3398{
3399 int nbytes; 3399 int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
3400 3400 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3401 maybe_quit (); 3401 + XSAVE_INTEGER (state, 1)),
3402 nbytes = emacs_read (XSAVE_INTEGER (state, 0), 3402 XSAVE_INTEGER (state, 2));
3403 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3404 + XSAVE_INTEGER (state, 1)),
3405 XSAVE_INTEGER (state, 2));
3406 /* Fast recycle this object for the likely next call. */ 3403 /* Fast recycle this object for the likely next call. */
3407 free_misc (state); 3404 free_misc (state);
3408 return make_number (nbytes); 3405 return make_number (nbytes);
@@ -3746,17 +3743,17 @@ by calling `format-decode', which see. */)
3746 int nread; 3743 int nread;
3747 3744
3748 if (st.st_size <= (1024 * 4)) 3745 if (st.st_size <= (1024 * 4))
3749 nread = emacs_read (fd, read_buf, 1024 * 4); 3746 nread = emacs_read_quit (fd, read_buf, 1024 * 4);
3750 else 3747 else
3751 { 3748 {
3752 nread = emacs_read (fd, read_buf, 1024); 3749 nread = emacs_read_quit (fd, read_buf, 1024);
3753 if (nread == 1024) 3750 if (nread == 1024)
3754 { 3751 {
3755 int ntail; 3752 int ntail;
3756 if (lseek (fd, - (1024 * 3), SEEK_END) < 0) 3753 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3757 report_file_error ("Setting file position", 3754 report_file_error ("Setting file position",
3758 orig_filename); 3755 orig_filename);
3759 ntail = emacs_read (fd, read_buf + nread, 1024 * 3); 3756 ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
3760 nread = ntail < 0 ? ntail : nread + ntail; 3757 nread = ntail < 0 ? ntail : nread + ntail;
3761 } 3758 }
3762 } 3759 }
@@ -3861,14 +3858,11 @@ by calling `format-decode', which see. */)
3861 report_file_error ("Setting file position", orig_filename); 3858 report_file_error ("Setting file position", orig_filename);
3862 } 3859 }
3863 3860
3864 maybe_quit ();
3865 /* Count how many chars at the start of the file 3861 /* Count how many chars at the start of the file
3866 match the text at the beginning of the buffer. */ 3862 match the text at the beginning of the buffer. */
3867 while (1) 3863 while (true)
3868 { 3864 {
3869 int nread, bufpos; 3865 int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
3870
3871 nread = emacs_read (fd, read_buf, sizeof read_buf);
3872 if (nread < 0) 3866 if (nread < 0)
3873 report_file_error ("Read error", orig_filename); 3867 report_file_error ("Read error", orig_filename);
3874 else if (nread == 0) 3868 else if (nread == 0)
@@ -3890,7 +3884,7 @@ by calling `format-decode', which see. */)
3890 break; 3884 break;
3891 } 3885 }
3892 3886
3893 bufpos = 0; 3887 int bufpos = 0;
3894 while (bufpos < nread && same_at_start < ZV_BYTE 3888 while (bufpos < nread && same_at_start < ZV_BYTE
3895 && FETCH_BYTE (same_at_start) == read_buf[bufpos]) 3889 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3896 same_at_start++, bufpos++; 3890 same_at_start++, bufpos++;
@@ -3910,7 +3904,7 @@ by calling `format-decode', which see. */)
3910 del_range_1 (same_at_start, same_at_end, 0, 0); 3904 del_range_1 (same_at_start, same_at_end, 0, 0);
3911 goto handled; 3905 goto handled;
3912 } 3906 }
3913 maybe_quit (); 3907
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)
@@ -4058,16 +4053,13 @@ by calling `format-decode', which see. */)
4058 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ 4053 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
4059 unprocessed = 0; /* Bytes not processed in previous loop. */ 4054 unprocessed = 0; /* Bytes not processed in previous loop. */
4060 4055
4061 while (1) 4056 while (true)
4062 { 4057 {
4063 /* 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
4064 quitting while reading a huge file. */ 4059 quitting while reading a huge file. */
4065 4060
4066 /* Allow quitting out of the actual I/O. */ 4061 this = emacs_read_quit (fd, read_buf + unprocessed,
4067 maybe_quit (); 4062 READ_BUF_SIZE - unprocessed);
4068 this = emacs_read (fd, read_buf + unprocessed,
4069 READ_BUF_SIZE - unprocessed);
4070
4071 if (this <= 0) 4063 if (this <= 0)
4072 break; 4064 break;
4073 4065
@@ -4281,11 +4273,10 @@ by calling `format-decode', which see. */)
4281 /* 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
4282 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
4283 here doesn't do any harm. */ 4275 here doesn't do any harm. */
4284 maybe_quit (); 4276 this = emacs_read_quit (fd,
4285 this = emacs_read (fd, 4277 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4286 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 4278 + inserted),
4287 + inserted), 4279 trytry);
4288 trytry);
4289 } 4280 }
4290 4281
4291 if (this <= 0) 4282 if (this <= 0)
@@ -5398,7 +5389,7 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5398 : (STRINGP (coding->dst_object) 5389 : (STRINGP (coding->dst_object)
5399 ? SSDATA (coding->dst_object) 5390 ? SSDATA (coding->dst_object)
5400 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); 5391 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5401 coding->produced -= emacs_write_sig (desc, buf, coding->produced); 5392 coding->produced -= emacs_write_quit (desc, buf, coding->produced);
5402 5393
5403 if (coding->raw_destination) 5394 if (coding->raw_destination)
5404 { 5395 {
diff --git a/src/filelock.c b/src/filelock.c
index de65c52efa1..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;
diff --git a/src/fns.c b/src/fns.c
index 444339c5259..41c0c5856b4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -84,22 +84,6 @@ See Info node `(elisp)Random Numbers' for more details. */)
84 return make_number (val); 84 return make_number (val);
85} 85}
86 86
87/* Heuristic on how many iterations of a tight loop can be safely done
88 before it's time to do a quit. This must be a power of 2. It
89 is nice but not necessary for it to equal USHRT_MAX + 1. */
90enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
91
92/* Process a quit, but do it only rarely, for efficiency. "Rarely"
93 means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
94 whichever is smaller. Use *QUIT_COUNT to count this. */
95
96static void
97rarely_quit (unsigned short int *quit_count)
98{
99 if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
100 maybe_quit ();
101}
102
103/* Random data-structure functions. */ 87/* Random data-structure functions. */
104 88
105DEFUN ("length", Flength, Slength, 1, 1, 0, 89DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -1359,9 +1343,8 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1359 (Lisp_Object n, Lisp_Object list) 1343 (Lisp_Object n, Lisp_Object list)
1360{ 1344{
1361 CHECK_NUMBER (n); 1345 CHECK_NUMBER (n);
1362 EMACS_INT num = XINT (n);
1363 Lisp_Object tail = list; 1346 Lisp_Object tail = list;
1364 for (EMACS_INT i = 0; i < num; i++) 1347 for (EMACS_INT num = XINT (n); 0 < num; num--)
1365 { 1348 {
1366 if (! CONSP (tail)) 1349 if (! CONSP (tail))
1367 { 1350 {
@@ -1369,6 +1352,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1369 return Qnil; 1352 return Qnil;
1370 } 1353 }
1371 tail = XCDR (tail); 1354 tail = XCDR (tail);
1355 rarely_quit (num);
1372 } 1356 }
1373 return tail; 1357 return tail;
1374} 1358}
@@ -1405,7 +1389,7 @@ The value is actually the tail of LIST whose car is ELT. */)
1405 { 1389 {
1406 if (! NILP (Fequal (elt, XCAR (tail)))) 1390 if (! NILP (Fequal (elt, XCAR (tail))))
1407 return tail; 1391 return tail;
1408 rarely_quit (&quit_count); 1392 incr_rarely_quit (&quit_count);
1409 } 1393 }
1410 CHECK_LIST_END (tail, list); 1394 CHECK_LIST_END (tail, list);
1411 return Qnil; 1395 return Qnil;
@@ -1416,11 +1400,13 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1416The value is actually the tail of LIST whose car is ELT. */) 1400The value is actually the tail of LIST whose car is ELT. */)
1417 (Lisp_Object elt, Lisp_Object list) 1401 (Lisp_Object elt, Lisp_Object list)
1418{ 1402{
1403 unsigned short int quit_count = 0;
1419 Lisp_Object tail; 1404 Lisp_Object tail;
1420 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1405 for (tail = list; CONSP (tail); tail = XCDR (tail))
1421 { 1406 {
1422 if (EQ (XCAR (tail), elt)) 1407 if (EQ (XCAR (tail), elt))
1423 return tail; 1408 return tail;
1409 incr_rarely_quit (&quit_count);
1424 } 1410 }
1425 CHECK_LIST_END (tail, list); 1411 CHECK_LIST_END (tail, list);
1426 return Qnil; 1412 return Qnil;
@@ -1434,12 +1420,14 @@ The value is actually the tail of LIST whose car is ELT. */)
1434 if (!FLOATP (elt)) 1420 if (!FLOATP (elt))
1435 return Fmemq (elt, list); 1421 return Fmemq (elt, list);
1436 1422
1423 unsigned short int quit_count = 0;
1437 Lisp_Object tail; 1424 Lisp_Object tail;
1438 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1425 for (tail = list; CONSP (tail); tail = XCDR (tail))
1439 { 1426 {
1440 Lisp_Object tem = XCAR (tail); 1427 Lisp_Object tem = XCAR (tail);
1441 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) 1428 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
1442 return tail; 1429 return tail;
1430 incr_rarely_quit (&quit_count);
1443 } 1431 }
1444 CHECK_LIST_END (tail, list); 1432 CHECK_LIST_END (tail, list);
1445 return Qnil; 1433 return Qnil;
@@ -1451,11 +1439,13 @@ The value is actually the first element of LIST whose car is KEY.
1451Elements of LIST that are not conses are ignored. */) 1439Elements of LIST that are not conses are ignored. */)
1452 (Lisp_Object key, Lisp_Object list) 1440 (Lisp_Object key, Lisp_Object list)
1453{ 1441{
1442 unsigned short int quit_count = 0;
1454 Lisp_Object tail; 1443 Lisp_Object tail;
1455 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1444 for (tail = list; CONSP (tail); tail = XCDR (tail))
1456 { 1445 {
1457 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) 1446 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1458 return XCAR (tail); 1447 return XCAR (tail);
1448 incr_rarely_quit (&quit_count);
1459 } 1449 }
1460 CHECK_LIST_END (tail, list); 1450 CHECK_LIST_END (tail, list);
1461 return Qnil; 1451 return Qnil;
@@ -1486,7 +1476,7 @@ The value is actually the first element of LIST whose car equals KEY. */)
1486 if (CONSP (car) 1476 if (CONSP (car)
1487 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) 1477 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1488 return car; 1478 return car;
1489 rarely_quit (&quit_count); 1479 incr_rarely_quit (&quit_count);
1490 } 1480 }
1491 CHECK_LIST_END (tail, list); 1481 CHECK_LIST_END (tail, list);
1492 return Qnil; 1482 return Qnil;
@@ -1513,11 +1503,13 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
1513The 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. */)
1514 (Lisp_Object key, Lisp_Object list) 1504 (Lisp_Object key, Lisp_Object list)
1515{ 1505{
1506 unsigned short int quit_count = 0;
1516 Lisp_Object tail; 1507 Lisp_Object tail;
1517 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1508 for (tail = list; CONSP (tail); tail = XCDR (tail))
1518 { 1509 {
1519 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) 1510 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
1520 return XCAR (tail); 1511 return XCAR (tail);
1512 incr_rarely_quit (&quit_count);
1521 } 1513 }
1522 CHECK_LIST_END (tail, list); 1514 CHECK_LIST_END (tail, list);
1523 return Qnil; 1515 return Qnil;
@@ -1536,7 +1528,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */)
1536 if (CONSP (car) 1528 if (CONSP (car)
1537 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) 1529 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
1538 return car; 1530 return car;
1539 rarely_quit (&quit_count); 1531 incr_rarely_quit (&quit_count);
1540 } 1532 }
1541 CHECK_LIST_END (tail, list); 1533 CHECK_LIST_END (tail, list);
1542 return Qnil; 1534 return Qnil;
@@ -1692,7 +1684,7 @@ changing the value of a sequence `foo'. */)
1692 } 1684 }
1693 else 1685 else
1694 prev = tail; 1686 prev = tail;
1695 rarely_quit (&quit_count); 1687 incr_rarely_quit (&quit_count);
1696 } 1688 }
1697 CHECK_LIST_END (tail, seq); 1689 CHECK_LIST_END (tail, seq);
1698 } 1690 }
@@ -1717,10 +1709,10 @@ This function may destructively modify SEQ to produce the value. */)
1717 1709
1718 for (prev = Qnil, tail = seq; CONSP (tail); tail = next) 1710 for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
1719 { 1711 {
1720 rarely_quit (&quit_count);
1721 next = XCDR (tail); 1712 next = XCDR (tail);
1722 Fsetcdr (tail, prev); 1713 Fsetcdr (tail, prev);
1723 prev = tail; 1714 prev = tail;
1715 incr_rarely_quit (&quit_count);
1724 } 1716 }
1725 CHECK_LIST_END (tail, seq); 1717 CHECK_LIST_END (tail, seq);
1726 seq = prev; 1718 seq = prev;
@@ -1766,8 +1758,8 @@ See also the function `nreverse', which is used more often. */)
1766 unsigned short int quit_count = 0; 1758 unsigned short int quit_count = 0;
1767 for (new = Qnil; CONSP (seq); seq = XCDR (seq)) 1759 for (new = Qnil; CONSP (seq); seq = XCDR (seq))
1768 { 1760 {
1769 rarely_quit (&quit_count);
1770 new = Fcons (XCAR (seq), new); 1761 new = Fcons (XCAR (seq), new);
1762 incr_rarely_quit (&quit_count);
1771 } 1763 }
1772 CHECK_LIST_END (seq, seq); 1764 CHECK_LIST_END (seq, seq);
1773 } 1765 }
@@ -2058,6 +2050,7 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value.
2058The PLIST is modified by side effects. */) 2050The PLIST is modified by side effects. */)
2059 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) 2051 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2060{ 2052{
2053 unsigned short int quit_count = 0;
2061 Lisp_Object prev = Qnil; 2054 Lisp_Object prev = Qnil;
2062 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); 2055 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2063 tail = XCDR (XCDR (tail))) 2056 tail = XCDR (XCDR (tail)))
@@ -2069,6 +2062,7 @@ The PLIST is modified by side effects. */)
2069 } 2062 }
2070 2063
2071 prev = tail; 2064 prev = tail;
2065 incr_rarely_quit (&quit_count);
2072 } 2066 }
2073 Lisp_Object newcell 2067 Lisp_Object newcell
2074 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); 2068 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
@@ -2106,7 +2100,7 @@ one of the properties on the list. */)
2106 { 2100 {
2107 if (! NILP (Fequal (prop, XCAR (tail)))) 2101 if (! NILP (Fequal (prop, XCAR (tail))))
2108 return XCAR (XCDR (tail)); 2102 return XCAR (XCDR (tail));
2109 rarely_quit (&quit_count); 2103 incr_rarely_quit (&quit_count);
2110 } 2104 }
2111 2105
2112 CHECK_LIST_END (tail, prop); 2106 CHECK_LIST_END (tail, prop);
@@ -2136,7 +2130,7 @@ The PLIST is modified by side effects. */)
2136 } 2130 }
2137 2131
2138 prev = tail; 2132 prev = tail;
2139 rarely_quit (&quit_count); 2133 incr_rarely_quit (&quit_count);
2140 } 2134 }
2141 Lisp_Object newcell = list2 (prop, val); 2135 Lisp_Object newcell = list2 (prop, val);
2142 if (NILP (prev)) 2136 if (NILP (prev))
@@ -2216,7 +2210,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2216 2210
2217 unsigned short int quit_count = 0; 2211 unsigned short int quit_count = 0;
2218 tail_recurse: 2212 tail_recurse:
2219 rarely_quit (&quit_count); 2213 incr_rarely_quit (&quit_count);
2220 if (EQ (o1, o2)) 2214 if (EQ (o1, o2))
2221 return 1; 2215 return 1;
2222 if (XTYPE (o1) != XTYPE (o2)) 2216 if (XTYPE (o1) != XTYPE (o2))
@@ -2425,11 +2419,10 @@ usage: (nconc &rest LISTS) */)
2425 { 2419 {
2426 tail = tem; 2420 tail = tem;
2427 tem = XCDR (tail); 2421 tem = XCDR (tail);
2422 incr_rarely_quit (&quit_count);
2428 } 2423 }
2429 while (CONSP (tem)); 2424 while (CONSP (tem));
2430 2425
2431 rarely_quit (&quit_count);
2432
2433 tem = args[argnum + 1]; 2426 tem = args[argnum + 1];
2434 Fsetcdr (tail, tem); 2427 Fsetcdr (tail, tem);
2435 if (NILP (tem)) 2428 if (NILP (tem))
@@ -2850,10 +2843,12 @@ property and a property with the value nil.
2850The value is actually the tail of PLIST whose car is PROP. */) 2843The value is actually the tail of PLIST whose car is PROP. */)
2851 (Lisp_Object plist, Lisp_Object prop) 2844 (Lisp_Object plist, Lisp_Object prop)
2852{ 2845{
2846 unsigned short int quit_count = 0;
2853 while (CONSP (plist) && !EQ (XCAR (plist), prop)) 2847 while (CONSP (plist) && !EQ (XCAR (plist), prop))
2854 { 2848 {
2855 plist = XCDR (plist); 2849 plist = XCDR (plist);
2856 plist = CDR (plist); 2850 plist = CDR (plist);
2851 incr_rarely_quit (&quit_count);
2857 } 2852 }
2858 return plist; 2853 return plist;
2859} 2854}
diff --git a/src/indent.c b/src/indent.c
index 33f709c5041..aff14abfd20 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,8 +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 maybe_quit ();
1204
1205 /* It's just impossible to be too paranoid here. */ 1203 /* It's just impossible to be too paranoid here. */
1206 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); 1204 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
1207 1205
@@ -1213,8 +1211,12 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1213 cmp_it.id = -1; 1211 cmp_it.id = -1;
1214 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); 1212 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil);
1215 1213
1216 while (1) 1214 unsigned short int quit_count = 0;
1215
1216 while (true)
1217 { 1217 {
1218 incr_rarely_quit (&quit_count);
1219
1218 while (pos == next_boundary) 1220 while (pos == next_boundary)
1219 { 1221 {
1220 ptrdiff_t pos_here = pos; 1222 ptrdiff_t pos_here = pos;
@@ -1279,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1279 pos = newpos; 1281 pos = newpos;
1280 pos_byte = CHAR_TO_BYTE (pos); 1282 pos_byte = CHAR_TO_BYTE (pos);
1281 } 1283 }
1284
1285 incr_rarely_quit (&quit_count);
1282 } 1286 }
1283 1287
1284 /* Handle right margin. */ 1288 /* Handle right margin. */
@@ -1601,6 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1601 pos = find_before_next_newline (pos, to, 1, &pos_byte); 1605 pos = find_before_next_newline (pos, to, 1, &pos_byte);
1602 if (pos < to) 1606 if (pos < to)
1603 INC_BOTH (pos, pos_byte); 1607 INC_BOTH (pos, pos_byte);
1608 incr_rarely_quit (&quit_count);
1604 } 1609 }
1605 while (pos < to 1610 while (pos < to
1606 && indented_beyond_p (pos, pos_byte, 1611 && indented_beyond_p (pos, pos_byte,
diff --git a/src/keyboard.c b/src/keyboard.c
index 317669d6a1a..a86e7c5f8e4 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -7041,40 +7041,22 @@ tty_read_avail_input (struct terminal *terminal,
7041 7041
7042 /* Now read; for one reason or another, this will not block. 7042 /* Now read; for one reason or another, this will not block.
7043 NREAD is set to the number of chars read. */ 7043 NREAD is set to the number of chars read. */
7044 do 7044 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
7045 { 7045 /* POSIX infers that processes which are not in the session leader's
7046 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); 7046 process group won't get SIGHUPs at logout time. BSDI adheres to
7047 /* 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
7048 process group won't get SIGHUPs at logout time. BSDI adheres to 7048 when the control tty is taken away.
7049 this part standard and returns -1 from read (0) with errno==EIO 7049 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7050 when the control tty is taken away. 7050 if (nread == -1 && errno == EIO)
7051 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */ 7051 return -2; /* Close this terminal. */
7052 if (nread == -1 && errno == EIO) 7052#if defined AIX && defined _BSD
7053 return -2; /* Close this terminal. */ 7053 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7054#if defined (AIX) && defined (_BSD) 7054 This looks incorrect, but it isn't, because _BSD causes
7055 /* The kernel sometimes fails to deliver SIGHUP for ptys. 7055 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7056 This looks incorrect, but it isn't, because _BSD causes 7056 and that causes a value other than 0 when there is no input. */
7057 O_NDELAY to be defined in fcntl.h as O_NONBLOCK, 7057 if (nread == 0)
7058 and that causes a value other than 0 when there is no input. */ 7058 return -2; /* Close this terminal. */
7059 if (nread == 0)
7060 return -2; /* Close this terminal. */
7061#endif
7062 }
7063 while (
7064 /* We used to retry the read if it was interrupted.
7065 But this does the wrong thing when O_NONBLOCK causes
7066 an EAGAIN error. Does anybody know of a situation
7067 where a retry is actually needed? */
7068#if 0
7069 nread < 0 && (errno == EAGAIN || errno == EFAULT
7070#ifdef EBADSLT
7071 || errno == EBADSLT
7072#endif
7073 )
7074#else
7075 0
7076#endif 7059#endif
7077 );
7078 7060
7079#ifndef USABLE_FIONREAD 7061#ifndef USABLE_FIONREAD
7080#if defined (USG) || defined (CYGWIN) 7062#if defined (USG) || defined (CYGWIN)
diff --git a/src/lisp.h b/src/lisp.h
index a18e4da1cfd..2d67e7edddb 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3123,24 +3123,36 @@ struct handler
3123 3123
3124extern Lisp_Object memory_signal_data; 3124extern Lisp_Object memory_signal_data;
3125 3125
3126/* Check quit-flag and quit if it is non-nil. Typing C-g does not
3127 directly cause a quit; it only sets Vquit_flag. So the program
3128 needs to call maybe_quit at times when it is safe to quit. Every
3129 loop that might run for a long time or might not exit ought to call
3130 maybe_quit at least once, at a safe place. Unless that is
3131 impossible, of course. But it is very desirable to avoid creating
3132 loops where maybe_quit is impossible.
3133
3134 If quit-flag is set to `kill-emacs' the SIGINT handler has received
3135 a request to exit Emacs when it is safe to do.
3136
3137 When not quitting, process any pending signals. */
3138
3139extern void maybe_quit (void); 3126extern void maybe_quit (void);
3140 3127
3141/* True if ought to quit now. */ 3128/* True if ought to quit now. */
3142 3129
3143#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) 3130#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
3131
3132/* Heuristic on how many iterations of a tight loop can be safely done
3133 before it's time to do a quit. This must be a power of 2. It
3134 is nice but not necessary for it to equal USHRT_MAX + 1. */
3135
3136enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
3137
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). */
3141
3142INLINE void
3143rarely_quit (unsigned short int count)
3144{
3145 if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
3146 maybe_quit ();
3147}
3148
3149/* Increment *QUIT_COUNT and rarely quit. */
3150
3151INLINE void
3152incr_rarely_quit (unsigned short int *quit_count)
3153{
3154 rarely_quit (++*quit_count);
3155}
3144 3156
3145extern Lisp_Object Vascii_downcase_table; 3157extern Lisp_Object Vascii_downcase_table;
3146extern Lisp_Object Vascii_canon_table; 3158extern Lisp_Object Vascii_canon_table;
@@ -4216,8 +4228,10 @@ extern int emacs_open (const char *, int, int);
4216extern int emacs_pipe (int[2]); 4228extern int emacs_pipe (int[2]);
4217extern int emacs_close (int); 4229extern int emacs_close (int);
4218extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); 4230extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
4231extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t);
4219extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); 4232extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
4220extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); 4233extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
4234extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
4221extern void emacs_perror (char const *); 4235extern void emacs_perror (char const *);
4222 4236
4223extern void unlock_all_files (void); 4237extern void unlock_all_files (void);
diff --git a/src/lread.c b/src/lread.c
index 17806922a8c..094aa628eec 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -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'
diff --git a/src/search.c b/src/search.c
index ed9c12c68fe..084adda097b 100644
--- a/src/search.c
+++ b/src/search.c
@@ -800,6 +800,8 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
800 *bytepos = lim_byte + next; 800 *bytepos = lim_byte + next;
801 return BYTE_TO_CHAR (lim_byte + next); 801 return BYTE_TO_CHAR (lim_byte + next);
802 } 802 }
803 if (allow_quit)
804 maybe_quit ();
803 } 805 }
804 806
805 start_byte = lim_byte; 807 start_byte = lim_byte;
@@ -905,6 +907,8 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
905 *bytepos = ceiling_byte + prev + 1; 907 *bytepos = ceiling_byte + prev + 1;
906 return BYTE_TO_CHAR (ceiling_byte + prev + 1); 908 return BYTE_TO_CHAR (ceiling_byte + prev + 1);
907 } 909 }
910 if (allow_quit)
911 maybe_quit ();
908 } 912 }
909 913
910 start_byte = ceiling_byte; 914 start_byte = ceiling_byte;
@@ -1252,6 +1256,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1252 return (n); 1256 return (n);
1253 } 1257 }
1254 n++; 1258 n++;
1259 maybe_quit ();
1255 } 1260 }
1256 while (n > 0) 1261 while (n > 0)
1257 { 1262 {
@@ -1296,6 +1301,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1296 return (0 - n); 1301 return (0 - n);
1297 } 1302 }
1298 n--; 1303 n--;
1304 maybe_quit ();
1299 } 1305 }
1300#ifdef REL_ALLOC 1306#ifdef REL_ALLOC
1301 r_alloc_inhibit_buffer_relocation (0); 1307 r_alloc_inhibit_buffer_relocation (0);
@@ -3252,6 +3258,8 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3252 *bytepos = lim_byte + next; 3258 *bytepos = lim_byte + next;
3253 return BYTE_TO_CHAR (lim_byte + next); 3259 return BYTE_TO_CHAR (lim_byte + next);
3254 } 3260 }
3261 if (allow_quit)
3262 maybe_quit ();
3255 } 3263 }
3256 3264
3257 start_byte = lim_byte; 3265 start_byte = lim_byte;
diff --git a/src/syntax.c b/src/syntax.c
index e713922bf10..06fe50b866b 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -593,6 +593,7 @@ static ptrdiff_t
593find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte) 593find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
594{ 594{
595 ptrdiff_t opoint = PT, opoint_byte = PT_BYTE; 595 ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
596 unsigned short int quit_count = 0;
596 597
597 /* Use previous finding, if it's valid and applies to this inquiry. */ 598 /* Use previous finding, if it's valid and applies to this inquiry. */
598 if (current_buffer == find_start_buffer 599 if (current_buffer == find_start_buffer
@@ -621,11 +622,9 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
621 SETUP_BUFFER_SYNTAX_TABLE (); 622 SETUP_BUFFER_SYNTAX_TABLE ();
622 while (PT > BEGV) 623 while (PT > BEGV)
623 { 624 {
624 int c;
625
626 /* Open-paren at start of line means we may have found our 625 /* Open-paren at start of line means we may have found our
627 defun-start. */ 626 defun-start. */
628 c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); 627 int c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
629 if (SYNTAX (c) == Sopen) 628 if (SYNTAX (c) == Sopen)
630 { 629 {
631 SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ 630 SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
@@ -637,6 +636,7 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
637 } 636 }
638 /* Move to beg of previous line. */ 637 /* Move to beg of previous line. */
639 scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1); 638 scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
639 incr_rarely_quit (&quit_count);
640 } 640 }
641 641
642 /* Record what we found, for the next try. */ 642 /* Record what we found, for the next try. */
@@ -715,6 +715,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
715 ptrdiff_t nesting = 1; /* Current comment nesting. */ 715 ptrdiff_t nesting = 1; /* Current comment nesting. */
716 int c; 716 int c;
717 int syntax = 0; 717 int syntax = 0;
718 unsigned short int quit_count = 0;
718 719
719 /* FIXME: A }} comment-ender style leads to incorrect behavior 720 /* FIXME: A }} comment-ender style leads to incorrect behavior
720 in the case of {{ c }}} because we ignore the last two chars which are 721 in the case of {{ c }}} because we ignore the last two chars which are
@@ -724,6 +725,8 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
724 that determines quote parity to the comment-end. */ 725 that determines quote parity to the comment-end. */
725 while (from != stop) 726 while (from != stop)
726 { 727 {
728 incr_rarely_quit (&quit_count);
729
727 ptrdiff_t temp_byte; 730 ptrdiff_t temp_byte;
728 int prev_syntax; 731 int prev_syntax;
729 bool com2start, com2end, comstart; 732 bool com2start, com2end, comstart;
@@ -951,7 +954,9 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
951 defun_start_byte = CHAR_TO_BYTE (defun_start); 954 defun_start_byte = CHAR_TO_BYTE (defun_start);
952 } 955 }
953 } 956 }
954 } while (defun_start < comment_end); 957 incr_rarely_quit (&quit_count);
958 }
959 while (defun_start < comment_end);
955 960
956 from_byte = CHAR_TO_BYTE (from); 961 from_byte = CHAR_TO_BYTE (from);
957 UPDATE_SYNTAX_TABLE_FORWARD (from - 1); 962 UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
@@ -1417,22 +1422,20 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
1417 COUNT negative means scan backward and stop at word beginning. */ 1422 COUNT negative means scan backward and stop at word beginning. */
1418 1423
1419ptrdiff_t 1424ptrdiff_t
1420scan_words (register ptrdiff_t from, register EMACS_INT count) 1425scan_words (ptrdiff_t from, EMACS_INT count)
1421{ 1426{
1422 register ptrdiff_t beg = BEGV; 1427 ptrdiff_t beg = BEGV;
1423 register ptrdiff_t end = ZV; 1428 ptrdiff_t end = ZV;
1424 register ptrdiff_t from_byte = CHAR_TO_BYTE (from); 1429 ptrdiff_t from_byte = CHAR_TO_BYTE (from);
1425 register enum syntaxcode code; 1430 enum syntaxcode code;
1426 int ch0, ch1; 1431 int ch0, ch1;
1427 Lisp_Object func, pos; 1432 Lisp_Object func, pos;
1428 1433
1429 maybe_quit ();
1430
1431 SETUP_SYNTAX_TABLE (from, count); 1434 SETUP_SYNTAX_TABLE (from, count);
1432 1435
1433 while (count > 0) 1436 while (count > 0)
1434 { 1437 {
1435 while (1) 1438 while (true)
1436 { 1439 {
1437 if (from == end) 1440 if (from == end)
1438 return 0; 1441 return 0;
@@ -1445,6 +1448,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1445 break; 1448 break;
1446 if (code == Sword) 1449 if (code == Sword)
1447 break; 1450 break;
1451 rarely_quit (from);
1448 } 1452 }
1449 /* Now CH0 is a character which begins a word and FROM is the 1453 /* Now CH0 is a character which begins a word and FROM is the
1450 position of the next character. */ 1454 position of the next character. */
@@ -1473,13 +1477,14 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1473 break; 1477 break;
1474 INC_BOTH (from, from_byte); 1478 INC_BOTH (from, from_byte);
1475 ch0 = ch1; 1479 ch0 = ch1;
1480 rarely_quit (from);
1476 } 1481 }
1477 } 1482 }
1478 count--; 1483 count--;
1479 } 1484 }
1480 while (count < 0) 1485 while (count < 0)
1481 { 1486 {
1482 while (1) 1487 while (true)
1483 { 1488 {
1484 if (from == beg) 1489 if (from == beg)
1485 return 0; 1490 return 0;
@@ -1492,6 +1497,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1492 break; 1497 break;
1493 if (code == Sword) 1498 if (code == Sword)
1494 break; 1499 break;
1500 rarely_quit (from);
1495 } 1501 }
1496 /* Now CH1 is a character which ends a word and FROM is the 1502 /* Now CH1 is a character which ends a word and FROM is the
1497 position of it. */ 1503 position of it. */
@@ -1524,6 +1530,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1524 break; 1530 break;
1525 } 1531 }
1526 ch1 = ch0; 1532 ch1 = ch0;
1533 rarely_quit (from);
1527 } 1534 }
1528 } 1535 }
1529 count++; 1536 count++;
@@ -1961,9 +1968,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1961 } 1968 }
1962 fwd_ok: 1969 fwd_ok:
1963 p += nbytes, pos++, pos_byte += nbytes; 1970 p += nbytes, pos++, pos_byte += nbytes;
1971 rarely_quit (pos);
1964 } 1972 }
1965 else 1973 else
1966 while (1) 1974 while (true)
1967 { 1975 {
1968 if (p >= stop) 1976 if (p >= stop)
1969 { 1977 {
@@ -1985,15 +1993,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1985 break; 1993 break;
1986 fwd_unibyte_ok: 1994 fwd_unibyte_ok:
1987 p++, pos++, pos_byte++; 1995 p++, pos++, pos_byte++;
1996 rarely_quit (pos);
1988 } 1997 }
1989 } 1998 }
1990 else 1999 else
1991 { 2000 {
1992 if (multibyte) 2001 if (multibyte)
1993 while (1) 2002 while (true)
1994 { 2003 {
1995 unsigned char *prev_p;
1996
1997 if (p <= stop) 2004 if (p <= stop)
1998 { 2005 {
1999 if (p <= endp) 2006 if (p <= endp)
@@ -2001,8 +2008,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2001 p = GPT_ADDR; 2008 p = GPT_ADDR;
2002 stop = endp; 2009 stop = endp;
2003 } 2010 }
2004 prev_p = p; 2011 unsigned char *prev_p = p;
2005 while (--p >= stop && ! CHAR_HEAD_P (*p)); 2012 do
2013 p--;
2014 while (stop <= p && ! CHAR_HEAD_P (*p));
2015
2006 c = STRING_CHAR (p); 2016 c = STRING_CHAR (p);
2007 2017
2008 if (! NILP (iso_classes) && in_classes (c, iso_classes)) 2018 if (! NILP (iso_classes) && in_classes (c, iso_classes))
@@ -2026,9 +2036,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2026 } 2036 }
2027 back_ok: 2037 back_ok:
2028 pos--, pos_byte -= prev_p - p; 2038 pos--, pos_byte -= prev_p - p;
2039 rarely_quit (pos);
2029 } 2040 }
2030 else 2041 else
2031 while (1) 2042 while (true)
2032 { 2043 {
2033 if (p <= stop) 2044 if (p <= stop)
2034 { 2045 {
@@ -2050,6 +2061,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2050 break; 2061 break;
2051 back_unibyte_ok: 2062 back_unibyte_ok:
2052 p--, pos--, pos_byte--; 2063 p--, pos--, pos_byte--;
2064 rarely_quit (pos);
2053 } 2065 }
2054 } 2066 }
2055 2067
@@ -2155,6 +2167,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2155 if (! fastmap[SYNTAX (c)]) 2167 if (! fastmap[SYNTAX (c)])
2156 goto done; 2168 goto done;
2157 p += nbytes, pos++, pos_byte += nbytes; 2169 p += nbytes, pos++, pos_byte += nbytes;
2170 rarely_quit (pos);
2158 } 2171 }
2159 while (!parse_sexp_lookup_properties 2172 while (!parse_sexp_lookup_properties
2160 || pos < gl_state.e_property); 2173 || pos < gl_state.e_property);
@@ -2171,10 +2184,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2171 2184
2172 if (multibyte) 2185 if (multibyte)
2173 { 2186 {
2174 while (1) 2187 while (true)
2175 { 2188 {
2176 unsigned char *prev_p;
2177
2178 if (p <= stop) 2189 if (p <= stop)
2179 { 2190 {
2180 if (p <= endp) 2191 if (p <= endp)
@@ -2183,17 +2194,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2183 stop = endp; 2194 stop = endp;
2184 } 2195 }
2185 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); 2196 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
2186 prev_p = p; 2197
2187 while (--p >= stop && ! CHAR_HEAD_P (*p)); 2198 unsigned char *prev_p = p;
2199 do
2200 p--;
2201 while (stop <= p && ! CHAR_HEAD_P (*p));
2202
2188 c = STRING_CHAR (p); 2203 c = STRING_CHAR (p);
2189 if (! fastmap[SYNTAX (c)]) 2204 if (! fastmap[SYNTAX (c)])
2190 break; 2205 break;
2191 pos--, pos_byte -= prev_p - p; 2206 pos--, pos_byte -= prev_p - p;
2207 rarely_quit (pos);
2192 } 2208 }
2193 } 2209 }
2194 else 2210 else
2195 { 2211 {
2196 while (1) 2212 while (true)
2197 { 2213 {
2198 if (p <= stop) 2214 if (p <= stop)
2199 { 2215 {
@@ -2206,6 +2222,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2206 if (! fastmap[SYNTAX (p[-1])]) 2222 if (! fastmap[SYNTAX (p[-1])])
2207 break; 2223 break;
2208 p--, pos--, pos_byte--; 2224 p--, pos--, pos_byte--;
2225 rarely_quit (pos);
2209 } 2226 }
2210 } 2227 }
2211 } 2228 }
@@ -2273,9 +2290,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2273 ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, 2290 ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
2274 EMACS_INT *incomment_ptr, int *last_syntax_ptr) 2291 EMACS_INT *incomment_ptr, int *last_syntax_ptr)
2275{ 2292{
2276 register int c, c1; 2293 unsigned short int quit_count = 0;
2277 register enum syntaxcode code; 2294 int c, c1;
2278 register int syntax, other_syntax; 2295 enum syntaxcode code;
2296 int syntax, other_syntax;
2279 2297
2280 if (nesting <= 0) nesting = -1; 2298 if (nesting <= 0) nesting = -1;
2281 2299
@@ -2367,6 +2385,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2367 UPDATE_SYNTAX_TABLE_FORWARD (from); 2385 UPDATE_SYNTAX_TABLE_FORWARD (from);
2368 nesting++; 2386 nesting++;
2369 } 2387 }
2388
2389 incr_rarely_quit (&quit_count);
2370 } 2390 }
2371 *charpos_ptr = from; 2391 *charpos_ptr = from;
2372 *bytepos_ptr = from_byte; 2392 *bytepos_ptr = from_byte;
@@ -2394,13 +2414,12 @@ between them, return t; otherwise return nil. */)
2394 ptrdiff_t out_charpos, out_bytepos; 2414 ptrdiff_t out_charpos, out_bytepos;
2395 EMACS_INT dummy; 2415 EMACS_INT dummy;
2396 int dummy2; 2416 int dummy2;
2417 unsigned short int quit_count = 0;
2397 2418
2398 CHECK_NUMBER (count); 2419 CHECK_NUMBER (count);
2399 count1 = XINT (count); 2420 count1 = XINT (count);
2400 stop = count1 > 0 ? ZV : BEGV; 2421 stop = count1 > 0 ? ZV : BEGV;
2401 2422
2402 maybe_quit ();
2403
2404 from = PT; 2423 from = PT;
2405 from_byte = PT_BYTE; 2424 from_byte = PT_BYTE;
2406 2425
@@ -2441,6 +2460,7 @@ between them, return t; otherwise return nil. */)
2441 INC_BOTH (from, from_byte); 2460 INC_BOTH (from, from_byte);
2442 UPDATE_SYNTAX_TABLE_FORWARD (from); 2461 UPDATE_SYNTAX_TABLE_FORWARD (from);
2443 } 2462 }
2463 incr_rarely_quit (&quit_count);
2444 } 2464 }
2445 while (code == Swhitespace || (code == Sendcomment && c == '\n')); 2465 while (code == Swhitespace || (code == Sendcomment && c == '\n'));
2446 2466
@@ -2469,11 +2489,8 @@ between them, return t; otherwise return nil. */)
2469 2489
2470 while (count1 < 0) 2490 while (count1 < 0)
2471 { 2491 {
2472 while (1) 2492 while (true)
2473 { 2493 {
2474 bool quoted;
2475 int syntax;
2476
2477 if (from <= stop) 2494 if (from <= stop)
2478 { 2495 {
2479 SET_PT_BOTH (BEGV, BEGV_BYTE); 2496 SET_PT_BOTH (BEGV, BEGV_BYTE);
@@ -2482,9 +2499,9 @@ between them, return t; otherwise return nil. */)
2482 2499
2483 DEC_BOTH (from, from_byte); 2500 DEC_BOTH (from, from_byte);
2484 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ 2501 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
2485 quoted = char_quoted (from, from_byte); 2502 bool quoted = char_quoted (from, from_byte);
2486 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2503 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2487 syntax = SYNTAX_WITH_FLAGS (c); 2504 int syntax = SYNTAX_WITH_FLAGS (c);
2488 code = SYNTAX (c); 2505 code = SYNTAX (c);
2489 comstyle = 0; 2506 comstyle = 0;
2490 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); 2507 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
@@ -2527,6 +2544,7 @@ between them, return t; otherwise return nil. */)
2527 } 2544 }
2528 else if (from == stop) 2545 else if (from == stop)
2529 break; 2546 break;
2547 incr_rarely_quit (&quit_count);
2530 } 2548 }
2531 if (fence_found == 0) 2549 if (fence_found == 0)
2532 { 2550 {
@@ -2573,6 +2591,8 @@ between them, return t; otherwise return nil. */)
2573 SET_PT_BOTH (from, from_byte); 2591 SET_PT_BOTH (from, from_byte);
2574 return Qnil; 2592 return Qnil;
2575 } 2593 }
2594
2595 incr_rarely_quit (&quit_count);
2576 } 2596 }
2577 2597
2578 count1++; 2598 count1++;
@@ -2612,6 +2632,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2612 EMACS_INT dummy; 2632 EMACS_INT dummy;
2613 int dummy2; 2633 int dummy2;
2614 bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; 2634 bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
2635 unsigned short int quit_count = 0;
2615 2636
2616 if (depth > 0) min_depth = 0; 2637 if (depth > 0) min_depth = 0;
2617 2638
@@ -2627,6 +2648,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2627 { 2648 {
2628 while (from < stop) 2649 while (from < stop)
2629 { 2650 {
2651 incr_rarely_quit (&quit_count);
2630 bool comstart_first, prefix; 2652 bool comstart_first, prefix;
2631 int syntax, other_syntax; 2653 int syntax, other_syntax;
2632 UPDATE_SYNTAX_TABLE_FORWARD (from); 2654 UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -2695,6 +2717,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2695 goto done; 2717 goto done;
2696 } 2718 }
2697 INC_BOTH (from, from_byte); 2719 INC_BOTH (from, from_byte);
2720 incr_rarely_quit (&quit_count);
2698 } 2721 }
2699 goto done; 2722 goto done;
2700 2723
@@ -2766,6 +2789,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2766 if (c_code == Scharquote || c_code == Sescape) 2789 if (c_code == Scharquote || c_code == Sescape)
2767 INC_BOTH (from, from_byte); 2790 INC_BOTH (from, from_byte);
2768 INC_BOTH (from, from_byte); 2791 INC_BOTH (from, from_byte);
2792 incr_rarely_quit (&quit_count);
2769 } 2793 }
2770 INC_BOTH (from, from_byte); 2794 INC_BOTH (from, from_byte);
2771 if (!depth && sexpflag) goto done; 2795 if (!depth && sexpflag) goto done;
@@ -2791,11 +2815,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2791 { 2815 {
2792 while (from > stop) 2816 while (from > stop)
2793 { 2817 {
2794 int syntax; 2818 incr_rarely_quit (&quit_count);
2795 DEC_BOTH (from, from_byte); 2819 DEC_BOTH (from, from_byte);
2796 UPDATE_SYNTAX_TABLE_BACKWARD (from); 2820 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2797 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2821 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2798 syntax= SYNTAX_WITH_FLAGS (c); 2822 int syntax = SYNTAX_WITH_FLAGS (c);
2799 code = syntax_multibyte (c, multibyte_symbol_p); 2823 code = syntax_multibyte (c, multibyte_symbol_p);
2800 if (depth == min_depth) 2824 if (depth == min_depth)
2801 last_good = from; 2825 last_good = from;
@@ -2867,6 +2891,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2867 default: goto done2; 2891 default: goto done2;
2868 } 2892 }
2869 DEC_BOTH (from, from_byte); 2893 DEC_BOTH (from, from_byte);
2894 incr_rarely_quit (&quit_count);
2870 } 2895 }
2871 goto done2; 2896 goto done2;
2872 2897
@@ -2929,13 +2954,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2929 if (syntax_multibyte (c, multibyte_symbol_p) == code) 2954 if (syntax_multibyte (c, multibyte_symbol_p) == code)
2930 break; 2955 break;
2931 } 2956 }
2957 incr_rarely_quit (&quit_count);
2932 } 2958 }
2933 if (code == Sstring_fence && !depth && sexpflag) goto done2; 2959 if (code == Sstring_fence && !depth && sexpflag) goto done2;
2934 break; 2960 break;
2935 2961
2936 case Sstring: 2962 case Sstring:
2937 stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2963 stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2938 while (1) 2964 while (true)
2939 { 2965 {
2940 if (from == stop) 2966 if (from == stop)
2941 goto lose; 2967 goto lose;
@@ -2949,6 +2975,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2949 == Sstring)) 2975 == Sstring))
2950 break; 2976 break;
2951 } 2977 }
2978 incr_rarely_quit (&quit_count);
2952 } 2979 }
2953 if (!depth && sexpflag) goto done2; 2980 if (!depth && sexpflag) goto done2;
2954 break; 2981 break;
@@ -3061,6 +3088,7 @@ the prefix syntax flag (p). */)
3061 if (pos <= beg) 3088 if (pos <= beg)
3062 break; 3089 break;
3063 DEC_BOTH (pos, pos_byte); 3090 DEC_BOTH (pos, pos_byte);
3091 rarely_quit (pos);
3064 } 3092 }
3065 3093
3066 SET_PT_BOTH (opoint, opoint_byte); 3094 SET_PT_BOTH (opoint, opoint_byte);
@@ -3131,6 +3159,7 @@ scan_sexps_forward (struct lisp_parse_state *state,
3131 bool found; 3159 bool found;
3132 ptrdiff_t out_bytepos, out_charpos; 3160 ptrdiff_t out_bytepos, out_charpos;
3133 int temp; 3161 int temp;
3162 unsigned short int quit_count = 0;
3134 3163
3135 prev_from = from; 3164 prev_from = from;
3136 prev_from_byte = from_byte; 3165 prev_from_byte = from_byte;
@@ -3200,6 +3229,7 @@ do { prev_from = from; \
3200 3229
3201 while (from < end) 3230 while (from < end)
3202 { 3231 {
3232 incr_rarely_quit (&quit_count);
3203 INC_FROM; 3233 INC_FROM;
3204 3234
3205 if ((from < end) 3235 if ((from < end)
@@ -3256,6 +3286,7 @@ do { prev_from = from; \
3256 goto symdone; 3286 goto symdone;
3257 } 3287 }
3258 INC_FROM; 3288 INC_FROM;
3289 incr_rarely_quit (&quit_count);
3259 } 3290 }
3260 symdone: 3291 symdone:
3261 curlevel->prev = curlevel->last; 3292 curlevel->prev = curlevel->last;
@@ -3366,6 +3397,7 @@ do { prev_from = from; \
3366 break; 3397 break;
3367 } 3398 }
3368 INC_FROM; 3399 INC_FROM;
3400 incr_rarely_quit (&quit_count);
3369 } 3401 }
3370 } 3402 }
3371 string_end: 3403 string_end:
diff --git a/src/sysdep.c b/src/sysdep.c
index e172dc0aed4..4155c205712 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 maybe_quit
395 internally. */
396 if (interruptible)
397 maybe_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
@@ -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, either quit or retry the read.
2512 Process any quits and pending signals immediately if INTERRUPTIBLE.
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_nointr_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 maybe_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_nointr_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_nointr_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 maybe_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)