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