New version of adding scopes etc.

Instead of reimplementing the whole scope handling in the debug information
use the existing functionality and fill the scopes explicitly in the functions.

3 files changed, 62 insertions, 15 deletions

diff --git a/debug/Debug.ml b/debug/Debug.ml
index bf3892d2..10b4e68f 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -30,8 +30,10 @@ type implem =
      mutable add_fun_addr: atom -> (int * int) -> unit;
      mutable generate_debug_info: unit -> dw_entry option;
      mutable all_files_iter: (string -> unit) -> unit;
-     mutable insert_local_declaration: storage -> ident -> typ -> location -> unit;
+     mutable insert_local_declaration: int -> storage -> ident -> typ -> location -> unit;
      mutable atom_local_variable: ident -> atom -> unit;
+     mutable enter_scope: int -> int -> unit;
+     mutable enter_function_scope: ident -> int -> unit;
    }
 
 let implem =
@@ -46,8 +48,10 @@ let implem =
    add_fun_addr = (fun _ _ -> ());
    generate_debug_info = (fun _ -> None);
    all_files_iter = (fun _ -> ());
-   insert_local_declaration = (fun _ _ _ _ -> ());
+   insert_local_declaration = (fun _ _ _ _ _ -> ());
    atom_local_variable = (fun _ _ -> ());
+   enter_scope = (fun _ _  -> ());
+   enter_function_scope = (fun _ _ -> ());
 }
 
 let init () =
@@ -64,6 +68,8 @@ let init () =
     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;
   end else begin
     implem.init <- (fun _ -> ());
     implem.atom_function <- (fun _ _ -> ());
@@ -75,8 +81,10 @@ let init () =
     implem.add_fun_addr <- (fun _ _ -> ());
     implem.generate_debug_info <- (fun _ -> None);
     implem.all_files_iter <- (fun _ -> ());
-    implem.insert_local_declaration <- (fun _ _ _ _ -> ());
+    implem.insert_local_declaration <- (fun _ _ _ _ _ -> ());
     implem.atom_local_variable <- (fun _ _ -> ());
+    implem.enter_scope <- (fun _ _  -> ());
+    implem.enter_function_scope <- (fun _ _ -> ());
   end
 
 let init_compile_unit name = implem.init name
@@ -89,5 +97,7 @@ 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 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 insert_local_declaration scope sto id ty loc = implem.insert_local_declaration scope 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
diff --git a/debug/Debug.mli b/debug/Debug.mli
index 69894ba7..087f073f 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -26,5 +26,7 @@ val insert_global_declaration:  Env.t -> globdecl -> unit
 val add_fun_addr: atom -> (int * int) -> unit
 val generate_debug_info: unit -> dw_entry option
 val all_files_iter: (string -> unit) -> unit
-val insert_local_declaration: storage -> ident -> typ -> location -> unit
+val insert_local_declaration: int -> storage -> ident -> typ -> location -> unit
 val atom_local_variable: ident -> atom -> unit
+val enter_scope: int -> int -> unit
+val enter_function_scope: ident -> int -> unit
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 38ce6e64..a85f2081 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -362,6 +362,7 @@ type function_information = {
     fun_parameter:   parameter_information list;
     fun_low_pc:      int option;
     fun_high_pc:     int option;
+    fun_scope:       int option;
   }
 
 type definition_type =
@@ -435,6 +436,9 @@ let stamp_to_local: (int,int) Hashtbl.t = Hashtbl.create 7
 (* Mapping form atom to the debug id of the local variable *)
 let atom_to_local: (atom, int) Hashtbl.t = Hashtbl.create 7
 
+(* Map from scope id to debug id *)
+let scope_to_local: (int,int) Hashtbl.t = Hashtbl.create 7
+
 let find_lvar_stamp id =
   let id = (Hashtbl.find stamp_to_local id) in
   let v = Hashtbl.find local_variables id in
@@ -446,6 +450,17 @@ let replace_lvar id var =
   let var = LocalVariable var in
   Hashtbl.replace local_variables id var
 
+let find_scope_id id =
+  let id = (Hashtbl.find scope_to_local id) in
+  let v = Hashtbl.find local_variables id in
+  match v with
+  | Scope v -> id,v
+  | _ -> assert false
+
+let replace_scope id var =
+  let var = Scope var in
+  Hashtbl.replace local_variables id var
+
 let gen_comp_typ sou id at = 
   if sou = Struct then
     TStruct (id,at)
@@ -507,6 +522,7 @@ let insert_global_declaration env dec=
         fun_parameter = params;
         fun_low_pc = None;
         fun_high_pc = None;
+        fun_scope = None;
       } in
       insert (Function fd) f.fd_name.stamp
   | Gcompositedecl (sou,id,at) -> 
@@ -598,7 +614,13 @@ let atom_local_variable id atom =
     Hashtbl.add atom_to_local atom id
   with Not_found -> ()
 
-let insert_local_declaration sto id ty loc =
+let add_lvar_scope var_id s_id =
+  try
+    let s_id',scope = find_scope_id s_id in
+    replace_scope s_id' ({scope_variables = var_id::scope.scope_variables;})
+  with Not_found -> ()
+
+let insert_local_declaration scope sto id ty loc =
   let ty = find_type ty in
   let var = {
     lvar_name = id.name;
@@ -609,17 +631,29 @@ let insert_local_declaration sto id ty loc =
   } in
   let id' = next_id () in
   Hashtbl.add local_variables id' (LocalVariable var);
-  Hashtbl.add stamp_to_local id.stamp id'
+  Hashtbl.add stamp_to_local id.stamp id';
+  add_lvar_scope id' scope
 
-let scopes: (int * scope_information) Stack.t = Stack.create ()
+let new_scope sc_id =
+  let scope = {scope_variables = [];} in
+  let id = next_id () in
+  Hashtbl.add local_variables id (Scope scope);
+  Hashtbl.add scope_to_local sc_id id;
+  id
 
-let enter_scope id =
-  let empty_scope = {scope_variables = [];} in
-  Stack.push (id,empty_scope) scopes
+let enter_function_scope fun_id sc_id =
+  try
+    let id = new_scope sc_id in
+    let fun_id,f = find_fun_stamp fun_id.stamp in
+    replace_fun id ({f with fun_scope = Some id})
+  with Not_found -> ()
 
-let enter_function_scope id =
-  Stack.clear scopes;
-  enter_scope id
+let enter_scope p_id id =
+  try
+    let id' = new_scope id in
+    let p_id',scope = find_scope_id p_id in
+    replace_scope p_id' ({scope_variables = id'::scope.scope_variables;})
+  with Not_found  -> ()
 
 let init name =
   id := 0;
@@ -631,5 +665,6 @@ let init name =
   Hashtbl.reset atom_to_definition;
   Hashtbl.reset local_variables;
   Hashtbl.reset stamp_to_local;
-  Hashtbl.reset atom_to_local
+  Hashtbl.reset atom_to_local;
+  Hashtbl.reset scope_to_local;