From e5777ecb2f2581f6788f7136adc78f129215d481 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Mon, 28 Nov 2016 20:29:33 -0800
Subject: [PATCH] Fix #26: Use nanosleep to sleep

lisp/os-common.c:
o Implement os_sleep(double) to sleep for the given number of
  seconds.  Uses nanosleep on all platforms to sleep, taking care to
  sleep more if nanosleep was interrupted.

code/lispinit.lisp:
code/multi-proc.lisp:
o Use the new os_sleep function to sleep for the requested amount of
  time.
---
 src/code/lispinit.lisp   |  9 +++------
 src/code/multi-proc.lisp |  9 +++------
 src/lisp/os-common.c     | 20 ++++++++++++++++++++
 3 files changed, 26 insertions(+), 12 deletions(-)

diff --git a/src/code/lispinit.lisp b/src/code/lispinit.lisp
index be5307c4c..5ed7b9661 100644
--- a/src/code/lispinit.lisp
+++ b/src/code/lispinit.lisp
@@ -515,12 +515,9 @@
            :format-arguments (list n)
            :datum n
            :expected-type '(real 0)))
-  (multiple-value-bind (sec usec)
-    (if (integerp n)
-	(values n 0)
-	(multiple-value-bind (sec frac) (truncate n)
-	  (values sec (truncate frac 1e-6))))
-    (unix:unix-select 0 0 0 0 sec usec))
+  (alien:alien-funcall
+   (alien:extern-alien "os_sleep" (function c-call:void double-float))
+   (float n 1d0))
   nil)
 
 ;;;; SCRUB-CONTROL-STACK
diff --git a/src/code/multi-proc.lisp b/src/code/multi-proc.lisp
index c73f0b41a..fb5bcc043 100644
--- a/src/code/multi-proc.lisp
+++ b/src/code/multi-proc.lisp
@@ -1643,12 +1643,9 @@
 	     ;; Can't call process-wait if the scheduling is inhibited.
 	     *inhibit-scheduling*)
 	 ;; The initial-process may block.
-	 (multiple-value-bind (sec usec)
-	     (if (integerp n)
-		 (values n 0)
-		 (multiple-value-bind (sec frac)(truncate n)
-		   (values sec (truncate frac 1e-6))))
-	   (unix:unix-select 0 0 0 0 sec usec))
+	 (alien:alien-funcall
+	  (alien:extern-alien "os_sleep" (function c-call:void double-float))
+	  (float n 1d0))
 	 nil)
 	(t
 	 (process-wait-with-timeout "Sleep" n (constantly nil)))))
diff --git a/src/lisp/os-common.c b/src/lisp/os-common.c
index 5c8462a63..a936716d1 100755
--- a/src/lisp/os-common.c
+++ b/src/lisp/os-common.c
@@ -9,6 +9,8 @@
 #include <netdb.h>
 #include <stdio.h>
 #include <string.h>
+#include <time.h>
+#include <math.h>
 
 #include "os.h"
 #include "internals.h"
@@ -562,3 +564,21 @@ int ieee754_rem_pio2(double x, double *y0, double *y1)
 
   return n;
 }
+
+/*
+ * sleep for the given number of seconds, even if we're interrupted.
+ */
+void os_sleep(double seconds)
+{
+    struct timespec requested;
+    struct timespec remaining;
+    double integral;
+    double fractional;
+
+    fractional = modf(seconds, &integral);
+    requested.tv_sec = (time_t) integral;
+    requested.tv_nsec = (long) trunc(fractional * 1e9);
+    while (nanosleep(&requested, &remaining) == -1 && errno == EINTR) {
+	requested = remaining;
+    }
+}
-- 
GitLab