never executed always true always false
1 -- | Constants describing the DWARF format. Most of this simply
2 -- mirrors \/usr\/include\/dwarf.h.
3
4 module GHC.CmmToAsm.Dwarf.Constants where
5
6 import GHC.Prelude
7
8 import GHC.Utils.Asm
9 import GHC.Platform
10 import GHC.Utils.Outputable
11
12 import GHC.Platform.Reg
13 import GHC.CmmToAsm.X86.Regs
14 import GHC.CmmToAsm.PPC.Regs (toRegNo)
15
16 import Data.Word
17
18 -- | Language ID used for Haskell.
19 dW_LANG_Haskell :: Word
20 dW_LANG_Haskell = 0x18
21 -- Thanks to Nathan Howell for getting us our very own language ID!
22
23 -- * Dwarf tags
24 dW_TAG_compile_unit, dW_TAG_subroutine_type,
25 dW_TAG_file_type, dW_TAG_subprogram, dW_TAG_lexical_block,
26 dW_TAG_base_type, dW_TAG_structure_type, dW_TAG_pointer_type,
27 dW_TAG_array_type, dW_TAG_subrange_type, dW_TAG_typedef,
28 dW_TAG_variable, dW_TAG_arg_variable, dW_TAG_auto_variable,
29 dW_TAG_ghc_src_note :: Word
30 dW_TAG_array_type = 1
31 dW_TAG_lexical_block = 11
32 dW_TAG_pointer_type = 15
33 dW_TAG_compile_unit = 17
34 dW_TAG_structure_type = 19
35 dW_TAG_typedef = 22
36 dW_TAG_subroutine_type = 32
37 dW_TAG_subrange_type = 33
38 dW_TAG_base_type = 36
39 dW_TAG_file_type = 41
40 dW_TAG_subprogram = 46
41 dW_TAG_variable = 52
42 dW_TAG_auto_variable = 256
43 dW_TAG_arg_variable = 257
44
45 dW_TAG_ghc_src_note = 0x5b00
46
47 -- * Dwarf attributes
48 dW_AT_name, dW_AT_stmt_list, dW_AT_low_pc, dW_AT_high_pc, dW_AT_language,
49 dW_AT_comp_dir, dW_AT_producer, dW_AT_external, dW_AT_frame_base,
50 dW_AT_use_UTF8, dW_AT_linkage_name :: Word
51 dW_AT_name = 0x03
52 dW_AT_stmt_list = 0x10
53 dW_AT_low_pc = 0x11
54 dW_AT_high_pc = 0x12
55 dW_AT_language = 0x13
56 dW_AT_comp_dir = 0x1b
57 dW_AT_producer = 0x25
58 dW_AT_external = 0x3f
59 dW_AT_frame_base = 0x40
60 dW_AT_use_UTF8 = 0x53
61 dW_AT_linkage_name = 0x6e
62
63 -- * Custom DWARF attributes
64 -- Chosen a more or less random section of the vendor-extensible region
65
66 -- ** Describing C-- blocks
67 -- These appear in DW_TAG_lexical_scope DIEs corresponding to C-- blocks
68 dW_AT_ghc_tick_parent :: Word
69 dW_AT_ghc_tick_parent = 0x2b20
70
71 -- ** Describing source notes
72 -- These appear in DW_TAG_ghc_src_note DIEs
73 dW_AT_ghc_span_file, dW_AT_ghc_span_start_line,
74 dW_AT_ghc_span_start_col, dW_AT_ghc_span_end_line,
75 dW_AT_ghc_span_end_col :: Word
76 dW_AT_ghc_span_file = 0x2b00
77 dW_AT_ghc_span_start_line = 0x2b01
78 dW_AT_ghc_span_start_col = 0x2b02
79 dW_AT_ghc_span_end_line = 0x2b03
80 dW_AT_ghc_span_end_col = 0x2b04
81
82
83 -- * Abbrev declarations
84 dW_CHILDREN_no, dW_CHILDREN_yes :: Word8
85 dW_CHILDREN_no = 0
86 dW_CHILDREN_yes = 1
87
88 dW_FORM_addr, dW_FORM_data2, dW_FORM_data4, dW_FORM_string, dW_FORM_flag,
89 dW_FORM_block1, dW_FORM_ref4, dW_FORM_ref_addr, dW_FORM_flag_present :: Word
90 dW_FORM_addr = 0x01
91 dW_FORM_data2 = 0x05
92 dW_FORM_data4 = 0x06
93 dW_FORM_string = 0x08
94 dW_FORM_flag = 0x0c
95 dW_FORM_block1 = 0x0a
96 dW_FORM_ref_addr = 0x10
97 dW_FORM_ref4 = 0x13
98 dW_FORM_flag_present = 0x19
99
100 -- * Dwarf native types
101 dW_ATE_address, dW_ATE_boolean, dW_ATE_float, dW_ATE_signed,
102 dW_ATE_signed_char, dW_ATE_unsigned, dW_ATE_unsigned_char :: Word
103 dW_ATE_address = 1
104 dW_ATE_boolean = 2
105 dW_ATE_float = 4
106 dW_ATE_signed = 5
107 dW_ATE_signed_char = 6
108 dW_ATE_unsigned = 7
109 dW_ATE_unsigned_char = 8
110
111 -- * Call frame information
112 dW_CFA_set_loc, dW_CFA_undefined, dW_CFA_same_value,
113 dW_CFA_def_cfa, dW_CFA_def_cfa_offset, dW_CFA_def_cfa_expression,
114 dW_CFA_expression, dW_CFA_offset_extended_sf, dW_CFA_def_cfa_offset_sf,
115 dW_CFA_def_cfa_sf, dW_CFA_val_offset, dW_CFA_val_expression,
116 dW_CFA_offset :: Word8
117 dW_CFA_set_loc = 0x01
118 dW_CFA_undefined = 0x07
119 dW_CFA_same_value = 0x08
120 dW_CFA_def_cfa = 0x0c
121 dW_CFA_def_cfa_offset = 0x0e
122 dW_CFA_def_cfa_expression = 0x0f
123 dW_CFA_expression = 0x10
124 dW_CFA_offset_extended_sf = 0x11
125 dW_CFA_def_cfa_sf = 0x12
126 dW_CFA_def_cfa_offset_sf = 0x13
127 dW_CFA_val_offset = 0x14
128 dW_CFA_val_expression = 0x16
129 dW_CFA_offset = 0x80
130
131 -- * Operations
132 dW_OP_addr, dW_OP_deref, dW_OP_consts,
133 dW_OP_minus, dW_OP_mul, dW_OP_plus,
134 dW_OP_lit0, dW_OP_breg0, dW_OP_call_frame_cfa :: Word8
135 dW_OP_addr = 0x03
136 dW_OP_deref = 0x06
137 dW_OP_consts = 0x11
138 dW_OP_minus = 0x1c
139 dW_OP_mul = 0x1e
140 dW_OP_plus = 0x22
141 dW_OP_lit0 = 0x30
142 dW_OP_breg0 = 0x70
143 dW_OP_call_frame_cfa = 0x9c
144
145 -- * Dwarf section declarations
146 dwarfInfoSection, dwarfAbbrevSection, dwarfLineSection,
147 dwarfFrameSection, dwarfGhcSection, dwarfARangesSection :: Platform -> SDoc
148 dwarfInfoSection platform = dwarfSection platform "info"
149 dwarfAbbrevSection platform = dwarfSection platform "abbrev"
150 dwarfLineSection platform = dwarfSection platform "line"
151 dwarfFrameSection platform = dwarfSection platform "frame"
152 dwarfGhcSection platform = dwarfSection platform "ghc"
153 dwarfARangesSection platform = dwarfSection platform "aranges"
154
155 dwarfSection :: Platform -> String -> SDoc
156 dwarfSection platform name =
157 case platformOS platform of
158 os | osElfTarget os
159 -> text "\t.section .debug_" <> text name <> text ",\"\","
160 <> sectionType platform "progbits"
161 | osMachOTarget os
162 -> text "\t.section __DWARF,__debug_" <> text name <> text ",regular,debug"
163 | otherwise
164 -> text "\t.section .debug_" <> text name <> text ",\"dr\""
165
166 -- * Dwarf section labels
167 dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: SDoc
168 dwarfInfoLabel = text ".Lsection_info"
169 dwarfAbbrevLabel = text ".Lsection_abbrev"
170 dwarfLineLabel = text ".Lsection_line"
171 dwarfFrameLabel = text ".Lsection_frame"
172
173 -- | Mapping of registers to DWARF register numbers
174 dwarfRegNo :: Platform -> Reg -> Word8
175 dwarfRegNo p r = case platformArch p of
176 ArchX86
177 | r == eax -> 0
178 | r == ecx -> 1 -- yes, no typo
179 | r == edx -> 2
180 | r == ebx -> 3
181 | r == esp -> 4
182 | r == ebp -> 5
183 | r == esi -> 6
184 | r == edi -> 7
185 ArchX86_64
186 | r == rax -> 0
187 | r == rdx -> 1 -- this neither. The order GCC allocates registers in?
188 | r == rcx -> 2
189 | r == rbx -> 3
190 | r == rsi -> 4
191 | r == rdi -> 5
192 | r == rbp -> 6
193 | r == rsp -> 7
194 | r == r8 -> 8
195 | r == r9 -> 9
196 | r == r10 -> 10
197 | r == r11 -> 11
198 | r == r12 -> 12
199 | r == r13 -> 13
200 | r == r14 -> 14
201 | r == r15 -> 15
202 | r == xmm0 -> 17
203 | r == xmm1 -> 18
204 | r == xmm2 -> 19
205 | r == xmm3 -> 20
206 | r == xmm4 -> 21
207 | r == xmm5 -> 22
208 | r == xmm6 -> 23
209 | r == xmm7 -> 24
210 | r == xmm8 -> 25
211 | r == xmm9 -> 26
212 | r == xmm10 -> 27
213 | r == xmm11 -> 28
214 | r == xmm12 -> 29
215 | r == xmm13 -> 30
216 | r == xmm14 -> 31
217 | r == xmm15 -> 32
218 ArchPPC_64 _ -> fromIntegral $ toRegNo r
219 ArchAArch64 -> fromIntegral $ toRegNo r
220 _other -> error "dwarfRegNo: Unsupported platform or unknown register!"
221
222 -- | Virtual register number to use for return address.
223 dwarfReturnRegNo :: Platform -> Word8
224 dwarfReturnRegNo p
225 -- We "overwrite" IP with our pseudo register - that makes sense, as
226 -- when using this mechanism gdb already knows the IP anyway. Clang
227 -- does this too, so it must be safe.
228 = case platformArch p of
229 ArchX86 -> 8 -- eip
230 ArchX86_64 -> 16 -- rip
231 ArchPPC_64 ELF_V2 -> 65 -- lr (link register)
232 ArchAArch64-> 30
233 _other -> error "dwarfReturnRegNo: Unsupported platform!"