X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FCPUTime.hsc;h=c2faa1c51b7a4d52042de1eb384c06275db4705d;hb=685432ac839f249ccd98bdf79fcf0c985872380b;hp=307b2a2ddb796ccf58083555516f23913196ab5e;hpb=606ec04189d5038f6b5a6cc09cfe2e1ee10f8dad;p=ghc-base.git diff --git a/System/CPUTime.hsc b/System/CPUTime.hsc index 307b2a2..c2faa1c 100644 --- a/System/CPUTime.hsc +++ b/System/CPUTime.hsc @@ -34,13 +34,43 @@ import CPUTime ( getCPUTime, cpuTimePrecision ) import Foreign import Foreign.C -#include "HsBase.h" +#include "HsBaseConfig.h" + +-- For _SC_CLK_TCK +#if HAVE_UNISTD_H +#include +#endif + +-- For struct rusage +#if !defined(mingw32_HOST_OS) && !defined(irix_HOST_OS) +# if HAVE_SYS_RESOURCE_H +# include +# endif +#endif + +-- For FILETIME etc. on Windows +#if HAVE_WINDOWS_H +#include +#endif + +-- for CLK_TCK +#if HAVE_TIME_H +#include +#endif + +-- for struct tms +#if HAVE_SYS_TIMES_H +#include #endif +#endif + +#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) realToInteger :: Real a => a -> Integer realToInteger ct = round (realToFrac ct :: Double) -- CTime, CClock, CUShort etc are in Real but not Fractional, -- so we must convert to Double before we can round it +#endif #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- @@ -61,7 +91,7 @@ getCPUTime = do -- #if defined(HAVE_GETRUSAGE) && ! irix_HOST_OS && ! solaris2_HOST_OS allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do - getrusage (#const RUSAGE_SELF) p_rusage + throwErrnoIfMinus1_ "getrusage" $ getrusage (#const RUSAGE_SELF) p_rusage let ru_utime = (#ptr struct rusage, ru_utime) p_rusage let ru_stime = (#ptr struct rusage, ru_stime) p_rusage @@ -78,7 +108,7 @@ foreign import ccall unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt #else # if defined(HAVE_TIMES) allocaBytes (#const sizeof(struct tms)) $ \ p_tms -> do - times p_tms + _ <- times p_tms u_ticks <- (#peek struct tms,tms_utime) p_tms :: IO CClock s_ticks <- (#peek struct tms,tms_stime) p_tms :: IO CClock return (( (realToInteger u_ticks + realToInteger s_ticks) * 1000000000000) @@ -115,7 +145,7 @@ foreign import ccall unsafe times :: Ptr CTms -> IO CClock low <- (#peek FILETIME,dwLowDateTime) ft :: IO Word32 -- Convert 100-ns units to picosecs (10^-12) -- => multiply by 10^5. - return (((fromIntegral high) * (2^32) + (fromIntegral low)) * 100000) + 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.