First step to implemente address ranges for the gnu backend.

In contrast to the dcc, the gcc uses address ranges to express
non-contiguous range of addresses. As a first step we set the
start and end addresses for the different address ranges for
the compilation unit by using the start and end addresses of
functions.
Bug 17392.

7 files changed, 95 insertions, 76 deletions

diff --git a/debug/Debug.ml b/debug/Debug.ml
index 14176d3b..87d04ad7 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -29,7 +29,7 @@ type implem =
       set_member_offset: ident -> string -> int -> unit;
       set_bitfield_offset: ident -> string -> int -> string -> int -> unit;
       insert_global_declaration: Env.t -> globdecl -> unit;
-      add_fun_addr: atom -> (int * int) -> unit;
+      add_fun_addr: atom -> section_name -> (int * int) -> unit;
       generate_debug_info: (atom -> string) -> string -> debug_entries option;
       all_files_iter: (string -> unit) -> unit;
       insert_local_declaration:  storage -> ident -> typ -> location -> unit;
@@ -44,14 +44,12 @@ type implem =
       stack_variable: (atom * atom) -> int * int builtin_arg -> unit;
       add_label: atom -> positive -> int -> unit;
       atom_parameter: ident -> ident -> atom -> unit;
-      add_compilation_section_start: section_name -> int -> unit;
-      add_compilation_section_end: section_name -> int -> unit;
       compute_diab_file_enum: (section_name -> int) -> (string-> int) -> (unit -> unit) -> unit;
       compute_gnu_file_enum: (string -> unit) -> unit;
       exists_section: section_name -> bool;
       remove_unused: ident -> unit;
       variable_printed: string -> unit;
-      add_diab_info: section_name -> int -> int -> unit;
+      add_diab_info: section_name -> int -> int -> int -> unit;
    }
 
 let default_implem =
@@ -62,7 +60,7 @@ let default_implem =
    set_member_offset = (fun _ _  _ -> ());
    set_bitfield_offset = (fun _ _ _ _ _ -> ());
    insert_global_declaration = (fun _ _ -> ());
-   add_fun_addr = (fun _ _ -> ());
+   add_fun_addr = (fun _ _ _ -> ());
    generate_debug_info = (fun _  _ -> None);
    all_files_iter = (fun _ -> ());
    insert_local_declaration = (fun  _ _ _ _ -> ());
@@ -77,14 +75,12 @@ let default_implem =
    stack_variable = (fun _ _ -> ());
    add_label = (fun _ _ _ -> ());
    atom_parameter = (fun _ _ _ -> ());
-   add_compilation_section_start = (fun _ _ -> ());
-   add_compilation_section_end = (fun _ _ -> ());
    compute_diab_file_enum = (fun _ _ _ -> ());
    compute_gnu_file_enum = (fun _ -> ());
    exists_section = (fun _ -> true);
    remove_unused = (fun _ -> ());
    variable_printed = (fun _ -> ());
-   add_diab_info = (fun _ _ _ -> ());
+   add_diab_info = (fun _ _ _ _ -> ());
 }
 
 let implem = ref default_implem
@@ -110,11 +106,9 @@ let end_live_range atom lbl = !implem.end_live_range atom lbl
 let stack_variable atom loc = !implem.stack_variable atom loc
 let add_label atom p lbl = !implem.add_label atom p lbl
 let atom_parameter fid pid atom = !implem.atom_parameter fid pid atom
-let add_compilation_section_start sec addr = !implem.add_compilation_section_start sec addr
-let add_compilation_section_end sec addr = !implem.add_compilation_section_end sec addr
 let exists_section sec = !implem.exists_section sec
 let compute_diab_file_enum end_l entry_l line_e = !implem.compute_diab_file_enum end_l entry_l line_e
 let compute_gnu_file_enum f = !implem.compute_gnu_file_enum f
 let remove_unused ident = !implem.remove_unused ident
 let variable_printed ident = !implem.variable_printed ident
