From 275d7f4091609ae30093a4a83a20a74997229f9c Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Mon, 23 Mar 2015 13:39:27 +0100 Subject: Added translation fucntion for declarations and fundefinitions. --- debug/CtoDwarf.ml | 158 +++++++++++++++++++++++++++++++++++--------------- debug/DwarfPrinter.ml | 31 +++++----- debug/DwarfTypes.mli | 21 +++++-- debug/DwarfUtil.ml | 7 ++- 4 files changed, 148 insertions(+), 69 deletions(-) (limited to 'debug') diff --git a/debug/CtoDwarf.ml b/debug/CtoDwarf.ml index 206061b6..01a34829 100644 --- a/debug/CtoDwarf.ml +++ b/debug/CtoDwarf.ml @@ -12,9 +12,9 @@ open C open Cprint +open Cutil open DwarfTypes open DwarfUtil -open Machine (* Functions to translate a C Ast into Dwarf 2 debugging information *) @@ -22,8 +22,20 @@ open Machine (* Hashtable from type name to entry id *) let type_table: (string, int) Hashtbl.t = Hashtbl.create 7 -(* Hashtable from typedefname to entry id *) -let defined_types_table: (string, int) Hashtbl.t = Hashtbl.create 7 +(* Hashtable for typedefname to entry id *) +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 get_composite_type (name: string): int = + try + Hashtbl.find composite_types_table name + with Not_found -> + let id = next_id () in + Hashtbl.add composite_types_table name id; + id + let typ_to_string (ty: typ) = let buf = Buffer.create 7 in @@ -39,26 +51,28 @@ let rec mmap f env = function let (tl', env2) = mmap f env1 tl in (hd' :: tl', env2) +let attr_to_dw attr_list id entries = + List.fold_left (fun (id,entry) attr -> + match attr with + | AConst -> let const_tag = DW_TAG_const_type ({const_type = id;}) in + let const_entry = new_entry const_tag in + const_entry.id,const_entry::entry + | AVolatile -> let volatile_tag = DW_TAG_volatile_type ({volatile_type = id;}) in + let volatile_entry = new_entry volatile_tag in + volatile_entry.id,volatile_entry::entry + | ARestrict + | AAlignas _ + | Attr _ -> id,entry) (id,entries) (List.rev attr_list) +let attr_to_dw_tag attr_list tag = + let entry = new_entry tag in + attr_to_dw attr_list entry.id [entry] + + let rec type_to_dwarf (typ: typ): int * dw_entry list = let typ_string = typ_to_string typ in try Hashtbl.find type_table typ_string,[] with Not_found -> - let attr_to_dw attr_list id entries = - List.fold_left (fun (id,entry) attr -> - match attr with - | AConst -> let const_tag = DW_TAG_const_type ({const_type = id;}) in - let const_entry = new_entry const_tag in - const_entry.id,const_entry::entry - | AVolatile -> let volatile_tag = DW_TAG_volatile_type ({volatile_type = id;}) in - let volatile_entry = new_entry volatile_tag in - volatile_entry.id,volatile_entry::entry - | ARestrict - | AAlignas _ - | Attr _ -> id,entry) (id,entries) (List.rev attr_list) in - let attr_to_dw_tag attr_list tag = - let entry = new_entry tag in - attr_to_dw attr_list entry.id [entry] in let id,entries = match typ with | TVoid at -> let void = { @@ -68,35 +82,23 @@ let rec type_to_dwarf (typ: typ): int * dw_entry list = } in attr_to_dw_tag at (DW_TAG_base_type void) | TInt (k,at) -> - let byte_size,encoding,name = + let encoding = (match k with - | IBool -> 1,DW_ATE_boolean,"_Bool" - | IChar -> 1,(if !config.char_signed then DW_ATE_signed_char else DW_ATE_unsigned_char),"char" - | ISChar -> 1,DW_ATE_signed_char,"signed char" - | IUChar -> 1,DW_ATE_unsigned_char,"unsigned char" - | IInt -> !config.sizeof_int,DW_ATE_signed,"signed int" - | IUInt -> !config.sizeof_int,DW_ATE_unsigned,"unsigned int" - | IShort -> !config.sizeof_short,DW_ATE_signed,"signed short" - | IUShort -> !config.sizeof_short,DW_ATE_unsigned,"unsigned short" - | ILong -> !config.sizeof_long, DW_ATE_signed,"long" - | IULong -> !config.sizeof_long, DW_ATE_unsigned,"unsigned long" - | ILongLong -> !config.sizeof_longlong, DW_ATE_signed,"long long" - | IULongLong -> !config.sizeof_longlong, DW_ATE_unsigned,"unsigned long long")in + | IBool -> DW_ATE_boolean + | IChar -> (if !Machine.config.Machine.char_signed then DW_ATE_signed_char else DW_ATE_unsigned_char) + | ILong | ILongLong | IShort | ISChar -> DW_ATE_signed_char + | _ -> DW_ATE_unsigned)in let int = { - base_type_byte_size = byte_size; + base_type_byte_size = sizeof_ikind k; base_type_encoding = Some encoding; - base_type_name = name;} in + base_type_name = typ_string;} in attr_to_dw_tag at (DW_TAG_base_type int) | TFloat (k,at) -> - let byte_size,name = - (match k with - | FFloat -> !config.sizeof_float,"float" - | FDouble -> !config.sizeof_double,"double" - | FLongDouble -> !config.sizeof_longdouble,"long double") in + let byte_size = sizeof_fkind k in let float = { base_type_byte_size = byte_size; base_type_encoding = Some DW_ATE_float; - base_type_name = name; + base_type_name = typ_string; } in attr_to_dw_tag at (DW_TAG_base_type float) | TPtr (t,at) -> @@ -144,9 +146,11 @@ let rec type_to_dwarf (typ: typ): int * dw_entry list = attr_to_dw at s.id ((s::others)@et) | TStruct (i,at) | TUnion (i,at) - | TEnum (i,at) + | TEnum (i,at) -> + let t = Hashtbl.find composite_types_table i.name in + attr_to_dw at t [] | TNamed (i,at) -> - let t = Hashtbl.find defined_types_table i.name in + let t = Hashtbl.find typedef_table i.name in attr_to_dw at t [] | TArray (child,size,at) -> let size_to_subrange s = @@ -184,15 +188,77 @@ let rec type_to_dwarf (typ: typ): int * dw_entry list = let rec globdecl_to_dwarf decl = match decl.gdesc with - | Gtypedef (n,t) -> let i,t = type_to_dwarf t in - Hashtbl.add defined_types_table n.name i; - t + | Gtypedef (n,t) -> + let i,t = type_to_dwarf t in + Hashtbl.add typedef_table n.name i; + let td = { + typedef_file_loc = Some (decl.gloc); + typedef_name = n.name; + typedef_type = i; + } in + let td = new_entry (DW_TAG_typedef td) in + td::t + | Gdecl (s,n,t,_) -> + let i,t = type_to_dwarf t in + let at_decl = (match s with + | Storage_extern -> true + | _ -> false) in + let ext = (match s with + | Storage_static -> false + | _ -> true) in + let decl = { + variable_file_loc = (Some decl.gloc); + variable_declaration = Some at_decl; + variable_external = Some ext; + variable_location = None; + variable_name = n.name; + variable_segment = None; + variable_type = i; + } in + let decl = new_entry (DW_TAG_variable decl) in + decl::t + | Gfundef f -> + let ret,e = (match f.fd_ret with + | TVoid _ -> None,[] + | _ -> let i,t = type_to_dwarf f.fd_ret in + Some i,t) in + let ext = (match f.fd_storage with + | Storage_static -> false + | _ -> true) in + let fdef = { + subprogram_file_loc = (Some decl.gloc); + subprogram_external = Some ext; + subprogram_frame_base = None; + subprogram_name = f.fd_name.name; + subprogram_prototyped = true; + subprogram_type = ret; + } in + let fp,e = mmap (fun acc (p,t) -> + let t,e = type_to_dwarf t in + let fp = + { + formal_parameter_file_loc = None; + formal_parameter_artificial = None; + formal_parameter_location = None; + formal_parameter_name = (Some p.name); + formal_parameter_segment = None; + formal_parameter_type = t; + formal_parameter_variable_parameter = None; + } in + let entry = new_entry (DW_TAG_formal_parameter fp) in + entry,(e@acc)) e f.fd_params in + let fdef = new_entry (DW_TAG_subprogram fdef) in + let fdef = add_children fdef fp in + fdef::e + | Genumdef _ + | Gcompositedef _ | Gpragma _ - | _ -> [] + | Gcompositedecl _ -> [] let program_to_dwarf prog name = Hashtbl.reset type_table; - Hashtbl.reset defined_types_table; + Hashtbl.reset composite_types_table; + Hashtbl.reset typedef_table; reset_id (); let defs = List.concat (List.map globdecl_to_dwarf prog) in let cp = { diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index 6010ac20..9ed70089 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -17,7 +17,7 @@ open Printf open PrintAsmaux open Sections -module DwarfPrinter(Target: TARGET) : +module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS): sig val print_debug: out_channel -> dw_entry -> unit end = @@ -25,7 +25,6 @@ module DwarfPrinter(Target: TARGET) : open Target - let string_of_byte value = sprintf " .byte %s\n" (if value then "0x1" else "0x0") @@ -34,7 +33,7 @@ module DwarfPrinter(Target: TARGET) : let curr_abbrev = ref 1 - let next_abbrev = + let next_abbrev () = let abbrev = !curr_abbrev in incr curr_abbrev;abbrev @@ -133,8 +132,8 @@ module DwarfPrinter(Target: TARGET) : add_type buf | DW_TAG_base_type b -> prologue 0x24; - add_attr_some b.base_type_encoding add_encoding; add_byte_size buf; + add_attr_some b.base_type_encoding add_encoding; add_name buf | DW_TAG_compile_unit e -> prologue 0x11; @@ -203,7 +202,7 @@ module DwarfPrinter(Target: TARGET) : add_low_pc buf; add_name buf; add_prototyped buf; - add_type buf + add_attr_some e.subprogram_type add_type; | DW_TAG_subrange_type e -> prologue 0x21; add_attr_some e.subrange_type add_type; @@ -247,7 +246,7 @@ module DwarfPrinter(Target: TARGET) : (try Hashtbl.find abbrev_mapping abbrev_string with Not_found -> - let id = next_abbrev in + let id = next_abbrev () in abbrevs:=(abbrev_string,id)::!abbrevs; Hashtbl.add abbrev_mapping abbrev_string id; id) @@ -257,7 +256,7 @@ module DwarfPrinter(Target: TARGET) : let has_sib = match sib with | None -> false | Some _ -> true in - ignore (get_abbrev entry has_sib)) entry + ignore (get_abbrev entry has_sib)) (fun _ -> ()) entry let abbrev_start_addr = ref (-1) @@ -284,7 +283,7 @@ module DwarfPrinter(Target: TARGET) : List.iter (fun (s,id) -> abbrev_prologue oc id; output_string oc s; - abbrev_epilogue oc) abbrevs; + abbrev_epilogue oc) abbrevs; abbrev_section_end oc let debug_start_addr = ref (-1) @@ -345,7 +344,7 @@ module DwarfPrinter(Target: TARGET) : let print_base_type oc bt = print_byte oc bt.base_type_byte_size; - match bt.base_type_encoding with + (match bt.base_type_encoding with | Some e -> let encoding = match e with | DW_ATE_address -> 0x1 @@ -358,7 +357,7 @@ module DwarfPrinter(Target: TARGET) : | DW_ATE_unsigned_char -> 0x8 in print_byte oc encoding; - | None -> (); + | None -> ()); print_string oc bt.base_type_name let print_compilation_unit oc tag = @@ -421,14 +420,15 @@ module DwarfPrinter(Target: TARGET) : print_string oc st.structure_name let print_subprogram oc sp = + let s,e = 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; - print_ref oc sp.subprogram_high_pc; - print_ref oc sp.subprogram_low_pc; + fprintf oc " .4byte %a\n" label s; + fprintf oc " .4byte %a\n" label e; print_string oc sp.subprogram_name; print_flag oc sp.subprogram_prototyped; - print_ref oc sp.subprogram_type + print_opt_value oc sp.subprogram_type print_ref let print_subrange oc sr = print_opt_value oc sr.subrange_type print_ref; @@ -443,6 +443,7 @@ module DwarfPrinter(Target: TARGET) : print_string oc td.typedef_name; print_ref oc td.typedef_type + let print_union_type oc ut = print_file_loc oc ut.union_file_loc; print_uleb128 oc ut.union_byte_size; @@ -498,8 +499,8 @@ module DwarfPrinter(Target: TARGET) : | DW_TAG_unspecified_parameter up -> print_unspecified_parameter oc up | DW_TAG_variable var -> print_variable oc var | DW_TAG_volatile_type vt -> print_volatile_type oc vt - end; - if entry.children = [] then + end) (fun e -> + if e.children <> [] then print_sleb128 oc 0) entry let print_debug_abbrev oc entry = diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index 4f434c4d..22f88a12 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -12,6 +12,8 @@ (* Types used for writing dwarf debug information *) +open Sections + (* Basic types for the value of attributes *) type constant = int @@ -130,9 +132,9 @@ type dw_tag_pointer_type = type dw_tag_structure_type = { - structure_file_loc: file_loc option; + structure_file_loc: file_loc option; structure_byte_size: constant; - structure_declaration: flag option; + structure_declaration: flag option; structure_name: string; } @@ -141,11 +143,9 @@ type dw_tag_subprogram = subprogram_file_loc: file_loc option; subprogram_external: flag option; subprogram_frame_base: location_value option; - subprogram_high_pc: address; - subprogram_low_pc: address; subprogram_name: string; subprogram_prototyped: flag; - subprogram_type: reference; + subprogram_type: reference option; } type dw_tag_subrange_type = @@ -257,3 +257,14 @@ module type DWARF_ABBREVS = val bound_const_type_abbr: int val bound_ref_type_abbr: int end + +module type DWARF_TARGET= + sig + val label: out_channel -> int -> unit + val print_file_loc: out_channel -> file_loc -> unit + val get_start_addr: unit -> int + 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 + end diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml index 91ef94a8..7b81be4c 100644 --- a/debug/DwarfUtil.ml +++ b/debug/DwarfUtil.ml @@ -50,10 +50,11 @@ let list_iter_with_next f list = aux list (* Iter over the tree and pass the sibling id *) -let entry_iter_sib f entry = +let entry_iter_sib f g entry = let rec aux sib entry = - f sib entry; - list_iter_with_next aux entry.children in + f sib entry; + list_iter_with_next aux entry.children; + g entry in aux None entry -- cgit