1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
(* *********************************************************************)
(* *)
(* The Compcert verified compiler *)
(* *)
(* Bernhard Schommer, AbsInt Angewandte Informatik GmbH *)
(* *)
(* AbsInt Angewandte Informatik GmbH. All rights reserved. This file *)
(* is distributed under the terms of the INRIA Non-Commercial *)
(* License Agreement. *)
(* *)
(* *********************************************************************)
(* Utility functions for the dwarf debugging type *)
open DwarfTypes
(* Generate a new entry from a given tag *)
let new_entry id tag =
{
tag = tag;
children = [];
id = id;
}
(* Add an entry as child to another entry *)
let add_child entry child =
{entry with children = child::entry.children;}
(* Add entries as children to another entry *)
let add_children entry children =
{entry with children = entry.children@children;}
let list_iter_with_next f list =
let rec aux = (function
| [] -> ()
| [a] -> f None a
| a::b::rest -> f (Some b.id) a; aux (b::rest)) in
aux list
(* Iter over the tree and pass the sibling id *)
let entry_iter_sib f g entry =
let rec aux sib entry =
f sib entry;
list_iter_with_next aux entry.children;
g entry in
aux None entry
(* Fold over the tree in prefix order *)
let rec entry_fold f acc entry =
let acc = f acc entry.tag in
List.fold_left (entry_fold f) acc entry.children
(* Return the code and the corresponding comment for a DW_FORM *)
let code_of_dw_form = function
| DW_FORM_addr -> 0x01,"DW_FORM_addr"
| DW_FORM_block2 -> 0x03,"DW_FORM_block2"
| DW_FORM_block4 -> 0x04,"DW_FORM_block4"
| DW_FORM_data2 -> 0x05,"DW_FORM_data2"
| DW_FORM_data4 -> 0x06,"DW_FORM_data4"
| DW_FORM_data8 -> 0x07,"DW_FORM_data8"
| DW_FORM_string -> 0x08,"DW_FORM_string"
| DW_FORM_block -> 0x09,"DW_FORM_block"
| DW_FORM_block1 -> 0x0a,"DW_FORM_block1"
| DW_FORM_data1 -> 0x0b,"DW_FORM_data1"
| DW_FORM_flag -> 0x0c,"DW_FORM_flag"
| DW_FORM_sdata -> 0x0d,"DW_FORM_sdata"
| DW_FORM_strp -> 0x0e,"DW_FORM_strp"
| DW_FORM_udata -> 0x0f,"DW_FORM_udata"
| DW_FORM_ref_addr -> 0x10,"DW_FORM_ref_addr"
| DW_FORM_ref1 -> 0x11,"DW_FORM_ref1"
| DW_FORM_ref2 -> 0x12,"DW_FORM_ref2"
| DW_FORM_ref4 -> 0x13,"DW_FORM_ref4"
| DW_FORM_ref8 -> 0x14,"DW_FORM_ref8"
| DW_FORM_ref_udata -> 0x15,"DW_FORM_ref_udata"
| DW_FORM_ref_indirect -> 0x16,"DW_FORM_ref_indirect"
(* Attribute form encoding *)
let dw_form_addr = 0x01
let dw_form_block2 = 0x03
let dw_form_block4 = 0x04
let dw_form_data2 = 0x05
let dw_form_data4 = 0x06
let dw_form_data8 = 0x07
let dw_form_string = 0x08
let dw_form_block = 0x09
let dw_form_block1 = 0x0a
let dw_form_data1 = 0x0b
let dw_form_flag = 0x0c
let dw_form_sdata = 0x0d
let dw_form_strp = 0x0e
let dw_form_udata = 0x0f
let dw_form_ref_addr = 0x10
let dw_form_ref1 = 0x11
let dw_form_ref2 = 0x12
let dw_form_ref4 = 0x13
let dw_form_ref8 = 0x14
let dw_ref_udata = 0x15
let dw_ref_indirect = 0x16
(* Operation encoding *)
let dw_op_addr = 0x3
let dw_op_plus_uconst = 0x23
let dw_op_reg0 = 0x50
let dw_op_regx = 0x90
let dw_op_bregx = 0x92
let dw_op_piece = 0x93
(* Tag to string function *)
let string_of_dw_tag = function
| DW_TAG_array_type _ -> "DW_TAG_array_type"
| DW_TAG_compile_unit _ -> "DW_TAG_compile_unit"
| DW_TAG_base_type _ -> "DW_TAG_base_type"
| DW_TAG_const_type _ -> "DW_TAG_const_type"
| DW_TAG_enumeration_type _ -> "DW_TAG_enumeration_type"
| DW_TAG_enumerator _ -> "DW_TAG_enumerator"
| DW_TAG_formal_parameter _ -> "DW_TAG_formal_parameter"
| DW_TAG_label _ -> "DW_TAG_label"
| DW_TAG_lexical_block _ -> "DW_TAG_lexical_block"
| DW_TAG_member _ -> "DW_TAG_member"
| DW_TAG_pointer_type _ -> "DW_TAG_pointer_type"
| DW_TAG_structure_type _ -> "DW_TAG_structure_type"
| DW_TAG_subprogram _ -> "DW_TAG_subprogram"
| DW_TAG_subrange_type _ -> "DW_TAG_subrange_type"
| DW_TAG_subroutine_type _ -> "DW_TAG_subroutine_type"
| DW_TAG_typedef _ -> "DW_TAG_typedef"
| DW_TAG_union_type _ -> "DW_TAG_union_type"
| DW_TAG_unspecified_parameter _ -> "DW_TAG_unspecified_parameter"
| DW_TAG_variable _ -> "DW_TAG_variable"
| DW_TAG_volatile_type _ -> "DW_TAG_volatile_type"
(* Sizeof functions for the encoding of uleb128 and sleb128 *)
let sizeof_uleb128 value =
let size = ref 1 in
let value = ref (value lsr 7) in
while !value <> 0 do
value := !value lsr 7;
incr size;
done;
!size
let sizeof_sleb128 value =
let size = ref 1 in
let byte = ref (value land 0x7f) in
let value = ref (value lsr 7) in
while not ((!value = 0 && (!byte land 0x40) = 0) || (!value = -1 && ((!byte land 0x40) <> 0))) do
byte := !value land 0x7f;
value := !value lsr 7;
incr size;
done;
!size
let size_of_loc_expr = function
| DW_OP_bregx (a,b) -> 1 + (sizeof_uleb128 a) + (sizeof_sleb128 (Int32.to_int b))
| DW_OP_plus_uconst a
| DW_OP_piece a -> 1 + (sizeof_uleb128 a)
| DW_OP_reg i -> if i < 32 then 1 else 1 + (sizeof_uleb128 i)
|
