Change the way the debug sections are printed.

If a user uses the #pragma use_section for functions the diab linker
requires a separate debug_info section for each entry. This commit
adds functionality to emulate this behavior.

15 files changed, 228 insertions, 179 deletions

diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml
index a7188206..86f9f973 100644
--- a/arm/TargetPrinter.ml
+++ b/arm/TargetPrinter.ml
@@ -152,7 +152,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET =
       | Section_user(s, wr, ex) ->
           sprintf ".section	\"%s\",\"a%s%s\",%%progbits"
             s (if wr then "w" else "") (if ex then "x" else "")
-      | Section_debug_info
+      | Section_debug_info _
       | Section_debug_loc
       | Section_debug_abbrev -> "" (* Dummy value *)
             
diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml
index 59570957..a152e3c2 100644
--- a/backend/PrintAsm.ml
+++ b/backend/PrintAsm.ml
@@ -24,8 +24,6 @@ open TargetPrinter
 module Printer(Target:TARGET) =
   struct
 
-    let addr_mapping: (string, (int * int)) Hashtbl.t = Hashtbl.create 7
-
     let get_fun_addr name =
       let s = Target.new_label ()
       and e = Target.new_label () in
@@ -38,7 +36,6 @@ module Printer(Target:TARGET) =
       else
         ()
 
-
     let print_location oc loc =
       if loc <> Cutil.no_loc then Target.print_file_line oc (fst loc) (snd loc)
           
@@ -113,11 +110,8 @@ module Printer(Target:TARGET) =
     module DwarfTarget: DwarfTypes.DWARF_TARGET =
       struct
         let label = Target.label
-        let name_of_section = Target.name_of_section
+        let section = Target.section
         let print_file_loc = Target.print_file_loc
-        let get_start_addr = Target.get_start_addr   
-        let get_end_addr = Target.get_end_addr
-        let get_stmt_list_addr = Target.get_stmt_list_addr
         let name_of_section = Target.name_of_section
         let symbol = Target.symbol
       end
@@ -136,8 +130,15 @@ let print_program oc p db =
   close_filenames ();
   if !Clflags.option_g && Configuration.advanced_debug then
     begin
-      match Debug.generate_debug_info () with
+      let atom_to_s s =
+        let s = C2C.atom_sections s in
+        match s with
+        | [] -> Target.name_of_section Section_text
+        | (Section_user (n,_,_))::_ -> n
+        | a::_ ->
+            Target.name_of_section a in
+      match Debug.generate_debug_info atom_to_s (Target.name_of_section Section_text) with
       | None -> ()
-      | Some (db,loc) ->
-          Printer.DebugPrinter.print_debug oc db loc
+      | Some db ->
+          Printer.DebugPrinter.print_debug oc db
     end
diff --git a/common/Sections.ml b/common/Sections.ml
index 8e569389..be0f415e 100644
--- a/common/Sections.ml
+++ b/common/Sections.ml
@@ -27,7 +27,7 @@ type section_name =
   | Section_literal
   | Section_jumptable
   | Section_user of string * bool (*writable*) * bool (*executable*)
-  | Section_debug_info
+  | Section_debug_info of string
   | Section_debug_abbrev
   | Section_debug_loc
 
diff --git a/common/Sections.mli b/common/Sections.mli
index eca9a993..cf6f13b8 100644
--- a/common/Sections.mli
+++ b/common/Sections.mli
@@ -26,7 +26,7 @@ type section_name =
   | Section_literal
   | Section_jumptable
   | Section_user of string * bool (*writable*) * bool (*executable*)
-  | Section_debug_info
+  | Section_debug_info of string
   | Section_debug_abbrev
   | Section_debug_loc
 
diff --git a/debug/Debug.ml b/debug/Debug.ml
index d0de9e98..1d3b260e 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -30,7 +30,7 @@ type implem =
      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;
-     mutable generate_debug_info: unit -> (dw_entry * dw_locations) option;
+     mutable generate_debug_info: (atom -> string) -> string -> debug_entries option;
      mutable all_files_iter: (string -> unit) -> unit;
      mutable insert_local_declaration:  storage -> ident -> typ -> location -> unit;
      mutable atom_local_variable: ident -> atom -> unit;
@@ -45,6 +45,9 @@ type implem =
      mutable function_end: atom -> positive -> unit;
      mutable add_label: atom -> positive -> int -> unit;
      mutable atom_parameter: ident -> ident -> atom -> unit;
+     mutable add_compilation_section_start: string ->(int * int * int * string) -> unit;
+     mutable compute_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit;
+     mutable exists_section: string -> bool;
    }
 
 let implem =
@@ -57,7 +60,7 @@ let implem =
    set_bitfield_offset = (fun _ _ _ _ _ -> ());
    insert_global_declaration = (fun _ _ -> ());
    add_fun_addr = (fun _ _ -> ());
