Skip to content

Commit bc63a2b

Browse files
committed
DWARF inlined frames support
1 parent ac1ef36 commit bc63a2b

19 files changed

+947
-58
lines changed

backend/debug/dwarf/dwarf_flags/dwarf_flags.ml

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ let use_g () =
7272
then use_g1 ()
7373
else current_debug_settings := bytecode_g
7474

75-
let restrict_to_upstream_dwarf = ref true
75+
let restrict_to_upstream_dwarf = ref false
7676

7777
(* Currently the maximum number of stack slots, see asmgen.ml *)
7878
let dwarf_max_function_complexity = ref 50
@@ -141,3 +141,5 @@ let default_gdwarf_self_tail_calls = true
141141
let gdwarf_self_tail_calls = ref default_gdwarf_self_tail_calls
142142

143143
let gdwarf_may_alter_codegen = ref false
144+
145+
let dwarf_inlined_frames = ref false

backend/debug/dwarf/dwarf_flags/dwarf_flags.mli

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -68,3 +68,9 @@ val default_ddebug_invariants : bool
6868
val ddebug_invariants : bool ref
6969

7070
val gdwarf_may_alter_codegen : bool ref
71+
72+
(** Setting this to [true] will emit sufficient DWARF to get inlined frame
73+
information, but won't emit information e.g. about local variables (unless
74+
[restrict_to_upstream_dwarf] is set to [false], although that implies
75+
this variable being set to [true]). *)
76+
val dwarf_inlined_frames : bool ref

backend/debug/dwarf/dwarf_ocaml/dwarf.ml

