/[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.316 by heller, Sun May 6 16:16:13 2012 UTC revision 1.317 by heller, Sun May 6 16:16:24 2012 UTC
# Line 1623  stack." Line 1623  stack."
1623          (setf (mailbox.queue mbox)          (setf (mailbox.queue mbox)
1624                (nconc (mailbox.queue mbox) (list message)))                (nconc (mailbox.queue mbox) (list message)))
1625          (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))          (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))
   #-sb-lutex  
   (defun condition-timed-wait (waitqueue mutex timeout)  
     (handler-case  
         (let ((*break-on-signals* nil))  
           (sb-sys:with-deadline (:seconds timeout :override t)  
             (sb-thread:condition-wait waitqueue mutex) t))  
       (sb-ext:timeout ()  
         nil)))  
1626    
   ;; FIXME: with-timeout doesn't work properly on Darwin  
   #+sb-lutex  
1627    (defun condition-timed-wait (waitqueue mutex timeout)    (defun condition-timed-wait (waitqueue mutex timeout)
1628      (declare (ignore timeout))      (macrolet ((foo ()
1629      (sb-thread:condition-wait waitqueue mutex   ))                   (cond ((> (length (sb-introspect:function-arglist
1630                                        #'sb-thread:condition-wait))
1631                               2)
1632                            '(sb-thread:condition-wait waitqueue mutex
1633                              :timeout timeout))
1634                           ((member :sb-lutex *features*) ; Darwin
1635                            '(sb-thread:condition-wait waitqueue mutex))
1636                           (t
1637                            '(handler-case
1638                              (let ((*break-on-signals* nil))
1639                                (sb-sys:with-deadline (:seconds timeout
1640                                                                :override t)
1641                                  (sb-thread:condition-wait waitqueue mutex) t))
1642                              (sb-ext:timeout ()
1643                               nil))))))
1644          (foo)))
1645    
1646    (defimplementation receive-if (test &optional timeout)    (defimplementation receive-if (test &optional timeout)
1647      (let* ((mbox (mailbox (current-thread)))      (let* ((mbox (mailbox (current-thread)))
1648             (mutex (mailbox.mutex mbox))             (mutex (mailbox.mutex mbox))

Legend:
Removed from v.1.316  
changed lines
  Added in v.1.317

  ViewVC Help
Powered by ViewVC 1.1.5