-let add_diab_info sec addr = !implem.add_diab_info sec addr
+let add_diab_info sec line_start debug_info low_pc = !implem.add_diab_info sec line_start debug_info low_pc
diff --git a/debug/Debug.mli b/debug/Debug.mli
index 83d5703b..1585e7e4 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -27,7 +27,7 @@ type implem =
      set_member_offset: ident -> string -> int -> unit;
      set_bitfield_offset: ident -> string -> int -> string -> int -> unit;
      insert_global_declaration: Env.t -> globdecl -> unit;
-     add_fun_addr: atom -> (int * int) -> unit;
+     add_fun_addr: atom -> section_name -> (int * int) -> unit;
      generate_debug_info: (atom -> string) -> string -> debug_entries option;
      all_files_iter: (string -> unit) -> unit;
      insert_local_declaration:  storage -> ident -> typ -> location -> unit;
@@ -42,14 +42,12 @@ type implem =
      stack_variable: (atom * atom) -> int * int builtin_arg -> unit;
      add_label: atom -> positive -> int -> unit;
      atom_parameter: ident -> ident -> atom -> unit;
-     add_compilation_section_start: section_name -> int -> unit;
-     add_compilation_section_end: section_name -> int -> unit;
      compute_diab_file_enum: (section_name -> int) -> (string-> int) -> (unit -> unit) -> unit;
      compute_gnu_file_enum: (string -> unit) -> unit;
      exists_section: section_name -> bool;
      remove_unused: ident -> unit;
      variable_printed: string -> unit;
-     add_diab_info: section_name ->  int  -> int -> unit;
+     add_diab_info: section_name ->  int -> int -> int -> unit;
    }
 
 val default_implem: implem
@@ -62,7 +60,7 @@ 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
+val add_fun_addr: atom -> section_name -> (int * int) -> unit
 val all_files_iter: (string -> unit) -> unit
 val insert_local_declaration: storage -> ident -> typ -> location -> unit
 val atom_local_variable: ident -> atom -> unit
@@ -77,11 +75,9 @@ val stack_variable: (atom * atom) -> int * int builtin_arg -> unit
 val add_label: atom -> positive -> int -> unit
 val generate_debug_info: (atom -> string) -> string -> debug_entries option
 val atom_parameter: ident -> ident -> atom -> unit
-val add_compilation_section_start: section_name -> int -> unit
-val add_compilation_section_end: section_name -> int -> unit
 val compute_diab_file_enum: (section_name -> int) -> (string-> int) -> (unit -> unit) -> unit
 val compute_gnu_file_enum: (string -> unit) -> unit
 val exists_section: section_name -> bool
 val remove_unused: ident -> unit
 val variable_printed: string -> unit
-val add_diab_info: section_name ->  int  -> int -> unit
+val add_diab_info: section_name ->  int -> int  -> int -> unit
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 95f34b1d..51fbfde9 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -593,10 +593,20 @@ let add_compilation_section_end sec addr =
   let sec = section_to_string sec in
   Hashtbl.add compilation_section_end sec addr
 
-let add_diab_info sec addr1 add2 =
+let add_diab_info sec addr1 add2 addr3 =
   let sec' = section_to_string sec in
+  Hashtbl.add compilation_section_start sec' addr3;
   Hashtbl.add diab_additional sec' (addr1,add2,sec)
 
+let diab_add_fun_addr name _ addr = add_fun_addr name addr
+
+let gnu_add_fun_addr name sec (high,low) =
+  let sec = section_to_string sec in
+  if not (Hashtbl.mem compilation_section_start sec) then
+    Hashtbl.add compilation_section_start sec low;
+  Hashtbl.replace compilation_section_end sec high;
+  add_fun_addr name (high,low)
+
 let exists_section sec =
   Hashtbl.mem compilation_section_start (section_to_string sec)
 
diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml
index 209f2024..b4240af7 100644
--- a/debug/DebugInit.ml
+++ b/debug/DebugInit.ml
@@ -26,7 +26,7 @@ let default_debug =
    set_member_offset = DebugInformation.set_member_offset;
    set_bitfield_offset = DebugInformation.set_bitfield_offset;
    insert_global_declaration = DebugInformation.insert_global_declaration;
-   add_fun_addr = DebugInformation.add_fun_addr;
+   add_fun_addr = (fun _ _ _ -> ());
    generate_debug_info = (fun _ _  -> None);
    all_files_iter = (fun f -> DebugInformation.StringSet.iter f !DebugInformation.all_files);
    insert_local_declaration = DebugInformation.insert_local_declaration;
@@ -41,23 +41,24 @@ let default_debug =
    stack_variable = DebugInformation.stack_variable;
    add_label = DebugInformation.add_label;
    atom_parameter = DebugInformation.atom_parameter;
-   add_compilation_section_start = DebugInformation.add_compilation_section_start;
-   add_compilation_section_end = DebugInformation.add_compilation_section_end;
    compute_diab_file_enum = DebugInformation.compute_diab_file_enum;
    compute_gnu_file_enum = DebugInformation.compute_gnu_file_enum;
    exists_section = DebugInformation.exists_section;
    remove_unused = DebugInformation.remove_unused;
    variable_printed = DebugInformation.variable_printed;
-   add_diab_info = DebugInformation.add_diab_info;
+   add_diab_info = (fun _ _ _ _ -> ());
  }
 
 let init_debug () =
-  let gen =
+  implem :=
   if Configuration.system = "diab" then
-    (fun a b -> Some (Dwarfgen.gen_diab_debug_info a b))
+    let gen = (fun a b -> Some (Dwarfgen.gen_diab_debug_info a b)) in
+    {default_debug with generate_debug_info = gen;
+     add_diab_info = DebugInformation.add_diab_info;
+     add_fun_addr = DebugInformation.diab_add_fun_addr;}
   else
-    (fun a b -> Some (Dwarfgen.gen_gnu_debug_info a b)) in
-  implem := {default_debug with generate_debug_info = gen;}
+    {default_debug with generate_debug_info = (fun a b -> Some (Dwarfgen.gen_gnu_debug_info a b));
+     add_fun_addr = DebugInformation.gnu_add_fun_addr}
 
 let init_none () =
   implem := default_implem
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index abed6a91..afa4799e 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -91,7 +91,13 @@ module DwarfPrinter(Target: DWARF_TARGET):
       | Some (LocSymbol _)
       | Some (LocSimple _) -> add_abbr_entry (0x2,"DW_AT_location",DW_FORM_block) buf
 
-
+    let add_range buf = function
+      | Pc_pair _ ->
+          add_abbr_entry (0x11,"DW_AT_low_pc",DW_FORM_addr) buf;
+          add_abbr_entry (0x12,"DW_AT_high_pc",DW_FORM_addr) buf
+      | Offset _ ->
+          add_abbr_entry (0x55,"DW_AT_ranges",DW_FORM_data4) buf
+      | Empty -> ()
 
     (* Dwarf entity to string function *)
     let abbrev_string_of_entity entity has_sibling =
@@ -120,8 +126,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
       | DW_TAG_compile_unit e ->
           prologue 0x11 "DW_TAG_compile_unit";
           add_string buf 0x1b "DW_AT_comp_dir" e.compile_unit_dir;
-          add_low_pc buf;
-          add_high_pc buf;
+          add_range buf e.compile_unit_range;
           add_abbr_entry (0x13,"DW_AT_language",DW_FORM_udata) buf;
           add_name buf e.compile_unit_name;
           add_string buf 0x25 "DW_AT_producer" e.compile_unit_prod_name;
