{-# LANGUAGE CPP #-}
module Foundation.Time.StopWatch
( StopWatchPrecise
, startPrecise
, stopPrecise
) where
import Basement.Imports
import Basement.Types.Ptr
import Foundation.Time.Types
import Basement.Block.Mutable
import Foundation.Numerical
import Foreign.Storable
#if defined(mingw32_HOST_OS)
import System.Win32.Time
import Basement.Monad
import Basement.IntegralConv
import System.IO.Unsafe
#elif defined(darwin_HOST_OS)
import Foundation.System.Bindings.Macos
import Basement.IntegralConv
import System.IO.Unsafe
import Basement.Types.OffsetSize
#else
import Foundation.System.Bindings.Time
import Basement.Monad
import Basement.Types.OffsetSize
#endif
newtype StopWatchPrecise =
#if defined(darwin_HOST_OS)
StopWatchPrecise Word64
#elif defined(mingw32_HOST_OS)
StopWatchPrecise (MutableBlock Word8 (PrimState IO))
#else
StopWatchPrecise (MutableBlock Word8 (PrimState IO))
#endif
#if defined(mingw32_HOST_OS)
initPrecise :: Word64
initPrecise = unsafePerformIO $ integralDownsize <$> queryPerformanceFrequency
{-# NOINLINE initPrecise #-}
#elif defined(darwin_HOST_OS)
initPrecise :: (Word64, Word64)
initPrecise :: (Word64, Word64)
initPrecise = IO (Word64, Word64) -> (Word64, Word64)
forall a. IO a -> a
unsafePerformIO (IO (Word64, Word64) -> (Word64, Word64))
-> IO (Word64, Word64) -> (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
MutableBlock Word8 RealWorld
mti <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
newPinned (CSize -> CountOf Word8
sizeOfCSize CSize
size_MachTimebaseInfo)
MutableBlock Word8 (PrimState IO)
-> (Ptr Word8 -> IO (Word64, Word64)) -> IO (Word64, Word64)
forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr MutableBlock Word8 RealWorld
MutableBlock Word8 (PrimState IO)
mti ((Ptr Word8 -> IO (Word64, Word64)) -> IO (Word64, Word64))
-> (Ptr Word8 -> IO (Word64, Word64)) -> IO (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr MachTimebaseInfo -> IO ()
sysMacos_timebase_info (Ptr Word8 -> Ptr MachTimebaseInfo
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p)
let p32 :: Ptr Word32
p32 = Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p :: Ptr Word32
!Word32
n <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32
p32 Ptr Word32 -> Offset Word8 -> Ptr Word32
forall a. Ptr a -> Offset Word8 -> Ptr a
`ptrPlus` Offset Word8
ofs_MachTimebaseInfo_numer)
!Word32
d <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word32
p32 Ptr Word32 -> Offset Word8 -> Ptr Word32
forall a. Ptr a -> Offset Word8 -> Ptr a
`ptrPlus` Offset Word8
ofs_MachTimebaseInfo_denom)
(Word64, Word64) -> IO (Word64, Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Word64
forall a b. IntegralUpsize a b => a -> b
integralUpsize Word32
n, Word32 -> Word64
forall a b. IntegralUpsize a b => a -> b
integralUpsize Word32
d)
{-# NOINLINE initPrecise #-}
#endif
startPrecise :: IO StopWatchPrecise
startPrecise :: IO StopWatchPrecise
startPrecise = do
#if defined(mingw32_HOST_OS)
blk <- newPinned 16
_ <- withMutablePtr blk $ \p -> do
ticks <- integralDownsize <$> queryPerformanceCounter :: IO Word64
let p64 = castPtr p :: Ptr Word64
poke (p64 `ptrPlus` 8) ticks
pure p
pure (StopWatchPrecise blk)
#elif defined(darwin_HOST_OS)
Word64 -> StopWatchPrecise
StopWatchPrecise (Word64 -> StopWatchPrecise) -> IO Word64 -> IO StopWatchPrecise
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word64
sysMacos_absolute_time
#else
blk <- newPinned (sizeOfCSize (size_CTimeSpec + size_CTimeSpec))
_err1 <- withMutablePtr blk $ \p -> do
sysTimeClockGetTime sysTime_CLOCK_MONOTONIC (castPtr p `ptrPlusCSz` size_CTimeSpec)
pure (StopWatchPrecise blk)
#endif
stopPrecise :: StopWatchPrecise -> IO NanoSeconds
stopPrecise :: StopWatchPrecise -> IO NanoSeconds
stopPrecise (StopWatchPrecise Word64
blk) = do
#if defined(mingw32_HOST_OS)
withMutablePtr blk $ \p -> do
end <- integralDownsize <$> queryPerformanceCounter
let p64 = castPtr p :: Ptr Word64
start <- peek (p64 `ptrPlus` 8)
pure $ NanoSeconds ((end - start) * secondInNano `div` initPrecise)
#elif defined(darwin_HOST_OS)
Word64
end <- IO Word64
sysMacos_absolute_time
NanoSeconds -> IO NanoSeconds
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NanoSeconds -> IO NanoSeconds) -> NanoSeconds -> IO NanoSeconds
forall a b. (a -> b) -> a -> b
$ Word64 -> NanoSeconds
NanoSeconds (Word64 -> NanoSeconds) -> Word64 -> NanoSeconds
forall a b. (a -> b) -> a -> b
$ case (Word64, Word64)
initPrecise of
(Word64
1,Word64
1) -> Word64
end Word64 -> Word64 -> Difference Word64
forall a. Subtractive a => a -> a -> Difference a
- Word64
blk
(Word64
numer,Word64
denom) -> ((Word64
end Word64 -> Word64 -> Difference Word64
forall a. Subtractive a => a -> a -> Difference a
- Word64
blk) Word64 -> Word64 -> Word64
forall a. Multiplicative a => a -> a -> a
* Word64
numer) Word64 -> Word64 -> Word64
forall a. IDivisible a => a -> a -> a
`div` Word64
denom
#else
withMutablePtr blk $ \p -> do
_err1 <- sysTimeClockGetTime sysTime_CLOCK_MONOTONIC (castPtr p)
let p64 = castPtr p :: Ptr Word64
endSec <- peek p64
startSec <- peek (p64 `ptrPlusCSz` size_CTimeSpec)
endNSec <- peek (p64 `ptrPlus` ofs_CTimeSpec_NanoSeconds)
startNSec <- peek (p64 `ptrPlus` (sizeAsOffset (sizeOfCSize size_CTimeSpec) + ofs_CTimeSpec_NanoSeconds))
pure $ NanoSeconds $ (endSec * secondInNano + endNSec) - (startSec * secondInNano + startNSec)
#endif
#if !defined(darwin_HOST_OS)
secondInNano :: Word64
secondInNano = 1000000000
#endif