1 files changed, 112 insertions, 46 deletions

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 = {