5 #include "HsVersions.h"
25 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
26 mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
27 mkInfoTable uniq (CmmProc info entry_label arguments blocks) =
29 CmmNonInfo _ -> [CmmProc [] entry_label arguments blocks]
30 CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
31 (FunInfo (ptrs, nptrs) srt fun_type fun_arity pap_bitmap slow_entry) ->
32 mkInfoTableAndCode info_label std_info fun_extra_bits entry_label arguments blocks
35 [packHalfWordsCLit fun_type fun_arity] ++
39 [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
40 makeRelativeRefTo info_label (CmmLabel slow_entry)]
42 std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout
43 info_label = entryLblToInfoLbl entry_label
44 (srt_label, srt_bitmap) =
47 (C_SRT lbl off bitmap) ->
48 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)],
50 layout = packHalfWordsCLit ptrs nptrs
52 CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
53 (ConstrInfo (ptrs, nptrs) con_tag descr) ->
54 mkInfoTableAndCode info_label std_info [con_name] entry_label arguments blocks
56 std_info = mkStdInfoTable ty_prof cl_prof type_tag con_tag layout
57 info_label = entryLblToInfoLbl entry_label
58 con_name = makeRelativeRefTo info_label descr
59 layout = packHalfWordsCLit ptrs nptrs
61 CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
62 (ThunkInfo (ptrs, nptrs) srt) ->
63 mkInfoTableAndCode info_label std_info srt_label entry_label arguments blocks
65 std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout
66 info_label = entryLblToInfoLbl entry_label
67 (srt_label, srt_bitmap) =
70 (C_SRT lbl off bitmap) ->
71 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)],
73 layout = packHalfWordsCLit ptrs nptrs
75 CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
76 (ThunkSelectorInfo offset srt) ->
77 mkInfoTableAndCode info_label std_info srt_label entry_label arguments blocks
79 std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap (mkWordCLit offset)
80 info_label = entryLblToInfoLbl entry_label
81 (srt_label, srt_bitmap) =
84 (C_SRT lbl off bitmap) ->
85 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)],
88 CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag (ContInfo stack_layout srt) ->
90 mkInfoTableAndCode info_label std_info srt_label entry_label arguments blocks
92 std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap liveness_lit
93 info_label = entryLblToInfoLbl entry_label
94 (liveness_lit, liveness_data) = mkLiveness uniq stack_layout
95 (srt_label, srt_bitmap) =
98 (C_SRT lbl off bitmap) ->
99 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)],
102 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
103 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
104 = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info)) entry_lbl args blocks]
106 | null blocks -- No actual code; only the info table is significant
107 = -- Use a zero place-holder in place of the
108 -- entry-label in the info table
109 [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
111 | otherwise -- Separately emit info table (with the function entry
112 = -- point as first entry) and the entry code
113 [mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits),
114 CmmProc [] entry_lbl args blocks]
116 -- TODO: refactor to use utility functions
117 mkLiveness :: Unique -> [Maybe LocalReg] -> (CmmLit, [GenCmmTop CmmStatic [CmmStatic] CmmStmt])
119 = if length live > mAX_SMALL_BITMAP_SIZE
120 then (CmmLabel big_liveness, [data_lits]) -- does not fit in one word
121 else (mkWordCLit small_liveness, []) -- fits in one word
125 bits = mkBitmap (map is_non_ptr live)
126 is_non_ptr Nothing = True
127 is_non_ptr (Just reg) | localRegGCFollow reg == KindNonPtr = True
128 is_non_ptr (Just reg) | localRegGCFollow reg == KindPtr = False
130 big_liveness = mkBitmapLabel uniq
131 data_lits = mkRODataLits big_liveness lits
132 lits = mkWordCLit (fromIntegral size) : map mkWordCLit bits
135 fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
136 small_bits = case bits of
138 [b] -> fromIntegral b
139 _ -> panic "mkLiveness"