Mercurial > hg > xemacs-beta
annotate src/signal.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +0000 |
| parents | 9410323e4b0d |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 428 | 1 /* Handling asynchronous signals. |
| 2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 5038 | 3 Copyright (C) 1995, 1996, 2001, 2002, 2004, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not synched with FSF. Split out of keyboard.c. */ | |
| 23 | |
| 24 #include <config.h> | |
| 25 #include "lisp.h" | |
| 26 | |
| 27 #include "console.h" | |
| 872 | 28 #include "device-impl.h" |
| 428 | 29 #include "events.h" /* for signal_fake_event() */ |
| 872 | 30 #include "frame-impl.h" |
| 593 | 31 #include "process.h" |
| 611 | 32 |
| 428 | 33 #include "sysdep.h" |
| 611 | 34 #include "sysfile.h" |
| 428 | 35 #include "syssignal.h" |
| 36 #include "systime.h" | |
| 37 | |
| 38 /* Set to 1 when a quit-check signal (either a SIGIO interrupt or | |
| 39 the asynch. timeout for poll-for-quit) occurs. The QUITP | |
| 40 macro may look at this. */ | |
| 41 volatile int quit_check_signal_happened; | |
| 42 | |
| 43 /* Count of the number of times a quit-check signal has occurred. | |
| 44 Some stuff in event-Xt.c looks at this. */ | |
| 45 volatile int quit_check_signal_tick_count; | |
| 46 | |
| 47 /* Set to 1 when a SIGINT (or SIGQUIT) interrupt is processed. | |
| 48 maybe_read_quit_event() looks at this. */ | |
| 49 volatile int sigint_happened; | |
| 50 | |
| 51 /* Set to 1 when an asynch. timeout signal occurs. */ | |
| 593 | 52 static volatile int async_timeout_happened; |
| 53 | |
| 54 /* Set to 1 when a multiple of SLOWED_DOWN_INTERRUPTS_SECS elapses, | |
| 55 after slow_down_interrupts() is called. */ | |
| 56 static volatile int slowed_interrupt_timeout_happened; | |
| 428 | 57 |
| 58 /* This is used to synchronize setting the waiting_for_user_input_p | |
| 59 flag. */ | |
| 593 | 60 static volatile int async_timeout_happened_while_emacs_was_blocking; |
| 428 | 61 |
| 62 /* See check_quit() for when this is set. */ | |
| 63 int dont_check_for_quit; | |
| 64 | |
| 593 | 65 static int poll_for_quit_id; |
| 66 static int poll_for_sigchld_id; | |
| 428 | 67 |
| 68 /* This variable is used to communicate to a lisp | |
| 69 process-filter/sentinel/asynchronous callback (via the function | |
| 70 Fwaiting_for_user_input_p below) whether XEmacs was waiting for | |
| 71 user-input when that process-filter was called. */ | |
| 72 static int waiting_for_user_input_p; | |
| 73 | |
| 74 static int interrupts_slowed_down; | |
| 75 | |
| 76 #define SLOWED_DOWN_INTERRUPTS_SECS 15 | |
| 77 #define NORMAL_QUIT_CHECK_TIMEOUT_MSECS 250 | |
| 78 #define NORMAL_SIGCHLD_CHECK_TIMEOUT_MSECS 250 | |
| 79 | |
| 80 /* Used so that signals can break out of system calls that aren't | |
| 81 naturally interruptible. */ | |
| 82 | |
| 83 JMP_BUF break_system_call_jump; | |
| 84 volatile int can_break_system_calls; | |
| 85 | |
| 593 | 86 static SIGTYPE alarm_signal (int signo); |
| 87 | |
| 88 | |
| 428 | 89 |
| 90 /**********************************************************************/ | |
| 91 /* Asynchronous timeout functions */ | |
| 92 /**********************************************************************/ | |
| 93 | |
| 593 | 94 /* See the comment in event-stream.c, under major heading "Timeouts", |
| 95 for the difference between low-level (one-shot) and high-level | |
| 96 (periodic/resignaling) timeouts. */ | |
| 97 | |
| 428 | 98 /* The pending timers are stored in an ordered list, where the first timer |
| 99 on the list is the first one to fire. Times recorded here are | |
| 100 absolute. */ | |
| 101 static struct low_level_timeout *async_timer_queue; | |
| 102 | |
| 103 /* Nonzero means async timers are temporarily suppressed. */ | |
| 104 static int async_timer_suppress_count; | |
| 105 | |
| 106 static void | |
| 107 set_one_shot_timer (EMACS_TIME interval) | |
| 108 { | |
| 109 #ifdef HAVE_SETITIMER | |
| 110 struct itimerval it; | |
| 111 it.it_value = interval; | |
| 112 EMACS_SET_SECS_USECS (it.it_interval, 0, 0); | |
| 611 | 113 qxe_setitimer (ITIMER_REAL, &it, 0); |
| 428 | 114 #else |
| 115 int secs; | |
| 116 EMACS_TIME_TO_INT (interval, secs); | |
| 117 alarm (secs); | |
| 118 #endif | |
| 119 } | |
| 120 | |
| 121 static void | |
| 122 reset_interval_timer (void) | |
| 123 { | |
| 124 EMACS_TIME interval; | |
| 125 | |
| 126 /* Get the interval to set. If an interval is available, | |
| 127 make sure it's not zero (this is a valid return, but it will | |
| 128 cause the timer to get disabled, so convert it to a very short | |
| 129 time). */ | |
| 130 if (get_low_level_timeout_interval (async_timer_queue, &interval)) | |
| 131 { | |
| 132 if (EMACS_SECS (interval) == 0 && EMACS_USECS (interval) == 0) | |
| 133 EMACS_SET_USECS (interval, 1); | |
| 134 } | |
| 135 else | |
| 136 /* A time of 0 means "disable". */ | |
| 137 EMACS_SET_SECS_USECS (interval, 0, 0); | |
| 138 | |
| 139 set_one_shot_timer (interval); | |
| 140 } | |
| 141 | |
| 142 | |
| 143 static void | |
| 144 init_async_timeouts (void) | |
| 145 { | |
| 613 | 146 set_timeout_signal (SIGALRM, alarm_signal); |
| 428 | 147 async_timer_suppress_count = 0; |
| 148 } | |
| 149 | |
| 150 /* Turn off async timeouts. */ | |
| 151 | |
| 152 static void | |
| 153 stop_async_timeouts (void) | |
| 154 { | |
| 155 if (async_timer_suppress_count == 0) | |
| 156 { | |
| 157 /* If timer was on, turn it off. */ | |
| 158 EMACS_TIME thyme; | |
| 159 EMACS_SET_SECS_USECS (thyme, 0, 0); | |
| 160 set_one_shot_timer (thyme); | |
| 161 } | |
| 162 async_timer_suppress_count++; | |
| 163 } | |
| 164 | |
| 165 /* Turn on async timeouts again. */ | |
| 166 | |
| 167 static void | |
| 168 start_async_timeouts (void) | |
| 169 { | |
| 170 assert (async_timer_suppress_count > 0); | |
| 171 async_timer_suppress_count--; | |
| 172 if (async_timer_suppress_count == 0) | |
| 173 { | |
| 174 /* Some callers turn off async timeouts and then use the alarm | |
| 175 for their own purposes; so reinitialize everything. */ | |
| 613 | 176 set_timeout_signal (SIGALRM, alarm_signal); |
| 428 | 177 reset_interval_timer (); |
| 178 } | |
| 179 } | |
| 180 | |
| 593 | 181 static void |
| 182 handle_async_timeout_signal (void) | |
| 428 | 183 { |
| 593 | 184 int interval_id; |
| 185 int wakeup_id; | |
| 186 Lisp_Object fun, arg; | |
| 771 | 187 /* Avoid any possibility of GC during QUIT */ |
| 188 int specco = begin_gc_forbidden (); | |
| 593 | 189 |
| 190 /* No checks for Vinhibit_quit here or anywhere else in this file!!! | |
| 191 Otherwise critical quit will not work right. | |
| 771 | 192 The only check for Vinhibit_quit is in QUIT itself. |
| 193 | |
| 194 (#### ???? I don't quite understand this comment.) */ | |
| 593 | 195 interval_id = pop_low_level_timeout (&async_timer_queue, 0); |
| 196 | |
| 197 reset_interval_timer (); | |
| 198 if (async_timeout_happened_while_emacs_was_blocking) | |
| 199 { | |
| 200 async_timeout_happened_while_emacs_was_blocking = 0; | |
| 201 waiting_for_user_input_p = 1; | |
| 202 } | |
| 203 | |
| 204 wakeup_id = event_stream_resignal_wakeup (interval_id, 1, &fun, &arg); | |
| 428 | 205 |
| 593 | 206 if (wakeup_id == poll_for_quit_id) |
| 207 { | |
| 208 quit_check_signal_happened = 1; | |
| 209 quit_check_signal_tick_count++; | |
| 210 } | |
| 211 else if (wakeup_id == poll_for_sigchld_id) | |
| 428 | 212 { |
| 593 | 213 kick_status_notify (); |
| 428 | 214 } |
| 593 | 215 else |
| 216 /* call1 GC-protects its arguments */ | |
| 853 | 217 call1_trapping_problems ("Error in asynchronous timeout callback", |
| 218 fun, arg, INHIBIT_GC); | |
| 593 | 219 |
| 220 waiting_for_user_input_p = 0; | |
| 771 | 221 |
| 222 unbind_to (specco); | |
| 593 | 223 } |
| 224 | |
| 225 /* The following two functions are the external interface onto | |
| 226 creating/deleting asynchronous interval timeouts, and are | |
| 227 called by event-stream.c. We call back to event-stream.c using | |
| 228 event_stream_resignal_wakeup(), when an interval goes off. */ | |
| 229 | |
| 230 int | |
| 231 signal_add_async_interval_timeout (EMACS_TIME thyme) | |
| 232 { | |
| 233 int id = add_low_level_timeout (&async_timer_queue, thyme); | |
| 234 | |
| 235 /* If this timeout is at the head of the queue, then we need to | |
| 236 set the timer right now for this timeout. Otherwise, things | |
| 237 are fine as-is; after the timers ahead of us are signalled, | |
| 238 the timer will be set for us. */ | |
| 239 | |
| 240 if (async_timer_queue->id == id) | |
| 241 reset_interval_timer (); | |
| 242 | |
| 243 return id; | |
| 428 | 244 } |
| 245 | |
| 246 void | |
| 593 | 247 signal_remove_async_interval_timeout (int id) |
| 428 | 248 { |
| 593 | 249 int first = (async_timer_queue && async_timer_queue->id == id); |
| 250 remove_low_level_timeout (&async_timer_queue, id); | |
| 251 | |
| 252 /* If we removed the timeout from the head of the queue, then | |
| 253 we need to reset the interval timer right now. */ | |
| 254 if (first) | |
| 255 reset_interval_timer (); | |
| 428 | 256 } |
| 257 | |
| 593 | 258 /* If alarm() gets called when polling isn't disabled, it will mess up |
| 259 the asynchronous timeouts, and then C-g checking won't work again. | |
| 260 Some libraries call alarm() directly, so we override the standard | |
| 2500 | 261 library's alarm() and ABORT() if the caller of the library function |
| 593 | 262 didn't wrap in stop_interrupts()/start_interrupts(). |
| 428 | 263 |
| 593 | 264 NOTE: We could potentially avoid the need to wrap by adding a |
| 265 one-shot timeout to simulate the alarm(), smashing our signal | |
| 266 handler back into place, and calling the library function when the | |
| 267 alarm goes off. But do we want to? We're not going to gain the | |
| 268 ability to C-g out of library functions this way (unless we forcibly | |
| 269 longjmp() out of a signal handler, which is likely to lead to a | |
| 270 crash). --ben */ | |
| 428 | 271 |
| 272 #ifdef HAVE_SETITIMER | |
| 611 | 273 |
| 428 | 274 unsigned int |
| 275 alarm (unsigned int howlong) | |
| 276 { | |
| 277 struct itimerval old_it, new_it; | |
| 278 | |
| 279 assert (async_timer_suppress_count > 0); | |
| 280 | |
| 281 new_it.it_value.tv_sec = howlong; | |
| 282 new_it.it_value.tv_usec = 0; | |
| 283 new_it.it_interval.tv_sec = 0; | |
| 284 new_it.it_interval.tv_usec = 0; | |
| 611 | 285 qxe_setitimer (ITIMER_REAL, &new_it, &old_it); |
| 428 | 286 |
| 287 /* Never return zero if there was a timer outstanding. */ | |
| 288 return old_it.it_value.tv_sec + (old_it.it_value.tv_usec > 0 ? 1 : 0); | |
| 289 } | |
| 611 | 290 |
| 291 int | |
| 292 qxe_setitimer (int kind, const struct itimerval *itnew, | |
| 293 struct itimerval *itold) | |
| 294 { | |
| 1315 | 295 #ifdef WIN32_ANY |
| 611 | 296 /* setitimer() does not exist on native MS Windows, and appears broken |
| 617 | 297 on Cygwin. See win32.c. |
| 298 | |
| 299 We are emulating the Unix98 setitimer() function, as found in its | |
| 300 incarnations on modern versions of Unix. Note however that in | |
| 301 the win32.c version, ITNEW and ITOLD must be equal if both are | |
| 302 non-zero, due to limitations in the underlying multimedia-timer | |
| 303 API. */ | |
| 611 | 304 return mswindows_setitimer (kind, itnew, itold); |
| 305 #else | |
| 617 | 306 /* YUCK! glibc defines setitimer's first argument as |
| 307 enum __itimer_which, not int, which causes compile errors if | |
| 308 we call setitimer() in the obvious way. */ | |
| 309 switch (kind) | |
| 310 { | |
| 311 case ITIMER_REAL: return setitimer (ITIMER_REAL, itnew, itold); | |
| 312 case ITIMER_VIRTUAL: return setitimer (ITIMER_VIRTUAL, itnew, itold); | |
| 313 case ITIMER_PROF: return setitimer (ITIMER_PROF, itnew, itold); | |
| 2500 | 314 default: ABORT (); return 0; |
| 617 | 315 } |
| 428 | 316 #endif |
| 611 | 317 } |
| 318 | |
| 319 #endif /* HAVE_SETITIMER */ | |
| 320 | |
| 613 | 321 signal_handler_t |
| 322 set_timeout_signal (int signal_number, signal_handler_t action) | |
| 323 { | |
| 324 #ifdef CYGWIN_BROKEN_SIGNALS | |
| 325 return mswindows_sigset (signal_number, action); | |
| 326 #else | |
| 327 return EMACS_SIGNAL (signal_number, action); | |
| 328 #endif | |
| 329 } | |
| 428 | 330 |
| 331 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, 0, 0, 0, /* | |
| 332 Return non-nil if XEmacs is waiting for input from the user. | |
| 333 This is intended for use by asynchronous timeout callbacks and by | |
| 334 asynchronous process output filters and sentinels (not yet implemented | |
| 335 in XEmacs). It will always be nil if XEmacs is not inside of | |
| 336 an asynchronous timeout or process callback. | |
| 337 */ | |
| 338 ()) | |
| 339 { | |
| 340 return waiting_for_user_input_p ? Qt : Qnil; | |
| 341 } | |
| 342 | |
| 343 | |
| 344 /**********************************************************************/ | |
| 593 | 345 /* Enabling/disabling signals */ |
| 346 /**********************************************************************/ | |
| 347 | |
| 348 static int interrupts_initted; | |
| 349 | |
| 350 void | |
| 351 stop_interrupts (void) | |
| 352 { | |
| 353 if (!interrupts_initted) | |
| 354 return; | |
| 355 #if defined(SIGIO) && !defined(BROKEN_SIGIO) | |
| 356 unrequest_sigio (); | |
| 357 #endif | |
| 358 stop_async_timeouts (); | |
| 359 } | |
| 360 | |
| 361 void | |
| 362 start_interrupts (void) | |
| 363 { | |
| 364 if (!interrupts_initted) | |
| 365 return; | |
| 366 #if defined(SIGIO) && !defined(BROKEN_SIGIO) | |
| 367 request_sigio (); | |
| 368 #endif | |
| 369 start_async_timeouts (); | |
| 370 } | |
| 371 | |
| 372 | |
| 373 static void | |
| 374 establish_slow_interrupt_timer (void) | |
| 375 { | |
| 376 EMACS_TIME thyme; | |
| 377 | |
| 378 EMACS_SET_SECS_USECS (thyme, SLOWED_DOWN_INTERRUPTS_SECS, 0); | |
| 379 set_one_shot_timer (thyme); | |
| 380 } | |
| 381 | |
| 382 /* Some functions don't like being interrupted with SIGALRM or SIGIO. | |
| 383 Previously we were calling stop_interrupts() / start_interrupts(), | |
| 384 but then if the program hangs in one of those functions, e.g. | |
| 385 waiting for a connect(), we're really screwed. So instead we | |
| 386 just "slow them down". We do this by disabling all interrupts | |
| 387 and then installing a timer of length fairly large, like 5 or | |
| 388 10 secs. That way, any "legitimate" connections (which should | |
| 389 take a fairly short amount of time) go through OK, but we can | |
| 390 interrupt bogus ones. */ | |
| 391 | |
| 392 void | |
| 393 slow_down_interrupts (void) | |
| 394 { | |
| 395 /* We have to set the flag *before* setting the slowed-down timer, | |
| 396 to avoid a race condition -- if the signal occurs between the | |
| 397 call to set_one_shot_timer() and the setting of this flag, | |
| 398 async_timeout_happened will get set, which will be a Bad Thing if | |
| 399 there were no timeouts on the queue. */ | |
| 400 interrupts_slowed_down++; | |
| 401 if (interrupts_slowed_down == 1) | |
| 402 { | |
| 403 stop_interrupts (); | |
| 404 establish_slow_interrupt_timer (); | |
| 405 } | |
| 406 } | |
| 407 | |
| 408 void | |
| 409 speed_up_interrupts (void) | |
| 410 { | |
| 411 if (interrupts_slowed_down > 0) | |
| 412 { | |
| 413 start_interrupts (); | |
| 414 /* Change this flag AFTER fiddling with interrupts, for the same | |
| 415 race-condition reasons as above. */ | |
| 416 interrupts_slowed_down--; | |
| 417 } | |
| 418 } | |
| 419 | |
| 420 | |
| 421 /**********************************************************************/ | |
| 422 /* The mechanism that drives it all */ | |
| 428 | 423 /**********************************************************************/ |
| 424 | |
| 593 | 425 /* called from QUIT when something_happened gets set (as a result of |
| 426 a signal) */ | |
| 427 | |
| 853 | 428 void |
| 593 | 429 check_what_happened (void) |
| 430 { | |
| 771 | 431 /* No GC can happen anywhere here. handle_async_timeout_signal() |
| 432 prevents GC (from asynch timeout handler), so does check_quit() | |
| 433 (from processing a message such as WM_INITMENU as a result of | |
| 434 draining the message queue). establish_slow_interrupt_timer() is | |
| 435 too low-level to do anything that might invoke QUIT or call Lisp | |
| 436 code. */ | |
| 1318 | 437 |
| 438 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS | |
| 439 /* When in a critical section, don't reset something_happened, so that | |
| 440 every single QUIT will verify proper wrapping. (something_happened | |
| 441 was set by enter_redisplay_critical_section() and will be reset | |
| 442 upon exit.) */ | |
| 443 if (!in_display) | |
| 444 #endif | |
| 445 something_happened = 0; | |
| 446 | |
|
5014
c2e0c3af5fe3
cleanups to debug-print, try harder to make it work during GC
Ben Wing <ben@xemacs.org>
parents:
2518
diff
changeset
|
447 /* Don't try to do anything clever if we're called from debug_print() |
|
c2e0c3af5fe3
cleanups to debug-print, try harder to make it work during GC
Ben Wing <ben@xemacs.org>
parents:
2518
diff
changeset
|
448 or very close to startup or shutdown. */ |
|
c2e0c3af5fe3
cleanups to debug-print, try harder to make it work during GC
Ben Wing <ben@xemacs.org>
parents:
2518
diff
changeset
|
449 if (inhibit_non_essential_conversion_operations) |
|
c2e0c3af5fe3
cleanups to debug-print, try harder to make it work during GC
Ben Wing <ben@xemacs.org>
parents:
2518
diff
changeset
|
450 return; |
|
c2e0c3af5fe3
cleanups to debug-print, try harder to make it work during GC
Ben Wing <ben@xemacs.org>
parents:
2518
diff
changeset
|
451 |
| 593 | 452 if (async_timeout_happened) |
| 453 { | |
| 454 async_timeout_happened = 0; | |
| 455 handle_async_timeout_signal (); | |
| 456 } | |
| 457 if (slowed_interrupt_timeout_happened) | |
| 458 { | |
| 459 slowed_interrupt_timeout_happened = 0; | |
| 460 establish_slow_interrupt_timer (); | |
| 461 } | |
| 462 | |
| 853 | 463 check_quit (); |
| 593 | 464 } |
| 465 | |
| 466 #ifdef SIGIO | |
| 467 | |
| 468 /* Signal handler for SIGIO. */ | |
| 469 | |
| 470 static void | |
| 2286 | 471 input_available_signal (int SIG_ARG_MAYBE_UNUSED (signo)) |
| 593 | 472 { |
| 473 something_happened = 1; /* tell QUIT to wake up */ | |
| 474 quit_check_signal_happened = 1; | |
| 475 quit_check_signal_tick_count++; | |
| 476 EMACS_REESTABLISH_SIGNAL (signo, input_available_signal); | |
| 477 SIGRETURN; | |
| 478 } | |
| 479 | |
| 480 #endif /* SIGIO */ | |
| 481 | |
| 482 /* Actual signal handler for SIGALRM. Called when: | |
| 483 | |
| 484 -- asynchronous timeouts (added with `add-async-timeout') go off | |
| 485 | |
| 486 -- when the poll-for-quit timer (used for C-g handling; more or | |
| 487 less when SIGIO is unavailable or BROKEN_SIGIO is defined) or | |
| 488 poll-for-sigchld timer (used when BROKEN_SIGCHLD is defined) go | |
| 489 off. The latter two timers, if set, normally go off every 1/4 | |
| 490 of a second -- see NORMAL_QUIT_CHECK_TIMEOUT_MSECS and | |
| 491 NORMAL_SIGCHLD_CHECK_TIMEOUT_MSECS. (Both of these timers are | |
| 492 treated like other asynchronous timeouts, but special-cased | |
| 493 in handle_async_timeout_signal().) | |
| 494 | |
| 495 -- we called slow_down_interrupts() and SLOWED_DOWN_INTERRUPTS_SECS | |
| 496 (or a multiple of it) has elapsed. | |
| 497 | |
| 498 Note that under Windows, we have no working setitimer(), so we | |
| 499 simulate it using the multimedia timeout functions, | |
| 500 e.g. timeSetEvent(). See setitimer() in nt.c. | |
| 501 | |
| 502 Note also that we don't actually *do* anything here (except in the | |
| 503 case of can_break_system_calls). Instead, we just set various | |
| 504 flags; next time QUIT is called, the flags will cause | |
| 505 check_what_happened() to be called, at which point we do everything | |
| 506 indicated by the flags. | |
| 507 */ | |
| 508 | |
| 509 static SIGTYPE | |
| 510 alarm_signal (int signo) | |
| 511 { | |
| 512 something_happened = 1; /* tell QUIT to wake up and call | |
| 513 check_what_happened() */ | |
| 514 | |
| 515 if (interrupts_slowed_down) | |
| 516 { | |
| 517 /* we are in "slowed-down interrupts" mode; the only alarm | |
| 518 happening here is the slowed-down quit-check alarm, so | |
| 519 we set this flag. | |
| 520 | |
| 521 Do NOT set async_timeout_happened, because we don't want | |
| 522 anyone looking at the timeout queue -- async timeouts | |
| 523 are disabled. */ | |
| 524 quit_check_signal_happened = 1; | |
| 525 quit_check_signal_tick_count++; | |
| 526 /* make sure we establish the slow timer again. */ | |
| 527 slowed_interrupt_timeout_happened = 1; | |
| 528 | |
| 529 /* can_break_system_calls is set when we want to break out of | |
| 530 non-interruptible system calls. */ | |
| 531 if (can_break_system_calls) | |
| 532 { | |
| 533 /* reset the flag for safety and such. Do this *before* | |
| 534 unblocking or reestablishing the signal to avoid potential | |
| 535 race conditions. */ | |
| 536 can_break_system_calls = 0; | |
| 537 #ifndef WIN32_NATIVE | |
| 538 /* #### I didn't add this WIN32_NATIVE check. I'm not sure | |
| 539 why it's here. But then again, someone needs to review | |
| 540 this can_break_system_calls stuff and see if it still | |
| 541 makes sense. --ben */ | |
| 542 EMACS_UNBLOCK_SIGNAL (signo); | |
| 543 EMACS_REESTABLISH_SIGNAL (signo, alarm_signal); | |
| 544 LONGJMP (break_system_call_jump, 0); | |
| 545 #endif | |
| 546 } | |
| 547 } | |
| 548 else | |
| 549 { | |
| 550 async_timeout_happened = 1; | |
| 551 if (emacs_is_blocking) | |
| 552 async_timeout_happened_while_emacs_was_blocking = 1; | |
| 553 /* #### This is for QUITP. When it is run, it may not be the | |
| 554 place to do arbitrary stuff like run asynch. handlers, but | |
| 555 it needs to know whether the poll-for-quit asynch. timeout | |
| 556 went off. Rather than put the code in to compute this | |
| 557 specially, we just set this flag. Should fix this. */ | |
| 558 quit_check_signal_happened = 1; | |
| 559 | |
| 560 #ifdef HAVE_UNIXOID_EVENT_LOOP | |
| 561 signal_fake_event (); | |
| 562 #endif | |
| 563 } | |
| 564 | |
| 565 EMACS_REESTABLISH_SIGNAL (signo, alarm_signal); | |
| 566 SIGRETURN; | |
| 567 } | |
| 568 | |
| 428 | 569 /* Set this for debugging, to have a way to get out */ |
| 570 int stop_character; /* #### not currently implemented */ | |
| 571 | |
| 593 | 572 /* Signal handler for SIGINT and SIGQUIT. On TTY's, one of these two |
| 573 signals will get generated in response to C-g. (When running under | |
| 574 X, C-g is handled using the SIGIO handler, which sets a flag | |
| 575 telling the QUIT macro to scan the unread events for a ^G.) | |
| 576 */ | |
| 428 | 577 |
| 578 static SIGTYPE | |
| 579 interrupt_signal (int sig) | |
| 580 { | |
| 581 /* This function can call lisp */ | |
| 582 /* #### we should NOT be calling lisp from a signal handler, boys | |
| 583 and girls */ | |
| 584 /* Must preserve main program's value of errno. */ | |
| 585 int old_errno = errno; | |
| 586 | |
| 587 EMACS_REESTABLISH_SIGNAL (sig, interrupt_signal); | |
| 588 | |
| 589 if (sigint_happened && CONSOLEP (Vcontrolling_terminal) && | |
| 590 CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)) && | |
| 591 !emacs_is_blocking) | |
| 592 { | |
| 593 | 593 /* #### this is inherited from GNU Emacs. Do we really want this? |
| 594 --ben */ | |
| 428 | 595 char c; |
| 596 fflush (stdout); | |
| 597 reset_initial_console (); | |
| 598 EMACS_UNBLOCK_SIGNAL (sig); | |
| 599 #ifdef SIGTSTP /* Support possible in later USG versions */ | |
| 600 /* | |
| 601 * On systems which can suspend the current process and return to the original | |
| 602 * shell, this command causes the user to end up back at the shell. | |
| 603 * The "Auto-save" and "Abort" questions are not asked until | |
| 604 * the user elects to return to emacs, at which point he can save the current | |
| 605 * job and either dump core or continue. | |
| 606 */ | |
| 607 sys_suspend (); | |
| 608 #else | |
| 609 /* Perhaps should really fork an inferior shell? | |
| 610 But that would not provide any way to get back | |
| 611 to the original shell, ever. */ | |
| 612 stdout_out ("No support for stopping a process on this operating system;\n"); | |
| 613 stdout_out ("you can continue or abort.\n"); | |
| 614 #endif /* not SIGTSTP */ | |
| 615 stdout_out ("Auto-save? (y or n) "); | |
| 616 if (((c = getc (stdin)) & ~040) == 'Y') | |
| 617 Fdo_auto_save (Qnil, Qnil); | |
| 618 while (c != '\n') | |
| 619 c = getc (stdin); | |
| 620 stdout_out ("Abort (and dump core)? (y or n) "); | |
| 621 if (((c = getc (stdin)) & ~040) == 'Y') | |
| 2500 | 622 ABORT (); |
| 428 | 623 while (c != '\n') |
| 624 c = getc (stdin); | |
| 625 stdout_out ("Continuing...\n"); | |
| 626 reinit_initial_console (); | |
| 627 MARK_FRAME_CHANGED (XFRAME (DEVICE_SELECTED_FRAME | |
| 628 (XDEVICE (CONSOLE_SELECTED_DEVICE | |
| 629 (XCONSOLE | |
| 630 (Vcontrolling_terminal)))))); | |
| 631 } | |
| 632 else | |
| 633 { | |
| 634 /* Else request quit when it's safe */ | |
| 635 Vquit_flag = Qt; | |
| 636 sigint_happened = 1; | |
| 637 #ifdef HAVE_UNIXOID_EVENT_LOOP | |
| 638 signal_fake_event (); | |
| 639 #endif | |
| 640 } | |
| 641 errno = old_errno; | |
| 642 SIGRETURN; | |
| 643 } | |
| 644 | |
| 593 | 645 |
| 646 /**********************************************************************/ | |
| 647 /* Control-G checking */ | |
| 648 /**********************************************************************/ | |
| 649 | |
| 2367 | 650 /* |
| 853 | 651 |
| 2367 | 652 Info on Control-G checking: |
| 853 | 653 |
| 2367 | 654 (Info-goto-node "(internals)Control-G (Quit) Checking") |
| 655 */ | |
| 853 | 656 |
| 771 | 657 /* Defer all checking or processing of C-g. You can do this, for example, |
| 658 if you want to read C-g's as events. (In that case, you should set | |
| 659 Vquit_flag to Qnil just before you unbind, because it typically gets set | |
| 660 as a result of reading C-g.) */ | |
| 661 | |
| 662 int | |
| 428 | 663 begin_dont_check_for_quit (void) |
| 664 { | |
| 771 | 665 int depth = specpdl_depth (); |
| 666 /* As an optimization in QUIT_FLAG_SAYS_SHOULD_QUIT, we bind inhibit-quit | |
| 667 to t -- it has to be checked anyway, and by doing this, we only need | |
| 668 to check dont_check_for_quit when quit-flag == `critical', which is | |
| 669 rare. */ | |
| 428 | 670 specbind (Qinhibit_quit, Qt); |
| 853 | 671 internal_bind_int (&dont_check_for_quit, 1); |
| 771 | 672 |
| 673 return depth; | |
| 428 | 674 } |
| 675 | |
| 853 | 676 /* If we're inside of a begin_dont_check_for_quit() section, but want |
| 677 to temporarily enable quit-checking, call this. This is used in | |
| 678 particular when processing menu filters -- some menu filters do | |
| 679 antisocial things like load large amounts of Lisp code (custom in | |
| 680 particular), and we obviously want a way of breaking out of any | |
| 681 problems. If you do use this, you should really be trapping the | |
| 682 throw() that comes from the quitting (as does the code that handles | |
| 683 menus popping up). */ | |
| 684 | |
| 428 | 685 int |
| 853 | 686 begin_do_check_for_quit (void) |
| 687 { | |
| 688 int depth = specpdl_depth (); | |
| 689 specbind (Qinhibit_quit, Qnil); | |
| 690 internal_bind_int (&dont_check_for_quit, 0); | |
| 691 /* #### should we set Vquit_flag to Qnil? */ | |
| 692 return depth; | |
| 693 } | |
| 694 | |
| 695 /* The effect of this function is to set Vquit_flag appropriately if the | |
| 696 user pressed C-g or Sh-C-g. After this function finishes, Vquit_flag | |
| 697 will be Qt for C-g, Qcritical for Sh-C-g, and unchanged otherwise. | |
| 698 The C-g or Sh-C-g is discarded, so it won't be noticed again. | |
| 699 */ | |
| 700 | |
| 2518 | 701 |
| 702 | |
| 853 | 703 void |
| 428 | 704 check_quit (void) |
| 705 { | |
| 853 | 706 int specdepth; |
| 707 | |
| 428 | 708 if (dont_check_for_quit) |
| 853 | 709 return; |
| 428 | 710 |
| 711 if (quit_check_signal_happened) | |
| 712 { | |
| 2034 | 713 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS |
| 714 /* Since the code below can call Lisp, make sure that proper wrapping is | |
| 715 in place during redisplay. */ | |
| 2518 | 716 #if 0 |
| 2034 | 717 assert_with_message |
| 718 (proper_redisplay_wrapping_in_place (), | |
| 719 "QUIT called from within redisplay without being properly wrapped"); | |
| 2518 | 720 #else |
| 721 /* FUCKME! It looks like we cannot even check for QUIT, *EVER*, during | |
| 722 redisplay. Checking for quit can dispatch events, which can enter | |
| 723 redisplay recursively, which can trip on | |
| 724 | |
| 725 Fatal error: assertion failed, file c:\xemacs\build\src\redisplay.c, line 5532, | |
| 726 !dy->locked | |
| 727 | |
| 728 Backtrace given in | |
| 729 | |
| 5038 | 730 (Info-goto-node "(internals)Critical Redisplay Sections") |
| 2518 | 731 |
| 732 */ | |
| 733 assert_with_message | |
| 734 (!in_display, | |
| 735 "QUIT called from within redisplay without being properly wrapped"); | |
| 736 #endif /* 0 */ | |
| 737 #endif /* ERROR_CHECK_TRAPPING_PROBLEMS */ | |
| 2034 | 738 |
| 1123 | 739 /* Since arbitrary Lisp code may be executed (e.g. through a menu |
| 740 filter, see backtrace directly above), GC might happen, | |
| 771 | 741 which would majorly fuck a lot of things, e.g. re_match() |
| 742 [string gets relocated] and lots of other code that's not | |
| 743 prepared to handle GC in QUIT. */ | |
| 853 | 744 specdepth = begin_gc_forbidden (); |
| 428 | 745 quit_check_signal_happened = 0; |
| 746 event_stream_quit_p (); | |
| 771 | 747 unbind_to (specdepth); |
| 428 | 748 } |
| 749 } | |
| 750 | |
| 751 | |
| 752 | |
| 753 void | |
| 754 init_poll_for_quit (void) | |
| 755 { | |
| 756 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT) | |
| 757 /* Check for C-g every 1/4 of a second. | |
| 758 | |
| 759 #### This is just a guess. Some investigation will have to be | |
| 760 done to see what the best value is. The best value is the | |
| 761 smallest possible value that doesn't cause a significant amount | |
| 762 of running time to be spent in C-g checking. */ | |
| 763 if (!poll_for_quit_id) | |
| 764 poll_for_quit_id = | |
| 765 event_stream_generate_wakeup (NORMAL_QUIT_CHECK_TIMEOUT_MSECS, | |
| 766 NORMAL_QUIT_CHECK_TIMEOUT_MSECS, | |
| 767 Qnil, Qnil, 1); | |
| 768 #endif /* not SIGIO and not DONT_POLL_FOR_QUIT */ | |
| 769 } | |
| 770 | |
| 593 | 771 #if 0 /* not used anywhere */ |
| 772 | |
| 428 | 773 void |
| 774 reset_poll_for_quit (void) | |
| 775 { | |
| 776 #if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT) | |
| 777 if (poll_for_quit_id) | |
| 778 { | |
| 779 event_stream_disable_wakeup (poll_for_quit_id, 1); | |
| 780 poll_for_quit_id = 0; | |
| 781 } | |
| 782 #endif /* not SIGIO and not DONT_POLL_FOR_QUIT */ | |
| 783 } | |
| 784 | |
| 593 | 785 #endif /* 0 */ |
| 786 | |
| 853 | 787 #if defined (HAVE_UNIX_PROCESSES) && !defined (SIGCHLD) |
| 428 | 788 |
| 789 static void | |
| 790 init_poll_for_sigchld (void) | |
| 791 { | |
| 792 /* Check for terminated processes every 1/4 of a second. | |
| 793 | |
| 794 #### This is just a guess. Some investigation will have to be | |
| 795 done to see what the best value is. The best value is the | |
| 796 smallest possible value that doesn't cause a significant amount | |
| 797 of running time to be spent in process-termination checking. | |
| 798 */ | |
| 799 poll_for_sigchld_id = | |
| 800 event_stream_generate_wakeup (NORMAL_SIGCHLD_CHECK_TIMEOUT_MSECS, | |
| 801 NORMAL_SIGCHLD_CHECK_TIMEOUT_MSECS, | |
| 802 Qnil, Qnil, 1); | |
| 803 } | |
| 804 | |
| 805 #endif /* not SIGCHLD */ | |
| 806 | |
| 807 | |
| 808 /************************************************************************/ | |
| 809 /* initialization */ | |
| 810 /************************************************************************/ | |
| 811 | |
| 812 /* If we've been nohup'ed, keep it that way. | |
| 813 This allows `nohup xemacs &' to work. | |
| 814 More generally, if a normally fatal signal has been redirected | |
| 815 to SIG_IGN by our invocation environment, trust the environment. | |
| 816 This keeps xemacs from being killed by a SIGQUIT intended for a | |
| 817 different process after having been backgrounded under a | |
| 818 non-job-control shell! */ | |
| 819 static void | |
| 820 handle_signal_if_fatal (int signo) | |
| 821 { | |
| 613 | 822 if (EMACS_SIGNAL (signo, fatal_error_signal) == SIG_IGN) |
| 823 EMACS_SIGNAL (signo, SIG_IGN); | |
| 428 | 824 } |
| 825 | |
| 826 void | |
| 827 init_signals_very_early (void) | |
| 828 { | |
| 829 /* Catch all signals that would kill us. | |
| 830 Don't catch these signals in batch mode if not initialized. | |
| 831 On some machines, this sets static data that would make | |
| 832 signal fail to work right when the dumped Emacs is run. */ | |
| 833 if (noninteractive && !initialized) | |
| 834 return; | |
| 835 | |
| 836 handle_signal_if_fatal (SIGILL); /* ANSI */ | |
| 837 handle_signal_if_fatal (SIGABRT); /* ANSI */ | |
| 838 handle_signal_if_fatal (SIGFPE); /* ANSI */ | |
| 839 handle_signal_if_fatal (SIGSEGV); /* ANSI */ | |
| 840 handle_signal_if_fatal (SIGTERM); /* ANSI */ | |
| 841 | |
| 842 | |
| 843 #ifdef SIGHUP | |
| 844 handle_signal_if_fatal (SIGHUP); /* POSIX */ | |
| 845 #endif | |
| 846 #ifdef SIGQUIT | |
| 847 handle_signal_if_fatal (SIGQUIT); /* POSIX */ | |
| 848 #endif | |
| 849 #ifdef SIGTRAP | |
| 850 handle_signal_if_fatal (SIGTRAP); /* POSIX */ | |
| 851 #endif | |
| 852 #ifdef SIGUSR1 | |
| 853 handle_signal_if_fatal (SIGUSR1); /* POSIX */ | |
| 854 #endif | |
| 855 #ifdef SIGUSR2 | |
| 856 handle_signal_if_fatal (SIGUSR2); /* POSIX */ | |
| 857 #endif | |
| 858 #ifdef SIGPIPE | |
| 859 handle_signal_if_fatal (SIGPIPE); /* POSIX */ | |
| 860 #endif | |
| 861 #ifdef SIGALRM | |
| 862 /* This will get reset later, once we're | |
| 863 capable of handling it properly. */ | |
| 864 handle_signal_if_fatal (SIGALRM); /* POSIX */ | |
| 865 #endif | |
| 866 | |
| 867 | |
| 868 #ifdef SIGBUS | |
| 869 handle_signal_if_fatal (SIGBUS); /* XPG5 */ | |
| 870 #endif | |
| 871 #ifdef SIGSYS | |
| 872 handle_signal_if_fatal (SIGSYS); /* XPG5 */ | |
| 873 #endif | |
| 874 #ifdef SIGXCPU | |
| 875 handle_signal_if_fatal (SIGXCPU); /* XPG5 */ | |
| 876 #endif | |
| 877 #ifdef SIGXFSZ | |
| 878 handle_signal_if_fatal (SIGXFSZ); /* XPG5 */ | |
| 879 #endif | |
| 880 #ifdef SIGVTALRM | |
| 881 handle_signal_if_fatal (SIGVTALRM); /* XPG5 */ | |
| 882 #endif | |
| 883 #ifdef SIGPROF | |
| 884 /* Messes up the REAL profiler */ | |
| 885 /* handle_signal_if_fatal (SIGPROF); */ /* XPG5 */ | |
| 886 #endif | |
| 887 | |
| 888 | |
| 889 #ifdef SIGHWE | |
| 890 handle_signal_if_fatal (SIGHWE); | |
| 891 #endif | |
| 892 #ifdef SIGPRE | |
| 893 handle_signal_if_fatal (SIGPRE); | |
| 894 #endif | |
| 895 #ifdef SIGORE | |
| 896 handle_signal_if_fatal (SIGORE); | |
| 897 #endif | |
| 898 #ifdef SIGUME | |
| 899 handle_signal_if_fatal (SIGUME); | |
| 900 #endif | |
| 901 #ifdef SIGDLK | |
| 902 handle_signal_if_fatal (SIGDLK); | |
| 903 #endif | |
| 904 #ifdef SIGCPULIM | |
| 905 handle_signal_if_fatal (SIGCPULIM); | |
| 906 #endif | |
| 907 #ifdef SIGIOT | |
| 908 handle_signal_if_fatal (SIGIOT); | |
| 909 #endif | |
| 910 #ifdef SIGEMT | |
| 911 handle_signal_if_fatal (SIGEMT); | |
| 912 #endif | |
| 913 #ifdef SIGLOST | |
| 914 handle_signal_if_fatal (SIGLOST); | |
| 915 #endif | |
| 916 #ifdef SIGSTKFLT /* coprocessor stack fault under Linux */ | |
| 917 handle_signal_if_fatal (SIGSTKFLT); | |
| 918 #endif | |
| 919 #ifdef SIGUNUSED /* exists under Linux, and will kill process! */ | |
| 920 handle_signal_if_fatal (SIGUNUSED); | |
| 921 #endif | |
| 922 | |
| 923 #ifdef AIX | |
| 924 /* 20 is SIGCHLD, 21 is SIGTTIN, 22 is SIGTTOU. */ | |
| 925 #ifndef _I386 | |
| 926 handle_signal_if_fatal (SIGIOINT); | |
| 927 #endif | |
| 928 handle_signal_if_fatal (SIGGRANT); | |
| 929 handle_signal_if_fatal (SIGRETRACT); | |
| 930 handle_signal_if_fatal (SIGSOUND); | |
| 931 handle_signal_if_fatal (SIGMSG); | |
| 932 #endif /* AIX */ | |
| 933 | |
| 934 #ifdef SIGDANGER | |
| 935 /* This just means available memory is getting low. */ | |
| 613 | 936 EMACS_SIGNAL (SIGDANGER, memory_warning_signal); |
| 428 | 937 #endif |
| 938 } | |
| 939 | |
| 940 void | |
| 941 syms_of_signal (void) | |
| 942 { | |
| 943 DEFSUBR (Fwaiting_for_user_input_p); | |
| 944 } | |
| 945 | |
| 946 void | |
| 947 init_interrupts_late (void) | |
| 948 { | |
| 949 if (!noninteractive) | |
| 950 { | |
| 613 | 951 EMACS_SIGNAL (SIGINT, interrupt_signal); |
| 428 | 952 #ifdef HAVE_TERMIO |
| 953 /* On systems with TERMIO, C-g is set up for both SIGINT and SIGQUIT | |
| 954 and we can't tell which one it will give us. */ | |
| 613 | 955 EMACS_SIGNAL (SIGQUIT, interrupt_signal); |
| 428 | 956 #endif /* HAVE_TERMIO */ |
| 957 init_async_timeouts (); | |
| 958 #ifdef SIGIO | |
| 613 | 959 EMACS_SIGNAL (SIGIO, input_available_signal); |
| 428 | 960 # ifdef SIGPOLL /* XPG5 */ |
| 961 /* Some systems (e.g. Motorola SVR4) losingly have different | |
| 962 values for SIGIO and SIGPOLL, and send SIGPOLL instead of | |
| 963 SIGIO. On those same systems, an uncaught SIGPOLL kills the | |
| 964 process. */ | |
| 613 | 965 EMACS_SIGNAL (SIGPOLL, input_available_signal); |
| 428 | 966 # endif |
| 967 #elif !defined (DONT_POLL_FOR_QUIT) | |
| 968 init_poll_for_quit (); | |
| 969 #endif | |
| 970 } | |
| 971 | |
| 853 | 972 #if defined (HAVE_UNIX_PROCESSES) && !defined (SIGCHLD) |
| 428 | 973 init_poll_for_sigchld (); |
| 974 #endif | |
| 975 | |
| 976 EMACS_UNBLOCK_ALL_SIGNALS (); | |
| 977 | |
| 978 interrupts_initted = 1; | |
| 979 } | |
| 980 |