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