@@ -152,8 +157,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
           add_name buf e.label_name;
       | DW_TAG_lexical_block a ->
           prologue 0xb "DW_TAG_lexical_block";
-          add_attr_some a.lexical_block_high_pc add_high_pc;
-          add_attr_some a.lexical_block_low_pc add_low_pc
+          add_range buf a.lexical_block_range;
       | DW_TAG_member e ->
           prologue 0xd "DW_TAG_member";
           add_attr_some e.member_byte_size add_byte_size;
@@ -179,8 +183,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
           prologue 0x2e "DW_TAG_subprogram";
           add_file_loc buf;
           add_attr_some e.subprogram_external (add_abbr_entry (0x3f,"DW_AT_external",DW_FORM_flag));
-          add_attr_some e.subprogram_low_pc add_low_pc;
-          add_attr_some e.subprogram_high_pc add_high_pc;
+          add_range buf e.subprogram_range;
           add_name buf e.subprogram_name;
           add_abbr_entry (0x27,"DW_AT_prototyped",DW_FORM_flag) buf;
           add_attr_some e.subprogram_type add_type;
@@ -418,10 +421,15 @@ module DwarfPrinter(Target: DWARF_TARGET):
       | None -> ());
       print_string oc "DW_AT_name" bt.base_type_name
 
+    let print_range oc = function
+      | Pc_pair (l,h) ->
+          print_addr oc "DW_AT_low_pc" l;
+          print_addr oc "DW_AT_high_pc" h
+      | _ -> ()
+
     let print_compilation_unit oc tag =
       print_string oc "DW_AT_comp_dir" tag.compile_unit_dir;
-      print_addr oc "DW_AT_low_pc" tag.compile_unit_low_pc;
-      print_addr oc "DW_AT_high_pc" tag.compile_unit_high_pc;
+      print_range oc tag.compile_unit_range;
       print_uleb128 oc "DW_AT_language" 1;
       print_string oc "DW_AT_name" tag.compile_unit_name;
       print_string oc "DW_AT_producer" tag.compile_unit_prod_name;
@@ -453,8 +461,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
 
 
     let print_lexical_block oc lb =
-      print_opt_value oc "DW_AT_high_pc" lb.lexical_block_high_pc print_addr;
-      print_opt_value oc "DW_AT_low_pc" lb.lexical_block_low_pc print_addr
+      print_range oc lb.lexical_block_range
 
     let print_member oc mb =
       print_opt_value oc "DW_AT_byte_size" mb.member_byte_size print_byte;
@@ -475,15 +482,11 @@ module DwarfPrinter(Target: DWARF_TARGET):
       print_opt_value oc "DW_AT_declaration" st.structure_declaration print_flag;
       print_opt_value oc "DW_AT_name" st.structure_name print_string
 
-    let print_subprogram_addr oc (s,e) =
-      fprintf oc "	.4byte		%a\n" label e;
-      fprintf oc "	.4byte		%a\n" label s
 
     let print_subprogram oc sp =
       print_file_loc oc (Some sp.subprogram_file_loc);
       print_opt_value oc "DW_AT_external" sp.subprogram_external print_flag;
-      print_opt_value oc "DW_AT_low_pc" sp.subprogram_low_pc print_addr;
-      print_opt_value oc "DW_AT_high_pc" sp.subprogram_high_pc print_addr;
+      print_range oc sp.subprogram_range;
       print_string oc "DW_AT_name" sp.subprogram_name;
       print_flag oc "DW_AT_prototyped" sp.subprogram_prototyped;
       print_opt_value oc "DW_AT_type" sp.subprogram_type print_ref
@@ -602,6 +605,11 @@ module DwarfPrinter(Target: DWARF_TARGET):
       | None -> print_location_entry_abs oc in
      List.iter f l
 
+    let list_opt l f =
+      match l with
+      | [] -> ()
+      | _ -> f ()
+
     let print_diab_entries oc entries =
       let abbrev_start = new_label () in
       abbrev_start_addr := abbrev_start;