-   generate_debug_info = (fun _ -> None);
+   generate_debug_info = (fun _  _ -> None);
    all_files_iter = (fun _ -> ());
    insert_local_declaration = (fun  _ _ _ _ -> ());
    atom_local_variable = (fun _ _ -> ());
@@ -72,6 +75,9 @@ let implem =
    function_end = (fun _ _ -> ());
    add_label = (fun _ _ _ -> ());
    atom_parameter = (fun _ _ _ -> ());
+   add_compilation_section_start = (fun _ _ -> ());
+   compute_file_enum = (fun _ _ _ -> ());
+   exists_section = (fun _ -> true);
 }
 
 let init_compile_unit name = implem.init name
@@ -82,7 +88,7 @@ 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
-let generate_debug_info () = implem.generate_debug_info ()
+let generate_debug_info fun_s var_s = implem.generate_debug_info fun_s var_s
 let all_files_iter f = implem.all_files_iter f
 let insert_local_declaration sto id ty loc = implem.insert_local_declaration sto id ty loc
 let atom_local_variable id atom = implem.atom_local_variable id atom
@@ -97,3 +103,6 @@ let stack_variable atom loc = implem.stack_variable atom loc
 let function_end atom loc = implem.function_end 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 exists_section sec = implem.exists_section sec
+let compute_file_enum end_l entry_l line_e = implem.compute_file_enum end_l entry_l line_e
diff --git a/debug/Debug.mli b/debug/Debug.mli
index c5fcddb3..166a6759 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -28,7 +28,7 @@ type implem =
      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;
-     mutable generate_debug_info: unit -> (dw_entry * dw_locations) option;
+     mutable generate_debug_info: (atom -> string) -> string -> debug_entries option;
      mutable all_files_iter: (string -> unit) -> unit;
      mutable insert_local_declaration:  storage -> ident -> typ -> location -> unit;
      mutable atom_local_variable: ident -> atom -> unit;
@@ -43,6 +43,9 @@ type implem =
      mutable function_end: atom -> positive -> unit;
      mutable add_label: atom -> positive -> int -> unit;
      mutable atom_parameter: ident -> ident -> atom -> unit;
+     mutable add_compilation_section_start: string -> (int * int * int * string) -> unit;
+     mutable compute_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit;
+     mutable exists_section: string -> bool;
    }
 
 val implem: implem
@@ -68,5 +71,8 @@ val end_live_range: atom -> positive -> unit
 val stack_variable: atom -> int * int builtin_arg -> unit
 val function_end: atom -> positive -> unit
 val add_label: atom -> positive -> int -> unit
-val generate_debug_info: unit -> (dw_entry * dw_locations) option
+val generate_debug_info: (atom -> string) -> string -> debug_entries option
 val atom_parameter: ident -> ident -> atom -> unit
+val add_compilation_section_start: string -> (int * int * int * string) -> unit
+val compute_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit
+val exists_section: string -> bool
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 8b6ec1ad..7866c339 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -774,9 +774,28 @@ let function_end atom loc =
   List.iter (close_range loc) !open_vars;
   open_vars:= []
 
-let compilation_section_start: (string,int) Hashtbl.t = Hashtbl.create 7
+let compilation_section_start: (string,int * int * int * string) Hashtbl.t = Hashtbl.create 7
 let compilation_section_end: (string,int) Hashtbl.t = Hashtbl.create 7
 
+let add_compilation_section_start sec addr =
+  Hashtbl.add compilation_section_start sec addr
+
+let add_compilation_section_end sec addr =
+  Hashtbl.add compilation_section_end sec addr
+
+let exists_section sec =
+  Hashtbl.mem compilation_section_start sec
+
+let filenum: (string * string,int) Hashtbl.t = Hashtbl.create 7
+
+let compute_file_enum end_label entry_label line_end =
+  Hashtbl.iter (fun sec (_,_,_,secname) ->
+    Hashtbl.add compilation_section_end sec (end_label secname);
+    StringSet.iter (fun file ->
+      let lbl = entry_label file in
+      Hashtbl.add filenum (sec,file) lbl) !all_files;
+    line_end ()) compilation_section_start
+
 let init name =
   id := 0;
   file_name := name;
@@ -790,4 +809,6 @@ let init name =
   Hashtbl.reset atom_to_local;
   Hashtbl.reset scope_to_local;
   Hashtbl.reset compilation_section_start;
-  Hashtbl.reset compilation_section_end
+  Hashtbl.reset compilation_section_end;
+  Hashtbl.reset filenum;
+  all_files := StringSet.empty
diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml
index 17db4354..e0c435cd 100644
--- a/debug/DebugInit.ml
+++ b/debug/DebugInit.ml
@@ -27,7 +27,7 @@ let init_debug () =
   implem.set_bitfield_offset <- DebugInformation.set_bitfield_offset;
   implem.insert_global_declaration <- DebugInformation.insert_global_declaration;
   implem.add_fun_addr <- DebugInformation.add_fun_addr;
