2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
15 #include "HsVersions.h"
39 -- When we split at proc points, we need an empty info table.
40 emptyContInfoTable :: CmmInfo
42 CmmInfo Nothing Nothing (CmmInfoTable False (ProfilingInfo zero zero) rET_SMALL
43 (ContInfo [] NoC_SRT))
44 where zero = CmmInt 0 wordWidth
46 cmmToRawCmm :: [Cmm] -> IO [RawCmm]
48 info_tbl_uniques <- mkSplitUniqSupply 'i'
49 return $ zipWith raw_cmm (listSplitUniqSupply info_tbl_uniques) cmm
51 raw_cmm uniq_supply (Cmm procs) =
52 Cmm $ concat $ zipWith mkInfoTable (uniqsFromSupply uniq_supply) procs
54 -- Make a concrete info table, represented as a list of CmmStatic
55 -- (it can't be simply a list of Word, because the SRT field is
56 -- represented by a label+offset expression).
58 -- With tablesNextToCode, the layout is
59 -- <reversed variable part>
60 -- <normal forward StgInfoTable, but without
61 -- an entry point at the front>
64 -- Without tablesNextToCode, the layout of an info table is
66 -- <normal forward rest of StgInfoTable>
67 -- <forward variable part>
69 -- See includes/InfoTables.h
71 -- For return-points these are as follows
73 -- Tables next to code:
76 -- <standard info table>
77 -- ret-addr --> <entry code (if any)>
79 -- Not tables-next-to-code:
81 -- ret-addr --> <ptr to entry code>
82 -- <standard info table>
85 -- * The SRT slot is only there if there is SRT info to record
87 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
88 mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
89 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
91 -- Code without an info table. Easy.
92 CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
94 CmmInfoTable _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
95 let info_label = entryLblToInfoLbl entry_label
96 ty_prof' = makeRelativeRefTo info_label ty_prof
97 cl_prof' = makeRelativeRefTo info_label cl_prof
99 -- A function entry point.
100 FunInfo (ptrs, nptrs) srt fun_arity pap_bitmap slow_entry ->
101 mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
104 fun_type = argDescrType pap_bitmap
106 [packHalfWordsCLit fun_type fun_arity] ++
109 (if null srt_label then [mkIntCLit 0] else srt_label) ++
110 [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
111 makeRelativeRefTo info_label slow_entry]
113 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap
115 (srt_label, srt_bitmap) = mkSRTLit info_label srt
116 layout = packHalfWordsCLit ptrs nptrs
119 ConstrInfo (ptrs, nptrs) con_tag descr ->
120 mkInfoTableAndCode info_label std_info [con_name] entry_label
123 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
124 con_name = makeRelativeRefTo info_label descr
125 layout = packHalfWordsCLit ptrs nptrs
127 ThunkInfo (ptrs, nptrs) srt ->
128 mkInfoTableAndCode info_label std_info srt_label entry_label
131 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
132 (srt_label, srt_bitmap) = mkSRTLit info_label srt
133 layout = packHalfWordsCLit ptrs nptrs
136 ThunkSelectorInfo offset srt ->
137 mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
140 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
142 -- A continuation/return-point.
143 ContInfo stack_layout srt ->
145 mkInfoTableAndCode info_label std_info srt_label entry_label
148 std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
149 (makeRelativeRefTo info_label liveness_lit)
150 (liveness_lit, liveness_data, liveness_tag) =
151 mkLiveness uniq stack_layout
152 maybe_big_type_tag = if type_tag == rET_SMALL
155 (srt_label, srt_bitmap) = mkSRTLit info_label srt
157 -- Generate a bare info table, not attached to any procedure.
158 mkBareInfoTable :: CLabel -> Unique -> CmmInfoTable -> [CmmTopZ]
159 mkBareInfoTable lbl uniq info =
160 case mkInfoTable uniq (CmmProc (CmmInfo Nothing Nothing info) lbl [] (ListGraph [])) of
162 ASSERT (tablesNextToCode)
163 [CmmData Data (d ++ [CmmDataLabel (entryLblToInfoLbl lbl)])]
164 [CmmData d s] -> [CmmData d s]
165 _ -> panic "mkBareInfoTable expected to produce only data"
168 -- Handle the differences between tables-next-to-code
169 -- and not tables-next-to-code
170 mkInfoTableAndCode :: CLabel
177 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
178 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
179 = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
180 entry_lbl args blocks]
182 | ListGraph [] <- blocks -- No code; only the info table is significant
183 = -- Use a zero place-holder in place of the
184 -- entry-label in the info table
185 [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
187 | otherwise -- Separately emit info table (with the function entry
188 = -- point as first entry) and the entry code
189 [CmmProc [] entry_lbl args blocks,
190 mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
194 -> ([CmmLit], -- srt_label
195 StgHalfWord) -- srt_bitmap
196 mkSRTLit info_label NoC_SRT = ([], 0)
197 mkSRTLit info_label (C_SRT lbl off bitmap) =
198 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
200 -------------------------------------------------------------------------
202 -- Build a liveness mask for the stack layout
204 -------------------------------------------------------------------------
206 -- There are four kinds of things on the stack:
208 -- - pointer variables (bound in the environment)
209 -- - non-pointer variables (bound in the environment)
210 -- - free slots (recorded in the stack free list)
211 -- - non-pointer data slots (recorded in the stack free list)
213 -- The first two are represented with a 'Just' of a 'LocalReg'.
214 -- The last two with one or more 'Nothing' constructors.
215 -- Each 'Nothing' represents one used word.
217 -- The head of the stack layout is the top of the stack and
218 -- the least-significant bit.
220 -- TODO: refactor to use utility functions
221 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
224 -> (CmmLit, [RawCmmTop], ClosureTypeTag)
226 -- 1. The bitmap (literal value or label)
227 -- 2. Large bitmap CmmData if needed
228 -- 3. rET_SMALL or rET_BIG
229 mkLiveness uniq live =
230 if length bits > mAX_SMALL_BITMAP_SIZE
231 -- does not fit in one word
232 then (CmmLabel big_liveness, [data_lits], rET_BIG)
234 else (mkWordCLit small_liveness, [], rET_SMALL)
237 mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
240 Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE - 1)
242 -- number of words, rounded up
243 bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
245 is_non_ptr Nothing = True
246 is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg)
252 bitmap = mkBitmap bits
254 small_bitmap = case bitmap of
256 [b] -> fromIntegral b
257 _ -> panic "mkLiveness"
259 fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
261 big_liveness = mkBitmapLabel uniq
262 lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
263 data_lits = mkRODataLits big_liveness lits
265 -------------------------------------------------------------------------
267 -- Generating a standard info table
269 -------------------------------------------------------------------------
271 -- The standard bits of an info table. This part of the info table
272 -- corresponds to the StgInfoTable type defined in InfoTables.h.
274 -- Its shape varies with ticky/profiling/tables next to code etc
275 -- so we can't use constant offsets from Constants
278 :: CmmLit -- closure type descr (profiling)
279 -> CmmLit -- closure descr (profiling)
280 -> StgHalfWord -- closure type
281 -> StgHalfWord -- SRT length
282 -> CmmLit -- layout field
285 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
286 = -- Parallel revertible-black hole field
288 -- Ticky info (none at present)
289 -- Debug info (none at present)
290 ++ [layout_lit, type_lit]
294 | opt_SccProfilingOn = [type_descr, closure_descr]
297 type_lit = packHalfWordsCLit cl_type srt_len