X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=ae5875f2a2743875f721cb274f884d983eb63fa9;hb=ce2a580a469d285e7054ada13ef456e3dad08a34;hp=37d715f65ee15c1a594672cb83d9e8e0437f9910;hpb=fcdd5b05583258e43bfe22bdfaea1fc34f85289d;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 37d715f..ae5875f 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -156,12 +156,13 @@ corresponds to NAME, or NIL if there is none."
   (declare (type unix-pathname path)
            (type fixnum flags)
            (type unix-file-mode mode))
-  (int-syscall ("open" c-string int int)
-               path
-               (logior #!+win32 o_binary
-                       #!+largefile o_largefile
-                       flags)
-               mode))
+  (with-restarted-syscall (value errno)
+    (int-syscall ("open" c-string int int)
+                 path
+                 (logior #!+win32 o_binary
+                         #!+largefile o_largefile
+                         flags)
+                 mode)))
 
 ;;; UNIX-CLOSE accepts a file descriptor and attempts to close the file
 ;;; associated with it.
@@ -916,12 +917,34 @@ corresponds to NAME, or NIL if there is none."
                (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.
+                     ;;
+                     ;; It would be neat to do this bit of defensive
+                     ;; programming on all platforms, but unfortunately on
+                     ;; Linux, REM can be a little higher than REQ if the
+                     ;; nanosleep() call is interrupted quickly enough,
+                     ;; probably due to the request being rounded up to the
+                     ;; nearest HZ. This would cause the sleep to return way
+                     ;; too early.
+                     #!+darwin
+                     (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)