SMRep.lhs 13.4 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
Simon Marlow's avatar
Simon Marlow committed
5 6

Storage manager representation of closures
7 8 9 10 11 12

This is here, rather than in ClosureInfo, just to keep nhc happy.
Other modules should access this info through ClosureInfo.

\begin{code}
module SMRep (
Simon Marlow's avatar
Simon Marlow committed
13
        -- * Words and bytes
14 15 16
        StgWord, StgHalfWord,
        hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
        WordOff, ByteOff,
17
        roundUpToWords,
18

Simon Marlow's avatar
Simon Marlow committed
19
        -- * Closure repesentation
20 21
        SMRep(..), -- CmmInfo sees the rep; no one else does
        IsStatic,
22
        ClosureTypeInfo(..), ArgDescr(..), Liveness,
23
        ConstrDescription,
Simon Marlow's avatar
Simon Marlow committed
24 25

        -- ** Construction
26
        mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep,
27

Simon Marlow's avatar
Simon Marlow committed
28
        -- ** Predicates
Simon Marlow's avatar
Simon Marlow committed
29
        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
Simon Marlow's avatar
Simon Marlow committed
30 31

        -- ** Size-related things
32 33 34 35
        heapClosureSize,
        fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
        profHdrSize, thunkHdrSize, nonHdrSize,

Simon Marlow's avatar
Simon Marlow committed
36 37
        -- ** RTS closure types
        rtsClosureType, rET_SMALL, rET_BIG,
38 39
        aRG_GEN, aRG_GEN_BIG,

Simon Marlow's avatar
Simon Marlow committed
40
        -- * Operations over [Word8] strings that don't belong here
41
        pprWord8String, stringToWord8s
42 43
    ) where

44
#include "../HsVersions.h"
45
#include "../includes/MachDeps.h"
46

47
import DynFlags
sof's avatar
sof committed
48
import Outputable
49
import FastString
50

51
import Data.Char( ord )
Simon Marlow's avatar
Simon Marlow committed
52
import Data.Word
53
import Data.Bits
54 55
\end{code}

56 57

%************************************************************************
58 59 60
%*                                                                      *
                Words and bytes
%*                                                                      *
61 62 63
%************************************************************************

\begin{code}
64 65
type WordOff = Int -- Word offset, or word count
type ByteOff = Int -- Byte offset, or byte count
66

67 68
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))
69 70 71 72 73 74 75 76
\end{code}

StgWord is a type representing an StgWord on the target platform.

\begin{code}
#if SIZEOF_HSWORD == 4
type StgWord     = Word32
type StgHalfWord = Word16
Ian Lynagh's avatar
Ian Lynagh committed
77 78 79 80
hALF_WORD_SIZE :: ByteOff
hALF_WORD_SIZE = 2
hALF_WORD_SIZE_IN_BITS :: Int
hALF_WORD_SIZE_IN_BITS = 16
81 82 83
#elif SIZEOF_HSWORD == 8
type StgWord     = Word64
type StgHalfWord = Word32
Ian Lynagh's avatar
Ian Lynagh committed
84 85 86 87
hALF_WORD_SIZE :: ByteOff
hALF_WORD_SIZE = 4
hALF_WORD_SIZE_IN_BITS :: Int
hALF_WORD_SIZE_IN_BITS = 32
88 89 90 91 92
#else
#error unknown SIZEOF_HSWORD
#endif
\end{code}

93

94
%************************************************************************
95
%*                                                                      *
96
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
97
%*                                                                      *
98 99 100
%************************************************************************

\begin{code}
101 102
-- | A description of the layout of a closure.  Corresponds directly
-- to the closure types in includes/rts/storage/ClosureTypes.h.
103
data SMRep
104 105 106 107 108 109 110 111 112
  = HeapRep              -- GC routines consult sizes in info tbl
        IsStatic
        !WordOff         --  # ptr words
        !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)
        ClosureTypeInfo  -- type-specific info

  | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
        Liveness

113 114 115 116
  | RTSRep              -- The RTS needs to declare info tables with specific
        StgHalfWord     -- type tags, so this form lets us override the default
        SMRep           -- tag for an SMRep.

117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
-- | True <=> This is a static closure.  Affects how we garbage-collect it.
-- Static closure have an extra static link field at the end.
type IsStatic = Bool

-- From an SMRep you can get to the closure type defined in
-- includes/rts/storage/ClosureTypes.h. Described by the function
-- rtsClosureType below.

data ClosureTypeInfo
  = Constr        ConstrTag ConstrDescription
  | Fun           FunArity ArgDescr
  | Thunk
  | ThunkSelector SelectorOffset
  | BlackHole

