SMRep.lhs 13.9 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
        StgWord,
        StgHalfWord, fromStgHalfWord, toStgHalfWord,
16 17
        hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
        WordOff, ByteOff,
18
        roundUpToWords,
19

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

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

Simon Marlow's avatar
Simon Marlow committed
29
        -- ** Predicates
Simon Marlow's avatar
Simon Marlow committed
30
        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
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.Char( ord )
Simon Marlow's avatar
Simon Marlow committed
54
import Data.Word
55
import Data.Bits
56 57
\end{code}

58 59

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

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

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

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

\begin{code}
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
newtype StgHalfWord = StgHalfWord Integer
    deriving Eq

fromStgHalfWord :: StgHalfWord -> Integer
fromStgHalfWord (StgHalfWord i) = i

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

instance Outputable StgHalfWord where
    ppr (StgHalfWord i) = integer i

94 95
#if SIZEOF_HSWORD == 4
type StgWord     = Word32
Ian Lynagh's avatar
Ian Lynagh committed
96 97 98 99
hALF_WORD_SIZE :: ByteOff
hALF_WORD_SIZE = 2
hALF_WORD_SIZE_IN_BITS :: Int
hALF_WORD_SIZE_IN_BITS = 16
100 101
#elif SIZEOF_HSWORD == 8
type StgWord     = Word64
Ian Lynagh's avatar
Ian Lynagh committed
102 103 104 105
hALF_WORD_SIZE :: ByteOff
hALF_WORD_SIZE = 4
hALF_WORD_SIZE_IN_BITS :: Int
hALF_WORD_SIZE_IN_BITS = 32
106 107 108 109 110
#else
#error unknown SIZEOF_HSWORD
#endif
\end{code}

111

112
%************************************************************************
113
%*                                                                      *
114
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
115
%*                                                                      *
116 117 118
%************************************************************************

\begin{code}
119 120
-- | A description of the layout of a closure.  Corresponds directly
-- to the closure types in includes/rts/storage/ClosureTypes.h.
121
data SMRep
122 123 124 125 126 127 128 129 130
  = 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

131 132 133 134
  | 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.

135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
-- | 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.
159
--
160 161
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
162
-- stored as a pointer to an array of words.
163 164 165 166 167 168 169 170

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
171 172
  = ArgSpec             -- Fits one of the standard patterns
        !StgHalfWord    -- RTS type identifier ARG_P, ARG_N, ...
173

174 175
  | ArgGen              -- General case
        Liveness        -- Details about the arguments
176 177 178 179 180


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

181 182 183
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
184 185 186 187 188 189 190
  = HeapRep is_static
            ptr_wds
            (nonptr_wds + slop_wds)
            cl_type_info
  where
     slop_wds
      | is_static = 0
191
      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
192

193
     hdr_size     = closureTypeHdrSize dflags cl_type_info
194
     payload_size = ptr_wds + nonptr_wds
195

196 197
mkRTSRep :: StgHalfWord -> SMRep -> SMRep
mkRTSRep = RTSRep
198 199

mkStackRep :: [Bool] -> SMRep
200
mkStackRep liveness = StackRep liveness
201 202 203 204

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

Simon Marlow's avatar
Simon Marlow committed
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222
-----------------------------------------------------------------------------
-- 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
223 224 225 226
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

Simon Marlow's avatar
Simon Marlow committed
227 228 229 230 231 232 233
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


234 235 236 237
-----------------------------------------------------------------------------
-- Size-related things

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

241 242
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
243 244
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
245
 | dopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
246
 | otherwise                      = 0
247

248 249 250
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
251
minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
252

253 254
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
255
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
256

257 258
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
259
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
260

261
-- Thunks have an extra header word on SMP, so the update doesn't
262
-- splat the payload.
263 264
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
265
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
266

267

268 269 270
nonHdrSize :: SMRep -> WordOff
nonHdrSize (HeapRep _ p np _) = p + np
nonHdrSize (StackRep bs)      = length bs
271
nonHdrSize (RTSRep _ rep)     = nonHdrSize rep
272

273 274 275 276 277 278 279 280 281 282 283
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
284 285 286 287 288
        -- 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.
289

290 291
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
292

293 294 295
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
296

297
-- | Derives the RTS closure type from an 'SMRep'
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 324 325 326 327 328 329 330 331 332 333 334 335 336
rtsClosureType :: DynFlags -> SMRep -> StgHalfWord
rtsClosureType dflags rep
    = toStgHalfWord dflags
    $ case rep of
      RTSRep ty _ -> fromStgHalfWord ty

      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

      _ -> panic "rtsClosureType"
337 338

-- We export these ones
339 340 341 342 343
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: DynFlags -> StgHalfWord
rET_SMALL   dflags = toStgHalfWord dflags RET_SMALL
rET_BIG     dflags = toStgHalfWord dflags RET_BIG
aRG_GEN     dflags = toStgHalfWord dflags ARG_GEN
aRG_GEN_BIG dflags = toStgHalfWord dflags ARG_GEN_BIG
344
\end{code}
345

346 347
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
348
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
349 350 351 352
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.
353

354
Currently we don't do this; instead we treat nullary constructors
355
as non-Caffy, and the others as potentially Caffy.
356

357

358
%************************************************************************
359
%*                                                                      *
360
             Pretty printing of SMRep and friends
361
%*                                                                      *
362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380
%************************************************************************

\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

381 382
   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep

383
instance Outputable ArgDescr where
384
  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
385
  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
386

387 388
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
389
  = ptext (sLit "Con") <+>
390
    braces (sep [ ptext (sLit "tag:") <+> ppr tag
391 392 393
                , ptext (sLit "descr:") <> text (show descr) ])

pprTypeInfo (Fun arity args)
394
  = ptext (sLit "Fun") <+>
395
    braces (sep [ ptext (sLit "arity:") <+> ppr arity
396 397
                , ptext (sLit ("fun_type:")) <+> ppr args ])

398
pprTypeInfo (ThunkSelector offset)
399 400 401 402 403
  = ptext (sLit "ThunkSel") <+> integer (toInteger offset)

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

Simon Marlow's avatar
Simon Marlow committed
404
-- XXX Does not belong here!!
405 406 407 408 409 410 411
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}