SMRep.lhs 17.3 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

\begin{code}
9 10
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

11
module SMRep (
Simon Marlow's avatar
Simon Marlow committed
12
        -- * Words and bytes
13 14 15 16
        WordOff, ByteOff,
        wordsToBytes, bytesToWordsRoundUp,
        roundUpToWords,

17
        StgWord, fromStgWord, toStgWord,
18
        StgHalfWord, fromStgHalfWord, toStgHalfWord,
19
        hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
20

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

        -- ** Construction
28
        mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
29
        arrWordsRep,
30

Simon Marlow's avatar
Simon Marlow committed
31
        -- ** Predicates
Simon Marlow's avatar
Simon Marlow committed
32
        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
33
        isStackRep,
Simon Marlow's avatar
Simon Marlow committed
34 35

        -- ** Size-related things
36
        heapClosureSizeW,
37 38
        fixedHdrSize, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
        arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
39

Simon Marlow's avatar
Simon Marlow committed
40 41
        -- ** RTS closure types
        rtsClosureType, rET_SMALL, rET_BIG,
42 43
        aRG_GEN, aRG_GEN_BIG,

44 45 46
        -- ** Arrays
        card, cardRoundUp, cardTableSizeB, cardTableSizeW,

Simon Marlow's avatar
Simon Marlow committed
47
        -- * Operations over [Word8] strings that don't belong here
48
        pprWord8String, stringToWord8s
49 50
    ) where

51
#include "../HsVersions.h"
52
#include "../includes/MachDeps.h"
53

54
import DynFlags
sof's avatar
sof committed
55
import Outputable
56
import Platform
57
import FastString
58

59
import Data.Char( ord )
Simon Marlow's avatar
Simon Marlow committed
60
import Data.Word
61
import Data.Bits
62 63
\end{code}

64 65

%************************************************************************
66 67 68
%*                                                                      *
                Words and bytes
%*                                                                      *
69 70 71
%************************************************************************

\begin{code}
72 73
type WordOff = Int -- Word offset, or word count
type ByteOff = Int -- Byte offset, or byte count
74

75
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
76 77 78 79 80 81 82 83 84
roundUpToWords dflags n =
  (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))

wordsToBytes :: DynFlags -> WordOff -> ByteOff
wordsToBytes dflags n = wORD_SIZE dflags * n

bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size
 where word_size = wORD_SIZE dflags
85 86 87 88 89
\end{code}

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

\begin{code}
90
-- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
91 92 93 94 95
newtype StgWord = StgWord Word64
    deriving (Eq,
#if __GLASGOW_HASKELL__ < 706
              Num,
#endif
96
              Bits)
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114

fromStgWord :: StgWord -> Integer
fromStgWord (StgWord i) = toInteger i

toStgWord :: DynFlags -> Integer -> StgWord
toStgWord dflags i
    = case platformWordSize (targetPlatform dflags) of
      -- These conversions mean that things like toStgWord (-1)
      -- do the right thing
      4 -> StgWord (fromIntegral (fromInteger i :: Word32))
      8 -> StgWord (fromInteger i :: Word64)
      w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w)

instance Outputable StgWord where
    ppr (StgWord i) = integer (toInteger i)

--

115 116 117
-- A Word32 is large enough to hold half a Word for either a 32bit or
-- 64bit platform
newtype StgHalfWord = StgHalfWord Word32
118 119 120
    deriving Eq

fromStgHalfWord :: StgHalfWord -> Integer
121
fromStgHalfWord (StgHalfWord w) = toInteger w
122 123 124 125 126 127

toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord dflags i
    = case platformWordSize (targetPlatform dflags) of
      -- These conversions mean that things like toStgHalfWord (-1)
      -- do the right thing
128 129
      4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
      8 -> StgHalfWord (fromInteger i :: Word32)
130 131 132
      w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)

instance Outputable StgHalfWord where
133
    ppr (StgHalfWord w) = integer (toInteger w)
134

ian@well-typed.com's avatar
ian@well-typed.com committed
135 136 137 138
hALF_WORD_SIZE :: DynFlags -> ByteOff
hALF_WORD_SIZE dflags = platformWordSize (targetPlatform dflags) `shiftR` 1
hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2
139 140
\end{code}

141
%************************************************************************
142
%*                                                                      *
143
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
144
%*                                                                      *
145 146 147
%************************************************************************

\begin{code}
148 149
-- | A description of the layout of a closure.  Corresponds directly
-- to the closure types in includes/rts/storage/ClosureTypes.h.
150
data SMRep
151 152 153 154 155 156
  = 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

157 158 159 160
  | ArrayPtrsRep
        !WordOff        -- # ptr words
        !WordOff        -- # card table words

161 162 163
  | ArrayWordsRep
        !WordOff        -- # bytes expressed in words, rounded up

164 165 166
  | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
        Liveness

167
  | RTSRep              -- The RTS needs to declare info tables with specific
168
        Int             -- type tags, so this form lets us override the default
