1 -----------------------------------------------------------------------------
3 -- Building info tables.
5 -- (c) The University of Glasgow 2004
7 -----------------------------------------------------------------------------
10 emitClosureCodeAndInfoTable,
14 emitDirectReturnTarget, emitAlgReturnTarget,
15 emitDirectReturnInstr, emitVectoredReturnInstr,
19 mkFunGenInfoExtraBits,
20 entryCode, closureInfoPtr,
22 infoTable, infoTableClosureType,
23 infoTablePtrs, infoTableNonPtrs,
29 #include "HsVersions.h"
31 import ClosureInfo ( ClosureInfo, closureTypeDescr, closureName,
32 infoTableLabelFromCI, Liveness,
33 closureValDescr, closureSRT, closureSMRep,
34 closurePtrsSize, closureNonHdrSize, closureFunInfo,
35 C_SRT(..), needsSRT, isConstrClosure_maybe,
37 import SMRep ( StgHalfWord, hALF_WORD_SIZE_IN_BITS, hALF_WORD_SIZE,
39 smRepClosureTypeInt, tablesNextToCode,
40 rET_BIG, rET_SMALL, rET_VEC_BIG, rET_VEC_SMALL )
41 import CgBindery ( getLiveStackSlots )
42 import CgCallConv ( isBigLiveness, mkLivenessCLit, buildContLiveness,
43 argDescrType, getSequelAmode,
44 CtrlReturnConvention(..) )
45 import CgUtils ( mkStringCLit, packHalfWordsCLit, mkWordCLit,
46 cmmOffsetB, cmmOffsetExprW, cmmLabelOffW, cmmOffsetW,
47 emitDataLits, emitRODataLits, emitSwitch, cmmNegate,
51 import CmmUtils ( mkIntCLit, zeroCLit )
52 import Cmm ( CmmStmt(..), CmmExpr(..), CmmLit(..), LocalReg,
53 CmmBasicBlock, nodeReg )
56 import StgSyn ( SRT(..) )
58 import DataCon ( DataCon, dataConTag, fIRST_TAG )
59 import Unique ( Uniquable(..) )
60 import DynFlags ( DynFlags(..), HscTarget(..) )
61 import StaticFlags ( opt_SccProfilingOn )
62 import ListSetOps ( assocDefault )
63 import Maybes ( isJust )
64 import Constants ( wORD_SIZE, sIZEOF_StgFunInfoExtraRev )
68 -------------------------------------------------------------------------
70 -- Generating the info table and code for a closure
72 -------------------------------------------------------------------------
74 -- Here we make a concrete info table, represented as a list of CmmAddr
75 -- (it can't be simply a list of Word, because the SRT field is
76 -- represented by a label+offset expression).
78 -- With tablesNextToCode, the layout is
79 -- <reversed variable part>
80 -- <normal forward StgInfoTable, but without
81 -- an entry point at the front>
84 -- Without tablesNextToCode, the layout of an info table is
86 -- <normal forward rest of StgInfoTable>
87 -- <forward variable part>
89 -- See includes/InfoTables.h
91 emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
92 emitClosureCodeAndInfoTable cl_info args body
93 = do { ty_descr_lit <-
95 then mkStringCLit (closureTypeDescr cl_info)
96 else return (mkIntCLit 0)
99 then mkStringCLit cl_descr_string
100 else return (mkIntCLit 0)
101 ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit
102 cl_type srt_len layout_lit
104 ; blks <- cgStmtsToBlocks body
105 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks }
107 info_lbl = infoTableLabelFromCI cl_info
109 cl_descr_string = closureValDescr cl_info
110 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
112 srt = closureSRT cl_info
113 needs_srt = needsSRT srt
115 mb_con = isConstrClosure_maybe cl_info
116 is_con = isJust mb_con
120 Just con -> -- Constructors don't have an SRT
121 -- We keep the *zero-indexed* tag in the srt_len
122 -- field of the info table.
123 (mkIntCLit 0, fromIntegral (dataConTagZ con))
125 Nothing -> -- Not a constructor
126 srtLabelAndLength srt info_lbl
128 ptrs = closurePtrsSize cl_info
130 size = closureNonHdrSize cl_info
131 layout_lit = packHalfWordsCLit ptrs nptrs
134 | is_fun = fun_extra_bits
136 | needs_srt = [srt_label]
139 maybe_fun_stuff = closureFunInfo cl_info
140 is_fun = isJust maybe_fun_stuff
141 (Just (arity, arg_descr)) = maybe_fun_stuff
144 | ArgGen liveness <- arg_descr
147 makeRelativeRefTo info_lbl $ mkLivenessCLit liveness,
149 | needs_srt = [fun_amode, srt_label]
150 | otherwise = [fun_amode]
152 slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
153 slow_entry_label = mkSlowEntryLabel (closureName cl_info)
155 fun_amode = packHalfWordsCLit fun_type arity
156 fun_type = argDescrType arg_descr
158 -- We keep the *zero-indexed* tag in the srt_len field of the info
159 -- table of a data constructor.
160 dataConTagZ :: DataCon -> ConTagZ
161 dataConTagZ con = dataConTag con - fIRST_TAG
163 -- A low-level way to generate the variable part of a fun-style info table.
164 -- (must match fun_extra_bits above). Used by the C-- parser.
165 mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
166 mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
167 = [ packHalfWordsCLit fun_type arity,
172 -------------------------------------------------------------------------
174 -- Generating the info table and code for a return point
176 -------------------------------------------------------------------------
178 -- Here's the layout of a return-point info table
180 -- Tables next to code:
182 -- <reversed vector table>
184 -- <standard info table>
185 -- ret-addr --> <entry code (if any)>
187 -- Not tables-next-to-code:
189 -- ret-addr --> <ptr to entry code>
190 -- <standard info table>
192 -- <forward vector table>
194 -- * The vector table is only present for vectored returns
196 -- * The SRT slot is only there if either
197 -- (a) there is SRT info to record, OR
198 -- (b) if the return is vectored
199 -- The latter (b) is necessary so that the vector is in a
202 vectorSlot :: CmmExpr -> CmmExpr -> CmmExpr
203 -- Get the vector slot from the info pointer
204 vectorSlot info_amode zero_indexed_tag
206 = cmmOffsetExprW (cmmOffsetW info_amode (- (stdInfoTableSizeW + 2)))
207 (cmmNegate zero_indexed_tag)
208 -- The "2" is one for the SRT slot, and one more
209 -- to get to the first word of the vector
212 = cmmOffsetExprW (cmmOffsetW info_amode (stdInfoTableSizeW + 2))
214 -- The "2" is one for the entry-code slot and one for the SRT slot
216 retVec :: CmmExpr -> CmmExpr -> CmmExpr
217 -- Get a return vector from the info pointer
218 retVec info_amode zero_indexed_tag
219 = let slot = vectorSlot info_amode zero_indexed_tag
220 #ifdef x86_64_TARGET_ARCH
221 tableEntry = CmmMachOp (MO_S_Conv I32 I64) [CmmLoad slot I32]
222 -- offsets are 32-bits on x86-64, due to the inability of
223 -- the tools to handle 64-bit PC-relative relocations. See also
224 -- PprMach.pprDataItem, and InfoTables.h:OFFSET_FIELD().
226 tableEntry = CmmLoad slot wordRep
228 in if tablesNextToCode
229 then CmmMachOp (MO_Add wordRep) [tableEntry, info_amode]
234 -> CgStmts -- The direct-return code (if any)
235 -- (empty for vectored returns)
236 -> [CmmLit] -- Vector of return points
237 -- (empty for non-vectored returns)
240 emitReturnTarget name stmts vector srt
241 = do { live_slots <- getLiveStackSlots
242 ; liveness <- buildContLiveness name live_slots
243 ; srt_info <- getSRTInfo name srt
246 cl_type = case (null vector, isBigLiveness liveness) of
247 (True, True) -> rET_BIG
248 (True, False) -> rET_SMALL
249 (False, True) -> rET_VEC_BIG
250 (False, False) -> rET_VEC_SMALL
252 (std_info, extra_bits) =
253 mkRetInfoTable info_lbl liveness srt_info cl_type vector
255 ; blks <- cgStmtsToBlocks stmts
256 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
259 args = {- trace "emitReturnTarget: missing args" -} []
260 uniq = getUnique name
261 info_lbl = mkReturnInfoLabel uniq
265 :: CLabel -- info label
266 -> Liveness -- liveness
268 -> Int -- type (eg. rET_SMALL)
269 -> [CmmLit] -- vector
270 -> ([CmmLit],[CmmLit])
271 mkRetInfoTable info_lbl liveness srt_info cl_type vector
272 = (std_info, extra_bits)
274 (srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
276 srt_slot | need_srt = [srt_label]
279 need_srt = needsSRT srt_info || not (null vector)
280 -- If there's a vector table then we must allocate
281 -- an SRT slot, so that the vector table is at a
282 -- known offset from the info pointer
284 liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
285 std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
286 extra_bits = srt_slot ++ map (makeRelativeRefTo info_lbl) vector
289 emitDirectReturnTarget
291 -> CgStmts -- The direct-return code
294 emitDirectReturnTarget name code srt
295 = emitReturnTarget name code [] srt
298 :: Name -- Just for its unique
299 -> [(ConTagZ, CgStmts)] -- Tagged branches
300 -> Maybe CgStmts -- Default branch (if any)
301 -> SRT -- Continuation's SRT
302 -> CtrlReturnConvention
303 -> FCode (CLabel, SemiTaggingStuff)
305 emitAlgReturnTarget name branches mb_deflt srt ret_conv
307 UnvectoredReturn fam_sz -> do
308 { blks <- getCgStmts $
309 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
310 -- NB: tag_expr is zero-based
311 ; lbl <- emitDirectReturnTarget name blks srt
312 ; return (lbl, Nothing) }
313 -- Nothing: the internal branches in the switch don't have
314 -- global labels, so we can't use them at the 'call site'
316 VectoredReturn fam_sz -> do
317 { let tagged_lbls = zip (map fst branches) $
318 map (CmmLabel . mkAltLabel uniq . fst) branches
319 deflt_lbl | isJust mb_deflt = CmmLabel $ mkDefaultLabel uniq
320 | otherwise = mkIntCLit 0
321 ; let vector = [ assocDefault deflt_lbl tagged_lbls i
322 | i <- [0..fam_sz-1]]
323 ; lbl <- emitReturnTarget name noCgStmts vector srt
324 ; mapFCs emit_alt branches
325 ; emit_deflt mb_deflt
326 ; return (lbl, Just (tagged_lbls, deflt_lbl)) }
328 uniq = getUnique name
329 tag_expr = getConstrTag (CmmReg nodeReg)
331 emit_alt :: (Int, CgStmts) -> FCode (Int, CmmLit)
332 -- Emit the code for the alternative as a top-level
333 -- code block returning a label for it
334 emit_alt (tag, stmts) = do { let lbl = mkAltLabel uniq tag
335 ; blks <- cgStmtsToBlocks stmts
336 ; emitProc [] lbl [] blks
337 ; return (tag, CmmLabel lbl) }
339 emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
340 ; blks <- cgStmtsToBlocks stmts
341 ; emitProc [] lbl [] blks
342 ; return (CmmLabel lbl) }
343 emit_deflt Nothing = return (mkIntCLit 0)
344 -- Nothing case: the simplifier might have eliminated a case
345 -- so we may have e.g. case xs of
347 -- In that situation the default should never be taken,
348 -- so we just use a NULL pointer
350 --------------------------------
351 emitDirectReturnInstr :: Code
352 emitDirectReturnInstr
353 = do { info_amode <- getSequelAmode
354 ; stmtC (CmmJump (entryCode info_amode) []) }
356 emitVectoredReturnInstr :: CmmExpr -- _Zero-indexed_ constructor tag
358 emitVectoredReturnInstr zero_indexed_tag
359 = do { info_amode <- getSequelAmode
360 -- HACK! assign info_amode to a temp, because retVec
361 -- uses it twice and the NCG doesn't have any CSE yet.
362 -- Only do this for the NCG, because gcc is too stupid
363 -- to optimise away the extra tmp (grrr).
364 ; dflags <- getDynFlags
365 ; x <- if hscTarget dflags == HscAsm
366 then do z <- newTemp wordRep
367 stmtC (CmmAssign z info_amode)
371 ; let target = retVec x zero_indexed_tag
372 ; stmtC (CmmJump target []) }
375 -------------------------------------------------------------------------
377 -- Generating a standard info table
379 -------------------------------------------------------------------------
381 -- The standard bits of an info table. This part of the info table
382 -- corresponds to the StgInfoTable type defined in InfoTables.h.
384 -- Its shape varies with ticky/profiling/tables next to code etc
385 -- so we can't use constant offsets from Constants
388 :: CmmLit -- closure type descr (profiling)
389 -> CmmLit -- closure descr (profiling)
390 -> Int -- closure type
391 -> StgHalfWord -- SRT length
392 -> CmmLit -- layout field
395 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
396 = -- Parallel revertible-black hole field
398 -- Ticky info (none at present)
399 -- Debug info (none at present)
400 ++ [layout_lit, type_lit]
404 | opt_SccProfilingOn = [type_descr, closure_descr]
407 type_lit = packHalfWordsCLit cl_type srt_len
409 stdInfoTableSizeW :: WordOff
410 -- The size of a standard info table varies with profiling/ticky etc,
411 -- so we can't get it from Constants
412 -- It must vary in sync with mkStdInfoTable
414 = size_fixed + size_prof
416 size_fixed = 2 -- layout, type
417 size_prof | opt_SccProfilingOn = 2
420 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
422 stdSrtBitmapOffset :: ByteOff
423 -- Byte offset of the SRT bitmap half-word which is
424 -- in the *higher-addressed* part of the type_lit
425 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
427 stdClosureTypeOffset :: ByteOff
428 -- Byte offset of the closure type half-word
429 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
431 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
432 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
433 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
435 -------------------------------------------------------------------------
437 -- Accessing fields of an info table
439 -------------------------------------------------------------------------
441 closureInfoPtr :: CmmExpr -> CmmExpr
442 -- Takes a closure pointer and returns the info table pointer
443 closureInfoPtr e = CmmLoad e wordRep
445 entryCode :: CmmExpr -> CmmExpr
446 -- Takes an info pointer (the first word of a closure)
447 -- and returns its entry code
448 entryCode e | tablesNextToCode = e
449 | otherwise = CmmLoad e wordRep
451 getConstrTag :: CmmExpr -> CmmExpr
452 -- Takes a closure pointer, and return the *zero-indexed*
453 -- constructor tag obtained from the info table
454 -- This lives in the SRT field of the info table
455 -- (constructors don't need SRTs).
456 getConstrTag closure_ptr
457 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
459 info_table = infoTable (closureInfoPtr closure_ptr)
461 infoTable :: CmmExpr -> CmmExpr
462 -- Takes an info pointer (the first word of a closure)
463 -- and returns a pointer to the first word of the standard-form
464 -- info table, excluding the entry-code word (if present)
466 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
467 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
469 infoTableConstrTag :: CmmExpr -> CmmExpr
470 -- Takes an info table pointer (from infoTable) and returns the constr tag
471 -- field of the info table (same as the srt_bitmap field)
472 infoTableConstrTag = infoTableSrtBitmap
474 infoTableSrtBitmap :: CmmExpr -> CmmExpr
475 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
476 -- field of the info table
477 infoTableSrtBitmap info_tbl
478 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
480 infoTableClosureType :: CmmExpr -> CmmExpr
481 -- Takes an info table pointer (from infoTable) and returns the closure type
482 -- field of the info table.
483 infoTableClosureType info_tbl
484 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
486 infoTablePtrs :: CmmExpr -> CmmExpr
487 infoTablePtrs info_tbl
488 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
490 infoTableNonPtrs :: CmmExpr -> CmmExpr
491 infoTableNonPtrs info_tbl
492 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
494 funInfoTable :: CmmExpr -> CmmExpr
495 -- Takes the info pointer of a function,
496 -- and returns a pointer to the first word of the StgFunInfoExtra struct
497 -- in the info table.
498 funInfoTable info_ptr
500 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
502 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
503 -- Past the entry code pointer
505 -------------------------------------------------------------------------
507 -- Emit the code for a closure (or return address)
508 -- and its associated info table
510 -------------------------------------------------------------------------
512 -- The complication here concerns whether or not we can
513 -- put the info table next to the code
516 :: CLabel -- Label of info table
517 -> [CmmLit] -- ...its invariant part
518 -> [CmmLit] -- ...and its variant part
519 -> [LocalReg] -- ...args
520 -> [CmmBasicBlock] -- ...and body
523 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
524 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
525 = emitProc (reverse extra_bits ++ std_info)
526 entry_lbl args blocks
527 -- NB: the info_lbl is discarded
529 | null blocks -- No actual code; only the info table is significant
530 = -- Use a zero place-holder in place of the
531 -- entry-label in the info table
532 emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
534 | otherwise -- Separately emit info table (with the function entry
535 = -- point as first entry) and the entry code
536 do { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
537 ; emitProc [] entry_lbl args blocks }
540 entry_lbl = infoLblToEntryLbl info_lbl
542 -------------------------------------------------------------------------
544 -- Static reference tables
546 -------------------------------------------------------------------------
548 -- There is just one SRT for each top level binding; all the nested
549 -- bindings use sub-sections of this SRT. The label is passed down to
550 -- the nested bindings via the monad.
552 getSRTInfo :: Name -> SRT -> FCode C_SRT
553 getSRTInfo id NoSRT = return NoC_SRT
554 getSRTInfo id (SRT off len bmp)
555 | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
556 = do { srt_lbl <- getSRTLabel
557 ; let srt_desc_lbl = mkSRTDescLabel id
558 ; emitRODataLits srt_desc_lbl
559 ( cmmLabelOffW srt_lbl off
560 : mkWordCLit (fromIntegral len)
561 : map mkWordCLit bmp)
562 ; return (C_SRT srt_desc_lbl 0 srt_escape) }
565 = do { srt_lbl <- getSRTLabel
566 ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
567 -- The fromIntegral converts to StgHalfWord
569 srt_escape = (-1) :: StgHalfWord
571 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
572 srtLabelAndLength NoC_SRT _
574 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
575 = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
577 -------------------------------------------------------------------------
579 -- Position independent code
581 -------------------------------------------------------------------------
582 -- In order to support position independent code, we mustn't put absolute
583 -- references into read-only space. Info tables in the tablesNextToCode
584 -- case must be in .text, which is read-only, so we doctor the CmmLits
585 -- to use relative offsets instead.
587 -- Note that this is done even when the -fPIC flag is not specified,
588 -- as we want to keep binary compatibility between PIC and non-PIC.
590 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
592 makeRelativeRefTo info_lbl (CmmLabel lbl)
594 = CmmLabelDiffOff lbl info_lbl 0
595 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
597 = CmmLabelDiffOff lbl info_lbl off
598 makeRelativeRefTo _ lit = lit