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 )
50 import CmmUtils ( mkIntCLit, zeroCLit )
51 import Cmm ( CmmStmt(..), CmmExpr(..), CmmLit(..), LocalReg,
52 CmmBasicBlock, nodeReg )
53 import MachOp ( MachOp(..), wordRep, halfWordRep )
55 import StgSyn ( SRT(..) )
57 import DataCon ( DataCon, dataConTag, fIRST_TAG )
58 import Unique ( Uniquable(..) )
59 import CmdLineOpts ( opt_SccProfilingOn )
60 import ListSetOps ( assocDefault )
61 import Maybes ( isJust )
62 import Constants ( wORD_SIZE, sIZEOF_StgFunInfoExtraRev )
66 -------------------------------------------------------------------------
68 -- Generating the info table and code for a closure
70 -------------------------------------------------------------------------
72 -- Here we make a concrete info table, represented as a list of CmmAddr
73 -- (it can't be simply a list of Word, because the SRT field is
74 -- represented by a label+offset expression).
76 -- With tablesNextToCode, the layout is
77 -- <reversed variable part>
78 -- <normal forward StgInfoTable, but without
79 -- an entry point at the front>
82 -- Without tablesNextToCode, the layout of an info table is
84 -- <normal forward rest of StgInfoTable>
85 -- <forward variable part>
87 -- See includes/InfoTables.h
89 emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
90 emitClosureCodeAndInfoTable cl_info args body
91 = do { ty_descr_lit <-
93 then mkStringCLit (closureTypeDescr cl_info)
94 else return (mkIntCLit 0)
97 then mkStringCLit cl_descr_string
98 else return (mkIntCLit 0)
99 ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit
100 cl_type srt_len layout_lit
102 ; blks <- cgStmtsToBlocks body
103 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks }
105 info_lbl = infoTableLabelFromCI cl_info
107 cl_descr_string = closureValDescr cl_info
108 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
110 srt = closureSRT cl_info
111 needs_srt = needsSRT srt
113 mb_con = isConstrClosure_maybe cl_info
114 is_con = isJust mb_con
118 Just con -> -- Constructors don't have an SRT
119 -- We keep the *zero-indexed* tag in the srt_len
120 -- field of the info table.
121 (mkIntCLit 0, fromIntegral (dataConTagZ con))
123 Nothing -> -- Not a constructor
124 srtLabelAndLength srt info_lbl
126 ptrs = closurePtrsSize cl_info
128 size = closureNonHdrSize cl_info
129 layout_lit = packHalfWordsCLit ptrs nptrs
132 | is_fun = fun_extra_bits
134 | needs_srt = [srt_label]
137 maybe_fun_stuff = closureFunInfo cl_info
138 is_fun = isJust maybe_fun_stuff
139 (Just (arity, arg_descr)) = maybe_fun_stuff
142 | ArgGen liveness <- arg_descr
145 makeRelativeRefTo info_lbl $ mkLivenessCLit liveness,
147 | needs_srt = [fun_amode, srt_label]
148 | otherwise = [fun_amode]
150 slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
151 slow_entry_label = mkSlowEntryLabel (closureName cl_info)
153 fun_amode = packHalfWordsCLit fun_type arity
154 fun_type = argDescrType arg_descr
156 -- We keep the *zero-indexed* tag in the srt_len field of the info
157 -- table of a data constructor.
158 dataConTagZ :: DataCon -> ConTagZ
159 dataConTagZ con = dataConTag con - fIRST_TAG
161 -- A low-level way to generate the variable part of a fun-style info table.
162 -- (must match fun_extra_bits above). Used by the C-- parser.
163 mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
164 mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
165 = [ packHalfWordsCLit fun_type arity,
170 -------------------------------------------------------------------------
172 -- Generating the info table and code for a return point
174 -------------------------------------------------------------------------
176 -- Here's the layout of a return-point info table
178 -- Tables next to code:
180 -- <reversed vector table>
182 -- <standard info table>
183 -- ret-addr --> <entry code (if any)>
185 -- Not tables-next-to-code:
187 -- ret-addr --> <ptr to entry code>
188 -- <standard info table>
190 -- <forward vector table>
192 -- * The vector table is only present for vectored returns
194 -- * The SRT slot is only there if either
195 -- (a) there is SRT info to record, OR
196 -- (b) if the return is vectored
197 -- The latter (b) is necessary so that the vector is in a
200 vectorSlot :: CmmExpr -> CmmExpr -> CmmExpr
201 -- Get the vector slot from the info pointer
202 vectorSlot info_amode zero_indexed_tag
204 = cmmOffsetExprW (cmmOffsetW info_amode (- (stdInfoTableSizeW + 2)))
205 (cmmNegate zero_indexed_tag)
206 -- The "2" is one for the SRT slot, and one more
207 -- to get to the first word of the vector
210 = cmmOffsetExprW (cmmOffsetW info_amode (stdInfoTableSizeW + 2))
212 -- The "2" is one for the entry-code slot and one for the SRT slot
214 retVec :: CmmExpr -> CmmExpr -> CmmExpr
215 -- Get a return vector from the info pointer
216 retVec info_amode zero_indexed_tag
217 = let slot = vectorSlot info_amode zero_indexed_tag
218 tableEntry = CmmLoad slot wordRep
219 in if tablesNextToCode
220 then CmmMachOp (MO_Add wordRep) [tableEntry, info_amode]
225 -> CgStmts -- The direct-return code (if any)
226 -- (empty for vectored returns)
227 -> [CmmLit] -- Vector of return points
228 -- (empty for non-vectored returns)
231 emitReturnTarget name stmts vector srt
232 = do { live_slots <- getLiveStackSlots
233 ; liveness <- buildContLiveness name live_slots
234 ; srt_info <- getSRTInfo name srt
237 cl_type = case (null vector, isBigLiveness liveness) of
238 (True, True) -> rET_BIG
239 (True, False) -> rET_SMALL
240 (False, True) -> rET_VEC_BIG
241 (False, False) -> rET_VEC_SMALL
243 (std_info, extra_bits) =
244 mkRetInfoTable info_lbl liveness srt_info cl_type vector
246 ; blks <- cgStmtsToBlocks stmts
247 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
250 args = trace "emitReturnTarget: missing args" []
251 uniq = getUnique name
252 info_lbl = mkReturnInfoLabel uniq
256 :: CLabel -- info label
257 -> Liveness -- liveness
259 -> Int -- type (eg. rET_SMALL)
260 -> [CmmLit] -- vector
261 -> ([CmmLit],[CmmLit])
262 mkRetInfoTable info_lbl liveness srt_info cl_type vector
263 = (std_info, extra_bits)
265 (srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
267 srt_slot | need_srt = [srt_label]
270 need_srt = needsSRT srt_info || not (null vector)
271 -- If there's a vector table then we must allocate
272 -- an SRT slot, so that the vector table is at a
273 -- known offset from the info pointer
275 liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
276 std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
277 extra_bits = srt_slot ++ map (makeRelativeRefTo info_lbl) vector
280 emitDirectReturnTarget
282 -> CgStmts -- The direct-return code
285 emitDirectReturnTarget name code srt
286 = emitReturnTarget name code [] srt
289 :: Name -- Just for its unique
290 -> [(ConTagZ, CgStmts)] -- Tagged branches
291 -> Maybe CgStmts -- Default branch (if any)
292 -> SRT -- Continuation's SRT
293 -> CtrlReturnConvention
294 -> FCode (CLabel, SemiTaggingStuff)
296 emitAlgReturnTarget name branches mb_deflt srt ret_conv
298 UnvectoredReturn fam_sz -> do
299 { blks <- getCgStmts $
300 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
301 -- NB: tag_expr is zero-based
302 ; lbl <- emitDirectReturnTarget name blks srt
303 ; return (lbl, Nothing) }
304 -- Nothing: the internal branches in the switch don't have
305 -- global labels, so we can't use them at the 'call site'
307 VectoredReturn fam_sz -> do
308 { let tagged_lbls = zip (map fst branches) $
309 map (CmmLabel . mkAltLabel uniq . fst) branches
310 deflt_lbl | isJust mb_deflt = CmmLabel $ mkDefaultLabel uniq
311 | otherwise = mkIntCLit 0
312 ; let vector = [ assocDefault deflt_lbl tagged_lbls i
313 | i <- [0..fam_sz-1]]
314 ; lbl <- emitReturnTarget name noCgStmts vector srt
315 ; mapFCs emit_alt branches
316 ; emit_deflt mb_deflt
317 ; return (lbl, Just (tagged_lbls, deflt_lbl)) }
319 uniq = getUnique name
320 tag_expr = getConstrTag (CmmReg nodeReg)
322 emit_alt :: (Int, CgStmts) -> FCode (Int, CmmLit)
323 -- Emit the code for the alternative as a top-level
324 -- code block returning a label for it
325 emit_alt (tag, stmts) = do { let lbl = mkAltLabel uniq tag
326 ; blks <- cgStmtsToBlocks stmts
327 ; emitProc [] lbl [] blks
328 ; return (tag, CmmLabel lbl) }
330 emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
331 ; blks <- cgStmtsToBlocks stmts
332 ; emitProc [] lbl [] blks
333 ; return (CmmLabel lbl) }
334 emit_deflt Nothing = return (mkIntCLit 0)
335 -- Nothing case: the simplifier might have eliminated a case
336 -- so we may have e.g. case xs of
338 -- In that situation the default should never be taken,
339 -- so we just use a NULL pointer
341 --------------------------------
342 emitDirectReturnInstr :: Code
343 emitDirectReturnInstr
344 = do { info_amode <- getSequelAmode
345 ; stmtC (CmmJump (entryCode info_amode) []) }
347 emitVectoredReturnInstr :: CmmExpr -- *Zero-indexed* constructor tag
349 emitVectoredReturnInstr zero_indexed_tag
350 = do { info_amode <- getSequelAmode
351 ; let target = retVec info_amode zero_indexed_tag
352 ; stmtC (CmmJump target []) }
355 -------------------------------------------------------------------------
357 -- Generating a standard info table
359 -------------------------------------------------------------------------
361 -- The standard bits of an info table. This part of the info table
362 -- corresponds to the StgInfoTable type defined in InfoTables.h.
364 -- Its shape varies with ticky/profiling/tables next to code etc
365 -- so we can't use constant offsets from Constants
368 :: CmmLit -- closure type descr (profiling)
369 -> CmmLit -- closure descr (profiling)
370 -> Int -- closure type
371 -> StgHalfWord -- SRT length
372 -> CmmLit -- layout field
375 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
376 = -- Parallel revertible-black hole field
378 -- Ticky info (none at present)
379 -- Debug info (none at present)
380 ++ [layout_lit, type_lit]
384 | opt_SccProfilingOn = [closure_descr, type_descr]
387 type_lit = packHalfWordsCLit cl_type srt_len
389 stdInfoTableSizeW :: WordOff
390 -- The size of a standard info table varies with profiling/ticky etc,
391 -- so we can't get it from Constants
392 -- It must vary in sync with mkStdInfoTable
394 = size_fixed + size_prof
396 size_fixed = 2 -- layout, type
397 size_prof | opt_SccProfilingOn = 2
400 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
402 stdSrtBitmapOffset :: ByteOff
403 -- Byte offset of the SRT bitmap half-word which is
404 -- in the *higher-addressed* part of the type_lit
405 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
407 stdClosureTypeOffset :: ByteOff
408 -- Byte offset of the closure type half-word
409 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
411 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
412 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
413 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
415 -------------------------------------------------------------------------
417 -- Accessing fields of an info table
419 -------------------------------------------------------------------------
421 closureInfoPtr :: CmmExpr -> CmmExpr
422 -- Takes a closure pointer and returns the info table pointer
423 closureInfoPtr e = CmmLoad e wordRep
425 entryCode :: CmmExpr -> CmmExpr
426 -- Takes an info pointer (the first word of a closure)
427 -- and returns its entry code
428 entryCode e | tablesNextToCode = e
429 | otherwise = CmmLoad e wordRep
431 getConstrTag :: CmmExpr -> CmmExpr
432 -- Takes a closure pointer, and return the *zero-indexed*
433 -- constructor tag obtained from the info table
434 -- This lives in the SRT field of the info table
435 -- (constructors don't need SRTs).
436 getConstrTag closure_ptr
437 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
439 info_table = infoTable (closureInfoPtr closure_ptr)
441 infoTable :: CmmExpr -> CmmExpr
442 -- Takes an info pointer (the first word of a closure)
443 -- and returns a pointer to the first word of the standard-form
444 -- info table, excluding the entry-code word (if present)
446 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
447 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
449 infoTableConstrTag :: CmmExpr -> CmmExpr
450 -- Takes an info table pointer (from infoTable) and returns the constr tag
451 -- field of the info table (same as the srt_bitmap field)
452 infoTableConstrTag = infoTableSrtBitmap
454 infoTableSrtBitmap :: CmmExpr -> CmmExpr
455 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
456 -- field of the info table
457 infoTableSrtBitmap info_tbl
458 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
460 infoTableClosureType :: CmmExpr -> CmmExpr
461 -- Takes an info table pointer (from infoTable) and returns the closure type
462 -- field of the info table.
463 infoTableClosureType info_tbl
464 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
466 infoTablePtrs :: CmmExpr -> CmmExpr
467 infoTablePtrs info_tbl
468 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
470 infoTableNonPtrs :: CmmExpr -> CmmExpr
471 infoTableNonPtrs info_tbl
472 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
474 funInfoTable :: CmmExpr -> CmmExpr
475 -- Takes the info pointer of a function,
476 -- and returns a pointer to the first word of the StgFunInfoExtra struct
477 -- in the info table.
478 funInfoTable info_ptr
480 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
482 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
483 -- Past the entry code pointer
485 -------------------------------------------------------------------------
487 -- Emit the code for a closure (or return address)
488 -- and its associated info table
490 -------------------------------------------------------------------------
492 -- The complication here concerns whether or not we can
493 -- put the info table next to the code
496 :: CLabel -- Label of info table
497 -> [CmmLit] -- ...its invariant part
498 -> [CmmLit] -- ...and its variant part
499 -> [LocalReg] -- ...args
500 -> [CmmBasicBlock] -- ...and body
503 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
504 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
505 = emitProc (reverse extra_bits ++ std_info)
506 entry_lbl args blocks
507 -- NB: the info_lbl is discarded
509 | null blocks -- No actual code; only the info table is significant
510 = -- Use a zero place-holder in place of the
511 -- entry-label in the info table
512 emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
514 | otherwise -- Separately emit info table (with the function entry
515 = -- point as first entry) and the entry code
516 do { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
517 ; emitProc [] entry_lbl args blocks }
520 entry_lbl = infoLblToEntryLbl info_lbl
522 -------------------------------------------------------------------------
524 -- Static reference tables
526 -------------------------------------------------------------------------
528 -- There is just one SRT for each top level binding; all the nested
529 -- bindings use sub-sections of this SRT. The label is passed down to
530 -- the nested bindings via the monad.
532 getSRTInfo :: Name -> SRT -> FCode C_SRT
533 getSRTInfo id NoSRT = return NoC_SRT
534 getSRTInfo id (SRT off len bmp)
535 | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
536 = do { srt_lbl <- getSRTLabel
537 ; let srt_desc_lbl = mkSRTDescLabel id
538 ; emitRODataLits srt_desc_lbl
539 ( cmmLabelOffW srt_lbl off
540 : mkWordCLit (fromIntegral len)
541 : map mkWordCLit bmp)
542 ; return (C_SRT srt_desc_lbl 0 srt_escape) }
545 = do { srt_lbl <- getSRTLabel
546 ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
547 -- The fromIntegral converts to StgHalfWord
549 srt_escape = (-1) :: StgHalfWord
551 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
552 srtLabelAndLength NoC_SRT _
554 srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
555 = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
557 -------------------------------------------------------------------------
559 -- Position independent code
561 -------------------------------------------------------------------------
562 -- In order to support position independent code, we mustn't put absolute
563 -- references into read-only space. Info tables in the tablesNextToCode
564 -- case must be in .text, which is read-only, so we doctor the CmmLits
565 -- to use relative offsets instead.
567 -- Note that this is done even when the -fPIC flag is not specified,
568 -- as we want to keep binary compatibility between PIC and non-PIC.
570 makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
572 makeRelativeRefTo info_lbl (CmmLabel lbl)
574 = CmmLabelDiffOff lbl info_lbl 0
575 makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
577 = CmmLabelDiffOff lbl info_lbl off
578 makeRelativeRefTo _ lit = lit