Provide nanosleep if we have it, and use it to implement usleep

Fixes #1156

2 files changed, 41 insertions, 4 deletions

diff --git a/System/Posix/Unistd.hsc b/System/Posix/Unistd.hsc
index 011abea..1463d25 100644
--- a/System/Posix/Unistd.hsc
+++ b/System/Posix/Unistd.hsc
@@ -22,7 +22,7 @@ module System.Posix.Unistd (
     getSysVar,
 
     -- * Sleeping
-    sleep, usleep,
+    sleep, usleep, nanosleep,
 
   {-
     ToDo from unistd.h:
@@ -50,9 +50,8 @@ module System.Posix.Unistd (
 
 import Foreign.C.Error
 import Foreign.C.String ( peekCString )
-import Foreign.C.Types ( CInt, CUInt, CLong )
-import Foreign.Marshal.Alloc ( allocaBytes )
-import Foreign.Ptr ( Ptr, plusPtr )
+import Foreign.C.Types
+import Foreign
 import System.Posix.Types
 import System.Posix.Internals
 
@@ -110,6 +109,9 @@ foreign import ccall safe "sleep"
 -- neither of these shortcomings.
 --
 usleep :: Int -> IO ()
+#ifdef HAVE_NANOSLEEP
+usleep usecs = nanosleep (fromIntegral usecs * 1000)
+#else
 usleep 0 = return ()
 #ifdef USLEEP_RETURNS_VOID
 usleep usecs = c_usleep (fromIntegral usecs)
@@ -124,6 +126,40 @@ foreign import ccall safe "usleep"
 foreign import ccall safe "usleep"
   c_usleep :: CUInt -> IO CInt
 #endif
+#endif /* HAVE_NANOSLEEP */
+
+-- | Sleep for the specified duration (in nanoseconds)
+--
+nanosleep :: Integer -> IO ()
+#ifndef HAVE_NANOSLEEP
+nanosleep = error "nanosleep: not available on this platform"
+#else
+nanosleep 0 = return ()
+nanosleep nsecs = do
+  allocaBytes (#const sizeof(struct timespec)) $ \pts1 -> do
+  allocaBytes (#const sizeof(struct timespec)) $ \pts2 -> do
+     let (tv_sec,tv_nsec) = nsecs `divMod` 1000000000
+     let 
+       loop tv_sec tv_nsec = do
+         (#poke struct timespec, tv_sec)  pts1 tv_sec
+         (#poke struct timespec, tv_nsec) pts1 tv_nsec
+         res <- c_nanosleep pts1 pts2
+         if res == 0
+            then return ()
+            else do errno <- getErrno
+                    if errno == eINTR
+                       then do
+                           tv_sec  <- (#peek struct timespec, tv_sec)  pts2
+                           tv_nsec <- (#peek struct timespec, tv_nsec) pts2
+                           loop tv_sec tv_nsec
+                       else throwErrno "nanosleep"
+     loop (fromIntegral tv_sec :: CTime) (fromIntegral tv_nsec :: CTime)
+
+newtype CTimeSpec = CTimeSpec CTimeSpec
+
+foreign import ccall safe "nanosleep" 
+  c_nanosleep :: Ptr CTimeSpec -> Ptr CTimeSpec -> IO CInt
+#endif
 
 -- -----------------------------------------------------------------------------
 -- System variables
diff --git a/configure.ac b/configure.ac
index e28b11f..1ff48cc 100644
--- a/configure.ac
+++ b/configure.ac
@@ -19,6 +19,7 @@ AC_CHECK_HEADERS([termios.h time.h unistd.h utime.h])
 AC_CHECK_FUNCS([getgrgid_r getgrnam_r getpwnam_r getpwuid_r getpwnam getpwuid])
 AC_CHECK_FUNCS([getpwent getgrent])
 AC_CHECK_FUNCS([lchown setenv sysconf unsetenv])
+AC_CHECK_FUNCS([nanosleep])
 
 AC_MSG_CHECKING([for _SC_GETGR_R_SIZE_MAX])
 AC_EGREP_CPP(we_have_that_sysconf_thing,