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