Added location for the formal parameters and move the end of all

scopes before the last statement.

7 files changed, 59 insertions, 27 deletions

diff --git a/debug/Debug.ml b/debug/Debug.ml
index a496b610..d0de9e98 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -44,6 +44,7 @@ type implem =
      mutable stack_variable: 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;
    }
 
 let implem =
@@ -70,6 +71,7 @@ let implem =
    stack_variable = (fun _ _ -> ());
    function_end = (fun _ _ -> ());
    add_label = (fun _ _ _ -> ());
+   atom_parameter = (fun _ _ _ -> ());
 }
 
 let init_compile_unit name = implem.init name
@@ -94,3 +96,4 @@ 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
diff --git a/debug/Debug.mli b/debug/Debug.mli
index 5ef1e7f5..c5fcddb3 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -42,6 +42,7 @@ type implem =
      mutable stack_variable: 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;
    }
 
 val implem: implem
@@ -68,3 +69,4 @@ 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 atom_parameter: ident -> ident -> atom -> unit
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index ec16f64e..8b6ec1ad 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -29,6 +29,10 @@ let next_id () =
 let reset_id () =
   id := 0
 
+(* Auximilary functions *)
+let list_replace c f l =
+  List.map (fun a -> if c a then f a else a) l
+
 (* The name of the current compilation unit *)
 let file_name: string ref = ref ""
 
@@ -349,6 +353,7 @@ type global_variable_information = {
 type parameter_information = 
  {
   parameter_name:     string;
+  parameter_ident:    int;
   parameter_atom:     atom option;
   parameter_type:     int;
 }
@@ -512,6 +517,7 @@ let insert_global_declaration env dec=
         let ty = insert_type ty in
         {
          parameter_name = p.name;
+         parameter_ident = p.stamp;
          parameter_atom = None;
          parameter_type = ty;
        }) f.fd_params in
@@ -572,9 +578,7 @@ 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;}
-      else a) comp.ct_members in
+    let members = list_replace name (fun a -> {a with cfd_byte_offset = Some offset;}) comp.ct_members in
     {comp with ct_members = members;})
 
 let set_composite_size comp sou size =
@@ -585,10 +589,9 @@ 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
+    let members = list_replace name (fun a -> 
+      {a with cfd_bit_offset = Some offset; cfd_bitfield = Some underlying; cfd_byte_size = Some size})
+        comp.ct_members in
     {comp with ct_members = members;})
 
 let atom_global_variable id atom = 
@@ -606,6 +609,14 @@ let atom_function id atom =
     Hashtbl.iter (fun (fid,sid) tid -> if fid = id.stamp then 
       Hashtbl.add atom_to_scope (atom,sid) tid) scope_to_local
   with Not_found -> ()
+
+let atom_parameter fid id atom =
+  try
+    let fid',f = find_fun_stamp fid.stamp in
+    let name p = p.parameter_ident = id.stamp in
+    let params = list_replace name (fun p -> {p with parameter_atom = Some atom;}) f.fun_parameter in
+    replace_fun fid' ({f with fun_parameter = params;})
+  with Not_found -> ()
     
 let add_fun_addr atom (high,low) =
   try
@@ -763,6 +774,8 @@ 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_end: (string,int) Hashtbl.t = Hashtbl.create 7
 
 let init name =
   id := 0;
@@ -776,3 +789,5 @@ let init name =
   Hashtbl.reset stamp_to_local;
   Hashtbl.reset atom_to_local;
   Hashtbl.reset scope_to_local;
+  Hashtbl.reset compilation_section_start;
+  Hashtbl.reset compilation_section_end
diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml
index 40be9f42..17db4354 100644
--- a/debug/DebugInit.ml
+++ b/debug/DebugInit.ml
@@ -40,7 +40,8 @@ let init_debug () =
   implem.end_live_range <- DebugInformation.end_live_range;
   implem.stack_variable <- DebugInformation.stack_variable;
   implem.function_end <- DebugInformation.function_end;
-  implem.add_label <- DebugInformation.add_label
+  implem.add_label <- DebugInformation.add_label;
+  implem.atom_parameter <- DebugInformation.atom_parameter
 
 let init_none () =
   implem.init <- (fun _ -> ());
@@ -64,7 +65,9 @@ let init_none () =
   implem.end_live_range <- (fun _ _ -> ());
   implem.stack_variable <- (fun _ _ -> ());
   implem.function_end <- (fun _ _ -> ());
-  implem.add_label <- (fun _ _ _ -> ())
+  implem.add_label <- (fun _ _ _ -> ());
+  implem.atom_parameter <- (fun _ _ _ -> ())
+
 
 let init () =
   if !Clflags.option_g then
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index 63ba4cd0..32c15dfd 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -131,7 +131,8 @@ module DwarfPrinter(Target: DWARF_TARGET):
           add_attr_some e.formal_parameter_artificial (add_abbr_entry (0x34,artificial_type_abbr));
           add_attr_some e.formal_parameter_name add_name;
           add_type buf;
