blob: 1b65e06ac9aec7352b5bfe07fe336497deef6628 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import GHC.Exts
import GHC.IO
import GHC.Stats
import System.Mem
import Control.Monad
data BA = BA ByteArray#
mblockSize = 2 ^ 20
main = do
-- Allocate 1000 byte arrays, to get a high watermark before only keeping
-- 100 of them.
ba <- take 100 <$> replicateM 1000 mkBA
let !n = (length ba)
-- Each major GC should free some amount of memory, 100 is just a large
-- number
replicateM 100 performMajorGC
s <- getRTSStats
let mblocks = (gcdetails_mem_in_use_bytes (gc s) `div` mblockSize)
live = (gcdetails_live_bytes (gc s) `div` mblockSize)
if fromIntegral mblocks < (2.2 * fromIntegral live)
then return ()
else error ("Additional memory is retained: "
++ show live ++ "/"
++ show mblocks)
-- Here to retain the ba
(length ba) `seq` return ()
mkBA =
let (I# siz) = 2^19 -- ~0.1MB
in IO $ \s0 ->
case newByteArray# siz s0 of
(# s1, mba #) -> case unsafeFreezeByteArray# mba s1 of
(# s2, ba #) -> (# s2, BA ba #)
|
