/ghc-7.0.4/libraries/base/dist-install/build/System/CPUTime.hs

http://picorec.googlecode.com/ · Haskell · 181 lines · 33 code · 63 blank · 85 comment · 0 complexity · 9c9a5ab13178978d5077a36503424b94 MD5 · raw file

  1. {-# LINE 1 "libraries/base/./System/CPUTime.hsc" #-}
  2. -----------------------------------------------------------------------------
  3. {-# LINE 2 "libraries/base/./System/CPUTime.hsc" #-}
  4. -- |
  5. -- Module : System.CPUTime
  6. -- Copyright : (c) The University of Glasgow 2001
  7. -- License : BSD-style (see the file libraries/base/LICENSE)
  8. --
  9. -- Maintainer : libraries@haskell.org
  10. -- Stability : provisional
  11. -- Portability : portable
  12. --
  13. -- The standard CPUTime library.
  14. --
  15. -----------------------------------------------------------------------------
  16. module System.CPUTime
  17. (
  18. getCPUTime, -- :: IO Integer
  19. cpuTimePrecision -- :: Integer
  20. ) where
  21. import Prelude
  22. import Data.Ratio
  23. {-# LINE 28 "libraries/base/./System/CPUTime.hsc" #-}
  24. {-# LINE 32 "libraries/base/./System/CPUTime.hsc" #-}
  25. {-# LINE 34 "libraries/base/./System/CPUTime.hsc" #-}
  26. import Foreign hiding (unsafePerformIO)
  27. import Foreign.C
  28. {-# LINE 37 "libraries/base/./System/CPUTime.hsc" #-}
  29. import System.IO.Unsafe (unsafePerformIO)
  30. {-# LINE 39 "libraries/base/./System/CPUTime.hsc" #-}
  31. {-# LINE 41 "libraries/base/./System/CPUTime.hsc" #-}
  32. -- For _SC_CLK_TCK
  33. {-# LINE 44 "libraries/base/./System/CPUTime.hsc" #-}
  34. {-# LINE 45 "libraries/base/./System/CPUTime.hsc" #-}
  35. {-# LINE 46 "libraries/base/./System/CPUTime.hsc" #-}
  36. -- For struct rusage
  37. {-# LINE 49 "libraries/base/./System/CPUTime.hsc" #-}
  38. {-# LINE 50 "libraries/base/./System/CPUTime.hsc" #-}
  39. {-# LINE 51 "libraries/base/./System/CPUTime.hsc" #-}
  40. {-# LINE 52 "libraries/base/./System/CPUTime.hsc" #-}
  41. {-# LINE 53 "libraries/base/./System/CPUTime.hsc" #-}
  42. -- For FILETIME etc. on Windows
  43. {-# LINE 58 "libraries/base/./System/CPUTime.hsc" #-}
  44. -- for CLK_TCK
  45. {-# LINE 61 "libraries/base/./System/CPUTime.hsc" #-}
  46. {-# LINE 62 "libraries/base/./System/CPUTime.hsc" #-}
  47. {-# LINE 63 "libraries/base/./System/CPUTime.hsc" #-}
  48. -- for struct tms
  49. {-# LINE 66 "libraries/base/./System/CPUTime.hsc" #-}
  50. {-# LINE 67 "libraries/base/./System/CPUTime.hsc" #-}
  51. {-# LINE 68 "libraries/base/./System/CPUTime.hsc" #-}
  52. {-# LINE 70 "libraries/base/./System/CPUTime.hsc" #-}
  53. {-# LINE 72 "libraries/base/./System/CPUTime.hsc" #-}
  54. realToInteger :: Real a => a -> Integer
  55. realToInteger ct = round (realToFrac ct :: Double)
  56. -- CTime, CClock, CUShort etc are in Real but not Fractional,
  57. -- so we must convert to Double before we can round it
  58. {-# LINE 77 "libraries/base/./System/CPUTime.hsc" #-}
  59. {-# LINE 79 "libraries/base/./System/CPUTime.hsc" #-}
  60. -- -----------------------------------------------------------------------------
  61. -- |Computation 'getCPUTime' returns the number of picoseconds CPU time
  62. -- used by the current program. The precision of this result is
  63. -- implementation-dependent.
  64. getCPUTime :: IO Integer
  65. getCPUTime = do
  66. {-# LINE 88 "libraries/base/./System/CPUTime.hsc" #-}
  67. -- getrusage() is right royal pain to deal with when targetting multiple
  68. -- versions of Solaris, since some versions supply it in libc (2.3 and 2.5),
  69. -- while 2.4 has got it in libucb (I wouldn't be too surprised if it was back
  70. -- again in libucb in 2.6..)
  71. --
  72. -- Avoid the problem by resorting to times() instead.
  73. --
  74. {-# LINE 96 "libraries/base/./System/CPUTime.hsc" #-}
  75. allocaBytes (144) $ \ p_rusage -> do
  76. {-# LINE 97 "libraries/base/./System/CPUTime.hsc" #-}
  77. throwErrnoIfMinus1_ "getrusage" $ getrusage (0) p_rusage
  78. {-# LINE 98 "libraries/base/./System/CPUTime.hsc" #-}
  79. let ru_utime = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) p_rusage
  80. {-# LINE 100 "libraries/base/./System/CPUTime.hsc" #-}
  81. let ru_stime = ((\hsc_ptr -> hsc_ptr `plusPtr` 16)) p_rusage
  82. {-# LINE 101 "libraries/base/./System/CPUTime.hsc" #-}
  83. u_sec <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ru_utime :: IO CTime
  84. {-# LINE 102 "libraries/base/./System/CPUTime.hsc" #-}
  85. {-# LINE 105 "libraries/base/./System/CPUTime.hsc" #-}
  86. u_usec <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ru_utime :: IO CTime
  87. {-# LINE 106 "libraries/base/./System/CPUTime.hsc" #-}
  88. {-# LINE 107 "libraries/base/./System/CPUTime.hsc" #-}
  89. s_sec <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ru_stime :: IO CTime
  90. {-# LINE 108 "libraries/base/./System/CPUTime.hsc" #-}
  91. {-# LINE 111 "libraries/base/./System/CPUTime.hsc" #-}
  92. s_usec <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ru_stime :: IO CTime
  93. {-# LINE 112 "libraries/base/./System/CPUTime.hsc" #-}
  94. {-# LINE 113 "libraries/base/./System/CPUTime.hsc" #-}
  95. return ((realToInteger u_sec * 1000000 + realToInteger u_usec +
  96. realToInteger s_sec * 1000000 + realToInteger s_usec)
  97. * 1000000)
  98. type CRUsage = ()
  99. foreign import ccall unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt
  100. {-# LINE 137 "libraries/base/./System/CPUTime.hsc" #-}
  101. {-# LINE 171 "libraries/base/./System/CPUTime.hsc" #-}
  102. {-# LINE 172 "libraries/base/./System/CPUTime.hsc" #-}
  103. -- |The 'cpuTimePrecision' constant is the smallest measurable difference
  104. -- in CPU time that the implementation can record, and is given as an
  105. -- integral number of picoseconds.
  106. {-# LINE 178 "libraries/base/./System/CPUTime.hsc" #-}
  107. cpuTimePrecision :: Integer
  108. cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks))
  109. {-# LINE 181 "libraries/base/./System/CPUTime.hsc" #-}
  110. {-# LINE 183 "libraries/base/./System/CPUTime.hsc" #-}
  111. clockTicks :: Int
  112. clockTicks =
  113. {-# LINE 188 "libraries/base/./System/CPUTime.hsc" #-}
  114. unsafePerformIO (sysconf (2) >>= return . fromIntegral)
  115. {-# LINE 189 "libraries/base/./System/CPUTime.hsc" #-}
  116. foreign import ccall unsafe sysconf :: CInt -> IO CLong
  117. {-# LINE 191 "libraries/base/./System/CPUTime.hsc" #-}
  118. {-# LINE 192 "libraries/base/./System/CPUTime.hsc" #-}