-          add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,variable_parameter_type_abbr))
+          add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,variable_parameter_type_abbr));
+          add_location  e.formal_parameter_location buf
       | DW_TAG_label _ ->
           prologue 0xa;
           add_low_pc buf;
@@ -419,7 +420,8 @@ module DwarfPrinter(Target: DWARF_TARGET):
       print_opt_value oc fp.formal_parameter_artificial print_flag;
       print_opt_value oc fp.formal_parameter_name print_string;
       print_ref oc fp.formal_parameter_type;
-      print_opt_value oc fp.formal_parameter_variable_parameter print_flag
+      print_opt_value oc fp.formal_parameter_variable_parameter print_flag;
+      print_opt_value oc fp.formal_parameter_location print_loc
 
     let print_tag_label oc tl =
       print_ref oc tl.label_low_pc;
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index 86a14163..8c2a7d56 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -107,6 +107,7 @@ type dw_tag_formal_parameter =
      formal_parameter_name:               string         option;
      formal_parameter_type:               reference;
      formal_parameter_variable_parameter: flag           option;
+     formal_parameter_location:           location_value option;
    }
 
 type dw_tag_label =
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index 4e531ca9..7fce22a7 100644
--- a/debug/Dwarfgen.ml
+++ b/debug/Dwarfgen.ml
@@ -145,6 +145,7 @@ let fun_type_to_entry id f =
         formal_parameter_name = if p.param_name <> "" then Some p.param_name else None;
         formal_parameter_type = p.param_type;
         formal_parameter_variable_parameter = None;
+        formal_parameter_location = None;
       } in
       new_entry (next_id ()) (DW_TAG_formal_parameter fp)) f.fun_params;
   in
@@ -272,16 +273,6 @@ let global_variable_to_entry acc id v =
   } in
   new_entry id (DW_TAG_variable var),IntSet.add v.gvar_type acc
 
-let function_parameter_to_entry acc p =
-  let p = {
-    formal_parameter_file_loc = None;
-    formal_parameter_artificial = None;
-    formal_parameter_name = Some p.parameter_name;
-    formal_parameter_type = p.parameter_type;
-    formal_parameter_variable_parameter = None;
-  } in
-  new_entry (next_id ()) (DW_TAG_formal_parameter p),IntSet.add p.formal_parameter_type acc
-
 let gen_splitlong op_hi op_lo =
   let op_piece = DW_OP_piece 4 in
   op_piece::op_hi@(op_piece::op_lo)
@@ -317,10 +308,10 @@ let range_entry_loc (sp,l) =
   | [a] -> LocSimple a
   | a::rest -> LocList (a::rest)
 
-let rec local_variable_to_entry f_id (acc,bcc) v id =
-  let loc,loc_list = try
+let location_entry f_id atom =
+  try
     begin 
-      match (Hashtbl.find var_locations (get_opt_val v.lvar_atom)) with
+      match (Hashtbl.find var_locations atom) with
       | FunctionLoc (a,r) ->
           translate_function_loc a r
       | RangeLoc l ->
@@ -331,9 +322,24 @@ let rec local_variable_to_entry f_id (acc,bcc) v id =
             and lo = Hashtbl.find label_translation (f_id,lo) in
             hi,lo,range_entry_loc i.var_loc) l in
           let id = next_id () in
-          Some (LocRef id),[{loc = l;loc_id = id;}]
+        Some (LocRef id),[{loc = l;loc_id = id;}]
     end
-  with Not_found -> None,[] in
+  with Not_found -> None,[]
+
+let function_parameter_to_entry f_id (acc,bcc) p =
+  let loc,loc_list = location_entry f_id (get_opt_val p.parameter_atom) in
+  let p = {
+    formal_parameter_file_loc = None;
+    formal_parameter_artificial = None;
+    formal_parameter_name = Some p.parameter_name;
+    formal_parameter_type = p.parameter_type;
+    formal_parameter_variable_parameter = None;
+    formal_parameter_location = loc;
+  } 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 loc,loc_list = location_entry f_id (get_opt_val v.lvar_atom) in
   let var = {
     variable_file_loc = v.lvar_file_loc;
     variable_declaration = None;
@@ -392,7 +398,7 @@ let function_to_entry (acc,bcc) id f =
   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
   let f_entry =  new_entry id (DW_TAG_subprogram f_tag) in
-  let params,acc = mmap function_parameter_to_entry acc f.fun_parameter 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
   add_children f_entry (params@vars),(acc,bcc)