6 #include "HsVersions.h"
31 cmmToRawCmm :: [Cmm] -> IO [RawCmm]
33 info_tbl_uniques <- mkSplitUniqSupply 'i'
34 return $ zipWith raw_cmm (listSplitUniqSupply info_tbl_uniques) cmm
36 raw_cmm uniq_supply (Cmm procs) =
37 Cmm $ concat $ zipWith mkInfoTable (uniqsFromSupply uniq_supply) procs
39 -- Make a concrete info table, represented as a list of CmmStatic
40 -- (it can't be simply a list of Word, because the SRT field is
41 -- represented by a label+offset expression).
43 -- With tablesNextToCode, the layout is
44 -- <reversed variable part>
45 -- <normal forward StgInfoTable, but without
46 -- an entry point at the front>
49 -- Without tablesNextToCode, the layout of an info table is
51 -- <normal forward rest of StgInfoTable>
52 -- <forward variable part>
54 -- See includes/InfoTables.h
56 -- For return-points these are as follows
58 -- Tables next to code:
61 -- <standard info table>
62 -- ret-addr --> <entry code (if any)>
64 -- Not tables-next-to-code:
66 -- ret-addr --> <ptr to entry code>
67 -- <standard info table>
70 -- * The SRT slot is only there if there is SRT info to record
72 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
73 mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
74 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
76 -- | Code without an info table. Easy.
77 CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
79 -- | A function entry point.
80 CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
81 (FunInfo (ptrs, nptrs) srt fun_type fun_arity
82 pap_bitmap slow_entry) ->
83 mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
87 [packHalfWordsCLit fun_type fun_arity] ++
90 (if null srt_label then [mkIntCLit 0] else srt_label) ++
91 [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
92 makeRelativeRefTo info_label slow_entry]
94 std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout
95 info_label = entryLblToInfoLbl entry_label
96 (srt_label, srt_bitmap) = mkSRTLit info_label srt
97 layout = packHalfWordsCLit ptrs nptrs
100 CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
101 (ConstrInfo (ptrs, nptrs) con_tag descr) ->
102 mkInfoTableAndCode info_label std_info [con_name] entry_label
105 std_info = mkStdInfoTable ty_prof cl_prof type_tag con_tag layout
106 info_label = entryLblToInfoLbl entry_label
107 con_name = makeRelativeRefTo info_label descr
108 layout = packHalfWordsCLit ptrs nptrs
111 CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
112 (ThunkInfo (ptrs, nptrs) srt) ->
113 mkInfoTableAndCode info_label std_info srt_label entry_label
116 std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout
117 info_label = entryLblToInfoLbl entry_label
118 (srt_label, srt_bitmap) = mkSRTLit info_label srt
119 layout = packHalfWordsCLit ptrs nptrs
121 -- | A selector thunk.
122 CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
123 (ThunkSelectorInfo offset srt) ->
124 mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
127 std_info = mkStdInfoTable ty_prof cl_prof type_tag 0 (mkWordCLit offset)
128 info_label = entryLblToInfoLbl entry_label
130 -- A continuation/return-point.
131 CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
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 info_label = entryLblToInfoLbl entry_label
140 (liveness_lit, liveness_data, liveness_tag) =
141 mkLiveness uniq stack_layout
142 maybe_big_type_tag = if type_tag == rET_SMALL
145 (srt_label, srt_bitmap) = mkSRTLit info_label srt
147 -- Handle the differences between tables-next-to-code
148 -- and not tables-next-to-code
149 mkInfoTableAndCode :: CLabel
156 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
157 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
158 = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
159 entry_lbl args blocks]
161 | null blocks -- No actual code; only the info table is significant
162 = -- Use a zero place-holder in place of the
163 -- entry-label in the info table
164 [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
166 | otherwise -- Separately emit info table (with the function entry
167 = -- point as first entry) and the entry code
168 [mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits),
169 CmmProc [] entry_lbl args blocks]
173 -> ([CmmLit], -- srt_label
174 StgHalfWord) -- srt_bitmap
175 mkSRTLit info_label NoC_SRT = ([], 0)
176 mkSRTLit info_label (C_SRT lbl off bitmap) =
177 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
179 -------------------------------------------------------------------------
181 -- Build a liveness mask for the stack layout
183 -------------------------------------------------------------------------
185 -- There are four kinds of things on the stack:
187 -- - pointer variables (bound in the environment)
188 -- - non-pointer variables (bound in the environment)
189 -- - free slots (recorded in the stack free list)
190 -- - non-pointer data slots (recorded in the stack free list)
192 -- The first two are represented with a 'Just' of a 'LocalReg'.
193 -- The last two with one or more 'Nothing' constructors.
194 -- Each 'Nothing' represents one used word.
196 -- The head of the stack layout is the top of the stack and
197 -- the least-significant bit.
199 -- TODO: refactor to use utility functions
200 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
203 -> (CmmLit, -- ^ The bitmap (literal value or label)
204 [RawCmmTop], -- ^ Large bitmap CmmData if needed
205 ClosureTypeTag) -- ^ 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 -> machRepByteWidth (localRegRep r) `quot` wORD_SIZE
218 bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
220 is_non_ptr Nothing = True
221 is_non_ptr (Just reg) =
222 case localRegGCFollow reg of
230 bitmap = mkBitmap bits
232 small_bitmap = case bitmap of
234 [b] -> fromIntegral b
235 _ -> panic "mkLiveness"
237 fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
239 big_liveness = mkBitmapLabel uniq
240 lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
241 data_lits = mkRODataLits big_liveness lits
243 -------------------------------------------------------------------------
245 -- Generating a standard info table
247 -------------------------------------------------------------------------
249 -- The standard bits of an info table. This part of the info table
250 -- corresponds to the StgInfoTable type defined in InfoTables.h.
252 -- Its shape varies with ticky/profiling/tables next to code etc
253 -- so we can't use constant offsets from Constants
256 :: CmmLit -- closure type descr (profiling)
257 -> CmmLit -- closure descr (profiling)
258 -> StgHalfWord -- closure type
259 -> StgHalfWord -- SRT length
260 -> CmmLit -- layout field
263 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
264 = -- Parallel revertible-black hole field
266 -- Ticky info (none at present)
267 -- Debug info (none at present)
268 ++ [layout_lit, type_lit]
272 | opt_SccProfilingOn = [type_descr, closure_descr]
275 type_lit = packHalfWordsCLit cl_type srt_len