diff options
Diffstat (limited to 'debug')
-rw-r--r-- | debug/CtoDwarf.ml | 93 | ||||
-rw-r--r-- | debug/DwarfPrinter.ml | 32 | ||||
-rw-r--r-- | debug/DwarfTypes.mli | 10 |
3 files changed, 92 insertions, 43 deletions
diff --git a/debug/CtoDwarf.ml b/debug/CtoDwarf.ml index a352e99f..cead6099 100644 --- a/debug/CtoDwarf.ml +++ b/debug/CtoDwarf.ml @@ -10,6 +10,7 @@ (* *) (* *********************************************************************) +open Builtins open C open Cprint open Cutil @@ -17,6 +18,7 @@ open C2C open DwarfTypes open DwarfUtil open Env +open Set (* Functions to translate a C Ast into Dwarf 2 debugging information *) @@ -28,10 +30,18 @@ let type_table: (string, int) Hashtbl.t = Hashtbl.create 7 let typedef_table: (string, int) Hashtbl.t = Hashtbl.create 7 (* Hashtable from composite table to entry id *) -let composite_types_table: (string, int) Hashtbl.t = Hashtbl.create 7 +let composite_types_table: (int, int) Hashtbl.t = Hashtbl.create 7 + +(* Hashtable from id of a defined composite types to minimal type info *) +let composite_declarations: (int, (struct_or_union * string * location)) Hashtbl.t = Hashtbl.create 7 + +module IntSet = Set.Make(struct type t = int let compare = compare end) + +(* Set of all declared composite_types *) +let composite_defined: IntSet.t ref = ref IntSet.empty (* Get the type id of a composite_type *) -let get_composite_type (name: string): int = +let get_composite_type (name: int): int = try Hashtbl.find composite_types_table name with Not_found -> @@ -231,7 +241,7 @@ and type_to_dwarf_entry typ typ_string= | TStruct (i,_) | TUnion (i,_) | TEnum (i,_) -> - let t = get_composite_type i.name in + let t = get_composite_type i.stamp in t,[] | TNamed (i,at) -> let t = Hashtbl.find typedef_table i.name in @@ -270,12 +280,12 @@ and type_to_dwarf (typ: typ): int * dw_entry list = attr_type_to_dwarf typ typ_string (* Translate a typedef to its corresponding dwarf representation *) -let typedef_to_dwarf (n,t) gloc = +let typedef_to_dwarf gloc (name,t) = let i,t = type_to_dwarf t in - Hashtbl.add typedef_table n.name i; + Hashtbl.add typedef_table name i; let td = { - typedef_file_loc = Some (gloc); - typedef_name = n.name; + typedef_file_loc = gloc; + typedef_name = name; typedef_type = i; } in let td = new_entry (DW_TAG_typedef td) in @@ -352,9 +362,9 @@ let enum_to_dwarf (n,at,e) gloc = enumeration_file_loc = Some gloc; enumeration_byte_size = bs; enumeration_declaration = Some false; - enumeration_name = n.name; + enumeration_name = if n.name <> "" then Some n.name else None; } in - let id = get_composite_type n.name in + let id = get_composite_type n.stamp in let child = List.map enumerator_to_dwarf e in let enum = { @@ -371,9 +381,9 @@ let struct_to_dwarf (n,at,m) env gloc = structure_file_loc = Some gloc; structure_byte_size = info.ci_sizeof; structure_declaration = Some false; - structure_name = n.name; + structure_name = if n.name <> "" then Some n.name else None; } in - let id = get_composite_type n.name in + let id = get_composite_type n.stamp in let rec pack acc bcc l m = match m with | [] -> acc,bcc,[] @@ -394,7 +404,7 @@ let struct_to_dwarf (n,at,m) env gloc = member_bit_size = Some n; member_data_member_location = None; member_declaration = None; - member_name = m.fld_name; + member_name = if m.fld_name <> "" then Some m.fld_name else None; member_type = t; } in pack ((new_entry (DW_TAG_member um))::acc) (e@bcc) (l + n) ms) @@ -412,7 +422,7 @@ let struct_to_dwarf (n,at,m) env gloc = member_bit_size = None; member_data_member_location = None; member_declaration = None; - member_name = m.fld_name; + member_name = if m.fld_name <> "" then Some m.fld_name else None; member_type = t; } in translate ((new_entry (DW_TAG_member um))::acc) (e@bcc) ms @@ -434,9 +444,9 @@ let union_to_dwarf (n,at,m) env gloc = union_file_loc = Some gloc; union_byte_size = info.ci_sizeof; union_declaration = Some false; - union_name = n.name; + union_name = if n.name <> "" then Some n.name else None; } in - let id = get_composite_type n.name in + let id = get_composite_type n.stamp in let children,e = mmap (fun acc f -> let t,e = type_to_dwarf f.fld_typ in @@ -447,7 +457,7 @@ let union_to_dwarf (n,at,m) env gloc = member_bit_size = None; member_data_member_location = None; member_declaration = None; - member_name = f.fld_name; + member_name = if f.fld_name <> "" then Some f.fld_name else None; member_type = t; } in new_entry (DW_TAG_member um),e@acc)[] m in @@ -461,21 +471,48 @@ let union_to_dwarf (n,at,m) env gloc = let globdecl_to_dwarf env (typs,decls) decl = PrintAsmaux.add_file (fst decl.gloc); match decl.gdesc with - | Gtypedef (n,t) -> let ret = typedef_to_dwarf (n,t) decl.gloc in + | Gtypedef (n,t) -> let ret = typedef_to_dwarf (Some decl.gloc) (n.name,t) in typs@ret,decls | Gdecl d -> let t,d = glob_var_to_dwarf d decl.gloc in typs@t,d::decls | Gfundef f -> let t,d = fundef_to_dwarf f decl.gloc in typs@t,d::decls - | Genumdef (n,at,e) ->let ret = enum_to_dwarf (n,at,e) decl.gloc in - typs@ret,decls - | Gcompositedef (Struct,n,at,m) -> let ret = struct_to_dwarf (n,at,m) env decl.gloc in - typs@ret,decls - | Gcompositedef (Union,n,at,m) -> let ret = union_to_dwarf (n,at,m) env decl.gloc in - typs@ret,decls - | Gcompositedecl _ + | Genumdef (n,at,e) -> + composite_defined:= IntSet.add n.stamp !composite_defined; + let ret = enum_to_dwarf (n,at,e) decl.gloc in + typs@ret,decls + | Gcompositedef (Struct,n,at,m) -> + composite_defined:= IntSet.add n.stamp !composite_defined; + let ret = struct_to_dwarf (n,at,m) env decl.gloc in + typs@ret,decls + | Gcompositedef (Union,n,at,m) -> + composite_defined:= IntSet.add n.stamp !composite_defined; + let ret = union_to_dwarf (n,at,m) env decl.gloc in + typs@ret,decls + | Gcompositedecl (sou,i,_) -> Hashtbl.add composite_declarations i.stamp (sou,i.name,decl.gloc); + typs,decls | Gpragma _ -> typs,decls +let forward_declaration_to_dwarf sou name loc stamp = + let id = get_composite_type stamp in + let tag = match sou with + | Struct -> + DW_TAG_structure_type{ + structure_file_loc = Some loc; + structure_byte_size = None; + structure_declaration = Some true; + structure_name = if name <> "" then Some name else None; + } + | Union -> + DW_TAG_union_type { + union_file_loc = Some loc; + union_byte_size = None; + union_declaration = Some true; + union_name = if name <> "" then Some name else None; + } in + {tag = tag; children = []; id = id} + + (* Compute the dwarf representations of global declarations. The second program argument is the program after the bitfield and packed struct transformation *) let program_to_dwarf prog prog1 name = @@ -485,8 +522,12 @@ let program_to_dwarf prog prog1 name = let prog = cleanupGlobals (prog) in let env = translEnv Env.empty prog1 in reset_id (); - let typs,defs = List.fold_left (globdecl_to_dwarf env) ([],[]) prog in - let defs = typs @ defs in + let typs = List.map (typedef_to_dwarf None) C2C.builtins.typedefs in + let typs = List.concat typs in + let typs,defs = List.fold_left (globdecl_to_dwarf env) (typs,[]) prog in + let typs = Hashtbl.fold (fun i (sou,name,loc) typs -> if not (IntSet.mem i !composite_defined) then + (forward_declaration_to_dwarf sou name loc i)::typs else typs) composite_declarations typs in + let defs = typs @ defs in let cp = { compile_unit_name = name; } in diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index 13d4049e..9e565ee4 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -62,6 +62,11 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): let add_low_pc = add_abbr_entry (0x11,low_pc_type_abbr) + let add_fun_pc sp buf = + match get_fun_addr sp.subprogram_name with + | None ->() + | Some (a,b) -> add_high_pc buf; add_low_pc buf + let add_declaration = add_abbr_entry (0x3c,declaration_type_abbr) let add_location loc buf = @@ -112,7 +117,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): add_attr_some e.enumeration_file_loc add_file_loc; add_byte_size buf; add_attr_some e.enumeration_declaration add_declaration; - add_name buf + add_attr_some e.enumeration_name add_name | DW_TAG_enumerator e -> prologue 0x28; add_attr_some e.enumerator_file_loc add_file_loc; @@ -146,7 +151,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): | Some (DataLocBlock __) -> add_abbr_entry (0x38,data_location_block_type_abbr) buf | Some (DataLocRef _) -> add_abbr_entry (0x38,data_location_ref_type_abbr) buf); add_attr_some e.member_declaration add_declaration; - add_name buf; + add_attr_some e.member_name add_name; add_type buf | DW_TAG_pointer_type _ -> prologue 0xf; @@ -156,7 +161,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): add_attr_some e.structure_file_loc add_file_loc; add_attr_some e.structure_byte_size add_byte_size; add_attr_some e.structure_declaration add_declaration; - add_name buf + add_attr_some e.structure_name add_name | DW_TAG_subprogram e -> prologue 0x2e; add_attr_some e.subprogram_file_loc add_file_loc; @@ -187,7 +192,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): add_attr_some e.union_file_loc add_file_loc; add_attr_some e.union_byte_size add_byte_size; add_attr_some e.union_declaration add_declaration; - add_name buf + add_attr_some e.union_name add_name | DW_TAG_unspecified_parameter e -> prologue 0x18; add_attr_some e.unspecified_parameter_file_loc add_file_loc; @@ -328,7 +333,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): print_string oc bt.base_type_name let print_compilation_unit oc tag = - let prod_name = sprintf "AbsInt Angewandte Informatik GmbH:CompCert Version %s:%s" Configuration.version Configuration.arch in + let prod_name = sprintf "AbsInt Angewandte Informatik GmbH:CompCert Version %s:%s" Version.version Configuration.arch in print_string oc (Sys.getcwd ()); print_addr oc (get_start_addr ()); print_addr oc (get_end_addr ()); @@ -344,7 +349,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): print_file_loc oc et.enumeration_file_loc; print_uleb128 oc et.enumeration_byte_size; print_opt_value oc et.enumeration_declaration print_flag; - print_string oc et.enumeration_name + print_opt_value oc et.enumeration_name print_string let print_enumerator oc en = print_file_loc oc en.enumerator_file_loc; @@ -375,7 +380,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): print_opt_value oc mb.member_bit_size print_byte; print_opt_value oc mb.member_data_member_location print_data_location; print_opt_value oc mb.member_declaration print_flag; - print_string oc mb.member_name; + print_opt_value oc mb.member_name print_string; print_ref oc mb.member_type let print_pointer oc pt = @@ -385,15 +390,18 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): print_file_loc oc st.structure_file_loc; print_opt_value oc st.structure_byte_size print_uleb128; print_opt_value oc st.structure_declaration print_flag; - print_string oc st.structure_name + print_opt_value oc st.structure_name print_string + let print_subprogram_addr oc (s,e) = + fprintf oc " .4byte %a\n" label s; + fprintf oc " .4byte %a\n" label e + let print_subprogram oc sp = - let s,e = get_fun_addr sp.subprogram_name in + let addr = get_fun_addr sp.subprogram_name in print_file_loc oc sp.subprogram_file_loc; print_opt_value oc sp.subprogram_external print_flag; print_opt_value oc sp.subprogram_frame_base print_loc; - fprintf oc " .4byte %a\n" label s; - fprintf oc " .4byte %a\n" label e; + print_opt_value oc addr print_subprogram_addr; print_string oc sp.subprogram_name; print_flag oc sp.subprogram_prototyped; print_opt_value oc sp.subprogram_type print_ref @@ -415,7 +423,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): print_file_loc oc ut.union_file_loc; print_opt_value oc ut.union_byte_size print_uleb128; print_opt_value oc ut.union_declaration print_flag; - print_string oc ut.union_name + print_opt_value oc ut.union_name print_string let print_unspecified_parameter oc up = print_file_loc oc up.unspecified_parameter_file_loc; diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index c02558b5..d6592bd9 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -80,7 +80,7 @@ type dw_tag_enumeration_type = enumeration_file_loc: file_loc option; enumeration_byte_size: constant; enumeration_declaration: flag option; - enumeration_name: string; + enumeration_name: string option; } type dw_tag_enumerator = @@ -121,7 +121,7 @@ type dw_tag_member = member_bit_size: constant option; member_data_member_location: data_location_value option; member_declaration: flag option; - member_name: string; + member_name: string option; member_type: reference; } @@ -135,7 +135,7 @@ type dw_tag_structure_type = structure_file_loc: file_loc option; structure_byte_size: constant option; structure_declaration: flag option; - structure_name: string; + structure_name: string option; } type dw_tag_subprogram = @@ -172,7 +172,7 @@ type dw_tag_union_type = union_file_loc: file_loc option; union_byte_size: constant option; union_declaration: flag option; - union_name: string; + union_name: string option; } type dw_tag_unspecified_parameter = @@ -268,5 +268,5 @@ module type DWARF_TARGET= val get_end_addr: unit -> int val get_stmt_list_addr: unit -> int val name_of_section: section_name -> string - val get_fun_addr: string -> int * int + val get_fun_addr: string -> (int * int) option end |