Add a class HasDynFlags(getDynFlags)
[ghc.git] / compiler / codeGen / CgInfoTbls.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Building info tables.
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 {-# OPTIONS -fno-warn-tabs #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and
12 -- detab the module (please do the detabbing in a separate patch). See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
14 -- for details
15
16 module CgInfoTbls (
17 emitClosureCodeAndInfoTable,
18 emitInfoTableAndCode,
19 emitReturnTarget, emitAlgReturnTarget,
20 emitReturnInstr,
21 stdInfoTableSizeB,
22 entryCode, closureInfoPtr,
23 getConstrTag,
24 cmmGetClosureType,
25 infoTable, infoTableClosureType,
26 infoTablePtrs, infoTableNonPtrs,
27 funInfoTable
28 ) where
29
30
31 #include "HsVersions.h"
32
33 import ClosureInfo
34 import SMRep
35 import CgBindery
36 import CgCallConv
37 import CgUtils
38 import CgMonad
39 import CmmBuildInfoTables
40
41 import OldCmm
42 import CLabel
43 import Name
44 import Unique
45 import StaticFlags
46
47 import Constants
48 import DynFlags
49 import Util
50 import Outputable
51
52 -------------------------------------------------------------------------
53 --
54 -- Generating the info table and code for a closure
55 --
56 -------------------------------------------------------------------------
57
58 -- Here we make an info table of type 'CmmInfo'. The concrete
59 -- representation as a list of 'CmmAddr' is handled later
60 -- in the pipeline by 'cmmToRawCmm'.
61
62 emitClosureCodeAndInfoTable :: ClosureInfo -> [CmmFormal] -> CgStmts -> Code
63 emitClosureCodeAndInfoTable cl_info args body
64 = do { blks <- cgStmtsToBlocks body
65 ; info <- mkCmmInfo cl_info
66 ; emitInfoTableAndCode (entryLabelFromCI cl_info) info args blks }
67
68 -- Convert from 'ClosureInfo' to 'CmmInfo'.
69 -- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
70 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
71 mkCmmInfo cl_info
72 = return (CmmInfo gc_target Nothing $
73 CmmInfoTable { cit_lbl = infoTableLabelFromCI cl_info,
74 cit_rep = closureSMRep cl_info,
75 cit_prof = prof,
76 cit_srt = closureSRT cl_info })
77 where
78 prof | not opt_SccProfilingOn = NoProfilingInfo
79 | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
80 ty_descr_w8 = stringToWord8s (closureTypeDescr cl_info)
81 val_descr_w8 = stringToWord8s (closureValDescr cl_info)
82
83 -- The gc_target is to inform the CPS pass when it inserts a stack check.
84 -- Since that pass isn't used yet we'll punt for now.
85 -- When the CPS pass is fully integrated, this should
86 -- be replaced by the label that any heap check jumped to,
87 -- so that branch can be shared by both the heap (from codeGen)
88 -- and stack checks (from the CPS pass).
89 gc_target = panic "TODO: gc_target"
90
91 -------------------------------------------------------------------------
92 --
93 -- Generating the info table and code for a return point
94 --
95 -------------------------------------------------------------------------
96
97 -- The concrete representation as a list of 'CmmAddr' is handled later
98 -- in the pipeline by 'cmmToRawCmm'.
99
100 emitReturnTarget
101 :: Name
102 -> CgStmts -- The direct-return code (if any)
103 -> FCode CLabel
104 emitReturnTarget name stmts
105 = do { srt_info <- getSRTInfo
106 ; blks <- cgStmtsToBlocks stmts
107 ; frame <- mkStackLayout
108 ; let smrep = mkStackRep (mkLiveness frame)
109 info = CmmInfo gc_target Nothing info_tbl
110 info_tbl = CmmInfoTable { cit_lbl = info_lbl
111 , cit_prof = NoProfilingInfo
112 , cit_rep = smrep
113 , cit_srt = srt_info }
114 ; emitInfoTableAndCode entry_lbl info args blks
115 ; return info_lbl }
116 where
117 args = {- trace "emitReturnTarget: missing args" -} []
118 uniq = getUnique name
119 info_lbl = mkReturnInfoLabel uniq
120 entry_lbl = mkReturnPtLabel uniq
121
122 -- The gc_target is to inform the CPS pass when it inserts a stack check.
123 -- Since that pass isn't used yet we'll punt for now.
124 -- When the CPS pass is fully integrated, this should
125 -- be replaced by the label that any heap check jumped to,
126 -- so that branch can be shared by both the heap (from codeGen)
127 -- and stack checks (from the CPS pass).
128 gc_target = panic "TODO: gc_target"
129
130 -- Build stack layout information from the state of the 'FCode' monad.
131 -- Should go away once 'codeGen' starts using the CPS conversion
132 -- pass to handle the stack. Until then, this is really just
133 -- here to convert from the 'codeGen' representation of the stack
134 -- to the 'CmmInfo' representation of the stack.
135 --
136 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
137
138 {-
139 This seems to be a very error prone part of the code.
140 It is surprisingly prone to off-by-one errors, because
141 it converts between offset form (codeGen) and list form (CmmInfo).
142 Thus a bit of explanation is in order.
143 Fortunately, this code should go away once the code generator
144 starts using the CPS conversion pass to handle the stack.
145
146 The stack looks like this:
147
148 | |
149 |-------------|
150 frame_sp --> | return addr |
151 |-------------|
152 | dead slot |
153 |-------------|
154 | live ptr b |
155 |-------------|
156 | live ptr a |
157 |-------------|
158 real_sp --> | return addr |
159 +-------------+
160
161 Both 'frame_sp' and 'real_sp' are measured downwards
162 (i.e. larger frame_sp means smaller memory address).
163
164 For that frame we want a result like: [Just a, Just b, Nothing]
165 Note that the 'head' of the list is the top
166 of the stack, and that the return address
167 is not present in the list (it is always assumed).
168 -}
169 mkStackLayout :: FCode [Maybe LocalReg]
170 mkStackLayout = do
171 dflags <- getDynFlags
172 let platform = targetPlatform dflags
173 StackUsage { realSp = real_sp,
174 frameSp = frame_sp } <- getStkUsage
175 binds <- getLiveStackBindings
176 let frame_size = real_sp - frame_sp - retAddrSizeW
177 rel_binds = reverse $ sortWith fst
178 [(offset - frame_sp - retAddrSizeW, b)
179 | (offset, b) <- binds]
180
181 WARN( not (all (\bind -> fst bind >= 0) rel_binds),
182 pprPlatform platform binds $$ pprPlatform platform rel_binds $$
183 ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
184 return $ stack_layout rel_binds frame_size
185
186 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
187 -> WordOff
188 -> [Maybe LocalReg]
189 stack_layout [] sizeW = replicate sizeW Nothing
190 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
191 (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
192 where
193 rep_size = cgRepSizeW (cgIdInfoArgRep bind)
194 stack_bind = LocalReg unique machRep
195 unique = getUnique (cgIdInfoId bind)
196 machRep = argMachRep (cgIdInfoArgRep bind)
197 stack_layout binds@(_:_) sizeW | otherwise =
198 Nothing : (stack_layout binds (sizeW - 1))
199
200 {- Another way to write the function that might be less error prone (untested)
201 stack_layout offsets sizeW = result
202 where
203 y = map (flip lookup offsets) [0..]
204 -- offsets -> nothing and just (each slot is one word)
205 x = take sizeW y -- set the frame size
206 z = clip x -- account for multi-word slots
207 result = map mk_reg z
208
209 clip [] = []
210 clip list@(x : _) = x : clip (drop count list)
211 ASSERT(all isNothing (tail (take count list)))
212
213 count Nothing = 1
214 count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
215
216 mk_reg Nothing = Nothing
217 mk_reg (Just x) = LocalReg unique machRep kind
218 where
219 unique = getUnique (cgIdInfoId x)
220 machRep = argMachrep (cgIdInfoArgRep bind)
221 kind = if isFollowableArg (cgIdInfoArgRep bind)
222 then GCKindPtr
223 else GCKindNonPtr
224 -}
225
226 emitAlgReturnTarget
227 :: Name -- Just for its unique
228 -> [(ConTagZ, CgStmts)] -- Tagged branches
229 -> Maybe CgStmts -- Default branch (if any)
230 -> Int -- family size
231 -> FCode (CLabel, SemiTaggingStuff)
232
233 emitAlgReturnTarget name branches mb_deflt fam_sz
234 = do { blks <- getCgStmts $
235 -- is the constructor tag in the node reg?
236 if isSmallFamily fam_sz
237 then do -- yes, node has constr. tag
238 let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
239 branches' = [(tag+1,branch)|(tag,branch)<-branches]
240 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
241 else do -- no, get tag from info table
242 let -- Note that ptr _always_ has tag 1
243 -- when the family size is big enough
244 untagged_ptr = cmmRegOffB nodeReg (-1)
245 tag_expr = getConstrTag (untagged_ptr)
246 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
247 ; lbl <- emitReturnTarget name blks
248 ; return (lbl, Nothing) }
249 -- Nothing: the internal branches in the switch don't have
250 -- global labels, so we can't use them at the 'call site'
251
252 --------------------------------
253 emitReturnInstr :: Code
254 emitReturnInstr
255 = do { info_amode <- getSequelAmode
256 ; stmtC (CmmJump (entryCode info_amode) []) }
257
258 -----------------------------------------------------------------------------
259 --
260 -- Info table offsets
261 --
262 -----------------------------------------------------------------------------
263
264 stdInfoTableSizeW :: WordOff
265 -- The size of a standard info table varies with profiling/ticky etc,
266 -- so we can't get it from Constants
267 -- It must vary in sync with mkStdInfoTable
268 stdInfoTableSizeW
269 = size_fixed + size_prof
270 where
271 size_fixed = 2 -- layout, type
272 size_prof | opt_SccProfilingOn = 2
273 | otherwise = 0
274
275 stdInfoTableSizeB :: ByteOff
276 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE
277
278 stdSrtBitmapOffset :: ByteOff
279 -- Byte offset of the SRT bitmap half-word which is
280 -- in the *higher-addressed* part of the type_lit
281 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
282
283 stdClosureTypeOffset :: ByteOff
284 -- Byte offset of the closure type half-word
285 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
286
287 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
288 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
289 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
290
291 -------------------------------------------------------------------------
292 --
293 -- Accessing fields of an info table
294 --
295 -------------------------------------------------------------------------
296
297 closureInfoPtr :: CmmExpr -> CmmExpr
298 -- Takes a closure pointer and returns the info table pointer
299 closureInfoPtr e = CmmLoad e bWord
300
301 entryCode :: CmmExpr -> CmmExpr
302 -- Takes an info pointer (the first word of a closure)
303 -- and returns its entry code
304 entryCode e | tablesNextToCode = e
305 | otherwise = CmmLoad e bWord
306
307 getConstrTag :: CmmExpr -> CmmExpr
308 -- Takes a closure pointer, and return the *zero-indexed*
309 -- constructor tag obtained from the info table
310 -- This lives in the SRT field of the info table
311 -- (constructors don't need SRTs).
312 getConstrTag closure_ptr
313 = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag info_table]
314 where
315 info_table = infoTable (closureInfoPtr closure_ptr)
316
317 cmmGetClosureType :: CmmExpr -> CmmExpr
318 -- Takes a closure pointer, and return the closure type
319 -- obtained from the info table
320 cmmGetClosureType closure_ptr
321 = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType info_table]
322 where
323 info_table = infoTable (closureInfoPtr closure_ptr)
324
325 infoTable :: CmmExpr -> CmmExpr
326 -- Takes an info pointer (the first word of a closure)
327 -- and returns a pointer to the first word of the standard-form
328 -- info table, excluding the entry-code word (if present)
329 infoTable info_ptr
330 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
331 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
332
333 infoTableConstrTag :: CmmExpr -> CmmExpr
334 -- Takes an info table pointer (from infoTable) and returns the constr tag
335 -- field of the info table (same as the srt_bitmap field)
336 infoTableConstrTag = infoTableSrtBitmap
337
338 infoTableSrtBitmap :: CmmExpr -> CmmExpr
339 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
340 -- field of the info table
341 infoTableSrtBitmap info_tbl
342 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) bHalfWord
343
344 infoTableClosureType :: CmmExpr -> CmmExpr
345 -- Takes an info table pointer (from infoTable) and returns the closure type
346 -- field of the info table.
347 infoTableClosureType info_tbl
348 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) bHalfWord
349
350 infoTablePtrs :: CmmExpr -> CmmExpr
351 infoTablePtrs info_tbl
352 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) bHalfWord
353
354 infoTableNonPtrs :: CmmExpr -> CmmExpr
355 infoTableNonPtrs info_tbl
356 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) bHalfWord
357
358 funInfoTable :: CmmExpr -> CmmExpr
359 -- Takes the info pointer of a function,
360 -- and returns a pointer to the first word of the StgFunInfoExtra struct
361 -- in the info table.
362 funInfoTable info_ptr
363 | tablesNextToCode
364 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
365 | otherwise
366 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
367 -- Past the entry code pointer
368
369 -------------------------------------------------------------------------
370 --
371 -- Emit the code for a closure (or return address)
372 -- and its associated info table
373 --
374 -------------------------------------------------------------------------
375
376 -- The complication here concerns whether or not we can
377 -- put the info table next to the code
378
379 emitInfoTableAndCode
380 :: CLabel -- Label of entry or ret
381 -> CmmInfo -- ...the info table
382 -> [CmmFormal] -- ...args
383 -> [CmmBasicBlock] -- ...and body
384 -> Code
385
386 emitInfoTableAndCode entry_ret_lbl info args blocks
387 = emitProc info entry_ret_lbl args blocks
388