type ConstrTag         = StgHalfWord
type ConstrDescription = [Word8] -- result of dataConIdentity
type FunArity          = StgHalfWord
type SelectorOffset    = StgWord

-------------------------
-- We represent liveness bitmaps as a Bitmap (whose internal
-- representation really is a bitmap).  These are pinned onto case return
-- vectors to indicate the state of the stack for the garbage collector.
141
--
142 143
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
144
-- stored as a pointer to an array of words.
145 146 147 148 149 150 151 152

type Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead
                         --                    False <=> ptr

-------------------------
-- An ArgDescr describes the argument pattern of a function

data ArgDescr
153 154
  = ArgSpec             -- Fits one of the standard patterns
        !StgHalfWord    -- RTS type identifier ARG_P, ARG_N, ...
155

156 157
  | ArgGen              -- General case
        Liveness        -- Details about the arguments
158 159 160 161 162


-----------------------------------------------------------------------------
-- Construction

163 164 165
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
166 167 168 169 170 171 172
  = HeapRep is_static
            ptr_wds
            (nonptr_wds + slop_wds)
            cl_type_info
  where
     slop_wds
      | is_static = 0
173
      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
174

175
     hdr_size     = closureTypeHdrSize dflags cl_type_info
176
     payload_size = ptr_wds + nonptr_wds
177

178 179
mkRTSRep :: StgHalfWord -> SMRep -> SMRep
mkRTSRep = RTSRep
180 181

mkStackRep :: [Bool] -> SMRep
182
mkStackRep liveness = StackRep liveness
183 184 185 186

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

Simon Marlow's avatar
Simon Marlow committed
187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
-----------------------------------------------------------------------------
-- Predicates

isStaticRep :: SMRep -> IsStatic
isStaticRep (HeapRep is_static _ _ _) = is_static
isStaticRep (StackRep {})             = False
isStaticRep (RTSRep _ rep)            = isStaticRep rep

isConRep :: SMRep -> Bool
isConRep (HeapRep _ _ _ Constr{}) = True
isConRep _                        = False

isThunkRep :: SMRep -> Bool
isThunkRep (HeapRep _ _ _ Thunk{})         = True
isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
isThunkRep (HeapRep _ _ _ BlackHole{})     = True
isThunkRep _                               = False

Simon Marlow's avatar
Simon Marlow committed
205 206 207 208
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

Simon Marlow's avatar
Simon Marlow committed
209 210 211 212 213 214 215
isStaticNoCafCon :: SMRep -> Bool
-- This should line up exactly with CONSTR_NOCAF_STATIC above
-- See Note [Static NoCaf constructors]
isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True
isStaticNoCafCon _                           = False


216 217 218 219
-----------------------------------------------------------------------------
-- Size-related things

-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
220
fixedHdrSize :: DynFlags -> WordOff
221
fixedHdrSize dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
222

223 224
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
225 226
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
227
 | dopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
228
 | otherwise                      = 0
229

230 231 232
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
233
minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
234

235 236
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
237
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
238

239 240
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
241
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
242

243
-- Thunks have an extra header word on SMP, so the update doesn't
244
-- splat the payload.
245 246
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
247
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
248

249

250 251 252
nonHdrSize :: SMRep -> WordOff
nonHdrSize (HeapRep _ p np _) = p + np
nonHdrSize (StackRep bs)      = length bs
253
nonHdrSize (RTSRep _ rep)     = nonHdrSize rep
254

255 256 257 258 259 260 261 262 263 264 265
heapClosureSize :: DynFlags -> SMRep -> WordOff
heapClosureSize dflags (HeapRep _ p np ty)
 = closureTypeHdrSize dflags ty + p + np
heapClosureSize _ _ = panic "SMRep.heapClosureSize"

closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
closureTypeHdrSize dflags ty = case ty of
                  Thunk{}         -> thunkHdrSize dflags
                  ThunkSelector{} -> thunkHdrSize dflags
                  BlackHole{}     -> thunkHdrSize dflags
                  _               -> fixedHdrSize dflags
266 267 268 269 270
        -- All thunks use thunkHdrSize, even if they are non-updatable.
        -- this is because we don't have separate closure types for
        -- updatable vs. non-updatable thunks, so the GC can't tell the
        -- difference.  If we ever have significant numbers of non-
        -- updatable thunks, it might be worth fixing this.
271

272 273
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
274

275 276 277
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
278

279 280
-- | Derives the RTS closure type from an 'SMRep'
rtsClosureType :: SMRep -> StgHalfWord
281 282
rtsClosureType (RTSRep ty _)  = ty

