[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#61741: 30.0.50; [PATCH] Reset errant timers
|
From: |
dick . r . chiang |
|
Subject: |
bug#61741: 30.0.50; [PATCH] Reset errant timers |
|
Date: |
Thu, 23 Feb 2023 13:54:46 -0500 |
|
User-agent: |
Gnus/5.14 (Gnus v5.14) |
>From 5f8dd26a2e521864ba5ca6c61e5a89ac5db223e0 Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang@gmail.com>
Date: Thu, 23 Feb 2023 13:30:33 -0500
Subject: [PATCH] Reset errant timers
It's always irked me that a repeated timer, should it error
under debug-on-error, enters a zombie state.
emacs -Q \
--eval "(setq debugger (lambda (&rest _args) \
(run-at-time 1 nil \
(function list-timers)) \
(top-level)))" \
--eval "(setq debug-on-error t)" \
--eval "(run-at-time nil 0.5 (lambda () (error \"foo\"))))"
* lisp/emacs-lisp/timer-list.el (timer, list-timers,
timer-list-mode): time-subtract prefers a smaller subtrahend.
* lisp/emacs-lisp/timer.el (timer, timerp): A timer
does not begin life already triggered.
(timer--check, timer--time-setter, timer-set-function, cancel-timer):
Make weak sauce less weak.
(cancel-timer-internal): Remove.
(timer-event-handler): Rewrite.
(run-with-idle-timer): Brevity is clarity.
(internal-timer-start-idle): Why test indeed.
* lisp/frame.el (blink-cursor--start-idle-timer):
Everyone else simply says "t".
* lisp/jit-lock.el (jit-lock-stealth-fontify):
Demangle interfaces.
* lisp/time.el (display-time-event-handler):
Prefer descriptive getters.
* src/fns.c (Fcopy_sequence): Stay safe.
* src/keyboard.c (trigger_timer, timer_check_2, timer_check):
Brevity is clarity.
* test/lisp/emacs-lisp/timer-tests.el (timer-test-debug-on-error-delay,
timer-test-debug-on-error-timer, timer-test-debug-on-error-0,
timer-test-debug-on-error-1): Test.
---
lisp/emacs-lisp/timer-list.el | 34 ++--
lisp/emacs-lisp/timer.el | 257 ++++++++-------------------
lisp/frame.el | 2 +-
lisp/jit-lock.el | 2 +-
lisp/time.el | 4 +-
src/fns.c | 2 +-
src/keyboard.c | 261 +++++++---------------------
test/lisp/emacs-lisp/timer-tests.el | 26 +++
8 files changed, 189 insertions(+), 399 deletions(-)
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index b9a171adc07..1e1c22b8f77 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -24,6 +24,8 @@
;;; Code:
+(require 'timer)
+
(defvar cl-print-compiled)
(defvar cl-print-compiled-button)
@@ -41,23 +43,29 @@ list-timers
nil
`[ ;; Idle.
,(propertize
- (if (aref timer 7) " *" " ")
+ (if (timer--idle-delay timer) " *" " ")
'help-echo "* marks idle timers"
'timer timer)
;; Next time.
,(propertize
- (let ((time (list (aref timer 1)
- (aref timer 2)
- (aref timer 3))))
- (format "%12s"
- (format-seconds "%dd %hh %mm %z%,1ss"
- (float-time
- (if (aref timer 7)
- time
- (time-subtract time nil))))))
+ (let* ((time (timer--time timer))
+ (idle-p (timer--idle-delay timer))
+ (inverted-p (and (not idle-p)
+ (time-less-p time nil)))
+ (formatted (format-seconds
+ "%1dd %2hh %2mm %z%,1ss"
+ (float-time
+ (if idle-p
+ time
+ (if inverted-p
+ (time-subtract nil time)
+ (time-subtract time nil)))))))
+ (when (equal formatted "0.0s")
+ (setq inverted-p nil))
+ (format "%13s" (concat (if inverted-p "-" "") formatted)))
'help-echo "Time until next invocation")
;; Repeat.
- ,(let ((repeat (aref timer 4)))
+ ,(let ((repeat (timer--repeat-delay timer)))
(cond
((numberp repeat)
(propertize
@@ -73,7 +81,7 @@ list-timers
(let ((cl-print-compiled 'static)
(cl-print-compiled-button nil)
(print-escape-newlines t))
- (cl-prin1-to-string (aref timer 5)))
+ (cl-prin1-to-string (timer--function timer)))
'help-echo "Function called by timer")]))
(append timer-list timer-idle-list)))
(tabulated-list-print))
@@ -94,7 +102,7 @@ timer-list-mode
(setq-local revert-buffer-function #'list-timers)
(setq tabulated-list-format
'[("Idle" 6 timer-list--idle-predicate)
- ("Next" 12 timer-list--next-predicate :right-align t :pad-right 1)
+ ("Next" 13 timer-list--next-predicate :right-align t :pad-right 1)
("Repeat" 12 timer-list--repeat-predicate :right-align t :pad-right
1)
("Function" 10 timer-list--function-predicate)]))
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 7544279d8aa..097290c7b4f 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -28,18 +28,13 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-
-;; If you change this structure, you also have to change `timerp'
-;; (below) and decode_timer in keyboard.c.
(cl-defstruct (timer
(:constructor nil)
(:copier nil)
(:constructor timer--create ())
- (:type vector)
+ (:type vector) ; undefines timer-p (see timerp)
(:conc-name timer--))
- ;; nil if the timer is active (waiting to be triggered),
- ;; non-nil if it is inactive ("already triggered", in theory).
- (triggered t)
+ triggered
;; Time of next trigger: for normal timers, absolute time, for idle timers,
;; time relative to idle-start.
high-seconds low-seconds usecs
@@ -61,18 +56,23 @@ timer-create
;; hardcode the shape of timers in other .elc files.
(timer--create))
-(defun timerp (object)
- "Return t if OBJECT is a timer."
- (and (vectorp object)
- ;; Timers are now ten elements, but old .elc code may have
- ;; shorter versions of `timer-create'.
- (<= 9 (length object) 10)))
+(defsubst timerp (object)
+ "Return t if OBJECT appears to be a timer.
+As the timer struct does not implicitly define a timer-p
+predicate (since it explicitly shunts to a vector type), we
+attempt an heuristic."
+ (and (vectorp object) (= (length object) 10)))
(defsubst timer--check (timer)
- (or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer))))
+ (or (and (timerp timer)
+ (integerp (timer--high-seconds timer))
+ (integerp (timer--low-seconds timer))
+ (integerp (timer--usecs timer))
+ (integerp (timer--psecs timer))
+ (timer--function timer))
+ (error "Invalid timer %S" timer)))
(defun timer--time-setter (timer time)
- (timer--check timer)
(let ((lt (time-convert time 'list)))
(setf (timer--high-seconds timer) (nth 0 lt))
(setf (timer--low-seconds timer) (nth 1 lt))
@@ -153,100 +153,29 @@ timer-inc-time
(defun timer-set-function (timer function &optional args)
"Make TIMER call FUNCTION with optional ARGS when triggering."
- (timer--check timer)
(setf (timer--function timer) function)
(setf (timer--args timer) args)
timer)
-
-(defun timer--activate (timer &optional triggered-p reuse-cell idle)
- (let ((timers (if idle timer-idle-list timer-list))
- last)
- (cond
- ((not (and (timerp timer)
- (integerp (timer--high-seconds timer))
- (integerp (timer--low-seconds timer))
- (integerp (timer--usecs timer))
- (integerp (timer--psecs timer))
- (timer--function timer)))
- (error "Invalid or uninitialized timer"))
- ;; FIXME: This is not reliable because `idle-delay' is only set late,
- ;; by `timer-activate-when-idle' :-(
- ;;((not (eq (not idle)
- ;; (not (timer--idle-delay timer))))
- ;; (error "idle arg %S out of sync with idle-delay field of timer: %S"
- ;; idle timer))
- ((memq timer timers)
- (error "Timer already activated"))
- (t
- ;; Skip all timers to trigger before the new one.
- (while (and timers (timer--time-less-p (car timers) timer))
- (setq last timers
- timers (cdr timers)))
- (if reuse-cell
- (progn
- (setcar reuse-cell timer)
- (setcdr reuse-cell timers))
- (setq reuse-cell (cons timer timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (setf (cond (last (cdr last))
- (idle timer-idle-list)
- (t timer-list))
- reuse-cell)
- (setf (timer--triggered timer) triggered-p)
- (setf (timer--idle-delay timer) idle)
- nil))))
-
-(defun timer-activate (timer &optional triggered-p reuse-cell)
- "Insert TIMER into `timer-list'.
-If TRIGGERED-P is t, make TIMER inactive (put it on the list, but
-mark it as already triggered). To remove it, use `cancel-timer'.
-
-REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
-TIMER into `timer-list' (usually a cell removed from that list by
-`cancel-timer-internal'; using this reduces consing for repeat
-timers). If nil, allocate a new cell."
- (timer--activate timer triggered-p reuse-cell nil))
-
-(defun timer-activate-when-idle (timer &optional dont-wait reuse-cell)
- "Insert TIMER into `timer-idle-list'.
-This arranges to activate TIMER whenever Emacs is next idle.
-If optional argument DONT-WAIT is non-nil, set TIMER to activate
-immediately \(see below), or at the right time, if Emacs is
-already idle.
-
-REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
-TIMER into `timer-idle-list' (usually a cell removed from that
-list by `cancel-timer-internal'; using this reduces consing for
-repeat timers). If nil, allocate a new cell.
-
-Using non-nil DONT-WAIT is not recommended when activating an
-idle timer from an idle timer handler, if the timer being
-activated has an idleness time that is smaller or equal to
-the time of the current timer. That's because the activated
-timer will fire right away."
- (timer--activate timer (not dont-wait) reuse-cell 'idle))
+
+(defsubst timer-activate (timer &optional _triggered-p _reuse-cell)
+ "Install TIMER."
+ (timer--check timer)
+ (cl-pushnew timer timer-list))
+
+(defsubst timer-activate-when-idle (timer &optional _dont-wait _reuse-cell)
+ "Install idle TIMER"
+ (setf (timer--idle-delay timer) 'idle)
+ (timer--check timer)
+ (cl-pushnew timer timer-idle-list))
(defalias 'disable-timeout #'cancel-timer)
(defun cancel-timer (timer)
"Remove TIMER from the list of active timers."
- (timer--check timer)
(setq timer-list (delq timer timer-list))
(setq timer-idle-list (delq timer timer-idle-list))
nil)
-(defun cancel-timer-internal (timer)
- "Remove TIMER from the list of active timers or idle timers.
-Only to be used in this file. It returns the cons cell
-that was removed from the timer list."
- (let ((cell1 (memq timer timer-list))
- (cell2 (memq timer timer-idle-list)))
- (if cell1
- (setq timer-list (delq timer timer-list)))
- (if cell2
- (setq timer-idle-list (delq timer timer-idle-list)))
- (or cell1 cell2)))
-
(defun cancel-function-timers (function)
"Cancel all timers which would run FUNCTION.
This affects ordinary timers such as are scheduled by `run-at-time',
@@ -258,7 +187,7 @@ cancel-function-timers
(dolist (timer timer-idle-list)
(if (eq (timer--function timer) function)
(setq timer-idle-list (delq timer timer-idle-list)))))
-
+
;; Record the last few events, for debugging.
(defvar timer-event-last nil
"Last timer that was run.")
@@ -285,74 +214,51 @@ timer-until
(defun timer-event-handler (timer)
"Call the handler for the timer TIMER.
This function is called, by name, directly by the C code."
- (setq timer-event-last-2 timer-event-last-1)
- (setq timer-event-last-1 timer-event-last)
- (setq timer-event-last timer)
- (let ((inhibit-quit t))
- (timer--check timer)
- (let ((retrigger nil)
- (cell
- ;; Delete from queue. Record the cons cell that was used.
- (cancel-timer-internal timer)))
- ;; If `cell' is nil, it means the timer was already canceled, so we
- ;; shouldn't be running it at all. This can happen for example with the
- ;; following scenario (bug#17392):
- ;; - we run timers, starting with A (and remembering the rest as (B C)).
- ;; - A runs and a does a sit-for.
- ;; - during sit-for we run timer D which cancels timer B.
- ;; - timer A finally finishes, so we move on to timers B and C.
- (when cell
- ;; Re-schedule if requested.
- (if (timer--repeat-delay timer)
- (if (timer--idle-delay timer)
- (timer-activate-when-idle timer nil cell)
- (timer-inc-time timer (timer--repeat-delay timer) 0)
- ;; If real time has jumped forward,
- ;; perhaps because Emacs was suspended for a long time,
- ;; limit how many times things get repeated.
- (if (and (numberp timer-max-repeats)
- (time-less-p (timer--time timer) nil))
- (let ((repeats (/ (timer-until timer nil)
- (timer--repeat-delay timer))))
- (if (> repeats timer-max-repeats)
- (timer-inc-time timer (* (timer--repeat-delay timer)
- repeats)))))
- ;; If we want integral multiples, we have to recompute
- ;; the repetition.
- (when (and (> (length timer) 9) ; Backwards compatible.
- (timer--integral-multiple timer)
- (not (timer--idle-delay timer)))
- (setf (timer--time timer)
- (timer-next-integral-multiple-of-time
- nil (timer--repeat-delay timer))))
- ;; Place it back on the timer-list before running
- ;; timer--function, so it can cancel-timer itself.
- (timer-activate timer t cell)
- (setq retrigger t)))
- ;; Run handler.
- (condition-case-unless-debug err
- ;; Timer functions should not change the current buffer.
- ;; If they do, all kinds of nasty surprises can happen,
- ;; and it can be hellish to track down their source.
- (save-current-buffer
- (apply (timer--function timer) (timer--args timer)))
- (error (message "Error running timer%s: %S"
- (if (symbolp (timer--function timer))
- (format-message " `%s'" (timer--function timer))
- "")
- err)))
- (when (and retrigger
- ;; If the timer's been canceled, don't "retrigger" it
- ;; since it might still be in the copy of timer-list kept
- ;; by keyboard.c:timer_check (bug#14156).
- (memq timer timer-list))
- (setf (timer--triggered timer) nil))))))
+ (setq timer-event-last-2 timer-event-last-1
+ timer-event-last-1 timer-event-last
+ timer-event-last timer)
+ (let ((inhibit-quit t)
+ (run-handler
+ (lambda (timer)
+ (condition-case-unless-debug err
+ (save-current-buffer
+ (setf (timer--triggered timer) t)
+ (let ((restore-deactivate-mark deactivate-mark))
+ (apply (timer--function timer) (timer--args timer))
+ (setq deactivate-mark restore-deactivate-mark)))
+ (error (message "Error running timer%s: %s"
+ (if (symbolp (timer--function timer))
+ (format-message " '%s'" (timer--function
timer))
+ "")
+ (error-message-string err)))))))
+ (cond ((memq timer timer-list)
+ (funcall run-handler timer)
+ (if (not (timer--repeat-delay timer))
+ ;; dequeue
+ (cancel-timer timer)
+ ;; requeue at new time
+ (setf (timer--triggered timer) nil)
+ (if (timer--integral-multiple timer)
+ (setf (timer--time timer)
+ (timer-next-integral-multiple-of-time
+ nil (timer--repeat-delay timer)))
+ (timer-inc-time timer (timer--repeat-delay timer)))
+ (when (numberp timer-max-repeats)
+ ;; Limit repetitions in case emacs was unduly suspended
+ (let ((limit (time-subtract nil (* timer-max-repeats
+ (timer--repeat-delay
timer)))))
+ (when (time-less-p (timer--time timer) limit)
+ (setf (timer--time timer) limit))))))
+ ((memq timer timer-idle-list)
+ (funcall run-handler timer)
+ (unless (timer--repeat-delay timer)
+ (cancel-timer timer))))))
;; This function is incompatible with the one in levents.el.
(defun timeout-event-p (event)
"Non-nil if EVENT is a timeout event."
(and (listp event) (eq (car event) 'timer-event)))
-
+
(declare-function diary-entry-time "diary-lib" (s))
@@ -451,19 +357,11 @@ add-timeout
(run-with-timer secs repeat function object))
(defun run-with-idle-timer (secs repeat function &rest args)
- "Perform an action the next time Emacs is idle for SECS seconds.
-The action is to call FUNCTION with arguments ARGS.
-SECS may be an integer, a floating point number, or the internal
-time format returned by, e.g., `current-idle-time'.
-If Emacs is currently idle, and has been idle for N seconds (N < SECS),
-then it will call FUNCTION in SECS - N seconds from now. Using
-SECS <= N is not recommended if this function is invoked from an idle
-timer, because FUNCTION will then be called immediately.
-
-If REPEAT is non-nil, do the action each time Emacs has been idle for
-exactly SECS seconds (that is, only once for each time Emacs becomes idle).
-
-This function returns a timer object which you can use in `cancel-timer'."
+ "Call FUNCTION on ARGS when idle for SECS seconds.
+If REPEAT is non-nil, repeat the behavior until cancelled via
+`cancel-timer'. SECS may be an integer, a floating point number,
+or the internal time format returned by, e.g.,
+`current-idle-time'."
(interactive
(list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
(y-or-n-p "Repeat each time Emacs is idle? ")
@@ -471,9 +369,9 @@ run-with-idle-timer
(let ((timer (timer-create)))
(timer-set-function timer function args)
(timer-set-idle-time timer secs repeat)
- (timer-activate-when-idle timer t)
+ (timer-activate-when-idle timer)
timer))
-
+
(defvar with-timeout-timers nil
"List of all timers used by currently pending `with-timeout' calls.")
@@ -533,7 +431,7 @@ y-or-n-p-with-timeout
If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
(with-timeout (seconds default-value)
(y-or-n-p prompt)))
-
+
(defconst timer-duration-words
(list (cons "microsec" 0.000001)
(cons "microsecond" 0.000001)
@@ -578,9 +476,8 @@ timer-duration
(defun internal-timer-start-idle ()
"Mark all idle-time timers as once again candidates for running."
(dolist (timer timer-idle-list)
- (if (timerp timer) ;; FIXME: Why test?
- (setf (timer--triggered timer) nil))))
-
+ (setf (timer--triggered timer) nil)))
+
(provide 'timer)
;;; timer.el ends here
diff --git a/lisp/frame.el b/lisp/frame.el
index b820d5fcd96..6eb7459ba42 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2861,7 +2861,7 @@ blink-cursor--start-idle-timer
;; during command execution) if they set blink-cursor-delay
;; to a very small or even zero value.
(run-with-idle-timer (max 0.2 blink-cursor-delay)
- :repeat #'blink-cursor-start)))
+ t #'blink-cursor-start)))
(defun blink-cursor--start-timer ()
"Start the `blink-cursor-timer'."
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 452cbd1ca51..2246cff28bf 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -593,7 +593,7 @@ jit-lock-stealth-fontify
(when jit-lock-stealth-buffers
(timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time))
(timer-inc-time jit-lock-stealth-repeat-timer delay)
- (timer-activate-when-idle jit-lock-stealth-repeat-timer t)))))
+ (timer-activate-when-idle jit-lock-stealth-repeat-timer)))))
;;; Deferred fontification.
diff --git a/lisp/time.el b/lisp/time.el
index 522bec46ac6..280293a9de2 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -238,8 +238,8 @@ display-time-event-handler
(timer display-time-timer)
;; Compute the time when this timer will run again, next.
(next-time (timer-relative-time
- (list (aref timer 1) (aref timer 2) (aref timer 3))
- (* 5 (aref timer 4)) 0)))
+ (timer--time timer)
+ (* 5 (timer--repeat-delay timer)) 0)))
;; If the activation time is not in the future,
;; skip executions until we reach a time in the future.
;; This avoids a long pause if Emacs has been suspended for hours.
diff --git a/src/fns.c b/src/fns.c
index 0af9b725c7a..28cffc9053f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -751,7 +751,7 @@ DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1,
1, 0,
Lisp_Object val = Fcons (XCAR (arg), Qnil);
Lisp_Object prev = val;
Lisp_Object tail = XCDR (arg);
- FOR_EACH_TAIL (tail)
+ FOR_EACH_TAIL_SAFE (tail)
{
Lisp_Object c = Fcons (XCAR (tail), Qnil);
XSETCDR (prev, c);
diff --git a/src/keyboard.c b/src/keyboard.c
index b2816f8270b..761e731fb22 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -4527,47 +4527,9 @@ timer_resume_idle (void)
...). Each element has the form (FUN . ARGS). */
Lisp_Object pending_funcalls;
-/* Return true if TIMER is a valid timer, placing its value into *RESULT. */
-static bool
-decode_timer (Lisp_Object timer, struct timespec *result)
-{
- Lisp_Object *vec;
-
- if (! (VECTORP (timer) && ASIZE (timer) == 10))
- return false;
- vec = XVECTOR (timer)->contents;
- if (! NILP (vec[0]))
- return false;
- if (! FIXNUMP (vec[2]))
- return false;
- return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result);
-}
-
-
-/* Check whether a timer has fired. To prevent larger problems we simply
- disregard elements that are not proper timers. Do not make a circular
- timer list for the time being.
-
- Returns the time to wait until the next timer fires. If a
- timer is triggering now, return zero.
- If no timer is active, return -1.
-
- If a timer is ripe, we run it, with quitting turned off.
- In that case we return 0 to indicate that a new timer_check_2 call
- should be done. */
-
-static struct timespec
-timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
+static void
+trigger_timer (Lisp_Object timer)
{
- struct timespec nexttime;
- struct timespec now;
- struct timespec idleness_now;
- Lisp_Object chosen_timer;
-
- nexttime = invalid_timespec ();
-
- chosen_timer = Qnil;
-
/* First run the code that was delayed. */
while (CONSP (pending_funcalls))
{
@@ -4575,180 +4537,77 @@ timer_check_2 (Lisp_Object timers, Lisp_Object
idle_timers)
pending_funcalls = XCDR (pending_funcalls);
safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
}
-
- if (CONSP (timers) || CONSP (idle_timers))
- {
- now = current_timespec ();
- idleness_now = (timespec_valid_p (timer_idleness_start_time)
- ? timespec_sub (now, timer_idleness_start_time)
- : make_timespec (0, 0));
- }
-
- while (CONSP (timers) || CONSP (idle_timers))
- {
- Lisp_Object timer = Qnil, idle_timer = Qnil;
- struct timespec timer_time, idle_timer_time;
- struct timespec difference;
- struct timespec timer_difference = invalid_timespec ();
- struct timespec idle_timer_difference = invalid_timespec ();
- bool ripe, timer_ripe = 0, idle_timer_ripe = 0;
-
- /* Set TIMER and TIMER_DIFFERENCE
- based on the next ordinary timer.
- TIMER_DIFFERENCE is the distance in time from NOW to when
- this timer becomes ripe.
- Skip past invalid timers and timers already handled. */
- if (CONSP (timers))
- {
- timer = XCAR (timers);
- if (! decode_timer (timer, &timer_time))
- {
- timers = XCDR (timers);
- continue;
- }
-
- timer_ripe = timespec_cmp (timer_time, now) <= 0;
- timer_difference = (timer_ripe
- ? timespec_sub (now, timer_time)
- : timespec_sub (timer_time, now));
- }
-
- /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
- based on the next idle timer. */
- if (CONSP (idle_timers))
- {
- idle_timer = XCAR (idle_timers);
- if (! decode_timer (idle_timer, &idle_timer_time))
- {
- idle_timers = XCDR (idle_timers);
- continue;
- }
-
- idle_timer_ripe = timespec_cmp (idle_timer_time, idleness_now) <= 0;
- idle_timer_difference
- = (idle_timer_ripe
- ? timespec_sub (idleness_now, idle_timer_time)
- : timespec_sub (idle_timer_time, idleness_now));
- }
-
- /* Decide which timer is the next timer,
- and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
- Also step down the list where we found that timer. */
-
- if (timespec_valid_p (timer_difference)
- && (! timespec_valid_p (idle_timer_difference)
- || idle_timer_ripe < timer_ripe
- || (idle_timer_ripe == timer_ripe
- && ((timer_ripe
- ? timespec_cmp (idle_timer_difference,
- timer_difference)
- : timespec_cmp (timer_difference,
- idle_timer_difference))
- < 0))))
- {
- chosen_timer = timer;
- timers = XCDR (timers);
- difference = timer_difference;
- ripe = timer_ripe;
- }
- else
- {
- chosen_timer = idle_timer;
- idle_timers = XCDR (idle_timers);
- difference = idle_timer_difference;
- ripe = idle_timer_ripe;
- }
-
- /* If timer is ripe, run it if it hasn't been run. */
- if (ripe)
- {
- /* If we got here, presumably `decode_timer` has checked
- that this timer has not yet been triggered. */
- eassert (NILP (AREF (chosen_timer, 0)));
- /* In a production build, where assertions compile to
- nothing, we still want to play it safe here. */
- if (NILP (AREF (chosen_timer, 0)))
- {
- specpdl_ref count = SPECPDL_INDEX ();
- Lisp_Object old_deactivate_mark = Vdeactivate_mark;
-
- /* Mark the timer as triggered to prevent problems if the lisp
- code fails to reschedule it right. */
- ASET (chosen_timer, 0, Qt);
-
- specbind (Qinhibit_quit, Qt);
-
- call1 (Qtimer_event_handler, chosen_timer);
- Vdeactivate_mark = old_deactivate_mark;
- timers_run++;
- unbind_to (count, Qnil);
-
- /* Since we have handled the event,
- we don't need to tell the caller to wake up and do it. */
- /* But the caller must still wait for the next timer, so
- return 0 to indicate that. */
- }
-
- nexttime = make_timespec (0, 0);
- break;
- }
- else
- /* When we encounter a timer that is still waiting,
- return the amount of time to wait before it is ripe. */
- {
- return difference;
- }
- }
-
- /* No timers are pending in the future. */
- /* Return 0 if we generated an event, and -1 if not. */
- return nexttime;
+ call1 (Qtimer_event_handler, timer);
+ timers_run++;
}
+/* Trigger any timers meeting their respective criteria.
-/* Check whether a timer has fired. To prevent larger problems we simply
- disregard elements that are not proper timers. Do not make a circular
- timer list for the time being.
+ For ordinary timers, this means current time is at
+ or past their scheduled time.
- Returns the time to wait until the next timer fires.
- If no timer is active, return an invalid value.
+ For idle timers, this means the idled period exceeds
+ their idle threshold.
- As long as any timer is ripe, we run it. */
+ Return the time distance to the next upcoming timer.
+*/
struct timespec
timer_check (void)
{
- struct timespec nexttime;
- Lisp_Object timers, idle_timers;
-
- Lisp_Object tem = Vinhibit_quit;
- Vinhibit_quit = Qt;
- block_input ();
- turn_on_atimers (false);
-
- /* We use copies of the timers' lists to allow a timer to add itself
- again, without locking up Emacs if the newly added timer is
- already ripe when added. */
+ struct timespec now = current_timespec ();
+ struct timespec idled = timespec_valid_p (timer_idleness_start_time)
+ ? timespec_sub (now, timer_idleness_start_time)
+ : invalid_timespec ();
+ struct timespec until_next = invalid_timespec ();
+ Lisp_Object *const lists[] = { &Vtimer_list, &Vtimer_idle_list };
+ struct timespec const bogeys[] = { now, idled };
- /* Always consider the ordinary timers. */
- timers = Fcopy_sequence (Vtimer_list);
- /* Consider the idle timers only if Emacs is idle. */
- if (timespec_valid_p (timer_idleness_start_time))
- idle_timers = Fcopy_sequence (Vtimer_idle_list);
- else
- idle_timers = Qnil;
-
- turn_on_atimers (true);
- unblock_input ();
- Vinhibit_quit = tem;
-
- do
+ for (int i = 0; i < 2; ++i)
{
- nexttime = timer_check_2 (timers, idle_timers);
+ struct timespec bogey = bogeys[i];
+ if (! timespec_valid_p (bogey))
+ continue;
+
+ Lisp_Object timers = Fcopy_sequence (*lists[i]);
+ FOR_EACH_TAIL_SAFE (timers)
+ {
+ struct timespec time;
+ Lisp_Object *vec;
+ CHECK_VECTOR (XCAR (timers));
+ vec = XVECTOR (XCAR (timers))->contents;
+ if (NILP (vec[0])) /* not yet triggered */
+ {
+ if (list4_to_timespec (vec[1], vec[2], vec[3], vec[8], &time))
+ {
+ /* Trigger when:
+ For ordinary timer, now is at or past trigger time.
+ For idle timer, idled duration at or past threshold. */
+ if (timespec_cmp (bogey, time) >= 0)
+ {
+ trigger_timer (XCAR (timers));
+ }
+ else
+ {
+ struct timespec diff = timespec_sub (time, bogey);
+ if (! timespec_valid_p (until_next)
+ || timespectod (diff) < timespectod (until_next))
+ until_next = diff;
+ }
+ }
+ }
+ else /* was triggered */
+ {
+ /* Clean up timers that errored out. */
+ if (NILP (vec[4])) /* if not repeated, delete it. */
+ *lists[i] = Fdelq (XCAR (timers), *lists[i]);
+ else if (NILP (vec[7]) /* if not idle, reset it. */)
+ vec[0] = Qnil;
+ }
+ }
}
- while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);
- return nexttime;
+ return until_next;
}
DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
diff --git a/test/lisp/emacs-lisp/timer-tests.el
b/test/lisp/emacs-lisp/timer-tests.el
index 7652b324493..be59727620d 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -65,4 +65,30 @@ timer-next-integral-multiple-of-time-3
(let ((nt (timer-next-integral-multiple-of-time '(32770 . 65539) 0.5)))
(should (time-equal-p 1 nt))))
+(defvar timer-test-debug-on-error-delay 0.5)
+(defvar timer-test-debug-on-error-timer nil)
+
+(ert-deftest timer-test-debug-on-error-0 ()
+ "Set the trap."
+ :expected-result :failed
+ (setq timer-test-debug-on-error-timer
+ (run-at-time nil timer-test-debug-on-error-delay
+ (lambda ()
+ (setf (timer--function timer-test-debug-on-error-timer)
+ #'ignore)
+ (error "foo"))))
+ (sit-for 0.1 t))
+
+(ert-deftest timer-test-debug-on-error-1 ()
+ "Recover when `debug-on-error' leaves timer-event-handler in limbo."
+ (should debug-on-error)
+ (unwind-protect
+ (progn
+ (sit-for (* timer-test-debug-on-error-delay 3) t)
+ (should-not (timer--triggered timer-test-debug-on-error-timer))
+ (list-timers)
+ (with-current-buffer "*timer-list*"
+ (should-error (re-search-forward (regexp-quote "-1d ")))))
+ (cancel-timer timer-test-debug-on-error-timer)))
+
;;; timer-tests.el ends here
--
2.38.1
- bug#61741: 30.0.50; [PATCH] Reset errant timers,
dick . r . chiang <=