0.8.21.20

	Patch SLEEP to use nanosleep() and to restart the sleep if
	interrupted e.g. by a signal, instead of returning early.  Thanks
	to Gabor Melis (ref sbcl-help, "Oddity with make-thread and sleep")

2 files changed, 15 insertions, 3 deletions

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 2b6dcbd2b..43a5c0ba0 100644
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -147,13 +147,13 @@ steppers to maintain contextual information.")
            :format-arguments (list n)
            :datum n
            :expected-type '(real 0)))
-  (multiple-value-bind (sec usec)
+  (multiple-value-bind (sec nsec)
       (if (integerp n)
 	  (values n 0)
 	  (multiple-value-bind (sec frac)
 	      (truncate n)
-	    (values sec (truncate frac 1e-6))))
-    (sb!unix:unix-select 0 0 0 0 sec usec))
+	    (values sec (truncate frac 1e-9))))
+    (sb!unix:nanosleep sec nsec))
   nil)
 
 ;;;; SCRUB-CONTROL-STACK
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 39b23eb04..59cf3504d 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -658,6 +658,18 @@
   (seconds-west sb!alien:int :out)
   (daylight-savings-p sb!alien:boolean :out))
 
+(defun nanosleep (secs nsecs)
+  (with-alien ((req (struct timespec))
+               (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))))
+
 (defun unix-get-seconds-west (secs)
   (multiple-value-bind (ignore seconds dst) (get-timezone secs)
     (declare (ignore ignore) (ignore dst))