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