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 (CmmLabel 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 (ContInfo stack_layout 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 liveness_lit
80 info_label = entryLblToInfoLbl entry_label
81 (liveness_lit, liveness_data) = mkLiveness uniq stack_layout
82 (srt_label, srt_bitmap) =
85 (C_SRT lbl off bitmap) ->
86 ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)],
89 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
90 | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc
91 = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info)) entry_lbl args blocks]
93 | null blocks -- No actual code; only the info table is significant
94 = -- Use a zero place-holder in place of the
95 -- entry-label in the info table
96 [mkRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)]
98 | otherwise -- Separately emit info table (with the function entry
99 = -- point as first entry) and the entry code
100 [mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits),
101 CmmProc [] entry_lbl args blocks]
103 -- TODO: refactor to use utility functions
104 mkLiveness :: Unique -> [Maybe LocalReg] -> (CmmLit, [GenCmmTop CmmStatic [CmmStatic] CmmStmt])
106 = if length live > mAX_SMALL_BITMAP_SIZE
107 then (CmmLabel big_liveness, [data_lits]) -- does not fit in one word
108 else (mkWordCLit small_liveness, []) -- fits in one word
112 bits = mkBitmap (map is_non_ptr live)
113 is_non_ptr Nothing = True
114 is_non_ptr (Just reg) | localRegGCFollow reg == KindNonPtr = True
115 is_non_ptr (Just reg) | localRegGCFollow reg == KindPtr = False
117 big_liveness = mkBitmapLabel uniq
118 data_lits = mkRODataLits big_liveness lits
119 lits = mkWordCLit (fromIntegral size) : map mkWordCLit bits
122 fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
123 small_bits = case bits of
125 [b] -> fromIntegral b
126 _ -> panic "mkLiveness"