SMRep.lhs 14.8 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
        StgWord, fromStgWord, toStgWord,
14
        StgHalfWord, fromStgHalfWord, toStgHalfWord,
15 16
        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, indStaticRep, 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,
30
        isStackRep,
Simon Marlow's avatar
Simon Marlow committed
31 32

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

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

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

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

48
import DynFlags
sof's avatar
sof committed
49
import Outputable
50
import Platform
51
import FastString
52

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

59 60

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

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

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

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

\begin{code}
77
-- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
newtype StgWord = StgWord Word64
    deriving (Eq,
#if __GLASGOW_HASKELL__ < 706
              Num,
#endif
              Bits, IArray UArray)

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)

--

102 103 104
-- A Word32 is large enough to hold half a Word for either a 32bit or
-- 64bit platform
newtype StgHalfWord = StgHalfWord Word32
105 106 107
    deriving Eq

fromStgHalfWord :: StgHalfWord -> Integer
108
fromStgHalfWord (StgHalfWord w) = toInteger w
109 110 111 112 113 114

toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord dflags i
    = case platformWordSize (targetPlatform dflags) of
      -- These conversions mean that things like toStgHalfWord (-1)
      -- do the right thing
115 116
      4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
      8 -> StgHalfWord (fromInteger i :: Word32)
117 118 119
      w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)

instance Outputable StgHalfWord where
120
    ppr (StgHalfWord w) = integer (toInteger w)
121

ian@well-typed.com's avatar
ian@well-typed.com committed
122 123 124 125
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
126 127
\end{code}

128

129
%************************************************************************
130
%*                                                                      *
131
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
132
%*                                                                      *
133 134 135
%************************************************************************

\begin{code}
136 137
-- | A description of the layout of a closure.  Corresponds directly
-- to the closure types in includes/rts/storage/ClosureTypes.h.
138
data SMRep
139 140 141 142 143 144 145 146 147
  = 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

148
  | RTSRep              -- The RTS needs to declare info tables with specific
149
        Int             -- type tags, so this form lets us override the default
150 151
        SMRep           -- tag for an SMRep.

152 153 154 155 156 157 158 159 160 161 162 163 164 165
-- | 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
166
  | IndStatic
167

168
type ConstrTag         = Int
169
type ConstrDescription = [Word8] -- result of dataConIdentity
170 171
type FunArity          = Int
type SelectorOffset    = Int
172 173 174 175 176

-------------------------
-- 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.
177
--
178 179
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
180
-- stored as a pointer to an array of words.
181 182 183 184 185 186 187 188

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

192 193
  | ArgGen              -- General case
        Liveness        -- Details about the arguments
194 195 196 197 198


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

199 200 201
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
202 203 204 205 206 207 208
  = HeapRep is_static
            ptr_wds
            (nonptr_wds + slop_wds)
            cl_type_info
  where
     slop_wds
      | is_static = 0
209
      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
210

211
     hdr_size     = closureTypeHdrSize dflags cl_type_info
212
     payload_size = ptr_wds + nonptr_wds
213

214
mkRTSRep :: Int -> SMRep -> SMRep
215
mkRTSRep = RTSRep
216 217

mkStackRep :: [Bool] -> SMRep
218
mkStackRep liveness = StackRep liveness
219 220 221 222

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

223 224 225
indStaticRep :: SMRep
indStaticRep = HeapRep True 1 0 IndStatic

Simon Marlow's avatar
Simon Marlow committed
226 227 228 229 230 231 232 233
-----------------------------------------------------------------------------
-- Predicates

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

234 235 236 237 238
isStackRep :: SMRep -> Bool
isStackRep StackRep{}     = True
isStackRep (RTSRep _ rep) = isStackRep rep
isStackRep _              = False

Simon Marlow's avatar
Simon Marlow committed
239 240 241 242 243 244 245 246
isConRep :: SMRep -> Bool
isConRep (HeapRep _ _ _ Constr{}) = True
isConRep _                        = False

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

Simon Marlow's avatar
Simon Marlow committed
250 251 252 253
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

Simon Marlow's avatar
Simon Marlow committed
254 255 256 257 258 259 260
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


261 262 263 264
-----------------------------------------------------------------------------
-- Size-related things

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

268 269
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
270 271
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
ian@well-typed.com's avatar
ian@well-typed.com committed
272
 | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
273
 | otherwise                      = 0
274

275 276 277
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
278
minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
279

280 281
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
282
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
283

284 285
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
286
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
287

288
-- Thunks have an extra header word on SMP, so the update doesn't
289
-- splat the payload.
290 291
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
292
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
293

294

295 296 297
nonHdrSize :: SMRep -> WordOff
nonHdrSize (HeapRep _ p np _) = p + np
nonHdrSize (StackRep bs)      = length bs
298
nonHdrSize (RTSRep _ rep)     = nonHdrSize rep
299

300 301 302 303 304 305 306 307 308 309
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
310
                  IndStatic{}     -> thunkHdrSize dflags
311
                  _               -> fixedHdrSize dflags
312 313 314 315 316
        -- 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.
317

318 319
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
320

321 322 323
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
324

325
-- | Derives the RTS closure type from an 'SMRep'
326 327 328 329
rtsClosureType :: SMRep -> Int
rtsClosureType rep
    = case rep of
      RTSRep ty _ -> ty
330 331 332 333 334 335 336 337 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

      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

363 364
      HeapRep False _ _ IndStatic{} -> IND_STATIC

365
      _ -> panic "rtsClosureType"
366 367

-- We export these ones
368 369 370 371 372
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
373
\end{code}
374

375 376
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
377
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
378 379 380 381
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.
382

383
Currently we don't do this; instead we treat nullary constructors
384
as non-Caffy, and the others as potentially Caffy.
385

386

387
%************************************************************************
388
%*                                                                      *
389
             Pretty printing of SMRep and friends
390
%*                                                                      *
391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409
%************************************************************************

\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

410 411
   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep

412
instance Outputable ArgDescr where
413
  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
414
  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
415

416 417
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
418
  = ptext (sLit "Con") <+>
419
    braces (sep [ ptext (sLit "tag:") <+> ppr tag
420 421 422
                , ptext (sLit "descr:") <> text (show descr) ])

pprTypeInfo (Fun arity args)
423
  = ptext (sLit "Fun") <+>
424
    braces (sep [ ptext (sLit "arity:") <+> ppr arity
425 426
                , ptext (sLit ("fun_type:")) <+> ppr args ])

427
pprTypeInfo (ThunkSelector offset)
428
  = ptext (sLit "ThunkSel") <+> ppr offset
429 430 431

pprTypeInfo Thunk     = ptext (sLit "Thunk")
pprTypeInfo BlackHole = ptext (sLit "BlackHole")
432
pprTypeInfo IndStatic = ptext (sLit "IndStatic")
433

Simon Marlow's avatar
Simon Marlow committed
434
-- XXX Does not belong here!!
435 436 437 438 439 440 441
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}