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

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

\begin{code}
12 13
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

14
module SMRep (
Simon Marlow's avatar
Simon Marlow committed
15
        -- * Words and bytes
16
        StgWord, fromStgWord, toStgWord,
17
        StgHalfWord, fromStgHalfWord, toStgHalfWord,
18 19
        hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
        WordOff, ByteOff,
20
        roundUpToWords,
21

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

        -- ** Construction
29
        mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep,
30

Simon Marlow's avatar
Simon Marlow committed
31
        -- ** Predicates
Simon Marlow's avatar
Simon Marlow committed
32
        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
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.Array.Base
56
import Data.Char( ord )
Simon Marlow's avatar
Simon Marlow committed
57
import Data.Word
58
import Data.Bits
59 60
\end{code}

61 62

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

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

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

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

\begin{code}
79
-- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
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)

--

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

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

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

instance Outputable StgHalfWord where
122
    ppr (StgHalfWord w) = integer (toInteger w)
123

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

130

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

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

150 151 152 153
  | 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.

154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
-- | 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.
178
--
179 180
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
181
-- stored as a pointer to an array of words.
182 183 184 185 186 187 188 189

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

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


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

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

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

215 216
mkRTSRep :: StgHalfWord -> SMRep -> SMRep
mkRTSRep = RTSRep
217 218

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

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

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

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
242 243 244 245
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

Simon Marlow's avatar
Simon Marlow committed
246 247 248 249 250 251 252
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


253 254 255 256
-----------------------------------------------------------------------------
-- Size-related things

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

260 261
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
262 263
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
264
 | dopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
265
 | otherwise                      = 0
266

267 268 269
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
270
minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
271

272 273
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
274
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
275

276 277
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
278
 = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
279

280
-- Thunks have an extra header word on SMP, so the update doesn't
281
-- splat the payload.
282 283
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
284
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
285

286

287 288 289
nonHdrSize :: SMRep -> WordOff
nonHdrSize (HeapRep _ p np _) = p + np
nonHdrSize (StackRep bs)      = length bs
290
nonHdrSize (RTSRep _ rep)     = nonHdrSize rep
291

292 293 294 295 296 297 298 299 300 301 302
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
303 304 305 306 307
        -- 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.
308

309 310
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
311

312 313 314
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
315

316
-- | Derives the RTS closure type from an 'SMRep'
317 318 319 320 321 322 323 324 325 326 327 328 329 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
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"
356 357

-- We export these ones
358 359 360 361 362
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
363
\end{code}
364

365 366
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
367
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
368 369 370 371
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.
372

373
Currently we don't do this; instead we treat nullary constructors
374
as non-Caffy, and the others as potentially Caffy.
375

376

377
%************************************************************************
378
%*                                                                      *
379
             Pretty printing of SMRep and friends
380
%*                                                                      *
381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399
%************************************************************************

\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

400 401
   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep

402
instance Outputable ArgDescr where
403
  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
404
  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
405

406 407
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
408
  = ptext (sLit "Con") <+>
409
    braces (sep [ ptext (sLit "tag:") <+> ppr tag
410 411 412
                , ptext (sLit "descr:") <> text (show descr) ])

pprTypeInfo (Fun arity args)
413
  = ptext (sLit "Fun") <+>
414
    braces (sep [ ptext (sLit "arity:") <+> ppr arity
415 416
                , ptext (sLit ("fun_type:")) <+> ppr args ])

417
pprTypeInfo (ThunkSelector offset)
418
  = ptext (sLit "ThunkSel") <+> ppr offset
419 420 421 422

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

Simon Marlow's avatar
Simon Marlow committed
423
-- XXX Does not belong here!!
424 425 426 427 428 429 430
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}