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