@@ -614,7 +622,8 @@ module DwarfPrinter(Target: DWARF_TARGET):
       section oc Section_debug_loc;
       List.iter (fun e -> print_location_list oc e.locs) entries
 
-    let print_gnu_entries oc cp loc s =
+
+    let print_gnu_entries oc cp (lpc,loc) s =
       compute_abbrev cp;
       let line_start = new_label ()
       and start = new_label ()
@@ -623,14 +632,16 @@ module DwarfPrinter(Target: DWARF_TARGET):
       section oc (Section_debug_info None);
       print_debug_info oc start line_start cp;
       print_abbrev oc;
-      section oc Section_debug_loc;
-      print_location_list oc loc;
+      list_opt loc (fun () ->
+        section oc Section_debug_loc;
+        print_location_list oc (lpc,loc));
       section oc (Section_debug_line None);
       print_label oc line_start;
-      section oc Section_debug_str;
-      List.iter (fun (id,s) ->
-        print_label oc (loc_to_label id);
-        fprintf oc "	.asciz		\"%s\"\n" s) s
+      list_opt s (fun () ->
+        section oc Section_debug_str;
+        List.iter (fun (id,s) ->
+          print_label oc (loc_to_label id);
+          fprintf oc "	.asciz		\"%s\"\n" s) s)
 
 
     (* Print the debug info and abbrev section *)
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index fb1725d9..ff895623 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -87,6 +87,11 @@ type dw_form =
   | DW_FORM_ref_udata
   | DW_FORM_ref_indirect
 
+type dw_range =
+  | Pc_pair of reference * reference (* Simple low,high pc *)
+  | Offset of reference * constant (* DWARF 3 version for different range *)
+  | Empty (* Needed for compilation units only containing variables *)
+
 (* Types representing the attribute information per tag value *)
 
 type dw_tag_array_type =
@@ -104,8 +109,7 @@ type dw_tag_base_type =
 type dw_tag_compile_unit =
     {
      compile_unit_name:      string_const;
-     compile_unit_low_pc:    constant;
-     compile_unit_high_pc:   constant;
+     compile_unit_range:     dw_range;
      compile_unit_dir:       string_const;
      compile_unit_prod_name: string_const;
    }
@@ -146,8 +150,7 @@ type dw_tag_label =
 
 type dw_tag_lexical_block =
     {
-     lexical_block_high_pc: address option;
-     lexical_block_low_pc:  address option;
+     lexical_block_range: dw_range;
    }
 
 type dw_tag_member =
@@ -181,8 +184,7 @@ type dw_tag_subprogram =
      subprogram_name:       string_const;
      subprogram_prototyped: flag;
      subprogram_type:       reference     option;
-     subprogram_high_pc:    reference     option;
-     subprogram_low_pc:     reference     option;
+     subprogram_range:      dw_range;
    }
 
 type dw_tag_subrange_type =
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index 1ef3938a..980c8a34 100644
--- a/debug/Dwarfgen.ml
+++ b/debug/Dwarfgen.ml
@@ -386,21 +386,23 @@ module Dwarfgenaux (Target: TARGET) =
           Some (new_entry id (DW_TAG_variable var)),(IntSet.add v.lvar_type acc,loc_list@bcc)
 
     and scope_to_entry  f_id acc sc id =
-      let l_pc,h_pc = try
+      let r = try
         let r = Hashtbl.find scope_ranges id in
-        let lbl l = match l with
-        | Some l -> Some (Hashtbl.find label_translation (f_id,l))
-        | None -> None in
+        let lbl l h = match l,h with
+        | Some l,Some h->
+            let l = (Hashtbl.find label_translation (f_id,l))
+            and h = (Hashtbl.find label_translation (f_id,h)) in
+            Pc_pair(l,h)
+        | _ -> Empty in
         begin
           match r with
