{-# LINE 1 "Gauge/Source/Time.hsc" #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Gauge.Source.Time
( initialize
, ClockTime(..)
, CpuTime(..)
, Cycles(..)
, TimeRecord(..)
, MeasurementType(..)
, getCycles
, getTime
, getCPUTime
, getMetrics
, withMetrics
) where
import Control.Applicative
import Data.Word (Word64)
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Prelude
data MeasurementType = Differential | Absolute
newtype ClockTime (ty :: MeasurementType) = ClockTime Word64
deriving (Eq, Storable)
newtype CpuTime (ty :: MeasurementType) = CpuTime Word64
deriving (Eq, Storable)
newtype Cycles (ty :: MeasurementType) = Cycles Word64
deriving (Eq, Storable)
data TimeRecord w = TimeRecord
{-# UNPACK #-} !(ClockTime w)
{-# UNPACK #-} !(CpuTime w)
{-# UNPACK #-} !(Cycles w)
instance Storable (TimeRecord w) where
alignment _ = 8
sizeOf _ = sizeTimeRecord
peek p = TimeRecord <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 53 "Gauge/Source/Time.hsc" #-}
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 54 "Gauge/Source/Time.hsc" #-}
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 55 "Gauge/Source/Time.hsc" #-}
poke p (TimeRecord clock cpu rdtsc) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p clock
{-# LINE 57 "Gauge/Source/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p cpu
{-# LINE 58 "Gauge/Source/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p rdtsc
{-# LINE 59 "Gauge/Source/Time.hsc" #-}
sizeTimeRecord :: Int
sizeTimeRecord = 24
{-# LINE 62 "Gauge/Source/Time.hsc" #-}
getMetrics :: IO (TimeRecord 'Absolute)
getMetrics = alloca $ \ptr -> getRecordPtr ptr >> peek ptr
withMetrics :: IO a -> IO (a, TimeRecord 'Absolute, TimeRecord 'Absolute)
withMetrics f = allocaBytes (sizeTimeRecord * 2) $ \ptr -> do
let ptr2 = ptr `plusPtr` sizeTimeRecord
getRecordPtr ptr
a <- f
getRecordPtr ptr2
(,,) <$> pure a <*> peek ptr <*> peek ptr2
foreign import ccall unsafe "gauge_inittime" initialize :: IO ()
foreign import ccall unsafe "gauge_rdtsc" getCycles :: IO (Cycles 'Absolute)
foreign import ccall unsafe "gauge_gettime" getTime :: IO Double
foreign import ccall unsafe "gauge_getcputime" getCPUTime :: IO Double
foreign import ccall unsafe "gauge_record" getRecordPtr :: Ptr (TimeRecord 'Absolute) -> IO ()