{-# LINE 1 "libraries\base\System\CPUTime.hsc" #-} {-# LANGUAGE Trustworthy #-} {-# LINE 2 "libraries\base\System\CPUTime.hsc" #-} {-# LANGUAGE CPP, NondecreasingIndentation, CApiFFI #-} ----------------------------------------------------------------------------- -- | -- Module : System.CPUTime -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- The standard CPUTime library. -- ----------------------------------------------------------------------------- {-# LINE 19 "libraries\base\System\CPUTime.hsc" #-} {-# LINE 20 "libraries\base\System\CPUTime.hsc" #-} module System.CPUTime ( getCPUTime, -- :: IO Integer cpuTimePrecision -- :: Integer ) where import Data.Ratio import Foreign import Foreign.C -- For struct rusage {-# LINE 38 "libraries\base\System\CPUTime.hsc" #-} -- For FILETIME etc. on Windows {-# LINE 41 "libraries\base\System\CPUTime.hsc" #-} {-# LINE 42 "libraries\base\System\CPUTime.hsc" #-} {-# LINE 43 "libraries\base\System\CPUTime.hsc" #-} -- for struct tms {-# LINE 48 "libraries\base\System\CPUTime.hsc" #-} #ifdef mingw32_HOST_OS # if defined(i386_HOST_ARCH) # define WINDOWS_CCONV stdcall # elif defined(x86_64_HOST_ARCH) # define WINDOWS_CCONV ccall # else # error Unknown mingw32 arch # endif #else #endif {-# LINE 66 "libraries\base\System\CPUTime.hsc" #-} -- ----------------------------------------------------------------------------- -- |Computation 'getCPUTime' returns the number of picoseconds CPU time -- used by the current program. The precision of this result is -- implementation-dependent. getCPUTime :: IO Integer getCPUTime = do {-# LINE 117 "libraries\base\System\CPUTime.hsc" #-} -- 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 120 "libraries\base\System\CPUTime.hsc" #-} allocaBytes (8) $ \ p_exitTime -> do {-# LINE 121 "libraries\base\System\CPUTime.hsc" #-} allocaBytes (8) $ \ p_kernelTime -> do {-# LINE 122 "libraries\base\System\CPUTime.hsc" #-} allocaBytes (8) $ \ p_userTime -> do {-# LINE 123 "libraries\base\System\CPUTime.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 134 "libraries\base\System\CPUTime.hsc" #-} low <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ft :: IO Word32 {-# LINE 135 "libraries\base\System\CPUTime.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. type FILETIME = () type HANDLE = () -- need proper Haskell names (initial lower-case character) foreign import WINDOWS_CCONV unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE) foreign import WINDOWS_CCONV unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt {-# LINE 149 "libraries\base\System\CPUTime.hsc" #-} -- |The 'cpuTimePrecision' constant is the smallest measurable difference -- in CPU time that the implementation can record, and is given as an -- integral number of picoseconds. cpuTimePrecision :: Integer cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks)) foreign import ccall unsafe clk_tck :: CLong clockTicks :: Int clockTicks = fromIntegral clk_tck