7 #include "HsVersions.h"
29 -- When we split at proc points, we need an empty info table.
30 emptyContInfoTable :: CmmInfoTable
31 emptyContInfoTable = CmmInfoTable False (ProfilingInfo zero zero) rET_SMALL
33 where zero = CmmInt 0 wordWidth
35 cmmToRawCmm :: [Cmm] -> IO [RawCmm]
37 info_tbl_uniques <- mkSplitUniqSupply 'i'
38 return $ zipWith raw_cmm (listSplitUniqSupply info_tbl_uniques) cmm
40 raw_cmm uniq_supply (Cmm procs) =
41 Cmm $ concat $ zipWith mkInfoTable (uniqsFromSupply uniq_supply) procs
43 -- Make a concrete info table, represented as a list of CmmStatic
44 -- (it can't be simply a list of Word, because the SRT field is
45 -- represented by a label+offset expression).
47 -- With tablesNextToCode, the layout is
48 -- <reversed variable part>
49 -- <normal forward StgInfoTable, but without
50 -- an entry point at the front>
53 -- Without tablesNextToCode, the layout of an info table is
55 -- <normal forward rest of StgInfoTable>
56 -- <forward variable part>
58 -- See includes/rts/storage/InfoTables.h
60 -- For return-points these are as follows
62 -- Tables next to code:
65 -- <standard info table>
66 -- ret-addr --> <entry code (if any)>
68 -- Not tables-next-to-code:
70 -- ret-addr --> <ptr to entry code>
71 -- <standard info table>
74 -- * The SRT slot is only there if there is SRT info to record
76 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
77 mkInfoTable _ (CmmData sec dat) = [CmmData sec dat]
78 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label blocks) =
80 -- Code without an info table. Easy.
81 CmmNonInfoTable -> [CmmProc [] entry_label blocks]
83 CmmInfoTable _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
84 let info_label = entryLblToInfoLbl entry_label
85 ty_prof' = makeRelativeRefTo info_label ty_prof
86 cl_prof' = makeRelativeRefTo info_label cl_prof
88 -- A function entry point.
89 FunInfo (ptrs, nptrs) srt fun_arity pap_bitmap slow_entry ->
90 mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
93 fun_type = argDescrType pap_bitmap
95 [packHalfWordsCLit fun_type fun_arity] ++
98 (if null srt_label then [mkIntCLit 0] else srt_label) ++
99 [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
100 makeRelativeRefTo info_label slow_entry]
102 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap
104 (srt_label, srt_bitmap) = mkSRTLit info_label srt
105 layout = packHalfWordsCLit ptrs nptrs
108 ConstrInfo (ptrs, nptrs) con_tag descr ->
109 mkInfoTableAndCode info_label std_info [con_name] entry_label
112 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
113 con_name = makeRelativeRefTo info_label descr
114 layout = packHalfWordsCLit ptrs nptrs
116 ThunkInfo (ptrs, nptrs) srt ->
117 mkInfoTableAndCode info_label std_info srt_label entry_label
120 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
121 (srt_label, srt_bitmap) = mkSRTLit info_label srt
122 layout = packHalfWordsCLit ptrs nptrs
125 ThunkSelectorInfo offset _srt ->
126 mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
129 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
131 -- A continuation/return-point.
132 ContInfo stack_layout srt ->
134 mkInfoTableAndCode info_label std_info srt_label entry_label
137 std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
138 (makeRelativeRefTo info_label liveness_lit)
139 (liveness_lit, liveness_data, liveness_tag) =
140 mkLiveness uniq stack_layout
141 maybe_big_type_tag = if type_tag == rET_SMALL
144 (srt_label, srt_bitmap) = mkSRTLit info_label srt
146 -- Handle the differences between tables-next-to-code
147 -- and not tables-next-to-code
148 mkInfoTableAndCode :: CLabel
154 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl blocks
155 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
156 = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
159 | ListGraph [] <- blocks -- No code; only the info table is significant
160 = -- Use a zero place-holder in place of the
161 -- entry-label in the info table
162 [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
164 | otherwise -- Separately emit info table (with the function entry
165 = -- point as first entry) and the entry code
166 [CmmProc [] entry_lbl blocks,
167 mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
171 -> ([CmmLit], -- srt_label
172 StgHalfWord) -- srt_bitmap
173 mkSRTLit _ NoC_SRT = ([], 0)
174 mkSRTLit info_label (C_SRT lbl off bitmap) =
175 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
177 -------------------------------------------------------------------------
179 -- Build a liveness mask for the stack layout
181 -------------------------------------------------------------------------
183 -- There are four kinds of things on the stack:
185 -- - pointer variables (bound in the environment)
186 -- - non-pointer variables (bound in the environment)
187 -- - free slots (recorded in the stack free list)
188 -- - non-pointer data slots (recorded in the stack free list)
190 -- The first two are represented with a 'Just' of a 'LocalReg'.
191 -- The last two with one or more 'Nothing' constructors.
192 -- Each 'Nothing' represents one used word.
194 -- The head of the stack layout is the top of the stack and
195 -- the least-significant bit.
197 -- TODO: refactor to use utility functions
198 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
201 -> (CmmLit, [RawCmmTop], ClosureTypeTag)
203 -- 1. The bitmap (literal value or label)
204 -- 2. Large bitmap CmmData if needed
205 -- 3. rET_SMALL or rET_BIG
206 mkLiveness uniq live =
207 if length bits > mAX_SMALL_BITMAP_SIZE
208 -- does not fit in one word
209 then (CmmLabel big_liveness, [data_lits], rET_BIG)
211 else (mkWordCLit small_liveness, [], rET_SMALL)
214 mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
217 Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE - 1)
219 -- number of words, rounded up
220 bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
222 is_non_ptr Nothing = True
223 is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg)
229 bitmap = mkBitmap bits
231 small_bitmap = case bitmap of
234 _ -> panic "mkLiveness"
236 fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
238 big_liveness = mkBitmapLabel uniq
239 lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
240 data_lits = mkRODataLits big_liveness lits
242 -------------------------------------------------------------------------
244 -- Generating a standard info table
246 -------------------------------------------------------------------------
248 -- The standard bits of an info table. This part of the info table
249 -- corresponds to the StgInfoTable type defined in InfoTables.h.
251 -- Its shape varies with ticky/profiling/tables next to code etc
252 -- so we can't use constant offsets from Constants
255 :: CmmLit -- closure type descr (profiling)
256 -> CmmLit -- closure descr (profiling)
257 -> StgHalfWord -- closure type
258 -> StgHalfWord -- SRT length
259 -> CmmLit -- layout field
262 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
263 = -- Parallel revertible-black hole field
265 -- Ticky info (none at present)
266 -- Debug info (none at present)
267 ++ [layout_lit, type_lit]
271 | opt_SccProfilingOn = [type_descr, closure_descr]
274 type_lit = packHalfWordsCLit cl_type srt_len