-  implem.generate_debug_info <- (fun () -> Some (Dwarfgen.gen_debug_info ()));
+  implem.generate_debug_info <- (fun a b -> Some (Dwarfgen.gen_debug_info a b));
   implem.all_files_iter <- (fun f -> DebugInformation.StringSet.iter f !DebugInformation.all_files);
   implem.insert_local_declaration <- DebugInformation.insert_local_declaration;
   implem.atom_local_variable <- DebugInformation.atom_local_variable;
@@ -41,7 +41,10 @@ let init_debug () =
   implem.stack_variable <- DebugInformation.stack_variable;
   implem.function_end <- DebugInformation.function_end;
   implem.add_label <- DebugInformation.add_label;
-  implem.atom_parameter <- DebugInformation.atom_parameter
+  implem.atom_parameter <- DebugInformation.atom_parameter;
+  implem.add_compilation_section_start <- DebugInformation.add_compilation_section_start;
+  implem.compute_file_enum <- DebugInformation.compute_file_enum;
+  implem.exists_section <- DebugInformation.exists_section
 
 let init_none () =
   implem.init <- (fun _ -> ());
@@ -52,7 +55,7 @@ let init_none () =
   implem.set_bitfield_offset <- (fun _ _ _ _ _ -> ());
   implem.insert_global_declaration <- (fun _ _ -> ());
   implem.add_fun_addr <- (fun _ _ -> ());
-  implem.generate_debug_info <- (fun _ -> None);
+  implem.generate_debug_info <- (fun _ _ -> None);
   implem.all_files_iter <- (fun _ -> ());
   implem.insert_local_declaration <- (fun  _ _ _ _ -> ());
   implem.atom_local_variable <- (fun _ _ -> ());
@@ -66,8 +69,9 @@ let init_none () =
   implem.stack_variable <- (fun _ _ -> ());
   implem.function_end <- (fun _ _ -> ());
   implem.add_label <- (fun _ _ _ -> ());
-  implem.atom_parameter <- (fun _ _ _ -> ())
-
+  implem.atom_parameter <- (fun _ _ _ -> ());
+  implem.add_compilation_section_start <- (fun _ _ -> ());
+  implem.exists_section <- (fun _ -> true)
 
 let init () =
   if !Clflags.option_g then
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index 32c15dfd..aa1c187f 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -21,7 +21,7 @@ open Sections
 (* The printer is parameterized over target specific functions and a set of dwarf type constants *)
 module DwarfPrinter(Target: DWARF_TARGET):
     sig
-      val print_debug: out_channel -> dw_entry -> dw_locations -> unit
+      val print_debug: out_channel -> debug_entries -> unit
     end =
   struct
 
@@ -245,7 +245,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
     let print_abbrev oc =
       let abbrevs = Hashtbl.fold (fun s i acc -> (s,i)::acc) abbrev_mapping [] in
       let abbrevs = List.sort (fun (_,a) (_,b) -> Pervasives.compare a b) abbrevs in
-      fprintf oc "	.section	%s\n" (name_of_section Section_debug_abbrev);
+      section oc Section_debug_abbrev;
       let lbl = new_label () in
       abbrev_start_addr := lbl;
       print_label oc lbl;
@@ -275,9 +275,6 @@ module DwarfPrinter(Target: DWARF_TARGET):
       | None -> ()
       | Some o -> f oc o
 
-    let print_file_loc oc f =
-      print_opt_value oc f print_file_loc
-
     let print_flag oc b =
       output_string oc (string_of_byte b)
 
@@ -296,6 +293,15 @@ module DwarfPrinter(Target: DWARF_TARGET):
     let print_2byte oc b =
       fprintf oc "	.2byte		0x%X\n" b
 
+    let print_ref oc r =
+      let ref = entry_to_label r in
+      fprintf oc "	.4byte		%a\n" label ref
+
+    let print_file_loc oc = function
+      | Some (file,col) ->
+          fprintf oc "	.4byte		%a\n" label file;
+          print_uleb128 oc col
+      | None -> ()
 
     let size_of_loc_expr = function
       | DW_OP_bregx _ -> 3
@@ -322,11 +328,6 @@ module DwarfPrinter(Target: DWARF_TARGET):
             print_uleb128 oc i
           end
 
-
-    let print_ref oc r =
-      let ref = entry_to_label r in
-      fprintf oc "	.4byte		%a\n" label ref
-        
     let print_loc oc loc =
       match loc with
       | LocSymbol s ->
@@ -394,12 +395,12 @@ module DwarfPrinter(Target: DWARF_TARGET):
     let print_compilation_unit oc tag =
       let prod_name = sprintf "AbsInt Angewandte Informatik GmbH:CompCert Version %s:%s" Version.version Configuration.arch in
       print_string oc (Sys.getcwd ());
