From 3e070cae6a316b7e3363c8159096c3bbc4bf21b2 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Fri, 25 Sep 2015 21:12:48 +0200 Subject: Added translation of the range lists to location entries. --- debug/DebugInformation.ml | 32 ++++++++++++----- debug/DwarfPrinter.ml | 11 +++++- debug/DwarfTypes.mli | 1 + debug/DwarfUtil.ml | 2 ++ debug/Dwarfgen.ml | 88 +++++++++++++++++++++++++++++++++-------------- 5 files changed, 98 insertions(+), 36 deletions(-) (limited to 'debug') diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml index 459c4e9d..ec16f64e 100644 --- a/debug/DebugInformation.ml +++ b/debug/DebugInformation.ml @@ -695,6 +695,7 @@ module IntSet = Set.Make(struct end) let open_scopes: IntSet.t ref = ref IntSet.empty +let open_vars: atom list ref = ref [] let open_scope atom s_id lbl = try @@ -721,33 +722,46 @@ let close_scope atom s_id lbl = with Not_found -> () let start_live_range atom lbl loc = + let old_r = try + begin + match Hashtbl.find var_locations atom with + | RangeLoc old_r -> old_r + | _ -> assert false + end + with Not_found -> [] in + let n_r = { range_start = Some lbl; range_end = None; var_loc = loc } in + open_vars := atom::!open_vars; + Hashtbl.replace var_locations atom (RangeLoc (n_r::old_r)) + +let end_live_range atom lbl = try let old_r = Hashtbl.find var_locations atom in match old_r with - | RangeLoc old_r -> - let n_r = { range_start = Some lbl; range_end = None; var_loc = loc } in + | RangeLoc (n_r::old_r) -> + let n_r = {n_r with range_end = Some lbl} in Hashtbl.replace var_locations atom (RangeLoc (n_r::old_r)) | _ -> assert false with Not_found -> () - - -let end_live_range atom lbl = + +let close_range lbl atom = try let old_r = Hashtbl.find var_locations atom in match old_r with | RangeLoc (n_r::old_r) -> - let n_r = {n_r with range_end = Some lbl} in - Hashtbl.replace var_locations atom (RangeLoc (n_r::old_r)) + if n_r.range_end = None then + let n_r = {n_r with range_end = Some lbl} in + Hashtbl.replace var_locations atom (RangeLoc (n_r::old_r)) | _ -> assert false with Not_found -> () - let stack_variable atom (sp,loc) = Hashtbl.add var_locations atom (FunctionLoc (sp,loc)) let function_end atom loc = IntSet.iter (fun id -> close_scope atom id loc) !open_scopes; - open_scopes := IntSet.empty + open_scopes := IntSet.empty; + List.iter (close_range loc) !open_vars; + open_vars:= [] let init name = diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index 5f459a57..3e98f0dd 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -298,7 +298,8 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): | DW_OP_bregx _ -> 3 | DW_OP_plus_uconst _ -> 2 | DW_OP_piece _ -> 2 - + | DW_OP_reg i -> if i < 32 then 1 else 2 + let print_loc_expr oc = function | DW_OP_bregx (a,b) -> print_byte oc dw_op_bregx; @@ -310,6 +311,13 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): | DW_OP_piece i -> print_byte oc dw_op_piece; print_uleb128 oc i + | DW_OP_reg i -> + if i < 32 then + print_byte oc (dw_op_reg0 + i) + else begin + print_byte oc dw_op_regx; + print_uleb128 oc i + end let print_loc oc loc = match loc with @@ -544,6 +552,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): fprintf oc " .4byte 0\n" let print_location_list oc l = + fprintf oc" .section %s\n" (name_of_section Section_debug_loc); List.iter (print_location_entry oc) l (* Print the debug info and abbrev section *) diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index f01e550a..ce00474a 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -42,6 +42,7 @@ type location_expression = | DW_OP_plus_uconst of constant | DW_OP_bregx of int * int32 | DW_OP_piece of int + | DW_OP_reg of int type location_value = | LocSymbol of atom diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml index 954324f1..b0b80924 100644 --- a/debug/DwarfUtil.ml +++ b/debug/DwarfUtil.ml @@ -79,6 +79,8 @@ 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 diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml index 7b155419..4e531ca9 100644 --- a/debug/Dwarfgen.ml +++ b/debug/Dwarfgen.ml @@ -282,23 +282,58 @@ let function_parameter_to_entry acc p = } in new_entry (next_id ()) (DW_TAG_formal_parameter p),IntSet.add p.formal_parameter_type acc -let rec local_variable_to_entry f_id acc v id = - let loc = try +let gen_splitlong op_hi op_lo = + let op_piece = DW_OP_piece 4 in + op_piece::op_hi@(op_piece::op_lo) + +let translate_function_loc a = function + | BA_addrstack (ofs) -> + let ofs = camlint_of_coqint ofs in + Some (LocSimple (DW_OP_bregx (a,ofs))),[] + | BA_splitlong (BA_addrstack hi,BA_addrstack lo)-> + let hi = camlint_of_coqint hi + and lo = camlint_of_coqint lo in + if lo = Int32.add hi 4l then + Some (LocSimple (DW_OP_bregx (a,hi))),[] + else + let op_hi = [DW_OP_bregx (a,hi)] + and op_lo = [DW_OP_bregx (a,lo)] in + Some (LocList (gen_splitlong op_hi op_lo)),[] + | _ -> None,[] + +let range_entry_loc (sp,l) = + let rec aux = function + | BA i -> [DW_OP_reg i] + | BA_addrstack ofs -> + let ofs = camlint_of_coqint ofs in + [DW_OP_bregx (sp,ofs)] + | BA_splitlong (hi,lo) -> + let hi = aux hi + and lo = aux lo in + gen_splitlong hi lo + | _ -> assert false in + match aux l with + | [] -> assert false + | [a] -> LocSimple a + | a::rest -> LocList (a::rest) + +let rec local_variable_to_entry f_id (acc,bcc) v id = + let loc,loc_list = try begin match (Hashtbl.find var_locations (get_opt_val v.lvar_atom)) with - | FunctionLoc (a,BA_addrstack (ofs)) -> - let ofs = camlint_of_coqint ofs in - Some (LocSimple (DW_OP_bregx (a,ofs))) - | FunctionLoc (a,BA_splitlong ((BA_addrstack hi),(BA_addrstack lo))) -> - let hi = camlint_of_coqint hi - and lo = camlint_of_coqint lo in - if lo = Int32.add hi 4l then - Some (LocSimple (DW_OP_bregx (a,hi))) - else - Some (LocList [DW_OP_bregx (a,hi);DW_OP_piece 4;DW_OP_bregx (a,lo);DW_OP_piece 4]) - | _ -> None + | FunctionLoc (a,r) -> + translate_function_loc a r + | RangeLoc l -> + let l = List.map (fun i -> + let hi = get_opt_val i.range_start + and lo = get_opt_val i.range_end in + let hi = Hashtbl.find label_translation (f_id,hi) + and lo = Hashtbl.find label_translation (f_id,lo) in + hi,lo,range_entry_loc i.var_loc) l in + let id = next_id () in + Some (LocRef id),[{loc = l;loc_id = id;}] end - with Not_found -> None in + with Not_found -> None,[] in let var = { variable_file_loc = v.lvar_file_loc; variable_declaration = None; @@ -307,7 +342,7 @@ let rec local_variable_to_entry f_id acc v id = variable_type = v.lvar_type; variable_location = loc; } in - new_entry id (DW_TAG_variable var),IntSet.add v.lvar_type acc + new_entry id (DW_TAG_variable var),(IntSet.add v.lvar_type acc,loc_list@bcc) and scope_to_entry f_id acc sc id = let l_pc,h_pc = try @@ -344,7 +379,7 @@ let fun_scope_to_entries f_id acc id = | Scope sc ->mmap (local_to_entry f_id) acc sc.scope_variables | _ -> assert false) -let function_to_entry acc id f = +let function_to_entry (acc,bcc) id f = let f_tag = { subprogram_file_loc = f.fun_file_loc; subprogram_external = Some f.fun_external; @@ -358,23 +393,24 @@ let function_to_entry acc id f = let acc = match f.fun_return_type with Some s -> IntSet.add s acc | None -> acc in let f_entry = new_entry id (DW_TAG_subprogram f_tag) in let params,acc = mmap function_parameter_to_entry acc f.fun_parameter in - let vars,acc = fun_scope_to_entries f_id acc f.fun_scope in - add_children f_entry (params@vars),acc + let vars,(acc,bcc) = fun_scope_to_entries f_id (acc,bcc) f.fun_scope in + add_children f_entry (params@vars),(acc,bcc) -let definition_to_entry acc id t = +let definition_to_entry (acc,bcc) id t = match t with - | GlobalVariable g -> global_variable_to_entry acc id g - | Function f -> function_to_entry acc id f + | GlobalVariable g -> let e,acc = global_variable_to_entry acc id g in + e,(acc,bcc) + | Function f -> function_to_entry (acc,bcc) id f let gen_defs () = - let defs,typ = Hashtbl.fold (fun id t (acc,bcc) -> let t,bcc = definition_to_entry bcc id t in - t::acc,bcc) definitions ([],IntSet.empty) in - List.rev defs,typ + let defs,(typ,locs) = Hashtbl.fold (fun id t (acc,bcc) -> let t,bcc = definition_to_entry bcc id t in + t::acc,bcc) definitions ([],(IntSet.empty,[])) in + List.rev defs,typ,locs let gen_debug_info () : dw_entry * dw_locations= let cp = { compile_unit_name = !file_name; } in let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in - let defs,ty = gen_defs () in - add_children cp ((gen_types ty) @ defs),[] + let defs,ty,locs = gen_defs () in + add_children cp ((gen_types ty) @ defs),locs -- cgit