Make StgWord a portable type too
[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 newtype StgWord = StgWord Word64
80     deriving (Eq,
81 #if __GLASGOW_HASKELL__ < 706
82               Num,
83 #endif
84               Bits, IArray UArray)
85
86 fromStgWord :: StgWord -> Integer
87 fromStgWord (StgWord i) = toInteger i
88
89 toStgWord :: DynFlags -> Integer -> StgWord
90 toStgWord dflags i
91     = case platformWordSize (targetPlatform dflags) of
92       -- These conversions mean that things like toStgWord (-1)
93       -- do the right thing
94       4 -> StgWord (fromIntegral (fromInteger i :: Word32))
95       8 -> StgWord (fromInteger i :: Word64)
96       w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w)
97
98 instance Outputable StgWord where
99     ppr (StgWord i) = integer (toInteger i)
100
101 --
102
103 newtype StgHalfWord = StgHalfWord Integer
104     deriving Eq
105
106 fromStgHalfWord :: StgHalfWord -> Integer
107 fromStgHalfWord (StgHalfWord i) = i
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 (toInteger (fromInteger i :: Word16))
115       8 -> StgHalfWord (toInteger (fromInteger i :: Word32))
116       w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)
117
118 instance Outputable StgHalfWord where
119     ppr (StgHalfWord i) = integer i
120
121 #if SIZEOF_HSWORD == 4
122 hALF_WORD_SIZE :: ByteOff
123 hALF_WORD_SIZE = 2
124 hALF_WORD_SIZE_IN_BITS :: Int
125 hALF_WORD_SIZE_IN_BITS = 16
126 #elif SIZEOF_HSWORD == 8
127 hALF_WORD_SIZE :: ByteOff
128 hALF_WORD_SIZE = 4
129 hALF_WORD_SIZE_IN_BITS :: Int
130 hALF_WORD_SIZE_IN_BITS = 32
131 #else
132 #error unknown SIZEOF_HSWORD
133 #endif
134 \end{code}
135
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         StgHalfWord     -- 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
175 type ConstrTag         = StgHalfWord
176 type ConstrDescription = [Word8] -- result of dataConIdentity
177 type FunArity          = StgHalfWord
178 type SelectorOffset    = StgWord
179
180 -------------------------
181 -- We represent liveness bitmaps as a Bitmap (whose internal
182 -- representation really is a bitmap).  These are pinned onto case return
183 -- vectors to indicate the state of the stack for the garbage collector.
184 --
185 -- In the compiled program, liveness bitmaps that fit inside a single
186 -- word (StgWord) are stored as a single word, while larger bitmaps are
187 -- stored as a pointer to an array of words.
188
189 type Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead
190                          --                    False <=> ptr
191
192 -------------------------
193 -- An ArgDescr describes the argument pattern of a function
194
195 data ArgDescr
196   = ArgSpec             -- Fits one of the standard patterns
197         !StgHalfWord    -- RTS type identifier ARG_P, ARG_N, ...
198
199   | ArgGen              -- General case
200         Liveness        -- Details about the arguments
201
202
203 -----------------------------------------------------------------------------
204 -- Construction
205
206 mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
207           -> SMRep
208 mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
209   = HeapRep is_static
210             ptr_wds
211             (nonptr_wds + slop_wds)
212             cl_type_info
213   where
214      slop_wds
215       | is_static = 0
216       | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
217
218      hdr_size     = closureTypeHdrSize dflags cl_type_info
219      payload_size = ptr_wds + nonptr_wds
220
221 mkRTSRep :: StgHalfWord -> SMRep -> SMRep
222 mkRTSRep = RTSRep
223
224 mkStackRep :: [Bool] -> SMRep
225 mkStackRep liveness = StackRep liveness
226
227 blackHoleRep :: SMRep
228 blackHoleRep = HeapRep False 0 0 BlackHole
229
230 -----------------------------------------------------------------------------
231 -- Predicates
232
233 isStaticRep :: SMRep -> IsStatic
234 isStaticRep (HeapRep is_static _ _ _) = is_static
235 isStaticRep (StackRep {})             = False
236 isStaticRep (RTSRep _ rep)            = isStaticRep rep
237
238 isConRep :: SMRep -> Bool
239 isConRep (HeapRep _ _ _ Constr{}) = True
240 isConRep _                        = False
241
242 isThunkRep :: SMRep -> Bool
243 isThunkRep (HeapRep _ _ _ Thunk{})         = True
244 isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
245 isThunkRep (HeapRep _ _ _ BlackHole{})     = 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  | dopt 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                   _               -> fixedHdrSize dflags
309         -- All thunks use thunkHdrSize, even if they are non-updatable.
310         -- this is because we don't have separate closure types for
311         -- updatable vs. non-updatable thunks, so the GC can't tell the
312         -- difference.  If we ever have significant numbers of non-
313         -- updatable thunks, it might be worth fixing this.
314
315 -----------------------------------------------------------------------------
316 -- deriving the RTS closure type from an SMRep
317
318 #include "../includes/rts/storage/ClosureTypes.h"
319 #include "../includes/rts/storage/FunTypes.h"
320 -- Defines CONSTR, CONSTR_1_0 etc
321
322 -- | Derives the RTS closure type from an 'SMRep'
323 rtsClosureType :: DynFlags -> SMRep -> StgHalfWord
324 rtsClosureType dflags rep
325     = toStgHalfWord dflags
326     $ case rep of
327       RTSRep ty _ -> fromStgHalfWord 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       _ -> panic "rtsClosureType"
362
363 -- We export these ones
364 rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: DynFlags -> StgHalfWord
365 rET_SMALL   dflags = toStgHalfWord dflags RET_SMALL
366 rET_BIG     dflags = toStgHalfWord dflags RET_BIG
367 aRG_GEN     dflags = toStgHalfWord dflags ARG_GEN
368 aRG_GEN_BIG dflags = toStgHalfWord dflags ARG_GEN_BIG
369 \end{code}
370
371 Note [Static NoCaf constructors]
372 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
373 If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
374 reachable from 'x'), then a statically allocated constructor (Just x)
375 is also not Caffy, and the garbage collector need not follow its
376 argument fields.  Exploiting this would require two static info tables
377 for Just, for the two cases where the argument was Caffy or non-Caffy.
378
379 Currently we don't do this; instead we treat nullary constructors
380 as non-Caffy, and the others as potentially Caffy.
381
382
383 %************************************************************************
384 %*                                                                      *
385              Pretty printing of SMRep and friends
386 %*                                                                      *
387 %************************************************************************
388
389 \begin{code}
390 instance Outputable ClosureTypeInfo where
391    ppr = pprTypeInfo
392
393 instance Outputable SMRep where
394    ppr (HeapRep static ps nps tyinfo)
395      = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
396      where
397        header = ptext (sLit "HeapRep")
398                 <+> if static then ptext (sLit "static") else empty
399                 <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps
400        pp_n :: String -> Int -> SDoc
401        pp_n _ 0 = empty
402        pp_n s n = int n <+> text s
403
404    ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs
405
406    ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep
407
408 instance Outputable ArgDescr where
409   ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
410   ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
411
412 pprTypeInfo :: ClosureTypeInfo -> SDoc
413 pprTypeInfo (Constr tag descr)
414   = ptext (sLit "Con") <+>
415     braces (sep [ ptext (sLit "tag:") <+> ppr tag
416                 , ptext (sLit "descr:") <> text (show descr) ])
417
418 pprTypeInfo (Fun arity args)
419   = ptext (sLit "Fun") <+>
420     braces (sep [ ptext (sLit "arity:") <+> ppr arity
421                 , ptext (sLit ("fun_type:")) <+> ppr args ])
422
423 pprTypeInfo (ThunkSelector offset)
424   = ptext (sLit "ThunkSel") <+> ppr offset
425
426 pprTypeInfo Thunk     = ptext (sLit "Thunk")
427 pprTypeInfo BlackHole = ptext (sLit "BlackHole")
428
429 -- XXX Does not belong here!!
430 stringToWord8s :: String -> [Word8]
431 stringToWord8s s = map (fromIntegral . ord) s
432
433 pprWord8String :: [Word8] -> SDoc
434 -- Debug printing.  Not very clever right now.
435 pprWord8String ws = text (show ws)
436 \end{code}