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