1 -----------------------------------------------------------------------------
3 -- Building info tables.
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
10 emitClosureCodeAndInfoTable,
14 emitDirectReturnTarget, emitAlgReturnTarget,
15 emitDirectReturnInstr, emitVectoredReturnInstr,
19 mkFunGenInfoExtraBits,
20 entryCode, closureInfoPtr,
22 infoTable, infoTableClosureType, infoTableConstrTag,
23 infoTablePtrs, infoTableNonPtrs,
29 #include "HsVersions.h"
53 -------------------------------------------------------------------------
55 -- Generating the info table and code for a closure
57 -------------------------------------------------------------------------
59 -- Here we make a concrete info table, represented as a list of CmmAddr
60 -- (it can't be simply a list of Word, because the SRT field is
61 -- represented by a label+offset expression).
63 -- With tablesNextToCode, the layout is
64 -- <reversed variable part>
65 -- <normal forward StgInfoTable, but without
66 -- an entry point at the front>
69 -- Without tablesNextToCode, the layout of an info table is
71 -- <normal forward rest of StgInfoTable>
72 -- <forward variable part>
74 -- See includes/InfoTables.h
76 emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
77 emitClosureCodeAndInfoTable cl_info args body
78 = do { ty_descr_lit <-
80 then mkStringCLit (closureTypeDescr cl_info)
81 else return (mkIntCLit 0)
84 then mkStringCLit cl_descr_string
85 else return (mkIntCLit 0)
86 ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit
87 cl_type srt_len layout_lit
89 ; blks <- cgStmtsToBlocks body
90 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks }
92 info_lbl = infoTableLabelFromCI cl_info
94 cl_descr_string = closureValDescr cl_info
95 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
97 srt = closureSRT cl_info
98 needs_srt = needsSRT srt
100 mb_con = isConstrClosure_maybe cl_info
101 is_con = isJust mb_con
105 Just con -> -- Constructors don't have an SRT
106 -- We keep the *zero-indexed* tag in the srt_len
107 -- field of the info table.
108 (mkIntCLit 0, fromIntegral (dataConTagZ con))
110 Nothing -> -- Not a constructor
111 srtLabelAndLength srt info_lbl
113 ptrs = closurePtrsSize cl_info
115 size = closureNonHdrSize cl_info
116 layout_lit = packHalfWordsCLit ptrs nptrs
119 | is_fun = fun_extra_bits
121 | needs_srt = [srt_label]
124 maybe_fun_stuff = closureFunInfo cl_info
125 is_fun = isJust maybe_fun_stuff
126 (Just (arity, arg_descr)) = maybe_fun_stuff
129 | ArgGen liveness <- arg_descr
132 makeRelativeRefTo info_lbl $ mkLivenessCLit liveness,
134 | needs_srt = [fun_amode, srt_label]
135 | otherwise = [fun_amode]
137 slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
138 slow_entry_label = mkSlowEntryLabel (closureName cl_info)
140 fun_amode = packHalfWordsCLit fun_type arity
141 fun_type = argDescrType arg_descr
143 -- We keep the *zero-indexed* tag in the srt_len field of the info
144 -- table of a data constructor.
145 dataConTagZ :: DataCon -> ConTagZ
146 dataConTagZ con = dataConTag con - fIRST_TAG
148 -- A low-level way to generate the variable part of a fun-style info table.
149 -- (must match fun_extra_bits above). Used by the C-- parser.
150 mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
151 mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
152 = [ packHalfWordsCLit fun_type arity,
157 -------------------------------------------------------------------------
159 -- Generating the info table and code for a return point
161 -------------------------------------------------------------------------
163 -- Here's the layout of a return-point info table
165 -- Tables next to code:
167 -- <reversed vector table>
169 -- <standard info table>
170 -- ret-addr --> <entry code (if any)>
172 -- Not tables-next-to-code:
174 -- ret-addr --> <ptr to entry code>
175 -- <standard info table>
177 -- <forward vector table>
179 -- * The vector table is only present for vectored returns
181 -- * The SRT slot is only there if either
182 -- (a) there is SRT info to record, OR
183 -- (b) if the return is vectored
184 -- The latter (b) is necessary so that the vector is in a
187 vectorSlot :: CmmExpr -> CmmExpr -> CmmExpr
188 -- Get the vector slot from the info pointer
189 vectorSlot info_amode zero_indexed_tag
191 = cmmOffsetExprW (cmmOffsetW info_amode (- (stdInfoTableSizeW + 2)))
192 (cmmNegate zero_indexed_tag)
193 -- The "2" is one for the SRT slot, and one more
194 -- to get to the first word of the vector
197 = cmmOffsetExprW (cmmOffsetW info_amode (stdInfoTableSizeW + 2))
199 -- The "2" is one for the entry-code slot and one for the SRT slot
201 retVec :: CmmExpr -> CmmExpr -> CmmExpr
202 -- Get a return vector from the info pointer
203 retVec info_amode zero_indexed_tag
204 = let slot = vectorSlot info_amode zero_indexed_tag
205 table_slot = CmmLoad slot wordRep
206 #if defined(x86_64_TARGET_ARCH)
207 offset_slot = CmmMachOp (MO_S_Conv I32 I64) [CmmLoad slot I32]
208 -- offsets are 32-bits on x86-64, due to the inability of
209 -- the tools to handle 64-bit PC-relative relocations. See also
210 -- PprMach.pprDataItem, and InfoTables.h:OFFSET_FIELD().
212 offset_slot = table_slot
214 in if tablesNextToCode
215 then CmmMachOp (MO_Add wordRep) [offset_slot, info_amode]
220 -> CgStmts -- The direct-return code (if any)
221 -- (empty for vectored returns)
222 -> [CmmLit] -- Vector of return points
223 -- (empty for non-vectored returns)
226 emitReturnTarget name stmts vector srt
227 = do { live_slots <- getLiveStackSlots
228 ; liveness <- buildContLiveness name live_slots
229 ; srt_info <- getSRTInfo name srt
232 cl_type = case (null vector, isBigLiveness liveness) of
233 (True, True) -> rET_BIG
234 (True, False) -> rET_SMALL
235 (False, True) -> rET_VEC_BIG
236 (False, False) -> rET_VEC_SMALL
238 (std_info, extra_bits) =
239 mkRetInfoTable info_lbl liveness srt_info cl_type vector
241 ; blks <- cgStmtsToBlocks stmts
242 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
245 args = {- trace "emitReturnTarget: missing args" -} []
246 uniq = getUnique name
247 info_lbl = mkReturnInfoLabel uniq
251 :: CLabel -- info label
252 -> Liveness -- liveness
254 -> Int -- type (eg. rET_SMALL)
255 -> [CmmLit] -- vector
256 -> ([CmmLit],[CmmLit])
257 mkRetInfoTable info_lbl liveness srt_info cl_type vector
258 = (std_info, extra_bits)
260 (srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
262 srt_slot | need_srt = [srt_label]
265 need_srt = needsSRT srt_info || not (null vector)
266 -- If there's a vector table then we must allocate
267 -- an SRT slot, so that the vector table is at a
268 -- known offset from the info pointer
270 liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
271 std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
272 extra_bits = srt_slot ++ map (makeRelativeRefTo info_lbl) vector
275 emitDirectReturnTarget
277 -> CgStmts -- The direct-return code
280 emitDirectReturnTarget name code srt
281 = emitReturnTarget name code [] srt
284 :: Name -- Just for its unique
285 -> [(ConTagZ, CgStmts)] -- Tagged branches
286 -> Maybe CgStmts -- Default branch (if any)
287 -> SRT -- Continuation's SRT
288 -> CtrlReturnConvention
289 -> FCode (CLabel, SemiTaggingStuff)
291 emitAlgReturnTarget name branches mb_deflt srt ret_conv
293 UnvectoredReturn fam_sz -> do
294 { blks <- getCgStmts $
295 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
296 -- NB: tag_expr is zero-based
297 ; lbl <- emitDirectReturnTarget name blks srt
298 ; return (lbl, Nothing) }
299 -- Nothing: the internal branches in the switch don't have
300 -- global labels, so we can't use them at the 'call site'
302 VectoredReturn fam_sz -> do
303 { let tagged_lbls = zip (map fst branches) $
304 map (CmmLabel . mkAltLabel uniq . fst) branches
305 deflt_lbl | isJust mb_deflt = CmmLabel $ mkDefaultLabel uniq
306 | otherwise = mkIntCLit 0
307 ; let vector = [ assocDefault deflt_lbl tagged_lbls i
308 | i <- [0..fam_sz-1]]
309 ; lbl <- emitReturnTarget name noCgStmts vector srt
310 ; mapFCs emit_alt branches
311 ; emit_deflt mb_deflt
312 ; return (lbl, Just (tagged_lbls, deflt_lbl)) }
314 uniq = getUnique name
315 tag_expr = getConstrTag (CmmReg nodeReg)
317 emit_alt :: (Int, CgStmts) -> FCode (Int, CmmLit)
318 -- Emit the code for the alternative as a top-level
319 -- code block returning a label for it
320 emit_alt (tag, stmts) = do { let lbl = mkAltLabel uniq tag
321 ; blks <- cgStmtsToBlocks stmts
322 ; emitProc [] lbl [] blks
323 ; return (tag, CmmLabel lbl) }
325 emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
326 ; blks <- cgStmtsToBlocks stmts
327 ; emitProc [] lbl [] blks
328 ; return (CmmLabel lbl) }
329 emit_deflt Nothing = return (mkIntCLit 0)
330 -- Nothing case: the simplifier might have eliminated a case
331 -- so we may have e.g. case xs of
333 -- In that situation the default should never be taken,
334 -- so we just use a NULL pointer
336 --------------------------------
337 emitDirectReturnInstr :: Code
338 emitDirectReturnInstr
339 = do { info_amode <- getSequelAmode
340 ; stmtC (CmmJump (entryCode info_amode) []) }
342 emitVectoredReturnInstr :: CmmExpr -- _Zero-indexed_ constructor tag
344 emitVectoredReturnInstr zero_indexed_tag
345 = do { info_amode <- getSequelAmode
346 -- HACK! assign info_amode to a temp, because retVec
347 -- uses it twice and the NCG doesn't have any CSE yet.
348 -- Only do this for the NCG, because gcc is too stupid
349 -- to optimise away the extra tmp (grrr).
350 ; dflags <- getDynFlags
351 ; x <- if hscTarget dflags == HscAsm
352 then do z <- newTemp wordRep
353 stmtC (CmmAssign z info_amode)
357 ; let target = retVec x zero_indexed_tag
358 ; stmtC (CmmJump target []) }
361 -------------------------------------------------------------------------
363 -- Generating a standard info table
365 -------------------------------------------------------------------------
367 -- The standard bits of an info table. This part of the info table
368 -- corresponds to the StgInfoTable type defined in InfoTables.h.
370 -- Its shape varies with ticky/profiling/tables next to code etc
371 -- so we can't use constant offsets from Constants
374 :: CmmLit -- closure type descr (profiling)
375 -> CmmLit -- closure descr (profiling)
376 -> Int -- closure type
377 -> StgHalfWord -- SRT length
378 -> CmmLit -- layout field
381 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
382 = -- Parallel revertible-black hole field
384 -- Ticky info (none at present)
385 -- Debug info (none at present)
386 ++ [layout_lit, type_lit]
390 | opt_SccProfilingOn = [type_descr, closure_descr]
393 type_lit = packHalfWordsCLit cl_type srt_len
395 stdInfoTableSizeW :: WordOff
396 -- The size of a standard info table varies with profiling/ticky etc,
397 -- so we can't get it from Constants
398 -- It must vary in sync with mkStdInfoTable
400 = size_fixed + size_prof
402 size_fixed = 2 -- layout, type
403 size_prof | opt_SccProfilingOn = 2
406 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
408 stdSrtBitmapOffset :: ByteOff
409 -- Byte offset of the SRT bitmap half-word which is
410 -- in the *higher-addressed* part of the type_lit
411 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
413 stdClosureTypeOffset :: ByteOff
414 -- Byte offset of the closure type half-word
415 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
417 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
418 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
419 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
421 -------------------------------------------------------------------------
423 -- Accessing fields of an info table
425 -------------------------------------------------------------------------
427 closureInfoPtr :: CmmExpr -> CmmExpr
428 -- Takes a closure pointer and returns the info table pointer
429 closureInfoPtr e = CmmLoad e wordRep
431 entryCode :: CmmExpr -> CmmExpr
432 -- Takes an info pointer (the first word of a closure)
433 -- and returns its entry code
434 entryCode e | tablesNextToCode = e
435 | otherwise = CmmLoad e wordRep
437 getConstrTag :: CmmExpr -> CmmExpr
438 -- Takes a closure pointer, and return the *zero-indexed*
439 -- constructor tag obtained from the info table
440 -- This lives in the SRT field of the info table
441 -- (constructors don't need SRTs).
442 getConstrTag closure_ptr
443 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
445 info_table = infoTable (closureInfoPtr closure_ptr)
447 infoTable :: CmmExpr -> CmmExpr
448 -- Takes an info pointer (the first word of a closure)
449 -- and returns a pointer to the first word of the standard-form
450 -- info table, excluding the entry-code word (if present)
452 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
453 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
455 infoTableConstrTag :: CmmExpr -> CmmExpr
456 -- Takes an info table pointer (from infoTable) and returns the constr tag
457 -- field of the info table (same as the srt_bitmap field)
458 infoTableConstrTag = infoTableSrtBitmap
460 infoTableSrtBitmap :: CmmExpr -> CmmExpr
461 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
462 -- field of the info table
463 infoTableSrtBitmap info_tbl
464 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
466 infoTableClosureType :: CmmExpr -> CmmExpr
467 -- Takes an info table pointer (from infoTable) and returns the closure type
468 -- field of the info table.
469 infoTableClosureType info_tbl
470 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
472 infoTablePtrs :: CmmExpr -> CmmExpr
473 infoTablePtrs info_tbl
474 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
476 infoTableNonPtrs :: CmmExpr -> CmmExpr
477 infoTableNonPtrs info_tbl
478 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
480 funInfoTable :: CmmExpr -> CmmExpr
481 -- Takes the info pointer of a function,
482 -- and returns a pointer to the first word of the StgFunInfoExtra struct
483 -- in the info table.
484 funInfoTable info_ptr
486 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
488 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
489 -- Past the entry code pointer
491 -------------------------------------------------------------------------
493 -- Emit the code for a closure (or return address)
494 -- and its associated info table
496 -------------------------------------------------------------------------
498 -- The complication here concerns whether or not we can
499 -- put the info table next to the code
502 :: CLabel -- Label of info table
503 -> [CmmLit] -- ...its invariant part
504 -> [CmmLit] -- ...and its variant part
505 -> [LocalReg] -- ...args
506 -> [CmmBasicBlock] -- ...and body
509 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
510 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
511 = emitProc (reverse extra_bits ++ std_info)
512 entry_lbl args blocks
513 -- NB: the info_lbl is discarded
515 | null blocks -- No actual code; only the info table is significant
516 = -- Use a zero place-holder in place of the
517 -- entry-label in the info table
518 emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
520 | otherwise -- Separately emit info table (with the function entry
521 = -- point as first entry) and the entry code
522 do { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
523 ; emitProc [] entry_lbl args blocks }
526 entry_lbl = infoLblToEntryLbl info_lbl
528 -------------------------------------------------------------------------
530 -- Static reference tables
532 -------------------------------------------------------------------------
534 -- There is just one SRT for each top level binding; all the nested
535 -- bindings use sub-sections of this SRT. The label is passed down to
536 -- the nested bindings via the monad.
538 getSRTInfo :: Name -> SRT -> FCode C_SRT
539 getSRTInfo id NoSRT = return NoC_SRT
540 getSRTInfo id (SRT off len bmp)
541 | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
542 = do { srt_lbl <- getSRTLabel
543 ; let srt_desc_lbl = mkSRTDescLabel id
544 ; emitRODataLits srt_desc_lbl
545 ( cmmLabelOffW srt_lbl off
546 : mkWordCLit (fromIntegral len)
547 : map mkWordCLit bmp)
548 ; return (C_SRT srt_desc_lbl 0 srt_escape) }
551 = do { srt_lbl <- getSRTLabel
552 ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
553 -- The fromIntegral converts to StgHalfWord
555 srt_escape = (-1) :: StgHalfWord
557 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
558 srtLabelAndLength NoC_SRT _
560 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
561 = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
563 -------------------------------------------------------------------------
565 -- Position independent code
567 -------------------------------------------------------------------------
568 -- In order to support position independent code, we mustn't put absolute
569 -- references into read-only space. Info tables in the tablesNextToCode
570 -- case must be in .text, which is read-only, so we doctor the CmmLits
571 -- to use relative offsets instead.
573 -- Note that this is done even when the -fPIC flag is not specified,
574 -- as we want to keep binary compatibility between PIC and non-PIC.
576 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
578 makeRelativeRefTo info_lbl (CmmLabel lbl)
580 = CmmLabelDiffOff lbl info_lbl 0
581 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
583 = CmmLabelDiffOff lbl info_lbl off
584 makeRelativeRefTo _ lit = lit