Move more functionality in the new interface.

Added functions to add more information to the debuging interface,
like the struct layout with offsets, bitifiled layout and removed
the no longer needed mapping from stamp to atom.

5 files changed, 59 insertions, 27 deletions

diff --git a/debug/Debug.ml b/debug/Debug.ml
index eb195b33..ab20f630 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -21,9 +21,11 @@ type implem =
      mutable init: string -> unit;
      mutable atom_function: ident -> atom -> unit;
      mutable atom_global_variable: ident -> atom -> unit;
-     mutable set_composite_size: ident -> struct_or_union -> int -> unit;
-     mutable set_member_offset: ident -> string -> int -> int -> unit;
-     mutable insert_declaration: globdecl -> Env.t -> unit;
+     mutable set_composite_size: ident -> struct_or_union -> int option -> unit;
+     mutable set_member_offset: ident -> string -> int -> unit;
+     mutable set_bitfield_offset: ident -> string -> int -> string -> int -> unit;
+     mutable insert_global_declaration: Env.t -> globdecl -> unit;
+     mutable add_fun_addr: atom -> (int * int) -> unit
    }
 
 let implem =
@@ -32,8 +34,10 @@ let implem =
    atom_function = (fun _ _ -> ());
    atom_global_variable = (fun _ _ -> ());
    set_composite_size = (fun _ _ _ -> ());
-   set_member_offset = (fun _ _ _ _ -> ());
-   insert_declaration = (fun _ _ -> ());
+   set_member_offset = (fun _ _  _ -> ());
+   set_bitfield_offset = (fun _ _ _ _ _ -> ());
+   insert_global_declaration = (fun _ _ -> ());
+   add_fun_addr = (fun _ _ -> ());
  }
 
 let init () =
@@ -43,19 +47,25 @@ let init () =
     implem.atom_global_variable <- DebugInformation.atom_global_variable;
     implem.set_composite_size <- DebugInformation.set_composite_size;
     implem.set_member_offset <- DebugInformation.set_member_offset;
-    implem.insert_declaration <- DebugInformation.insert_declaration;
+    implem.set_bitfield_offset <- DebugInformation.set_bitfield_offset;
+    implem.insert_global_declaration <- DebugInformation.insert_global_declaration;
+    implem.add_fun_addr <- DebugInformation.add_fun_addr;
   end else begin
-   implem.init <- (fun _ -> ());
-   implem.atom_function <- (fun _ _ -> ());
-   implem.atom_global_variable <- (fun _ _ -> ());
-   implem.set_composite_size <- (fun _ _ _ -> ());
-   implem.set_member_offset <- (fun _ _ _ _ -> ());
-   implem.insert_declaration <- (fun _ _ -> ())
+    implem.init <- (fun _ -> ());
+    implem.atom_function <- (fun _ _ -> ());
+    implem.atom_global_variable <- (fun _ _ -> ());
+    implem.set_composite_size <- (fun _ _ _ -> ());
+    implem.set_member_offset <- (fun _ _ _ -> ());
+    implem.set_bitfield_offset <- (fun _ _ _ _ _ -> ());
+    implem.insert_global_declaration <- (fun _ _ -> ());
+    implem.add_fun_addr <- (fun _ _ -> ())
   end
 
 let init_compile_unit name = implem.init name
 let atom_function id atom = implem.atom_function id atom
 let atom_global_variable id atom = implem.atom_global_variable id atom
 let set_composite_size id sou size = implem.set_composite_size id sou size
-let set_member_offset id field off size = implem.set_member_offset id field off size
-let insert_declaration dec env = implem.insert_declaration dec env
+let set_member_offset id field off = implem.set_member_offset id field off
+let set_bitfield_offset id field off underlying size = implem.set_bitfield_offset id field off underlying size
+let insert_global_declaration env dec = implem.insert_global_declaration env dec
+let add_fun_addr atom addr = implem.add_fun_addr atom addr
diff --git a/debug/Debug.mli b/debug/Debug.mli
index ea72aeb4..ae32af5b 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -18,6 +18,8 @@ val init: unit -> unit
 val init_compile_unit: string -> unit
 val atom_function: ident -> atom -> unit
 val atom_global_variable: ident -> atom -> unit
-val set_composite_size: ident -> struct_or_union -> int -> unit
-val set_member_offset: ident -> string -> int -> int -> unit
-val insert_declaration: globdecl -> Env.t -> unit
+val set_composite_size: ident -> struct_or_union -> int option -> unit
+val set_member_offset: ident -> string -> int -> unit
+val set_bitfield_offset: ident -> string -> int -> string -> int -> unit
+val insert_global_declaration:  Env.t -> globdecl -> unit
+val add_fun_addr: atom -> (int * int) -> unit
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 30d026c7..53f73115 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -343,7 +343,9 @@ type function_information = {
     fun_return_type: int option; (* Again the special case of void functions *)
     fun_vararg:      bool;
     fun_parameter:   parameter_information list;
-    fun_locals:       int list;
+    fun_locals:      int list;
+    fun_low_pc:      int option;
+    fun_high_pc:     int option;
   }
 
 type definition_type =
