From 5492b5b55afa68e3d628da07ff583a0cac79b7e3 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Mon, 28 Sep 2015 13:36:53 +0200 Subject: Added location for the formal parameters and move the end of all scopes before the last statement. --- debug/Debug.ml | 3 +++ debug/Debug.mli | 2 ++ debug/DebugInformation.ml | 29 ++++++++++++++++++++++------- debug/DebugInit.ml | 7 +++++-- debug/DwarfPrinter.ml | 6 ++++-- debug/DwarfTypes.mli | 1 + debug/Dwarfgen.ml | 38 ++++++++++++++++++++++---------------- 7 files changed, 59 insertions(+), 27 deletions(-) (limited to 'debug') diff --git a/debug/Debug.ml b/debug/Debug.ml index a496b610..d0de9e98 100644 --- a/debug/Debug.ml +++ b/debug/Debug.ml @@ -44,6 +44,7 @@ type implem = mutable stack_variable: atom -> int * int builtin_arg -> unit; mutable function_end: atom -> positive -> unit; mutable add_label: atom -> positive -> int -> unit; + mutable atom_parameter: ident -> ident -> atom -> unit; } let implem = @@ -70,6 +71,7 @@ let implem = stack_variable = (fun _ _ -> ()); function_end = (fun _ _ -> ()); add_label = (fun _ _ _ -> ()); + atom_parameter = (fun _ _ _ -> ()); } let init_compile_unit name = implem.init name @@ -94,3 +96,4 @@ let end_live_range atom lbl = implem.end_live_range atom lbl let stack_variable atom loc = implem.stack_variable atom loc let function_end atom loc = implem.function_end atom loc let add_label atom p lbl = implem.add_label atom p lbl +let atom_parameter fid pid atom = implem.atom_parameter fid pid atom diff --git a/debug/Debug.mli b/debug/Debug.mli index 5ef1e7f5..c5fcddb3 100644 --- a/debug/Debug.mli +++ b/debug/Debug.mli @@ -42,6 +42,7 @@ type implem = mutable stack_variable: atom -> int * int builtin_arg -> unit; mutable function_end: atom -> positive -> unit; mutable add_label: atom -> positive -> int -> unit; + mutable atom_parameter: ident -> ident -> atom -> unit; } val implem: implem @@ -68,3 +69,4 @@ val stack_variable: atom -> int * int builtin_arg -> unit val function_end: atom -> positive -> unit val add_label: atom -> positive -> int -> unit val generate_debug_info: unit -> (dw_entry * dw_locations) option +val atom_parameter: ident -> ident -> atom -> unit diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml index ec16f64e..8b6ec1ad 100644 --- a/debug/DebugInformation.ml +++ b/debug/DebugInformation.ml @@ -29,6 +29,10 @@ let next_id () = let reset_id () = id := 0 +(* Auximilary functions *) +let list_replace c f l = + List.map (fun a -> if c a then f a else a) l + (* The name of the current compilation unit *) let file_name: string ref = ref "" @@ -349,6 +353,7 @@ type global_variable_information = { type parameter_information = { parameter_name: string; + parameter_ident: int; parameter_atom: atom option; parameter_type: int; } @@ -512,6 +517,7 @@ let insert_global_declaration env dec= let ty = insert_type ty in { parameter_name = p.name; + parameter_ident = p.stamp; parameter_atom = None; parameter_type = ty; }) f.fd_params in @@ -572,9 +578,7 @@ let set_member_offset str field offset = let id = find_type (TStruct (str,[])) in replace_composite id (fun comp -> let name f = f.cfd_name = field || match f.cfd_bitfield with Some n -> n = field | _ -> false in - let members = List.map (fun a -> if name a then - {a with cfd_byte_offset = Some offset;} - else a) comp.ct_members in + let members = list_replace name (fun a -> {a with cfd_byte_offset = Some offset;}) comp.ct_members in {comp with ct_members = members;}) let set_composite_size comp sou size = @@ -585,10 +589,9 @@ let set_bitfield_offset str field offset underlying size = let id = find_type (TStruct (str,[])) in replace_composite id (fun comp -> let name f = f.cfd_name = field in - let members = List.map (fun a -> if name a then - {a with cfd_bit_offset = Some offset; cfd_bitfield = Some underlying; cfd_byte_size = Some size} - else - a) comp.ct_members in + let members = list_replace name (fun a -> + {a with cfd_bit_offset = Some offset; cfd_bitfield = Some underlying; cfd_byte_size = Some size}) + comp.ct_members in {comp with ct_members = members;}) let atom_global_variable id atom = @@ -606,6 +609,14 @@ let atom_function id atom = Hashtbl.iter (fun (fid,sid) tid -> if fid = id.stamp then Hashtbl.add atom_to_scope (atom,sid) tid) scope_to_local with Not_found -> () + +let atom_parameter fid id atom = + try + let fid',f = find_fun_stamp fid.stamp in + let name p = p.parameter_ident = id.stamp in + let params = list_replace name (fun p -> {p with parameter_atom = Some atom;}) f.fun_parameter in + replace_fun fid' ({f with fun_parameter = params;}) + with Not_found -> () let add_fun_addr atom (high,low) = try @@ -763,6 +774,8 @@ let function_end atom loc = List.iter (close_range loc) !open_vars; open_vars:= [] +let compilation_section_start: (string,int) Hashtbl.t = Hashtbl.create 7 +let compilation_section_end: (string,int) Hashtbl.t = Hashtbl.create 7 let init name = id := 0; @@ -776,3 +789,5 @@ let init name = Hashtbl.reset stamp_to_local; Hashtbl.reset atom_to_local; Hashtbl.reset scope_to_local; + Hashtbl.reset compilation_section_start; + Hashtbl.reset compilation_section_end diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml index 40be9f42..17db4354 100644 --- a/debug/DebugInit.ml +++ b/debug/DebugInit.ml @@ -40,7 +40,8 @@ let init_debug () = implem.end_live_range <- DebugInformation.end_live_range; implem.stack_variable <- DebugInformation.stack_variable; implem.function_end <- DebugInformation.function_end; - implem.add_label <- DebugInformation.add_label + implem.add_label <- DebugInformation.add_label; + implem.atom_parameter <- DebugInformation.atom_parameter let init_none () = implem.init <- (fun _ -> ()); @@ -64,7 +65,9 @@ let init_none () = implem.end_live_range <- (fun _ _ -> ()); implem.stack_variable <- (fun _ _ -> ()); implem.function_end <- (fun _ _ -> ()); - implem.add_label <- (fun _ _ _ -> ()) + implem.add_label <- (fun _ _ _ -> ()); + implem.atom_parameter <- (fun _ _ _ -> ()) + let init () = if !Clflags.option_g then diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index 63ba4cd0..32c15dfd 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -131,7 +131,8 @@ module DwarfPrinter(Target: DWARF_TARGET): add_attr_some e.formal_parameter_artificial (add_abbr_entry (0x34,artificial_type_abbr)); add_attr_some e.formal_parameter_name add_name; add_type buf; - add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,variable_parameter_type_abbr)) + add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,variable_parameter_type_abbr)); + add_location e.formal_parameter_location buf | DW_TAG_label _ -> prologue 0xa; add_low_pc buf; @@ -419,7 +420,8 @@ module DwarfPrinter(Target: DWARF_TARGET): print_opt_value oc fp.formal_parameter_artificial print_flag; print_opt_value oc fp.formal_parameter_name print_string; print_ref oc fp.formal_parameter_type; - print_opt_value oc fp.formal_parameter_variable_parameter print_flag + print_opt_value oc fp.formal_parameter_variable_parameter print_flag; + print_opt_value oc fp.formal_parameter_location print_loc let print_tag_label oc tl = print_ref oc tl.label_low_pc; diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index 86a14163..8c2a7d56 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -107,6 +107,7 @@ type dw_tag_formal_parameter = formal_parameter_name: string option; formal_parameter_type: reference; formal_parameter_variable_parameter: flag option; + formal_parameter_location: location_value option; } type dw_tag_label = diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml index 4e531ca9..7fce22a7 100644 --- a/debug/Dwarfgen.ml +++ b/debug/Dwarfgen.ml @@ -145,6 +145,7 @@ let fun_type_to_entry id f = formal_parameter_name = if p.param_name <> "" then Some p.param_name else None; formal_parameter_type = p.param_type; formal_parameter_variable_parameter = None; + formal_parameter_location = None; } in new_entry (next_id ()) (DW_TAG_formal_parameter fp)) f.fun_params; in @@ -272,16 +273,6 @@ let global_variable_to_entry acc id v = } in new_entry id (DW_TAG_variable var),IntSet.add v.gvar_type acc -let function_parameter_to_entry acc p = - let p = { - formal_parameter_file_loc = None; - formal_parameter_artificial = None; - formal_parameter_name = Some p.parameter_name; - formal_parameter_type = p.parameter_type; - formal_parameter_variable_parameter = None; - } in - new_entry (next_id ()) (DW_TAG_formal_parameter p),IntSet.add p.formal_parameter_type acc - let gen_splitlong op_hi op_lo = let op_piece = DW_OP_piece 4 in op_piece::op_hi@(op_piece::op_lo) @@ -317,10 +308,10 @@ let range_entry_loc (sp,l) = | [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 +let location_entry f_id atom = + try begin - match (Hashtbl.find var_locations (get_opt_val v.lvar_atom)) with + match (Hashtbl.find var_locations atom) with | FunctionLoc (a,r) -> translate_function_loc a r | RangeLoc l -> @@ -331,9 +322,24 @@ let rec local_variable_to_entry f_id (acc,bcc) v id = 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;}] + Some (LocRef id),[{loc = l;loc_id = id;}] end - with Not_found -> None,[] in + with Not_found -> None,[] + +let function_parameter_to_entry f_id (acc,bcc) p = + let loc,loc_list = location_entry f_id (get_opt_val p.parameter_atom) in + let p = { + formal_parameter_file_loc = None; + formal_parameter_artificial = None; + formal_parameter_name = Some p.parameter_name; + formal_parameter_type = p.parameter_type; + formal_parameter_variable_parameter = None; + formal_parameter_location = loc; + } in + new_entry (next_id ()) (DW_TAG_formal_parameter p),(IntSet.add p.formal_parameter_type acc,loc_list@bcc) + +let rec local_variable_to_entry f_id (acc,bcc) v id = + let loc,loc_list = location_entry f_id (get_opt_val v.lvar_atom) in let var = { variable_file_loc = v.lvar_file_loc; variable_declaration = None; @@ -392,7 +398,7 @@ let function_to_entry (acc,bcc) id f = let f_id = get_opt_val f.fun_atom in 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 params,(acc,bcc) = mmap (function_parameter_to_entry f_id) (acc,bcc) f.fun_parameter in let vars,(acc,bcc) = fun_scope_to_entries f_id (acc,bcc) f.fun_scope in add_children f_entry (params@vars),(acc,bcc) -- cgit