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 ++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 112 insertions(+), 46 deletions(-) (limited to 'debug/CtoDwarf.ml') 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 = { -- cgit