ghc/lib/std/CPUTime.hsc

   1 -- -----------------------------------------------------------------------------
   2 -- $Id: CPUTime.hsc,v 1.1 2001/05/08 08:55:17 simonmar 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 PrelCTypesISO
  15 import PrelCTypes
  16 import PrelStorable
  17 import PrelPtr
  18
  19 import PrelBase         ( Int(..) )
  20 import PrelByteArr      ( ByteArray(..), newIntArray )
  21 import PrelArrExtra     ( unsafeFreezeByteArray )
  22 import PrelIOBase       ( IOException(..),
  23                           IOErrorType( UnsupportedOperation ),
  24                           unsafePerformIO, stToIO, ioException )
  25 import Ratio
  26
  27 #include "config.h"
  28
  29 #ifdef HAVE_SYS_TYPES_H
  30 #include <sys/types.h>
  31 #endif
  32
  33 #ifdef HAVE_UNISTD_H
  34 #include <unistd.h>
  35 #endif
  36
  37 #ifndef mingw32_TARGET_OS
  38 # ifdef HAVE_SYS_TIMES_H
  39 #  include <sys/times.h>
  40 # endif
  41 #endif
  42
  43 #ifdef HAVE_SYS_TIME_H
  44 #include <sys/time.h>
  45 #endif
  46
  47 #if !defined(mingw32_TARGET_OS) && !defined(irix_TARGET_OS)
  48 # if defined(HAVE_SYS_RESOURCE_H)
  49 #  include <sys/resource.h>
  50 # endif
  51 #endif
  52
  53 #ifdef hpux_TARGET_OS
  54 #include <sys/syscall.h>
  55 #define getrusage(a, b)  syscall(SYS_GETRUSAGE, a, b)
  56 #define HAVE_GETRUSAGE
  57 #endif
  58
  59 #ifdef HAVE_WINDOWS_H
  60 # include <windows.h>
  61 #endif
  62
  63 -- -----------------------------------------------------------------------------
  64 -- Computation `getCPUTime' returns the number of picoseconds CPU time
  65 -- used by the current program.  The precision of this result is
  66 -- implementation-dependent.
  67
  68 -- The `cpuTimePrecision' constant is the smallest measurable difference
  69 -- in CPU time that the implementation can record, and is given as an
  70 -- integral number of picoseconds.
  71
  72 getCPUTime :: IO Integer
  73 getCPUTime = do
  74
  75 #ifndef _WIN32
  76 -- getrusage() is right royal pain to deal with when targetting multiple
  77 -- versions of Solaris, since some versions supply it in libc (2.3 and 2.5),
  78 -- while 2.4 has got it in libucb (I wouldn't be too surprised if it was back
  79 -- again in libucb in 2.6..)
  80 --
  81 -- Avoid the problem by resorting to times() instead.
  82 --
  83 #if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS && ! solaris2_TARGET_OS
  84     allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do
  85     getrusage (#const RUSAGE_SELF) p_rusage
  86
  87     let ru_utime = (#ptr struct rusage, ru_utime) p_rusage
  88     let ru_stime = (#ptr struct rusage, ru_stime) p_rusage
  89     u_sec  <- (#peek struct timeval,tv_sec)  ru_utime :: IO CLong
  90     u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CLong
  91     s_sec  <- (#peek struct timeval,tv_sec)  ru_stime :: IO CLong
  92     s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CLong
  93
  94     return ((fromIntegral u_sec * 1000000 + fromIntegral u_usec +
  95              fromIntegral s_sec * 1000000 + fromIntegral s_usec)
  96                 * 1000000)
  97 #else
  98 # if defined(HAVE_TIMES)
  99     allocaBytes (#const sizeof(struct tms)) $ \ p_tms ->
 100     times p_tms
 101     u_ticks  <- (#peek struct tms,tms_utime) p_tms :: IO CClock
 102     s_ticks  <- (#peek struct tms,tms_stime) p_tms :: IO CClock
 103     return (( (fromIntegral u_ticks + fromIntegral s_ticks) * 1000000000000)
 104                         `div` clockTicks)
 105 # else
 106     ioException (IOError Nothing UnsupportedOperation
 107                          "getCPUTime"
 108                          "can't get CPU time"
 109                          Nothing)
 110 # endif
 111 #endif
 112
 113 #else /* _WIN32 */
 114
 115 #error ToDo!!!
 116
 117 #ifdef _WIN32
 118 /* 100ns units per sec, really */
 119 #define NS_PER_SEC 10000000LL
 120 #define FT2usecs(ll,ft)    \
 121     (ll)=(ft).dwHighDateTime; \
 122     (ll) <<= 32;              \
 123     (ll) |= (ft).dwLowDateTime;
 124
 125 #endif
 126
 127 /* cygwin32 or mingw32 version */
 128 StgInt
 129 getCPUTime(StgByteArray cpuStruct)
 130 {
 131     FILETIME creationTime, exitTime, kernelTime, userTime;
 132     StgInt *cpu=(StgInt *)cpuStruct;
 133     unsigned long long uT, kT;
 134
 135     /* ToDo: pin down elapsed times to just the OS thread(s) that
 136        are evaluating/managing Haskell code.
 137     */
 138     if (!GetProcessTimes (GetCurrentProcess(), &creationTime,
 139                           &exitTime, &kernelTime, &userTime)) {
 140         /* Probably on a Win95 box..*/
 141         cpu[0]=0;
 142         cpu[1]=0;
 143         cpu[2]=0;
 144         cpu[3]=0;
 145         return 1;
 146     }
 147
 148     FT2usecs(uT, userTime);
 149     FT2usecs(kT, kernelTime);
 150
 151     cpu[0] = (unsigned int)(uT / NS_PER_SEC);
 152     cpu[1] = (unsigned int)((uT - cpu[0] * NS_PER_SEC) * 100);
 153     cpu[2] = (unsigned int)(kT / NS_PER_SEC);
 154     cpu[3] = (unsigned int)((kT - cpu[2] * NS_PER_SEC) * 100);
 155     return 1;
 156 }
 157 #endif /* WIN32 */
 158
 159 cpuTimePrecision :: Integer
 160 cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks))
 161
 162 clockTicks :: Int
 163 clockTicks =
 164 #if defined(CLK_TCK)
 165     (#const CLK_TCK)
 166 #else
 167     unsafePerformIO (sysconf (#const _SC_CLK_TCK) >>= return . fromIntegral)
 168 #endif
 169
 170 type CRUsage = ()
 171 foreign import unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt
 172 foreign import unsafe sysconf   :: CInt -> IO CLong