* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
[not found] ` <20170126052542.828422201BC@vcs.savannah.gnu.org>
@ 2017-01-26 13:40 ` Stefan Monnier
2017-01-26 17:45 ` Paul Eggert
2017-02-02 0:01 ` Paul Eggert
0 siblings, 2 replies; 13+ messages in thread
From: Stefan Monnier @ 2017-01-26 13:40 UTC (permalink / raw)
To: emacs-devel; +Cc: Paul Eggert
> Set and clear immediate_quit before and after loop instead of
> executing QUIT each time through the loop. This is OK for loops
> that affect only locals.
IIRC we have moved some QUIT checks *into* loops in the past in order to
be able to interrupt inf-loops, such as when you do (memq 4 '#1=(1 . #1#)).
Of course, for circular lists a better solution is to use the
hare&tortoise, e.g. with FOR_EACH_TAIL.
Stefan
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-26 13:40 ` [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit Stefan Monnier
@ 2017-01-26 17:45 ` Paul Eggert
2017-01-26 20:02 ` Eli Zaretskii
2017-01-29 17:30 ` Eli Zaretskii
2017-02-02 0:01 ` Paul Eggert
1 sibling, 2 replies; 13+ messages in thread
From: Paul Eggert @ 2017-01-26 17:45 UTC (permalink / raw)
To: Stefan Monnier, Emacs development discussions
On 01/26/2017 05:40 AM, Stefan Monnier wrote:
> IIRC we have moved some QUIT checks*into* loops in the past in order to
> be able to interrupt inf-loops, such as when you do (memq 4 '#1=(1 . #1#)).
I was under the impression that if immediate_quit is true, then a tight
loop in C doesn't need to call maybe_quit (the new name for QUIT), as
C-g will error out immediately. There is longstanding code in the
interpreter that assumes this, for example in the implementation of nth.
Unfortunately my impression is incorrect. If you byte-compile this:
(defun foo () (nth most-positive-fixnum '#1=(1 . #1#)))
and load the resulting .elc file and then execute (foo) on a 64-bit
Emacs displaying X, then C-g does not interrupt Emacs and Emacs hangs
while counting up to 2**61. (C-g works as expected with emacs -nw.) I
will look into fixing this longstanding bug, as well as fixing similar
bugs that I recently introduced.
This leads me to wonder: what's the point of immediate_quit? If
immediate_quit doesn't always cause C-g to immediately quit, why are we
bothering with an immediate_quit variable? Or if immediate_quit makes
sense, then should we arrange for a C-g under X to behave more like C-g
on a terminal, and do a longjmp? (Shudder.)
> Of course, for circular lists a better solution is to use the
> hare&tortoise, e.g. with FOR_EACH_TAIL.
Yes, that's something that could be done in these cases too. I'd like to
get C-g fixed first, though.
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-26 17:45 ` Paul Eggert
@ 2017-01-26 20:02 ` Eli Zaretskii
2017-01-29 17:30 ` Eli Zaretskii
1 sibling, 0 replies; 13+ messages in thread
From: Eli Zaretskii @ 2017-01-26 20:02 UTC (permalink / raw)
To: Paul Eggert; +Cc: monnier, emacs-devel
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Thu, 26 Jan 2017 09:45:09 -0800
>
> This leads me to wonder: what's the point of immediate_quit? If
> immediate_quit doesn't always cause C-g to immediately quit, why are we
> bothering with an immediate_quit variable?
It's only tested in the TTY input code, AFAIK.
> Or if immediate_quit makes sense, then should we arrange for a C-g
> under X to behave more like C-g on a terminal, and do a longjmp?
I hope not.
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-26 17:45 ` Paul Eggert
2017-01-26 20:02 ` Eli Zaretskii
@ 2017-01-29 17:30 ` Eli Zaretskii
2017-01-29 17:47 ` Stefan Monnier
2017-01-29 23:05 ` Paul Eggert
1 sibling, 2 replies; 13+ messages in thread
From: Eli Zaretskii @ 2017-01-29 17:30 UTC (permalink / raw)
To: Paul Eggert; +Cc: monnier, emacs-devel
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Thu, 26 Jan 2017 09:45:09 -0800
>
> I was under the impression that if immediate_quit is true, then a tight
> loop in C doesn't need to call maybe_quit (the new name for QUIT), as
> C-g will error out immediately. There is longstanding code in the
> interpreter that assumes this, for example in the implementation of nth.
>
> Unfortunately my impression is incorrect. If you byte-compile this:
>
> (defun foo () (nth most-positive-fixnum '#1=(1 . #1#)))
>
> and load the resulting .elc file and then execute (foo) on a 64-bit
> Emacs displaying X, then C-g does not interrupt Emacs and Emacs hangs
> while counting up to 2**61. (C-g works as expected with emacs -nw.) I
> will look into fixing this longstanding bug, as well as fixing similar
> bugs that I recently introduced.
>
> This leads me to wonder: what's the point of immediate_quit? If
> immediate_quit doesn't always cause C-g to immediately quit, why are we
> bothering with an immediate_quit variable? Or if immediate_quit makes
> sense, then should we arrange for a C-g under X to behave more like C-g
> on a terminal, and do a longjmp? (Shudder.)
Once upon a time Emacs on X would read input from a SIGIO handler. If
you look in the sources for, say, Emacs 22.3, you will see there that
the function input_available_signal, which was installed as the SIGIO
handler, called handle_async_input, which read input from the
window-system. As part of reading input, Emacs would QUIT immediately
when it saw C-g, if immediate_quit was set and inhibit-quit was nil.
Thus, functions that wanted to be interruptible could set
immediate_quit non-zero and be sure they will be interrupted when the
user pressed C-g.
Later we decided that doing non-trivial stuff from signal handlers was
not such a good idea. So nowadays, the SIGIO handler just sets a flag
and returns. That flag is checked as part of QUIT (now rebranded as
maybe_quit), and if found set, we quit at that time.
This is why we started inserting QUIT in places that could potentially
hang or take a long time -- to allow the user to interrupt them sooner
rather than later. And that is why the recent changes which removed
QUIT and added setting immediate_quit non-zero are a move in the wrong
direction -- we should be doing the exact opposite.
> > Of course, for circular lists a better solution is to use the
> > hare&tortoise, e.g. with FOR_EACH_TAIL.
>
> Yes, that's something that could be done in these cases too. I'd like to
> get C-g fixed first, though.
If your plan for fixing this is anything other than restoring the
removed calls to maybe_quit, please show or describe your planned
changes before you install them. This tricky issue is further
complicated by the concurrency features, so I think we should make
sure the design is right before applying.
Thanks.
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-29 17:30 ` Eli Zaretskii
@ 2017-01-29 17:47 ` Stefan Monnier
2017-01-29 20:16 ` Eli Zaretskii
2017-01-29 23:05 ` Paul Eggert
1 sibling, 1 reply; 13+ messages in thread
From: Stefan Monnier @ 2017-01-29 17:47 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Paul Eggert, emacs-devel
>>>>> "Eli" == Eli Zaretskii <eliz@gnu.org> writes:
[...]
Thanks. This nicely matches what I remember, but I wasn't sure (I'm
obviously quite familiar with this story, since I was the one who
introduced the SYNC_INPUT changes, yet I never quite understood the
details of the immediate_quit thingy).
> This is why we started inserting QUIT in places that could potentially
> hang or take a long time -- to allow the user to interrupt them sooner
> rather than later. And that is why the recent changes which removed
> QUIT and added setting immediate_quit non-zero are a move in the wrong
> direction -- we should be doing the exact opposite.
So, IIUC we should basically get rid of immediate_quit.
Since I never really understood it, I'd be happy to see it disappear ;-)
[ But, it's obviously not urgent. ]
Stefan
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-29 17:47 ` Stefan Monnier
@ 2017-01-29 20:16 ` Eli Zaretskii
0 siblings, 0 replies; 13+ messages in thread
From: Eli Zaretskii @ 2017-01-29 20:16 UTC (permalink / raw)
To: Stefan Monnier; +Cc: eggert, emacs-devel
> From: Stefan Monnier <monnier@IRO.UMontreal.CA>
> Cc: Paul Eggert <eggert@cs.ucla.edu>, emacs-devel@gnu.org
> Date: Sun, 29 Jan 2017 12:47:57 -0500
>
> So, IIUC we should basically get rid of immediate_quit.
Not sure, because it's still used in TTY input, when C-g triggers
SIGINT. With TTY input, we don't delay C-g handling as we do on X.
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-29 17:30 ` Eli Zaretskii
2017-01-29 17:47 ` Stefan Monnier
@ 2017-01-29 23:05 ` Paul Eggert
2017-01-30 15:33 ` Eli Zaretskii
1 sibling, 1 reply; 13+ messages in thread
From: Paul Eggert @ 2017-01-29 23:05 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: monnier, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 775 bytes --]
On 01/29/2017 09:30 AM, Eli Zaretskii wrote:
> please show or describe your planned changes before you install them
OK, attached. I've been using them for a few days and they work for me.
After installing them, I plan to address the FOR_EACH_TAIL issue that
Stefan mentioned earlier. While I'm in the neighborhood, I have drafted
fixes for the TODO items mentioned in lisp.h's FOR_EACH_TAIL comments
(I'm attacking loop unrolling in a different way). But one thing at a time.
The idea of the attached code is to fix the problems I recently
introduced in this area, along with some longstanding related bugs, e.g,
(defun foo () (nth most-positive-fixnum '#1=(1 . #1#))) when
byte-compiled on a 64-bit X platform (currently Emacs hangs and cannot
be C-g'ed out of).
[-- Attachment #2: 0001-Remove-immediate_quit.patch --]
[-- Type: text/x-patch, Size: 34409 bytes --]
From 291150778e4427d55703b4bd9a5543867d7ecf11 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 27 Jan 2017 08:58:51 -0800
Subject: [PATCH 1/3] Remove immediate_quit.
The old code that sets and clears immediate_quit was
ineffective except when Emacs is running in terminal mode, and
has problematic race conditions anyway, so remove it. This
will introduce some hangs when Emacs runs in terminal mode,
and these hangs should be fixed in followup patches.
* src/keyboard.c (immediate_quit): Remove. All uses removed.
---
admin/notes/multi-tty | 5 ++---
src/bytecode.c | 4 ----
src/callproc.c | 8 +-------
src/dired.c | 3 ---
src/editfns.c | 9 ++-------
src/eval.c | 2 --
src/fileio.c | 19 -------------------
src/fns.c | 42 ++++++++----------------------------------
src/indent.c | 2 --
src/keyboard.c | 45 +++++++--------------------------------------
src/lisp.h | 8 --------
src/process.c | 10 +---------
src/regex.c | 10 ++++------
src/search.c | 33 ++-------------------------------
src/syntax.c | 30 ++----------------------------
src/w32fns.c | 11 +----------
src/window.c | 2 --
17 files changed, 30 insertions(+), 213 deletions(-)
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty
index b58180e..d0096ad 100644
--- a/admin/notes/multi-tty
+++ b/admin/notes/multi-tty
@@ -1239,9 +1239,8 @@ DIARY OF CHANGES
(Update: OK, it all seems so easy now (NOT). Input could be done
synchronously (with wait_reading_process_input), or asynchronously
by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag,
- signals a 'quit condition (when immediate_quit), or throws to
- 'getcjmp' when Emacs was waiting for input when the C-g event
- arrived.)
+ signals a 'quit condition, or throws to 'getcjmp' when Emacs was
+ waiting for input when the C-g event arrived.)
-- Replace wrong_kboard_jmpbuf with a special return value of
read_char. It is absurd that we use setjmp/longjmp just to return
diff --git a/src/bytecode.c b/src/bytecode.c
index 499fb88..ed58d18 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -842,10 +842,8 @@ 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);
- immediate_quit = true;
while (--n >= 0 && CONSP (v2))
v2 = XCDR (v2);
- immediate_quit = false;
TOP = CAR (v2);
NEXT;
}
@@ -1276,10 +1274,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER (v2);
EMACS_INT n = XINT (v2);
- immediate_quit = true;
while (--n >= 0 && CONSP (v1))
v1 = XCDR (v1);
- immediate_quit = false;
TOP = CAR (v1);
}
else
diff --git a/src/callproc.c b/src/callproc.c
index 301ccf3..85674bb 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,11 +198,9 @@ 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)");
- immediate_quit = true;
maybe_quit ();
wait_for_termination (synch_process_pid, 0, 1);
synch_process_pid = 0;
- immediate_quit = false;
message1 ("Waiting for process to die...done");
}
#endif /* !MSDOS */
@@ -726,7 +724,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
process_coding.src_multibyte = 0;
}
- immediate_quit = true;
maybe_quit ();
if (0 <= fd0)
@@ -769,7 +766,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
}
/* Now NREAD is the total amount of data in the buffer. */
- immediate_quit = false;
if (!nread)
;
@@ -842,7 +838,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
we should have already detected a coding system. */
display_on_the_fly = true;
}
- immediate_quit = true;
+
maybe_quit ();
}
give_up: ;
@@ -860,8 +856,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
wait_for_termination (pid, &status, fd0 < 0);
#endif
- immediate_quit = false;
-
/* Don't kill any children that the subprocess may have left behind
when exiting. */
synch_process_pid = 0;
diff --git a/src/dired.c b/src/dired.c
index 52e81fb..5ea00fb 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -248,14 +248,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
- immediate_quit = true;
maybe_quit ();
bool wanted = (NILP (match)
|| re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
- immediate_quit = false;
-
if (wanted)
{
if (!NILP (full))
diff --git a/src/editfns.c b/src/editfns.c
index 82c6abb..b605437 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3053,7 +3053,6 @@ determines whether case is significant or ignored. */)
i2 = begp2;
i1_byte = buf_charpos_to_bytepos (bp1, i1);
i2_byte = buf_charpos_to_bytepos (bp2, i2);
- immediate_quit = true;
while (i1 < endp1 && i2 < endp2)
{
@@ -3092,17 +3091,13 @@ determines whether case is significant or ignored. */)
c1 = char_table_translate (trt, c1);
c2 = char_table_translate (trt, c2);
}
+
if (c1 != c2)
- {
- immediate_quit = false;
- return make_number (c1 < c2 ? -1 - chars : chars + 1);
- }
+ return make_number (c1 < c2 ? -1 - chars : chars + 1);
chars++;
}
- immediate_quit = false;
-
/* The strings match as far as they go.
If one is shorter, that one is less. */
if (chars < endp1 - begp1)
diff --git a/src/eval.c b/src/eval.c
index 62d4af1..844879d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1131,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
unblock_input_to (catch->interrupt_input_blocked);
- immediate_quit = false;
do
{
@@ -1517,7 +1516,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
Lisp_Object clause = Qnil;
struct handler *h;
- immediate_quit = false;
if (gc_in_progress || waiting_for_input)
emacs_abort ();
diff --git a/src/fileio.c b/src/fileio.c
index b8706e1..3e28517 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1960,9 +1960,7 @@ permissions. */)
report_file_error ("Copying permissions to", newname);
}
#else /* not WINDOWSNT */
- immediate_quit = true;
ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
- immediate_quit = false;
if (ifd < 0)
report_file_error ("Opening input file", file);
@@ -2024,7 +2022,6 @@ permissions. */)
oldsize = out_st.st_size;
}
- immediate_quit = true;
maybe_quit ();
if (clone_file (ofd, ifd))
@@ -2047,8 +2044,6 @@ permissions. */)
if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
report_file_error ("Truncating output file", newname);
- immediate_quit = false;
-
#ifndef MSDOS
/* Preserve the original file permissions, and if requested, also its
owner and group. */
@@ -3402,13 +3397,11 @@ read_non_regular (Lisp_Object state)
{
int nbytes;
- immediate_quit = true;
maybe_quit ();
nbytes = emacs_read (XSAVE_INTEGER (state, 0),
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ XSAVE_INTEGER (state, 1)),
XSAVE_INTEGER (state, 2));
- immediate_quit = false;
/* Fast recycle this object for the likely next call. */
free_misc (state);
return make_number (nbytes);
@@ -3867,7 +3860,6 @@ by calling `format-decode', which see. */)
report_file_error ("Setting file position", orig_filename);
}
- immediate_quit = true;
maybe_quit ();
/* Count how many chars at the start of the file
match the text at the beginning of the buffer. */
@@ -3906,7 +3898,6 @@ by calling `format-decode', which see. */)
if (bufpos != nread)
break;
}
- immediate_quit = false;
/* If the file matches the buffer completely,
there's no need to replace anything. */
if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
@@ -3918,7 +3909,6 @@ by calling `format-decode', which see. */)
del_range_1 (same_at_start, same_at_end, 0, 0);
goto handled;
}
- immediate_quit = true;
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
@@ -3976,7 +3966,6 @@ by calling `format-decode', which see. */)
if (nread == 0)
break;
}
- immediate_quit = false;
if (! giveup_match_end)
{
@@ -4074,11 +4063,9 @@ by calling `format-decode', which see. */)
quitting while reading a huge file. */
/* Allow quitting out of the actual I/O. */
- immediate_quit = true;
maybe_quit ();
this = emacs_read (fd, read_buf + unprocessed,
READ_BUF_SIZE - unprocessed);
- immediate_quit = false;
if (this <= 0)
break;
@@ -4293,13 +4280,11 @@ 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. */
- immediate_quit = true;
maybe_quit ();
this = emacs_read (fd,
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ inserted),
trytry);
- immediate_quit = false;
}
if (this <= 0)
@@ -5001,8 +4986,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
}
}
- immediate_quit = true;
-
if (STRINGP (start))
ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
else if (XINT (start) != XINT (end))
@@ -5025,8 +5008,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
save_errno = errno;
}
- immediate_quit = false;
-
/* fsync is not crucial for temporary files. Nor for auto-save
files, since they might lose some work anyway. */
if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
diff --git a/src/fns.c b/src/fns.c
index b8ebfe5..03af092 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1360,18 +1360,15 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
CHECK_NUMBER (n);
EMACS_INT num = XINT (n);
Lisp_Object tail = list;
- immediate_quit = true;
for (EMACS_INT i = 0; i < num; i++)
{
if (! CONSP (tail))
{
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
tail = XCDR (tail);
}
- immediate_quit = false;
return tail;
}
@@ -1418,17 +1415,12 @@ 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)
{
- immediate_quit = true;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (EQ (XCAR (tail), elt))
- {
- immediate_quit = false;
- return tail;
- }
+ return tail;
}
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1441,18 +1433,13 @@ The value is actually the tail of LIST whose car is ELT. */)
if (!FLOATP (elt))
return Fmemq (elt, list);
- immediate_quit = true;
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))
- {
- immediate_quit = false;
- return tail;
- }
+ return tail;
}
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1463,15 +1450,12 @@ 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)
{
- immediate_quit = true;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
- if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
- {
- immediate_quit = false;
+ {
+ if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
return XCAR (tail);
- }
- immediate_quit = true;
+ }
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1528,15 +1512,12 @@ 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)
{
- immediate_quit = true;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
- if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
- {
- immediate_quit = false;
+ {
+ if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
return XCAR (tail);
- }
- immediate_quit = true;
+ }
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -2075,21 +2056,18 @@ 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)
{
- immediate_quit = true;
Lisp_Object prev = Qnil;
for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (EQ (prop, XCAR (tail)))
{
- immediate_quit = false;
Fsetcar (XCDR (tail), val);
return plist;
}
prev = tail;
}
- immediate_quit = true;
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
@@ -2440,7 +2418,6 @@ usage: (nconc &rest LISTS) */)
CHECK_CONS (tem);
- immediate_quit = true;
Lisp_Object tail;
do
{
@@ -2449,7 +2426,6 @@ usage: (nconc &rest LISTS) */)
}
while (CONSP (tem));
- immediate_quit = false;
rarely_quit (&quit_count);
tem = args[argnum + 1];
@@ -2872,13 +2848,11 @@ 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)
{
- immediate_quit = true;
while (CONSP (plist) && !EQ (XCAR (plist), prop))
{
plist = XCDR (plist);
plist = CDR (plist);
}
- immediate_quit = false;
return plist;
}
diff --git a/src/indent.c b/src/indent.c
index 23951a1..33f709c 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,7 +1200,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
continuation_glyph_width = 0; /* In the fringe. */
#endif
- immediate_quit = true;
maybe_quit ();
/* It's just impossible to be too paranoid here. */
@@ -1694,7 +1693,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
/* Nonzero if have just continued a line */
val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
- immediate_quit = false;
return &val_compute_motion;
}
diff --git a/src/keyboard.c b/src/keyboard.c
index d41603b..317669d 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -169,9 +169,6 @@ struct kboard *echo_kboard;
Lisp_Object echo_message_buffer;
-/* True means C-g should cause immediate error-signal. */
-bool immediate_quit;
-
/* Character that causes a quit. Normally C-g.
If we are running on an ordinary terminal, this must be an ordinary
@@ -3584,16 +3581,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
as input, set quit-flag to cause an interrupt. */
if (!NILP (Vthrow_on_input)
&& NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)))
- {
- Vquit_flag = Vthrow_on_input;
- /* If we're inside a function that wants immediate quits,
- do it now. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- immediate_quit = false;
- maybe_quit ();
- }
- }
+ Vquit_flag = Vthrow_on_input;
}
@@ -10445,30 +10433,12 @@ handle_interrupt (bool in_signal_handler)
}
else
{
- /* If executing a function that wants to be interrupted out of
- and the user has not deferred quitting by binding `inhibit-quit'
- then quit right away. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- struct gl_state_s saved;
-
- immediate_quit = false;
- pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
- saved = gl_state;
- quit ();
- gl_state = saved;
- }
- else
- { /* Else request quit when it's safe. */
- int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
- force_quit_count = count;
- if (count == 3)
- {
- immediate_quit = true;
- Vinhibit_quit = Qnil;
- }
- Vquit_flag = Qt;
- }
+ /* Request quit when it's safe. */
+ int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
+ force_quit_count = count;
+ if (count == 3)
+ Vinhibit_quit = Qnil;
+ Vquit_flag = Qt;
}
pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
@@ -10907,7 +10877,6 @@ init_keyboard (void)
{
/* This is correct before outermost invocation of the editor loop. */
command_loop_level = -1;
- immediate_quit = false;
quit_char = Ctl ('g');
Vunread_command_events = Qnil;
timer_idleness_start_time = invalid_timespec ();
diff --git a/src/lisp.h b/src/lisp.h
index 84d53bb..219e9f8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3127,11 +3127,6 @@ extern Lisp_Object memory_signal_data;
impossible, of course. But it is very desirable to avoid creating
loops where maybe_quit is impossible.
- Exception: if you set immediate_quit, the handler that responds to
- the C-g does the quit itself. This is a good thing to do around a
- loop that has no side effects and (in particular) cannot call
- arbitrary Lisp code.
-
If quit-flag is set to `kill-emacs' the SIGINT handler has received
a request to exit Emacs when it is safe to do.
@@ -4344,9 +4339,6 @@ extern char my_edata[];
extern char my_endbss[];
extern char *my_endbss_static;
-/* True means ^G can quit instantly. */
-extern bool immediate_quit;
-
extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
diff --git a/src/process.c b/src/process.c
index dbd4358..434a395 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,7 +3431,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
break;
}
- immediate_quit = true;
maybe_quit ();
ret = connect (s, sa, addrlen);
@@ -3439,8 +3438,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
if (ret == 0 || xerrno == EISCONN)
{
- /* The unwind-protect will be discarded afterwards.
- Likewise for immediate_quit. */
+ /* The unwind-protect will be discarded afterwards. */
break;
}
@@ -3481,8 +3479,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
}
#endif /* !WINDOWSNT */
- immediate_quit = false;
-
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count;
emacs_close (s);
@@ -3539,8 +3535,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
#endif
}
- immediate_quit = false;
-
if (s < 0)
{
/* If non-blocking got this far - and failed - assume non-blocking is
@@ -4012,7 +4006,6 @@ usage: (make-network-process &rest ARGS) */)
struct addrinfo *res, *lres;
int ret;
- immediate_quit = true;
maybe_quit ();
struct addrinfo hints;
@@ -4034,7 +4027,6 @@ usage: (make-network-process &rest ARGS) */)
#else
error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
- immediate_quit = false;
for (lres = res; lres; lres = lres->ai_next)
addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
diff --git a/src/regex.c b/src/regex.c
index f6e67af..796f868 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1728,10 +1728,8 @@ typedef struct
/* Explicit quit checking is needed for Emacs, which uses polling to
process input events. */
-#ifdef emacs
-# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0)
-#else
-# define IMMEDIATE_QUIT_CHECK ((void) 0)
+#ifndef emacs
+static void maybe_quit (void) {}
#endif
\f
/* Structure to manage work area for range table. */
@@ -5820,7 +5818,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
/* Unconditionally jump (without popping any failure points). */
case jump:
unconditional_jump:
- IMMEDIATE_QUIT_CHECK;
+ maybe_quit ();
EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */
DEBUG_PRINT ("EXECUTING jump %d ", mcnt);
p += mcnt; /* Do the jump. */
@@ -6168,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
/* We goto here if a matching operation fails. */
fail:
- IMMEDIATE_QUIT_CHECK;
+ maybe_quit ();
if (!FAIL_STACK_EMPTY ())
{
re_char *str, *pat;
diff --git a/src/search.c b/src/search.c
index f54f44c..ed9c12c 100644
--- a/src/search.c
+++ b/src/search.c
@@ -277,7 +277,6 @@ looking_at_1 (Lisp_Object string, bool posix)
!NILP (BVAR (current_buffer, enable_multibyte_characters)));
/* Do a pending quit right away, to avoid paradoxical behavior */
- immediate_quit = true;
maybe_quit ();
/* Get pointers and sizes of the two strings
@@ -311,7 +310,6 @@ looking_at_1 (Lisp_Object string, bool posix)
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL),
ZV_BYTE - BEGV_BYTE);
- immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -399,7 +397,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
? BVAR (current_buffer, case_canon_table) : Qnil),
posix,
STRING_MULTIBYTE (string));
- immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
@@ -407,7 +404,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
SBYTES (string) - pos_byte,
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL));
- immediate_quit = false;
/* Set last_thing_searched only when match data is changed. */
if (NILP (Vinhibit_changing_match_data))
@@ -471,13 +467,11 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string,
bufp = compile_pattern (regexp, 0, table,
0, STRING_MULTIBYTE (string));
- immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
SBYTES (string), 0,
SBYTES (string), 0);
- immediate_quit = false;
return val;
}
@@ -498,9 +492,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
bufp = compile_pattern (regexp, 0,
Vascii_canon_table, 0,
0);
- immediate_quit = true;
val = re_search (bufp, string, len, 0, len, 0);
- immediate_quit = false;
return val;
}
@@ -561,7 +553,6 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
}
buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
- immediate_quit = true;
#ifdef REL_ALLOC
/* Prevent ralloc.c from relocating the current buffer while
searching it. */
@@ -572,7 +563,6 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
- immediate_quit = false;
return len;
}
@@ -649,7 +639,7 @@ newline_cache_on_off (struct buffer *buf)
If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding
to the returned character position.
- If ALLOW_QUIT, set immediate_quit. That's good to do
+ If ALLOW_QUIT, check for quitting. That's good to do
except when inside redisplay. */
ptrdiff_t
@@ -685,8 +675,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (shortage != 0)
*shortage = 0;
- immediate_quit = allow_quit;
-
if (count > 0)
while (start != end)
{
@@ -704,7 +692,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = false;
while (start < end && result)
{
ptrdiff_t lim1;
@@ -757,7 +744,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
start_byte = end_byte;
break;
}
- immediate_quit = allow_quit;
/* START should never be after END. */
if (start_byte > ceiling_byte)
@@ -810,7 +796,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
@@ -833,7 +818,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = false;
while (start > end && result)
{
ptrdiff_t lim1;
@@ -870,7 +854,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
start_byte = end_byte;
break;
}
- immediate_quit = allow_quit;
/* Start should never be at or before end. */
if (start_byte <= ceiling_byte)
@@ -918,7 +901,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (++count >= 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = ceiling_byte + prev + 1;
return BYTE_TO_CHAR (ceiling_byte + prev + 1);
@@ -930,7 +912,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
}
}
- immediate_quit = false;
if (shortage)
*shortage = count * direction;
if (bytepos)
@@ -954,7 +935,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
the number of line boundaries left unfound, and position at
the limit we bumped up against.
- If ALLOW_QUIT, set immediate_quit. That's good to do
+ If ALLOW_QUIT, check for quitting. That's good to do
except in special cases. */
ptrdiff_t
@@ -1197,9 +1178,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
trt, posix,
!NILP (BVAR (current_buffer, enable_multibyte_characters)));
- immediate_quit = true; /* Quit immediately if user types ^G,
- because letting this function finish
- can take too long. */
maybe_quit (); /* Do a pending quit right away,
to avoid paradoxical behavior */
/* Get pointers and sizes of the two strings
@@ -1268,7 +1246,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
}
else
{
- immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -1313,7 +1290,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
}
else
{
- immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -1321,7 +1297,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
}
n--;
}
- immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -3231,8 +3206,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (shortage != 0)
*shortage = 0;
- immediate_quit = allow_quit;
-
if (count > 0)
while (start != end)
{
@@ -3275,7 +3248,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
@@ -3287,7 +3259,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
}
}
- immediate_quit = false;
if (shortage)
*shortage = count;
if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index f9e4093..e713922 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1426,7 +1426,6 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
int ch0, ch1;
Lisp_Object func, pos;
- immediate_quit = true;
maybe_quit ();
SETUP_SYNTAX_TABLE (from, count);
@@ -1436,10 +1435,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
while (1)
{
if (from == end)
- {
- immediate_quit = false;
- return 0;
- }
+ return 0;
UPDATE_SYNTAX_TABLE_FORWARD (from);
ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
@@ -1486,10 +1482,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
while (1)
{
if (from == beg)
- {
- immediate_quit = false;
- return 0;
- }
+ return 0;
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -1536,8 +1529,6 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
count++;
}
- immediate_quit = false;
-
return from;
}
@@ -1921,7 +1912,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
}
- immediate_quit = true;
/* This code may look up syntax tables using functions that rely on the
gl_state object. To make sure this object is not out of date,
let's initialize it manually.
@@ -2064,7 +2054,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
}
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = false;
SAFE_FREE ();
return make_number (PT - start_point);
@@ -2138,7 +2127,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p, *endp, *stop;
- immediate_quit = true;
SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
if (forwardp)
@@ -2224,7 +2212,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
done:
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = false;
return make_number (PT - start_point);
}
@@ -2412,7 +2399,6 @@ between them, return t; otherwise return nil. */)
count1 = XINT (count);
stop = count1 > 0 ? ZV : BEGV;
- immediate_quit = true;
maybe_quit ();
from = PT;
@@ -2429,7 +2415,6 @@ between them, return t; otherwise return nil. */)
if (from == stop)
{
SET_PT_BOTH (from, from_byte);
- immediate_quit = false;
return Qnil;
}
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2463,7 +2448,6 @@ between them, return t; otherwise return nil. */)
comstyle = ST_COMMENT_STYLE;
else if (code != Scomment)
{
- immediate_quit = false;
DEC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
@@ -2474,7 +2458,6 @@ between them, return t; otherwise return nil. */)
from = out_charpos; from_byte = out_bytepos;
if (!found)
{
- immediate_quit = false;
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2494,7 +2477,6 @@ between them, return t; otherwise return nil. */)
if (from <= stop)
{
SET_PT_BOTH (BEGV, BEGV_BYTE);
- immediate_quit = false;
return Qnil;
}
@@ -2587,7 +2569,6 @@ between them, return t; otherwise return nil. */)
else if (code != Swhitespace || quoted)
{
leave:
- immediate_quit = false;
INC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
@@ -2598,7 +2579,6 @@ between them, return t; otherwise return nil. */)
}
SET_PT_BOTH (from, from_byte);
- immediate_quit = false;
return Qt;
}
\f
@@ -2640,7 +2620,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
from_byte = CHAR_TO_BYTE (from);
- immediate_quit = true;
maybe_quit ();
SETUP_SYNTAX_TABLE (from, count);
@@ -2801,7 +2780,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = false;
return Qnil;
/* End of object reached */
@@ -2984,7 +2962,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = false;
return Qnil;
done2:
@@ -2992,7 +2969,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
}
- immediate_quit = false;
XSETFASTINT (val, from);
return val;
@@ -3173,7 +3149,6 @@ do { prev_from = from; \
UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
- immediate_quit = true;
maybe_quit ();
depth = state->depth;
@@ -3432,7 +3407,6 @@ do { prev_from = from; \
state->levelstarts);
state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
|| state->quoted) ? prev_from_syntax : Smax;
- immediate_quit = false;
}
/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/w32fns.c b/src/w32fns.c
index 6a576fc..1b628b0 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -3168,16 +3168,7 @@ signal_user_input (void)
Vquit_flag = Vthrow_on_input;
/* Calling maybe_quit from this thread is a bad idea, since this
unwinds the stack of the Lisp thread, and the Windows runtime
- rightfully barfs. Disabled. */
-#if 0
- /* If we're inside a function that wants immediate quits,
- do it now. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- immediate_quit = false;
- maybe_quit ();
- }
-#endif
+ rightfully barfs. */
}
}
diff --git a/src/window.c b/src/window.c
index 71a82b5..bc3f488 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4770,7 +4770,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
{
ptrdiff_t count = SPECPDL_INDEX ();
- immediate_quit = true;
n = clip_to_bounds (INT_MIN, n, INT_MAX);
wset_redisplay (XWINDOW (window));
@@ -4789,7 +4788,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
/* Bug#15957. */
XWINDOW (window)->window_end_valid = false;
- immediate_quit = false;
}
--
2.9.3
[-- Attachment #3: 0002-Revamp-quitting-and-fix-infloops.patch --]
[-- Type: text/x-patch, Size: 49937 bytes --]
From db9f32e10b76294b21787bcc4b03cc36dce15ffe Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Fri, 27 Jan 2017 08:58:51 -0800
Subject: [PATCH 2/3] 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.
---
src/alloc.c | 2 +-
src/bytecode.c | 16 ++++---
src/callproc.c | 9 +---
src/doc.c | 9 ++--
src/editfns.c | 1 +
src/eval.c | 13 ++++++
src/fileio.c | 55 ++++++++++--------------
src/filelock.c | 7 +---
src/fns.c | 53 +++++++++++-------------
src/indent.c | 11 +++--
src/keyboard.c | 48 +++++++--------------
src/lisp.h | 40 ++++++++++++------
src/lread.c | 2 +-
src/search.c | 8 ++++
src/syntax.c | 112 +++++++++++++++++++++++++++++++------------------
src/sysdep.c | 129 +++++++++++++++++++++++++++++++++++++--------------------
16 files changed, 295 insertions(+), 220 deletions(-)
diff --git a/src/alloc.c b/src/alloc.c
index f7b6515..b24dd7f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -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;
diff --git a/src/bytecode.c b/src/bytecode.c
index ed58d18..0f7420c 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,
{
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
diff --git a/src/callproc.c b/src/callproc.c
index 85674bb..710174c 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -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: ;
diff --git a/src/doc.c b/src/doc.c
index 361d09a..1e7e3fc 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -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)
diff --git a/src/editfns.c b/src/editfns.c
index b605437..4618164 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -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.
diff --git a/src/eval.c b/src/eval.c
index 844879d..22b02b4 100644
--- a/src/eval.c
+++ b/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)
{
diff --git a/src/fileio.c b/src/fileio.c
index 3e28517..a634eee 100644
--- a/src/fileio.c
+++ b/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);
@@ -3395,13 +3395,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);
@@ -3745,17 +3742,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;
}
}
@@ -3860,14 +3857,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)
@@ -3889,7 +3883,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++;
@@ -3909,7 +3903,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. */
@@ -3931,7 +3925,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)
@@ -4057,16 +4052,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;
@@ -4280,11 +4272,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)
@@ -5397,7 +5388,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)
{
diff --git a/src/filelock.c b/src/filelock.c
index de65c52..67e8dbd 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -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;
diff --git a/src/fns.c b/src/fns.c
index 03af092..dc75d84 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -83,22 +83,6 @@ See Info node `(elisp)Random Numbers' for more details. */)
return make_number (val);
}
\f
-/* 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,
@@ -1358,9 +1342,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))
{
@@ -1368,6 +1351,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
return Qnil;
}
tail = XCDR (tail);
+ rarely_quit (num);
}
return tail;
}
@@ -1404,7 +1388,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;
@@ -1415,11 +1399,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;
@@ -1433,12 +1419,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;
@@ -1450,11 +1438,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;
@@ -1485,7 +1475,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;
@@ -1512,11 +1502,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;
@@ -1535,7 +1527,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;
@@ -1690,7 +1682,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);
}
@@ -1715,10 +1707,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;
@@ -1764,8 +1756,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);
}
@@ -2056,6 +2048,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)))
@@ -2067,6 +2060,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))));
@@ -2104,7 +2098,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);
@@ -2134,7 +2128,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))
@@ -2214,7 +2208,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))
@@ -2423,11 +2417,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))
@@ -2848,10 +2841,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;
}
diff --git a/src/indent.c b/src/indent.c
index 33f709c..aff14ab 100644
--- a/src/indent.c
+++ b/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,
diff --git a/src/keyboard.c b/src/keyboard.c
index 317669d..a86e7c5 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -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. */
-#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
+ 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
- );
#ifndef USABLE_FIONREAD
#if defined (USG) || defined (CYGWIN)
diff --git a/src/lisp.h b/src/lisp.h
index 219e9f8..1db76ce 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3119,24 +3119,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);
+}
\f
extern Lisp_Object Vascii_downcase_table;
extern Lisp_Object Vascii_canon_table;
@@ -4212,8 +4224,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);
diff --git a/src/lread.c b/src/lread.c
index ea2a1d1..6875c8b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -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'
diff --git a/src/search.c b/src/search.c
index ed9c12c..084adda 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,
*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;
diff --git a/src/syntax.c b/src/syntax.c
index e713922..06fe50b 100644
--- a/src/syntax.c
+++ b/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:
diff --git a/src/sysdep.c b/src/sysdep.c
index e172dc0..4155c20 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)
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)
+ if (errno != EINTR)
+ break;
+
+ if (interruptible)
{
- /* 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)
+ if (0 < interruptible)
+ maybe_quit ();
+ if (pending_signals)
process_pending_signals ();
- continue;
}
- else
- break;
}
-
- buf += n;
- nbyte -= n;
- bytes_written += n;
+ 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 fd, void const *buf, ptrdiff_t nbyte)
+{
+ return emacs_full_write (fd, buf, nbyte, 0);
+}
+
+/* Like emacs_write, but also process pending signals. */
ptrdiff_t
-emacs_write (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, 0);
+ return emacs_full_write (fd, buf, nbyte, -1);
}
-/* Like emacs_write, but also process pending signals if interrupted. */
+/* Like emacs_write, but also process quits and pending signals. */
ptrdiff_t
-emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte)
+emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte)
{
- return emacs_full_write (fildes, buf, nbyte, 1);
+ 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)
--
2.9.3
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Add-delq-list-arg-check.patch --]
[-- Type: text/x-patch; name="0003-Add-delq-list-arg-check.patch", Size: 707 bytes --]
From f5f93b6c425925a5fe65adc791051150bc29ff53 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Sat, 28 Jan 2017 16:45:56 -0800
Subject: [PATCH 3/3] Add delq list arg check
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
* src/fns.c (Fdelq): Check that list is a proper list.
This is more compatible with what ‘delete’ does.
---
src/fns.c | 1 +
1 file changed, 1 insertion(+)
diff --git a/src/fns.c b/src/fns.c
index dc75d84..4fc1b63 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1561,6 +1561,7 @@ argument. */)
else
prev = tail;
}
+ CHECK_LIST_END (tail, list);
return list;
}
--
2.9.3
^ permalink raw reply related [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-29 23:05 ` Paul Eggert
@ 2017-01-30 15:33 ` Eli Zaretskii
2017-01-30 21:52 ` Paul Eggert
0 siblings, 1 reply; 13+ messages in thread
From: Eli Zaretskii @ 2017-01-30 15:33 UTC (permalink / raw)
To: Paul Eggert; +Cc: monnier, emacs-devel
> Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Sun, 29 Jan 2017 15:05:50 -0800
>
> The idea of the attached code is to fix the problems I recently introduced in this area, along with some longstanding related bugs, e.g, (defun foo () (nth most-positive-fixnum '#1=(1 . #1#))) when byte-compiled on a 64-bit X platform (currently Emacs hangs and cannot be C-g'ed out of).
Thanks, some comments follow:
+ 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)
The "nointr" part in the name of the function seems to be in
contradiction to what the function actually does.
More generally, I don't understand why we need both this and
emacs_read, which cannot be interrupted. Why not have just emacs_read
which can be interrupted, and use that all over? I've reviewed the
places where you left the call to emacs_read, and I don't see why
those would be "unsafe" for C-g.
@@ -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);
I think it would be good to add a comment here saying that
wait_for_termination will quit if the user hits C-g there.
+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);
+}
Does it really pay off to have two almost identical functions? Why
not have just rarely_quit, and increment the counter by hand where we
need that?
@@ -1252,6 +1256,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
return (n);
}
n++;
+ maybe_quit ();
}
while (n > 0)
{
regex.c calls maybe_quit internally, so why do we need this additional
call?
@@ -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);
This can quit without calling r_alloc_inhibit_buffer_relocation, which
will leave ralloc.c in a state where it doesn't do relocations, which
is a crash waiting to happen.
@@ -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. */
scan_newline calls maybe_quit internally, so the call to
incr_rarely_quit shouldn't be necessary, I think.
@@ -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);
+
Is it safe to quit from back_comment? It manipulates a global
variable gl_state, and I don't see unwind-protect calls anywhere in
sight.
@@ -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. */
Same here (and in a few more places in scan_words where you added such
calls).
@@ -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);
}
Same here.
Same issue in forw_comment and in scan_lists.
@@ -10445,30 +10433,12 @@ handle_interrupt (bool in_signal_handler)
}
else
{
- /* If executing a function that wants to be interrupted out of
- and the user has not deferred quitting by binding `inhibit-quit'
- then quit right away. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- struct gl_state_s saved;
-
- immediate_quit = false;
- pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
- saved = gl_state;
- quit ();
- gl_state = saved;
- }
- else
- { /* Else request quit when it's safe. */
- int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
- force_quit_count = count;
- if (count == 3)
- {
- immediate_quit = true;
- Vinhibit_quit = Qnil;
- }
- Vquit_flag = Qt;
- }
+ /* Request quit when it's safe. */
+ int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
+ force_quit_count = count;
+ if (count == 3)
+ Vinhibit_quit = Qnil;
+ Vquit_flag = Qt;
}
This loses the feature whereby C-g on a TTY would quit much faster.
Why is this a good idea? And if it is a good idea, why do we still
generate SIGINT on C-g (and force GDB to handle SIGINT specially to
support that)?
Thanks again for working on this.
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-30 15:33 ` Eli Zaretskii
@ 2017-01-30 21:52 ` Paul Eggert
2017-01-31 15:48 ` Eli Zaretskii
0 siblings, 1 reply; 13+ messages in thread
From: Paul Eggert @ 2017-01-30 21:52 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: monnier, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 4952 bytes --]
Thanks for reviewing the patches. I installed the little patch for delq
as that's relatively independent and was not commented on. Attached is a
revised set of patches. The first two of are the same as before
(rebased), and the third patch attempts to address several of your
comments directly. The other comments are remarked on below.
On 01/30/2017 07:33 AM, Eli Zaretskii wrote:
> I don't understand why we need both this and
> emacs_read, which cannot be interrupted. Why not have just emacs_read
> which can be interrupted, and use that all over?
For example, filelock.c's read_lock_data opens a file, uses emacs_read
to read it, and then closes the file. If read_lock_data used
emacs_read_quit it might process a quit, which would skip the close and
leak a file descriptor.
The read_lock_data issue could be fixed by having it call
record_unwind_protect_int (close_file_unwind, fd) before calling
emacs_read. Possibly all these dicey uses of emacs_read could be fixed
in a similar way. However, that would be a bigger and more-intrusive
change, and in the read_lock_data case it arguably would be overkill and
I wanted to keep the patch smaller. I used emacs_read_quit only in
places that I verified were safe, and stuck with emacs_read when I
wasn't sure, or where more-intrusive changes would be needed.
>
> @@ -1252,6 +1256,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
> return (n);
> }
> n++;
> + maybe_quit ();
> }
> while (n > 0)
> {
>
> regex.c calls maybe_quit internally, so why do we need this additional
> call?
The regex code does not always call maybe_quit. For example, without
this additional call, (re-search-forward "[[:alpha:]]" nil nil
most-positive-fixnum) would loop indefinitely in a buffer containing
only alphabetic characters on a 64-bit platform.
> @@ -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);
> +
>
> Is it safe to quit from back_comment? It manipulates a global
> variable gl_state, and I don't see unwind-protect calls anywhere in
> sight.
It should be OK. The current master sets immediate_quit=true in
back_comment's callers (both scan_lists and Fforward_comment), so
current master already lets back_comment quit. If Emacs quits in
back_comment, it should longjmp to code that reinitializes gl_state
before using it. This also applies to the other places you mentioned.
The idea is to insert maybe_quit calls in code that was already subject
to immediate_quit=true in the current master, so it should be safe to quit.
> @@ -10445,30 +10433,12 @@ handle_interrupt (bool in_signal_handler)
> }
> else
> {
> - /* If executing a function that wants to be interrupted out of
> - and the user has not deferred quitting by binding `inhibit-quit'
> - then quit right away. */
> - if (immediate_quit && NILP (Vinhibit_quit))
> - {
> - struct gl_state_s saved;
> -
> - immediate_quit = false;
> - pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
> - saved = gl_state;
> - quit ();
> - gl_state = saved;
> - }
> - else
> - { /* Else request quit when it's safe. */
> - int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
> - force_quit_count = count;
> - if (count == 3)
> - {
> - immediate_quit = true;
> - Vinhibit_quit = Qnil;
> - }
> - Vquit_flag = Qt;
> - }
> + /* Request quit when it's safe. */
> + int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
> + force_quit_count = count;
> + if (count == 3)
> + Vinhibit_quit = Qnil;
> + Vquit_flag = Qt;
> }
>
> This loses the feature whereby C-g on a TTY would quit much faster.
> Why is this a good idea?
Speed is not a problem, as C-g (with the proposed changes) should quit
just as fast on a TTY as it already does under X, and it's been working
that way under X for some time. The good idea here is to simplify the
analysis of C code, so that reviewers no longer have to worry about
random asynchronous longjmps that depend on settings of global
variables, something that is a real pain to reason about. Instead,
quitting will work the same on a TTY as it does on a GUI, making
maintenance easier overall.
> And if it is a good idea, why do we still
> generate SIGINT on C-g (and force GDB to handle SIGINT specially to
> support that)?
Inertia, I think. Having C-g generate SIGINT made sense when we had
immediate_quit. I expect that it is a useless appendage now, and that in
a later patch we can change Emacs so that C-g no longer generates SIGINT
but is instead processed like any other input character.
[-- Attachment #2: 0001-Remove-immediate_quit.patch --]
[-- Type: application/x-patch, Size: 34434 bytes --]
[-- Attachment #3: 0002-Revamp-quitting-and-fix-infloops.patch --]
[-- Type: application/x-patch, Size: 49937 bytes --]
[-- Attachment #4: 0003-Fix-quitting-bug-when-buffers-are-frozen.patch --]
[-- Type: application/x-patch, Size: 16986 bytes --]
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-30 21:52 ` Paul Eggert
@ 2017-01-31 15:48 ` Eli Zaretskii
2017-01-31 16:31 ` Stefan Monnier
2017-01-31 16:59 ` Paul Eggert
0 siblings, 2 replies; 13+ messages in thread
From: Eli Zaretskii @ 2017-01-31 15:48 UTC (permalink / raw)
To: Paul Eggert; +Cc: monnier, emacs-devel
> Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Mon, 30 Jan 2017 13:52:46 -0800
>
> I don't understand why we need both this and
> emacs_read, which cannot be interrupted. Why not have just emacs_read
> which can be interrupted, and use that all over?
>
> For example, filelock.c's read_lock_data opens a file, uses emacs_read to read it, and then closes the file. If read_lock_data used emacs_read_quit it might process a quit, which would skip the close and leak a file descriptor.
>
> The read_lock_data issue could be fixed by having it call record_unwind_protect_int (close_file_unwind, fd) before calling emacs_read. Possibly all these dicey uses of emacs_read could be fixed in a similar way. However, that would be a bigger and more-intrusive change, and in the read_lock_data case it arguably would be overkill and I wanted to keep the patch smaller. I used emacs_read_quit only in places that I verified were safe, and stuck with emacs_read when I wasn't sure, or where more-intrusive changes would be needed.
I indeed think that we should make emacs_read support quitting, and
add unwind_protect calls where we currently don't. This should be
safer in the long run, and also simpler. As for overhead, operations
like locking a file should indeed normally be very fast, but could
take perceptible time in some exceptional conditions, like networked
volumes or high I/O load, in which case users may wish to interrupt
that.
But yes, this could be done as a separate changeset.
> @@ -1252,6 +1256,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
> ptrdiff_t pos_byte,
> return (n);
> }
> n++;
> + maybe_quit ();
> }
> while (n > 0)
> {
> regex.c calls maybe_quit internally, so why do we need this additional
> call?
>
> The regex code does not always call maybe_quit. For example, without this additional call, (re-search-forward "[[:alpha:]]" nil nil most-positive-fixnum) would loop indefinitely in a buffer containing only alphabetic characters on a 64-bit platform.
Then maybe we should add maybe_quit calls in regex.c instead?
Currently, immediate_quit is non-zero all the time re_search_2 runs,
so on a TTY a C-g will can stop regex.c in its tracks anywhere. I
thought we wanted to make GUI sessions as responsive as TTY sessions.
> @@ -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);
> +
>
> Is it safe to quit from back_comment? It manipulates a global
> variable gl_state, and I don't see unwind-protect calls anywhere in
> sight.
>
> It should be OK. The current master sets immediate_quit=true in back_comment's callers (both scan_lists and Fforward_comment), so current master already lets back_comment quit.
Yes, but that is why we have gl_state-related dance in
handle_interrupt, and your changes delete that part.
> If Emacs quits in back_comment, it should longjmp to code that reinitializes gl_state before using it.
But unwinding the Lisp stack could run some Lisp that uses syntax.c
functions, before we longjmp, right?
> This also applies to the other places you mentioned. The idea is to insert maybe_quit calls in code that was already subject to immediate_quit=true in the current master, so it should be safe to quit.
That assumes all the immediate_quit=true settings were safe.
Previously, they were only in effect on TTY frames, whereas now the
maybe_quit calls will be in effect everywhere, so their exposure to
various use cases will be much wider. That's why I think it's prudent
to take a good look at these places while we make these changes.
But I don't feel I know enough about this aspect of syntax.c. Stefan,
can you comment on this, please?
> @@ -10445,30 +10433,12 @@ handle_interrupt (bool in_signal_handler)
> }
> else
> {
> - /* If executing a function that wants to be interrupted out of
> - and the user has not deferred quitting by binding `inhibit-quit'
> - then quit right away. */
> - if (immediate_quit && NILP (Vinhibit_quit))
> - {
> - struct gl_state_s saved;
> -
> - immediate_quit = false;
> - pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
> - saved = gl_state;
> - quit ();
> - gl_state = saved;
> - }
> - else
> - { /* Else request quit when it's safe. */
> - int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
> - force_quit_count = count;
> - if (count == 3)
> - {
> - immediate_quit = true;
> - Vinhibit_quit = Qnil;
> - }
> - Vquit_flag = Qt;
> - }
> + /* Request quit when it's safe. */
> + int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
> + force_quit_count = count;
> + if (count == 3)
> + Vinhibit_quit = Qnil;
> + Vquit_flag = Qt;
> }
>
> This loses the feature whereby C-g on a TTY would quit much faster.
> Why is this a good idea?
>
> Speed is not a problem, as C-g (with the proposed changes) should quit just as fast on a TTY as it already does under X, and it's been working that way under X for some time.
No, it will be slower. A signal handler will always react faster than
any solution based on polling. A signal handler is also capable of
interrupting calls to standard C library functions.
It is true that we already have this issue on GUI frames, but I still
feel uneasy about losing this feature. TTY frames are still quite
popular, even today, in particular for remote sessions.
What do others think about this?
> And if it is a good idea, why do we still
> generate SIGINT on C-g (and force GDB to handle SIGINT specially to
> support that)?
>
> Inertia, I think. Having C-g generate SIGINT made sense when we had immediate_quit. I expect that it is a useless appendage now, and that in a later patch we can change Emacs so that C-g no longer generates SIGINT but is instead processed like any other input character.
No, I don't think we can remove the SIGINT generation: if we do, there
will be nothing to set the quit-flag on TTY frames. Also, the
"emergency exit" feature is also based on SIGINT.
The new patches still include both rarely_quit and incr_rarely_quit
(in the second patchset), which I thought you decided to remove. Did
you send the correct patches?
Thanks.
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-31 15:48 ` Eli Zaretskii
@ 2017-01-31 16:31 ` Stefan Monnier
2017-01-31 16:59 ` Paul Eggert
1 sibling, 0 replies; 13+ messages in thread
From: Stefan Monnier @ 2017-01-31 16:31 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Paul Eggert, emacs-devel
>>> regex.c calls maybe_quit internally, so why do we need this
>>> additional call?
>>
>> The regex code does not always call maybe_quit. For example, without
>> this additional call, (re-search-forward "[[:alpha:]]" nil nil
>> most-positive-fixnum) would loop indefinitely in a buffer containing
>> only alphabetic characters on a 64-bit platform.
>
> Then maybe we should add maybe_quit calls in regex.c instead?
FWIW, in the case or (re-search-forward "[[:alpha:]]" nil nil
most-positive-fixnum) the regexp matches themselves are constant-time
operations, repeated in search.c, so it makes sense to put the maybe_quit
in search.c rather than in regexp.c.
Clearly both options will/would work, but I think the general design of
maybe_quit is that we should not need to put one in code whose runtime
is constant. IOW the maybe_quit calls should be on the backward-edges
of loops which means that running a loop a single time may but does not
need to call maybe_quit.
Stefan
^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-31 15:48 ` Eli Zaretskii
2017-01-31 16:31 ` Stefan Monnier
@ 2017-01-31 16:59 ` Paul Eggert
1 sibling, 0 replies; 13+ messages in thread
From: Paul Eggert @ 2017-01-31 16:59 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: monnier, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 3122 bytes --]
On 01/31/2017 07:48 AM, Eli Zaretskii wrote:
> Then maybe we should add maybe_quit calls in regex.c instead?
We already have them there, everywhere that the regex code could do a
lot of computation. In places where it's fast and bounded, we don't have
them as they would slow things down.
> Currently, immediate_quit is non-zero all the time re_search_2 runs,
> so on a TTY a C-g will can stop regex.c in its tracks anywhere. I
> thought we wanted to make GUI sessions as responsive as TTY sessions.
That has not been my goal. C-g in GUI sessions is already plenty fast
enough for human interaction. (If they are not, we should fix that; but
I don't know of any bugs in the regexp-searching area.) Whatever way we
do it, treating GUI and TTY sessions the same as far as quitting goes
simplifies maintenance significantly.
>
>> It should be OK. The current master sets immediate_quit=true in back_comment's callers (both scan_lists and Fforward_comment), so current master already lets back_comment quit.
> Yes, but that is why we have gl_state-related dance in
> handle_interrupt, and your changes delete that part.
That gl_state-related dance is present only because 'quit ()' can return
instead of quitting, which means that the code could asynchronously
reenter the regexp code. Since that call to 'quit' is no longer present,
that sort of reentry is no longer possible, and we don't need the dance.
>
>> If Emacs quits in back_comment, it should longjmp to code that reinitializes gl_state before using it.
> But unwinding the Lisp stack could run some Lisp that uses syntax.c
> functions, before we longjmp, right?
No, because the interruptible regexp code does not call Lisp code: it
does not try to reenter itself.
> That assumes all the immediate_quit=true settings were safe.
That sort of thing has been in Emacs for ages, and I daresay it's been
tested at least as well as, if not even more than, the GUI approach to
quitting searching. When I was using Emacs in the 1980s computers were
not nearly as fast and people's keystrokes were just as fast as they are
now. So it's reasonable to place some confidence in those settings.
Quite possibly we could make improvements in this area later, but it's
conservative to stick with those settings for now.
> Speed is not a problem, as C-g (with the proposed changes) should quit just as fast on a TTY as it already does under X, and it's been working that way under X for some time.
> No, it will be slower.
Apparently I was not clear enough. I was not saying that the change
won't delay C-g handling in ttys; obviously it will. All I was saying is
that C-g will be handled as fast on ttys as it is on GUIs, which is good
enough.
> The new patches still include both rarely_quit and incr_rarely_quit
> (in the second patchset), which I thought you decided to remove. Did
> you send the correct patches?
Yes, the third patch removed incr_rarely_quit. I'm not a big fan of
rewriting history. For your convenience I've attached a combined patch,
that's just all the patches squashed together so that there isn't any
incr_rarely_quit.
[-- Attachment #2: quit.diff --]
[-- Type: text/x-patch, Size: 69953 bytes --]
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty
index b58180e..d0096ad 100644
--- a/admin/notes/multi-tty
+++ b/admin/notes/multi-tty
@@ -1239,9 +1239,8 @@ DIARY OF CHANGES
(Update: OK, it all seems so easy now (NOT). Input could be done
synchronously (with wait_reading_process_input), or asynchronously
by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag,
- signals a 'quit condition (when immediate_quit), or throws to
- 'getcjmp' when Emacs was waiting for input when the C-g event
- arrived.)
+ signals a 'quit condition, or throws to 'getcjmp' when Emacs was
+ waiting for input when the C-g event arrived.)
-- Replace wrong_kboard_jmpbuf with a special return value of
read_char. It is absurd that we use setjmp/longjmp just to return
diff --git a/src/alloc.c b/src/alloc.c
index b59220c..e909d31 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -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;
diff --git a/src/bytecode.c b/src/bytecode.c
index 499fb88..0f7420c 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -841,11 +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);
- immediate_quit = true;
- while (--n >= 0 && CONSP (v2))
- v2 = XCDR (v2);
- immediate_quit = false;
+ for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--)
+ {
+ v2 = XCDR (v2);
+ rarely_quit (n);
+ }
TOP = CAR (v2);
NEXT;
}
@@ -1275,11 +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);
- immediate_quit = true;
- while (--n >= 0 && CONSP (v1))
- v1 = XCDR (v1);
- immediate_quit = false;
+ for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
+ {
+ v1 = XCDR (v1);
+ rarely_quit (n);
+ }
TOP = CAR (v1);
}
else
diff --git a/src/callproc.c b/src/callproc.c
index 301ccf3..84324c4 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,11 +198,11 @@ 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)");
- immediate_quit = true;
- maybe_quit ();
+
+ /* This will quit on C-g. */
wait_for_termination (synch_process_pid, 0, 1);
+
synch_process_pid = 0;
- immediate_quit = false;
message1 ("Waiting for process to die...done");
}
#endif /* !MSDOS */
@@ -726,9 +726,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
process_coding.src_multibyte = 0;
}
- immediate_quit = true;
- maybe_quit ();
-
if (0 <= fd0)
{
enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
@@ -749,8 +746,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;
@@ -769,7 +766,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
}
/* Now NREAD is the total amount of data in the buffer. */
- immediate_quit = false;
if (!nread)
;
@@ -842,8 +838,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
we should have already detected a coding system. */
display_on_the_fly = true;
}
- immediate_quit = true;
- maybe_quit ();
}
give_up: ;
@@ -860,8 +854,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
wait_for_termination (pid, &status, fd0 < 0);
#endif
- immediate_quit = false;
-
/* Don't kill any children that the subprocess may have left behind
when exiting. */
synch_process_pid = 0;
diff --git a/src/dired.c b/src/dired.c
index 52e81fb..5ea00fb 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -248,14 +248,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
- immediate_quit = true;
maybe_quit ();
bool wanted = (NILP (match)
|| re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
- immediate_quit = false;
-
if (wanted)
{
if (!NILP (full))
diff --git a/src/doc.c b/src/doc.c
index 361d09a..1e7e3fc 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -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)
diff --git a/src/editfns.c b/src/editfns.c
index 82c6abb..4618164 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3053,7 +3053,6 @@ determines whether case is significant or ignored. */)
i2 = begp2;
i1_byte = buf_charpos_to_bytepos (bp1, i1);
i2_byte = buf_charpos_to_bytepos (bp2, i2);
- immediate_quit = true;
while (i1 < endp1 && i2 < endp2)
{
@@ -3092,17 +3091,14 @@ determines whether case is significant or ignored. */)
c1 = char_table_translate (trt, c1);
c2 = char_table_translate (trt, c2);
}
+
if (c1 != c2)
- {
- immediate_quit = false;
- return make_number (c1 < c2 ? -1 - chars : chars + 1);
- }
+ return make_number (c1 < c2 ? -1 - chars : chars + 1);
chars++;
+ rarely_quit (chars);
}
- immediate_quit = false;
-
/* The strings match as far as they go.
If one is shorter, that one is less. */
if (chars < endp1 - begp1)
diff --git a/src/eval.c b/src/eval.c
index 62d4af1..22b02b4 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1131,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
unblock_input_to (catch->interrupt_input_blocked);
- immediate_quit = false;
do
{
@@ -1462,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)
{
@@ -1517,7 +1529,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
Lisp_Object clause = Qnil;
struct handler *h;
- immediate_quit = false;
if (gc_in_progress || waiting_for_input)
emacs_abort ();
diff --git a/src/fileio.c b/src/fileio.c
index a46cfc7..3840062 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1960,9 +1960,7 @@ permissions. */)
report_file_error ("Copying permissions to", newname);
}
#else /* not WINDOWSNT */
- immediate_quit = true;
ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
- immediate_quit = false;
if (ifd < 0)
report_file_error ("Opening input file", file);
@@ -2024,7 +2022,6 @@ permissions. */)
oldsize = out_st.st_size;
}
- immediate_quit = true;
maybe_quit ();
if (clone_file (ofd, ifd))
@@ -2033,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);
@@ -2047,8 +2044,6 @@ permissions. */)
if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
report_file_error ("Truncating output file", newname);
- immediate_quit = false;
-
#ifndef MSDOS
/* Preserve the original file permissions, and if requested, also its
owner and group. */
@@ -3401,15 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data)
static Lisp_Object
read_non_regular (Lisp_Object state)
{
- int nbytes;
-
- immediate_quit = true;
- maybe_quit ();
- nbytes = emacs_read (XSAVE_INTEGER (state, 0),
- ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
- + XSAVE_INTEGER (state, 1)),
- XSAVE_INTEGER (state, 2));
- immediate_quit = false;
+ 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);
@@ -3753,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;
}
}
@@ -3868,15 +3858,11 @@ by calling `format-decode', which see. */)
report_file_error ("Setting file position", orig_filename);
}
- immediate_quit = true;
- 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)
@@ -3898,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++;
@@ -3907,7 +3893,6 @@ by calling `format-decode', which see. */)
if (bufpos != nread)
break;
}
- immediate_quit = false;
/* If the file matches the buffer completely,
there's no need to replace anything. */
if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
@@ -3919,8 +3904,7 @@ by calling `format-decode', which see. */)
del_range_1 (same_at_start, same_at_end, 0, 0);
goto handled;
}
- immediate_quit = true;
- 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. */
@@ -3942,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)
@@ -3977,7 +3962,6 @@ by calling `format-decode', which see. */)
if (nread == 0)
break;
}
- immediate_quit = false;
if (! giveup_match_end)
{
@@ -4069,18 +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. */
- immediate_quit = true;
- maybe_quit ();
- this = emacs_read (fd, read_buf + unprocessed,
- READ_BUF_SIZE - unprocessed);
- immediate_quit = false;
-
+ this = emacs_read_quit (fd, read_buf + unprocessed,
+ READ_BUF_SIZE - unprocessed);
if (this <= 0)
break;
@@ -4294,13 +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. */
- immediate_quit = true;
- maybe_quit ();
- this = emacs_read (fd,
- ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
- + inserted),
- trytry);
- immediate_quit = false;
+ this = emacs_read_quit (fd,
+ ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ + inserted),
+ trytry);
}
if (this <= 0)
@@ -5002,8 +4978,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
}
}
- immediate_quit = true;
-
if (STRINGP (start))
ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
else if (XINT (start) != XINT (end))
@@ -5026,8 +5000,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
save_errno = errno;
}
- immediate_quit = false;
-
/* fsync is not crucial for temporary files. Nor for auto-save
files, since they might lose some work anyway. */
if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
@@ -5417,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)
{
diff --git a/src/filelock.c b/src/filelock.c
index de65c52..67e8dbd 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -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;
diff --git a/src/fns.c b/src/fns.c
index 136a219..ac7c1f2 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -84,22 +84,6 @@ See Info node `(elisp)Random Numbers' for more details. */)
return make_number (val);
}
\f
-/* 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,20 +1343,17 @@ 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;
- immediate_quit = true;
- for (EMACS_INT i = 0; i < num; i++)
+ for (EMACS_INT num = XINT (n); 0 < num; num--)
{
if (! CONSP (tail))
{
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
tail = XCDR (tail);
+ rarely_quit (num);
}
- immediate_quit = false;
return tail;
}
@@ -1408,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);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1419,17 +1400,14 @@ 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)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (EQ (XCAR (tail), elt))
- {
- immediate_quit = false;
- return tail;
- }
+ return tail;
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1442,18 +1420,15 @@ The value is actually the tail of LIST whose car is ELT. */)
if (!FLOATP (elt))
return Fmemq (elt, list);
- immediate_quit = true;
+ 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))
- {
- immediate_quit = false;
- return tail;
- }
+ return tail;
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1464,15 +1439,14 @@ 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)
{
- immediate_quit = true;
+ 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))
- {
- immediate_quit = false;
+ {
+ if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
return XCAR (tail);
- }
- immediate_quit = false;
+ rarely_quit (++quit_count);
+ }
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1502,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);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1529,15 +1503,14 @@ 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)
{
- immediate_quit = true;
+ 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))
- {
- immediate_quit = false;
+ {
+ if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
return XCAR (tail);
- }
- immediate_quit = false;
+ rarely_quit (++quit_count);
+ }
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1555,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);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1711,7 +1684,7 @@ changing the value of a sequence `foo'. */)
}
else
prev = tail;
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, seq);
}
@@ -1736,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;
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, seq);
seq = prev;
@@ -1785,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);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (seq, seq);
}
@@ -2077,21 +2050,20 @@ 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)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
Lisp_Object prev = Qnil;
for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (EQ (prop, XCAR (tail)))
{
- immediate_quit = false;
Fsetcar (XCDR (tail), val);
return plist;
}
prev = tail;
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
@@ -2128,7 +2100,7 @@ one of the properties on the list. */)
{
if (! NILP (Fequal (prop, XCAR (tail))))
return XCAR (XCDR (tail));
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, prop);
@@ -2158,7 +2130,7 @@ The PLIST is modified by side effects. */)
}
prev = tail;
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
@@ -2238,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);
+ rarely_quit (++quit_count);
if (EQ (o1, o2))
return 1;
if (XTYPE (o1) != XTYPE (o2))
@@ -2442,18 +2414,15 @@ usage: (nconc &rest LISTS) */)
CHECK_CONS (tem);
- immediate_quit = true;
Lisp_Object tail;
do
{
tail = tem;
tem = XCDR (tail);
+ rarely_quit (++quit_count);
}
while (CONSP (tem));
- immediate_quit = false;
- rarely_quit (&quit_count);
-
tem = args[argnum + 1];
Fsetcdr (tail, tem);
if (NILP (tem))
@@ -2874,13 +2843,13 @@ 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)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
while (CONSP (plist) && !EQ (XCAR (plist), prop))
{
plist = XCDR (plist);
plist = CDR (plist);
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
return plist;
}
diff --git a/src/indent.c b/src/indent.c
index 23951a1..f630ebb 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,9 +1200,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
continuation_glyph_width = 0; /* In the fringe. */
#endif
- immediate_quit = true;
- maybe_quit ();
-
/* It's just impossible to be too paranoid here. */
eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
@@ -1214,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)
{
+ rarely_quit (++quit_count);
+
while (pos == next_boundary)
{
ptrdiff_t pos_here = pos;
@@ -1280,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
pos = newpos;
pos_byte = CHAR_TO_BYTE (pos);
}
+
+ rarely_quit (++quit_count);
}
/* Handle right margin. */
@@ -1602,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);
+ rarely_quit (++quit_count);
}
while (pos < to
&& indented_beyond_p (pos, pos_byte,
@@ -1694,7 +1698,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
/* Nonzero if have just continued a line */
val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
- immediate_quit = false;
return &val_compute_motion;
}
diff --git a/src/keyboard.c b/src/keyboard.c
index 0c04d95..a86e7c5 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -169,9 +169,6 @@ struct kboard *echo_kboard;
Lisp_Object echo_message_buffer;
-/* True means C-g should cause immediate error-signal. */
-bool immediate_quit;
-
/* Character that causes a quit. Normally C-g.
If we are running on an ordinary terminal, this must be an ordinary
@@ -3584,16 +3581,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
as input, set quit-flag to cause an interrupt. */
if (!NILP (Vthrow_on_input)
&& NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)))
- {
- Vquit_flag = Vthrow_on_input;
- /* If we're inside a function that wants immediate quits,
- do it now. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- immediate_quit = false;
- maybe_quit ();
- }
- }
+ Vquit_flag = Vthrow_on_input;
}
@@ -7053,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. */
-#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
+ 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
- );
#ifndef USABLE_FIONREAD
#if defined (USG) || defined (CYGWIN)
@@ -10445,30 +10415,12 @@ handle_interrupt (bool in_signal_handler)
}
else
{
- /* If executing a function that wants to be interrupted out of
- and the user has not deferred quitting by binding `inhibit-quit'
- then quit right away. */
- if (immediate_quit && NILP (Vinhibit_quit) && !waiting_for_input)
- {
- struct gl_state_s saved;
-
- immediate_quit = false;
- pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
- saved = gl_state;
- quit ();
- gl_state = saved;
- }
- else
- { /* Else request quit when it's safe. */
- int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
- force_quit_count = count;
- if (count == 3)
- {
- immediate_quit = true;
- Vinhibit_quit = Qnil;
- }
- Vquit_flag = Qt;
- }
+ /* Request quit when it's safe. */
+ int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
+ force_quit_count = count;
+ if (count == 3)
+ Vinhibit_quit = Qnil;
+ Vquit_flag = Qt;
}
pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
@@ -10907,7 +10859,6 @@ init_keyboard (void)
{
/* This is correct before outermost invocation of the editor loop. */
command_loop_level = -1;
- immediate_quit = false;
quit_char = Ctl ('g');
Vunread_command_events = Qnil;
timer_idleness_start_time = invalid_timespec ();
diff --git a/src/lisp.h b/src/lisp.h
index 58e2288..1ac3816 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3123,29 +3123,28 @@ 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.
+extern void maybe_quit (void);
- Exception: if you set immediate_quit, the handler that responds to
- the C-g does the quit itself. This is a good thing to do around a
- loop that has no side effects and (in particular) cannot call
- arbitrary Lisp code.
+/* True if ought to quit now. */
- If quit-flag is set to `kill-emacs' the SIGINT handler has received
- a request to exit Emacs when it is safe to do.
+#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
- When not quitting, process any pending signals. */
+/* 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. */
-extern void maybe_quit (void);
+enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
-/* True if ought to quit now. */
+/* 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). */
-#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
+INLINE void
+rarely_quit (unsigned short int count)
+{
+ if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
+ maybe_quit ();
+}
\f
extern Lisp_Object Vascii_downcase_table;
extern Lisp_Object Vascii_canon_table;
@@ -4221,8 +4220,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);
@@ -4348,9 +4349,6 @@ extern char my_edata[];
extern char my_endbss[];
extern char *my_endbss_static;
-/* True means ^G can quit instantly. */
-extern bool immediate_quit;
-
extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
diff --git a/src/lread.c b/src/lread.c
index 1780692..094aa62 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -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'
diff --git a/src/process.c b/src/process.c
index dbd4358..434a395 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,7 +3431,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
break;
}
- immediate_quit = true;
maybe_quit ();
ret = connect (s, sa, addrlen);
@@ -3439,8 +3438,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
if (ret == 0 || xerrno == EISCONN)
{
- /* The unwind-protect will be discarded afterwards.
- Likewise for immediate_quit. */
+ /* The unwind-protect will be discarded afterwards. */
break;
}
@@ -3481,8 +3479,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
}
#endif /* !WINDOWSNT */
- immediate_quit = false;
-
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count;
emacs_close (s);
@@ -3539,8 +3535,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
#endif
}
- immediate_quit = false;
-
if (s < 0)
{
/* If non-blocking got this far - and failed - assume non-blocking is
@@ -4012,7 +4006,6 @@ usage: (make-network-process &rest ARGS) */)
struct addrinfo *res, *lres;
int ret;
- immediate_quit = true;
maybe_quit ();
struct addrinfo hints;
@@ -4034,7 +4027,6 @@ usage: (make-network-process &rest ARGS) */)
#else
error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
- immediate_quit = false;
for (lres = res; lres; lres = lres->ai_next)
addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
diff --git a/src/regex.c b/src/regex.c
index f6e67af..796f868 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1728,10 +1728,8 @@ typedef struct
/* Explicit quit checking is needed for Emacs, which uses polling to
process input events. */
-#ifdef emacs
-# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0)
-#else
-# define IMMEDIATE_QUIT_CHECK ((void) 0)
+#ifndef emacs
+static void maybe_quit (void) {}
#endif
\f
/* Structure to manage work area for range table. */
@@ -5820,7 +5818,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
/* Unconditionally jump (without popping any failure points). */
case jump:
unconditional_jump:
- IMMEDIATE_QUIT_CHECK;
+ maybe_quit ();
EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */
DEBUG_PRINT ("EXECUTING jump %d ", mcnt);
p += mcnt; /* Do the jump. */
@@ -6168,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
/* We goto here if a matching operation fails. */
fail:
- IMMEDIATE_QUIT_CHECK;
+ maybe_quit ();
if (!FAIL_STACK_EMPTY ())
{
re_char *str, *pat;
diff --git a/src/search.c b/src/search.c
index f54f44c..33cb02a 100644
--- a/src/search.c
+++ b/src/search.c
@@ -99,6 +99,25 @@ matcher_overflow (void)
error ("Stack overflow in regexp matcher");
}
+static void
+freeze_buffer_relocation (void)
+{
+#ifdef REL_ALLOC
+ /* Prevent ralloc.c from relocating the current buffer while
+ searching it. */
+ r_alloc_inhibit_buffer_relocation (1);
+ record_unwind_protect_int (r_alloc_inhibit_buffer_relocation, 0);
+#endif
+}
+
+static void
+thaw_buffer_relocation (void)
+{
+#ifdef REL_ALLOC
+ unbind_to (SPECPDL_INDEX () - 1, Qnil);
+#endif
+}
+
/* Compile a regexp and signal a Lisp error if anything goes wrong.
PATTERN is the pattern to compile.
CP is the place to put the result.
@@ -277,7 +296,6 @@ looking_at_1 (Lisp_Object string, bool posix)
!NILP (BVAR (current_buffer, enable_multibyte_characters)));
/* Do a pending quit right away, to avoid paradoxical behavior */
- immediate_quit = true;
maybe_quit ();
/* Get pointers and sizes of the two strings
@@ -301,20 +319,13 @@ looking_at_1 (Lisp_Object string, bool posix)
re_match_object = Qnil;
-#ifdef REL_ALLOC
- /* Prevent ralloc.c from relocating the current buffer while
- searching it. */
- r_alloc_inhibit_buffer_relocation (1);
-#endif
+ freeze_buffer_relocation ();
i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
PT_BYTE - BEGV_BYTE,
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL),
ZV_BYTE - BEGV_BYTE);
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
if (i == -2)
matcher_overflow ();
@@ -399,7 +410,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
? BVAR (current_buffer, case_canon_table) : Qnil),
posix,
STRING_MULTIBYTE (string));
- immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
@@ -407,7 +417,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
SBYTES (string) - pos_byte,
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL));
- immediate_quit = false;
/* Set last_thing_searched only when match data is changed. */
if (NILP (Vinhibit_changing_match_data))
@@ -471,13 +480,11 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string,
bufp = compile_pattern (regexp, 0, table,
0, STRING_MULTIBYTE (string));
- immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
SBYTES (string), 0,
SBYTES (string), 0);
- immediate_quit = false;
return val;
}
@@ -498,9 +505,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
bufp = compile_pattern (regexp, 0,
Vascii_canon_table, 0,
0);
- immediate_quit = true;
val = re_search (bufp, string, len, 0, len, 0);
- immediate_quit = false;
return val;
}
@@ -561,18 +566,10 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
}
buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
- immediate_quit = true;
-#ifdef REL_ALLOC
- /* Prevent ralloc.c from relocating the current buffer while
- searching it. */
- r_alloc_inhibit_buffer_relocation (1);
-#endif
+ freeze_buffer_relocation ();
len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2,
pos_byte, NULL, limit_byte);
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
- immediate_quit = false;
+ thaw_buffer_relocation ();
return len;
}
@@ -649,7 +646,7 @@ newline_cache_on_off (struct buffer *buf)
If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding
to the returned character position.
- If ALLOW_QUIT, set immediate_quit. That's good to do
+ If ALLOW_QUIT, check for quitting. That's good to do
except when inside redisplay. */
ptrdiff_t
@@ -685,8 +682,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (shortage != 0)
*shortage = 0;
- immediate_quit = allow_quit;
-
if (count > 0)
while (start != end)
{
@@ -704,7 +699,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = false;
while (start < end && result)
{
ptrdiff_t lim1;
@@ -757,7 +751,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
start_byte = end_byte;
break;
}
- immediate_quit = allow_quit;
/* START should never be after END. */
if (start_byte > ceiling_byte)
@@ -810,11 +803,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
}
+ if (allow_quit)
+ maybe_quit ();
}
start_byte = lim_byte;
@@ -833,7 +827,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = false;
while (start > end && result)
{
ptrdiff_t lim1;
@@ -870,7 +863,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
start_byte = end_byte;
break;
}
- immediate_quit = allow_quit;
/* Start should never be at or before end. */
if (start_byte <= ceiling_byte)
@@ -918,11 +910,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (++count >= 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = ceiling_byte + prev + 1;
return BYTE_TO_CHAR (ceiling_byte + prev + 1);
}
+ if (allow_quit)
+ maybe_quit ();
}
start_byte = ceiling_byte;
@@ -930,7 +923,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
}
}
- immediate_quit = false;
if (shortage)
*shortage = count * direction;
if (bytepos)
@@ -954,7 +946,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
the number of line boundaries left unfound, and position at
the limit we bumped up against.
- If ALLOW_QUIT, set immediate_quit. That's good to do
+ If ALLOW_QUIT, check for quitting. That's good to do
except in special cases. */
ptrdiff_t
@@ -1197,9 +1189,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
trt, posix,
!NILP (BVAR (current_buffer, enable_multibyte_characters)));
- immediate_quit = true; /* Quit immediately if user types ^G,
- because letting this function finish
- can take too long. */
maybe_quit (); /* Do a pending quit right away,
to avoid paradoxical behavior */
/* Get pointers and sizes of the two strings
@@ -1222,11 +1211,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
}
re_match_object = Qnil;
-#ifdef REL_ALLOC
- /* Prevent ralloc.c from relocating the current buffer while
- searching it. */
- r_alloc_inhibit_buffer_relocation (1);
-#endif
+ freeze_buffer_relocation ();
while (n < 0)
{
@@ -1268,13 +1253,11 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
}
else
{
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
return (n);
}
n++;
+ maybe_quit ();
}
while (n > 0)
{
@@ -1313,18 +1296,13 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
}
else
{
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
return (0 - n);
}
n--;
+ maybe_quit ();
}
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
return (pos);
}
else /* non-RE case */
@@ -3231,8 +3209,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (shortage != 0)
*shortage = 0;
- immediate_quit = allow_quit;
-
if (count > 0)
while (start != end)
{
@@ -3275,11 +3251,12 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
}
+ if (allow_quit)
+ maybe_quit ();
}
start_byte = lim_byte;
@@ -3287,7 +3264,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
}
}
- immediate_quit = false;
if (shortage)
*shortage = count;
if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index f9e4093..7aa43e6 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -621,11 +621,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... */
@@ -715,6 +713,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 +723,8 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
that determines quote parity to the comment-end. */
while (from != stop)
{
+ rarely_quit (++quit_count);
+
ptrdiff_t temp_byte;
int prev_syntax;
bool com2start, com2end, comstart;
@@ -951,7 +952,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);
+ rarely_quit (++quit_count);
+ }
+ while (defun_start < comment_end);
from_byte = CHAR_TO_BYTE (from);
UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
@@ -1417,29 +1420,23 @@ 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;
- immediate_quit = true;
- maybe_quit ();
-
SETUP_SYNTAX_TABLE (from, count);
while (count > 0)
{
- while (1)
+ while (true)
{
if (from == end)
- {
- immediate_quit = false;
- return 0;
- }
+ return 0;
UPDATE_SYNTAX_TABLE_FORWARD (from);
ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
@@ -1449,6 +1446,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. */
@@ -1477,19 +1475,17 @@ 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)
- {
- immediate_quit = false;
- return 0;
- }
+ return 0;
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -1499,6 +1495,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. */
@@ -1531,13 +1528,12 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
break;
}
ch1 = ch0;
+ rarely_quit (from);
}
}
count++;
}
- immediate_quit = false;
-
return from;
}
@@ -1921,7 +1917,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
}
- immediate_quit = true;
/* This code may look up syntax tables using functions that rely on the
gl_state object. To make sure this object is not out of date,
let's initialize it manually.
@@ -1971,9 +1966,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)
{
@@ -1995,15 +1991,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)
@@ -2011,8 +2006,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))
@@ -2036,9 +2034,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)
{
@@ -2060,11 +2059,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
break;
back_unibyte_ok:
p--, pos--, pos_byte--;
+ rarely_quit (pos);
}
}
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = false;
SAFE_FREE ();
return make_number (PT - start_point);
@@ -2138,7 +2137,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p, *endp, *stop;
- immediate_quit = true;
SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
if (forwardp)
@@ -2167,6 +2165,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);
@@ -2183,10 +2182,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)
@@ -2195,17 +2192,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)
{
@@ -2218,13 +2220,13 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
if (! fastmap[SYNTAX (p[-1])])
break;
p--, pos--, pos_byte--;
+ rarely_quit (pos);
}
}
}
done:
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = false;
return make_number (PT - start_point);
}
@@ -2286,9 +2288,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;
@@ -2380,6 +2383,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
UPDATE_SYNTAX_TABLE_FORWARD (from);
nesting++;
}
+
+ rarely_quit (++quit_count);
}
*charpos_ptr = from;
*bytepos_ptr = from_byte;
@@ -2407,14 +2412,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;
- immediate_quit = true;
- maybe_quit ();
-
from = PT;
from_byte = PT_BYTE;
@@ -2429,7 +2432,6 @@ between them, return t; otherwise return nil. */)
if (from == stop)
{
SET_PT_BOTH (from, from_byte);
- immediate_quit = false;
return Qnil;
}
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2456,6 +2458,7 @@ between them, return t; otherwise return nil. */)
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
+ rarely_quit (++quit_count);
}
while (code == Swhitespace || (code == Sendcomment && c == '\n'));
@@ -2463,7 +2466,6 @@ between them, return t; otherwise return nil. */)
comstyle = ST_COMMENT_STYLE;
else if (code != Scomment)
{
- immediate_quit = false;
DEC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
@@ -2474,7 +2476,6 @@ between them, return t; otherwise return nil. */)
from = out_charpos; from_byte = out_bytepos;
if (!found)
{
- immediate_quit = false;
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2486,23 +2487,19 @@ 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);
- immediate_quit = false;
return Qnil;
}
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);
@@ -2545,6 +2542,7 @@ between them, return t; otherwise return nil. */)
}
else if (from == stop)
break;
+ rarely_quit (++quit_count);
}
if (fence_found == 0)
{
@@ -2587,18 +2585,18 @@ between them, return t; otherwise return nil. */)
else if (code != Swhitespace || quoted)
{
leave:
- immediate_quit = false;
INC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
+
+ rarely_quit (++quit_count);
}
count1++;
}
SET_PT_BOTH (from, from_byte);
- immediate_quit = false;
return Qt;
}
\f
@@ -2632,6 +2630,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;
@@ -2640,7 +2639,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
from_byte = CHAR_TO_BYTE (from);
- immediate_quit = true;
maybe_quit ();
SETUP_SYNTAX_TABLE (from, count);
@@ -2648,6 +2646,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
{
while (from < stop)
{
+ rarely_quit (++quit_count);
bool comstart_first, prefix;
int syntax, other_syntax;
UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -2716,6 +2715,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
goto done;
}
INC_BOTH (from, from_byte);
+ rarely_quit (++quit_count);
}
goto done;
@@ -2787,6 +2787,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);
+ rarely_quit (++quit_count);
}
INC_BOTH (from, from_byte);
if (!depth && sexpflag) goto done;
@@ -2801,7 +2802,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = false;
return Qnil;
/* End of object reached */
@@ -2813,11 +2813,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
{
while (from > stop)
{
- int syntax;
+ 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;
@@ -2889,6 +2889,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
default: goto done2;
}
DEC_BOTH (from, from_byte);
+ rarely_quit (++quit_count);
}
goto done2;
@@ -2951,13 +2952,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if (syntax_multibyte (c, multibyte_symbol_p) == code)
break;
}
+ 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;
@@ -2971,6 +2973,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
== Sstring))
break;
}
+ rarely_quit (++quit_count);
}
if (!depth && sexpflag) goto done2;
break;
@@ -2984,7 +2987,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = false;
return Qnil;
done2:
@@ -2992,7 +2994,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
}
- immediate_quit = false;
XSETFASTINT (val, from);
return val;
@@ -3085,6 +3086,7 @@ the prefix syntax flag (p). */)
if (pos <= beg)
break;
DEC_BOTH (pos, pos_byte);
+ rarely_quit (pos);
}
SET_PT_BOTH (opoint, opoint_byte);
@@ -3155,6 +3157,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;
@@ -3173,7 +3176,6 @@ do { prev_from = from; \
UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
- immediate_quit = true;
maybe_quit ();
depth = state->depth;
@@ -3225,6 +3227,7 @@ do { prev_from = from; \
while (from < end)
{
+ rarely_quit (++quit_count);
INC_FROM;
if ((from < end)
@@ -3281,6 +3284,7 @@ do { prev_from = from; \
goto symdone;
}
INC_FROM;
+ rarely_quit (++quit_count);
}
symdone:
curlevel->prev = curlevel->last;
@@ -3391,6 +3395,7 @@ do { prev_from = from; \
break;
}
INC_FROM;
+ rarely_quit (++quit_count);
}
}
string_end:
@@ -3432,7 +3437,6 @@ do { prev_from = from; \
state->levelstarts);
state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
|| state->quoted) ? prev_from_syntax : Smax;
- immediate_quit = false;
}
/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/sysdep.c b/src/sysdep.c
index e172dc0..91b2a5c 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)
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, process any quits and pending signals immediately
+ if INTERRUPTIBLE, and then retry the read unless quitting.
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_intr_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_intr_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_intr_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)
+ if (errno != EINTR)
+ break;
+
+ if (interruptible)
{
- /* 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)
+ if (0 < interruptible)
+ maybe_quit ();
+ if (pending_signals)
process_pending_signals ();
- continue;
}
- else
- break;
}
-
- buf += n;
- nbyte -= n;
- bytes_written += n;
+ 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 fd, void const *buf, ptrdiff_t nbyte)
+{
+ return emacs_full_write (fd, buf, nbyte, 0);
+}
+
+/* Like emacs_write, but also process pending signals. */
ptrdiff_t
-emacs_write (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, 0);
+ return emacs_full_write (fd, buf, nbyte, -1);
}
-/* Like emacs_write, but also process pending signals if interrupted. */
+/* Like emacs_write, but also process quits and pending signals. */
ptrdiff_t
-emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte)
+emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte)
{
- return emacs_full_write (fildes, buf, nbyte, 1);
+ 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)
diff --git a/src/w32fns.c b/src/w32fns.c
index 6a576fc..1b628b0 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -3168,16 +3168,7 @@ signal_user_input (void)
Vquit_flag = Vthrow_on_input;
/* Calling maybe_quit from this thread is a bad idea, since this
unwinds the stack of the Lisp thread, and the Windows runtime
- rightfully barfs. Disabled. */
-#if 0
- /* If we're inside a function that wants immediate quits,
- do it now. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- immediate_quit = false;
- maybe_quit ();
- }
-#endif
+ rightfully barfs. */
}
}
diff --git a/src/window.c b/src/window.c
index 71a82b5..bc3f488 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4770,7 +4770,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
{
ptrdiff_t count = SPECPDL_INDEX ();
- immediate_quit = true;
n = clip_to_bounds (INT_MIN, n, INT_MAX);
wset_redisplay (XWINDOW (window));
@@ -4789,7 +4788,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
/* Bug#15957. */
XWINDOW (window)->window_end_valid = false;
- immediate_quit = false;
}
^ permalink raw reply related [flat|nested] 13+ messages in thread
* Re: [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit
2017-01-26 13:40 ` [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit Stefan Monnier
2017-01-26 17:45 ` Paul Eggert
@ 2017-02-02 0:01 ` Paul Eggert
1 sibling, 0 replies; 13+ messages in thread
From: Paul Eggert @ 2017-02-02 0:01 UTC (permalink / raw)
To: Stefan Monnier, emacs-devel
On 01/26/2017 05:40 AM, Stefan Monnier wrote:
> for circular lists a better solution is to use the hare&tortoise, e.g. with FOR_EACH_TAIL.
OK, after installing the patches that I circulated earlier, I submitted
bug reports containing two draft patches to use hare&tortoise and
FOR_EACH_TAIL instead of maybe_quit, when possible.
The patch in Bug#25605 improves FOR_EACH_TAIL to fix its FIXMEs and to
switch to Brent's teleporting-tortoise algorithm, which is faster than
Floyd's plodding tortoise.
The patch in Bug#25606 changes functions like 'length' and 'member' so
that they use FOR_EACH_TAIL to signal loop cycles, rather than wait for
the user to type C-g. Alternatively, functions like 'member' could
simply return nil when they discover a cycle; however, in practice I
think it's probably better to signal.
^ permalink raw reply [flat|nested] 13+ messages in thread
end of thread, other threads:[~2017-02-02 0:01 UTC | newest]
Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <20170126052541.29089.5382@vcs.savannah.gnu.org>
[not found] ` <20170126052542.828422201BC@vcs.savannah.gnu.org>
2017-01-26 13:40 ` [Emacs-diffs] master 1392ec7 2/3: A quicker check for quit Stefan Monnier
2017-01-26 17:45 ` Paul Eggert
2017-01-26 20:02 ` Eli Zaretskii
2017-01-29 17:30 ` Eli Zaretskii
2017-01-29 17:47 ` Stefan Monnier
2017-01-29 20:16 ` Eli Zaretskii
2017-01-29 23:05 ` Paul Eggert
2017-01-30 15:33 ` Eli Zaretskii
2017-01-30 21:52 ` Paul Eggert
2017-01-31 15:48 ` Eli Zaretskii
2017-01-31 16:31 ` Stefan Monnier
2017-01-31 16:59 ` Paul Eggert
2017-02-02 0:01 ` Paul Eggert
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).