-      print_addr oc (get_start_addr ());
-      print_addr oc (get_end_addr ());
+      print_addr oc tag.compile_unit_low_pc;
+      print_addr oc tag.compile_unit_high_pc;
       print_uleb128 oc 1;
       print_string oc tag.compile_unit_name;
       print_string oc prod_name;
-      print_addr oc (get_stmt_list_addr ())
+      print_addr oc tag.compile_unit_stmt_list
 
     let print_const_type oc ct =
       print_ref oc ct.const_type
@@ -539,16 +540,15 @@ module DwarfPrinter(Target: DWARF_TARGET):
           print_sleb128 oc 0) entry
 
     (* Print the debug abbrev section *)
-    let print_debug_abbrev oc entry =
-      compute_abbrev entry;
+    let print_debug_abbrev oc entries =
+      List.iter (fun (_,_,e,_) -> compute_abbrev e) entries;
       print_abbrev oc
 
     (* Print the debug info section *)
-    let print_debug_info oc entry  =
-      let debug_start = new_label () in
-      debug_start_addr:= debug_start;
-      fprintf oc"	.section	%s\n" (name_of_section Section_debug_info);
-      print_label oc debug_start;
+    let print_debug_info oc sec start entry  =
+      debug_start_addr:= start;
+      section oc (Section_debug_info sec);      
+      print_label oc start;
       let debug_length_start = new_label ()  (* Address used for length calculation *)
       and debug_end = new_label () in
       fprintf oc "	.4byte		%a-%a\n" label debug_end label debug_length_start;
@@ -560,8 +560,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
       print_sleb128 oc 0;
       print_label oc debug_end (* End of the debug section *)
 
-    let print_location_entry oc l =
-      let c_low = get_start_addr () in
+    let print_location_entry oc c_low l =
       print_label oc (entry_to_label l.loc_id);
       List.iter (fun (b,e,loc) ->
         fprintf oc "	.4byte		%a-%a\n" label b label c_low;
@@ -570,15 +569,15 @@ module DwarfPrinter(Target: DWARF_TARGET):
       fprintf oc "	.4byte	0\n";
       fprintf oc "	.4byte	0\n"
 
-    let print_location_list oc l =
-      fprintf oc"	.section	%s\n" (name_of_section Section_debug_loc);
-      List.iter (print_location_entry oc) l
+    let print_location_list oc (c_low,l) =
+      List.iter (print_location_entry oc c_low) l
 
     (* Print the debug info and abbrev section *)
-    let print_debug oc entry loc =
-      print_debug_abbrev oc entry;
-      print_debug_info oc entry;
-      print_location_list oc loc
+    let print_debug oc entries =
+      print_debug_abbrev oc entries;
+      List.iter (fun (s,d,e,_) -> print_debug_info oc s d e) entries;
+      section oc Section_debug_loc;
+      List.iter (fun (_,_,_,l) -> print_location_list oc l) entries
 
 
   end
diff --git a/debug/DwarfPrinter.mli b/debug/DwarfPrinter.mli
index 8b206a00..e1e10601 100644
--- a/debug/DwarfPrinter.mli
+++ b/debug/DwarfPrinter.mli
@@ -14,5 +14,5 @@ open DwarfTypes
 
 module DwarfPrinter: functor (Target: DWARF_TARGET) ->
   sig
-    val print_debug: out_channel -> dw_entry -> dw_locations -> unit
+    val print_debug: out_channel -> debug_entries -> unit
   end
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index 8c2a7d56..906b7cba 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -60,7 +60,7 @@ type bound_value =
 
 (* Types representing the attribute information per tag value *)
 
-type file_loc = string * constant
+type file_loc = int * constant
 
 type dw_tag_array_type =
     {
@@ -77,7 +77,10 @@ type dw_tag_base_type =
 
 type dw_tag_compile_unit =
     {
-     compile_unit_name:            string;
+     compile_unit_name:      string;
+     compile_unit_low_pc:    int;
+     compile_unit_high_pc:   int;
+     compile_unit_stmt_list: int;
    }
 
 type dw_tag_const_type =
@@ -243,16 +246,15 @@ type location_entry =
      loc:     (int * int * location_value) list;
      loc_id:  reference;
    }
-type dw_locations = location_entry list
+type dw_locations = int * location_entry list
+
+type debug_entries = (string * int * dw_entry * dw_locations) list
 
 (* The target specific functions for printing the debug information *)
 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 section: out_channel -> section_name -> unit
     val symbol: out_channel -> atom -> unit
   end
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index 7fce22a7..3239ceb6 100644
--- a/debug/Dwarfgen.ml
+++ b/debug/Dwarfgen.ml
@@ -72,10 +72,20 @@ let void_to_entry id =
   } in
   new_entry id (DW_TAG_base_type void)
 
