ghc/lib/std/CPUTime.hsc

   1 -- -----------------------------------------------------------------------------
   2 -- $Id: CPUTime.hsc,v 1.13 2001/09/06 15:15:23 sewardj Exp $
   3 --
   4 -- (c) The University of Glasgow, 1995-2001
   5 --
   6
   7 module CPUTime
   8         (
   9          getCPUTime,       -- :: IO Integer
  10          cpuTimePrecision  -- :: Integer
  11         ) where
  12
  13 import PrelMarshalAlloc
  14 import PrelMarshalUtils ( toBool )
  15 import PrelCTypesISO
  16 import PrelCTypes
  17 import PrelStorable
  18 import PrelPtr
  19
  20 import PrelBase         ( Int(..) )
  21 import PrelByteArr      ( ByteArray(..), newIntArray )
  22 import PrelArrExtra     ( unsafeFreezeByteArray )
  23 import PrelIOBase       ( IOException(..) )
  24 import Ratio
  25
  26 #include "HsStd.h"
  27
  28 -- -----------------------------------------------------------------------------
  29 -- Computation `getCPUTime' returns the number of picoseconds CPU time
  30 -- used by the current program.  The precision of this result is
  31 -- implementation-dependent.
  32
  33 -- The `cpuTimePrecision' constant is the smallest measurable difference
  34 -- in CPU time that the implementation can record, and is given as an
  35 -- integral number of picoseconds.
  36
  37 getCPUTime :: IO Integer
  38 getCPUTime = do
  39
  40 #if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
  41 -- getrusage() is right royal pain to deal with when targetting multiple
  42 -- versions of Solaris, since some versions supply it in libc (2.3 and 2.5),
  43 -- while 2.4 has got it in libucb (I wouldn't be too surprised if it was back
  44 -- again in libucb in 2.6..)
  45 --
  46 -- Avoid the problem by resorting to times() instead.
  47 --
  48 #if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS && ! solaris2_TARGET_OS
  49     allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do
  50     getrusage (#const RUSAGE_SELF) p_rusage
  51
  52     let ru_utime = (#ptr struct rusage, ru_utime) p_rusage
  53     let ru_stime = (#ptr struct rusage, ru_stime) p_rusage
  54     u_sec  <- (#peek struct timeval,tv_sec)  ru_utime :: IO CTime
  55     u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime
  56     s_sec  <- (#peek struct timeval,tv_sec)  ru_stime :: IO CTime
  57     s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime
  58
  59     return ((fromIntegral u_sec * 1000000 + fromIntegral u_usec +
  60              fromIntegral s_sec * 1000000 + fromIntegral s_usec)
  61                 * 1000000)
  62
  63 type CRUsage = ()
  64 foreign import unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt
  65 #else
  66 # if defined(HAVE_TIMES)
  67     allocaBytes (#const sizeof(struct tms)) $ \ p_tms -> do
  68     times p_tms
  69     u_ticks  <- (#peek struct tms,tms_utime) p_tms :: IO CClock
  70     s_ticks  <- (#peek struct tms,tms_stime) p_tms :: IO CClock
  71     return (( (fromIntegral u_ticks + fromIntegral s_ticks) * 1000000000000)
  72                         `div` fromIntegral clockTicks)
  73
  74 type CTms = ()
  75 foreign import unsafe times :: Ptr CTms -> IO CClock
  76 # else
  77     ioException (IOError Nothing UnsupportedOperation
  78                          "getCPUTime"
  79                          "can't get CPU time"
  80                          Nothing)
  81 # endif
  82 #endif
  83
  84 #else /* win32 */
  85     allocaBytes (#const sizeof(FILETIME)) $ \ p_creationTime -> do
  86     allocaBytes (#const sizeof(FILETIME)) $ \ p_exitTime -> do
  87     allocaBytes (#const sizeof(FILETIME)) $ \ p_kernelTime -> do
  88     allocaBytes (#const sizeof(FILETIME)) $ \ p_userTime -> do
  89     pid <- getCurrentProcess
  90     ok <- getProcessTimes pid p_creationTime p_exitTime p_kernelTime p_userTime
  91     if toBool ok then do
  92       ut <- ft2psecs p_userTime
  93       kt <- ft2psecs p_kernelTime
  94       return (fromIntegral (ut + kt))
  95      else return 0
  96   where ft2psecs ft = do
  97           high <- (#peek FILETIME,dwHighDateTime) ft :: IO CLong
  98           low <- (#peek FILETIME,dwLowDateTime) ft :: IO CLong
  99           return (((fromIntegral high) * (2^32) + (fromIntegral low)) * 100000)
 100
 101     -- ToDo: pin down elapsed times to just the OS thread(s) that
 102     -- are evaluating/managing Haskell code.
 103
 104 type FILETIME = ()
 105 type HANDLE = ()
 106 -- need proper Haskell names (initial lower-case character)
 107 foreign import "GetCurrentProcess" unsafe getCurrentProcess :: IO (Ptr HANDLE)
 108 foreign import "GetProcessTimes" unsafe getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt
 109
 110 #endif /* not _WIN32 */
 111
 112 cpuTimePrecision :: Integer
 113 cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks))
 114
 115 clockTicks :: Int
 116 clockTicks =
 117 #if defined(CLK_TCK)
 118     (#const CLK_TCK)
 119 #else
 120     unsafePerformIO (sysconf (#const _SC_CLK_TCK) >>= return . fromIntegral)
 121 foreign import unsafe sysconf :: CInt -> IO CLong
 122 #endif