X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FCPUTime.hsc;h=603afce7986807fc21c301443ed052c3257d3559;hb=ec3ba94b254bd444e7a1c560c1d91c4879948c69;hp=0ce703e43797208177e40c585916fe57a33c5899;hpb=7b956b7f0850b3ea1f006ac301cc148b3fda8d57;p=ghc-base.git diff --git a/System/CPUTime.hsc b/System/CPUTime.hsc index 0ce703e..603afce 100644 --- a/System/CPUTime.hsc +++ b/System/CPUTime.hsc @@ -2,7 +2,7 @@ -- | -- Module : System.CPUTime -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional @@ -26,6 +26,10 @@ import Data.Ratio import Hugs.Time ( getCPUTime, clockTicks ) #endif +#ifdef __NHC__ +import CPUTime ( getCPUTime, cpuTimePrecision ) +#endif + #ifdef __GLASGOW_HASKELL__ import Foreign import Foreign.C @@ -42,7 +46,7 @@ import Foreign.C getCPUTime :: IO Integer getCPUTime = do -#if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS) +#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) -- getrusage() is right royal pain to deal with when targetting multiple -- versions of Solaris, since some versions supply it in libc (2.3 and 2.5), -- while 2.4 has got it in libucb (I wouldn't be too surprised if it was back @@ -50,7 +54,7 @@ getCPUTime = do -- -- Avoid the problem by resorting to times() instead. -- -#if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS && ! solaris2_TARGET_OS +#if defined(HAVE_GETRUSAGE) && ! irix_HOST_OS && ! solaris2_HOST_OS allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do getrusage (#const RUSAGE_SELF) p_rusage @@ -60,9 +64,9 @@ getCPUTime = do u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime s_sec <- (#peek struct timeval,tv_sec) ru_stime :: IO CTime s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime - - return ((fromIntegral u_sec * 1000000 + fromIntegral u_usec + - fromIntegral s_sec * 1000000 + fromIntegral s_usec) + let realToInteger = round . realToFrac :: Real a => a -> Integer + return ((realToInteger u_sec * 1000000 + realToInteger u_usec + + realToInteger s_sec * 1000000 + realToInteger s_usec) * 1000000) type CRUsage = () @@ -73,7 +77,8 @@ foreign import ccall unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt 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 (( (fromIntegral u_ticks + fromIntegral s_ticks) * 1000000000000) + let realToInteger = round . realToFrac :: Real a => a -> Integer + return (( (realToInteger u_ticks + realToInteger s_ticks) * 1000000000000) `div` fromIntegral clockTicks) type CTms = () @@ -125,8 +130,10 @@ foreign import ccall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> P -- in CPU time that the implementation can record, and is given as an -- integral number of picoseconds. +#ifndef __NHC__ cpuTimePrecision :: Integer cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks)) +#endif #ifdef __GLASGOW_HASKELL__ clockTicks :: Int