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.
This commit is contained in:
parent
33be50037c
commit
b01ac672be
16 changed files with 297 additions and 222 deletions
|
@ -2880,7 +2880,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
|
|||
for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
|
||||
{
|
||||
val = Fcons (init, val);
|
||||
maybe_quit ();
|
||||
rarely_quit (size);
|
||||
}
|
||||
|
||||
return val;
|
||||
|
|
|
@ -841,9 +841,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
|||
{
|
||||
Lisp_Object v2 = POP, v1 = TOP;
|
||||
CHECK_NUMBER (v1);
|
||||
EMACS_INT n = XINT (v1);
|
||||
while (--n >= 0 && CONSP (v2))
|
||||
v2 = XCDR (v2);
|
||||
for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--)
|
||||
{
|
||||
v2 = XCDR (v2);
|
||||
rarely_quit (n);
|
||||
}
|
||||
TOP = CAR (v2);
|
||||
NEXT;
|
||||
}
|
||||
|
@ -1273,9 +1275,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
|||
/* Exchange args and then do nth. */
|
||||
Lisp_Object v2 = POP, v1 = TOP;
|
||||
CHECK_NUMBER (v2);
|
||||
EMACS_INT n = XINT (v2);
|
||||
while (--n >= 0 && CONSP (v1))
|
||||
v1 = XCDR (v1);
|
||||
for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
|
||||
{
|
||||
v1 = XCDR (v1);
|
||||
rarely_quit (n);
|
||||
}
|
||||
TOP = CAR (v1);
|
||||
}
|
||||
else
|
||||
|
|
|
@ -198,7 +198,6 @@ call_process_cleanup (Lisp_Object buffer)
|
|||
{
|
||||
kill (-synch_process_pid, SIGINT);
|
||||
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
|
||||
maybe_quit ();
|
||||
wait_for_termination (synch_process_pid, 0, 1);
|
||||
synch_process_pid = 0;
|
||||
message1 ("Waiting for process to die...done");
|
||||
|
@ -724,8 +723,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
|
|||
process_coding.src_multibyte = 0;
|
||||
}
|
||||
|
||||
maybe_quit ();
|
||||
|
||||
if (0 <= fd0)
|
||||
{
|
||||
enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
|
||||
|
@ -746,8 +743,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
|
|||
nread = carryover;
|
||||
while (nread < bufsize - 1024)
|
||||
{
|
||||
int this_read = emacs_read (fd0, buf + nread,
|
||||
bufsize - nread);
|
||||
int this_read = emacs_read_quit (fd0, buf + nread,
|
||||
bufsize - nread);
|
||||
|
||||
if (this_read < 0)
|
||||
goto give_up;
|
||||
|
@ -838,8 +835,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
|
|||
we should have already detected a coding system. */
|
||||
display_on_the_fly = true;
|
||||
}
|
||||
|
||||
maybe_quit ();
|
||||
}
|
||||
give_up: ;
|
||||
|
||||
|
|
|
@ -186,7 +186,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
|
|||
If we read the same block last time, maybe skip this? */
|
||||
if (space_left > 1024 * 8)
|
||||
space_left = 1024 * 8;
|
||||
nread = emacs_read (fd, p, space_left);
|
||||
nread = emacs_read_quit (fd, p, space_left);
|
||||
if (nread < 0)
|
||||
report_file_error ("Read error on documentation file", file);
|
||||
p[nread] = 0;
|
||||
|
@ -590,16 +590,15 @@ the same file name is found in the `doc-directory'. */)
|
|||
Vdoc_file_name = filename;
|
||||
filled = 0;
|
||||
pos = 0;
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
register char *end;
|
||||
if (filled < 512)
|
||||
filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
|
||||
filled += emacs_read_quit (fd, &buf[filled], sizeof buf - 1 - filled);
|
||||
if (!filled)
|
||||
break;
|
||||
|
||||
buf[filled] = 0;
|
||||
end = buf + (filled < 512 ? filled : filled - 128);
|
||||
char *end = buf + (filled < 512 ? filled : filled - 128);
|
||||
p = memchr (buf, '\037', end - buf);
|
||||
/* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
|
||||
if (p)
|
||||
|
|
|
@ -3096,6 +3096,7 @@ determines whether case is significant or ignored. */)
|
|||
return make_number (c1 < c2 ? -1 - chars : chars + 1);
|
||||
|
||||
chars++;
|
||||
rarely_quit (chars);
|
||||
}
|
||||
|
||||
/* The strings match as far as they go.
|
||||
|
|
13
src/eval.c
13
src/eval.c
|
@ -1461,6 +1461,19 @@ process_quit_flag (void)
|
|||
quit ();
|
||||
}
|
||||
|
||||
/* Check quit-flag and quit if it is non-nil. Typing C-g does not
|
||||
directly cause a quit; it only sets Vquit_flag. So the program
|
||||
needs to call maybe_quit at times when it is safe to quit. Every
|
||||
loop that might run for a long time or might not exit ought to call
|
||||
maybe_quit at least once, at a safe place. Unless that is
|
||||
impossible, of course. But it is very desirable to avoid creating
|
||||
loops where maybe_quit is impossible.
|
||||
|
||||
If quit-flag is set to `kill-emacs' the SIGINT handler has received
|
||||
a request to exit Emacs when it is safe to do.
|
||||
|
||||
When not quitting, process any pending signals. */
|
||||
|
||||
void
|
||||
maybe_quit (void)
|
||||
{
|
||||
|
|
55
src/fileio.c
55
src/fileio.c
|
@ -2030,9 +2030,9 @@ permissions. */)
|
|||
{
|
||||
char buf[MAX_ALLOCA];
|
||||
ptrdiff_t n;
|
||||
for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf));
|
||||
for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf));
|
||||
newsize += n)
|
||||
if (emacs_write_sig (ofd, buf, n) != n)
|
||||
if (emacs_write_quit (ofd, buf, n) != n)
|
||||
report_file_error ("Write error", newname);
|
||||
if (n < 0)
|
||||
report_file_error ("Read error", file);
|
||||
|
@ -3396,13 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data)
|
|||
static Lisp_Object
|
||||
read_non_regular (Lisp_Object state)
|
||||
{
|
||||
int nbytes;
|
||||
|
||||
maybe_quit ();
|
||||
nbytes = emacs_read (XSAVE_INTEGER (state, 0),
|
||||
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
|
||||
+ XSAVE_INTEGER (state, 1)),
|
||||
XSAVE_INTEGER (state, 2));
|
||||
int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
|
||||
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
|
||||
+ XSAVE_INTEGER (state, 1)),
|
||||
XSAVE_INTEGER (state, 2));
|
||||
/* Fast recycle this object for the likely next call. */
|
||||
free_misc (state);
|
||||
return make_number (nbytes);
|
||||
|
@ -3746,17 +3743,17 @@ by calling `format-decode', which see. */)
|
|||
int nread;
|
||||
|
||||
if (st.st_size <= (1024 * 4))
|
||||
nread = emacs_read (fd, read_buf, 1024 * 4);
|
||||
nread = emacs_read_quit (fd, read_buf, 1024 * 4);
|
||||
else
|
||||
{
|
||||
nread = emacs_read (fd, read_buf, 1024);
|
||||
nread = emacs_read_quit (fd, read_buf, 1024);
|
||||
if (nread == 1024)
|
||||
{
|
||||
int ntail;
|
||||
if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
|
||||
report_file_error ("Setting file position",
|
||||
orig_filename);
|
||||
ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
|
||||
ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
|
||||
nread = ntail < 0 ? ntail : nread + ntail;
|
||||
}
|
||||
}
|
||||
|
@ -3861,14 +3858,11 @@ by calling `format-decode', which see. */)
|
|||
report_file_error ("Setting file position", orig_filename);
|
||||
}
|
||||
|
||||
maybe_quit ();
|
||||
/* Count how many chars at the start of the file
|
||||
match the text at the beginning of the buffer. */
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
int nread, bufpos;
|
||||
|
||||
nread = emacs_read (fd, read_buf, sizeof read_buf);
|
||||
int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
|
||||
if (nread < 0)
|
||||
report_file_error ("Read error", orig_filename);
|
||||
else if (nread == 0)
|
||||
|
@ -3890,7 +3884,7 @@ by calling `format-decode', which see. */)
|
|||
break;
|
||||
}
|
||||
|
||||
bufpos = 0;
|
||||
int bufpos = 0;
|
||||
while (bufpos < nread && same_at_start < ZV_BYTE
|
||||
&& FETCH_BYTE (same_at_start) == read_buf[bufpos])
|
||||
same_at_start++, bufpos++;
|
||||
|
@ -3910,7 +3904,7 @@ by calling `format-decode', which see. */)
|
|||
del_range_1 (same_at_start, same_at_end, 0, 0);
|
||||
goto handled;
|
||||
}
|
||||
maybe_quit ();
|
||||
|
||||
/* Count how many chars at the end of the file
|
||||
match the text at the end of the buffer. But, if we have
|
||||
already found that decoding is necessary, don't waste time. */
|
||||
|
@ -3932,7 +3926,8 @@ by calling `format-decode', which see. */)
|
|||
total_read = nread = 0;
|
||||
while (total_read < trial)
|
||||
{
|
||||
nread = emacs_read (fd, read_buf + total_read, trial - total_read);
|
||||
nread = emacs_read_quit (fd, read_buf + total_read,
|
||||
trial - total_read);
|
||||
if (nread < 0)
|
||||
report_file_error ("Read error", orig_filename);
|
||||
else if (nread == 0)
|
||||
|
@ -4058,16 +4053,13 @@ by calling `format-decode', which see. */)
|
|||
inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
|
||||
unprocessed = 0; /* Bytes not processed in previous loop. */
|
||||
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
/* Read at most READ_BUF_SIZE bytes at a time, to allow
|
||||
quitting while reading a huge file. */
|
||||
|
||||
/* Allow quitting out of the actual I/O. */
|
||||
maybe_quit ();
|
||||
this = emacs_read (fd, read_buf + unprocessed,
|
||||
READ_BUF_SIZE - unprocessed);
|
||||
|
||||
this = emacs_read_quit (fd, read_buf + unprocessed,
|
||||
READ_BUF_SIZE - unprocessed);
|
||||
if (this <= 0)
|
||||
break;
|
||||
|
||||
|
@ -4281,11 +4273,10 @@ by calling `format-decode', which see. */)
|
|||
/* Allow quitting out of the actual I/O. We don't make text
|
||||
part of the buffer until all the reading is done, so a C-g
|
||||
here doesn't do any harm. */
|
||||
maybe_quit ();
|
||||
this = emacs_read (fd,
|
||||
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
|
||||
+ inserted),
|
||||
trytry);
|
||||
this = emacs_read_quit (fd,
|
||||
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
|
||||
+ inserted),
|
||||
trytry);
|
||||
}
|
||||
|
||||
if (this <= 0)
|
||||
|
@ -5398,7 +5389,7 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
|
|||
: (STRINGP (coding->dst_object)
|
||||
? SSDATA (coding->dst_object)
|
||||
: (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
|
||||
coding->produced -= emacs_write_sig (desc, buf, coding->produced);
|
||||
coding->produced -= emacs_write_quit (desc, buf, coding->produced);
|
||||
|
||||
if (coding->raw_destination)
|
||||
{
|
||||
|
|
|
@ -407,9 +407,7 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
|
|||
fcntl (fd, F_SETFD, FD_CLOEXEC);
|
||||
lock_info_len = strlen (lock_info_str);
|
||||
err = 0;
|
||||
/* Use 'write', not 'emacs_write', as garbage collection
|
||||
might signal an error, which would leak FD. */
|
||||
if (write (fd, lock_info_str, lock_info_len) != lock_info_len
|
||||
if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
|
||||
|| fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
|
||||
err = errno;
|
||||
/* 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])
|
|||
int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0);
|
||||
if (0 <= fd)
|
||||
{
|
||||
/* Use read, not emacs_read, since FD isn't unwind-protected. */
|
||||
ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
|
||||
ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
|
||||
int read_errno = errno;
|
||||
if (emacs_close (fd) != 0)
|
||||
return -1;
|
||||
|
|
53
src/fns.c
53
src/fns.c
|
@ -84,22 +84,6 @@ See Info node `(elisp)Random Numbers' for more details. */)
|
|||
return make_number (val);
|
||||
}
|
||||
|
||||
/* Heuristic on how many iterations of a tight loop can be safely done
|
||||
before it's time to do a quit. This must be a power of 2. It
|
||||
is nice but not necessary for it to equal USHRT_MAX + 1. */
|
||||
enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
|
||||
|
||||
/* Process a quit, but do it only rarely, for efficiency. "Rarely"
|
||||
means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
|
||||
whichever is smaller. Use *QUIT_COUNT to count this. */
|
||||
|
||||
static void
|
||||
rarely_quit (unsigned short int *quit_count)
|
||||
{
|
||||
if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
|
||||
maybe_quit ();
|
||||
}
|
||||
|
||||
/* Random data-structure functions. */
|
||||
|
||||
DEFUN ("length", Flength, Slength, 1, 1, 0,
|
||||
|
@ -1359,9 +1343,8 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
|
|||
(Lisp_Object n, Lisp_Object list)
|
||||
{
|
||||
CHECK_NUMBER (n);
|
||||
EMACS_INT num = XINT (n);
|
||||
Lisp_Object tail = list;
|
||||
for (EMACS_INT i = 0; i < num; i++)
|
||||
for (EMACS_INT num = XINT (n); 0 < num; num--)
|
||||
{
|
||||
if (! CONSP (tail))
|
||||
{
|
||||
|
@ -1369,6 +1352,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
|
|||
return Qnil;
|
||||
}
|
||||
tail = XCDR (tail);
|
||||
rarely_quit (num);
|
||||
}
|
||||
return tail;
|
||||
}
|
||||
|
@ -1405,7 +1389,7 @@ The value is actually the tail of LIST whose car is ELT. */)
|
|||
{
|
||||
if (! NILP (Fequal (elt, XCAR (tail))))
|
||||
return tail;
|
||||
rarely_quit (&quit_count);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
|
@ -1416,11 +1400,13 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
|
|||
The value is actually the tail of LIST whose car is ELT. */)
|
||||
(Lisp_Object elt, Lisp_Object list)
|
||||
{
|
||||
unsigned short int quit_count = 0;
|
||||
Lisp_Object tail;
|
||||
for (tail = list; CONSP (tail); tail = XCDR (tail))
|
||||
{
|
||||
if (EQ (XCAR (tail), elt))
|
||||
return tail;
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
|
@ -1434,12 +1420,14 @@ The value is actually the tail of LIST whose car is ELT. */)
|
|||
if (!FLOATP (elt))
|
||||
return Fmemq (elt, list);
|
||||
|
||||
unsigned short int quit_count = 0;
|
||||
Lisp_Object tail;
|
||||
for (tail = list; CONSP (tail); tail = XCDR (tail))
|
||||
{
|
||||
Lisp_Object tem = XCAR (tail);
|
||||
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
|
||||
return tail;
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
|
@ -1451,11 +1439,13 @@ The value is actually the first element of LIST whose car is KEY.
|
|||
Elements of LIST that are not conses are ignored. */)
|
||||
(Lisp_Object key, Lisp_Object list)
|
||||
{
|
||||
unsigned short int quit_count = 0;
|
||||
Lisp_Object tail;
|
||||
for (tail = list; CONSP (tail); tail = XCDR (tail))
|
||||
{
|
||||
if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
|
||||
return XCAR (tail);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
|
@ -1486,7 +1476,7 @@ The value is actually the first element of LIST whose car equals KEY. */)
|
|||
if (CONSP (car)
|
||||
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
|
||||
return car;
|
||||
rarely_quit (&quit_count);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
|
@ -1513,11 +1503,13 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
|
|||
The value is actually the first element of LIST whose cdr is KEY. */)
|
||||
(Lisp_Object key, Lisp_Object list)
|
||||
{
|
||||
unsigned short int quit_count = 0;
|
||||
Lisp_Object tail;
|
||||
for (tail = list; CONSP (tail); tail = XCDR (tail))
|
||||
{
|
||||
if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
|
||||
return XCAR (tail);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
|
@ -1536,7 +1528,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */)
|
|||
if (CONSP (car)
|
||||
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
|
||||
return car;
|
||||
rarely_quit (&quit_count);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, list);
|
||||
return Qnil;
|
||||
|
@ -1692,7 +1684,7 @@ changing the value of a sequence `foo'. */)
|
|||
}
|
||||
else
|
||||
prev = tail;
|
||||
rarely_quit (&quit_count);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, seq);
|
||||
}
|
||||
|
@ -1717,10 +1709,10 @@ This function may destructively modify SEQ to produce the value. */)
|
|||
|
||||
for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
|
||||
{
|
||||
rarely_quit (&quit_count);
|
||||
next = XCDR (tail);
|
||||
Fsetcdr (tail, prev);
|
||||
prev = tail;
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (tail, seq);
|
||||
seq = prev;
|
||||
|
@ -1766,8 +1758,8 @@ See also the function `nreverse', which is used more often. */)
|
|||
unsigned short int quit_count = 0;
|
||||
for (new = Qnil; CONSP (seq); seq = XCDR (seq))
|
||||
{
|
||||
rarely_quit (&quit_count);
|
||||
new = Fcons (XCAR (seq), new);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
CHECK_LIST_END (seq, seq);
|
||||
}
|
||||
|
@ -2058,6 +2050,7 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value.
|
|||
The PLIST is modified by side effects. */)
|
||||
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
|
||||
{
|
||||
unsigned short int quit_count = 0;
|
||||
Lisp_Object prev = Qnil;
|
||||
for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
|
||||
tail = XCDR (XCDR (tail)))
|
||||
|
@ -2069,6 +2062,7 @@ The PLIST is modified by side effects. */)
|
|||
}
|
||||
|
||||
prev = tail;
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
Lisp_Object newcell
|
||||
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
|
||||
|
@ -2106,7 +2100,7 @@ one of the properties on the list. */)
|
|||
{
|
||||
if (! NILP (Fequal (prop, XCAR (tail))))
|
||||
return XCAR (XCDR (tail));
|
||||
rarely_quit (&quit_count);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
|
||||
CHECK_LIST_END (tail, prop);
|
||||
|
@ -2136,7 +2130,7 @@ The PLIST is modified by side effects. */)
|
|||
}
|
||||
|
||||
prev = tail;
|
||||
rarely_quit (&quit_count);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
Lisp_Object newcell = list2 (prop, val);
|
||||
if (NILP (prev))
|
||||
|
@ -2216,7 +2210,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
|
|||
|
||||
unsigned short int quit_count = 0;
|
||||
tail_recurse:
|
||||
rarely_quit (&quit_count);
|
||||
incr_rarely_quit (&quit_count);
|
||||
if (EQ (o1, o2))
|
||||
return 1;
|
||||
if (XTYPE (o1) != XTYPE (o2))
|
||||
|
@ -2425,11 +2419,10 @@ usage: (nconc &rest LISTS) */)
|
|||
{
|
||||
tail = tem;
|
||||
tem = XCDR (tail);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
while (CONSP (tem));
|
||||
|
||||
rarely_quit (&quit_count);
|
||||
|
||||
tem = args[argnum + 1];
|
||||
Fsetcdr (tail, tem);
|
||||
if (NILP (tem))
|
||||
|
@ -2850,10 +2843,12 @@ property and a property with the value nil.
|
|||
The value is actually the tail of PLIST whose car is PROP. */)
|
||||
(Lisp_Object plist, Lisp_Object prop)
|
||||
{
|
||||
unsigned short int quit_count = 0;
|
||||
while (CONSP (plist) && !EQ (XCAR (plist), prop))
|
||||
{
|
||||
plist = XCDR (plist);
|
||||
plist = CDR (plist);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
return plist;
|
||||
}
|
||||
|
|
11
src/indent.c
11
src/indent.c
|
@ -1200,8 +1200,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
|
|||
continuation_glyph_width = 0; /* In the fringe. */
|
||||
#endif
|
||||
|
||||
maybe_quit ();
|
||||
|
||||
/* It's just impossible to be too paranoid here. */
|
||||
eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
|
||||
|
||||
|
@ -1213,8 +1211,12 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
|
|||
cmp_it.id = -1;
|
||||
composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil);
|
||||
|
||||
while (1)
|
||||
unsigned short int quit_count = 0;
|
||||
|
||||
while (true)
|
||||
{
|
||||
incr_rarely_quit (&quit_count);
|
||||
|
||||
while (pos == next_boundary)
|
||||
{
|
||||
ptrdiff_t pos_here = pos;
|
||||
|
@ -1279,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
|
|||
pos = newpos;
|
||||
pos_byte = CHAR_TO_BYTE (pos);
|
||||
}
|
||||
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
|
||||
/* Handle right margin. */
|
||||
|
@ -1601,6 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
|
|||
pos = find_before_next_newline (pos, to, 1, &pos_byte);
|
||||
if (pos < to)
|
||||
INC_BOTH (pos, pos_byte);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
while (pos < to
|
||||
&& indented_beyond_p (pos, pos_byte,
|
||||
|
|
|
@ -7041,40 +7041,22 @@ tty_read_avail_input (struct terminal *terminal,
|
|||
|
||||
/* Now read; for one reason or another, this will not block.
|
||||
NREAD is set to the number of chars read. */
|
||||
do
|
||||
{
|
||||
nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
|
||||
/* POSIX infers that processes which are not in the session leader's
|
||||
process group won't get SIGHUPs at logout time. BSDI adheres to
|
||||
this part standard and returns -1 from read (0) with errno==EIO
|
||||
when the control tty is taken away.
|
||||
Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
|
||||
if (nread == -1 && errno == EIO)
|
||||
return -2; /* Close this terminal. */
|
||||
#if defined (AIX) && defined (_BSD)
|
||||
/* The kernel sometimes fails to deliver SIGHUP for ptys.
|
||||
This looks incorrect, but it isn't, because _BSD causes
|
||||
O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
|
||||
and that causes a value other than 0 when there is no input. */
|
||||
if (nread == 0)
|
||||
return -2; /* Close this terminal. */
|
||||
nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
|
||||
/* POSIX infers that processes which are not in the session leader's
|
||||
process group won't get SIGHUPs at logout time. BSDI adheres to
|
||||
this part standard and returns -1 from read (0) with errno==EIO
|
||||
when the control tty is taken away.
|
||||
Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
|
||||
if (nread == -1 && errno == EIO)
|
||||
return -2; /* Close this terminal. */
|
||||
#if defined AIX && defined _BSD
|
||||
/* The kernel sometimes fails to deliver SIGHUP for ptys.
|
||||
This looks incorrect, but it isn't, because _BSD causes
|
||||
O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
|
||||
and that causes a value other than 0 when there is no input. */
|
||||
if (nread == 0)
|
||||
return -2; /* Close this terminal. */
|
||||
#endif
|
||||
}
|
||||
while (
|
||||
/* We used to retry the read if it was interrupted.
|
||||
But this does the wrong thing when O_NONBLOCK causes
|
||||
an EAGAIN error. Does anybody know of a situation
|
||||
where a retry is actually needed? */
|
||||
#if 0
|
||||
nread < 0 && (errno == EAGAIN || errno == EFAULT
|
||||
#ifdef EBADSLT
|
||||
|| errno == EBADSLT
|
||||
#endif
|
||||
)
|
||||
#else
|
||||
0
|
||||
#endif
|
||||
);
|
||||
|
||||
#ifndef USABLE_FIONREAD
|
||||
#if defined (USG) || defined (CYGWIN)
|
||||
|
|
40
src/lisp.h
40
src/lisp.h
|
@ -3123,24 +3123,36 @@ struct handler
|
|||
|
||||
extern Lisp_Object memory_signal_data;
|
||||
|
||||
/* Check quit-flag and quit if it is non-nil. Typing C-g does not
|
||||
directly cause a quit; it only sets Vquit_flag. So the program
|
||||
needs to call maybe_quit at times when it is safe to quit. Every
|
||||
loop that might run for a long time or might not exit ought to call
|
||||
maybe_quit at least once, at a safe place. Unless that is
|
||||
impossible, of course. But it is very desirable to avoid creating
|
||||
loops where maybe_quit is impossible.
|
||||
|
||||
If quit-flag is set to `kill-emacs' the SIGINT handler has received
|
||||
a request to exit Emacs when it is safe to do.
|
||||
|
||||
When not quitting, process any pending signals. */
|
||||
|
||||
extern void maybe_quit (void);
|
||||
|
||||
/* True if ought to quit now. */
|
||||
|
||||
#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
|
||||
|
||||
/* Heuristic on how many iterations of a tight loop can be safely done
|
||||
before it's time to do a quit. This must be a power of 2. It
|
||||
is nice but not necessary for it to equal USHRT_MAX + 1. */
|
||||
|
||||
enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
|
||||
|
||||
/* Process a quit rarely, based on a counter COUNT, for efficiency.
|
||||
"Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1
|
||||
times, whichever is smaller (somewhat arbitrary, but often faster). */
|
||||
|
||||
INLINE void
|
||||
rarely_quit (unsigned short int count)
|
||||
{
|
||||
if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
|
||||
maybe_quit ();
|
||||
}
|
||||
|
||||
/* Increment *QUIT_COUNT and rarely quit. */
|
||||
|
||||
INLINE void
|
||||
incr_rarely_quit (unsigned short int *quit_count)
|
||||
{
|
||||
rarely_quit (++*quit_count);
|
||||
}
|
||||
|
||||
extern Lisp_Object Vascii_downcase_table;
|
||||
extern Lisp_Object Vascii_canon_table;
|
||||
|
@ -4216,8 +4228,10 @@ extern int emacs_open (const char *, int, int);
|
|||
extern int emacs_pipe (int[2]);
|
||||
extern int emacs_close (int);
|
||||
extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
|
||||
extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t);
|
||||
extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
|
||||
extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
|
||||
extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
|
||||
extern void emacs_perror (char const *);
|
||||
|
||||
extern void unlock_all_files (void);
|
||||
|
|
|
@ -910,7 +910,7 @@ safe_to_load_version (int fd)
|
|||
|
||||
/* Read the first few bytes from the file, and look for a line
|
||||
specifying the byte compiler version used. */
|
||||
nbytes = emacs_read (fd, buf, sizeof buf);
|
||||
nbytes = emacs_read_quit (fd, buf, sizeof buf);
|
||||
if (nbytes > 0)
|
||||
{
|
||||
/* Skip to the next newline, skipping over the initial `ELC'
|
||||
|
|
|
@ -800,6 +800,8 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
|
|||
*bytepos = lim_byte + next;
|
||||
return BYTE_TO_CHAR (lim_byte + next);
|
||||
}
|
||||
if (allow_quit)
|
||||
maybe_quit ();
|
||||
}
|
||||
|
||||
start_byte = lim_byte;
|
||||
|
@ -905,6 +907,8 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
|
|||
*bytepos = ceiling_byte + prev + 1;
|
||||
return BYTE_TO_CHAR (ceiling_byte + prev + 1);
|
||||
}
|
||||
if (allow_quit)
|
||||
maybe_quit ();
|
||||
}
|
||||
|
||||
start_byte = ceiling_byte;
|
||||
|
@ -1252,6 +1256,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
|
|||
return (n);
|
||||
}
|
||||
n++;
|
||||
maybe_quit ();
|
||||
}
|
||||
while (n > 0)
|
||||
{
|
||||
|
@ -1296,6 +1301,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
|
|||
return (0 - n);
|
||||
}
|
||||
n--;
|
||||
maybe_quit ();
|
||||
}
|
||||
#ifdef REL_ALLOC
|
||||
r_alloc_inhibit_buffer_relocation (0);
|
||||
|
@ -3252,6 +3258,8 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
|
|||
*bytepos = lim_byte + next;
|
||||
return BYTE_TO_CHAR (lim_byte + next);
|
||||
}
|
||||
if (allow_quit)
|
||||
maybe_quit ();
|
||||
}
|
||||
|
||||
start_byte = lim_byte;
|
||||
|
|
112
src/syntax.c
112
src/syntax.c
|
@ -593,6 +593,7 @@ static ptrdiff_t
|
|||
find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
|
||||
{
|
||||
ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
|
||||
unsigned short int quit_count = 0;
|
||||
|
||||
/* Use previous finding, if it's valid and applies to this inquiry. */
|
||||
if (current_buffer == find_start_buffer
|
||||
|
@ -621,11 +622,9 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
|
|||
SETUP_BUFFER_SYNTAX_TABLE ();
|
||||
while (PT > BEGV)
|
||||
{
|
||||
int c;
|
||||
|
||||
/* Open-paren at start of line means we may have found our
|
||||
defun-start. */
|
||||
c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
|
||||
int c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
|
||||
if (SYNTAX (c) == Sopen)
|
||||
{
|
||||
SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
|
||||
|
@ -637,6 +636,7 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
|
|||
}
|
||||
/* Move to beg of previous line. */
|
||||
scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
|
||||
/* Record what we found, for the next try. */
|
||||
|
@ -715,6 +715,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
|
|||
ptrdiff_t nesting = 1; /* Current comment nesting. */
|
||||
int c;
|
||||
int syntax = 0;
|
||||
unsigned short int quit_count = 0;
|
||||
|
||||
/* FIXME: A }} comment-ender style leads to incorrect behavior
|
||||
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,
|
|||
that determines quote parity to the comment-end. */
|
||||
while (from != stop)
|
||||
{
|
||||
incr_rarely_quit (&quit_count);
|
||||
|
||||
ptrdiff_t temp_byte;
|
||||
int prev_syntax;
|
||||
bool com2start, com2end, comstart;
|
||||
|
@ -951,7 +954,9 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
|
|||
defun_start_byte = CHAR_TO_BYTE (defun_start);
|
||||
}
|
||||
}
|
||||
} while (defun_start < comment_end);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
while (defun_start < comment_end);
|
||||
|
||||
from_byte = CHAR_TO_BYTE (from);
|
||||
UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
|
||||
|
@ -1417,22 +1422,20 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
|
|||
COUNT negative means scan backward and stop at word beginning. */
|
||||
|
||||
ptrdiff_t
|
||||
scan_words (register ptrdiff_t from, register EMACS_INT count)
|
||||
scan_words (ptrdiff_t from, EMACS_INT count)
|
||||
{
|
||||
register ptrdiff_t beg = BEGV;
|
||||
register ptrdiff_t end = ZV;
|
||||
register ptrdiff_t from_byte = CHAR_TO_BYTE (from);
|
||||
register enum syntaxcode code;
|
||||
ptrdiff_t beg = BEGV;
|
||||
ptrdiff_t end = ZV;
|
||||
ptrdiff_t from_byte = CHAR_TO_BYTE (from);
|
||||
enum syntaxcode code;
|
||||
int ch0, ch1;
|
||||
Lisp_Object func, pos;
|
||||
|
||||
maybe_quit ();
|
||||
|
||||
SETUP_SYNTAX_TABLE (from, count);
|
||||
|
||||
while (count > 0)
|
||||
{
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
if (from == end)
|
||||
return 0;
|
||||
|
@ -1445,6 +1448,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
|
|||
break;
|
||||
if (code == Sword)
|
||||
break;
|
||||
rarely_quit (from);
|
||||
}
|
||||
/* Now CH0 is a character which begins a word and FROM is the
|
||||
position of the next character. */
|
||||
|
@ -1473,13 +1477,14 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
|
|||
break;
|
||||
INC_BOTH (from, from_byte);
|
||||
ch0 = ch1;
|
||||
rarely_quit (from);
|
||||
}
|
||||
}
|
||||
count--;
|
||||
}
|
||||
while (count < 0)
|
||||
{
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
if (from == beg)
|
||||
return 0;
|
||||
|
@ -1492,6 +1497,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
|
|||
break;
|
||||
if (code == Sword)
|
||||
break;
|
||||
rarely_quit (from);
|
||||
}
|
||||
/* Now CH1 is a character which ends a word and FROM is the
|
||||
position of it. */
|
||||
|
@ -1524,6 +1530,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
|
|||
break;
|
||||
}
|
||||
ch1 = ch0;
|
||||
rarely_quit (from);
|
||||
}
|
||||
}
|
||||
count++;
|
||||
|
@ -1961,9 +1968,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
|
|||
}
|
||||
fwd_ok:
|
||||
p += nbytes, pos++, pos_byte += nbytes;
|
||||
rarely_quit (pos);
|
||||
}
|
||||
else
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
if (p >= stop)
|
||||
{
|
||||
|
@ -1985,15 +1993,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
|
|||
break;
|
||||
fwd_unibyte_ok:
|
||||
p++, pos++, pos_byte++;
|
||||
rarely_quit (pos);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if (multibyte)
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
unsigned char *prev_p;
|
||||
|
||||
if (p <= stop)
|
||||
{
|
||||
if (p <= endp)
|
||||
|
@ -2001,8 +2008,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
|
|||
p = GPT_ADDR;
|
||||
stop = endp;
|
||||
}
|
||||
prev_p = p;
|
||||
while (--p >= stop && ! CHAR_HEAD_P (*p));
|
||||
unsigned char *prev_p = p;
|
||||
do
|
||||
p--;
|
||||
while (stop <= p && ! CHAR_HEAD_P (*p));
|
||||
|
||||
c = STRING_CHAR (p);
|
||||
|
||||
if (! NILP (iso_classes) && in_classes (c, iso_classes))
|
||||
|
@ -2026,9 +2036,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
|
|||
}
|
||||
back_ok:
|
||||
pos--, pos_byte -= prev_p - p;
|
||||
rarely_quit (pos);
|
||||
}
|
||||
else
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
if (p <= stop)
|
||||
{
|
||||
|
@ -2050,6 +2061,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
|
|||
break;
|
||||
back_unibyte_ok:
|
||||
p--, pos--, pos_byte--;
|
||||
rarely_quit (pos);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -2155,6 +2167,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
|
|||
if (! fastmap[SYNTAX (c)])
|
||||
goto done;
|
||||
p += nbytes, pos++, pos_byte += nbytes;
|
||||
rarely_quit (pos);
|
||||
}
|
||||
while (!parse_sexp_lookup_properties
|
||||
|| pos < gl_state.e_property);
|
||||
|
@ -2171,10 +2184,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
|
|||
|
||||
if (multibyte)
|
||||
{
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
unsigned char *prev_p;
|
||||
|
||||
if (p <= stop)
|
||||
{
|
||||
if (p <= endp)
|
||||
|
@ -2183,17 +2194,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
|
|||
stop = endp;
|
||||
}
|
||||
UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
|
||||
prev_p = p;
|
||||
while (--p >= stop && ! CHAR_HEAD_P (*p));
|
||||
|
||||
unsigned char *prev_p = p;
|
||||
do
|
||||
p--;
|
||||
while (stop <= p && ! CHAR_HEAD_P (*p));
|
||||
|
||||
c = STRING_CHAR (p);
|
||||
if (! fastmap[SYNTAX (c)])
|
||||
break;
|
||||
pos--, pos_byte -= prev_p - p;
|
||||
rarely_quit (pos);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
if (p <= stop)
|
||||
{
|
||||
|
@ -2206,6 +2222,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
|
|||
if (! fastmap[SYNTAX (p[-1])])
|
||||
break;
|
||||
p--, pos--, pos_byte--;
|
||||
rarely_quit (pos);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -2273,9 +2290,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
|
|||
ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
|
||||
EMACS_INT *incomment_ptr, int *last_syntax_ptr)
|
||||
{
|
||||
register int c, c1;
|
||||
register enum syntaxcode code;
|
||||
register int syntax, other_syntax;
|
||||
unsigned short int quit_count = 0;
|
||||
int c, c1;
|
||||
enum syntaxcode code;
|
||||
int syntax, other_syntax;
|
||||
|
||||
if (nesting <= 0) nesting = -1;
|
||||
|
||||
|
@ -2367,6 +2385,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
|
|||
UPDATE_SYNTAX_TABLE_FORWARD (from);
|
||||
nesting++;
|
||||
}
|
||||
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
*charpos_ptr = from;
|
||||
*bytepos_ptr = from_byte;
|
||||
|
@ -2394,13 +2414,12 @@ between them, return t; otherwise return nil. */)
|
|||
ptrdiff_t out_charpos, out_bytepos;
|
||||
EMACS_INT dummy;
|
||||
int dummy2;
|
||||
unsigned short int quit_count = 0;
|
||||
|
||||
CHECK_NUMBER (count);
|
||||
count1 = XINT (count);
|
||||
stop = count1 > 0 ? ZV : BEGV;
|
||||
|
||||
maybe_quit ();
|
||||
|
||||
from = PT;
|
||||
from_byte = PT_BYTE;
|
||||
|
||||
|
@ -2441,6 +2460,7 @@ between them, return t; otherwise return nil. */)
|
|||
INC_BOTH (from, from_byte);
|
||||
UPDATE_SYNTAX_TABLE_FORWARD (from);
|
||||
}
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
while (code == Swhitespace || (code == Sendcomment && c == '\n'));
|
||||
|
||||
|
@ -2469,11 +2489,8 @@ between them, return t; otherwise return nil. */)
|
|||
|
||||
while (count1 < 0)
|
||||
{
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
bool quoted;
|
||||
int syntax;
|
||||
|
||||
if (from <= stop)
|
||||
{
|
||||
SET_PT_BOTH (BEGV, BEGV_BYTE);
|
||||
|
@ -2482,9 +2499,9 @@ between them, return t; otherwise return nil. */)
|
|||
|
||||
DEC_BOTH (from, from_byte);
|
||||
/* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
|
||||
quoted = char_quoted (from, from_byte);
|
||||
bool quoted = char_quoted (from, from_byte);
|
||||
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
|
||||
syntax = SYNTAX_WITH_FLAGS (c);
|
||||
int syntax = SYNTAX_WITH_FLAGS (c);
|
||||
code = SYNTAX (c);
|
||||
comstyle = 0;
|
||||
comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
|
||||
|
@ -2527,6 +2544,7 @@ between them, return t; otherwise return nil. */)
|
|||
}
|
||||
else if (from == stop)
|
||||
break;
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
if (fence_found == 0)
|
||||
{
|
||||
|
@ -2573,6 +2591,8 @@ between them, return t; otherwise return nil. */)
|
|||
SET_PT_BOTH (from, from_byte);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
|
||||
count1++;
|
||||
|
@ -2612,6 +2632,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
EMACS_INT dummy;
|
||||
int dummy2;
|
||||
bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
|
||||
unsigned short int quit_count = 0;
|
||||
|
||||
if (depth > 0) min_depth = 0;
|
||||
|
||||
|
@ -2627,6 +2648,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
{
|
||||
while (from < stop)
|
||||
{
|
||||
incr_rarely_quit (&quit_count);
|
||||
bool comstart_first, prefix;
|
||||
int syntax, other_syntax;
|
||||
UPDATE_SYNTAX_TABLE_FORWARD (from);
|
||||
|
@ -2695,6 +2717,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
goto done;
|
||||
}
|
||||
INC_BOTH (from, from_byte);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
goto done;
|
||||
|
||||
|
@ -2766,6 +2789,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
if (c_code == Scharquote || c_code == Sescape)
|
||||
INC_BOTH (from, from_byte);
|
||||
INC_BOTH (from, from_byte);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
INC_BOTH (from, from_byte);
|
||||
if (!depth && sexpflag) goto done;
|
||||
|
@ -2791,11 +2815,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
{
|
||||
while (from > stop)
|
||||
{
|
||||
int syntax;
|
||||
incr_rarely_quit (&quit_count);
|
||||
DEC_BOTH (from, from_byte);
|
||||
UPDATE_SYNTAX_TABLE_BACKWARD (from);
|
||||
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
|
||||
syntax= SYNTAX_WITH_FLAGS (c);
|
||||
int syntax = SYNTAX_WITH_FLAGS (c);
|
||||
code = syntax_multibyte (c, multibyte_symbol_p);
|
||||
if (depth == min_depth)
|
||||
last_good = from;
|
||||
|
@ -2867,6 +2891,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
default: goto done2;
|
||||
}
|
||||
DEC_BOTH (from, from_byte);
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
goto done2;
|
||||
|
||||
|
@ -2929,13 +2954,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
if (syntax_multibyte (c, multibyte_symbol_p) == code)
|
||||
break;
|
||||
}
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
if (code == Sstring_fence && !depth && sexpflag) goto done2;
|
||||
break;
|
||||
|
||||
case Sstring:
|
||||
stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
|
||||
while (1)
|
||||
while (true)
|
||||
{
|
||||
if (from == stop)
|
||||
goto lose;
|
||||
|
@ -2949,6 +2975,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
|
|||
== Sstring))
|
||||
break;
|
||||
}
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
if (!depth && sexpflag) goto done2;
|
||||
break;
|
||||
|
@ -3061,6 +3088,7 @@ the prefix syntax flag (p). */)
|
|||
if (pos <= beg)
|
||||
break;
|
||||
DEC_BOTH (pos, pos_byte);
|
||||
rarely_quit (pos);
|
||||
}
|
||||
|
||||
SET_PT_BOTH (opoint, opoint_byte);
|
||||
|
@ -3131,6 +3159,7 @@ scan_sexps_forward (struct lisp_parse_state *state,
|
|||
bool found;
|
||||
ptrdiff_t out_bytepos, out_charpos;
|
||||
int temp;
|
||||
unsigned short int quit_count = 0;
|
||||
|
||||
prev_from = from;
|
||||
prev_from_byte = from_byte;
|
||||
|
@ -3200,6 +3229,7 @@ do { prev_from = from; \
|
|||
|
||||
while (from < end)
|
||||
{
|
||||
incr_rarely_quit (&quit_count);
|
||||
INC_FROM;
|
||||
|
||||
if ((from < end)
|
||||
|
@ -3256,6 +3286,7 @@ do { prev_from = from; \
|
|||
goto symdone;
|
||||
}
|
||||
INC_FROM;
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
symdone:
|
||||
curlevel->prev = curlevel->last;
|
||||
|
@ -3366,6 +3397,7 @@ do { prev_from = from; \
|
|||
break;
|
||||
}
|
||||
INC_FROM;
|
||||
incr_rarely_quit (&quit_count);
|
||||
}
|
||||
}
|
||||
string_end:
|
||||
|
|
133
src/sysdep.c
133
src/sysdep.c
|
@ -382,19 +382,23 @@ get_child_status (pid_t child, int *status, int options, bool interruptible)
|
|||
so that another thread running glib won't find them. */
|
||||
eassert (child > 0);
|
||||
|
||||
while ((pid = waitpid (child, status, options)) < 0)
|
||||
while (true)
|
||||
{
|
||||
/* Note: the MS-Windows emulation of waitpid calls maybe_quit
|
||||
internally. */
|
||||
if (interruptible)
|
||||
maybe_quit ();
|
||||
|
||||
pid = waitpid (child, status, options);
|
||||
if (0 <= pid)
|
||||
break;
|
||||
|
||||
/* Check that CHILD is a child process that has not been reaped,
|
||||
and that STATUS and OPTIONS are valid. Otherwise abort,
|
||||
as continuing after this internal error could cause Emacs to
|
||||
become confused and kill innocent-victim processes. */
|
||||
if (errno != EINTR)
|
||||
emacs_abort ();
|
||||
|
||||
/* Note: the MS-Windows emulation of waitpid calls maybe_quit
|
||||
internally. */
|
||||
if (interruptible)
|
||||
maybe_quit ();
|
||||
}
|
||||
|
||||
/* If successful and status is requested, tell wait_reading_process_output
|
||||
|
@ -2503,78 +2507,113 @@ emacs_close (int fd)
|
|||
#define MAX_RW_COUNT (INT_MAX >> 18 << 18)
|
||||
#endif
|
||||
|
||||
/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted.
|
||||
/* Read from FD to a buffer BUF with size NBYTE.
|
||||
If interrupted, either quit or retry the read.
|
||||
Process any quits and pending signals immediately if INTERRUPTIBLE.
|
||||
Return the number of bytes read, which might be less than NBYTE.
|
||||
On error, set errno and return -1. */
|
||||
ptrdiff_t
|
||||
emacs_read (int fildes, void *buf, ptrdiff_t nbyte)
|
||||
On error, set errno to a value other than EINTR, and return -1. */
|
||||
static ptrdiff_t
|
||||
emacs_nointr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible)
|
||||
{
|
||||
ssize_t rtnval;
|
||||
ssize_t result;
|
||||
|
||||
/* There is no need to check against MAX_RW_COUNT, since no caller ever
|
||||
passes a size that large to emacs_read. */
|
||||
do
|
||||
{
|
||||
if (interruptible)
|
||||
maybe_quit ();
|
||||
result = read (fd, buf, nbyte);
|
||||
}
|
||||
while (result < 0 && errno == EINTR);
|
||||
|
||||
while ((rtnval = read (fildes, buf, nbyte)) == -1
|
||||
&& (errno == EINTR))
|
||||
maybe_quit ();
|
||||
return (rtnval);
|
||||
return result;
|
||||
}
|
||||
|
||||
/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted
|
||||
or if a partial write occurs. If interrupted, process pending
|
||||
signals if PROCESS SIGNALS. Return the number of bytes written, setting
|
||||
errno if this is less than NBYTE. */
|
||||
/* Read from FD to a buffer BUF with size NBYTE.
|
||||
If interrupted, retry the read. Return the number of bytes read,
|
||||
which might be less than NBYTE. On error, set errno to a value
|
||||
other than EINTR, and return -1. */
|
||||
ptrdiff_t
|
||||
emacs_read (int fd, void *buf, ptrdiff_t nbyte)
|
||||
{
|
||||
return emacs_nointr_read (fd, buf, nbyte, false);
|
||||
}
|
||||
|
||||
/* Like emacs_read, but also process quits and pending signals. */
|
||||
ptrdiff_t
|
||||
emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte)
|
||||
{
|
||||
return emacs_nointr_read (fd, buf, nbyte, true);
|
||||
}
|
||||
|
||||
/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if
|
||||
interrupted or if a partial write occurs. Process any quits
|
||||
immediately if INTERRUPTIBLE is positive, and process any pending
|
||||
signals immediately if INTERRUPTIBLE is nonzero. Return the number
|
||||
of bytes written; if this is less than NBYTE, set errno to a value
|
||||
other than EINTR. */
|
||||
static ptrdiff_t
|
||||
emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte,
|
||||
bool process_signals)
|
||||
emacs_full_write (int fd, char const *buf, ptrdiff_t nbyte,
|
||||
int interruptible)
|
||||
{
|
||||
ptrdiff_t bytes_written = 0;
|
||||
|
||||
while (nbyte > 0)
|
||||
{
|
||||
ssize_t n = write (fildes, buf, min (nbyte, MAX_RW_COUNT));
|
||||
ssize_t n = write (fd, buf, min (nbyte, MAX_RW_COUNT));
|
||||
|
||||
if (n < 0)
|
||||
{
|
||||
if (errno == EINTR)
|
||||
{
|
||||
/* I originally used maybe_quit but that might cause files to
|
||||
be truncated if you hit C-g in the middle of it. --Stef */
|
||||
if (process_signals && pending_signals)
|
||||
process_pending_signals ();
|
||||
continue;
|
||||
}
|
||||
else
|
||||
if (errno != EINTR)
|
||||
break;
|
||||
}
|
||||
|
||||
buf += n;
|
||||
nbyte -= n;
|
||||
bytes_written += n;
|
||||
if (interruptible)
|
||||
{
|
||||
if (0 < interruptible)
|
||||
maybe_quit ();
|
||||
if (pending_signals)
|
||||
process_pending_signals ();
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
buf += n;
|
||||
nbyte -= n;
|
||||
bytes_written += n;
|
||||
}
|
||||
}
|
||||
|
||||
return bytes_written;
|
||||
}
|
||||
|
||||
/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if
|
||||
interrupted or if a partial write occurs. Return the number of
|
||||
bytes written, setting errno if this is less than NBYTE. */
|
||||
/* Write to FD from a buffer BUF with size NBYTE, retrying if
|
||||
interrupted or if a partial write occurs. Do not process quits or
|
||||
pending signals. Return the number of bytes written, setting errno
|
||||
if this is less than NBYTE. */
|
||||
ptrdiff_t
|
||||
emacs_write (int fildes, void const *buf, ptrdiff_t nbyte)
|
||||
emacs_write (int fd, void const *buf, ptrdiff_t nbyte)
|
||||
{
|
||||
return emacs_full_write (fildes, buf, nbyte, 0);
|
||||
return emacs_full_write (fd, buf, nbyte, 0);
|
||||
}
|
||||
|
||||
/* Like emacs_write, but also process pending signals if interrupted. */
|
||||
/* Like emacs_write, but also process pending signals. */
|
||||
ptrdiff_t
|
||||
emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte)
|
||||
emacs_write_sig (int fd, void const *buf, ptrdiff_t nbyte)
|
||||
{
|
||||
return emacs_full_write (fildes, buf, nbyte, 1);
|
||||
return emacs_full_write (fd, buf, nbyte, -1);
|
||||
}
|
||||
|
||||
/* Like emacs_write, but also process quits and pending signals. */
|
||||
ptrdiff_t
|
||||
emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte)
|
||||
{
|
||||
return emacs_full_write (fd, buf, nbyte, 1);
|
||||
}
|
||||
|
||||
/* Write a diagnostic to standard error that contains MESSAGE and a
|
||||
string derived from errno. Preserve errno. Do not buffer stderr.
|
||||
Do not process pending signals if interrupted. */
|
||||
Do not process quits or pending signals if interrupted. */
|
||||
void
|
||||
emacs_perror (char const *message)
|
||||
{
|
||||
|
@ -3168,7 +3207,7 @@ system_process_attributes (Lisp_Object pid)
|
|||
else
|
||||
{
|
||||
record_unwind_protect_int (close_file_unwind, fd);
|
||||
nread = emacs_read (fd, procbuf, sizeof procbuf - 1);
|
||||
nread = emacs_read_quit (fd, procbuf, sizeof procbuf - 1);
|
||||
}
|
||||
if (0 < nread)
|
||||
{
|
||||
|
@ -3289,7 +3328,7 @@ system_process_attributes (Lisp_Object pid)
|
|||
/* Leave room even if every byte needs escaping below. */
|
||||
readsize = (cmdline_size >> 1) - nread;
|
||||
|
||||
nread_incr = emacs_read (fd, cmdline + nread, readsize);
|
||||
nread_incr = emacs_read_quit (fd, cmdline + nread, readsize);
|
||||
nread += max (0, nread_incr);
|
||||
}
|
||||
while (nread_incr == readsize);
|
||||
|
@ -3402,7 +3441,7 @@ system_process_attributes (Lisp_Object pid)
|
|||
else
|
||||
{
|
||||
record_unwind_protect_int (close_file_unwind, fd);
|
||||
nread = emacs_read (fd, &pinfo, sizeof pinfo);
|
||||
nread = emacs_read_quit (fd, &pinfo, sizeof pinfo);
|
||||
}
|
||||
|
||||
if (nread == sizeof pinfo)
|
||||
|
|
Loading…
Add table
Reference in a new issue