add a comment
[ghc.git] / compiler / cmm / SMRep.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 Storage manager representation of closures
7
8 \begin{code}
9 {-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}
10
11 module SMRep (
12         -- * Words and bytes
13         WordOff, ByteOff,
14         wordsToBytes, bytesToWordsRoundUp,
15         roundUpToWords,
16
17         StgWord, fromStgWord, toStgWord,
18         StgHalfWord, fromStgHalfWord, toStgHalfWord,
19         hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
20
21         -- * Closure repesentation
22         SMRep(..), -- CmmInfo sees the rep; no one else does
23         IsStatic,
24         ClosureTypeInfo(..), ArgDescr(..), Liveness,
25         ConstrDescription,
26
27         -- ** Construction
28         mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
29         smallArrPtrsRep, arrWordsRep,
30
31         -- ** Predicates
32         isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
33         isStackRep,
34
35         -- ** Size-related things
36         heapClosureSizeW,
37         fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
38         arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
39         smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
40         fixedHdrSize,
41
42         -- ** RTS closure types
43         rtsClosureType, rET_SMALL, rET_BIG,
44         aRG_GEN, aRG_GEN_BIG,
45
46         -- ** Arrays
47         card, cardRoundUp, cardTableSizeB, cardTableSizeW,
48
49         -- * Operations over [Word8] strings that don't belong here
50         pprWord8String, stringToWord8s
51     ) where
52
53 #include "../HsVersions.h"
54 #include "../includes/MachDeps.h"
55
56 import DynFlags
57 import Outputable
58 import Platform
59 import FastString
60
61 import Data.Char( ord )
62 import Data.Word
63 import Data.Bits
64 \end{code}
65
66
67 %************************************************************************
68 %*                                                                      *
69                 Words and bytes
70 %*                                                                      *
71 %************************************************************************
72
73 \begin{code}
74 type WordOff = Int -- Word offset, or word count
75 type ByteOff = Int -- Byte offset, or byte count
76
77 roundUpToWords :: DynFlags -> ByteOff -> ByteOff
78 roundUpToWords dflags n =
79   (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))
80
81 wordsToBytes :: DynFlags -> WordOff -> ByteOff
82 wordsToBytes dflags n = wORD_SIZE dflags * n
83
84 bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
85 bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size
86  where word_size = wORD_SIZE dflags
87 \end{code}
88
89 StgWord is a type representing an StgWord on the target platform.
90
91 \begin{code}
92 -- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
93 newtype StgWord = StgWord Word64
94     deriving (Eq,
95 #if __GLASGOW_HASKELL__ < 706
96               Num,
97 #endif
98               Bits)
99
100 fromStgWord :: StgWord -> Integer
101 fromStgWord (StgWord i) = toInteger i
102
103 toStgWord :: DynFlags -> Integer -> StgWord
104 toStgWord dflags i
105     = case platformWordSize (targetPlatform dflags) of
106       -- These conversions mean that things like toStgWord (-1)
107       -- do the right thing
108       4 -> StgWord (fromIntegral (fromInteger i :: Word32))
109       8 -> StgWord (fromInteger i :: Word64)
110       w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w)
111
112 instance Outputable StgWord where
113     ppr (StgWord i) = integer (toInteger i)
114
115 --
116
117 -- A Word32 is large enough to hold half a Word for either a 32bit or
118 -- 64bit platform
119 newtype StgHalfWord = StgHalfWord Word32
120     deriving Eq
121
122 fromStgHalfWord :: StgHalfWord -> Integer
123 fromStgHalfWord (StgHalfWord w) = toInteger w
124
125 toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
126 toStgHalfWord dflags i
127     = case platformWordSize (targetPlatform dflags) of
128       -- These conversions mean that things like toStgHalfWord (-1)
129       -- do the right thing
130       4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
131       8 -> StgHalfWord (fromInteger i :: Word32)
132       w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)
133
134 instance Outputable StgHalfWord where
135     ppr (StgHalfWord w) = integer (toInteger w)
136
137 hALF_WORD_SIZE :: DynFlags -> ByteOff
138 hALF_WORD_SIZE dflags = platformWordSize (targetPlatform dflags) `shiftR` 1
139 hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
140 hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2
141 \end{code}
142
143 %************************************************************************
144 %*                                                                      *
145 \subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
146 %*                                                                      *
147 %************************************************************************
148
149 \begin{code}
150 -- | A description of the layout of a closure.  Corresponds directly
151 -- to the closure types in includes/rts/storage/ClosureTypes.h.
152 data SMRep
153   = HeapRep              -- GC routines consult sizes in info tbl
154         IsStatic
155         !WordOff         --  # ptr words
156         !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)
157         ClosureTypeInfo  -- type-specific info
158
159   | ArrayPtrsRep
160         !WordOff        -- # ptr words
161         !WordOff        -- # card table words
162
163   | SmallArrayPtrsRep
164         !WordOff        -- # ptr words
165
166   | ArrayWordsRep
167         !WordOff        -- # bytes expressed in words, rounded up
168
169   | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
170         Liveness
171
172   | RTSRep              -- The RTS needs to declare info tables with specific
173         Int             -- type tags, so this form lets us override the default
174         SMRep           -- tag for an SMRep.
175
176 -- | True <=> This is a static closure.  Affects how we garbage-collect it.
177 -- Static closure have an extra static link field at the end.
178 type IsStatic = Bool
179
180 -- From an SMRep you can get to the closure type defined in
181 -- includes/rts/storage/ClosureTypes.h. Described by the function
182 -- rtsClosureType below.
183
184 data ClosureTypeInfo
185   = Constr        ConstrTag ConstrDescription
186   | Fun           FunArity ArgDescr
187   | Thunk
188   | ThunkSelector SelectorOffset
189   | BlackHole
190   | IndStatic
191
192 type ConstrTag         = Int
193 type ConstrDescription = [Word8] -- result of dataConIdentity
194 type FunArity          = Int
195 type SelectorOffset    = Int
196
197 -------------------------
198 -- We represent liveness bitmaps as a Bitmap (whose internal
199 -- representation really is a bitmap).  These are pinned onto case return
200 -- vectors to indicate the state of the stack for the garbage collector.
201 --
202 -- In the compiled program, liveness bitmaps that fit inside a single
203 -- word (StgWord) are stored as a single word, while larger bitmaps are
204 -- stored as a pointer to an array of words.
205
206 type Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead
207                          --                    False <=> ptr
208
209 -------------------------
210 -- An ArgDescr describes the argument pattern of a function
211
212 data ArgDescr
213   = ArgSpec             -- Fits one of the standard patterns
214         !Int            -- RTS type identifier ARG_P, ARG_N, ...
215
216   | ArgGen              -- General case
217         Liveness        -- Details about the arguments
218
219
220 -----------------------------------------------------------------------------
221 -- Construction
222
223 mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
224           -> SMRep
225 mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
226   = HeapRep is_static
227             ptr_wds
228             (nonptr_wds + slop_wds)
229             cl_type_info
230   where
231      slop_wds
232       | is_static = 0
233       | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
234
235      hdr_size     = closureTypeHdrSize dflags cl_type_info
236      payload_size = ptr_wds + nonptr_wds
237
238 mkRTSRep :: Int -> SMRep -> SMRep
239 mkRTSRep = RTSRep
240
241 mkStackRep :: [Bool] -> SMRep
242 mkStackRep liveness = StackRep liveness
243
244 blackHoleRep :: SMRep
245 blackHoleRep = HeapRep False 0 0 BlackHole
246
247 indStaticRep :: SMRep
248 indStaticRep = HeapRep True 1 0 IndStatic
249
250 arrPtrsRep :: DynFlags -> WordOff -> SMRep
251 arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)
252
253 smallArrPtrsRep :: WordOff -> SMRep
254 smallArrPtrsRep elems = SmallArrayPtrsRep elems
255
256 arrWordsRep :: DynFlags -> ByteOff -> SMRep
257 arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)
258
259 -----------------------------------------------------------------------------
260 -- Predicates
261
262 isStaticRep :: SMRep -> IsStatic
263 isStaticRep (HeapRep is_static _ _ _) = is_static
264 isStaticRep (RTSRep _ rep)            = isStaticRep rep
265 isStaticRep _                         = False
266
267 isStackRep :: SMRep -> Bool
268 isStackRep StackRep{}     = True
269 isStackRep (RTSRep _ rep) = isStackRep rep
270 isStackRep _              = False
271
272 isConRep :: SMRep -> Bool
273 isConRep (HeapRep _ _ _ Constr{}) = True
274 isConRep _                        = False
275
276 isThunkRep :: SMRep -> Bool
277 isThunkRep (HeapRep _ _ _ Thunk{})         = True
278 isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
279 isThunkRep (HeapRep _ _ _ BlackHole{})     = True
280 isThunkRep (HeapRep _ _ _ IndStatic{})     = True
281 isThunkRep _                               = False
282
283 isFunRep :: SMRep -> Bool
284 isFunRep (HeapRep _ _ _ Fun{}) = True
285 isFunRep _                     = False
286
287 isStaticNoCafCon :: SMRep -> Bool
288 -- This should line up exactly with CONSTR_NOCAF_STATIC above
289 -- See Note [Static NoCaf constructors]
290 isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True
291 isStaticNoCafCon _                           = False
292
293
294 -----------------------------------------------------------------------------
295 -- Size-related things
296
297 fixedHdrSize :: DynFlags -> ByteOff
298 fixedHdrSize dflags = wordsToBytes dflags (fixedHdrSizeW dflags)
299
300 -- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
301 fixedHdrSizeW :: DynFlags -> WordOff
302 fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
303
304 -- | Size of the profiling part of a closure header
305 -- (StgProfHeader in includes/rts/storage/Closures.h)
306 profHdrSize  :: DynFlags -> WordOff
307 profHdrSize dflags
308  | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
309  | otherwise                      = 0
310
311 -- | The garbage collector requires that every closure is at least as
312 --   big as this.
313 minClosureSize :: DynFlags -> WordOff
314 minClosureSize dflags = fixedHdrSizeW dflags + mIN_PAYLOAD_SIZE dflags
315
316 arrWordsHdrSize :: DynFlags -> ByteOff
317 arrWordsHdrSize dflags
318  = fixedHdrSize dflags + sIZEOF_StgArrWords_NoHdr dflags
319
320 arrWordsHdrSizeW :: DynFlags -> WordOff
321 arrWordsHdrSizeW dflags =
322     fixedHdrSizeW dflags +
323     (sIZEOF_StgArrWords_NoHdr dflags `quot` wORD_SIZE dflags)
324
325 arrPtrsHdrSize :: DynFlags -> ByteOff
326 arrPtrsHdrSize dflags
327  = fixedHdrSize dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
328
329 arrPtrsHdrSizeW :: DynFlags -> WordOff
330 arrPtrsHdrSizeW dflags =
331     fixedHdrSizeW dflags +
332     (sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
333
334 smallArrPtrsHdrSize :: DynFlags -> ByteOff
335 smallArrPtrsHdrSize dflags
336  = fixedHdrSize dflags + sIZEOF_StgSmallMutArrPtrs_NoHdr dflags
337
338 smallArrPtrsHdrSizeW :: DynFlags -> WordOff
339 smallArrPtrsHdrSizeW dflags =
340     fixedHdrSizeW dflags +
341     (sIZEOF_StgSmallMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
342
343 -- Thunks have an extra header word on SMP, so the update doesn't
344 -- splat the payload.
345 thunkHdrSize :: DynFlags -> WordOff
346 thunkHdrSize dflags = fixedHdrSizeW dflags + smp_hdr
347         where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
348
349 hdrSize :: DynFlags -> SMRep -> ByteOff
350 hdrSize dflags rep = wordsToBytes dflags (hdrSizeW dflags rep)
351
352 hdrSizeW :: DynFlags -> SMRep -> WordOff
353 hdrSizeW dflags (HeapRep _ _ _ ty)    = closureTypeHdrSize dflags ty
354 hdrSizeW dflags (ArrayPtrsRep _ _)    = arrPtrsHdrSizeW dflags
355 hdrSizeW dflags (SmallArrayPtrsRep _) = smallArrPtrsHdrSizeW dflags
356 hdrSizeW dflags (ArrayWordsRep _)     = arrWordsHdrSizeW dflags
357 hdrSizeW _ _                          = panic "SMRep.hdrSizeW"
358
359 nonHdrSize :: DynFlags -> SMRep -> ByteOff
360 nonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep)
361
362 nonHdrSizeW :: SMRep -> WordOff
363 nonHdrSizeW (HeapRep _ p np _) = p + np
364 nonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct
365 nonHdrSizeW (SmallArrayPtrsRep elems) = elems
366 nonHdrSizeW (ArrayWordsRep words) = words
367 nonHdrSizeW (StackRep bs)      = length bs
368 nonHdrSizeW (RTSRep _ rep)     = nonHdrSizeW rep
369
370 -- | The total size of the closure, in words.
371 heapClosureSizeW :: DynFlags -> SMRep -> WordOff
372 heapClosureSizeW dflags (HeapRep _ p np ty)
373  = closureTypeHdrSize dflags ty + p + np
374 heapClosureSizeW dflags (ArrayPtrsRep elems ct)
375  = arrPtrsHdrSizeW dflags + elems + ct
376 heapClosureSizeW dflags (SmallArrayPtrsRep elems)
377  = smallArrPtrsHdrSizeW dflags + elems
378 heapClosureSizeW dflags (ArrayWordsRep words)
379  = arrWordsHdrSizeW dflags + words
380 heapClosureSizeW _ _ = panic "SMRep.heapClosureSize"
381
382 closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
383 closureTypeHdrSize dflags ty = case ty of
384                   Thunk{}         -> thunkHdrSize dflags
385                   ThunkSelector{} -> thunkHdrSize dflags
386                   BlackHole{}     -> thunkHdrSize dflags
387                   IndStatic{}     -> thunkHdrSize dflags
388                   _               -> fixedHdrSizeW dflags
389         -- All thunks use thunkHdrSize, even if they are non-updatable.
390         -- this is because we don't have separate closure types for
391         -- updatable vs. non-updatable thunks, so the GC can't tell the
392         -- difference.  If we ever have significant numbers of non-
393         -- updatable thunks, it might be worth fixing this.
394
395 -- ---------------------------------------------------------------------------
396 -- Arrays
397
398 -- | The byte offset into the card table of the card for a given element
399 card :: DynFlags -> Int -> Int
400 card dflags i = i `shiftR` mUT_ARR_PTRS_CARD_BITS dflags
401
402 -- | Convert a number of elements to a number of cards, rounding up
403 cardRoundUp :: DynFlags -> Int -> Int
404 cardRoundUp dflags i =
405   card dflags (i + ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))
406
407 -- | The size of a card table, in bytes
408 cardTableSizeB :: DynFlags -> Int -> ByteOff
409 cardTableSizeB dflags elems = cardRoundUp dflags elems
410
411 -- | The size of a card table, in words
412 cardTableSizeW :: DynFlags -> Int -> WordOff
413 cardTableSizeW dflags elems =
414   bytesToWordsRoundUp dflags (cardTableSizeB dflags elems)
415
416 -----------------------------------------------------------------------------
417 -- deriving the RTS closure type from an SMRep
418
419 #include "../includes/rts/storage/ClosureTypes.h"
420 #include "../includes/rts/storage/FunTypes.h"
421 -- Defines CONSTR, CONSTR_1_0 etc
422
423 -- | Derives the RTS closure type from an 'SMRep'
424 rtsClosureType :: SMRep -> Int
425 rtsClosureType rep
426     = case rep of
427       RTSRep ty _ -> ty
428
429       HeapRep False 1 0 Constr{} -> CONSTR_1_0
430       HeapRep False 0 1 Constr{} -> CONSTR_0_1
431       HeapRep False 2 0 Constr{} -> CONSTR_2_0
432       HeapRep False 1 1 Constr{} -> CONSTR_1_1
433       HeapRep False 0 2 Constr{} -> CONSTR_0_2
434       HeapRep False _ _ Constr{} -> CONSTR
435
436       HeapRep False 1 0 Fun{} -> FUN_1_0
437       HeapRep False 0 1 Fun{} -> FUN_0_1
438       HeapRep False 2 0 Fun{} -> FUN_2_0
439       HeapRep False 1 1 Fun{} -> FUN_1_1
440       HeapRep False 0 2 Fun{} -> FUN_0_2
441       HeapRep False _ _ Fun{} -> FUN
442
443       HeapRep False 1 0 Thunk{} -> THUNK_1_0
444       HeapRep False 0 1 Thunk{} -> THUNK_0_1
445       HeapRep False 2 0 Thunk{} -> THUNK_2_0
446       HeapRep False 1 1 Thunk{} -> THUNK_1_1
447       HeapRep False 0 2 Thunk{} -> THUNK_0_2
448       HeapRep False _ _ Thunk{} -> THUNK
449
450       HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR
451
452       -- Approximation: we use the CONSTR_NOCAF_STATIC type for static
453       -- constructors -- that have no pointer words only.
454       HeapRep True 0 _ Constr{} -> CONSTR_NOCAF_STATIC  -- See isStaticNoCafCon below
455       HeapRep True _ _ Constr{} -> CONSTR_STATIC
456       HeapRep True _ _ Fun{}    -> FUN_STATIC
457       HeapRep True _ _ Thunk{}  -> THUNK_STATIC
458
459       HeapRep False _ _ BlackHole{} -> BLACKHOLE
460
461       HeapRep False _ _ IndStatic{} -> IND_STATIC
462
463       _ -> panic "rtsClosureType"
464
465 -- We export these ones
466 rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int
467 rET_SMALL   = RET_SMALL
468 rET_BIG     = RET_BIG
469 aRG_GEN     = ARG_GEN
470 aRG_GEN_BIG = ARG_GEN_BIG
471 \end{code}
472
473 Note [Static NoCaf constructors]
474 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
475 If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
476 reachable from 'x'), then a statically allocated constructor (Just x)
477 is also not Caffy, and the garbage collector need not follow its
478 argument fields.  Exploiting this would require two static info tables
479 for Just, for the two cases where the argument was Caffy or non-Caffy.
480
481 Currently we don't do this; instead we treat nullary constructors
482 as non-Caffy, and the others as potentially Caffy.
483
484
485 %************************************************************************
486 %*                                                                      *
487              Pretty printing of SMRep and friends
488 %*                                                                      *
489 %************************************************************************
490
491 \begin{code}
492 instance Outputable ClosureTypeInfo where
493    ppr = pprTypeInfo
494
495 instance Outputable SMRep where
496    ppr (HeapRep static ps nps tyinfo)
497      = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
498      where
499        header = ptext (sLit "HeapRep")
500                 <+> if static then ptext (sLit "static") else empty
501                 <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps
502        pp_n :: String -> Int -> SDoc
503        pp_n _ 0 = empty
504        pp_n s n = int n <+> text s
505
506    ppr (ArrayPtrsRep size _) = ptext (sLit "ArrayPtrsRep") <+> ppr size
507
508    ppr (SmallArrayPtrsRep size) = ptext (sLit "SmallArrayPtrsRep") <+> ppr size
509
510    ppr (ArrayWordsRep words) = ptext (sLit "ArrayWordsRep") <+> ppr words
511
512    ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs
513
514    ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep
515
516 instance Outputable ArgDescr where
517   ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
518   ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
519
520 pprTypeInfo :: ClosureTypeInfo -> SDoc
521 pprTypeInfo (Constr tag descr)
522   = ptext (sLit "Con") <+>
523     braces (sep [ ptext (sLit "tag:") <+> ppr tag
524                 , ptext (sLit "descr:") <> text (show descr) ])
525
526 pprTypeInfo (Fun arity args)
527   = ptext (sLit "Fun") <+>
528     braces (sep [ ptext (sLit "arity:") <+> ppr arity
529                 , ptext (sLit ("fun_type:")) <+> ppr args ])
530
531 pprTypeInfo (ThunkSelector offset)
532   = ptext (sLit "ThunkSel") <+> ppr offset
533
534 pprTypeInfo Thunk     = ptext (sLit "Thunk")
535 pprTypeInfo BlackHole = ptext (sLit "BlackHole")
536 pprTypeInfo IndStatic = ptext (sLit "IndStatic")
537
538 -- XXX Does not belong here!!
539 stringToWord8s :: String -> [Word8]
540 stringToWord8s s = map (fromIntegral . ord) s
541
542 pprWord8String :: [Word8] -> SDoc
543 -- Debug printing.  Not very clever right now.
544 pprWord8String ws = text (show ws)
545 \end{code}