1 -----------------------------------------------------------------------------
3 -- Building info tables.
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
10 emitClosureCodeAndInfoTable,
13 emitReturnTarget, emitAlgReturnTarget,
16 entryCode, closureInfoPtr,
19 infoTable, infoTableClosureType,
20 infoTablePtrs, infoTableNonPtrs,
21 funInfoTable, makeRelativeRefTo
25 #include "HsVersions.h"
50 -------------------------------------------------------------------------
52 -- Generating the info table and code for a closure
54 -------------------------------------------------------------------------
56 -- Here we make an info table of type 'CmmInfo'. The concrete
57 -- representation as a list of 'CmmAddr' is handled later
58 -- in the pipeline by 'cmmToRawCmm'.
60 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
61 emitClosureCodeAndInfoTable cl_info args body
62 = do { blks <- cgStmtsToBlocks body
63 ; info <- mkCmmInfo cl_info
64 ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
66 info_lbl = infoTableLabelFromCI cl_info
68 -- We keep the *zero-indexed* tag in the srt_len field of the info
69 -- table of a data constructor.
70 dataConTagZ :: DataCon -> ConTagZ
71 dataConTagZ con = dataConTag con - fIRST_TAG
73 -- Convert from 'ClosureInfo' to 'CmmInfo'.
74 -- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
75 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
76 mkCmmInfo cl_info = do
79 then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info)
80 cl_descr_lit <- mkStringCLit (closureValDescr cl_info)
81 return $ ProfilingInfo ty_descr_lit cl_descr_lit
82 else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
85 ConInfo { closureCon = con } -> do
86 cstr <- mkByteStringCLit $ dataConIdentity con
87 let conName = makeRelativeRefTo info_lbl cstr
88 info = ConstrInfo (ptrs, nptrs)
89 (fromIntegral (dataConTagZ con))
91 return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
93 ClosureInfo { closureName = name,
94 closureLFInfo = lf_info,
96 return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
100 LFReEntrant _ arity _ arg_descr ->
101 FunInfo (ptrs, nptrs)
103 (argDescrType arg_descr)
106 (CmmLabel (mkSlowEntryLabel name))
107 LFThunk _ _ _ (SelectorThunk offset) _ ->
108 ThunkSelectorInfo (fromIntegral offset) srt
110 ThunkInfo (ptrs, nptrs) srt
111 _ -> panic "unexpected lambda form in mkCmmInfo"
113 info_lbl = infoTableLabelFromCI cl_info
115 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
117 ptrs = fromIntegral $ closurePtrsSize cl_info
118 size = fromIntegral $ closureNonHdrSize cl_info
121 -- The gc_target is to inform the CPS pass when it inserts a stack check.
122 -- Since that pass isn't used yet we'll punt for now.
123 -- When the CPS pass is fully integrated, this should
124 -- be replaced by the label that any heap check jumped to,
125 -- so that branch can be shared by both the heap (from codeGen)
126 -- and stack checks (from the CPS pass).
127 gc_target = panic "TODO: gc_target"
129 -------------------------------------------------------------------------
131 -- Generating the info table and code for a return point
133 -------------------------------------------------------------------------
135 -- The concrete representation as a list of 'CmmAddr' is handled later
136 -- in the pipeline by 'cmmToRawCmm'.
140 -> CgStmts -- The direct-return code (if any)
142 emitReturnTarget name stmts
143 = do { srt_info <- getSRTInfo
144 ; blks <- cgStmtsToBlocks stmts
145 ; frame <- mkStackLayout
150 (ProfilingInfo zeroCLit zeroCLit)
151 rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
152 (ContInfo frame srt_info))
153 ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
156 args = {- trace "emitReturnTarget: missing args" -} []
157 uniq = getUnique name
158 info_lbl = mkReturnInfoLabel uniq
160 -- The gc_target is to inform the CPS pass when it inserts a stack check.
161 -- Since that pass isn't used yet we'll punt for now.
162 -- When the CPS pass is fully integrated, this should
163 -- be replaced by the label that any heap check jumped to,
164 -- so that branch can be shared by both the heap (from codeGen)
165 -- and stack checks (from the CPS pass).
166 gc_target = panic "TODO: gc_target"
169 -- Build stack layout information from the state of the 'FCode' monad.
170 -- Should go away once 'codeGen' starts using the CPS conversion
171 -- pass to handle the stack. Until then, this is really just
172 -- here to convert from the 'codeGen' representation of the stack
173 -- to the 'CmmInfo' representation of the stack.
175 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
178 This seems to be a very error prone part of the code.
179 It is surprisingly prone to off-by-one errors, because
180 it converts between offset form (codeGen) and list form (CmmInfo).
181 Thus a bit of explanation is in order.
182 Fortunately, this code should go away once the code generator
183 starts using the CPS conversion pass to handle the stack.
185 The stack looks like this:
189 frame_sp --> | return addr |
197 real_sp --> | return addr |
200 Both 'frame_sp' and 'real_sp' are measured downwards
201 (i.e. larger frame_sp means smaller memory address).
203 For that frame we want a result like: [Just a, Just b, Nothing]
204 Note that the 'head' of the list is the top
205 of the stack, and that the return address
206 is not present in the list (it is always assumed).
208 mkStackLayout :: FCode [Maybe LocalReg]
210 StackUsage { realSp = real_sp,
211 frameSp = frame_sp } <- getStkUsage
212 binds <- getLiveStackBindings
213 let frame_size = real_sp - frame_sp - retAddrSizeW
214 rel_binds = reverse $ sortWith fst
215 [(offset - frame_sp - retAddrSizeW, b)
216 | (offset, b) <- binds]
218 WARN( not (all (\bind -> fst bind >= 0) rel_binds),
219 ppr binds $$ ppr rel_binds $$
220 ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
221 return $ stack_layout rel_binds frame_size
223 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
226 stack_layout [] sizeW = replicate sizeW Nothing
227 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
228 (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
230 rep_size = cgRepSizeW (cgIdInfoArgRep bind)
231 stack_bind = LocalReg unique machRep kind
232 unique = getUnique (cgIdInfoId bind)
233 machRep = argMachRep (cgIdInfoArgRep bind)
234 kind = if isFollowableArg (cgIdInfoArgRep bind)
237 stack_layout binds@((off, _):_) sizeW | otherwise =
238 Nothing : (stack_layout binds (sizeW - 1))
240 {- Another way to write the function that might be less error prone (untested)
241 stack_layout offsets sizeW = result
243 y = map (flip lookup offsets) [0..]
244 -- offsets -> nothing and just (each slot is one word)
245 x = take sizeW y -- set the frame size
246 z = clip x -- account for multi-word slots
247 result = map mk_reg z
250 clip list@(x : _) = x : clip (drop count list)
251 ASSERT(all isNothing (tail (take count list)))
254 count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
256 mk_reg Nothing = Nothing
257 mk_reg (Just x) = LocalReg unique machRep kind
259 unique = getUnique (cgIdInfoId x)
260 machRep = argMachrep (cgIdInfoArgRep bind)
261 kind = if isFollowableArg (cgIdInfoArgRep bind)
267 :: Name -- Just for its unique
268 -> [(ConTagZ, CgStmts)] -- Tagged branches
269 -> Maybe CgStmts -- Default branch (if any)
270 -> Int -- family size
271 -> FCode (CLabel, SemiTaggingStuff)
273 emitAlgReturnTarget name branches mb_deflt fam_sz
274 = do { blks <- getCgStmts $
275 -- is the constructor tag in the node reg?
276 if isSmallFamily fam_sz
277 then do -- yes, node has constr. tag
278 let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
279 branches' = [(tag+1,branch)|(tag,branch)<-branches]
280 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
281 else do -- no, get tag from info table
282 let -- Note that ptr _always_ has tag 1
283 -- when the family size is big enough
284 untagged_ptr = cmmRegOffB nodeReg (-1)
285 tag_expr = getConstrTag (untagged_ptr)
286 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
287 ; lbl <- emitReturnTarget name blks
288 ; return (lbl, Nothing) }
289 -- Nothing: the internal branches in the switch don't have
290 -- global labels, so we can't use them at the 'call site'
292 uniq = getUnique name
294 --------------------------------
295 emitReturnInstr :: Code
297 = do { info_amode <- getSequelAmode
298 ; stmtC (CmmJump (entryCode info_amode) []) }
300 -----------------------------------------------------------------------------
302 -- Info table offsets
304 -----------------------------------------------------------------------------
306 stdInfoTableSizeW :: WordOff
307 -- The size of a standard info table varies with profiling/ticky etc,
308 -- so we can't get it from Constants
309 -- It must vary in sync with mkStdInfoTable
311 = size_fixed + size_prof
313 size_fixed = 2 -- layout, type
314 size_prof | opt_SccProfilingOn = 2
317 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
319 stdSrtBitmapOffset :: ByteOff
320 -- Byte offset of the SRT bitmap half-word which is
321 -- in the *higher-addressed* part of the type_lit
322 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
324 stdClosureTypeOffset :: ByteOff
325 -- Byte offset of the closure type half-word
326 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
328 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
329 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
330 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
332 -------------------------------------------------------------------------
334 -- Accessing fields of an info table
336 -------------------------------------------------------------------------
338 closureInfoPtr :: CmmExpr -> CmmExpr
339 -- Takes a closure pointer and returns the info table pointer
340 closureInfoPtr e = CmmLoad e wordRep
342 entryCode :: CmmExpr -> CmmExpr
343 -- Takes an info pointer (the first word of a closure)
344 -- and returns its entry code
345 entryCode e | tablesNextToCode = e
346 | otherwise = CmmLoad e wordRep
348 getConstrTag :: CmmExpr -> CmmExpr
349 -- Takes a closure pointer, and return the *zero-indexed*
350 -- constructor tag obtained from the info table
351 -- This lives in the SRT field of the info table
352 -- (constructors don't need SRTs).
353 getConstrTag closure_ptr
354 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
356 info_table = infoTable (closureInfoPtr closure_ptr)
358 cmmGetClosureType :: CmmExpr -> CmmExpr
359 -- Takes a closure pointer, and return the closure type
360 -- obtained from the info table
361 cmmGetClosureType closure_ptr
362 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableClosureType info_table]
364 info_table = infoTable (closureInfoPtr closure_ptr)
366 infoTable :: CmmExpr -> CmmExpr
367 -- Takes an info pointer (the first word of a closure)
368 -- and returns a pointer to the first word of the standard-form
369 -- info table, excluding the entry-code word (if present)
371 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
372 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
374 infoTableConstrTag :: CmmExpr -> CmmExpr
375 -- Takes an info table pointer (from infoTable) and returns the constr tag
376 -- field of the info table (same as the srt_bitmap field)
377 infoTableConstrTag = infoTableSrtBitmap
379 infoTableSrtBitmap :: CmmExpr -> CmmExpr
380 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
381 -- field of the info table
382 infoTableSrtBitmap info_tbl
383 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
385 infoTableClosureType :: CmmExpr -> CmmExpr
386 -- Takes an info table pointer (from infoTable) and returns the closure type
387 -- field of the info table.
388 infoTableClosureType info_tbl
389 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
391 infoTablePtrs :: CmmExpr -> CmmExpr
392 infoTablePtrs info_tbl
393 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
395 infoTableNonPtrs :: CmmExpr -> CmmExpr
396 infoTableNonPtrs info_tbl
397 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
399 funInfoTable :: CmmExpr -> CmmExpr
400 -- Takes the info pointer of a function,
401 -- and returns a pointer to the first word of the StgFunInfoExtra struct
402 -- in the info table.
403 funInfoTable info_ptr
405 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
407 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
408 -- Past the entry code pointer
410 -------------------------------------------------------------------------
412 -- Emit the code for a closure (or return address)
413 -- and its associated info table
415 -------------------------------------------------------------------------
417 -- The complication here concerns whether or not we can
418 -- put the info table next to the code
421 :: CLabel -- Label of entry or ret
422 -> CmmInfo -- ...the info table
423 -> CmmFormals -- ...args
424 -> [CmmBasicBlock] -- ...and body
427 emitInfoTableAndCode entry_ret_lbl info args blocks
428 = emitProc info entry_ret_lbl args blocks
430 -------------------------------------------------------------------------
432 -- Static reference tables
434 -------------------------------------------------------------------------
436 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
437 srtLabelAndLength NoC_SRT _
439 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
440 = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
442 -------------------------------------------------------------------------
444 -- Position independent code
446 -------------------------------------------------------------------------
447 -- In order to support position independent code, we mustn't put absolute
448 -- references into read-only space. Info tables in the tablesNextToCode
449 -- case must be in .text, which is read-only, so we doctor the CmmLits
450 -- to use relative offsets instead.
452 -- Note that this is done even when the -fPIC flag is not specified,
453 -- as we want to keep binary compatibility between PIC and non-PIC.
455 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
457 makeRelativeRefTo info_lbl (CmmLabel lbl)
459 = CmmLabelDiffOff lbl info_lbl 0
460 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
462 = CmmLabelDiffOff lbl info_lbl off
463 makeRelativeRefTo _ lit = lit