/[slime]/slime/swank-sbcl.lisp
ViewVC logotype

Diff of /slime/swank-sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.269 by sboukarev, Tue Mar 2 14:36:48 2010 UTC revision 1.270 by trittweiler, Tue Apr 20 09:48:19 2010 UTC
# Line 1450  stack." Line 1450  stack."
1450          (setf (mailbox.queue mbox)          (setf (mailbox.queue mbox)
1451                (nconc (mailbox.queue mbox) (list message)))                (nconc (mailbox.queue mbox) (list message)))
1452          (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))          (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))
1453      #-sb-lutex
1454      (defun condition-timed-wait (waitqueue mutex timeout)
1455        (handler-case
1456            (let ((*break-on-signals* nil))
1457              (sb-sys:with-deadline (:seconds timeout :override t)
1458                (sb-thread:condition-wait waitqueue mutex) t))
1459          (sb-ext:timeout ()
1460            nil)))
1461    
1462      ;; FIXME: with-timeout doesn't work properly on Darwin
1463      #+sb-lutex
1464      (defun condition-timed-wait (waitqueue mutex timeout)
1465        (declare (ignore timeout))
1466        (sb-thread:condition-wait waitqueue mutex))
1467    
1468    (defimplementation receive-if (test &optional timeout)    (defimplementation receive-if (test &optional timeout)
1469      (let* ((mbox (mailbox (current-thread)))      (let* ((mbox (mailbox (current-thread)))
1470             (mutex (mailbox.mutex mbox)))             (mutex (mailbox.mutex mbox))
1471               (waitq (mailbox.waitqueue mbox)))
1472        (assert (or (not timeout) (eq timeout t)))        (assert (or (not timeout) (eq timeout t)))
1473        (loop        (loop
1474         (check-slime-interrupts)         (check-slime-interrupts)
# Line 1464  stack." Line 1479  stack."
1479               (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))               (setf (mailbox.queue mbox) (nconc (ldiff q tail) (cdr tail)))
1480               (return (car tail))))               (return (car tail))))
1481           (when (eq timeout t) (return (values nil t)))           (when (eq timeout t) (return (values nil t)))
1482           ;; FIXME: with-timeout doesn't work properly on Darwin           (condition-timed-wait waitq mutex 0.2)))))
          #+linux  
          (handler-case  
              (let ((*break-on-signals* nil))  
                (sb-ext:with-timeout 0.2  
                  (sb-thread:condition-wait (mailbox.waitqueue mbox)  
                                            mutex)))  
            (sb-ext:timeout ()))  
          #-linux  
          (sb-thread:condition-wait (mailbox.waitqueue mbox)  
                                    mutex)))))  
1483    )    )
1484    
1485  (defimplementation quit-lisp ()  (defimplementation quit-lisp ()

Legend:
Removed from v.1.269  
changed lines
  Added in v.1.270

  ViewVC Help
Powered by ViewVC 1.1.5