aboutsummaryrefslogtreecommitdiffstats
path: root/debug
diff options
context:
space:
mode:
Diffstat (limited to 'debug')
-rw-r--r--debug/CtoDwarf.ml93
-rw-r--r--debug/DwarfPrinter.ml32
-rw-r--r--debug/DwarfTypes.mli10
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
generated by cgit (git 2.34.1) at 2024-07-03 19:13:08 +0000