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"
56 -------------------------------------------------------------------------
58 -- Generating the info table and code for a closure
60 -------------------------------------------------------------------------
62 -- Here we make an info table of type 'CmmInfo'. The concrete
63 -- representation as a list of 'CmmAddr' is handled later
64 -- in the pipeline by 'cmmToRawCmm'.
66 emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
67 emitClosureCodeAndInfoTable cl_info args body
68 = do { blks <- cgStmtsToBlocks body
69 ; info <- mkCmmInfo cl_info
70 ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
72 info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info
74 -- We keep the *zero-indexed* tag in the srt_len field of the info
75 -- table of a data constructor.
76 dataConTagZ :: DataCon -> ConTagZ
77 dataConTagZ con = dataConTag con - fIRST_TAG
79 -- Convert from 'ClosureInfo' to 'CmmInfo'.
80 -- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
81 mkCmmInfo :: ClosureInfo -> FCode CmmInfo
82 mkCmmInfo cl_info = do
85 then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info)
86 cl_descr_lit <- mkStringCLit (closureValDescr cl_info)
87 return $ ProfilingInfo ty_descr_lit cl_descr_lit
88 else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
91 ConInfo { closureCon = con } -> do
92 cstr <- mkByteStringCLit $ dataConIdentity con
93 let conName = makeRelativeRefTo info_lbl cstr
94 info = ConstrInfo (ptrs, nptrs)
95 (fromIntegral (dataConTagZ con))
97 return $ CmmInfo gc_target Nothing (CmmInfoTable False prof cl_type info)
99 ClosureInfo { closureName = name,
100 closureLFInfo = lf_info,
101 closureSRT = srt } ->
102 return $ CmmInfo gc_target Nothing (CmmInfoTable False prof cl_type info)
106 LFReEntrant _ arity _ arg_descr ->
107 FunInfo (ptrs, nptrs)
111 (CmmLabel (mkSlowEntryLabel name has_caf_refs))
112 LFThunk _ _ _ (SelectorThunk offset) _ ->
113 ThunkSelectorInfo (fromIntegral offset) srt
115 ThunkInfo (ptrs, nptrs) srt
116 _ -> panic "unexpected lambda form in mkCmmInfo"
118 info_lbl = infoTableLabelFromCI cl_info has_caf_refs
119 has_caf_refs = clHasCafRefs cl_info
121 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
123 ptrs = fromIntegral $ closurePtrsSize cl_info
124 size = fromIntegral $ closureNonHdrSize cl_info
127 -- The gc_target is to inform the CPS pass when it inserts a stack check.
128 -- Since that pass isn't used yet we'll punt for now.
129 -- When the CPS pass is fully integrated, this should
130 -- be replaced by the label that any heap check jumped to,
131 -- so that branch can be shared by both the heap (from codeGen)
132 -- and stack checks (from the CPS pass).
133 gc_target = panic "TODO: gc_target"
135 -------------------------------------------------------------------------
137 -- Generating the info table and code for a return point
139 -------------------------------------------------------------------------
141 -- The concrete representation as a list of 'CmmAddr' is handled later
142 -- in the pipeline by 'cmmToRawCmm'.
146 -> CgStmts -- The direct-return code (if any)
148 emitReturnTarget name stmts
149 = do { srt_info <- getSRTInfo
150 ; blks <- cgStmtsToBlocks stmts
151 ; frame <- mkStackLayout
156 (ProfilingInfo zeroCLit zeroCLit)
157 rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
158 (ContInfo frame srt_info))
159 ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
162 args = {- trace "emitReturnTarget: missing args" -} []
163 uniq = getUnique name
164 info_lbl = mkReturnInfoLabel uniq
166 -- The gc_target is to inform the CPS pass when it inserts a stack check.
167 -- Since that pass isn't used yet we'll punt for now.
168 -- When the CPS pass is fully integrated, this should
169 -- be replaced by the label that any heap check jumped to,
170 -- so that branch can be shared by both the heap (from codeGen)
171 -- and stack checks (from the CPS pass).
172 gc_target = panic "TODO: gc_target"
175 -- Build stack layout information from the state of the 'FCode' monad.
176 -- Should go away once 'codeGen' starts using the CPS conversion
177 -- pass to handle the stack. Until then, this is really just
178 -- here to convert from the 'codeGen' representation of the stack
179 -- to the 'CmmInfo' representation of the stack.
181 -- See 'CmmInfo.mkLiveness' for where this is converted to a bitmap.
184 This seems to be a very error prone part of the code.
185 It is surprisingly prone to off-by-one errors, because
186 it converts between offset form (codeGen) and list form (CmmInfo).
187 Thus a bit of explanation is in order.
188 Fortunately, this code should go away once the code generator
189 starts using the CPS conversion pass to handle the stack.
191 The stack looks like this:
195 frame_sp --> | return addr |
203 real_sp --> | return addr |
206 Both 'frame_sp' and 'real_sp' are measured downwards
207 (i.e. larger frame_sp means smaller memory address).
209 For that frame we want a result like: [Just a, Just b, Nothing]
210 Note that the 'head' of the list is the top
211 of the stack, and that the return address
212 is not present in the list (it is always assumed).
214 mkStackLayout :: FCode [Maybe LocalReg]
216 StackUsage { realSp = real_sp,
217 frameSp = frame_sp } <- getStkUsage
218 binds <- getLiveStackBindings
219 let frame_size = real_sp - frame_sp - retAddrSizeW
220 rel_binds = reverse $ sortWith fst
221 [(offset - frame_sp - retAddrSizeW, b)
222 | (offset, b) <- binds]
224 WARN( not (all (\bind -> fst bind >= 0) rel_binds),
225 ppr binds $$ ppr rel_binds $$
226 ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
227 return $ stack_layout rel_binds frame_size
229 stack_layout :: [(VirtualSpOffset, CgIdInfo)]
232 stack_layout [] sizeW = replicate sizeW Nothing
233 stack_layout ((off, bind):binds) sizeW | off == sizeW - 1 =
234 (Just stack_bind) : (stack_layout binds (sizeW - rep_size))
236 rep_size = cgRepSizeW (cgIdInfoArgRep bind)
237 stack_bind = LocalReg unique machRep
238 unique = getUnique (cgIdInfoId bind)
239 machRep = argMachRep (cgIdInfoArgRep bind)
240 stack_layout binds@((off, _):_) sizeW | otherwise =
241 Nothing : (stack_layout binds (sizeW - 1))
243 {- Another way to write the function that might be less error prone (untested)
244 stack_layout offsets sizeW = result
246 y = map (flip lookup offsets) [0..]
247 -- offsets -> nothing and just (each slot is one word)
248 x = take sizeW y -- set the frame size
249 z = clip x -- account for multi-word slots
250 result = map mk_reg z
253 clip list@(x : _) = x : clip (drop count list)
254 ASSERT(all isNothing (tail (take count list)))
257 count (Just x) = cgRepSizeW (cgIdInfoArgRep x)
259 mk_reg Nothing = Nothing
260 mk_reg (Just x) = LocalReg unique machRep kind
262 unique = getUnique (cgIdInfoId x)
263 machRep = argMachrep (cgIdInfoArgRep bind)
264 kind = if isFollowableArg (cgIdInfoArgRep bind)
270 :: Name -- Just for its unique
271 -> [(ConTagZ, CgStmts)] -- Tagged branches
272 -> Maybe CgStmts -- Default branch (if any)
273 -> Int -- family size
274 -> FCode (CLabel, SemiTaggingStuff)
276 emitAlgReturnTarget name branches mb_deflt fam_sz
277 = do { blks <- getCgStmts $
278 -- is the constructor tag in the node reg?
279 if isSmallFamily fam_sz
280 then do -- yes, node has constr. tag
281 let tag_expr = cmmConstrTag1 (CmmReg nodeReg)
282 branches' = [(tag+1,branch)|(tag,branch)<-branches]
283 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
284 else do -- no, get tag from info table
285 let -- Note that ptr _always_ has tag 1
286 -- when the family size is big enough
287 untagged_ptr = cmmRegOffB nodeReg (-1)
288 tag_expr = getConstrTag (untagged_ptr)
289 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
290 ; lbl <- emitReturnTarget name blks
291 ; return (lbl, Nothing) }
292 -- Nothing: the internal branches in the switch don't have
293 -- global labels, so we can't use them at the 'call site'
295 uniq = getUnique name
297 --------------------------------
298 emitReturnInstr :: Code
300 = do { info_amode <- getSequelAmode
301 ; stmtC (CmmJump (entryCode info_amode) []) }
303 -----------------------------------------------------------------------------
305 -- Info table offsets
307 -----------------------------------------------------------------------------
309 stdInfoTableSizeW :: WordOff
310 -- The size of a standard info table varies with profiling/ticky etc,
311 -- so we can't get it from Constants
312 -- It must vary in sync with mkStdInfoTable
314 = size_fixed + size_prof
316 size_fixed = 2 -- layout, type
317 size_prof | opt_SccProfilingOn = 2
320 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
322 stdSrtBitmapOffset :: ByteOff
323 -- Byte offset of the SRT bitmap half-word which is
324 -- in the *higher-addressed* part of the type_lit
325 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
327 stdClosureTypeOffset :: ByteOff
328 -- Byte offset of the closure type half-word
329 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
331 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
332 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
333 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
335 -------------------------------------------------------------------------
337 -- Accessing fields of an info table
339 -------------------------------------------------------------------------
341 closureInfoPtr :: CmmExpr -> CmmExpr
342 -- Takes a closure pointer and returns the info table pointer
343 closureInfoPtr e = CmmLoad e bWord
345 entryCode :: CmmExpr -> CmmExpr
346 -- Takes an info pointer (the first word of a closure)
347 -- and returns its entry code
348 entryCode e | tablesNextToCode = e
349 | otherwise = CmmLoad e bWord
351 getConstrTag :: CmmExpr -> CmmExpr
352 -- Takes a closure pointer, and return the *zero-indexed*
353 -- constructor tag obtained from the info table
354 -- This lives in the SRT field of the info table
355 -- (constructors don't need SRTs).
356 getConstrTag closure_ptr
357 = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableConstrTag info_table]
359 info_table = infoTable (closureInfoPtr closure_ptr)
361 cmmGetClosureType :: CmmExpr -> CmmExpr
362 -- Takes a closure pointer, and return the closure type
363 -- obtained from the info table
364 cmmGetClosureType closure_ptr
365 = CmmMachOp (MO_UU_Conv halfWordWidth wordWidth) [infoTableClosureType info_table]
367 info_table = infoTable (closureInfoPtr closure_ptr)
369 infoTable :: CmmExpr -> CmmExpr
370 -- Takes an info pointer (the first word of a closure)
371 -- and returns a pointer to the first word of the standard-form
372 -- info table, excluding the entry-code word (if present)
374 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
375 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
377 infoTableConstrTag :: CmmExpr -> CmmExpr
378 -- Takes an info table pointer (from infoTable) and returns the constr tag
379 -- field of the info table (same as the srt_bitmap field)
380 infoTableConstrTag = infoTableSrtBitmap
382 infoTableSrtBitmap :: CmmExpr -> CmmExpr
383 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
384 -- field of the info table
385 infoTableSrtBitmap info_tbl
386 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) bHalfWord
388 infoTableClosureType :: CmmExpr -> CmmExpr
389 -- Takes an info table pointer (from infoTable) and returns the closure type
390 -- field of the info table.
391 infoTableClosureType info_tbl
392 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) bHalfWord
394 infoTablePtrs :: CmmExpr -> CmmExpr
395 infoTablePtrs info_tbl
396 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) bHalfWord
398 infoTableNonPtrs :: CmmExpr -> CmmExpr
399 infoTableNonPtrs info_tbl
400 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) bHalfWord
402 funInfoTable :: CmmExpr -> CmmExpr
403 -- Takes the info pointer of a function,
404 -- and returns a pointer to the first word of the StgFunInfoExtra struct
405 -- in the info table.
406 funInfoTable info_ptr
408 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
410 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
411 -- Past the entry code pointer
413 -------------------------------------------------------------------------
415 -- Emit the code for a closure (or return address)
416 -- and its associated info table
418 -------------------------------------------------------------------------
420 -- The complication here concerns whether or not we can
421 -- put the info table next to the code
424 :: CLabel -- Label of entry or ret
425 -> CmmInfo -- ...the info table
426 -> CmmFormals -- ...args
427 -> [CmmBasicBlock] -- ...and body
430 emitInfoTableAndCode entry_ret_lbl info args blocks
431 = emitProc info entry_ret_lbl args blocks
433 -------------------------------------------------------------------------
435 -- Static reference tables
437 -------------------------------------------------------------------------
439 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
440 srtLabelAndLength NoC_SRT _
442 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
443 = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
445 -------------------------------------------------------------------------
447 -- Position independent code
449 -------------------------------------------------------------------------
450 -- In order to support position independent code, we mustn't put absolute
451 -- references into read-only space. Info tables in the tablesNextToCode
452 -- case must be in .text, which is read-only, so we doctor the CmmLits
453 -- to use relative offsets instead.
455 -- Note that this is done even when the -fPIC flag is not specified,
456 -- as we want to keep binary compatibility between PIC and non-PIC.
458 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
460 makeRelativeRefTo info_lbl (CmmLabel lbl)
462 = CmmLabelDiffOff lbl info_lbl 0
463 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
465 = CmmLabelDiffOff lbl info_lbl off
466 makeRelativeRefTo _ lit = lit