1 -----------------------------------------------------------------------------
3 -- Building info tables.
5 -- (c) The University of Glasgow 2004
7 -----------------------------------------------------------------------------
10 emitClosureCodeAndInfoTable,
14 emitDirectReturnTarget, emitAlgReturnTarget,
15 emitDirectReturnInstr, emitVectoredReturnInstr,
18 mkFunGenInfoExtraBits,
19 entryCode, closureInfoPtr,
21 infoTable, infoTableClosureType,
22 infoTablePtrs, infoTableNonPtrs,
28 #include "HsVersions.h"
30 import ClosureInfo ( ClosureInfo, closureTypeDescr, closureName,
31 infoTableLabelFromCI, Liveness,
32 closureValDescr, closureSRT, closureSMRep,
33 closurePtrsSize, closureNonHdrSize, closureFunInfo,
34 C_SRT(..), needsSRT, isConstrClosure_maybe,
36 import SMRep ( StgHalfWord, hALF_WORD_SIZE_IN_BITS, hALF_WORD_SIZE,
38 smRepClosureTypeInt, tablesNextToCode,
39 rET_BIG, rET_SMALL, rET_VEC_BIG, rET_VEC_SMALL )
40 import CgBindery ( getLiveStackSlots )
41 import CgCallConv ( isBigLiveness, mkLivenessCLit, buildContLiveness,
42 argDescrType, getSequelAmode,
43 CtrlReturnConvention(..) )
44 import CgUtils ( mkStringCLit, packHalfWordsCLit, mkWordCLit,
45 cmmOffsetB, cmmOffsetExprW, cmmLabelOffW, cmmOffsetW,
46 emitDataLits, emitRODataLits, emitSwitch, cmmNegate )
49 import CmmUtils ( mkIntCLit, zeroCLit )
50 import Cmm ( CmmStmt(..), CmmExpr(..), CmmLit(..), LocalReg,
51 CmmBasicBlock, nodeReg )
52 import MachOp ( MachOp(..), wordRep, halfWordRep )
54 import StgSyn ( SRT(..) )
56 import DataCon ( DataCon, dataConTag, fIRST_TAG )
57 import Unique ( Uniquable(..) )
58 import CmdLineOpts ( opt_SccProfilingOn )
59 import ListSetOps ( assocDefault )
60 import Maybes ( isJust )
61 import Constants ( wORD_SIZE, sIZEOF_StgFunInfoExtraRev )
65 -------------------------------------------------------------------------
67 -- Generating the info table and code for a closure
69 -------------------------------------------------------------------------
71 -- Here we make a concrete info table, represented as a list of CmmAddr
72 -- (it can't be simply a list of Word, because the SRT field is
73 -- represented by a label+offset expression).
75 -- With tablesNextToCode, the layout is
76 -- <reversed variable part>
77 -- <normal forward StgInfoTable, but without
78 -- an entry point at the front>
81 -- Without tablesNextToCode, the layout of an info table is
83 -- <normal forward rest of StgInfoTable>
84 -- <forward variable part>
86 -- See includes/InfoTables.h
88 emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
89 emitClosureCodeAndInfoTable cl_info args body
90 = do { ty_descr_lit <-
92 then mkStringCLit (closureTypeDescr cl_info)
93 else return (mkIntCLit 0)
96 then mkStringCLit cl_descr_string
97 else return (mkIntCLit 0)
98 ; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit
99 cl_type srt_len layout_lit
101 ; blks <- cgStmtsToBlocks body
102 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks }
104 info_lbl = infoTableLabelFromCI cl_info
106 cl_descr_string = closureValDescr cl_info
107 cl_type = smRepClosureTypeInt (closureSMRep cl_info)
109 srt = closureSRT cl_info
110 needs_srt = needsSRT srt
112 mb_con = isConstrClosure_maybe cl_info
113 is_con = isJust mb_con
117 Just con -> -- Constructors don't have an SRT
118 -- We keep the *zero-indexed* tag in the srt_len
119 -- field of the info table.
120 (mkIntCLit 0, fromIntegral (dataConTagZ con))
122 Nothing -> -- Not a constructor
123 srtLabelAndLength srt
125 ptrs = closurePtrsSize cl_info
127 size = closureNonHdrSize cl_info
128 layout_lit = packHalfWordsCLit ptrs nptrs
131 | is_fun = fun_extra_bits
133 | needs_srt = [srt_label]
136 maybe_fun_stuff = closureFunInfo cl_info
137 is_fun = isJust maybe_fun_stuff
138 (Just (arity, arg_descr)) = maybe_fun_stuff
141 | ArgGen liveness <- arg_descr
144 mkLivenessCLit liveness,
145 CmmLabel (mkSlowEntryLabel (closureName cl_info)) ]
146 | needs_srt = [fun_amode, srt_label]
147 | otherwise = [fun_amode]
149 fun_amode = packHalfWordsCLit fun_type arity
150 fun_type = argDescrType arg_descr
152 -- We keep the *zero-indexed* tag in the srt_len field of the info
153 -- table of a data constructor.
154 dataConTagZ :: DataCon -> ConTagZ
155 dataConTagZ con = dataConTag con - fIRST_TAG
157 -- A low-level way to generate the variable part of a fun-style info table.
158 -- (must match fun_extra_bits above). Used by the C-- parser.
159 mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
160 mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
161 = [ packHalfWordsCLit fun_type arity,
166 -------------------------------------------------------------------------
168 -- Generating the info table and code for a return point
170 -------------------------------------------------------------------------
172 -- Here's the layout of a return-point info table
174 -- Tables next to code:
176 -- <reversed vector table>
178 -- <standard info table>
179 -- ret-addr --> <entry code (if any)>
181 -- Not tables-next-to-code:
183 -- ret-addr --> <ptr to entry code>
184 -- <standard info table>
186 -- <forward vector table>
188 -- * The vector table is only present for vectored returns
190 -- * The SRT slot is only there if either
191 -- (a) there is SRT info to record, OR
192 -- (b) if the return is vectored
193 -- The latter (b) is necessary so that the vector is in a
196 vectorSlot :: CmmExpr -> CmmExpr -> CmmExpr
197 -- Get the vector slot from the info pointer
198 vectorSlot info_amode zero_indexed_tag
200 = cmmOffsetExprW (cmmOffsetW info_amode (- (stdInfoTableSizeW + 2)))
201 (cmmNegate zero_indexed_tag)
202 -- The "2" is one for the SRT slot, and one more
203 -- to get to the first word of the vector
206 = cmmOffsetExprW (cmmOffsetW info_amode (stdInfoTableSizeW + 2))
208 -- The "2" is one for the entry-code slot and one for the SRT slot
213 -> CgStmts -- The direct-return code (if any)
214 -- (empty for vectored returns)
215 -> [CLabel] -- Vector of return points
216 -- (empty for non-vectored returns)
219 emitReturnTarget name stmts vector srt
220 = do { live_slots <- getLiveStackSlots
221 ; liveness <- buildContLiveness name live_slots
222 ; srt_info <- getSRTInfo name srt
225 cl_type = case (null vector, isBigLiveness liveness) of
226 (True, True) -> rET_BIG
227 (True, False) -> rET_SMALL
228 (False, True) -> rET_VEC_BIG
229 (False, False) -> rET_VEC_SMALL
231 (std_info, extra_bits) =
232 mkRetInfoTable liveness srt_info cl_type vector
234 ; blks <- cgStmtsToBlocks stmts
235 ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
238 args = trace "emitReturnTarget: missing args" []
239 uniq = getUnique name
240 info_lbl = mkReturnInfoLabel uniq
244 :: Liveness -- liveness
246 -> Int -- type (eg. rET_SMALL)
247 -> [CLabel] -- vector
248 -> ([CmmLit],[CmmLit])
249 mkRetInfoTable liveness srt_info cl_type vector
250 = (std_info, extra_bits)
252 (srt_label, srt_len) = srtLabelAndLength srt_info
254 srt_slot | need_srt = [srt_label]
257 need_srt = needsSRT srt_info || not (null vector)
258 -- If there's a vector table then we must allocate
259 -- an SRT slot, so that the vector table is at a
260 -- known offset from the info pointer
262 liveness_lit = mkLivenessCLit liveness
263 std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
264 extra_bits = srt_slot ++ map CmmLabel vector
267 emitDirectReturnTarget
269 -> CgStmts -- The direct-return code
272 emitDirectReturnTarget name code srt
273 = emitReturnTarget name code [] srt
276 :: Name -- Just for its unique
277 -> [(ConTagZ, CgStmts)] -- Tagged branches
278 -> Maybe CgStmts -- Default branch (if any)
279 -> SRT -- Continuation's SRT
280 -> CtrlReturnConvention
281 -> FCode (CLabel, SemiTaggingStuff)
283 emitAlgReturnTarget name branches mb_deflt srt ret_conv
285 UnvectoredReturn fam_sz -> do
286 { blks <- getCgStmts $
287 emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
288 -- NB: tag_expr is zero-based
289 ; lbl <- emitDirectReturnTarget name blks srt
290 ; return (lbl, Nothing) }
291 -- Nothing: the internal branches in the switch don't have
292 -- global labels, so we can't use them at the 'call site'
294 VectoredReturn fam_sz -> do
295 { tagged_lbls <- mapFCs emit_alt branches
296 ; deflt_lbl <- emit_deflt mb_deflt
297 ; let vector = [ assocDefault deflt_lbl tagged_lbls i
298 | i <- [0..fam_sz-1]]
299 ; lbl <- emitReturnTarget name noCgStmts vector srt
300 ; return (lbl, Just (tagged_lbls, deflt_lbl)) }
302 uniq = getUnique name
303 tag_expr = getConstrTag (CmmReg nodeReg)
305 emit_alt :: (Int, CgStmts) -> FCode (Int, CLabel)
306 -- Emit the code for the alternative as a top-level
307 -- code block returning a label for it
308 emit_alt (tag, stmts) = do { let lbl = mkAltLabel uniq tag
309 ; blks <- cgStmtsToBlocks stmts
310 ; emitProc [] lbl [] blks
311 ; return (tag, lbl) }
313 emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
314 ; blks <- cgStmtsToBlocks stmts
315 ; emitProc [] lbl [] blks
317 emit_deflt Nothing = return mkErrorStdEntryLabel
318 -- Nothing case: the simplifier might have eliminated a case
319 -- so we may have e.g. case xs of
321 -- In that situation the default should never be taken,
322 -- so we just use mkErrorStdEntryLabel
324 --------------------------------
325 emitDirectReturnInstr :: Code
326 emitDirectReturnInstr
327 = do { info_amode <- getSequelAmode
328 ; stmtC (CmmJump (entryCode info_amode) []) }
330 emitVectoredReturnInstr :: CmmExpr -- *Zero-indexed* constructor tag
332 emitVectoredReturnInstr zero_indexed_tag
333 = do { info_amode <- getSequelAmode
334 ; let slot = vectorSlot info_amode zero_indexed_tag
335 ; stmtC (CmmJump (CmmLoad slot wordRep) []) }
339 -------------------------------------------------------------------------
341 -- Generating a standard info table
343 -------------------------------------------------------------------------
345 -- The standard bits of an info table. This part of the info table
346 -- corresponds to the StgInfoTable type defined in InfoTables.h.
348 -- Its shape varies with ticky/profiling/tables next to code etc
349 -- so we can't use constant offsets from Constants
352 :: CmmLit -- closure type descr (profiling)
353 -> CmmLit -- closure descr (profiling)
354 -> Int -- closure type
355 -> StgHalfWord -- SRT length
356 -> CmmLit -- layout field
359 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
360 = -- Parallel revertible-black hole field
362 -- Ticky info (none at present)
363 -- Debug info (none at present)
364 ++ [layout_lit, type_lit]
368 | opt_SccProfilingOn = [closure_descr, type_descr]
371 type_lit = packHalfWordsCLit cl_type srt_len
373 stdInfoTableSizeW :: WordOff
374 -- The size of a standard info table varies with profiling/ticky etc,
375 -- so we can't get it from Constants
376 -- It must vary in sync with mkStdInfoTable
378 = size_fixed + size_prof
380 size_fixed = 2 -- layout, type
381 size_prof | opt_SccProfilingOn = 2
384 stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
386 stdSrtBitmapOffset :: ByteOff
387 -- Byte offset of the SRT bitmap half-word which is
388 -- in the *higher-addressed* part of the type_lit
389 stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
391 stdClosureTypeOffset :: ByteOff
392 -- Byte offset of the closure type half-word
393 stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
395 stdPtrsOffset, stdNonPtrsOffset :: ByteOff
396 stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
397 stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
399 -------------------------------------------------------------------------
401 -- Accessing fields of an info table
403 -------------------------------------------------------------------------
405 closureInfoPtr :: CmmExpr -> CmmExpr
406 -- Takes a closure pointer and returns the info table pointer
407 closureInfoPtr e = CmmLoad e wordRep
409 entryCode :: CmmExpr -> CmmExpr
410 -- Takes an info pointer (the first word of a closure)
411 -- and returns its entry code
412 entryCode e | tablesNextToCode = e
413 | otherwise = CmmLoad e wordRep
415 getConstrTag :: CmmExpr -> CmmExpr
416 -- Takes a closure pointer, and return the *zero-indexed*
417 -- constructor tag obtained from the info table
418 -- This lives in the SRT field of the info table
419 -- (constructors don't need SRTs).
420 getConstrTag closure_ptr
421 = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
423 info_table = infoTable (closureInfoPtr closure_ptr)
425 infoTable :: CmmExpr -> CmmExpr
426 -- Takes an info pointer (the first word of a closure)
427 -- and returns a pointer to the first word of the standard-form
428 -- info table, excluding the entry-code word (if present)
430 | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
431 | otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
433 infoTableConstrTag :: CmmExpr -> CmmExpr
434 -- Takes an info table pointer (from infoTable) and returns the constr tag
435 -- field of the info table (same as the srt_bitmap field)
436 infoTableConstrTag = infoTableSrtBitmap
438 infoTableSrtBitmap :: CmmExpr -> CmmExpr
439 -- Takes an info table pointer (from infoTable) and returns the srt_bitmap
440 -- field of the info table
441 infoTableSrtBitmap info_tbl
442 = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
444 infoTableClosureType :: CmmExpr -> CmmExpr
445 -- Takes an info table pointer (from infoTable) and returns the closure type
446 -- field of the info table.
447 infoTableClosureType info_tbl
448 = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
450 infoTablePtrs :: CmmExpr -> CmmExpr
451 infoTablePtrs info_tbl
452 = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
454 infoTableNonPtrs :: CmmExpr -> CmmExpr
455 infoTableNonPtrs info_tbl
456 = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
458 funInfoTable :: CmmExpr -> CmmExpr
459 -- Takes the info pointer of a function,
460 -- and returns a pointer to the first word of the StgFunInfoExtra struct
461 -- in the info table.
462 funInfoTable info_ptr
464 = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
466 = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
467 -- Past the entry code pointer
469 -------------------------------------------------------------------------
471 -- Emit the code for a closure (or return address)
472 -- and its associated info table
474 -------------------------------------------------------------------------
476 -- The complication here concerns whether or not we can
477 -- put the info table next to the code
480 :: CLabel -- Label of info table
481 -> [CmmLit] -- ...its invariant part
482 -> [CmmLit] -- ...and its variant part
483 -> [LocalReg] -- ...args
484 -> [CmmBasicBlock] -- ...and body
487 emitInfoTableAndCode info_lbl std_info extra_bits args blocks
488 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
489 = emitProc (reverse extra_bits ++ std_info)
490 entry_lbl args blocks
491 -- NB: the info_lbl is discarded
493 | null blocks -- No actual code; only the info table is significant
494 = -- Use a zero place-holder in place of the
495 -- entry-label in the info table
496 emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
498 | otherwise -- Separately emit info table (with the function entry
499 = -- point as first entry) and the entry code
500 do { emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
501 ; emitProc [] entry_lbl args blocks }
504 entry_lbl = infoLblToEntryLbl info_lbl
506 -------------------------------------------------------------------------
508 -- Static reference tables
510 -------------------------------------------------------------------------
512 -- There is just one SRT for each top level binding; all the nested
513 -- bindings use sub-sections of this SRT. The label is passed down to
514 -- the nested bindings via the monad.
516 getSRTInfo :: Name -> SRT -> FCode C_SRT
517 getSRTInfo id NoSRT = return NoC_SRT
518 getSRTInfo id (SRT off len bmp)
519 | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
520 = do { srt_lbl <- getSRTLabel
521 ; let srt_desc_lbl = mkSRTDescLabel id
522 ; emitRODataLits srt_desc_lbl
523 ( cmmLabelOffW srt_lbl off
524 : mkWordCLit (fromIntegral len)
525 : map mkWordCLit bmp)
526 ; return (C_SRT srt_desc_lbl 0 srt_escape) }
529 = do { srt_lbl <- getSRTLabel
530 ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
531 -- The fromIntegral converts to StgHalfWord
533 srt_escape = (-1) :: StgHalfWord
535 srtLabelAndLength :: C_SRT -> (CmmLit, StgHalfWord)
536 srtLabelAndLength NoC_SRT = (zeroCLit, 0)
537 srtLabelAndLength (C_SRT lbl off bitmap) = (cmmLabelOffW lbl off, bitmap)