ghc/lib/std/CPUTime.hsc

   1 -- -----------------------------------------------------------------------------
   2 -- $Id: CPUTime.hsc,v 1.2 2001/05/08 17:33:57 qrczak 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
  98 type CRUsage = ()
  99 foreign import unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt
 100 #else
 101 # if defined(HAVE_TIMES)
 102     allocaBytes (#const sizeof(struct tms)) $ \ p_tms -> do
 103     times p_tms
 104     u_ticks  <- (#peek struct tms,tms_utime) p_tms :: IO CClock
 105     s_ticks  <- (#peek struct tms,tms_stime) p_tms :: IO CClock
 106     return (( (fromIntegral u_ticks + fromIntegral s_ticks) * 1000000000000)
 107                         `div` clockTicks)
 108
 109 type CTms = ()
 110 foreign import unsafe times :: Ptr CTms -> CClock
 111 # else
 112     ioException (IOError Nothing UnsupportedOperation
 113                          "getCPUTime"
 114                          "can't get CPU time"
 115                          Nothing)
 116 # endif
 117 #endif
 118
 119 #else /* _WIN32 */
 120
 121 #error ToDo!!!
 122
 123 #ifdef _WIN32
 124 /* 100ns units per sec, really */
 125 #define NS_PER_SEC 10000000LL
 126 #define FT2usecs(ll,ft)    \
 127     (ll)=(ft).dwHighDateTime; \
 128     (ll) <<= 32;              \
 129     (ll) |= (ft).dwLowDateTime;
 130
 131 #endif
 132
 133 /* cygwin32 or mingw32 version */
 134 StgInt
 135 getCPUTime(StgByteArray cpuStruct)
 136 {
 137     FILETIME creationTime, exitTime, kernelTime, userTime;
 138     StgInt *cpu=(StgInt *)cpuStruct;
 139     unsigned long long uT, kT;
 140
 141     /* ToDo: pin down elapsed times to just the OS thread(s) that
 142        are evaluating/managing Haskell code.
 143     */
 144     if (!GetProcessTimes (GetCurrentProcess(), &creationTime,
 145                           &exitTime, &kernelTime, &userTime)) {
 146         /* Probably on a Win95 box..*/
 147         cpu[0]=0;
 148         cpu[1]=0;
 149         cpu[2]=0;
 150         cpu[3]=0;
 151         return 1;
 152     }
 153
 154     FT2usecs(uT, userTime);
 155     FT2usecs(kT, kernelTime);
 156
 157     cpu[0] = (unsigned int)(uT / NS_PER_SEC);
 158     cpu[1] = (unsigned int)((uT - cpu[0] * NS_PER_SEC) * 100);
 159     cpu[2] = (unsigned int)(kT / NS_PER_SEC);
 160     cpu[3] = (unsigned int)((kT - cpu[2] * NS_PER_SEC) * 100);
 161     return 1;
 162 }
 163 #endif /* WIN32 */
 164
 165 cpuTimePrecision :: Integer
 166 cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks))
 167
 168 clockTicks :: Int
 169 clockTicks =
 170 #if defined(CLK_TCK)
 171     (#const CLK_TCK)
 172 #else
 173     unsafePerformIO (sysconf (#const _SC_CLK_TCK) >>= return . fromIntegral)
 174 foreign import unsafe sysconf :: CInt -> IO CLong
 175 #endif