diff options
| -rw-r--r-- | cfrontend/C2C.ml | 1 | ||||
| -rw-r--r-- | cparser/Elab.ml | 4 | ||||
| -rw-r--r-- | debug/Debug.ml | 10 | ||||
| -rw-r--r-- | debug/Debug.mli | 2 | ||||
| -rw-r--r-- | debug/DebugInformation.ml | 89 | ||||
| -rw-r--r-- | debug/Dwarfgen.ml | 16 |
6 files changed, 109 insertions, 13 deletions
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 4ed1ded3..b7012ef9 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -1054,6 +1054,7 @@ let convertFundef loc env fd = if init <> None then unsupported "initialized local variable"; let id' = intern_string id.name in + Debug.atom_local_variable id id'; (id', convertTyp env ty)) fd.fd_locals in let body' = convertStmt loc env fd.fd_body in diff --git a/cparser/Elab.ml b/cparser/Elab.ml index 6839ac9f..6c941a1f 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -2226,7 +2226,9 @@ and elab_block_body env ctx sl = | DEFINITION def :: sl1 -> let (dcl, env') = elab_definition true env def in let loc = elab_loc (get_definitionloc def) in - List.map (fun d -> {sdesc = Sdecl d; sloc = loc}) dcl + List.map (fun ((sto,id,ty,_) as d) -> + Debug.insert_local_declaration sto id ty loc; + {sdesc = Sdecl d; sloc = loc}) dcl @ elab_block_body env' ctx sl1 | s :: sl1 -> let s' = elab_stmt env ctx s in diff --git a/debug/Debug.ml b/debug/Debug.ml index c45fd074..bf3892d2 100644 --- a/debug/Debug.ml +++ b/debug/Debug.ml @@ -30,6 +30,8 @@ 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 atom_local_variable: ident -> atom -> unit; } let implem = @@ -44,6 +46,8 @@ let implem = add_fun_addr = (fun _ _ -> ()); generate_debug_info = (fun _ -> None); all_files_iter = (fun _ -> ()); + insert_local_declaration = (fun _ _ _ _ -> ()); + atom_local_variable = (fun _ _ -> ()); } let init () = @@ -58,6 +62,8 @@ let init () = implem.add_fun_addr <- DebugInformation.add_fun_addr; implem.generate_debug_info <- (fun () -> Some (Dwarfgen.gen_debug_info ())); 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; end else begin implem.init <- (fun _ -> ()); implem.atom_function <- (fun _ _ -> ()); @@ -69,6 +75,8 @@ let init () = 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 _ _ -> ()); end let init_compile_unit name = implem.init name @@ -81,3 +89,5 @@ 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 atom_local_variable id atom = implem.atom_local_variable id atom diff --git a/debug/Debug.mli b/debug/Debug.mli index e712874c..69894ba7 100644 --- a/debug/Debug.mli +++ b/debug/Debug.mli @@ -26,3 +26,5 @@ 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 atom_local_variable: ident -> atom -> unit diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml index 100f37e2..38ce6e64 100644 --- a/debug/DebugInformation.ml +++ b/debug/DebugInformation.ml @@ -360,7 +360,6 @@ type function_information = { fun_return_type: int option; (* Again the special case of void functions *) fun_vararg: bool; fun_parameter: parameter_information list; - fun_locals: int list; fun_low_pc: int option; fun_high_pc: int option; } @@ -369,7 +368,8 @@ type definition_type = | GlobalVariable of global_variable_information | Function of function_information -(* All definitions encountered *) + +(* All global definitions encountered *) let definitions: (int,definition_type) Hashtbl.t = Hashtbl.create 7 (* Mapping from stamp to debug id *) @@ -378,7 +378,7 @@ let stamp_to_definition: (int,int) Hashtbl.t = Hashtbl.create 7 (* Mapping from atom to debug id *) let atom_to_definition: (atom, int) Hashtbl.t = Hashtbl.create 7 -let find_var_stamp id = +let find_gvar_stamp id = let id = (Hashtbl.find stamp_to_definition id) in let var = Hashtbl.find definitions id in match var with @@ -399,7 +399,6 @@ let find_fun_atom id = | Function f -> id,f | _ -> assert false - let replace_var id var = let var = GlobalVariable var in Hashtbl.replace definitions id var @@ -408,6 +407,45 @@ let replace_fun id f = let f = Function f in Hashtbl.replace definitions id f + +(* Information for local variables *) +type local_variable_information = { + lvar_name: string; + lvar_atom: atom option; + lvar_file_loc:location; + lvar_type: int; + lvar_static: bool; (* Static variable are mapped to symbols *) + } + +type scope_information = + { + scope_variables: int list; (* Variable and Scope ids *) + } + +type local_information = + | LocalVariable of local_variable_information + | Scope of scope_information + +(* All local variables *) +let local_variables: (int, local_information) Hashtbl.t = Hashtbl.create 7 + +(* Mapping from stampt to the debug id of the local variable *) +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 + +let find_lvar_stamp id = + let id = (Hashtbl.find stamp_to_local id) in + let v = Hashtbl.find local_variables id in + match v with + | LocalVariable v -> id,v + | _ -> assert false + +let replace_lvar id var = + let var = LocalVariable var in + Hashtbl.replace local_variables id var + let gen_comp_typ sou id at = if sou = Struct then TStruct (id,at) @@ -440,7 +478,7 @@ let insert_global_declaration env dec= } in insert (GlobalVariable decl) id.stamp end else if init <> None || sto <> Storage_extern then begin (* It is a definition *) - let id,var = find_var_stamp id.stamp in + let id,var = find_gvar_stamp id.stamp in replace_var id ({var with gvar_declaration = false;}) end end @@ -467,7 +505,6 @@ let insert_global_declaration env dec= fun_return_type = ret; fun_vararg = f.fd_vararg; fun_parameter = params; - fun_locals = []; fun_low_pc = None; fun_high_pc = None; } in @@ -536,14 +573,13 @@ let set_bitfield_offset str field offset underlying size = let atom_global_variable id atom = try - let id,var = find_var_stamp id.stamp in + let id,var = find_gvar_stamp id.stamp in replace_var id ({var with gvar_atom = Some atom;}); Hashtbl.add atom_to_definition atom id with Not_found -> () let atom_function id atom = try - Printf.printf "Trying to add atom of function %s\n" id.name; let id,f = find_fun_stamp id.stamp in replace_fun id ({f with fun_atom = Some atom;}); Hashtbl.add atom_to_definition atom id @@ -553,7 +589,37 @@ let add_fun_addr atom (high,low) = try let id,f = find_fun_atom atom in replace_fun id ({f with fun_high_pc = Some high; fun_low_pc = Some low;}) - with Not_found -> Printf.printf "Could not find function %s\n" (extern_atom atom); () + with Not_found -> () + +let atom_local_variable id atom = + try + let id,var = find_lvar_stamp id.stamp in + replace_lvar id ({var with lvar_atom = Some atom;}); + Hashtbl.add atom_to_local atom id + with Not_found -> () + +let insert_local_declaration sto id ty loc = + let ty = find_type ty in + let var = { + lvar_name = id.name; + lvar_atom = None; + lvar_file_loc = loc; + lvar_type = ty; + lvar_static = sto = Storage_static; + } in + let id' = next_id () in + Hashtbl.add local_variables id' (LocalVariable var); + Hashtbl.add stamp_to_local id.stamp id' + +let scopes: (int * scope_information) Stack.t = Stack.create () + +let enter_scope id = + let empty_scope = {scope_variables = [];} in + Stack.push (id,empty_scope) scopes + +let enter_function_scope id = + Stack.clear scopes; + enter_scope id let init name = id := 0; @@ -562,5 +628,8 @@ let init name = Hashtbl.reset lookup_types; Hashtbl.reset definitions; Hashtbl.reset stamp_to_definition; - Hashtbl.reset atom_to_definition + Hashtbl.reset atom_to_definition; + Hashtbl.reset local_variables; + Hashtbl.reset stamp_to_local; + Hashtbl.reset atom_to_local diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml index 0acab05a..bb0ab5f2 100644 --- a/debug/Dwarfgen.ml +++ b/debug/Dwarfgen.ml @@ -217,6 +217,17 @@ let function_parameter_to_entry p = } in new_entry (next_id ()) (DW_TAG_formal_parameter p) +let local_variable_to_entry v id = + let var = { + variable_file_loc = v.lvar_file_loc; + variable_declaration = None; + variable_external = None; + variable_name = v.lvar_name; + variable_type = v.lvar_type; + variable_location = None; + } in + new_entry id (DW_TAG_variable var) + let function_to_entry id f = let f_tag = { subprogram_file_loc = f.fun_file_loc; @@ -228,8 +239,9 @@ let function_to_entry id f = subprogram_low_pc = f.fun_low_pc; } in let f_entry = new_entry id (DW_TAG_subprogram f_tag) in - let child = List.map function_parameter_to_entry f.fun_parameter in - add_children f_entry child + let params = List.map function_parameter_to_entry f.fun_parameter in +(* let vars = List.map local_variable_to_entry f.fun_locals in*) + add_children f_entry params let definition_to_entry id t = match t with |