@@ -373,6 +375,13 @@ let find_fun_stamp id =
   | Function f -> id,f
   |  _ -> assert false
 
+let find_fun_atom id =
+  let id = (Hashtbl.find atom_to_definition id) in
+  let f = Hashtbl.find definitions id in
+  match f with
+  | Function f -> id,f
+  |  _ -> assert false
+
 
 let replace_var id var =
   let var = GlobalVariable var in
@@ -388,7 +397,7 @@ let gen_comp_typ sou id at =
   else
     TUnion (id,at)
 
-let insert_declaration dec env =
+let insert_global_declaration env dec=
   let insert d_dec stamp =
     let id = next_id () in
     Hashtbl.add definitions id d_dec;
@@ -441,6 +450,8 @@ let insert_declaration dec env =
         fun_vararg = f.fd_vararg;
         fun_parameter = params;
         fun_locals = [];
+        fun_low_pc = None;
+        fun_high_pc = None;
       } in
       insert (Function fd) f.fd_name.stamp
   | Gcompositedecl (sou,id,at) -> 
@@ -481,18 +492,28 @@ let insert_declaration dec env =
         {en with enum_file_loc = Some dec.gloc; enum_enumerators = enumerator;})
   | Gpragma _ -> ()
 
-let set_member_offset str field offset byte_size =
+let set_member_offset str field offset =
   let id = find_type (TStruct (str,[])) in
   replace_composite id (fun comp ->
     let name f = f.cfd_name = field || match f.cfd_bitfield with Some n -> n = field | _ -> false in 
     let members = List.map (fun a -> if name a then
-          {a with cfd_byte_offset = Some offset; cfd_byte_size = Some byte_size;}
+          {a with cfd_byte_offset = Some offset;}
       else a) comp.ct_members in
     {comp with ct_members = members;})
 
 let set_composite_size comp sou size =
   let id = find_type (gen_comp_typ sou comp []) in
-  replace_composite id (fun comp -> {comp with ct_sizeof = Some size;}) 
+  replace_composite id (fun comp -> {comp with ct_sizeof = size;}) 
+
+let set_bitfield_offset str field offset underlying size =
+  let id = find_type (TStruct (str,[])) in
+  replace_composite id (fun comp ->
+    let name f = f.cfd_name = field in
+    let members = List.map (fun a -> if name a then
+      {a with cfd_bit_offset = Some offset; cfd_bitfield = Some underlying; cfd_byte_size = Some size}
+    else
+      a) comp.ct_members in
+    {comp with ct_members = members;})
 
 let atom_global_variable id atom = 
   let id,var = find_var_stamp id.stamp in
@@ -504,6 +525,10 @@ let atom_function id atom =
   replace_fun id ({f with fun_atom = Some atom;});
   Hashtbl.add atom_to_definition atom id
 
+let add_fun_addr atom (high,low) =
+  let id,f = find_fun_atom atom in
+  replace_fun id ({f with fun_high_pc = Some high; fun_low_pc = Some low;})
+
 let init name =
   id := 0;
   file_name := name;
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index c85a9efc..09cf72eb 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -130,7 +130,6 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
           add_attr_some e.formal_parameter_artificial (add_abbr_entry (0x34,artificial_type_abbr));
           add_location  (get_location e.formal_parameter_id) buf;
           add_attr_some e.formal_parameter_name add_name;
-          add_location  (get_segment_location e.formal_parameter_id) buf;
           add_type buf;
           add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,variable_parameter_type_abbr))
       | DW_TAG_label _ ->
@@ -205,7 +204,6 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
           add_attr_some e.variable_external (add_abbr_entry (0x3f,external_type_abbr));
           add_location  (get_location e.variable_id) buf;
           add_name buf;
-          add_location  (get_segment_location e.variable_id) buf;
           add_type buf
       | DW_TAG_volatile_type _ ->
           prologue 0x35;
@@ -367,7 +365,6 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       print_opt_value oc fp.formal_parameter_artificial print_flag;
       print_opt_value oc (get_location fp.formal_parameter_id) print_loc;
       print_opt_value oc fp.formal_parameter_name print_string;
-      print_opt_value oc  (get_segment_location fp.formal_parameter_id) print_loc;
       print_ref oc fp.formal_parameter_type;
       print_opt_value oc fp.formal_parameter_variable_parameter print_flag
 
@@ -441,7 +438,6 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       print_opt_value oc var.variable_external print_flag;
       print_opt_value oc (get_location var.variable_id) print_loc;
       print_string oc var.variable_name;
-      print_opt_value oc (get_segment_location var.variable_id) print_loc;
       print_ref oc var.variable_type
 
     let print_volatile_type oc vt =
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index 174f2403..b852d1f4 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -270,7 +270,6 @@ module type DWARF_TARGET=
     val name_of_section: section_name -> string
     val get_fun_addr: string -> (int * int) option
     val get_location: int -> location_value option
-    val get_segment_location: int -> location_value option
     val get_frame_base: int -> location_value option
     val symbol: out_channel -> atom -> unit
   end