-          | [] -> None,None
-          | [a] -> lbl a.start_addr, lbl a.end_addr
-          | a::rest -> lbl (List.hd (List.rev rest)).start_addr,lbl a.end_addr
+          | [] -> Empty
+          | [a] -> lbl a.start_addr a.end_addr
+          | a::rest -> lbl (List.hd (List.rev rest)).start_addr  a.end_addr
         end
-      with Not_found -> None,None in
+      with Not_found -> Empty in
       let scope = {
-        lexical_block_high_pc = h_pc;
-        lexical_block_low_pc = l_pc;
+        lexical_block_range = r;
       } in
       let vars,acc = mmap_opt (local_to_entry  f_id) acc sc.scope_variables in
       let entry = new_entry id (DW_TAG_lexical_block scope) in
@@ -423,14 +425,16 @@ module Dwarfgenaux (Target: TARGET) =
           | _ -> assert false)
 
     let function_to_entry (acc,bcc) id f =
+      let r = match f.fun_low_pc, f.fun_high_pc with
+      | Some l,Some h -> Pc_pair (l,h)
+      | _ -> Empty in
       let f_tag = {
         subprogram_file_loc = file_loc f.fun_file_loc;
         subprogram_external = Some f.fun_external;
         subprogram_name = string_entry f.fun_name;
         subprogram_prototyped = true;
         subprogram_type = f.fun_return_type;
-        subprogram_high_pc = f.fun_high_pc;
-        subprogram_low_pc = f.fun_low_pc;
+        subprogram_range = r;
       } in
       let f_id = get_opt_val f.fun_atom in
       let acc = match f.fun_return_type with Some s -> IntSet.add s acc | None -> acc in
@@ -473,8 +477,7 @@ let diab_gen_compilation_section s defs acc =
   and high_pc = Hashtbl.find compilation_section_end s in
   let cp = {
     compile_unit_name = Simple_string !file_name;
-    compile_unit_low_pc = low_pc;
-    compile_unit_high_pc = high_pc;
+    compile_unit_range = Pc_pair (low_pc,high_pc);
     compile_unit_dir = Simple_string (Sys.getcwd ());
     compile_unit_prod_name = Simple_string prod_name
   } in
@@ -515,8 +518,11 @@ let gnu_string_entry s =
       Offset_string id
 
 let gen_gnu_debug_info sec_name var_section : debug_entries =
-  let low_pc = Hashtbl.find compilation_section_start ".text"
-  and high_pc = Hashtbl.find compilation_section_end ".text" in
+  let r,low_pc = try
+    let low_pc = Hashtbl.find compilation_section_start ".text"
+    and high_pc = Hashtbl.find compilation_section_end ".text" in
+    Pc_pair (low_pc,high_pc),Some low_pc
+  with Not_found -> Empty,None in
   let module Gen = Dwarfgenaux (struct
     let file_loc = gnu_file_loc
     let string_entry = gnu_string_entry
@@ -530,13 +536,12 @@ let gen_gnu_debug_info sec_name var_section : debug_entries =
   let types = Gen.gen_types ty in
   let cp = {
     compile_unit_name = gnu_string_entry !file_name;
-    compile_unit_low_pc = low_pc;
-    compile_unit_high_pc = high_pc;
+    compile_unit_range = r;
     compile_unit_dir = gnu_string_entry (Sys.getcwd ());
     compile_unit_prod_name = gnu_string_entry prod_name;
   } in
   let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in
   let cp = add_children cp (types@defs) in
-  let loc_pc = if StringSet.cardinal sec > 1 then None else Some low_pc in
+  let loc_pc = if StringSet.cardinal sec > 1 then None else low_pc in
   let string_table = Hashtbl.fold (fun s i acc -> (i,s)::acc) string_table [] in
   Gnu (cp,(loc_pc,locs),string_table)