283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323
rtsClosureType (HeapRep False 1 0 Constr{}) = CONSTR_1_0
rtsClosureType (HeapRep False 0 1 Constr{}) = CONSTR_0_1
rtsClosureType (HeapRep False 2 0 Constr{}) = CONSTR_2_0
rtsClosureType (HeapRep False 1 1 Constr{}) = CONSTR_1_1
rtsClosureType (HeapRep False 0 2 Constr{}) = CONSTR_0_2
rtsClosureType (HeapRep False _ _ Constr{}) = CONSTR

rtsClosureType (HeapRep False 1 0 Fun{}) = FUN_1_0
rtsClosureType (HeapRep False 0 1 Fun{}) = FUN_0_1
rtsClosureType (HeapRep False 2 0 Fun{}) = FUN_2_0
rtsClosureType (HeapRep False 1 1 Fun{}) = FUN_1_1
rtsClosureType (HeapRep False 0 2 Fun{}) = FUN_0_2
rtsClosureType (HeapRep False _ _ Fun{}) = FUN

rtsClosureType (HeapRep False 1 0 Thunk{}) = THUNK_1_0
rtsClosureType (HeapRep False 0 1 Thunk{}) = THUNK_0_1
rtsClosureType (HeapRep False 2 0 Thunk{}) = THUNK_2_0
rtsClosureType (HeapRep False 1 1 Thunk{}) = THUNK_1_1
rtsClosureType (HeapRep False 0 2 Thunk{}) = THUNK_0_2
rtsClosureType (HeapRep False _ _ Thunk{}) = THUNK

rtsClosureType (HeapRep False _ _ ThunkSelector{}) =  THUNK_SELECTOR

-- Approximation: we use the CONSTR_NOCAF_STATIC type for static constructors
-- that have no pointer words only.
rtsClosureType (HeapRep True 0 _ Constr{}) = CONSTR_NOCAF_STATIC  -- See isStaticNoCafCon below
rtsClosureType (HeapRep True _ _ Constr{}) = CONSTR_STATIC
rtsClosureType (HeapRep True _ _ Fun{})    = FUN_STATIC
rtsClosureType (HeapRep True _ _ Thunk{})  = THUNK_STATIC

rtsClosureType (HeapRep False _ _ BlackHole{}) =  BLACKHOLE

rtsClosureType _ = panic "rtsClosureType"

-- We export these ones
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: StgHalfWord
rET_SMALL   = RET_SMALL
rET_BIG     = RET_BIG
aRG_GEN     = ARG_GEN
aRG_GEN_BIG = ARG_GEN_BIG
\end{code}
324

325 326
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
327
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
328 329 330 331
reachable from 'x'), then a statically allocated constructor (Just x)
is also not Caffy, and the garbage collector need not follow its
argument fields.  Exploiting this would require two static info tables
for Just, for the two cases where the argument was Caffy or non-Caffy.
332

333
Currently we don't do this; instead we treat nullary constructors
334
as non-Caffy, and the others as potentially Caffy.
335

336

337
%************************************************************************
338
%*                                                                      *
339
             Pretty printing of SMRep and friends
340
%*                                                                      *
341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359
%************************************************************************

\begin{code}
instance Outputable ClosureTypeInfo where
   ppr = pprTypeInfo

instance Outputable SMRep where
   ppr (HeapRep static ps nps tyinfo)
     = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
     where
       header = ptext (sLit "HeapRep")
                <+> if static then ptext (sLit "static") else empty
                <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps
       pp_n :: String -> Int -> SDoc
       pp_n _ 0 = empty
       pp_n s n = int n <+> text s

   ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs

360 361
   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep

362 363 364
instance Outputable ArgDescr where
  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> integer (toInteger n)
  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
365

366 367
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
368
  = ptext (sLit "Con") <+>
369 370 371 372
    braces (sep [ ptext (sLit "tag:") <+> integer (toInteger tag)
                , ptext (sLit "descr:") <> text (show descr) ])

pprTypeInfo (Fun arity args)
373
  = ptext (sLit "Fun") <+>
374 375 376
    braces (sep [ ptext (sLit "arity:") <+> integer (toInteger arity)
                , ptext (sLit ("fun_type:")) <+> ppr args ])

377
pprTypeInfo (ThunkSelector offset)
378 379 380 381 382
  = ptext (sLit "ThunkSel") <+> integer (toInteger offset)

pprTypeInfo Thunk     = ptext (sLit "Thunk")
pprTypeInfo BlackHole = ptext (sLit "BlackHole")

Simon Marlow's avatar
Simon Marlow committed
383
-- XXX Does not belong here!!
384 385 386 387 388 389 390
stringToWord8s :: String -> [Word8]
stringToWord8s s = map (fromIntegral . ord) s

pprWord8String :: [Word8] -> SDoc
-- Debug printing.  Not very clever right now.
pprWord8String ws = text (show ws)
\end{code}