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