-let typedef_to_entry id t =
+let translate_file_loc sec (f,l)  =
+  Hashtbl.find filenum (sec,f),l
+
+let translate_file_loc_opt sec = function
+  | None -> None
+  | Some (f,l) ->
+    try 
+      Some (translate_file_loc sec (f,l))
+    with Not_found -> None
+
+let typedef_to_entry sec id t =
   let i = get_opt_val t.typ in
   let td = {
-    typedef_file_loc = t.typedef_file_loc;
+    typedef_file_loc = translate_file_loc_opt sec t.typedef_file_loc;
     typedef_name = t.typedef_name;
     typedef_type = i;
   } in
@@ -110,7 +120,7 @@ let const_to_entry id c =
 let volatile_to_entry id v =
   new_entry id (DW_TAG_volatile_type ({volatile_type = v.vol_type}))
 
-let enum_to_entry id e =
+let enum_to_entry sec id e =
   let enumerator_to_entry e =
     let tag =
       {
@@ -121,7 +131,7 @@ let enum_to_entry id e =
     new_entry (next_id ()) (DW_TAG_enumerator tag) in
   let bs = sizeof_ikind enum_ikind in
   let enum = {
-    enumeration_file_loc = e.enum_file_loc;
+    enumeration_file_loc = translate_file_loc_opt sec e.enum_file_loc;
     enumeration_byte_size = bs;
     enumeration_declaration = Some false;
     enumeration_name = Some e.enum_name;
@@ -172,9 +182,9 @@ let member_to_entry mem =
   } in
   new_entry (next_id ()) (DW_TAG_member mem)
 
-let struct_to_entry id s =
+let struct_to_entry sec id s =
   let tag = {
-     structure_file_loc = s.ct_file_loc;
+     structure_file_loc = translate_file_loc_opt sec s.ct_file_loc;
      structure_byte_size = s.ct_sizeof;
      structure_declaration = Some s.ct_declaration;
      structure_name = if s.ct_name <> "" then Some s.ct_name else None;
@@ -183,9 +193,9 @@ let struct_to_entry id s =
   let child = List.map member_to_entry s.ct_members in
   add_children entry child
 
-let union_to_entry id s =
+let union_to_entry sec id s =
   let tag = {
-    union_file_loc = s.ct_file_loc;
+    union_file_loc =  translate_file_loc_opt sec s.ct_file_loc;
     union_byte_size = s.ct_sizeof;
     union_declaration = Some s.ct_declaration;
     union_name = if s.ct_name <> "" then Some s.ct_name else None;
@@ -194,20 +204,20 @@ let union_to_entry id s =
   let child = List.map member_to_entry s.ct_members in
   add_children entry child
 
-let composite_to_entry id s =
+let composite_to_entry sec id s =
   match s.ct_sou with
-  | Struct -> struct_to_entry id s
-  | Union -> union_to_entry id s
+  | Struct -> struct_to_entry sec id s
+  | Union -> union_to_entry sec id s
 
-let infotype_to_entry id = function
+let infotype_to_entry sec id = function
   | IntegerType i -> int_type_to_entry id i
   | FloatType f -> float_type_to_entry id f
   | PointerType p -> pointer_to_entry id p
   | ArrayType arr -> array_to_entry id arr
-  | CompositeType c -> composite_to_entry id c
-  | EnumType e -> enum_to_entry id e
+  | CompositeType c -> composite_to_entry sec id c
+  | EnumType e -> enum_to_entry sec id e
   | FunctionType f -> fun_type_to_entry id f
-  | Typedef t -> typedef_to_entry id t
+  | Typedef t -> typedef_to_entry sec id t
   | ConstType c -> const_to_entry id c
   | VolatileType v -> volatile_to_entry id v
   | Void -> void_to_entry id
@@ -246,7 +256,7 @@ let needs_types id d =
         let d,c' = add_type f.cfd_typ d in
         d,c||c') (d,false) c.ct_members
 
-let gen_types needed =
+let gen_types sec needed =
   let rec aux d =
     let d,c = IntSet.fold (fun id (d,c) ->
       let d,c' = needs_types id d in
@@ -258,13 +268,13 @@ let gen_types needed =
   let typs = aux needed in
   List.rev (Hashtbl.fold (fun id t acc -> 
     if IntSet.mem id typs then
-      (infotype_to_entry id t)::acc
+      (infotype_to_entry sec id t)::acc
     else 
       acc) types [])
 
-let global_variable_to_entry acc id v =
+let global_variable_to_entry sec acc id v =
   let var = {
-    variable_file_loc = v.gvar_file_loc;
+    variable_file_loc = translate_file_loc sec v.gvar_file_loc;
     variable_declaration = Some v.gvar_declaration;
     variable_external = Some v.gvar_external;
     variable_name = v.gvar_name;
@@ -338,10 +348,10 @@ let function_parameter_to_entry f_id (acc,bcc) p =
   } in
   new_entry (next_id ()) (DW_TAG_formal_parameter p),(IntSet.add p.formal_parameter_type acc,loc_list@bcc)
 
-let rec local_variable_to_entry f_id (acc,bcc) v id =
+let rec local_variable_to_entry sec f_id (acc,bcc) v id =
   let loc,loc_list = location_entry f_id (get_opt_val v.lvar_atom) in
   let var = {
-    variable_file_loc = v.lvar_file_loc;
+    variable_file_loc = translate_file_loc sec v.lvar_file_loc;
     variable_declaration = None;
     variable_external = None;
     variable_name = v.lvar_name;
@@ -350,7 +360,7 @@ let rec local_variable_to_entry f_id (acc,bcc) v id =
   } in
   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 =
+and scope_to_entry sec f_id acc sc id =
   let l_pc,h_pc = try
     let r = Hashtbl.find scope_ranges id in
     let lbl l = match l with 
@@ -367,27 +377,27 @@ and scope_to_entry f_id acc sc id =
     lexical_block_high_pc = h_pc;
     lexical_block_low_pc = l_pc;
   } in
-  let vars,acc = mmap (local_to_entry f_id) acc sc.scope_variables in
+  let vars,acc = mmap (local_to_entry sec f_id) acc sc.scope_variables in
   let entry = new_entry id (DW_TAG_lexical_block scope) in
   add_children entry vars,acc
 
-and local_to_entry f_id acc id =
+and local_to_entry sec f_id acc id =
   match Hashtbl.find local_variables id with
-  | LocalVariable v -> local_variable_to_entry f_id acc v id
-  | Scope v -> scope_to_entry f_id acc v id
+  | LocalVariable v -> local_variable_to_entry sec f_id acc v id
+  | Scope v -> scope_to_entry sec f_id acc v id
 
-let fun_scope_to_entries f_id acc id =
+let fun_scope_to_entries sec f_id acc id =
   match id with
   | None -> [],acc
   | Some id ->
       let sc = Hashtbl.find local_variables id in
       (match sc with
-      | Scope sc ->mmap (local_to_entry f_id) acc sc.scope_variables
+      | Scope sc ->mmap (local_to_entry sec f_id) acc sc.scope_variables
       | _ -> assert false)
 
-let function_to_entry (acc,bcc) id f =
+let function_to_entry sec (acc,bcc) id f =
   let f_tag = {
-    subprogram_file_loc = f.fun_file_loc;
+    subprogram_file_loc = translate_file_loc sec f.fun_file_loc;
     subprogram_external = Some f.fun_external;
     subprogram_name = f.fun_name;
     subprogram_prototyped = true;
@@ -399,24 +409,36 @@ let function_to_entry (acc,bcc) id f =
   let acc = match f.fun_return_type with Some s -> IntSet.add s acc | None -> acc in
   let f_entry =  new_entry id (DW_TAG_subprogram f_tag) in
   let params,(acc,bcc) = mmap (function_parameter_to_entry f_id) (acc,bcc) f.fun_parameter in
-  let vars,(acc,bcc) = fun_scope_to_entries f_id (acc,bcc) f.fun_scope in
+  let vars,(acc,bcc) = fun_scope_to_entries sec f_id (acc,bcc) f.fun_scope in
   add_children f_entry (params@vars),(acc,bcc)
      
-let definition_to_entry (acc,bcc) id t =
+let definition_to_entry sec (acc,bcc) id t =
   match t with
-  | GlobalVariable g -> let e,acc = global_variable_to_entry acc id g in
+  | GlobalVariable g -> let e,acc = global_variable_to_entry sec acc id g in
     e,(acc,bcc)
-  | Function f -> function_to_entry (acc,bcc) id f
-
-let gen_defs () =
-  let defs,(typ,locs) = Hashtbl.fold (fun id t (acc,bcc) -> let t,bcc = definition_to_entry bcc id t in
-  t::acc,bcc) definitions ([],(IntSet.empty,[])) in
-  List.rev defs,typ,locs
-
-let gen_debug_info () : dw_entry * dw_locations=
-  let cp =  {
-    compile_unit_name = !file_name;
-  } in
-  let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in
-  let defs,ty,locs = gen_defs () in
-  add_children cp ((gen_types ty) @ defs),locs
+  | Function f -> function_to_entry sec (acc,bcc) id f
+
+module StringMap = Map.Make(String)
+
+let gen_debug_info sec_name var_section : debug_entries =
+  let defs = Hashtbl.fold (fun id t acc ->
+    let s = match t with
+    | GlobalVariable _ -> var_section
+    | Function f -> sec_name (get_opt_val f.fun_atom) in
+    let old = try StringMap.find s acc with Not_found -> [] in
+    StringMap.add s ((id,t)::old) acc) definitions StringMap.empty in
+  StringMap.fold (fun s defs acc ->
+    let defs,(ty,locs) = List.fold_left (fun (acc,bcc) (id,t) -> 
+      let t,bcc = definition_to_entry s bcc id t in
+      t::acc,bcc) ([],(IntSet.empty,[])) defs in
+    let line_start,low_pc,debug_start,_ = Hashtbl.find compilation_section_start s
+    and high_pc = Hashtbl.find compilation_section_end s in
+    let cp = {
+      compile_unit_name = !file_name;
+      compile_unit_low_pc = low_pc;
+      compile_unit_high_pc = high_pc;
+      compile_unit_stmt_list = line_start; 
+    } in
+    let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in
+    let cp = add_children cp ((gen_types s ty) @ defs) in
+    (s,debug_start,cp,(low_pc,locs))::acc) defs []
diff --git a/ia32/TargetPrinter.ml b/ia32/TargetPrinter.ml
index c4045e63..51169d86 100644
--- a/ia32/TargetPrinter.ml
+++ b/ia32/TargetPrinter.ml
@@ -101,7 +101,7 @@ module Cygwin_System : SYSTEM =
       | Section_user(s, wr, ex) ->
           sprintf ".section	\"%s\", \"%s\"\n"
             s (if ex then "xr" else if wr then "d" else "dr")
-      | Section_debug_info
+      | Section_debug_info _
       | Section_debug_loc
       | Section_debug_abbrev -> "" (* Dummy value *)
 
@@ -151,7 +151,8 @@ module ELF_System : SYSTEM =
       | Section_user(s, wr, ex) ->
           sprintf ".section	\"%s\",\"a%s%s\",@progbits"
             s (if wr then "w" else "") (if ex then "x" else "")
-      | Section_debug_info
+      | Section_debug_info _
+      | Section_debug_loc
       | Section_debug_abbrev -> "" (* Dummy value *)
             
     let stack_alignment = 8 (* minimum is 4, 8 is better for perfs *)
@@ -203,7 +204,8 @@ module MacOS_System : SYSTEM =
           sprintf ".section	\"%s\", %s, %s"
             (if wr then "__DATA" else "__TEXT") s
             (if ex then "regular, pure_instructions" else "regular")
-      | Section_debug_info
+      | Section_debug_info _
+      | Section_debug_loc
       | Section_debug_abbrev -> "" (* Dummy value *)
     
     let stack_alignment =  16 (* mandatory *)
diff --git a/powerpc/AsmToJSON.ml b/powerpc/AsmToJSON.ml
index 136c9e41..5764aa8f 100644
--- a/powerpc/AsmToJSON.ml
+++ b/powerpc/AsmToJSON.ml
@@ -330,7 +330,7 @@ let p_section oc = function
   | Section_literal -> fprintf oc "{\"Section Name\":\"Literal\"}"
   | Section_jumptable -> fprintf oc "{\"Section Name\":\"Jumptable\"}"
   | Section_user (s,w,e) -> fprintf oc "{\"Section Name\":%s,\"Writable\":%B,\"Executable\":%B}" s w e
-  | Section_debug_info 
+  | Section_debug_info _
   | Section_debug_abbrev 
   | Section_debug_loc -> () (* There should be no info in the debug sections *)
 
diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml
index c05c995a..3c73f22d 100644
--- a/powerpc/TargetPrinter.ml
+++ b/powerpc/TargetPrinter.ml
@@ -131,7 +131,7 @@ module Linux_System : SYSTEM =
       | Section_user(s, wr, ex) ->
           sprintf ".section	\"%s\",\"a%s%s\",@progbits"
             s (if wr then "w" else "") (if ex then "x" else "")
-      | Section_debug_info -> ".debug_info,\"\",@progbits"
+      | Section_debug_info _ -> ".debug_info,\"\",@progbits"
       | Section_debug_abbrev -> ".debug_abbrev,\"\",@progbits"
       | Section_debug_loc -> ".debug_loc,\"\",@progbits"
             
@@ -210,15 +210,20 @@ module Diab_System : SYSTEM =
             | true, false -> 'd'                (* data *)
             | false, true -> 'c'                (* text *)
             | false, false -> 'r')              (* const *)
-      | Section_debug_info -> ".debug_info,,n"
-      | Section_debug_abbrev -> ".debug_abbrev,,n"
-      | Section_debug_loc -> ".debug_loc,,n"
+      | Section_debug_info s -> sprintf ".section	.debug_info%s,,n" (if s <> ".text" then s else "")
+      | Section_debug_abbrev -> ".section	.debug_abbrev,,n"
+      | Section_debug_loc -> ".section	.debug_loc,,n"
 
     let section oc sec =
       let name = name_of_section sec in
       assert (name <> "COMM");
-      fprintf oc "	%s\n" name
-
+      match sec with
+      | Section_debug_info s ->
+          fprintf oc "	%s\n" name;
+          if s <> ".text" then
+            fprintf oc "	.sectionlink	.debug_info\n"
+      | _ ->
+          fprintf oc "	%s\n" name
 
     let print_file_line oc file line =
       print_file_line_d2 oc comment file line
@@ -233,73 +238,51 @@ module Diab_System : SYSTEM =
     let cfi_rel_offset oc reg ofs = ()
         
     let print_prologue oc =
-      fprintf oc "	.xopt	align-fill-text=0x60000000\n";
-      if !Clflags.option_g then
-        begin
-          fprintf oc "	.text\n";
-          fprintf oc "	.section	.debug_line,,n\n";
-          let label_line_start = new_label () in
-          stmt_list_addr := label_line_start;
-          fprintf oc "%a:\n" label label_line_start;
-          fprintf oc "	.text\n";
-          let label_start = new_label () in
-          start_addr := label_start;
-          fprintf oc "%a:\n" label label_start;
-          let d_start = new_label() in
-          debug_start_addr := d_start;
-          fprintf oc "	.0byte	%a\n" label d_start;
-          fprintf oc "	.d2_line_start	.debug_line\n";
-        end
-
-    let filenum : (string,int) Hashtbl.t = Hashtbl.create 7
-
-    module StringSet = Set.Make(String)
-
-    let additional_debug_sections: StringSet.t ref = ref StringSet.empty
+      fprintf oc "	.xopt	align-fill-text=0x60000000\n"
 
     let print_epilogue oc =
-      if !Clflags.option_g then
-        begin
-          fprintf oc "\n";
-          let label_end = new_label () in
-          end_addr := label_end;
-          fprintf oc "%a:\n" label label_end;
-          fprintf oc "	.text\n";
-          Debug.all_files_iter (fun file ->
-            let label = new_label () in
-            Hashtbl.add filenum file label;
-            fprintf oc ".L%d:	.d2filenum \"%s\"\n" label file);
-          fprintf oc "	.d2_line_end\n";
-          StringSet.iter (fun s ->
-            if s <> (name_of_section Section_text) then
-              begin
-                fprintf oc "	%s\n" s;
-                fprintf oc "	.d2_line_end\n"
-              end) !additional_debug_sections
-        end
+      let end_label sec = 
+        fprintf oc "\n";
+        fprintf oc "	%s\n" sec;
+        let label_end = new_label () in
+        fprintf oc "%a:\n" label label_end;
+        label_end 
+      and entry_label f =
+        let label = new_label () in
+        fprintf oc ".L%d:	.d2filenum \"%s\"\n" label f;
+        label
+      and end_line () =   fprintf oc "	.d2_line_end\n" in
+      Debug.compute_file_enum end_label entry_label end_line
 
     let print_file_loc oc (file,col) =
-      fprintf oc "	.4byte		%a\n" label (Hashtbl.find filenum file);
+      fprintf oc "	.4byte		1\n";(* label (Hashtbl.find filenum file);*)
       fprintf oc "	.uleb128	%d\n" col
 
     let debug_section oc sec =
-      if !Clflags.option_g && Configuration.advanced_debug then
-        match sec with
-        | Section_user (name,_,_)  ->
-            let sec_name = name_of_section sec in
-            if not (StringSet.mem sec_name !additional_debug_sections) && name <> ".text" then
-              begin
-                let name = ".debug_line"^name in
-                additional_debug_sections := StringSet.add sec_name !additional_debug_sections;
-                fprintf oc "	.section	%s,,n\n" name;
-                fprintf oc "	.sectionlink	.debug_line\n";
-                section oc sec;
-                fprintf oc "	.0byte	%a\n" label !debug_start_addr;
-                fprintf oc "	.d2_line_start	%s\n" name
-              end
-        | _ -> () (* Only the case of a user section is interresting *)
-      else
-        ()
+      match sec with
+      | Section_debug_abbrev 
+      | Section_debug_info _
+      | Section_debug_loc -> ()
+      | sec ->
+          let name = match sec with
+          | Section_user (name,_,_) -> name
+          | _ -> name_of_section sec in
+          if not (Debug.exists_section name) then 
+            let line_start = new_label ()
+            and low_pc = new_label ()
+            and debug_info = new_label () in
+            Debug.add_compilation_section_start name (line_start,low_pc,debug_info,name_of_section sec);
+            let line_name = ".debug_line" ^(if name <> ".text" then name else "") in 
+            fprintf oc "	.section	%s,,n\n" line_name;
+            if name <> ".text" then
+              fprintf oc "	.sectionlink	.debug_line\n";
+            fprintf oc "%a:\n" label line_start;
+            section oc sec;
+            fprintf oc "%a:\n" label low_pc;
+            fprintf oc "	.0byte	%a\n" label debug_info;
+            fprintf oc "	.d2_line_start	%s\n" line_name
+          else
+            ()
             
 
   end