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