{-# LINE 1 "GHC/Stats.hsc" #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-----------------------------------------------------------------------------
-- | This module provides access to internal garbage collection and
-- memory usage statistics.  These statistics are not available unless
-- a program is run with the @-T@ RTS flag.
--
-- This module is GHC-only and should not be considered portable.
--
-- @since 4.5.0.0
-----------------------------------------------------------------------------
module GHC.Stats
    (
    -- * Runtime statistics
      RTSStats(..), GCDetails(..), RtsTime
    , getRTSStats
    , getRTSStatsEnabled
) where

import Control.Monad
import Data.Int
import Data.Word
import GHC.Base
import GHC.Read ( Read )
import GHC.Show ( Show )
import GHC.IO.Exception
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Ptr



foreign import ccall "getRTSStats" getRTSStats_ :: Ptr () -> IO ()

-- | Returns whether GC stats have been enabled (with @+RTS -T@, for example).
--
-- @since 4.10.0.0
foreign import ccall "getRTSStatsEnabled" getRTSStatsEnabled :: IO Bool

--
-- | Statistics about runtime activity since the start of the
-- program.  This is a mirror of the C @struct RTSStats@ in @RtsAPI.h@
--
-- @since 4.10.0.0
--
data RTSStats = RTSStats {
  -- -----------------------------------
  -- Cumulative stats about memory use

    -- | Total number of GCs
    RTSStats -> Word32
gcs :: Word32
    -- | Total number of major (oldest generation) GCs
  , RTSStats -> Word32
major_gcs :: Word32
    -- | Total bytes allocated
  , RTSStats -> Word64
allocated_bytes :: Word64
    -- | Maximum live data (including large objects + compact regions) in the
    -- heap. Updated after a major GC.
  , RTSStats -> Word64
max_live_bytes :: Word64
    -- | Maximum live data in large objects
  , RTSStats -> Word64
max_large_objects_bytes :: Word64
    -- | Maximum live data in compact regions
  , RTSStats -> Word64
max_compact_bytes :: Word64
    -- | Maximum slop
  , RTSStats -> Word64
max_slop_bytes :: Word64
    -- | Maximum memory in use by the RTS
  , RTSStats -> Word64
max_mem_in_use_bytes :: Word64
    -- | Sum of live bytes across all major GCs.  Divided by major_gcs
    -- gives the average live data over the lifetime of the program.
  , RTSStats -> Word64
cumulative_live_bytes :: Word64
    -- | Sum of copied_bytes across all GCs
  , RTSStats -> Word64
copied_bytes :: Word64
    -- | Sum of copied_bytes across all parallel GCs
  , RTSStats -> Word64
par_copied_bytes :: Word64
    -- | Sum of par_max_copied_bytes across all parallel GCs. Deprecated.
  , RTSStats -> Word64
cumulative_par_max_copied_bytes :: Word64
    -- | Sum of par_balanced_copied bytes across all parallel GCs
  , RTSStats -> Word64
cumulative_par_balanced_copied_bytes :: Word64

  -- -----------------------------------
  -- Cumulative stats about time use
  -- (we use signed values here because due to inaccuracies in timers
  -- the values can occasionally go slightly negative)

    -- | Total CPU time used by the init phase
    -- @since 4.12.0.0
  , RTSStats -> RtsTime
init_cpu_ns :: RtsTime
    -- | Total elapsed time used by the init phase
    -- @since 4.12.0.0
  , RTSStats -> RtsTime
init_elapsed_ns :: RtsTime
    -- | Total CPU time used by the mutator
  , RTSStats -> RtsTime
mutator_cpu_ns :: RtsTime
    -- | Total elapsed time used by the mutator
  , RTSStats -> RtsTime
mutator_elapsed_ns :: RtsTime
    -- | Total CPU time used by the GC
  , RTSStats -> RtsTime
gc_cpu_ns :: RtsTime
    -- | Total elapsed time used by the GC
  , RTSStats -> RtsTime
gc_elapsed_ns :: RtsTime
    -- | Total CPU time (at the previous GC)
  , RTSStats -> RtsTime
cpu_ns :: RtsTime
    -- | Total elapsed time (at the previous GC)
  , RTSStats -> RtsTime
elapsed_ns :: RtsTime

    -- | The CPU time used during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_sync_cpu_ns :: RtsTime
    -- | The time elapsed during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_sync_elapsed_ns :: RtsTime
    -- | The maximum time elapsed during the post-mark pause phase of the
    -- concurrent nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RtsTime
    -- | The CPU time used during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_cpu_ns :: RtsTime
    -- | The time elapsed during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_elapsed_ns :: RtsTime
    -- | The maximum time elapsed during the post-mark pause phase of the
    -- concurrent nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_max_elapsed_ns :: RtsTime

    -- | Details about the most recent GC
  , RTSStats -> GCDetails
gc :: GCDetails
  } deriving ( Read -- ^ @since 4.10.0.0
             , Show -- ^ @since 4.10.0.0
             )

--
-- | Statistics about a single GC.  This is a mirror of the C @struct
--   GCDetails@ in @RtsAPI.h@, with the field prefixed with @gc_@ to
--   avoid collisions with 'RTSStats'.
--
data GCDetails = GCDetails {
    -- | The generation number of this GC
    GCDetails -> Word32
gcdetails_gen :: Word32
    -- | Number of threads used in this GC
  , GCDetails -> Word32
gcdetails_threads :: Word32
    -- | Number of bytes allocated since the previous GC
  , GCDetails -> Word64
gcdetails_allocated_bytes :: Word64
    -- | Total amount of live data in the heap (incliudes large + compact data).
    -- Updated after every GC. Data in uncollected generations (in minor GCs)
    -- are considered live.
  , GCDetails -> Word64
gcdetails_live_bytes :: Word64
    -- | Total amount of live data in large objects
  , GCDetails -> Word64
gcdetails_large_objects_bytes :: Word64
    -- | Total amount of live data in compact regions
  , GCDetails -> Word64
gcdetails_compact_bytes :: Word64
    -- | Total amount of slop (wasted memory)
  , GCDetails -> Word64
gcdetails_slop_bytes :: Word64
    -- | Total amount of memory in use by the RTS
  , GCDetails -> Word64
gcdetails_mem_in_use_bytes :: Word64
    -- | Total amount of data copied during this GC
  , GCDetails -> Word64
gcdetails_copied_bytes :: Word64
    -- | In parallel GC, the max amount of data copied by any one thread.
    -- Deprecated.
  , GCDetails -> Word64
gcdetails_par_max_copied_bytes :: Word64
    -- | In parallel GC, the amount of balanced data copied by all threads
  , GCDetails -> Word64
gcdetails_par_balanced_copied_bytes :: Word64
    -- | The time elapsed during synchronisation before GC
  , GCDetails -> RtsTime
gcdetails_sync_elapsed_ns :: RtsTime
    -- | The CPU time used during GC itself
  , GCDetails -> RtsTime
gcdetails_cpu_ns :: RtsTime
    -- | The time elapsed during GC itself
  , GCDetails -> RtsTime
gcdetails_elapsed_ns :: RtsTime

    -- | The CPU time used during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , GCDetails -> RtsTime
gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime
    -- | The time elapsed during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , GCDetails -> RtsTime
gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime
  } deriving ( Read -- ^ @since 4.10.0.0
             , Show -- ^ @since 4.10.0.0
             )

-- | 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 :: IO RTSStats
getRTSStats = do
  Bool
statsEnabled <- IO Bool
getRTSStatsEnabled
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
statsEnabled (IO () -> IO ()) -> (IOError -> IO ()) -> IOError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError
    Maybe Handle
forall a. Maybe a
Nothing
    IOErrorType
UnsupportedOperation
    String
""
    String
"GHC.Stats.getRTSStats: GC stats not enabled. Use `+RTS -T -RTS' to enable them."
    Maybe CInt
forall a. Maybe a
Nothing
    Maybe String
forall a. Maybe a
Nothing
  Int -> (Ptr () -> IO RTSStats) -> IO RTSStats
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
400)) ((Ptr () -> IO RTSStats) -> IO RTSStats)
-> (Ptr () -> IO RTSStats) -> IO RTSStats
forall a b. (a -> b) -> a -> b
$ \Ptr ()
p -> do
{-# LINE 197 "GHC/Stats.hsc" #-}
    getRTSStats_ p
    gcs <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 199 "GHC/Stats.hsc" #-}
    major_gcs <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 200 "GHC/Stats.hsc" #-}
    allocated_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 201 "GHC/Stats.hsc" #-}
    max_live_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 202 "GHC/Stats.hsc" #-}
    max_large_objects_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 203 "GHC/Stats.hsc" #-}
    max_compact_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
{-# LINE 204 "GHC/Stats.hsc" #-}
    max_slop_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p
{-# LINE 205 "GHC/Stats.hsc" #-}
    max_mem_in_use_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p
{-# LINE 206 "GHC/Stats.hsc" #-}
    cumulative_live_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) p
{-# LINE 207 "GHC/Stats.hsc" #-}
    copied_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) p
{-# LINE 208 "GHC/Stats.hsc" #-}
    par_copied_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) p
{-# LINE 209 "GHC/Stats.hsc" #-}
    cumulative_par_max_copied_bytes <-
      ((\hsc_ptr -> peekByteOff hsc_ptr 80)) p
{-# LINE 211 "GHC/Stats.hsc" #-}
    cumulative_par_balanced_copied_bytes <-
      ((\hsc_ptr -> peekByteOff hsc_ptr 88)) p
{-# LINE 213 "GHC/Stats.hsc" #-}
    init_cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 96)) p
{-# LINE 214 "GHC/Stats.hsc" #-}
    init_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 104)) p
{-# LINE 215 "GHC/Stats.hsc" #-}
    mutator_cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 112)) p
{-# LINE 216 "GHC/Stats.hsc" #-}
    mutator_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 120)) p
{-# LINE 217 "GHC/Stats.hsc" #-}
    gc_cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 128)) p
{-# LINE 218 "GHC/Stats.hsc" #-}
    gc_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 136)) p
{-# LINE 219 "GHC/Stats.hsc" #-}
    cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 144)) p
{-# LINE 220 "GHC/Stats.hsc" #-}
    elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 152)) p
{-# LINE 221 "GHC/Stats.hsc" #-}
    nonmoving_gc_sync_cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 352)) p
{-# LINE 222 "GHC/Stats.hsc" #-}
    nonmoving_gc_sync_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 360)) p
{-# LINE 223 "GHC/Stats.hsc" #-}
    nonmoving_gc_sync_max_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 368)) p
{-# LINE 224 "GHC/Stats.hsc" #-}
    nonmoving_gc_cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 376)) p
{-# LINE 225 "GHC/Stats.hsc" #-}
    nonmoving_gc_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 384)) p
{-# LINE 226 "GHC/Stats.hsc" #-}
    nonmoving_gc_max_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 392)) p
{-# LINE 227 "GHC/Stats.hsc" #-}
    let pgc = ((\hsc_ptr -> hsc_ptr `plusPtr` 160)) p
{-# LINE 228 "GHC/Stats.hsc" #-}
    gc <- do
      gcdetails_gen <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pgc
{-# LINE 230 "GHC/Stats.hsc" #-}
      gcdetails_threads <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) pgc
{-# LINE 231 "GHC/Stats.hsc" #-}
      gcdetails_allocated_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) pgc
{-# LINE 232 "GHC/Stats.hsc" #-}
      gcdetails_live_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) pgc
{-# LINE 233 "GHC/Stats.hsc" #-}
      gcdetails_large_objects_bytes <-
        ((\hsc_ptr -> peekByteOff hsc_ptr 24)) pgc
{-# LINE 235 "GHC/Stats.hsc" #-}
      gcdetails_compact_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) pgc
{-# LINE 236 "GHC/Stats.hsc" #-}
      gcdetails_slop_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) pgc
{-# LINE 237 "GHC/Stats.hsc" #-}
      gcdetails_mem_in_use_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) pgc
{-# LINE 238 "GHC/Stats.hsc" #-}
      gcdetails_copied_bytes <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) pgc
{-# LINE 239 "GHC/Stats.hsc" #-}
      gcdetails_par_max_copied_bytes <-
        ((\hsc_ptr -> peekByteOff hsc_ptr 64)) pgc
{-# LINE 241 "GHC/Stats.hsc" #-}
      gcdetails_par_balanced_copied_bytes <-
        ((\hsc_ptr -> peekByteOff hsc_ptr 72)) pgc
{-# LINE 243 "GHC/Stats.hsc" #-}
      gcdetails_sync_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) pgc
{-# LINE 244 "GHC/Stats.hsc" #-}
      gcdetails_cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 88)) pgc
{-# LINE 245 "GHC/Stats.hsc" #-}
      gcdetails_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 96)) pgc
{-# LINE 246 "GHC/Stats.hsc" #-}
      gcdetails_nonmoving_gc_sync_cpu_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 104)) pgc
{-# LINE 247 "GHC/Stats.hsc" #-}
      gcdetails_nonmoving_gc_sync_elapsed_ns <- ((\hsc_ptr -> peekByteOff hsc_ptr 112)) pgc
{-# LINE 248 "GHC/Stats.hsc" #-}
      return GCDetails{..}
    return RTSStats{..}