SMRep.lhs 15.1 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,
29

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

        -- ** Size-related things
35 36 37 38
        heapClosureSize,
        fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
        profHdrSize, thunkHdrSize, nonHdrSize,

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

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

47
#include "../HsVersions.h"
48
#include "../includes/MachDeps.h"
49

50
import DynFlags
sof's avatar
sof committed
51
import Outputable
52
import Platform
53
import FastString
54

55
import Data.Char( ord )
Simon Marlow's avatar
Simon Marlow committed
56
import Data.Word
57
import Data.Bits
58 59
\end{code}

60 61

%************************************************************************
62 63 64
%*                                                                      *
                Words and bytes
%*                                                                      *
65 66 67
%************************************************************************

\begin{code}
68 69
type WordOff = Int -- Word offset, or word count
type ByteOff = Int -- Byte offset, or byte count
70

71
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
72 73 74 75 76 77 78 79 80
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
81 82 83 84 85
\end{code}

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

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

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)

--

111 112 113
-- A Word32 is large enough to hold half a Word for either a 32bit or
-- 64bit platform
newtype StgHalfWord = StgHalfWord Word32
114 115 116
    deriving Eq

fromStgHalfWord :: StgHalfWord -> Integer
117
fromStgHalfWord (StgHalfWord w) = toInteger w
118 119 120 121 122 123

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

instance Outputable StgHalfWord where
129
    ppr (StgHalfWord w) = integer (toInteger w)
130

ian@well-typed.com's avatar
ian@well-typed.com committed
131 132 133 134
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
135 136
\end{code}

137
%************************************************************************
138
%*                                                                      *
139
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
140
%*                                                                      *
141 142 143
%************************************************************************

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

156
  | RTSRep              -- The RTS needs to declare info tables with specific
157
        Int             -- type tags, so this form lets us override the default
158 159
        SMRep           -- tag for an SMRep.

160 161 162 163 164 165 166 167 168 169 170 171 172 173
-- | 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
174
  | IndStatic
175

176
type ConstrTag         = Int
177
type ConstrDescription = [Word8] -- result of dataConIdentity
178 179
type FunArity          = Int
type SelectorOffset    = Int
180 181 182 183 184

-------------------------
-- 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.
185
--
186 187
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
188
-- stored as a pointer to an array of words.
189 190 191 192 193 194 195 196

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

200 201
  | ArgGen              -- General case
        Liveness        -- Details about the arguments
202 203 204 205 206


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

207 208 209
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
210 211 212 213 214 215 216
  = HeapRep is_static
            ptr_wds
            (nonptr_wds + slop_wds)
            cl_type_info
  where
     slop_wds
      | is_static = 0
217
      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
218

219
     hdr_size     = closureTypeHdrSize dflags cl_type_info
220
     payload_size = ptr_wds + nonptr_wds
221

222
mkRTSRep :: Int -> SMRep -> SMRep
223
mkRTSRep = RTSRep
224 225

mkStackRep :: [Bool] -> SMRep
226
mkStackRep liveness = StackRep liveness
227 228 229 230

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

231 232 233
indStaticRep :: SMRep
indStaticRep = HeapRep True 1 0 IndStatic

Simon Marlow's avatar
Simon Marlow committed
234 235 236 237 238 239 240 241
-----------------------------------------------------------------------------
-- Predicates

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

242 243 244 245 246
isStackRep :: SMRep -> Bool
isStackRep StackRep{}     = True
isStackRep (RTSRep _ rep) = isStackRep rep
isStackRep _              = False

Simon Marlow's avatar
Simon Marlow committed
247 248 249 250 251 252 253 254
isConRep :: SMRep -> Bool
isConRep (HeapRep _ _ _ Constr{}) = True
isConRep _                        = False

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

Simon Marlow's avatar
Simon Marlow committed
258 259 260 261
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

Simon Marlow's avatar
Simon Marlow committed
262 263 264 265 266 267 268
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


269 270 271 272
-----------------------------------------------------------------------------
-- Size-related things

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

276 277
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
278 279
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
ian@well-typed.com's avatar
ian@well-typed.com committed
280
 | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
281
 | otherwise                      = 0
282

283 284 285
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
286
minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
287

288 289
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
290
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
291

292 293
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
294
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
295

296
-- Thunks have an extra header word on SMP, so the update doesn't
297
-- splat the payload.
298 299
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
300
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
301

302

303 304 305
nonHdrSize :: SMRep -> WordOff
nonHdrSize (HeapRep _ p np _) = p + np
nonHdrSize (StackRep bs)      = length bs
306
nonHdrSize (RTSRep _ rep)     = nonHdrSize rep
307

308 309 310 311 312 313 314 315 316 317
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
318
                  IndStatic{}     -> thunkHdrSize dflags
319
                  _               -> fixedHdrSize dflags
320 321 322 323 324
        -- 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.
325

326 327
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
328

329 330 331
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
332

333
-- | Derives the RTS closure type from an 'SMRep'
334 335 336 337
rtsClosureType :: SMRep -> Int
rtsClosureType rep
    = case rep of
      RTSRep ty _ -> ty
338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370

      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

371 372
      HeapRep False _ _ IndStatic{} -> IND_STATIC

373
      _ -> panic "rtsClosureType"
374 375

-- We export these ones
376 377 378 379 380
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
381
\end{code}
382

383 384
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
385
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
386 387 388 389
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.
390

391
Currently we don't do this; instead we treat nullary constructors
392
as non-Caffy, and the others as potentially Caffy.
393

394

395
%************************************************************************
396
%*                                                                      *
397
             Pretty printing of SMRep and friends
398
%*                                                                      *
399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417
%************************************************************************

\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

418 419
   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep

420
instance Outputable ArgDescr where
421
  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
422
  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
423

424 425
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
426
  = ptext (sLit "Con") <+>
427
    braces (sep [ ptext (sLit "tag:") <+> ppr tag
428 429 430
                , ptext (sLit "descr:") <> text (show descr) ])

pprTypeInfo (Fun arity args)
431
  = ptext (sLit "Fun") <+>
432
    braces (sep [ ptext (sLit "arity:") <+> ppr arity
433 434
                , ptext (sLit ("fun_type:")) <+> ppr args ])

435
pprTypeInfo (ThunkSelector offset)
436
  = ptext (sLit "ThunkSel") <+> ppr offset
437 438 439

pprTypeInfo Thunk     = ptext (sLit "Thunk")
pprTypeInfo BlackHole = ptext (sLit "BlackHole")
440
pprTypeInfo IndStatic = ptext (sLit "IndStatic")
441

Simon Marlow's avatar
Simon Marlow committed
442
-- XXX Does not belong here!!
443 444 445 446 447 448 449
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}