Changed definition of implem for debug information.

Instead of making each filed mutuable we use a reference to a record
of type implem. Now only the default implementation and the default
debug information need to be upated to add a new function.
Bug 17392.

4 files changed, 134 insertions, 171 deletions

diff --git a/debug/Debug.ml b/debug/Debug.ml
index 22f913c5..25517eee 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -22,39 +22,38 @@ open DwarfTypes
 (* Record used for stroring references to the actual implementation functions *)
 type implem = 
     {
-     mutable init: string -> unit;
-     mutable atom_global: ident -> atom -> 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;
-     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;
-     mutable enter_scope: int -> int -> int -> unit;
-     mutable enter_function_scope: int -> int -> unit;
-     mutable add_lvar_scope: int -> ident -> int -> unit;
-     mutable open_scope: atom -> int -> positive -> unit;
-     mutable close_scope: atom -> int -> positive -> unit;
-     mutable start_live_range: (atom * atom) -> positive -> int * int builtin_arg -> unit;
-     mutable end_live_range: (atom * atom) -> positive -> unit;
-     mutable stack_variable: (atom * atom) -> int * int builtin_arg -> unit;
-     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 -> unit;
-     mutable add_compilation_section_end: string -> int -> unit;
-     mutable compute_diab_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit;
-     mutable compute_gnu_file_enum: (string -> unit) -> unit;
-     mutable exists_section: string -> bool;
-     mutable remove_unused: ident -> unit;
-     mutable variable_printed: string -> unit;
-     mutable add_diab_info: string -> (int * int * string) -> unit;
+      init: string -> unit;
+      atom_global: ident -> atom -> unit;
+      set_composite_size: ident -> struct_or_union -> int option -> unit;
+      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;
+      generate_debug_info: (atom -> string) -> string -> debug_entries option;
+      all_files_iter: (string -> unit) -> unit;
+      insert_local_declaration:  storage -> ident -> typ -> location -> unit;
+      atom_local_variable: ident -> atom -> unit;
+      enter_scope: int -> int -> int -> unit;
+      enter_function_scope: int -> int -> unit;
+      add_lvar_scope: int -> ident -> int -> unit;
+      open_scope: atom -> int -> positive -> unit;
+      close_scope: atom -> int -> positive -> unit;
+      start_live_range: (atom * atom) -> positive -> int * int builtin_arg -> unit;
+      end_live_range: (atom * atom) -> positive -> unit;
+      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: string -> int -> unit;
+      add_compilation_section_end: string -> int -> unit;
+      compute_diab_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit;
+      compute_gnu_file_enum: (string -> unit) -> unit;
+      exists_section: string -> bool;
+      remove_unused: ident -> unit;
+      variable_printed: string -> unit;
+      add_diab_info: string -> (int * int * string) -> unit;
    }
 
-let implem =
+let default_implem =
   {
    init = (fun _ -> ());
    atom_global = (fun _ _ -> ());
@@ -75,7 +74,6 @@ let implem =
    start_live_range = (fun _ _ _ -> ());
    end_live_range = (fun _ _ -> ());
    stack_variable = (fun _ _ -> ());
-   function_end = (fun _ _ -> ());
    add_label = (fun _ _ _ -> ());
    atom_parameter = (fun _ _ _ -> ());
    add_compilation_section_start = (fun _ _ -> ());
@@ -88,33 +86,34 @@ let implem =
    add_diab_info = (fun _ _ -> ());
 }
 
