Update of /cvsroot/sbcl/sbcl/src/code
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv22483/src/code
Modified Files:
unix.lisp
Log Message:
1.0.42.50: workaround a Darwin nanosleep() bug
Fixes lp#640516.
It turns out that on Darwin, if a nanosleep() call is interrupted,
and the signal handler takes longer than the requested sleep time
was, then the call will return with EINTR and (unsigned)-1 in the
remaining seconds.
Since we call nanosleep() again when it returns with EINTR with the
remaining time, this would cause us to sleep ~136 years...
So, check that the remainder is not increasing before calling
nanosleep() again.
Many, many thanks to Joe Lobraco who reported and diagnosed the
issue.
Index: unix.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/unix.lisp,v
retrieving revision 1.110
retrieving revision 1.111
diff -u -d -r1.110 -r1.111
--- unix.lisp 19 Sep 2010 21:33:31 -0000 1.110
+++ unix.lisp 21 Sep 2010 13:10:39 -0000 1.111
@@ -916,12 +916,27 @@
(rem (struct timespec)))
(setf (slot req 'tv-sec) secs)
(setf (slot req 'tv-nsec) nsecs)
- (loop while (eql sb!unix:eintr
- (nth-value 1
- (int-syscall ("nanosleep" (* (struct timespec))
- (* (struct timespec)))
- (addr req) (addr rem))))
- do (rotatef req rem))))
+ (loop while (and (eql sb!unix:eintr
+ (nth-value 1
+ (int-syscall ("nanosleep" (* (struct timespec))
+ (* (struct timespec)))
+ (addr req) (addr rem))))
+ ;; KLUDGE: On Darwin, if an interrupt cases nanosleep to
+ ;; take longer than the requested time, the call will
+ ;; return with EINT and (unsigned)-1 seconds in the
+ ;; remainder timespec, which would cause us to enter
+ ;; nanosleep again for ~136 years. So, we check that the
+ ;; remainder time is actually decreasing. Since the cost
+ ;; of this check is neglible, do it on all platforms.
+ ;; http://osdir.com/ml/darwin-kernel/2010-03/msg00007.html
+ (let ((rem-sec (slot rem 'tv-sec))
+ (rem-nsec (slot rem 'tv-nsec)))
+ (when (or (> secs rem-sec)
+ (and (= secs rem-sec) (>= nsecs rem-nsec)))
+ (setf secs rem-sec
+ nsecs rem-nsec)
+ t)))
+ do (rotatef req rem))))
(defun unix-get-seconds-west (secs)
(multiple-value-bind (ignore seconds dst) (get-timezone secs)
|