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/WorkingConventions#Warnings
13 #include "HsVersions.h"
38 cmmToRawCmm :: [Cmm] -> IO [RawCmm]
40 info_tbl_uniques <- mkSplitUniqSupply 'i'
41 return $ zipWith raw_cmm (listSplitUniqSupply info_tbl_uniques) cmm
43 raw_cmm uniq_supply (Cmm procs) =
44 Cmm $ concat $ zipWith mkInfoTable (uniqsFromSupply uniq_supply) procs
46 -- Make a concrete info table, represented as a list of CmmStatic
47 -- (it can't be simply a list of Word, because the SRT field is
48 -- represented by a label+offset expression).
50 -- With tablesNextToCode, the layout is
51 -- <reversed variable part>
52 -- <normal forward StgInfoTable, but without
53 -- an entry point at the front>
56 -- Without tablesNextToCode, the layout of an info table is
58 -- <normal forward rest of StgInfoTable>
59 -- <forward variable part>
61 -- See includes/InfoTables.h
63 -- For return-points these are as follows
65 -- Tables next to code:
68 -- <standard info table>
69 -- ret-addr --> <entry code (if any)>
71 -- Not tables-next-to-code:
73 -- ret-addr --> <ptr to entry code>
74 -- <standard info table>
77 -- * The SRT slot is only there if there is SRT info to record
79 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
80 mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
81 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
83 -- | Code without an info table. Easy.
84 CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
86 CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
87 let info_label = entryLblToInfoLbl entry_label
88 ty_prof' = makeRelativeRefTo info_label ty_prof
89 cl_prof' = makeRelativeRefTo info_label cl_prof
91 -- | A function entry point.
92 FunInfo (ptrs, nptrs) srt fun_type fun_arity pap_bitmap slow_entry ->
93 mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
97 [packHalfWordsCLit fun_type fun_arity] ++
100 (if null srt_label then [mkIntCLit 0] else srt_label) ++
101 [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
102 makeRelativeRefTo info_label slow_entry]
104 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap
106 (srt_label, srt_bitmap) = mkSRTLit info_label srt
107 layout = packHalfWordsCLit ptrs nptrs
110 ConstrInfo (ptrs, nptrs) con_tag descr ->
111 mkInfoTableAndCode info_label std_info [con_name] entry_label
114 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
115 con_name = makeRelativeRefTo info_label descr
116 layout = packHalfWordsCLit ptrs nptrs
119 ThunkInfo (ptrs, nptrs) srt ->
120 mkInfoTableAndCode info_label std_info srt_label entry_label
123 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
124 (srt_label, srt_bitmap) = mkSRTLit info_label srt
125 layout = packHalfWordsCLit ptrs nptrs
127 -- | A selector thunk.
128 ThunkSelectorInfo offset srt ->
129 mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
132 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
134 -- A continuation/return-point.
135 ContInfo stack_layout srt ->
137 mkInfoTableAndCode info_label std_info srt_label entry_label
140 std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
141 (makeRelativeRefTo info_label liveness_lit)
142 (liveness_lit, liveness_data, liveness_tag) =
143 mkLiveness uniq stack_layout
144 maybe_big_type_tag = if type_tag == rET_SMALL
147 (srt_label, srt_bitmap) = mkSRTLit info_label srt
149 -- Handle the differences between tables-next-to-code
150 -- and not tables-next-to-code
151 mkInfoTableAndCode :: CLabel
158 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
159 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
160 = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
161 entry_lbl args blocks]
163 | null blocks -- No actual code; only the info table is significant
164 = -- Use a zero place-holder in place of the
165 -- entry-label in the info table
166 [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
168 | otherwise -- Separately emit info table (with the function entry
169 = -- point as first entry) and the entry code
170 [CmmProc [] entry_lbl args blocks,
171 mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
175 -> ([CmmLit], -- srt_label
176 StgHalfWord) -- srt_bitmap
177 mkSRTLit info_label NoC_SRT = ([], 0)
178 mkSRTLit info_label (C_SRT lbl off bitmap) =
179 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
181 -------------------------------------------------------------------------
183 -- Build a liveness mask for the stack layout
185 -------------------------------------------------------------------------
187 -- There are four kinds of things on the stack:
189 -- - pointer variables (bound in the environment)
190 -- - non-pointer variables (bound in the environment)
191 -- - free slots (recorded in the stack free list)
192 -- - non-pointer data slots (recorded in the stack free list)
194 -- The first two are represented with a 'Just' of a 'LocalReg'.
195 -- The last two with one or more 'Nothing' constructors.
196 -- Each 'Nothing' represents one used word.
198 -- The head of the stack layout is the top of the stack and
199 -- the least-significant bit.
201 -- TODO: refactor to use utility functions
202 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
205 -> (CmmLit, -- ^ The bitmap (literal value or label)
206 [RawCmmTop], -- ^ Large bitmap CmmData if needed
207 ClosureTypeTag) -- ^ rET_SMALL or rET_BIG
208 mkLiveness uniq live =
209 if length bits > mAX_SMALL_BITMAP_SIZE
210 -- does not fit in one word
211 then (CmmLabel big_liveness, [data_lits], rET_BIG)
213 else (mkWordCLit small_liveness, [], rET_SMALL)
216 mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
219 Just r -> (machRepByteWidth (localRegRep r) + wORD_SIZE - 1)
221 -- number of words, rounded up
222 bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
224 is_non_ptr Nothing = True
225 is_non_ptr (Just reg) =
226 case localRegGCFollow reg of
234 bitmap = mkBitmap bits
236 small_bitmap = case bitmap of
238 [b] -> fromIntegral b
239 _ -> panic "mkLiveness"
241 fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
243 big_liveness = mkBitmapLabel uniq
244 lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
245 data_lits = mkRODataLits big_liveness lits
247 -------------------------------------------------------------------------
249 -- Generating a standard info table
251 -------------------------------------------------------------------------
253 -- The standard bits of an info table. This part of the info table
254 -- corresponds to the StgInfoTable type defined in InfoTables.h.
256 -- Its shape varies with ticky/profiling/tables next to code etc
257 -- so we can't use constant offsets from Constants
260 :: CmmLit -- closure type descr (profiling)
261 -> CmmLit -- closure descr (profiling)
262 -> StgHalfWord -- closure type
263 -> StgHalfWord -- SRT length
264 -> CmmLit -- layout field
267 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
268 = -- Parallel revertible-black hole field
270 -- Ticky info (none at present)
271 -- Debug info (none at present)
272 ++ [layout_lit, type_lit]
276 | opt_SccProfilingOn = [type_descr, closure_descr]
279 type_lit = packHalfWordsCLit cl_type srt_len