[commit: ghc] master: base: Rip out old RTS statistics interface (54fda25)
git at git.haskell.org
git at git.haskell.org
Tue Nov 28 01:29:53 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/54fda257d4a7bfddaa0c1fa0be698d1a849c4124/ghc
>---------------------------------------------------------------
commit 54fda257d4a7bfddaa0c1fa0be698d1a849c4124
Author: Ben Gamari <bgamari.foss at gmail.com>
Date: Mon Nov 27 14:02:56 2017 -0500
base: Rip out old RTS statistics interface
Test Plan: Validate
Reviewers: simonmar, hvr
Subscribers: rwbarton, thomie
GHC Trac Issues: #14516
Differential Revision: https://phabricator.haskell.org/D4228
>---------------------------------------------------------------
54fda257d4a7bfddaa0c1fa0be698d1a849c4124
libraries/base/GHC/Stats.hsc | 147 ++-----------------------------------------
libraries/base/changelog.md | 2 +
2 files changed, 6 insertions(+), 143 deletions(-)
diff --git a/libraries/base/GHC/Stats.hsc b/libraries/base/GHC/Stats.hsc
index 35925c9..94d04a8 100644
--- a/libraries/base/GHC/Stats.hsc
+++ b/libraries/base/GHC/Stats.hsc
@@ -18,20 +18,12 @@ module GHC.Stats
RTSStats(..), GCDetails(..), RtsTime
, getRTSStats
, getRTSStatsEnabled
-
- -- * DEPRECATED, don't use
- , GCStats(..)
- , getGCStats
- , getGCStatsEnabled
) where
-import Control.Applicative
import Control.Monad
import Data.Int
import Data.Word
import GHC.Base
-import GHC.Num (Num(..))
-import GHC.Real (quot, fromIntegral, (/))
import GHC.Read ( Read )
import GHC.Show ( Show )
import GHC.IO.Exception
@@ -148,16 +140,18 @@ data GCDetails = GCDetails {
-- | Time values from the RTS, using a fixed resolution of nanoseconds.
type RtsTime = Int64
+-- | Get current runtime system statistics.
+--
-- @since 4.10.0.0
--
getRTSStats :: IO RTSStats
getRTSStats = do
- statsEnabled <- getGCStatsEnabled
+ statsEnabled <- getRTSStatsEnabled
unless statsEnabled . ioError $ IOError
Nothing
UnsupportedOperation
""
- "getGCStats: GC stats not enabled. Use `+RTS -T -RTS' to enable them."
+ "GHC.Stats.getRTSStats: GC stats not enabled. Use `+RTS -T -RTS' to enable them."
Nothing
Nothing
allocaBytes (#size RTSStats) $ \p -> do
@@ -204,136 +198,3 @@ getRTSStats = do
gcdetails_elapsed_ns <- (# peek GCDetails, elapsed_ns) pgc
return GCDetails{..}
return RTSStats{..}
-
--- -----------------------------------------------------------------------------
--- DEPRECATED API
-
--- I'm probably violating a bucket of constraints here... oops.
-
--- | Statistics about memory usage and the garbage collector. Apart from
--- 'currentBytesUsed' and 'currentBytesSlop' all are cumulative values since
--- the program started.
---
--- @since 4.5.0.0
-{-# DEPRECATED GCStats "Use RTSStats instead. This will be removed in GHC 8.4.1" #-}
-data GCStats = GCStats
- { -- | Total number of bytes allocated
- bytesAllocated :: !Int64
- -- | Number of garbage collections performed (any generation, major and
- -- minor)
- , numGcs :: !Int64
- -- | Maximum number of live bytes seen so far
- , maxBytesUsed :: !Int64
- -- | Number of byte usage samples taken, or equivalently
- -- the number of major GCs performed.
- , numByteUsageSamples :: !Int64
- -- | Sum of all byte usage samples, can be used with
- -- 'numByteUsageSamples' to calculate averages with
- -- arbitrary weighting (if you are sampling this record multiple
- -- times).
- , cumulativeBytesUsed :: !Int64
- -- | Number of bytes copied during GC
- , bytesCopied :: !Int64
- -- | Number of live bytes at the end of the last major GC
- , currentBytesUsed :: !Int64
- -- | Current number of bytes lost to slop
- , currentBytesSlop :: !Int64
- -- | Maximum number of bytes lost to slop at any one time so far
- , maxBytesSlop :: !Int64
- -- | Maximum number of megabytes allocated
- , peakMegabytesAllocated :: !Int64
- -- | CPU time spent running mutator threads. This does not include
- -- any profiling overhead or initialization.
- , mblocksAllocated :: !Int64 -- ^ Number of allocated megablocks
- , mutatorCpuSeconds :: !Double
-
- -- | Wall clock time spent running mutator threads. This does not
- -- include initialization.
- , mutatorWallSeconds :: !Double
- -- | CPU time spent running GC
- , gcCpuSeconds :: !Double
- -- | Wall clock time spent running GC
- , gcWallSeconds :: !Double
- -- | Total CPU time elapsed since program start
- , cpuSeconds :: !Double
- -- | Total wall clock time elapsed since start
- , wallSeconds :: !Double
- -- | Number of bytes copied during GC, minus space held by mutable
- -- lists held by the capabilities. Can be used with
- -- 'parMaxBytesCopied' to determine how well parallel GC utilized
- -- all cores.
- , parTotBytesCopied :: !Int64
-
- -- | Sum of number of bytes copied each GC by the most active GC
- -- thread each GC. The ratio of 'parTotBytesCopied' divided by
- -- 'parMaxBytesCopied' approaches 1 for a maximally sequential
- -- run and approaches the number of threads (set by the RTS flag
- -- @-N@) for a maximally parallel run. This is included for
- -- backwards compatibility; to compute work balance use
- -- `parBalancedBytesCopied`.
- , parMaxBytesCopied :: !Int64
-
- -- | Sum of number of balanced bytes copied on each thread of each GC.
- -- Balanced bytes are those up to a
- -- limit = (parTotBytesCopied / num_gc_threads).
- -- This number is normalized so that when balance is perfect
- -- @parBalancedBytesCopied = parTotBytesCopied@ and when all
- -- gc is done by a single thread @parBalancedBytesCopied = 0 at .
- , parBalancedBytesCopied :: !Int64
-
- } deriving (Show, Read)
-
--- | Retrieves garbage collection and memory statistics as of the last
--- garbage collection. If you would like your statistics as recent as
--- possible, first run a 'System.Mem.performGC'.
---
--- @since 4.5.0.0
-{-# DEPRECATED getGCStats
- "Use getRTSStats instead. This will be removed in GHC 8.4.1" #-}
-getGCStats :: IO GCStats
-getGCStats = do
- statsEnabled <- getGCStatsEnabled
- unless statsEnabled . ioError $ IOError
- Nothing
- UnsupportedOperation
- ""
- "getGCStats: GC stats not enabled. Use `+RTS -T -RTS' to enable them."
- Nothing
- Nothing
- allocaBytes (#size RTSStats) $ \p -> do
- getRTSStats_ p
- bytesAllocated <- (# peek RTSStats, allocated_bytes) p
- numGcs <- (# peek RTSStats, gcs ) p
- numByteUsageSamples <- (# peek RTSStats, major_gcs ) p
- maxBytesUsed <- (# peek RTSStats, max_live_bytes ) p
- cumulativeBytesUsed <- (# peek RTSStats, cumulative_live_bytes ) p
- bytesCopied <- (# peek RTSStats, copied_bytes ) p
- currentBytesUsed <- (# peek RTSStats, gc.live_bytes ) p
- currentBytesSlop <- (# peek RTSStats, gc.slop_bytes) p
- maxBytesSlop <- (# peek RTSStats, max_slop_bytes) p
- peakMegabytesAllocated <- do
- bytes <- (# peek RTSStats, max_mem_in_use_bytes ) p
- return (bytes `quot` (1024*1024))
- mblocksAllocated <- do
- bytes <- (# peek RTSStats, gc.mem_in_use_bytes) p
- return (bytes `quot` (1024*1024))
- mutatorCpuSeconds <- nsToSecs <$> (# peek RTSStats, mutator_cpu_ns) p
- mutatorWallSeconds <-
- nsToSecs <$> (# peek RTSStats, mutator_elapsed_ns) p
- gcCpuSeconds <- nsToSecs <$> (# peek RTSStats, gc_cpu_ns) p
- gcWallSeconds <- nsToSecs <$> (# peek RTSStats, gc_elapsed_ns) p
- cpuSeconds <- nsToSecs <$> (# peek RTSStats, cpu_ns) p
- wallSeconds <- nsToSecs <$> (# peek RTSStats, elapsed_ns) p
- parTotBytesCopied <- (# peek RTSStats, par_copied_bytes) p
- parMaxBytesCopied <- (# peek RTSStats, cumulative_par_max_copied_bytes) p
- parBalancedBytesCopied <-
- (# peek RTSStats, cumulative_par_balanced_copied_bytes) p
- return GCStats { .. }
-
-nsToSecs :: Int64 -> Double
-nsToSecs ns = fromIntegral ns / (# const TIME_RESOLUTION)
-
-{-# DEPRECATED getGCStatsEnabled
- "use getRTSStatsEnabled instead. This will be removed in GHC 8.4.1" #-}
-getGCStatsEnabled :: IO Bool
-getGCStatsEnabled = getRTSStatsEnabled
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 1e0a67d..7e3c1b0 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -3,6 +3,8 @@
## 4.11.0.0 *TBA*
* Bundled with GHC 8.4.1
+ * Deprecated `GHC.Stats.GCStats` interface has been removed.
+
* Add `showHFloat` to `Numeric`
* Add `Div`, `Mod`, and `Log2` functions on type-level naturals
More information about the ghc-commits
mailing list