Added translation fucntion for declarations and fundefinitions.

4 files changed, 148 insertions, 69 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 = {
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