module System.Posix.Realtime.RTTime (
TimerId,
ClockId(..),
SetTimeFlag(..),
timerCreate,
timerDelete,
timerSetTime,
timerGetTime,
timerGetOverrun,
clockGetRes,
clockGetTime,
clockSetTime
) where
import System.Posix.Realtime.RTDataTypes
import System.Posix.Types
import System.Posix.Error
import System.Posix.Internals
import Foreign
import Foreign.C
type TimerId = Int
data ClockId = Clock_Realtime
| Clock_Monotonic
| Clock_Process_CPUTime_ID
| Clock_Thread_CPUTime_ID
type CClockId = Int
data SetTimeFlag = Timer_Abstime
timerCreate :: ClockId -> Maybe Sigevent -> IO TimerId
timerCreate clockId (Just sigEvent) =
allocaBytes (64) $ \ p_sigevent -> do
allocaBytes (4) $ \ p_timerId -> do
poke p_sigevent sigEvent
throwErrnoIfMinus1 "timerCreate" (c_timer_create (fromIntegral (mapClockId clockId)) p_sigevent p_timerId)
timerId <- peek p_timerId
return timerId
timerCreate clockId Nothing =
allocaBytes (4) $ \ p_timerId -> do
throwErrnoIfMinus1 "timerCreate" (c_timer_create (fromIntegral (mapClockId clockId)) nullPtr p_timerId)
timerId <- peek p_timerId
return (timerId)
foreign import ccall safe "time.h timer_create"
c_timer_create :: CInt -> Ptr Sigevent -> Ptr TimerId -> IO CInt
timerDelete :: TimerId -> IO ()
timerDelete timerId = do
throwErrnoIfMinus1 "timerDelete" (c_timer_delete (fromIntegral timerId))
return ()
foreign import ccall safe "time.h timer_delete"
c_timer_delete :: CInt -> IO CInt
timerGetTime :: TimerId -> IO ItimerSpec
timerGetTime timerId =
allocaBytes (32) $ \ p_itimerSpec -> do
throwErrnoIfMinus1 "timerGettime" (c_timer_gettime (fromIntegral timerId) p_itimerSpec)
itimerSpec <- peek p_itimerSpec
return itimerSpec
foreign import ccall safe "time.h timer_gettime"
c_timer_gettime :: CInt -> Ptr ItimerSpec-> IO CInt
timerSetTime :: TimerId -> SetTimeFlag -> ItimerSpec -> IO ItimerSpec
timerSetTime timerId setTimeFlag itimerSpec = do
allocaBytes (32) $ \ p_itimerSpec -> do
poke p_itimerSpec itimerSpec
allocaBytes (32) $ \ p_olditimerSpec -> do
throwErrnoIfMinus1 "timerSettime" (c_timer_settime (fromIntegral timerId) (cSetTimeFlag) p_itimerSpec p_olditimerSpec)
olditimerSpec <- peek p_olditimerSpec
return olditimerSpec
where
cSetTimeFlag = case setTimeFlag of
Timer_Abstime -> (1)
foreign import ccall safe "time.h timer_settime"
c_timer_settime :: CInt -> CInt -> Ptr ItimerSpec -> Ptr ItimerSpec-> IO CInt
timerGetOverrun :: TimerId -> IO Int
timerGetOverrun timerId = do
rc <- throwErrnoIfMinus1 "timerGetoverrun" (c_timer_getoverrun (fromIntegral timerId))
return (fromIntegral rc)
foreign import ccall safe "time.h timer_getoverrun"
c_timer_getoverrun :: CInt -> IO CInt
clockGetRes :: ClockId -> IO TimeSpec
clockGetRes clockId =
allocaBytes (16) $ \ p_timeSpec -> do
throwErrnoIfMinus1 "clockGetres" (c_clock_getres (fromIntegral (mapClockId clockId)) p_timeSpec)
timeSpec <- peek p_timeSpec
return timeSpec
foreign import ccall safe "time.h clock_getres"
c_clock_getres :: CInt -> Ptr TimeSpec -> IO CInt
clockGetTime :: ClockId -> IO TimeSpec
clockGetTime clockId =
allocaBytes (16) $ \ p_timeSpec -> do
throwErrnoIfMinus1 "clockGettime" (c_clock_gettime (fromIntegral (mapClockId clockId)) p_timeSpec)
timeSpec <- peek p_timeSpec
return (timeSpec)
foreign import ccall safe "time.h clock_gettime"
c_clock_gettime :: CInt -> Ptr TimeSpec -> IO CInt
clockSetTime :: ClockId -> TimeSpec -> IO ()
clockSetTime clockId timeSpec =
allocaBytes (16) $ \ p_timeSpec -> do
throwErrnoIfMinus1 "clockSettime" (c_clock_settime (fromIntegral (mapClockId clockId)) p_timeSpec)
return ()
foreign import ccall safe "time.h clock_settime"
c_clock_settime :: CInt -> Ptr TimeSpec -> IO CInt
mapClockId :: ClockId -> CClockId
mapClockId clockId = case clockId of
Clock_Realtime -> (0)
Clock_Monotonic -> (1)
Clock_Process_CPUTime_ID -> (2)
Clock_Thread_CPUTime_ID -> (3)