e463b3619fc637d68db1d3bd3e33405efa481b05
[ghc.git] / compiler / cmm / CmmInfo.hs
1 module CmmInfo (
2 mkEmptyContInfoTable,
3 cmmToRawCmm,
4 mkInfoTable,
5 ) where
6
7 #include "HsVersions.h"
8
9 import OldCmm
10 import CmmUtils
11
12 import CLabel
13
14 import Bitmap
15 import ClosureInfo
16 import CgInfoTbls
17 import CgCallConv
18 import CgUtils
19 import SMRep
20
21 import Constants
22 import Panic
23 import StaticFlags
24 import Unique
25 import UniqSupply
26
27 import Data.Bits
28
29 -- When we split at proc points, we need an empty info table.
30 mkEmptyContInfoTable :: CLabel -> CmmInfoTable
31 mkEmptyContInfoTable info_lbl = CmmInfoTable info_lbl False (ProfilingInfo zero zero) rET_SMALL
32 (ContInfo [] NoC_SRT)
33 where zero = CmmInt 0 wordWidth
34
35 cmmToRawCmm :: [Cmm] -> IO [RawCmm]
36 cmmToRawCmm cmm = do
37 info_tbl_uniques <- mkSplitUniqSupply 'i'
38 return $ zipWith raw_cmm (listSplitUniqSupply info_tbl_uniques) cmm
39 where
40 raw_cmm uniq_supply (Cmm procs) =
41 Cmm $ concat $ zipWith mkInfoTable (uniqsFromSupply uniq_supply) procs
42
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).
46 --
47 -- With tablesNextToCode, the layout is
48 -- <reversed variable part>
49 -- <normal forward StgInfoTable, but without
50 -- an entry point at the front>
51 -- <code>
52 --
53 -- Without tablesNextToCode, the layout of an info table is
54 -- <entry label>
55 -- <normal forward rest of StgInfoTable>
56 -- <forward variable part>
57 --
58 -- See includes/rts/storage/InfoTables.h
59 --
60 -- For return-points these are as follows
61 --
62 -- Tables next to code:
63 --
64 -- <srt slot>
65 -- <standard info table>
66 -- ret-addr --> <entry code (if any)>
67 --
68 -- Not tables-next-to-code:
69 --
70 -- ret-addr --> <ptr to entry code>
71 -- <standard info table>
72 -- <srt slot>
73 --
74 -- * The SRT slot is only there if there is SRT info to record
75
76 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
77 mkInfoTable _ (CmmData sec dat) = [CmmData sec dat]
78 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label blocks) =
79 case info of
80 -- Code without an info table. Easy.
81 CmmNonInfoTable -> [CmmProc Nothing entry_label blocks]
82
83 CmmInfoTable info_label _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
84 let ty_prof' = makeRelativeRefTo info_label ty_prof
85 cl_prof' = makeRelativeRefTo info_label cl_prof
86 in case type_info of
87 -- A function entry point.
88 FunInfo (ptrs, nptrs) srt fun_arity pap_bitmap slow_entry ->
89 mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
90 blocks
91 where
92 fun_type = argDescrType pap_bitmap
93 fun_extra_bits =
94 [packHalfWordsCLit fun_type fun_arity] ++
95 case pap_bitmap of
96 ArgGen liveness ->
97 (if null srt_label then [mkIntCLit 0] else srt_label) ++
98 [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
99 makeRelativeRefTo info_label slow_entry]
100 _ -> srt_label
101 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap
102 layout
103 (srt_label, srt_bitmap) = mkSRTLit info_label srt
104 layout = packHalfWordsCLit ptrs nptrs
105
106 -- A constructor.
107 ConstrInfo (ptrs, nptrs) con_tag descr ->
108 mkInfoTableAndCode info_label std_info [con_name] entry_label
109 blocks
110 where
111 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
112 con_name = makeRelativeRefTo info_label descr
113 layout = packHalfWordsCLit ptrs nptrs
114 -- A thunk.
115 ThunkInfo (ptrs, nptrs) srt ->
116 mkInfoTableAndCode info_label std_info srt_label entry_label
117 blocks
118 where
119 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
120 (srt_label, srt_bitmap) = mkSRTLit info_label srt
121 layout = packHalfWordsCLit ptrs nptrs
122
123 -- A selector thunk.
124 ThunkSelectorInfo offset _srt ->
125 mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
126 blocks
127 where
128 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
129
130 -- A continuation/return-point.
131 ContInfo stack_layout srt ->
132 liveness_data ++
133 mkInfoTableAndCode info_label std_info srt_label entry_label
134 blocks
135 where
136 std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
137 (makeRelativeRefTo info_label liveness_lit)
138 (liveness_lit, liveness_data, liveness_tag) =
139 mkLiveness uniq stack_layout
140 maybe_big_type_tag = if type_tag == rET_SMALL
141 then liveness_tag
142 else type_tag
143 (srt_label, srt_bitmap) = mkSRTLit info_label srt
144
145 -- Handle the differences between tables-next-to-code
146 -- and not tables-next-to-code
147 mkInfoTableAndCode :: CLabel
148 -> [CmmLit]
149 -> [CmmLit]
150 -> CLabel
151 -> ListGraph CmmStmt
152 -> [RawCmmTop]
153 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl blocks
154 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
155 = [CmmProc (Just (Statics info_lbl $ map CmmStaticLit (reverse extra_bits ++ std_info)))
156 entry_lbl blocks]
157
158 | ListGraph [] <- blocks -- No code; only the info table is significant
159 = -- Use a zero place-holder in place of the
160 -- entry-label in the info table
161 [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
162
163 | otherwise -- Separately emit info table (with the function entry
164 = -- point as first entry) and the entry code
165 [CmmProc Nothing entry_lbl blocks,
166 mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
167
168 mkSRTLit :: CLabel
169 -> C_SRT
170 -> ([CmmLit], -- srt_label
171 StgHalfWord) -- srt_bitmap
172 mkSRTLit _ NoC_SRT = ([], 0)
173 mkSRTLit info_label (C_SRT lbl off bitmap) =
174 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap)
175
176 -------------------------------------------------------------------------
177 --
178 -- Build a liveness mask for the stack layout
179 --
180 -------------------------------------------------------------------------
181
182 -- There are four kinds of things on the stack:
183 --
184 -- - pointer variables (bound in the environment)
185 -- - non-pointer variables (bound in the environment)
186 -- - free slots (recorded in the stack free list)
187 -- - non-pointer data slots (recorded in the stack free list)
188 --
189 -- The first two are represented with a 'Just' of a 'LocalReg'.
190 -- The last two with one or more 'Nothing' constructors.
191 -- Each 'Nothing' represents one used word.
192 --
193 -- The head of the stack layout is the top of the stack and
194 -- the least-significant bit.
195
196 -- TODO: refactor to use utility functions
197 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
198 mkLiveness :: Unique
199 -> [Maybe LocalReg]
200 -> (CmmLit, [RawCmmTop], ClosureTypeTag)
201 -- ^ Returns:
202 -- 1. The bitmap (literal value or label)
203 -- 2. Large bitmap CmmData if needed
204 -- 3. rET_SMALL or rET_BIG
205 mkLiveness uniq live =
206 if length bits > mAX_SMALL_BITMAP_SIZE
207 -- does not fit in one word
208 then (CmmLabel big_liveness, [data_lits], rET_BIG)
209 -- fits in one word
210 else (mkWordCLit small_liveness, [], rET_SMALL)
211 where
212 mkBits [] = []
213 mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
214 sizeW = case reg of
215 Nothing -> 1
216 Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE - 1)
217 `quot` wORD_SIZE
218 -- number of words, rounded up
219 bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
220
221 is_non_ptr Nothing = True
222 is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg)
223
224 bits :: [Bool]
225 bits = mkBits live
226
227 bitmap :: Bitmap
228 bitmap = mkBitmap bits
229
230 small_bitmap = case bitmap of
231 [] -> 0
232 [b] -> b
233 _ -> panic "mkLiveness"
234 small_liveness =
235 fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)
236
237 big_liveness = mkBitmapLabel uniq
238 lits = mkWordCLit (fromIntegral (length bits)) : map mkWordCLit bitmap
239 data_lits = mkRODataLits big_liveness lits
240
241 -------------------------------------------------------------------------
242 --
243 -- Generating a standard info table
244 --
245 -------------------------------------------------------------------------
246
247 -- The standard bits of an info table. This part of the info table
248 -- corresponds to the StgInfoTable type defined in InfoTables.h.
249 --
250 -- Its shape varies with ticky/profiling/tables next to code etc
251 -- so we can't use constant offsets from Constants
252
253 mkStdInfoTable
254 :: CmmLit -- closure type descr (profiling)
255 -> CmmLit -- closure descr (profiling)
256 -> StgHalfWord -- closure type
257 -> StgHalfWord -- SRT length
258 -> CmmLit -- layout field
259 -> [CmmLit]
260
261 mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
262 = -- Parallel revertible-black hole field
263 prof_info
264 -- Ticky info (none at present)
265 -- Debug info (none at present)
266 ++ [layout_lit, type_lit]
267
268 where
269 prof_info
270 | opt_SccProfilingOn = [type_descr, closure_descr]
271 | otherwise = []
272
273 type_lit = packHalfWordsCLit cl_type srt_len
274