From dc673bca305b43342b864445539b49c353dd6a10 Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 8 May 2001 08:55:18 +0000 Subject: [PATCH] [project @ 2001-05-08 08:55:17 by simonmar] Drop in CPUTime library replacement. Still needs to be ported to Win32. --- ghc/lib/std/CPUTime.hsc | 172 ++++++++++++++++++++++++++++++++++++++++ ghc/lib/std/CPUTime.lhs | 89 --------------------- ghc/lib/std/cbits/getCPUTime.c | 166 -------------------------------------- ghc/lib/std/cbits/stgio.h | 6 +- 4 files changed, 173 insertions(+), 260 deletions(-) create mode 100644 ghc/lib/std/CPUTime.hsc delete mode 100644 ghc/lib/std/CPUTime.lhs delete mode 100644 ghc/lib/std/cbits/getCPUTime.c diff --git a/ghc/lib/std/CPUTime.hsc b/ghc/lib/std/CPUTime.hsc new file mode 100644 index 0000000..090f401 --- /dev/null +++ b/ghc/lib/std/CPUTime.hsc @@ -0,0 +1,172 @@ +-- ----------------------------------------------------------------------------- +-- $Id: CPUTime.hsc,v 1.1 2001/05/08 08:55:17 simonmar Exp $ +-- +-- (c) The University of Glasgow, 1995-2001 +-- + +module CPUTime + ( + getCPUTime, -- :: IO Integer + cpuTimePrecision -- :: Integer + ) where + +import PrelMarshalAlloc +import PrelCTypesISO +import PrelCTypes +import PrelStorable +import PrelPtr + +import PrelBase ( Int(..) ) +import PrelByteArr ( ByteArray(..), newIntArray ) +import PrelArrExtra ( unsafeFreezeByteArray ) +import PrelIOBase ( IOException(..), + IOErrorType( UnsupportedOperation ), + unsafePerformIO, stToIO, ioException ) +import Ratio + +#include "config.h" + +#ifdef HAVE_SYS_TYPES_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifndef mingw32_TARGET_OS +# ifdef HAVE_SYS_TIMES_H +# include +# endif +#endif + +#ifdef HAVE_SYS_TIME_H +#include +#endif + +#if !defined(mingw32_TARGET_OS) && !defined(irix_TARGET_OS) +# if defined(HAVE_SYS_RESOURCE_H) +# include +# endif +#endif + +#ifdef hpux_TARGET_OS +#include +#define getrusage(a, b) syscall(SYS_GETRUSAGE, a, b) +#define HAVE_GETRUSAGE +#endif + +#ifdef HAVE_WINDOWS_H +# include +#endif + +-- ----------------------------------------------------------------------------- +-- Computation `getCPUTime' returns the number of picoseconds CPU time +-- used by the current program. The precision of this result is +-- implementation-dependent. + +-- The `cpuTimePrecision' constant is the smallest measurable difference +-- in CPU time that the implementation can record, and is given as an +-- integral number of picoseconds. + +getCPUTime :: IO Integer +getCPUTime = do + +#ifndef _WIN32 +-- 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 +-- again in libucb in 2.6..) +-- +-- Avoid the problem by resorting to times() instead. +-- +#if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS && ! solaris2_TARGET_OS + allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do + 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 + u_sec <- (#peek struct timeval,tv_sec) ru_utime :: IO CLong + u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CLong + s_sec <- (#peek struct timeval,tv_sec) ru_stime :: IO CLong + s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CLong + + return ((fromIntegral u_sec * 1000000 + fromIntegral u_usec + + fromIntegral s_sec * 1000000 + fromIntegral s_usec) + * 1000000) +#else +# if defined(HAVE_TIMES) + allocaBytes (#const sizeof(struct tms)) $ \ 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 (( (fromIntegral u_ticks + fromIntegral s_ticks) * 1000000000000) + `div` clockTicks) +# else + ioException (IOError Nothing UnsupportedOperation + "getCPUTime" + "can't get CPU time" + Nothing) +# endif +#endif + +#else /* _WIN32 */ + +#error ToDo!!! + +#ifdef _WIN32 +/* 100ns units per sec, really */ +#define NS_PER_SEC 10000000LL +#define FT2usecs(ll,ft) \ + (ll)=(ft).dwHighDateTime; \ + (ll) <<= 32; \ + (ll) |= (ft).dwLowDateTime; + +#endif + +/* cygwin32 or mingw32 version */ +StgInt +getCPUTime(StgByteArray cpuStruct) +{ + FILETIME creationTime, exitTime, kernelTime, userTime; + StgInt *cpu=(StgInt *)cpuStruct; + unsigned long long uT, kT; + + /* ToDo: pin down elapsed times to just the OS thread(s) that + are evaluating/managing Haskell code. + */ + if (!GetProcessTimes (GetCurrentProcess(), &creationTime, + &exitTime, &kernelTime, &userTime)) { + /* Probably on a Win95 box..*/ + cpu[0]=0; + cpu[1]=0; + cpu[2]=0; + cpu[3]=0; + return 1; + } + + FT2usecs(uT, userTime); + FT2usecs(kT, kernelTime); + + cpu[0] = (unsigned int)(uT / NS_PER_SEC); + cpu[1] = (unsigned int)((uT - cpu[0] * NS_PER_SEC) * 100); + cpu[2] = (unsigned int)(kT / NS_PER_SEC); + cpu[3] = (unsigned int)((kT - cpu[2] * NS_PER_SEC) * 100); + return 1; +} +#endif /* WIN32 */ + +cpuTimePrecision :: Integer +cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks)) + +clockTicks :: Int +clockTicks = +#if defined(CLK_TCK) + (#const CLK_TCK) +#else + unsafePerformIO (sysconf (#const _SC_CLK_TCK) >>= return . fromIntegral) +#endif + +type CRUsage = () +foreign import unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt +foreign import unsafe sysconf :: CInt -> IO CLong diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs deleted file mode 100644 index 9478bdc..0000000 --- a/ghc/lib/std/CPUTime.lhs +++ /dev/null @@ -1,89 +0,0 @@ -% ----------------------------------------------------------------------------- -% $Id: CPUTime.lhs,v 1.29 2001/02/22 16:48:24 qrczak Exp $ -% -% (c) The University of Glasgow, 1995-2000 -% -\section[CPUTime]{Haskell 98 CPU Time Library} - -\begin{code} -{-# OPTIONS -#include "cbits/stgio.h" #-} - -module CPUTime - ( - getCPUTime, -- :: IO Integer - cpuTimePrecision -- :: Integer - ) where -\end{code} - - -#ifndef __HUGS__ - -\begin{code} -import Prelude -- To generate the dependency -import PrelGHC ( indexIntArray# ) -import PrelBase ( Int(..) ) -import PrelByteArr ( ByteArray(..), newIntArray ) -import PrelArrExtra ( unsafeFreezeByteArray ) -import PrelIOBase ( IOException(..), - IOErrorType( UnsupportedOperation ), - unsafePerformIO, stToIO, ioException ) -import Ratio -\end{code} - -Computation @getCPUTime@ returns the number of picoseconds CPU time -used by the current program. The precision of this result is -implementation-dependent. - -The @cpuTimePrecision@ constant is the smallest measurable difference -in CPU time that the implementation can record, and is given as an -integral number of picoseconds. - -\begin{code} -getCPUTime :: IO Integer -getCPUTime = do - marr <- stToIO (newIntArray ((0::Int),3)) - barr <- stToIO (unsafeFreezeByteArray marr) - rc <- primGetCPUTime barr - if rc /= 0 then - case barr of - ByteArray _ _ frozen# -> -- avoid bounds checking - return ((fromIntegral (I# (indexIntArray# frozen# 0#)) * 1000000000 + - fromIntegral (I# (indexIntArray# frozen# 1#)) + - fromIntegral (I# (indexIntArray# frozen# 2#)) * 1000000000 + - fromIntegral (I# (indexIntArray# frozen# 3#))) * 1000) - else - ioException (IOError Nothing UnsupportedOperation - "getCPUTime" - "can't get CPU time" - Nothing) - -cpuTimePrecision :: Integer -cpuTimePrecision = round ((1000000000000::Integer) % - fromIntegral (unsafePerformIO clockTicks)) - -foreign import "libHS_cbits" "getCPUTime" unsafe primGetCPUTime :: ByteArray Int -> IO Int -foreign import "libHS_cbits" "clockTicks" unsafe clockTicks :: IO Int - -\end{code} - -#else - -\begin{code} -import PrelPrim ( nh_getCPUtime - , nh_getCPUprec - , unsafePerformIO - ) - -getCPUTime :: IO Integer -getCPUTime - = do seconds <- nh_getCPUtime - return (round (seconds * 1.0e+12)) - -cpuTimePrecision :: Integer -cpuTimePrecision - = unsafePerformIO ( - do resolution <- nh_getCPUprec - return (round (resolution * 1.0e+12)) - ) -\end{code} -#endif diff --git a/ghc/lib/std/cbits/getCPUTime.c b/ghc/lib/std/cbits/getCPUTime.c deleted file mode 100644 index 34f1b37..0000000 --- a/ghc/lib/std/cbits/getCPUTime.c +++ /dev/null @@ -1,166 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: getCPUTime.c,v 1.7 2000/04/06 17:54:01 rrt Exp $ - * - * getCPUTime Runtime Support - */ - -#ifndef _AIX -#define NON_POSIX_SOURCE /*needed for solaris2 only?*/ -#endif - -/* how is this to work given we have not read platform.h yet? */ -#ifdef hpux_TARGET_OS -#define _INCLUDE_HPUX_SOURCE -#endif - -#include "Rts.h" - -#ifdef HAVE_SYS_TYPES_H -#include -#endif - -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifndef mingw32_TARGET_OS -# ifdef HAVE_SYS_TIMES_H -# include -# endif -#endif - -#ifdef HAVE_SYS_TIME_H -#include -#endif - -#if !defined(mingw32_TARGET_OS) && !defined(irix_TARGET_OS) -# if defined(HAVE_SYS_RESOURCE_H) -# include -# endif -#endif - -#ifdef HAVE_SYS_TIMEB_H -#include -#endif - -#ifdef hpux_TARGET_OS -#include -#define getrusage(a, b) syscall(SYS_GETRUSAGE, a, b) -#define HAVE_GETRUSAGE -#endif - -#ifdef HAVE_WINDOWS_H -# include -#endif - -StgInt -clockTicks () -{ - return ( -#if defined(CLK_TCK) - CLK_TCK -#else - sysconf(_SC_CLK_TCK) -#endif - ); -} - -/* - * Our caller wants a pointer to four StgInts, - * user seconds, user nanoseconds, system seconds, system nanoseconds. - * Yes, the timerval has unsigned components, but nanoseconds take only - * 30 bits, and our CPU usage would have to be over 68 years for the - * seconds to overflow 31 bits. - */ - -#ifndef _WIN32 -StgInt -getCPUTime(StgByteArray cpuStruct) -{ - StgInt *cpu=(StgInt *)cpuStruct; - -/* 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 - again in libucb in 2.6..) - - Avoid the problem by resorting to times() instead. -*/ -#if defined(HAVE_GETRUSAGE) && ! irix_TARGET_OS && ! solaris2_TARGET_OS - struct rusage t; - - getrusage(RUSAGE_SELF, &t); - cpu[0] = t.ru_utime.tv_sec; - cpu[1] = 1000 * t.ru_utime.tv_usec; - cpu[2] = t.ru_stime.tv_sec; - cpu[3] = 1000 * t.ru_stime.tv_usec; - -#else -# if defined(HAVE_TIMES) - struct tms t; -# if defined(CLK_TCK) -# define ticks CLK_TCK -# else - long ticks; - ticks = sysconf(_SC_CLK_TCK); -# endif - - times(&t); - cpu[0] = t.tms_utime / ticks; - cpu[1] = (t.tms_utime - cpu[0] * ticks) * (1000000000 / ticks); - cpu[2] = t.tms_stime / ticks; - cpu[3] = (t.tms_stime - cpu[2] * ticks) * (1000000000 / ticks); - -# else - return 0; -# endif -#endif - return 1; -} - -#else - -#ifdef _WIN32 -/* 100ns units per sec, really */ -#define NS_PER_SEC 10000000LL -#define FT2usecs(ll,ft) \ - (ll)=(ft).dwHighDateTime; \ - (ll) <<= 32; \ - (ll) |= (ft).dwLowDateTime; - -#endif - -/* cygwin32 or mingw32 version */ -StgInt -getCPUTime(StgByteArray cpuStruct) -{ - FILETIME creationTime, exitTime, kernelTime, userTime; - StgInt *cpu=(StgInt *)cpuStruct; - unsigned long long uT, kT; - - /* ToDo: pin down elapsed times to just the OS thread(s) that - are evaluating/managing Haskell code. - */ - if (!GetProcessTimes (GetCurrentProcess(), &creationTime, - &exitTime, &kernelTime, &userTime)) { - /* Probably on a Win95 box..*/ - cpu[0]=0; - cpu[1]=0; - cpu[2]=0; - cpu[3]=0; - return 1; - } - - FT2usecs(uT, userTime); - FT2usecs(kT, kernelTime); - - cpu[0] = (unsigned int)(uT / NS_PER_SEC); - cpu[1] = (unsigned int)((uT - cpu[0] * NS_PER_SEC) * 100); - cpu[2] = (unsigned int)(kT / NS_PER_SEC); - cpu[3] = (unsigned int)((kT - cpu[2] * NS_PER_SEC) * 100); - return 1; -} - -#endif /* _WIN32 */ diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h index 9734281..87fb04f 100644 --- a/ghc/lib/std/cbits/stgio.h +++ b/ghc/lib/std/cbits/stgio.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: stgio.h,v 1.28 2001/04/02 16:10:33 rrt Exp $ + * $Id: stgio.h,v 1.29 2001/05/08 08:55:18 simonmar Exp $ * * (c) The GRASP/AQUA Project, Glasgow University, 1994-1999 * @@ -109,10 +109,6 @@ StgAddr ref_freeFileObject (void); /* getBufferMode.c */ StgInt getBufferMode (StgForeignPtr); -/* getCPUTime.c */ -StgInt getCPUTime (StgByteArray); -StgInt clockTicks(void); - /* getLock.c */ int lockFile (int, int, int); int unlockFile (int); -- 1.7.10.4