Lines changed: 18 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,9 @@ let create ~sourcefile ~unit_name ~asm_directives ~get_file_id ~code_begin
6161
DS.create ~compilation_unit_header_label ~compilation_unit_proto_die
6262
~value_type_proto_die ~start_of_code_symbol debug_loc_table
6363
debug_ranges_table address_table location_list_table
64+
~get_file_num:get_file_id
65+
(* CR mshinwell: does get_file_id successfully emit .file directives for
66+
files we haven't seen before? *)
6467
in
6568
{ state;
6669
asm_directives;
@@ -75,18 +78,29 @@ type fundecl =
7578
}
7679

7780
let dwarf_for_fundecl t fundecl ~fun_end_label =
78-
if not (!Clflags.debug && not !Dwarf_flags.restrict_to_upstream_dwarf)
81+
if not
82+
(!Clflags.debug
83+
&& ((not !Dwarf_flags.restrict_to_upstream_dwarf)
84+
|| !Dwarf_flags.dwarf_inlined_frames))
7985
then { fun_end_label; fundecl }
8086
else
8187
let available_ranges_vars, fundecl =
82-
Profile.record "debug_available_ranges_vars"
83-
(fun fundecl -> Available_ranges_vars.create fundecl)
88+
if not !Dwarf_flags.restrict_to_upstream_dwarf
89+
then
90+
Profile.record "debug_available_ranges_vars"
91+
(fun fundecl -> Available_ranges_vars.create fundecl)
92+
~accumulate:true fundecl
93+
else Available_ranges_vars.empty, fundecl
94+
in
95+
let inlined_frame_ranges, fundecl =
96+
Profile.record "debug_inlined_frame_ranges"
97+
(fun fundecl -> Inlined_frame_ranges.create fundecl)
8498
~accumulate:true fundecl
8599
in
86100
Dwarf_concrete_instances.for_fundecl ~get_file_id:t.get_file_id t.state
87101
fundecl
88102
~fun_end_label:(Asm_label.create_int Text fun_end_label)
89-
available_ranges_vars;
103+
available_ranges_vars inlined_frame_ranges;
90104
{ fun_end_label; fundecl }
91105

92106
let emit t ~basic_block_sections ~binary_backend_available =
Lines changed: 178 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,178 @@
1+
(******************************************************************************
2+
* flambda-backend *
3+
* Mark Shinwell, Jane Street *
4+
* -------------------------------------------------------------------------- *
5+
* MIT License *
6+
* *
7+
* Copyright (c) 2024 Jane Street Group LLC *
8+
9+
* *
10+
* Permission is hereby granted, free of charge, to any person obtaining a *
11+
* copy of this software and associated documentation files (the "Software"), *
12+
* to deal in the Software without restriction, including without limitation *
13+
* the rights to use, copy, modify, merge, publish, distribute, sublicense, *
14+
* and/or sell copies of the Software, and to permit persons to whom the *
15+
* Software is furnished to do so, subject to the following conditions: *
16+
* *
17+
* The above copyright notice and this permission notice shall be included *
18+
* in all copies or substantial portions of the Software. *
19+
* *
20+
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *
21+
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *
22+
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *
23+
* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
24+
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *
25+
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *
26+
* DEALINGS IN THE SOFTWARE. *
27+
******************************************************************************)
28+
29+
open! Asm_targets
30+
open! Dwarf_low
31+
open! Dwarf_high
32+
module DAH = Dwarf_attribute_helpers
33+
module DS = Dwarf_state
34+
module L = Linear
35+
36+
let attributes fun_name =
37+
[DAH.create_name fun_name; DAH.create_external ~is_visible_externally:true]
38+
39+
let abstract_instance_proto_die_symbol ~fun_symbol =
40+
Asm_symbol.create (Asm_symbol.to_raw_string fun_symbol ^ "_absinst")
41+
42+
let add_empty state ~compilation_unit_proto_die ~fun_symbol ~demangled_name =
43+
let abstract_instance_proto_die =
44+
(* DWARF-5 specification section 3.3.8.1, page 82. *)
45+
Proto_die.create ~parent:(Some compilation_unit_proto_die) ~tag:Subprogram
46+
~attribute_values:
47+
[ DAH.create_name (Asm_symbol.encode fun_symbol);
48+
DAH.create_linkage_name ~linkage_name:demangled_name;
49+
DAH.create_external ~is_visible_externally:true ]
50+
()
51+
in
52+
let abstract_instance_proto_die_symbol =
53+
abstract_instance_proto_die_symbol ~fun_symbol
54+
in
55+
Proto_die.set_name abstract_instance_proto_die
56+
abstract_instance_proto_die_symbol;
57+
Asm_symbol.Tbl.add
58+
(DS.function_abstract_instances state)
59+
fun_symbol
60+
(abstract_instance_proto_die, abstract_instance_proto_die_symbol);
61+
abstract_instance_proto_die, abstract_instance_proto_die_symbol
62+
63+
let add_root state ~parent ~demangled_name fun_symbol ~location_attributes =
64+
let attributes =
65+
[ DAH.create_name (Asm_symbol.encode fun_symbol);
66+
DAH.create_linkage_name ~linkage_name:demangled_name;
67+
DAH.create_external ~is_visible_externally:true ]
68+
@ location_attributes
69+
in
70+
let attribute_values =
71+
attributes
72+
@ [ (* We assume every function might potentially be inlined (and possibly
73+
in the future), so we choose [DW_INL_inlined] as the most appropriate
74+
setting for [DW_AT_inline], even if it doesn't seem exactly correct.
75+
We must set something here to ensure that the subprogram is marked as
76+
an abstract instance root. *)
77+
DAH.create_inline Inlined ]
78+
in
79+
let abstract_instance_proto_die_symbol =
80+
abstract_instance_proto_die_symbol ~fun_symbol
81+
in
82+
DS.Debug.log "add_root: fun_symbol=%a\n" Asm_symbol.print fun_symbol;
83+
let abstract_instance_proto_die =
84+
match
85+
Asm_symbol.Tbl.find (DS.function_abstract_instances state) fun_symbol
86+
with
87+
| proto_die, _symbol ->
88+
(* See below in [find] *)
89+
Proto_die.replace_all_attribute_values proto_die attribute_values
90+
| exception Not_found ->
91+
(* DWARF-5 specification section 3.3.8.1, page 82. *)
92+
Proto_die.create ~parent:(Some parent) ~tag:Subprogram ~attribute_values
93+
()
94+
in
95+
Proto_die.set_name abstract_instance_proto_die
96+
abstract_instance_proto_die_symbol;
97+
Asm_symbol.Tbl.add (* or replace *)
98+
(DS.function_abstract_instances state)
99+
fun_symbol
100+
(abstract_instance_proto_die, abstract_instance_proto_die_symbol);
101+
abstract_instance_proto_die, abstract_instance_proto_die_symbol
102+
103+
type decomposed_singleton_debuginfo =
104+
{ demangled_name : string;
105+
fun_symbol : Asm_symbol.t;
106+
compilation_unit : Compilation_unit.t
107+
}
108+
109+
let decompose_singleton_debuginfo dbg =
110+
let orig_dbg = dbg in
111+
match Debuginfo.to_items dbg with
112+
| [({ dinfo_scopes; dinfo_function_symbol; _ } as item)] -> (
113+
let module S = Debuginfo.Scoped_location in
114+
let compilation_unit = S.compilation_unit dinfo_scopes in
115+
let dbg = Debuginfo.of_items [item] in
116+
let fun_symbol =
117+
match dinfo_function_symbol with
118+
| Some dinfo_function_symbol -> Asm_symbol.create dinfo_function_symbol
119+
| None ->
120+
Misc.fatal_errorf
121+
"No function symbol in Debuginfo.t: orig_dbg=%a dbg=%a"
122+
Debuginfo.print_compact_extended orig_dbg
123+
Debuginfo.print_compact_extended dbg
124+
in
125+
let demangled_name =
126+
Debuginfo.Scoped_location.string_of_scopes dinfo_scopes
127+
|> Misc.remove_double_underscores
128+
in
129+
match compilation_unit with
130+
| Some compilation_unit -> { demangled_name; fun_symbol; compilation_unit }
131+
| None ->
132+
Misc.fatal_errorf "No compilation unit extracted from: %a"
133+
Debuginfo.print_compact_extended dbg)
134+
| [] -> Misc.fatal_error "Empty Debuginfo.t"
135+
| _ :: _ ->
136+
Misc.fatal_errorf "Non-singleton Debuginfo.t: %a"
137+
Debuginfo.print_compact_extended dbg
138+
139+
type find_result =
140+
| Ok of Asm_symbol.t
141+
| External_unit of
142+
{ demangled_name : string;
143+
fun_symbol : Asm_symbol.t
144+
}
145+
146+
let find state ~compilation_unit_proto_die (dbg : Debuginfo.t) =
147+
let { demangled_name; fun_symbol; compilation_unit = dbg_comp_unit } =
148+
decompose_singleton_debuginfo dbg
149+
in
150+
DS.Debug.log "found comp unit %a\n%!" Compilation_unit.print dbg_comp_unit;
151+
let this_comp_unit = Compilation_unit.get_current_exn () in
152+
if Compilation_unit.equal dbg_comp_unit this_comp_unit
153+
then (
154+
DS.Debug.log "looking in function_abstract_instances for %a\n%!"
155+
Asm_symbol.print fun_symbol;
156+
match
157+
Asm_symbol.Tbl.find (DS.function_abstract_instances state) fun_symbol
158+
with
159+
| existing_instance ->
160+
DS.Debug.log "...successfully found existing absint DIE\n%!";
161+
Ok (snd existing_instance)
162+
| exception Not_found ->
163+
(* Fabricate an empty abstract instance DIE to fill in later, just in case
164+
we haven't seen things in topological order. *)
165+
(* CR mshinwell: does that actually happen now? *)
166+
DS.Debug.log "...making empty absint DIE for %a\n" Asm_symbol.print
167+
fun_symbol;
168+
(* The empty abstract instances are parented to the compilation unit as
169+
they might be referenced by other DIEs in a completely different scope
170+
within the current unit. *)
171+
let _, die_symbol =
172+
add_empty state ~compilation_unit_proto_die ~fun_symbol ~demangled_name
173+
in
174+
Ok die_symbol)
175+
else
176+
(* abstract_instance_proto_die_symbol ~fun_symbol *)
177+
(* See the call site of this function *)
178+
External_unit { demangled_name; fun_symbol }
Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
(******************************************************************************
2+
* flambda-backend *
3+
* Mark Shinwell, Jane Street *
4+
* -------------------------------------------------------------------------- *
5+
* MIT License *
6+
* *
7+
* Copyright (c) 2024 Jane Street Group LLC *
8+
9+
* *
10+
* Permission is hereby granted, free of charge, to any person obtaining a *
11+
* copy of this software and associated documentation files (the "Software"), *
12+
* to deal in the Software without restriction, including without limitation *
13+
* the rights to use, copy, modify, merge, publish, distribute, sublicense, *
14+
* and/or sell copies of the Software, and to permit persons to whom the *
15+
* Software is furnished to do so, subject to the following conditions: *
16+
* *
17+
* The above copyright notice and this permission notice shall be included *
18+
* in all copies or substantial portions of the Software. *
19+
* *
20+
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *
21+
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *
22+
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *
23+
* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
24+
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *
25+
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *
26+
* DEALINGS IN THE SOFTWARE. *
27+
******************************************************************************)
28+
29+
(** Management of DWARF "abstract instances" for functions. *)
30+
31+
open! Asm_targets
32+
open! Dwarf_low
33+
open! Dwarf_high
34+
35+
val attributes : string -> Dwarf_attribute_values.Attribute_value.t list
36+
37+
(** Add an abstract instance root. *)
38+
val add_root :
39+
Dwarf_state.t ->
40+
parent:Proto_die.t ->
41+
demangled_name:string ->
42+
Asm_symbol.t ->
43+
location_attributes:Dwarf_attribute_values.Attribute_value.t list ->
44+
Proto_die.t * Asm_symbol.t
45+
46+
type find_result = private
47+
| Ok of Asm_symbol.t
48+
| External_unit of
49+
{ demangled_name : string;
50+
fun_symbol : Asm_symbol.t
51+
}
52+
53+
val find :
54+
Dwarf_state.t ->
55+
compilation_unit_proto_die:Proto_die.t ->
56+
Debuginfo.t ->
57+
find_result
58+
(* val find_maybe_in_another_unit_or_add : Dwarf_state.t ->
59+
function_proto_die:Proto_die.t -> Linear.fundecl -> Asm_symbol.t option *)

0 commit comments

Comments
 (0)