169 170
        SMRep           -- tag for an SMRep.

171 172 173 174 175 176 177 178 179 180 181 182 183 184
-- | 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
185
  | IndStatic
186

187
type ConstrTag         = Int
188
type ConstrDescription = [Word8] -- result of dataConIdentity
189 190
type FunArity          = Int
type SelectorOffset    = Int
191 192 193 194 195

-------------------------
-- 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.
196
--
197 198
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
199
-- stored as a pointer to an array of words.
200 201 202 203 204 205 206 207

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
208
  = ArgSpec             -- Fits one of the standard patterns
209
        !Int            -- RTS type identifier ARG_P, ARG_N, ...
210

211 212
  | ArgGen              -- General case
        Liveness        -- Details about the arguments
213 214 215 216 217


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

218 219 220
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
221 222 223 224 225 226 227
  = HeapRep is_static
            ptr_wds
            (nonptr_wds + slop_wds)
            cl_type_info
  where
     slop_wds
      | is_static = 0
228
      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
229

230
     hdr_size     = closureTypeHdrSize dflags cl_type_info
231
     payload_size = ptr_wds + nonptr_wds
232

233
mkRTSRep :: Int -> SMRep -> SMRep
234
mkRTSRep = RTSRep
235 236

mkStackRep :: [Bool] -> SMRep
237
mkStackRep liveness = StackRep liveness
238 239 240 241

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

242 243 244
indStaticRep :: SMRep
indStaticRep = HeapRep True 1 0 IndStatic

245 246 247
arrPtrsRep :: DynFlags -> WordOff -> SMRep
arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)

248 249 250
arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)

Simon Marlow's avatar
Simon Marlow committed
251 252 253 254 255 256
-----------------------------------------------------------------------------
-- Predicates

isStaticRep :: SMRep -> IsStatic
isStaticRep (HeapRep is_static _ _ _) = is_static
isStaticRep (RTSRep _ rep)            = isStaticRep rep
257
isStaticRep _                         = False
Simon Marlow's avatar
Simon Marlow committed
258

259 260 261 262 263
isStackRep :: SMRep -> Bool
isStackRep StackRep{}     = True
isStackRep (RTSRep _ rep) = isStackRep rep
isStackRep _              = False

Simon Marlow's avatar
Simon Marlow committed
264 265 266 267 268 269 270 271
isConRep :: SMRep -> Bool
isConRep (HeapRep _ _ _ Constr{}) = True
isConRep _                        = False

isThunkRep :: SMRep -> Bool
isThunkRep (HeapRep _ _ _ Thunk{})         = True
isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
isThunkRep (HeapRep _ _ _ BlackHole{})     = True
272
isThunkRep (HeapRep _ _ _ IndStatic{})     = True
Simon Marlow's avatar
Simon Marlow committed
273 274
isThunkRep _                               = False

Simon Marlow's avatar
Simon Marlow committed
275 276 277 278
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

Simon Marlow's avatar
Simon Marlow committed
279 280 281 282 283 284 285
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


286 287 288 289
-----------------------------------------------------------------------------
-- Size-related things

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

293 294
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
295 296
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
ian@well-typed.com's avatar
ian@well-typed.com committed
297
 | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
298
 | otherwise                      = 0
299

300 301 302
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
303
minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
304

305 306
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
307
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
308

309 310 311 312 313
arrWordsHdrSizeW :: DynFlags -> WordOff
arrWordsHdrSizeW dflags =
    fixedHdrSize dflags +
    (sIZEOF_StgArrWords_NoHdr dflags `quot` wORD_SIZE dflags)

314 315
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
316
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
317

318 319 320 321 322
arrPtrsHdrSizeW :: DynFlags -> WordOff
arrPtrsHdrSizeW dflags =
    fixedHdrSize dflags +
    (sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)

323
-- Thunks have an extra header word on SMP, so the update doesn't
324
-- splat the payload.
325 326
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
327
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
328

329 330
nonHdrSize :: DynFlags -> SMRep -> ByteOff
nonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep)
331

332 333 334
nonHdrSizeW :: SMRep -> WordOff
nonHdrSizeW (HeapRep _ p np _) = p + np
nonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct
335
nonHdrSizeW (ArrayWordsRep words) = words
336 337
nonHdrSizeW (StackRep bs)      = length bs
nonHdrSizeW (RTSRep _ rep)     = nonHdrSizeW rep
338

339
-- | The total size of the closure, in words.
340 341
heapClosureSizeW :: DynFlags -> SMRep -> WordOff
heapClosureSizeW dflags (HeapRep _ p np ty)
342
 = closureTypeHdrSize dflags ty + p + np
343 344
heapClosureSizeW dflags (ArrayPtrsRep elems ct)
 = arrPtrsHdrSizeW dflags + elems + ct
345 346
heapClosureSizeW dflags (ArrayWordsRep words)
 = arrWordsHdrSizeW dflags + words
