0.9.8.34:

[sbcl.git] / src / code / timer.lisp

diff --git a/src/code/timer.lisp b/src/code/timer.lisp
index cdf8863..3280bd2 100644 (file)
--- a/src/code/timer.lisp
+++ b/src/code/timer.lisp
@@ -135,6 +135,8 @@
   ;; 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)
@@ -206,9 +208,9 @@ from now. For timers with a repeat interval it returns true."
       ,@body)))
 
 (defun under-scheduler-lock-p ()
-  #!-sb!thread
+  #!-sb-thread
   t
-  #!+sb!thread
+  #!+sb-thread
   (eq sb!thread:*current-thread* (sb!thread:mutex-value *scheduler-lock*)))
 
 (defparameter *schedule* (make-priority-queue :key #'%timer-expire-time))
@@ -337,19 +339,21 @@ triggers."
              (sb!thread:interrupt-thread-error (c)
                (warn c)))))))
 
+;; Called from the signal handler.
 (defun run-expired-timers ()
   (unwind-protect
-       (let (timer)
-         (loop
-          (with-scheduler-lock ()
-            (setq timer (peek-schedule))
-            (unless (and timer
-                         (> (get-internal-real-time)
-                            (%timer-expire-time timer)))
-              (return-from run-expired-timers nil))
-            (assert (eq timer (priority-queue-extract-maximum *schedule*))))
-          ;; run the timer without the lock
-          (run-timer timer)))
+       (with-interrupts
+         (let (timer)
+           (loop
+            (with-scheduler-lock ()
+              (setq timer (peek-schedule))
+              (unless (and timer
+                           (> (get-internal-real-time)
+                              (%timer-expire-time timer)))
+                (return-from run-expired-timers nil))
+              (assert (eq timer (priority-queue-extract-maximum *schedule*))))
+            ;; run the timer without the lock
+            (run-timer timer))))
     (with-scheduler-lock ()
       (set-system-timer))))
 
@@ -358,9 +362,13 @@ triggers."
   "Execute the body, asynchronously interrupting it and signalling a
 TIMEOUT condition after at least EXPIRES seconds have passed."
   (with-unique-names (timer)
-    `(let ((,timer (make-timer (lambda ()
-                                 (cerror "Continue" 'sb!ext::timeout)))))
-      (schedule-timer ,timer ,expires)
-      (unwind-protect
-           (progn ,@body)
-        (unschedule-timer ,timer)))))
+    ;; FIXME: a temporary compatibility workaround for CLX, if unsafe
+    ;; unwinds are handled revisit it.
+    `(if (> ,expires 0)
+         (let ((,timer (make-timer (lambda ()
+                                     (cerror "Continue" 'sb!ext::timeout)))))
+           (schedule-timer ,timer ,expires)
+           (unwind-protect
+                (progn ,@body)
+             (unschedule-timer ,timer)))
+         (progn ,@body))))