-let init_compile_unit name = implem.init name
-let atom_global id atom = implem.atom_global id atom
-let set_composite_size id sou size = implem.set_composite_size id sou size
-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 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
-let enter_scope p_id id = implem.enter_scope p_id id
-let enter_function_scope fun_id sc_id = implem.enter_function_scope fun_id sc_id
-let add_lvar_scope fun_id var_id s_id = implem.add_lvar_scope fun_id var_id s_id
-let open_scope atom id lbl = implem.open_scope atom id lbl
-let close_scope atom id lbl = implem.close_scope atom id lbl
-let start_live_range atom lbl loc = implem.start_live_range atom lbl loc
-let end_live_range atom lbl = implem.end_live_range atom lbl
-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 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 implem = ref default_implem
+
+let init_compile_unit name = !implem.init name
+let atom_global id atom = !implem.atom_global id atom
+let set_composite_size id sou size = !implem.set_composite_size id sou size
+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 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
+let enter_scope p_id id = !implem.enter_scope p_id id
+let enter_function_scope fun_id sc_id = !implem.enter_function_scope fun_id sc_id
+let add_lvar_scope fun_id var_id s_id = !implem.add_lvar_scope fun_id var_id s_id
+let open_scope atom id lbl = !implem.open_scope atom id lbl
+let close_scope atom id lbl = !implem.close_scope atom id lbl
+let start_live_range atom lbl loc = !implem.start_live_range atom lbl loc
+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
diff --git a/debug/Debug.mli b/debug/Debug.mli
index 94862844..553e1412 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -20,39 +20,40 @@ open BinNums
 (* Record used for stroring references to the actual implementation functions *)
 type implem = 
     {
-     mutable init: string -> unit;
-     mutable atom_global: ident -> atom -> 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;
-     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;
-     mutable enter_scope: int -> int -> int -> unit;
-     mutable enter_function_scope: int -> int -> unit;
-     mutable add_lvar_scope: int -> ident -> int -> unit;
-     mutable open_scope: atom -> int -> positive -> unit;
-     mutable close_scope: atom -> int -> positive -> unit;
-     mutable start_live_range: (atom * atom) -> positive -> int * int builtin_arg -> unit;
-     mutable end_live_range: (atom * atom) -> positive -> unit;
-     mutable stack_variable: (atom * atom) -> int * int builtin_arg -> unit;
-     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 -> unit;
-     mutable add_compilation_section_end: string -> int -> unit;
-     mutable compute_diab_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit;
-     mutable compute_gnu_file_enum: (string -> unit) -> unit;
-     mutable exists_section: string -> bool;
-     mutable remove_unused: ident -> unit;
-     mutable variable_printed: string -> unit;
-     mutable add_diab_info: string -> (int * int * string) -> unit;
+     init: string -> unit;
+     atom_global: ident -> atom -> unit;
+     set_composite_size: ident -> struct_or_union -> int option -> unit;
+     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;
+     generate_debug_info: (atom -> string) -> string -> debug_entries option;
+     all_files_iter: (string -> unit) -> unit;
+     insert_local_declaration:  storage -> ident -> typ -> location -> unit;
+     atom_local_variable: ident -> atom -> unit;
+     enter_scope: int -> int -> int -> unit;
+     enter_function_scope: int -> int -> unit;
+     add_lvar_scope: int -> ident -> int -> unit;
+     open_scope: atom -> int -> positive -> unit;
+     close_scope: atom -> int -> positive -> unit;
+     start_live_range: (atom * atom) -> positive -> int * int builtin_arg -> unit;
+     end_live_range: (atom * atom) -> positive -> unit;
+     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: string -> int -> unit;
+     add_compilation_section_end: string -> int -> unit;
+     compute_diab_file_enum: (string -> int) -> (string-> int) -> (unit -> unit) -> unit;
+     compute_gnu_file_enum: (string -> unit) -> unit;
+     exists_section: string -> bool;
+     remove_unused: ident -> unit;
+     variable_printed: string -> unit;
+     add_diab_info: string -> (int * int * string) -> unit;
    }
 
-val implem: implem
+val default_implem: implem
+
+val implem: implem ref
 
 val init_compile_unit: string -> unit
 val atom_global: ident -> atom -> unit
@@ -72,7 +73,6 @@ val close_scope: atom -> int -> positive -> unit
 val start_live_range: (atom * atom) -> positive -> (int * int builtin_arg) -> unit
 val end_live_range: (atom * atom) -> positive -> unit
 val stack_variable: (atom * atom) -> int * int builtin_arg -> unit
-val function_end: atom -> positive -> 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
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 96355d66..0f9c8ff3 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -60,7 +60,7 @@ let typ_to_string (ty: typ) =
   Buffer.contents buf
 
 (* Helper functions for the attributes *)
-let strip_attributes typ = strip_attributes_type typ [AConst;AVolatile]
+let strip_attributes typ = strip_attributes_type typ [AConst; AVolatile]
 
 (* Does the type already exist? *)
 let exist_type (ty: typ) =
@@ -536,20 +536,11 @@ let label_translation: (atom * positive, int) Hashtbl.t = Hashtbl.create 7
 let add_label atom p i =
   Hashtbl.add label_translation (atom,p) i
 
-(* Auxiliary data structures and functions *)
-module IntSet = Set.Make(struct
-  type t = int
-  let compare (x:int) (y:int) = compare x y
-end)
-
-let open_scopes: IntSet.t ref = ref IntSet.empty
-
 let open_scope atom s_id lbl =
   try
     let s_id = Hashtbl.find atom_to_scope (atom,s_id) in
     let old_r = try Hashtbl.find scope_ranges s_id with Not_found -> [] in
     let n_scop = { start_addr = Some lbl; end_addr = None;} in
-    open_scopes := IntSet.add s_id !open_scopes;
     Hashtbl.replace scope_ranges s_id (n_scop::old_r)
   with Not_found -> ()
 
@@ -564,7 +555,6 @@ let close_scope atom s_id lbl =
         | _ -> assert false (* We must have an opening scope *)
       end in
     let new_r = ({last_r with end_addr = Some lbl;})::rest in
-    open_scopes := IntSet.remove s_id !open_scopes;
     Hashtbl.replace scope_ranges s_id new_r
   with Not_found -> ()
 
@@ -590,10 +580,6 @@ let end_live_range (f,v) lbl =
 let stack_variable (f,v) (sp,loc) =
   Hashtbl.add var_locations (f,v) (FunctionLoc (sp,loc))
 
