[commit: ghc] master: base: Track timer PSQ timeouts as Word64 instead of Double (ab2dcb1)
git at git.haskell.org
git at git.haskell.org
Tue Apr 18 00:35:23 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/ab2dcb1c474d918efdc875f3cca7ef5b6ebdce1a/ghc
>---------------------------------------------------------------
commit ab2dcb1c474d918efdc875f3cca7ef5b6ebdce1a
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Mon Apr 17 11:17:00 2017 -0400
base: Track timer PSQ timeouts as Word64 instead of Double
Test Plan: Validate on all the platforms
Reviewers: nh2, hvr, austin
Subscribers: Phyx, nh2, rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3417
>---------------------------------------------------------------
ab2dcb1c474d918efdc875f3cca7ef5b6ebdce1a
libraries/base/GHC/Event/Clock.hsc | 10 +++++++---
libraries/base/GHC/Event/EPoll.hsc | 6 ++++--
libraries/base/GHC/Event/Internal.hs | 5 +++--
libraries/base/GHC/Event/KQueue.hsc | 12 ++++++------
libraries/base/GHC/Event/PSQ.hs | 4 ++--
libraries/base/GHC/Event/Poll.hsc | 6 ++++--
libraries/base/GHC/Event/TimerManager.hs | 14 +++++++-------
7 files changed, 33 insertions(+), 24 deletions(-)
diff --git a/libraries/base/GHC/Event/Clock.hsc b/libraries/base/GHC/Event/Clock.hsc
index 5dbdb67..7f98a03 100644
--- a/libraries/base/GHC/Event/Clock.hsc
+++ b/libraries/base/GHC/Event/Clock.hsc
@@ -1,7 +1,10 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
-module GHC.Event.Clock (getMonotonicTime) where
+module GHC.Event.Clock
+ ( getMonotonicTime
+ , getMonotonicTimeNSec
+ ) where
import GHC.Base
import GHC.Real
@@ -9,9 +12,10 @@ import Data.Word
-- | Return monotonic time in seconds, since some unspecified starting point
getMonotonicTime :: IO Double
-getMonotonicTime = do w <- getMonotonicNSec
+getMonotonicTime = do w <- getMonotonicTimeNSec
return (fromIntegral w / 1000000000)
+-- | Return monotonic time in nanoseconds, since some unspecified starting point
foreign import ccall unsafe "getMonotonicNSec"
- getMonotonicNSec :: IO Word64
+ getMonotonicTimeNSec :: IO Word64
diff --git a/libraries/base/GHC/Event/EPoll.hsc b/libraries/base/GHC/Event/EPoll.hsc
index 47e69a6..32bfc39 100644
--- a/libraries/base/GHC/Event/EPoll.hsc
+++ b/libraries/base/GHC/Event/EPoll.hsc
@@ -48,7 +48,7 @@ import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(..))
import GHC.Base
import GHC.Num (Num(..))
-import GHC.Real (ceiling, fromIntegral)
+import GHC.Real (fromIntegral, div)
import GHC.Show (Show)
import System.Posix.Internals (c_close)
import System.Posix.Internals (setCloseOnExec)
@@ -223,7 +223,9 @@ toEvent e = remap (epollIn .|. epollErr .|. epollHup) E.evtRead `mappend`
fromTimeout :: Timeout -> Int
fromTimeout Forever = -1
-fromTimeout (Timeout s) = ceiling $ 1000 * s
+fromTimeout (Timeout s) = fromIntegral $ s `divRoundUp` 1000000
+ where
+ divRoundUp num denom = (num + denom - 1) `div` denom
foreign import ccall unsafe "sys/epoll.h epoll_create"
c_epoll_create :: CInt -> IO CInt
diff --git a/libraries/base/GHC/Event/Internal.hs b/libraries/base/GHC/Event/Internal.hs
index f6eb8ef..9b8230c 100644
--- a/libraries/base/GHC/Event/Internal.hs
+++ b/libraries/base/GHC/Event/Internal.hs
@@ -33,6 +33,7 @@ import Data.OldList (foldl', filter, intercalate, null)
import Foreign.C.Error (eINTR, getErrno, throwErrno)
import System.Posix.Types (Fd)
import GHC.Base
+import GHC.Word (Word64)
import GHC.Num (Num(..))
import GHC.Show (Show(..))
@@ -133,8 +134,8 @@ elEvent :: EventLifetime -> Event
elEvent (EL x) = Event (x .&. 0x7)
{-# INLINE elEvent #-}
--- | A type alias for timeouts, specified in seconds.
-data Timeout = Timeout {-# UNPACK #-} !Double
+-- | A type alias for timeouts, specified in nanoseconds.
+data Timeout = Timeout {-# UNPACK #-} !Word64
| Forever
deriving (Show)
diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc
index f26d199..a76cc51 100644
--- a/libraries/base/GHC/Event/KQueue.hsc
+++ b/libraries/base/GHC/Event/KQueue.hsc
@@ -38,7 +38,7 @@ import Foreign.Storable (Storable(..))
import GHC.Base
import GHC.Enum (toEnum)
import GHC.Num (Num(..))
-import GHC.Real (ceiling, floor, fromIntegral)
+import GHC.Real (quotRem, fromIntegral)
import GHC.Show (Show(show))
import GHC.Event.Internal (Timeout(..))
import System.Posix.Internals (c_close)
@@ -265,13 +265,13 @@ withTimeSpec ts f
fromTimeout :: Timeout -> TimeSpec
fromTimeout Forever = TimeSpec (-1) (-1)
-fromTimeout (Timeout s) = TimeSpec (toEnum sec) (toEnum nanosec)
+fromTimeout (Timeout s) = TimeSpec (toEnum sec') (toEnum nanosec')
where
- sec :: Int
- sec = floor s
+ (sec, nanosec) = s `quotRem` 1000000000
- nanosec :: Int
- nanosec = ceiling $ (s - fromIntegral sec) * 1000000000
+ nanosec', sec' :: Int
+ sec' = fromIntegral sec
+ nanosec' = fromIntegral nanosec
toEvent :: Filter -> E.Event
toEvent (Filter f)
diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs
index b03bc9c..26ab531 100644
--- a/libraries/base/GHC/Event/PSQ.hs
+++ b/libraries/base/GHC/Event/PSQ.hs
@@ -89,7 +89,7 @@ module GHC.Event.PSQ
) where
import GHC.Base hiding (empty)
-import GHC.Float () -- for Show Double instance
+import GHC.Word (Word64)
import GHC.Num (Num(..))
import GHC.Show (Show(showsPrec))
import GHC.Event.Unique (Unique)
@@ -104,7 +104,7 @@ data Elem a = E
------------------------------------------------------------------------
-- | A mapping from keys @k@ to priorites @p at .
-type Prio = Double
+type Prio = Word64
type Key = Unique
data PSQ a = Void
diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc
index 330007c..5c5ad49 100644
--- a/libraries/base/GHC/Event/Poll.hsc
+++ b/libraries/base/GHC/Event/Poll.hsc
@@ -35,7 +35,7 @@ import GHC.Base
import GHC.Conc.Sync (withMVar)
import GHC.Enum (maxBound)
import GHC.Num (Num(..))
-import GHC.Real (ceiling, fromIntegral)
+import GHC.Real (fromIntegral, div)
import GHC.Show (Show)
import System.Posix.Types (Fd(..))
@@ -143,7 +143,9 @@ poll p mtout f = do
fromTimeout :: E.Timeout -> Int
fromTimeout E.Forever = -1
-fromTimeout (E.Timeout s) = ceiling $ 1000 * s
+fromTimeout (E.Timeout s) = fromIntegral $ s `divRoundUp` 1000000
+ where
+ divRoundUp num denom = (num + denom - 1) `div` denom
data PollFd = PollFd {
pfdFd :: {-# UNPACK #-} !Fd
diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs
index 93b1766..10baa3b 100644
--- a/libraries/base/GHC/Event/TimerManager.hs
+++ b/libraries/base/GHC/Event/TimerManager.hs
@@ -45,9 +45,9 @@ import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
import GHC.Base
import GHC.Conc.Signal (runHandlers)
import GHC.Num (Num(..))
-import GHC.Real ((/), fromIntegral )
+import GHC.Real (fromIntegral)
import GHC.Show (Show(..))
-import GHC.Event.Clock (getMonotonicTime)
+import GHC.Event.Clock (getMonotonicTimeNSec)
import GHC.Event.Control
import GHC.Event.Internal (Backend, Event, evtRead, Timeout(..))
import GHC.Event.Unique (Unique, UniqueSource, newSource, newUnique)
@@ -186,7 +186,7 @@ step mgr = do
-- next timeout.
mkTimeout :: IO Timeout
mkTimeout = do
- now <- getMonotonicTime
+ now <- getMonotonicTimeNSec
(expired, timeout) <- atomicModifyIORef' (emTimeouts mgr) $ \tq ->
let (expired, tq') = Q.atMost now tq
timeout = case Q.minView tq' of
@@ -215,8 +215,8 @@ registerTimeout mgr us cb = do
!key <- newUnique (emUniqueSource mgr)
if us <= 0 then cb
else do
- now <- getMonotonicTime
- let expTime = fromIntegral us / 1000000.0 + now
+ now <- getMonotonicTimeNSec
+ let expTime = fromIntegral us * 1000 + now
editTimeouts mgr (Q.insert key expTime cb)
wakeManager mgr
@@ -232,8 +232,8 @@ unregisterTimeout mgr (TK key) = do
-- microseconds.
updateTimeout :: TimerManager -> TimeoutKey -> Int -> IO ()
updateTimeout mgr (TK key) us = do
- now <- getMonotonicTime
- let expTime = fromIntegral us / 1000000.0 + now
+ now <- getMonotonicTimeNSec
+ let expTime = fromIntegral us * 1000 + now
editTimeouts mgr (Q.adjust (const expTime) key)
wakeManager mgr
More information about the ghc-commits
mailing list