{-# LINE 1 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} {-# LANGUAGE CPP, CApiFFI, NondecreasingIndentation, NumDecimals #-} module System.CPUTime.Windows ( getCPUTime , getCpuTimePrecision ) where import Foreign import Foreign.C -- For FILETIME etc. on Windows {-# LINE 16 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} {-# LINE 18 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} getCPUTime :: IO Integer getCPUTime = do -- NOTE: GetProcessTimes() is only supported on NT-based OSes. -- The counts reported by GetProcessTimes() are in 100-ns (10^-7) units. allocaBytes (8) $ \ p_creationTime -> do {-# LINE 24 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} allocaBytes (8) $ \ p_exitTime -> do {-# LINE 25 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} allocaBytes (8) $ \ p_kernelTime -> do {-# LINE 26 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} allocaBytes (8) $ \ p_userTime -> do {-# LINE 27 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} pid <- getCurrentProcess ok <- getProcessTimes pid p_creationTime p_exitTime p_kernelTime p_userTime if toBool ok then do ut <- ft2psecs p_userTime kt <- ft2psecs p_kernelTime return (ut + kt) else return 0 where ft2psecs :: Ptr FILETIME -> IO Integer ft2psecs ft = do high <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ft :: IO Word32 {-# LINE 38 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} low <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ft :: IO Word32 {-# LINE 39 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} -- Convert 100-ns units to picosecs (10^-12) -- => multiply by 10^5. return (((fromIntegral high) * (2^(32::Int)) + (fromIntegral low)) * 100000) -- ToDo: pin down elapsed times to just the OS thread(s) that -- are evaluating/managing Haskell code. -- While it's hard to get reliable numbers, the consensus is that Windows only provides -- 16 millisecond resolution in GetProcessTimes (see Python PEP 0418) getCpuTimePrecision :: IO Integer getCpuTimePrecision = return 16e9 type FILETIME = () type HANDLE = () -- need proper Haskell names (initial lower-case character) {-# LINE 59 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-} foreign import ccall unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE) foreign import ccall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt {-# LINE 64 "libraries\\base\\System\\CPUTime\\Windows.hsc" #-}