-let function_end atom loc =
-  IntSet.iter (fun id -> close_scope atom id loc) !open_scopes;
-  open_scopes := IntSet.empty
-
 let compilation_section_start: (string,int) Hashtbl.t = Hashtbl.create 7
 let compilation_section_end: (string,int) Hashtbl.t = Hashtbl.create 7
 
diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml
index 09714628..209f2024 100644
--- a/debug/DebugInit.ml
+++ b/debug/DebugInit.ml
@@ -18,71 +18,49 @@ open Dwarfgen
 open DwarfTypes
 open Debug
 
+let default_debug =
+  {
+   init = DebugInformation.init;
+   atom_global = DebugInformation.atom_global;
+   set_composite_size = DebugInformation.set_composite_size;
+   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;
+   generate_debug_info = (fun _ _  -> None);
+   all_files_iter = (fun f -> DebugInformation.StringSet.iter f !DebugInformation.all_files);
+   insert_local_declaration = DebugInformation.insert_local_declaration;
+   atom_local_variable = DebugInformation.atom_local_variable;
+   enter_scope = DebugInformation.enter_scope;
+   enter_function_scope = DebugInformation.enter_function_scope;
+   add_lvar_scope = DebugInformation.add_lvar_scope;
+   open_scope = DebugInformation.open_scope;
+   close_scope = DebugInformation.close_scope;
+   start_live_range = DebugInformation.start_live_range;
+   end_live_range = DebugInformation.end_live_range;
+   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;
+ }
+
 let init_debug () =
-  implem.init <- DebugInformation.init;
-  implem.atom_global <- DebugInformation.atom_global;
-  implem.set_composite_size <- DebugInformation.set_composite_size;
-  implem.set_member_offset <- DebugInformation.set_member_offset;
-  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 <- 
-    if Configuration.system = "diab" then
-      (fun a b -> Some (Dwarfgen.gen_diab_debug_info a b))
-    else
-      (fun a b -> Some (Dwarfgen.gen_gnu_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;
-  implem.enter_scope <- DebugInformation.enter_scope;
-  implem.enter_function_scope <- DebugInformation.enter_function_scope;
-  implem.add_lvar_scope <- DebugInformation.add_lvar_scope;
-  implem.open_scope <- DebugInformation.open_scope;
-  implem.close_scope <- DebugInformation.close_scope;
-  implem.start_live_range <- DebugInformation.start_live_range;
-  implem.end_live_range <- DebugInformation.end_live_range;
-  implem.stack_variable <- DebugInformation.stack_variable;
-  implem.add_label <- DebugInformation.add_label;
-  implem.atom_parameter <- DebugInformation.atom_parameter;
-  implem.add_compilation_section_start <- DebugInformation.add_compilation_section_start;
-  implem.add_compilation_section_end <- DebugInformation.add_compilation_section_end;
-  implem.compute_diab_file_enum <- DebugInformation.compute_diab_file_enum;
-  implem.compute_gnu_file_enum <- DebugInformation.compute_gnu_file_enum;
-  implem.exists_section <- DebugInformation.exists_section;
-  implem.remove_unused <- DebugInformation.remove_unused;
-  implem.variable_printed <- DebugInformation.variable_printed;
-  implem.add_diab_info <- DebugInformation.add_diab_info
+  let gen =
+  if Configuration.system = "diab" then
+    (fun a b -> Some (Dwarfgen.gen_diab_debug_info a b))
+  else
+    (fun a b -> Some (Dwarfgen.gen_gnu_debug_info a b)) in
+  implem := {default_debug with generate_debug_info = gen;}
 
 let init_none () =
-  implem.init <- (fun _ -> ());
-  implem.atom_global <- (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 _ _ -> ());
-  implem.generate_debug_info <- (fun _ _ -> None);
-  implem.all_files_iter <- (fun _ -> ());
-  implem.insert_local_declaration <- (fun  _ _ _ _ -> ());
-  implem.atom_local_variable <- (fun _ _ -> ());
-  implem.enter_scope <- (fun _ _  _ -> ());
-  implem.enter_function_scope <- (fun _ _ -> ());
-  implem.add_lvar_scope <- (fun _ _ _ -> ());
-  implem.open_scope <- (fun _ _ _ -> ());
-  implem.close_scope <- (fun _ _ _ -> ());
-  implem.start_live_range <- (fun _ _ _ -> ());
-  implem.end_live_range <- (fun _ _ -> ());
-  implem.stack_variable <- (fun _ _ -> ());
-  implem.add_label <- (fun _ _ _ -> ());
-  implem.atom_parameter <- (fun _ _ _ -> ());
-  implem.add_compilation_section_start <- (fun _ _ -> ());
-  implem.add_compilation_section_end <- (fun _ _ -> ());
-  implem.compute_diab_file_enum <- (fun _ _ _ -> ());
-  implem.compute_gnu_file_enum <- (fun _ -> ());
-  implem.exists_section <- (fun _ -> true);
-  implem.remove_unused <- (fun _ -> ());
-  implem.variable_printed <- (fun _ -> ());
-  implem.add_diab_info <- (fun _ _ -> ())
+  implem := default_implem
 
 let init () =
   if !Clflags.option_g && Configuration.advanced_debug then