X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftimer.lisp;h=36235acaf648eade8ffcfcbc2e97adb3015a54e1;hb=b9147dff981d00779cccc6b9a00be2a388bd28a6;hp=7862876e5005707632f06e48a3b63400a6256be6;hpb=c548f73e8dd676d6ec4576eba6ab661a5061bdfe;p=sbcl.git

diff --git a/src/code/timer.lisp b/src/code/timer.lisp
index 7862876..36235ac 100644
--- a/src/code/timer.lisp
+++ b/src/code/timer.lisp
@@ -65,7 +65,7 @@
     (aref heap 0)))
 
 (defun heap-extract (heap i &key (key #'identity) (test #'>=))
-  (when (< (length heap) i)
+  (unless (> (length heap) i)
     (error "Heap underflow"))
   (prog1
       (aref heap i)
@@ -135,8 +135,6 @@
   ;; FUNCTION until the other is called, from when it does nothing.
   (let ((mutex (sb!thread:make-mutex))
         (cancelled-p nil))
-    #!-sb-thread
-    (declare (ignore mutex))
     (list
      #'(lambda ()
          (sb!thread:with-recursive-lock (mutex)
@@ -202,8 +200,9 @@ from now. For timers with a repeat interval it returns true."
 (defvar *scheduler-lock* (sb!thread:make-mutex :name "Scheduler lock"))
 
 (defmacro with-scheduler-lock ((&optional) &body body)
-  ;; don't let the SIGALRM handler mess things up
-  `(sb!thread::call-with-system-mutex (lambda () ,@body) *scheduler-lock*))
+  ;; Don't let the SIGALRM handler mess things up.
+  `(sb!thread::with-system-mutex (*scheduler-lock*)
+     ,@body))
 
 (defun under-scheduler-lock-p ()
   #!-sb-thread
@@ -294,10 +293,13 @@ triggers."
 ;;; Not public, but related
 
 (defun reschedule-timer (timer)
-  (with-scheduler-lock ()
-    (setf (%timer-expire-time timer) (+ (get-internal-real-time)
-                                        (%timer-repeat-interval timer)))
-    (%schedule-timer timer)))
+  (let ((thread (%timer-thread timer)))
+    (if (and (sb!thread::thread-p thread) (not (sb!thread:thread-alive-p thread)))
+        (unschedule-timer timer)
+        (with-scheduler-lock ()
+          (setf (%timer-expire-time timer) (+ (get-internal-real-time)
+                                              (%timer-repeat-interval timer)))
+          (%schedule-timer timer)))))
 
 ;;; Expiring timers