2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 -----------------------------------------------------------------------------
10 -- Building info tables.
12 -- (c) The University of Glasgow 2004-2006
14 -----------------------------------------------------------------------------
17 emitClosureCodeAndInfoTable,
20 emitReturnTarget, emitAlgReturnTarget,
23 entryCode, closureInfoPtr,
26 infoTable, infoTableClosureType,
27 infoTablePtrs, infoTableNonPtrs,
28 funInfoTable, makeRelativeRefTo
32 #include "HsVersions.h"
57 -------------------------------------------------------------------------
59 -- Generating the info table and code for a closure
61 -------------------------------------------------------------------------
63 -- Here we make an info table of type 'CmmInfo'. The concrete
64 -- representation as a list of 'CmmAddr' is handled later
65 -- in the pipeline by 'cmmToRawCmm'.
67 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormalsWithoutKinds -> CgStmts -> Code
68 emitClosureCodeAndInfoTable cl_info args body
69 = do { blks <- cgStmtsToBlocks body
70 ; info <- mkCmmInfo cl_info
71 ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
73 info_lbl = infoTableLabelFromCI cl_info
75 -- We keep the *zero-indexed* tag in the srt_len field of the info
76 -- table of a data constructor.
77 dataConTagZ :: DataCon -> ConTagZ
78 dataConTagZ con = dataConTag con - fIRST_TAG
80 -- Convert from 'ClosureInfo' to 'CmmInfo'.
81 -- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
82 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
83 mkCmmInfo cl_info = do
86 then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info)
87 cl_descr_lit <- mkStringCLit (closureValDescr cl_info)
88 return $ ProfilingInfo ty_descr_lit cl_descr_lit
89 else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
92 ConInfo { closureCon = con } -> do
93 cstr <- mkByteStringCLit $ dataConIdentity con
94 let conName = makeRelativeRefTo info_lbl cstr
95 info = ConstrInfo (ptrs, nptrs)
96 (fromIntegral (dataConTagZ con))
98 return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
100 ClosureInfo { closureName = name,
101 closureLFInfo = lf_info,
102 closureSRT = srt } ->
103 return $ CmmInfo gc_target Nothing (CmmInfoTable prof cl_type info)
107 LFReEntrant _ arity _ arg_descr ->
108 FunInfo (ptrs, nptrs)
110 (argDescrType arg_descr)
113 (CmmLabel (mkSlowEntryLabel name))
114 LFThunk _ _ _ (SelectorThunk offset) _ ->
115 ThunkSelectorInfo (fromIntegral offset) srt
117 ThunkInfo (ptrs, nptrs) srt
118 _ -> panic "unexpected lambda form in mkCmmInfo"
120 info_lbl = infoTableLabelFromCI cl_info
122 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
124 ptrs = fromIntegral $ closurePtrsSize cl_info
125 size = fromIntegral $ closureNonHdrSize cl_info
128 -- The gc_target is to inform the CPS pass when it inserts a stack check.
129 -- Since that pass isn't used yet we'll punt for now.
130 -- When the CPS pass is fully integrated, this should
131 -- be replaced by the label that any heap check jumped to,
132 -- so that branch can be shared by both the heap (from codeGen)
133 -- and stack checks (from the CPS pass).
134 gc_target = panic "TODO: gc_target"
136 -------------------------------------------------------------------------
138 -- Generating the info table and code for a return point
140 -------------------------------------------------------------------------
142 -- The concrete representation as a list of 'CmmAddr' is handled later
143 -- in the pipeline by 'cmmToRawCmm'.
147 -> CgStmts -- The direct-return code (if any)
149 emitReturnTarget name stmts
150 = do { srt_info <- getSRTInfo
151 ; blks <- cgStmtsToBlocks stmts
152 ; frame <- mkStackLayout
157 (ProfilingInfo zeroCLit zeroCLit)
158 rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
159 (ContInfo frame srt_info))
160 ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
163 args = {- trace "emitReturnTarget: missing args" -} []
164 uniq = getUnique name
165 info_lbl = mkReturnInfoLabel uniq
167 -- The gc_target is to inform the CPS pass when it inserts a stack check.
168 -- Since that pass isn't used yet we'll punt for now.
169 -- When the CPS pass is fully integrated, this should
170 -- be replaced by the label that any heap check jumped to,
171 -- so that branch can be shared by both the heap (from codeGen)
172 -- and stack checks (from the CPS pass).
173 gc_target = panic "TODO: gc_target"
176 -- Build stack layout information from the state of the 'FCode' monad.
177 -- Should go away once 'codeGen' starts using the CPS conversion
178 -- pass to handle the stack. Until then, this is really just
179 -- here to convert from the 'codeGen' representation of the stack
180 -- to the 'CmmInfo' representation of the stack.
182 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
185 This seems to be a very error prone part of the code.
186 It is surprisingly prone to off-by-one errors, because
187 it converts between offset form (codeGen) and list form (CmmInfo).
188 Thus a bit of explanation is in order.
189 Fortunately, this code should go away once the code generator
190 starts using the CPS conversion pass to handle the stack.
192 The stack looks like this:
196 frame_sp --> | return addr |
204 real_sp --> | return addr |
207 Both 'frame_sp' and 'real_sp' are measured downwards
208 (i.e. larger frame_sp means smaller memory address).
210 For that frame we want a result like: [Just a, Just b, Nothing]
211 Note that the 'head' of the list is the top
212 of the stack, and that the return address
213 is not present in the list (it is always assumed).
215 mkStackLayout :: FCode [Maybe LocalReg]
217 StackUsage { realSp = real_sp,
218 frameSp = frame_sp } <- getStkUsage
219 binds <- getLiveStackBindings
220 let frame_size = real_sp - frame_sp - retAddrSizeW
221 rel_binds = reverse $ sortWith fst
222 [(offset - frame_sp - retAddrSizeW, b)
223 | (offset, b) <- binds]
225 WARN( not (all (\bind -> fst bind >= 0) rel_binds),
226 ppr binds $$ ppr rel_binds $$
227 ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
228 return $ stack_layout rel_binds frame_size
230 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
233 stack_layout [] sizeW = replicate sizeW Nothing
234 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
235 (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
237 rep_size = cgRepSizeW (cgIdInfoArgRep bind)
238 stack_bind = LocalReg unique machRep kind
239 unique = getUnique (cgIdInfoId bind)
240 machRep = argMachRep (cgIdInfoArgRep bind)
241 kind = if isFollowableArg (cgIdInfoArgRep bind)
244 stack_layout binds@((off, _):_) sizeW | otherwise =
245 Nothing : (stack_layout binds (sizeW - 1))
247 {- Another way to write the function that might be less error prone (untested)
248 stack_layout offsets sizeW = result
250 y = map (flip lookup offsets) [0..]
251 -- offsets -> nothing and just (each slot is one word)
252 x = take sizeW y -- set the frame size
253 z = clip x -- account for multi-word slots
254 result = map mk_reg z
257 clip list@(x : _) = x : clip (drop count list)
258 ASSERT(all isNothing (tail (take count list)))
261 count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
263 mk_reg Nothing = Nothing
264 mk_reg (Just x) = LocalReg unique machRep kind
266 unique = getUnique (cgIdInfoId x)
267 machRep = argMachrep (cgIdInfoArgRep bind)
268 kind = if isFollowableArg (cgIdInfoArgRep bind)
274 :: Name -- Just for its unique
275 -> [(ConTagZ, CgStmts)] -- Tagged branches
276 -> Maybe CgStmts -- Default branch (if any)
277 -> Int -- family size
278 -> FCode (CLabel, SemiTaggingStuff)
280 emitAlgReturnTarget name branches mb_deflt fam_sz
281 = do { blks <- getCgStmts $
282 -- is the constructor tag in the node reg?
283 if isSmallFamily fam_sz
284 then do -- yes, node has constr. tag
285 let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
286 branches' = [(tag+1,branch)|(tag,branch)<-branches]
287 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
288 else do -- no, get tag from info table
289 let -- Note that ptr _always_ has tag 1
290 -- when the family size is big enough
291 untagged_ptr = cmmRegOffB nodeReg (-1)
292 tag_expr = getConstrTag (untagged_ptr)
293 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
294 ; lbl <- emitReturnTarget name blks
295 ; return (lbl, Nothing) }
296 -- Nothing: the internal branches in the switch don't have
297 -- global labels, so we can't use them at the 'call site'
299 uniq = getUnique name
301 --------------------------------
302 emitReturnInstr :: Code
304 = do { info_amode <- getSequelAmode
305 ; stmtC (CmmJump (entryCode info_amode) []) }
307 -----------------------------------------------------------------------------
309 -- Info table offsets
311 -----------------------------------------------------------------------------
313 stdInfoTableSizeW :: WordOff
314 -- The size of a standard info table varies with profiling/ticky etc,
315 -- so we can't get it from Constants
316 -- It must vary in sync with mkStdInfoTable
318 = size_fixed + size_prof
320 size_fixed = 2 -- layout, type
321 size_prof | opt_SccProfilingOn = 2
324 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
326 stdSrtBitmapOffset :: ByteOff
327 -- Byte offset of the SRT bitmap half-word which is
328 -- in the *higher-addressed* part of the type_lit
329 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
331 stdClosureTypeOffset :: ByteOff
332 -- Byte offset of the closure type half-word
333 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
335 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
336 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
337 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
339 -------------------------------------------------------------------------
341 -- Accessing fields of an info table
343 -------------------------------------------------------------------------
345 closureInfoPtr :: CmmExpr -> CmmExpr
346 -- Takes a closure pointer and returns the info table pointer
347 closureInfoPtr e = CmmLoad e wordRep
349 entryCode :: CmmExpr -> CmmExpr
350 -- Takes an info pointer (the first word of a closure)
351 -- and returns its entry code
352 entryCode e | tablesNextToCode = e
353 | otherwise = CmmLoad e wordRep
355 getConstrTag :: CmmExpr -> CmmExpr
356 -- Takes a closure pointer, and return the *zero-indexed*
357 -- constructor tag obtained from the info table
358 -- This lives in the SRT field of the info table
359 -- (constructors don't need SRTs).
360 getConstrTag closure_ptr
361 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
363 info_table = infoTable (closureInfoPtr closure_ptr)
365 cmmGetClosureType :: CmmExpr -> CmmExpr
366 -- Takes a closure pointer, and return the closure type
367 -- obtained from the info table
368 cmmGetClosureType closure_ptr
369 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableClosureType info_table]
371 info_table = infoTable (closureInfoPtr closure_ptr)
373 infoTable :: CmmExpr -> CmmExpr
374 -- Takes an info pointer (the first word of a closure)
375 -- and returns a pointer to the first word of the standard-form
376 -- info table, excluding the entry-code word (if present)
378 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
379 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
381 infoTableConstrTag :: CmmExpr -> CmmExpr
382 -- Takes an info table pointer (from infoTable) and returns the constr tag
383 -- field of the info table (same as the srt_bitmap field)
384 infoTableConstrTag = infoTableSrtBitmap
386 infoTableSrtBitmap :: CmmExpr -> CmmExpr
387 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
388 -- field of the info table
389 infoTableSrtBitmap info_tbl
390 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
392 infoTableClosureType :: CmmExpr -> CmmExpr
393 -- Takes an info table pointer (from infoTable) and returns the closure type
394 -- field of the info table.
395 infoTableClosureType info_tbl
396 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
398 infoTablePtrs :: CmmExpr -> CmmExpr
399 infoTablePtrs info_tbl
400 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
402 infoTableNonPtrs :: CmmExpr -> CmmExpr
403 infoTableNonPtrs info_tbl
404 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
406 funInfoTable :: CmmExpr -> CmmExpr
407 -- Takes the info pointer of a function,
408 -- and returns a pointer to the first word of the StgFunInfoExtra struct
409 -- in the info table.
410 funInfoTable info_ptr
412 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
414 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
415 -- Past the entry code pointer
417 -------------------------------------------------------------------------
419 -- Emit the code for a closure (or return address)
420 -- and its associated info table
422 -------------------------------------------------------------------------
424 -- The complication here concerns whether or not we can
425 -- put the info table next to the code
428 :: CLabel -- Label of entry or ret
429 -> CmmInfo -- ...the info table
430 -> CmmFormalsWithoutKinds -- ...args
431 -> [CmmBasicBlock] -- ...and body
434 emitInfoTableAndCode entry_ret_lbl info args blocks
435 = emitProc info entry_ret_lbl args blocks
437 -------------------------------------------------------------------------
439 -- Static reference tables
441 -------------------------------------------------------------------------
443 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
444 srtLabelAndLength NoC_SRT _
446 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
447 = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
449 -------------------------------------------------------------------------
451 -- Position independent code
453 -------------------------------------------------------------------------
454 -- In order to support position independent code, we mustn't put absolute
455 -- references into read-only space. Info tables in the tablesNextToCode
456 -- case must be in .text, which is read-only, so we doctor the CmmLits
457 -- to use relative offsets instead.
459 -- Note that this is done even when the -fPIC flag is not specified,
460 -- as we want to keep binary compatibility between PIC and non-PIC.
462 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
464 makeRelativeRefTo info_lbl (CmmLabel lbl)
466 = CmmLabelDiffOff lbl info_lbl 0
467 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
469 = CmmLabelDiffOff lbl info_lbl off
470 makeRelativeRefTo _ lit = lit