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
82 (makeRelativeRefTo info_lbl ty_descr_lit)
83 (makeRelativeRefTo info_lbl cl_descr_lit)
84 else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
87 ConInfo { closureCon = con } -> do
88 cstr <- mkByteStringCLit $ dataConIdentity con
89 let conName = makeRelativeRefTo info_lbl cstr
90 info = ConstrInfo (ptrs, nptrs)
91 (fromIntegral (dataConTagZ con))
93 return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
95 ClosureInfo { closureName = name,
96 closureLFInfo = lf_info,
98 return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
102 LFReEntrant _ arity _ arg_descr ->
103 FunInfo (ptrs, nptrs)
105 (argDescrType arg_descr)
108 (CmmLabel (mkSlowEntryLabel name))
109 LFThunk _ _ _ (SelectorThunk offset) _ ->
110 ThunkSelectorInfo (fromIntegral offset) srt
112 ThunkInfo (ptrs, nptrs) srt
113 _ -> panic "unexpected lambda form in mkCmmInfo"
115 info_lbl = infoTableLabelFromCI cl_info
117 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
119 ptrs = fromIntegral $ closurePtrsSize cl_info
120 size = fromIntegral $ closureNonHdrSize cl_info
123 -- The gc_target is to inform the CPS pass when it inserts a stack check.
124 -- Since that pass isn't used yet we'll punt for now.
125 -- When the CPS pass is fully integrated, this should
126 -- be replaced by the label that any heap check jumped to,
127 -- so that branch can be shared by both the heap (from codeGen)
128 -- and stack checks (from the CPS pass).
129 gc_target = panic "TODO: gc_target"
131 -------------------------------------------------------------------------
133 -- Generating the info table and code for a return point
135 -------------------------------------------------------------------------
137 -- The concrete representation as a list of 'CmmAddr' is handled later
138 -- in the pipeline by 'cmmToRawCmm'.
142 -> CgStmts -- The direct-return code (if any)
144 emitReturnTarget name stmts
145 = do { srt_info <- getSRTInfo
146 ; blks <- cgStmtsToBlocks stmts
147 ; frame <- mkStackLayout
152 (ProfilingInfo zeroCLit zeroCLit)
153 rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
154 (ContInfo frame srt_info))
155 ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
158 args = {- trace "emitReturnTarget: missing args" -} []
159 uniq = getUnique name
160 info_lbl = mkReturnInfoLabel uniq
162 -- The gc_target is to inform the CPS pass when it inserts a stack check.
163 -- Since that pass isn't used yet we'll punt for now.
164 -- When the CPS pass is fully integrated, this should
165 -- be replaced by the label that any heap check jumped to,
166 -- so that branch can be shared by both the heap (from codeGen)
167 -- and stack checks (from the CPS pass).
168 gc_target = panic "TODO: gc_target"
171 -- Build stack layout information from the state of the 'FCode' monad.
172 -- Should go away once 'codeGen' starts using the CPS conversion
173 -- pass to handle the stack. Until then, this is really just
174 -- here to convert from the 'codeGen' representation of the stack
175 -- to the 'CmmInfo' representation of the stack.
177 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
180 This seems to be a very error prone part of the code.
181 It is surprisingly prone to off-by-one errors, because
182 it converts between offset form (codeGen) and list form (CmmInfo).
183 Thus a bit of explanation is in order.
184 Fortunately, this code should go away once the code generator
185 starts using the CPS conversion pass to handle the stack.
187 The stack looks like this:
191 frame_sp --> | return addr |
199 real_sp --> | return addr |
202 Both 'frame_sp' and 'real_sp' are measured downwards
203 (i.e. larger frame_sp means smaller memory address).
205 For that frame we want a result like: [Just a, Just b, Nothing]
206 Note that the 'head' of the list is the top
207 of the stack, and that the return address
208 is not present in the list (it is always assumed).
210 mkStackLayout :: FCode [Maybe LocalReg]
212 StackUsage { realSp = real_sp,
213 frameSp = frame_sp } <- getStkUsage
214 binds <- getLiveStackBindings
215 let frame_size = real_sp - frame_sp - retAddrSizeW
216 rel_binds = reverse $ sortWith fst
217 [(offset - frame_sp - retAddrSizeW, b)
218 | (offset, b) <- binds]
220 WARN( not (all (\bind -> fst bind >= 0) rel_binds),
221 ppr binds $$ ppr rel_binds $$
222 ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
223 return $ stack_layout rel_binds frame_size
225 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
228 stack_layout [] sizeW = replicate sizeW Nothing
229 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
230 (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
232 rep_size = cgRepSizeW (cgIdInfoArgRep bind)
233 stack_bind = LocalReg unique machRep kind
234 unique = getUnique (cgIdInfoId bind)
235 machRep = argMachRep (cgIdInfoArgRep bind)
236 kind = if isFollowableArg (cgIdInfoArgRep bind)
239 stack_layout binds@((off, _):_) sizeW | otherwise =
240 Nothing : (stack_layout binds (sizeW - 1))
242 {- Another way to write the function that might be less error prone (untested)
243 stack_layout offsets sizeW = result
245 y = map (flip lookup offsets) [0..]
246 -- offsets -> nothing and just (each slot is one word)
247 x = take sizeW y -- set the frame size
248 z = clip x -- account for multi-word slots
249 result = map mk_reg z
252 clip list@(x : _) = x : clip (drop count list)
253 ASSERT(all isNothing (tail (take count list)))
256 count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
258 mk_reg Nothing = Nothing
259 mk_reg (Just x) = LocalReg unique machRep kind
261 unique = getUnique (cgIdInfoId x)
262 machRep = argMachrep (cgIdInfoArgRep bind)
263 kind = if isFollowableArg (cgIdInfoArgRep bind)
269 :: Name -- Just for its unique
270 -> [(ConTagZ, CgStmts)] -- Tagged branches
271 -> Maybe CgStmts -- Default branch (if any)
272 -> Int -- family size
273 -> FCode (CLabel, SemiTaggingStuff)
275 emitAlgReturnTarget name branches mb_deflt fam_sz
276 = do { blks <- getCgStmts $
277 -- is the constructor tag in the node reg?
278 if isSmallFamily fam_sz
279 then do -- yes, node has constr. tag
280 let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
281 branches' = [(tag+1,branch)|(tag,branch)<-branches]
282 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
283 else do -- no, get tag from info table
284 let -- Note that ptr _always_ has tag 1
285 -- when the family size is big enough
286 untagged_ptr = cmmRegOffB nodeReg (-1)
287 tag_expr = getConstrTag (untagged_ptr)
288 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
289 ; lbl <- emitReturnTarget name blks
290 ; return (lbl, Nothing) }
291 -- Nothing: the internal branches in the switch don't have
292 -- global labels, so we can't use them at the 'call site'
294 uniq = getUnique name
296 --------------------------------
297 emitReturnInstr :: Code
299 = do { info_amode <- getSequelAmode
300 ; stmtC (CmmJump (entryCode info_amode) []) }
302 -----------------------------------------------------------------------------
304 -- Info table offsets
306 -----------------------------------------------------------------------------
308 stdInfoTableSizeW :: WordOff
309 -- The size of a standard info table varies with profiling/ticky etc,
310 -- so we can't get it from Constants
311 -- It must vary in sync with mkStdInfoTable
313 = size_fixed + size_prof
315 size_fixed = 2 -- layout, type
316 size_prof | opt_SccProfilingOn = 2
319 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
321 stdSrtBitmapOffset :: ByteOff
322 -- Byte offset of the SRT bitmap half-word which is
323 -- in the *higher-addressed* part of the type_lit
324 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
326 stdClosureTypeOffset :: ByteOff
327 -- Byte offset of the closure type half-word
328 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
330 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
331 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
332 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
334 -------------------------------------------------------------------------
336 -- Accessing fields of an info table
338 -------------------------------------------------------------------------
340 closureInfoPtr :: CmmExpr -> CmmExpr
341 -- Takes a closure pointer and returns the info table pointer
342 closureInfoPtr e = CmmLoad e wordRep
344 entryCode :: CmmExpr -> CmmExpr
345 -- Takes an info pointer (the first word of a closure)
346 -- and returns its entry code
347 entryCode e | tablesNextToCode = e
348 | otherwise = CmmLoad e wordRep
350 getConstrTag :: CmmExpr -> CmmExpr
351 -- Takes a closure pointer, and return the *zero-indexed*
352 -- constructor tag obtained from the info table
353 -- This lives in the SRT field of the info table
354 -- (constructors don't need SRTs).
355 getConstrTag closure_ptr
356 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
358 info_table = infoTable (closureInfoPtr closure_ptr)
360 cmmGetClosureType :: CmmExpr -> CmmExpr
361 -- Takes a closure pointer, and return the closure type
362 -- obtained from the info table
363 cmmGetClosureType closure_ptr
364 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableClosureType info_table]
366 info_table = infoTable (closureInfoPtr closure_ptr)
368 infoTable :: CmmExpr -> CmmExpr
369 -- Takes an info pointer (the first word of a closure)
370 -- and returns a pointer to the first word of the standard-form
371 -- info table, excluding the entry-code word (if present)
373 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
374 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
376 infoTableConstrTag :: CmmExpr -> CmmExpr
377 -- Takes an info table pointer (from infoTable) and returns the constr tag
378 -- field of the info table (same as the srt_bitmap field)
379 infoTableConstrTag = infoTableSrtBitmap
381 infoTableSrtBitmap :: CmmExpr -> CmmExpr
382 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
383 -- field of the info table
384 infoTableSrtBitmap info_tbl
385 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
387 infoTableClosureType :: CmmExpr -> CmmExpr
388 -- Takes an info table pointer (from infoTable) and returns the closure type
389 -- field of the info table.
390 infoTableClosureType info_tbl
391 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
393 infoTablePtrs :: CmmExpr -> CmmExpr
394 infoTablePtrs info_tbl
395 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
397 infoTableNonPtrs :: CmmExpr -> CmmExpr
398 infoTableNonPtrs info_tbl
399 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
401 funInfoTable :: CmmExpr -> CmmExpr
402 -- Takes the info pointer of a function,
403 -- and returns a pointer to the first word of the StgFunInfoExtra struct
404 -- in the info table.
405 funInfoTable info_ptr
407 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
409 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
410 -- Past the entry code pointer
412 -------------------------------------------------------------------------
414 -- Emit the code for a closure (or return address)
415 -- and its associated info table
417 -------------------------------------------------------------------------
419 -- The complication here concerns whether or not we can
420 -- put the info table next to the code
423 :: CLabel -- Label of entry or ret
424 -> CmmInfo -- ...the info table
425 -> CmmFormals -- ...args
426 -> [CmmBasicBlock] -- ...and body
429 emitInfoTableAndCode entry_ret_lbl info args blocks
430 = emitProc info entry_ret_lbl args blocks
432 -------------------------------------------------------------------------
434 -- Static reference tables
436 -------------------------------------------------------------------------
438 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
439 srtLabelAndLength NoC_SRT _
441 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
442 = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
444 -------------------------------------------------------------------------
446 -- Position independent code
448 -------------------------------------------------------------------------
449 -- In order to support position independent code, we mustn't put absolute
450 -- references into read-only space. Info tables in the tablesNextToCode
451 -- case must be in .text, which is read-only, so we doctor the CmmLits
452 -- to use relative offsets instead.
454 -- Note that this is done even when the -fPIC flag is not specified,
455 -- as we want to keep binary compatibility between PIC and non-PIC.
457 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
459 makeRelativeRefTo info_lbl (CmmLabel lbl)
461 = CmmLabelDiffOff lbl info_lbl 0
462 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
464 = CmmLabelDiffOff lbl info_lbl off
465 makeRelativeRefTo _ lit = lit