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