347
heapClosureSizeW _ _ = panic "SMRep.heapClosureSize"
348 349 350 351 352 353

closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
closureTypeHdrSize dflags ty = case ty of
                  Thunk{}         -> thunkHdrSize dflags
                  ThunkSelector{} -> thunkHdrSize dflags
                  BlackHole{}     -> thunkHdrSize dflags
354
                  IndStatic{}     -> thunkHdrSize dflags
355
                  _               -> fixedHdrSize dflags
356 357 358 359 360
        -- 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.
361

362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382
-- ---------------------------------------------------------------------------
-- Arrays

-- | The byte offset into the card table of the card for a given element
card :: DynFlags -> Int -> Int
card dflags i = i `shiftR` mUT_ARR_PTRS_CARD_BITS dflags

-- | Convert a number of elements to a number of cards, rounding up
cardRoundUp :: DynFlags -> Int -> Int
cardRoundUp dflags i =
  card dflags (i + ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))

-- | The size of a card table, in bytes
cardTableSizeB :: DynFlags -> Int -> ByteOff
cardTableSizeB dflags elems = cardRoundUp dflags elems

-- | The size of a card table, in words
cardTableSizeW :: DynFlags -> Int -> WordOff
cardTableSizeW dflags elems =
  bytesToWordsRoundUp dflags (cardTableSizeB dflags elems)

383 384
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
385

386 387 388
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
389

390
-- | Derives the RTS closure type from an 'SMRep'
391 392 393 394
rtsClosureType :: SMRep -> Int
rtsClosureType rep
    = case rep of
      RTSRep ty _ -> ty
395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427

      HeapRep False 1 0 Constr{} -> CONSTR_1_0
      HeapRep False 0 1 Constr{} -> CONSTR_0_1
      HeapRep False 2 0 Constr{} -> CONSTR_2_0
      HeapRep False 1 1 Constr{} -> CONSTR_1_1
      HeapRep False 0 2 Constr{} -> CONSTR_0_2
      HeapRep False _ _ Constr{} -> CONSTR

      HeapRep False 1 0 Fun{} -> FUN_1_0
      HeapRep False 0 1 Fun{} -> FUN_0_1
      HeapRep False 2 0 Fun{} -> FUN_2_0
      HeapRep False 1 1 Fun{} -> FUN_1_1
      HeapRep False 0 2 Fun{} -> FUN_0_2
      HeapRep False _ _ Fun{} -> FUN

      HeapRep False 1 0 Thunk{} -> THUNK_1_0
      HeapRep False 0 1 Thunk{} -> THUNK_0_1
      HeapRep False 2 0 Thunk{} -> THUNK_2_0
      HeapRep False 1 1 Thunk{} -> THUNK_1_1
      HeapRep False 0 2 Thunk{} -> THUNK_0_2
      HeapRep False _ _ Thunk{} -> THUNK

      HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR

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

      HeapRep False _ _ BlackHole{} -> BLACKHOLE

428 429
      HeapRep False _ _ IndStatic{} -> IND_STATIC

430
      _ -> panic "rtsClosureType"
431 432

-- We export these ones
433 434 435 436 437
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int
rET_SMALL   = RET_SMALL
rET_BIG     = RET_BIG
aRG_GEN     = ARG_GEN
aRG_GEN_BIG = ARG_GEN_BIG
438
\end{code}
439

440 441
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
442
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
443 444 445 446
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.
447

448
Currently we don't do this; instead we treat nullary constructors
449
as non-Caffy, and the others as potentially Caffy.
450

451

452
%************************************************************************
453
%*                                                                      *
454
             Pretty printing of SMRep and friends
455
%*                                                                      *
456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472
%************************************************************************

\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

473 474
   ppr (ArrayPtrsRep size _) = ptext (sLit "ArrayPtrsRep") <+> ppr size

475 476
   ppr (ArrayWordsRep words) = ptext (sLit "ArrayWordsRep") <+> ppr words

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

479 480
   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep

481
instance Outputable ArgDescr where
482
  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
483
  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
484

485 486
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
487
  = ptext (sLit "Con") <+>
488
    braces (sep [ ptext (sLit "tag:") <+> ppr tag
489 490 491
                , ptext (sLit "descr:") <> text (show descr) ])

pprTypeInfo (Fun arity args)
492
  = ptext (sLit "Fun") <+>
493
    braces (sep [ ptext (sLit "arity:") <+> ppr arity
494 495
                , ptext (sLit ("fun_type:")) <+> ppr args ])

496
pprTypeInfo (ThunkSelector offset)
497
  = ptext (sLit "ThunkSel") <+> ppr offset
498 499 500

pprTypeInfo Thunk     = ptext (sLit "Thunk")
pprTypeInfo BlackHole = ptext (sLit "BlackHole")
501
pprTypeInfo IndStatic = ptext (sLit "IndStatic")
502

Simon Marlow's avatar
Simon Marlow committed
503
-- XXX Does not belong here!!
504 505 506 507 508 509 510
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}