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