aboutsummaryrefslogtreecommitdiffstats
path: root/debug/DebugInformation.ml
diff options
context:
space:
mode:
authorBernhard Schommer <bernhardschommer@gmail.com>2015-09-16 11:10:28 +0200
committerBernhard Schommer <bernhardschommer@gmail.com>2015-09-16 11:10:28 +0200
commit3344bcf59acb1ae8d43a0d15acb4b824689e706d (patch)
treea5621a5d30ee7e39e2e6d2a95e02ab018e8ef846 /debug/DebugInformation.ml
parent36fe88d4cc2022947474a2fcc0b650e22f41ee3e (diff)
downloadcompcert-kvx-3344bcf59acb1ae8d43a0d15acb4b824689e706d.tar.gz
compcert-kvx-3344bcf59acb1ae8d43a0d15acb4b824689e706d.zip
Add the debug interface file.
The new file Debug.ml contains the interface for generating and printing debug information. In order to generate debug information the init function initializes the necessary functions depending on the -g flag. If the -g is not there all functions are dummy functions which do nothing.
Diffstat (limited to 'debug/DebugInformation.ml')
-rw-r--r--debug/DebugInformation.ml58
1 files changed, 48 insertions, 10 deletions
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 166a81e8..30d026c7 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -27,6 +27,9 @@ let next_id () =
let reset_id () =
id := 0
+(* The name of the current compilation unit *)
+let file_name: string ref = ref ""
+
(* Types for the information of type info *)
type composite_field =
@@ -117,7 +120,7 @@ type debug_types =
| Void
(* All types encountered *)
-let all_types: (int,debug_types) Hashtbl.t = Hashtbl.create 7
+let types: (int,debug_types) Hashtbl.t = Hashtbl.create 7
(* Lookup table for types *)
let lookup_types: (string, int) Hashtbl.t = Hashtbl.create 7
@@ -193,7 +196,7 @@ let insert_type (ty: typ) =
let insert d_ty ty =
let id = next_id ()
and name = typ_to_string ty in
- Hashtbl.add all_types id d_ty;
+ Hashtbl.add types id d_ty;
Hashtbl.add lookup_types name id;
id in
(* We are only interrested in Const and Volatile *)
@@ -291,26 +294,26 @@ let insert_type (ty: typ) =
(* Replace the composite information *)
let replace_composite id f =
- let str = Hashtbl.find all_types id in
+ let str = Hashtbl.find types id in
match str with
| CompositeType comp -> let comp' = f comp in
- if comp <> comp' then Hashtbl.replace all_types id (CompositeType comp')
+ if comp <> comp' then Hashtbl.replace types id (CompositeType comp')
| _ -> assert false (* This should never happen *)
(* Replace the enum information *)
let replace_enum id f =
- let str = Hashtbl.find all_types id in
+ let str = Hashtbl.find types id in
match str with
| EnumType comp -> let comp' = f comp in
- if comp <> comp' then Hashtbl.replace all_types id (EnumType comp')
+ if comp <> comp' then Hashtbl.replace types id (EnumType comp')
| _ -> assert false (* This should never happen *)
(* Replace the typdef information *)
let replace_typedef id f =
- let typdef = Hashtbl.find all_types id in
+ let typdef = Hashtbl.find types id in
match typdef with
| Typedef typ -> let typ' = f typ in
- if typ <> typ' then Hashtbl.replace all_types id (Typedef typ')
+ if typ <> typ' then Hashtbl.replace types id (Typedef typ')
| _ -> assert false (* This should never happen *)
(* Types for global definitions *)
@@ -353,6 +356,9 @@ let definitions: (int,definition_type) Hashtbl.t = Hashtbl.create 7
(* Mapping from stamp to debug id *)
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 id = (Hashtbl.find stamp_to_definition id) in
let var = Hashtbl.find definitions id in
@@ -360,10 +366,22 @@ let find_var_stamp id =
| GlobalVariable var -> id,var
| _ -> assert false
+let find_fun_stamp id =
+ let id = (Hashtbl.find stamp_to_definition id) in
+ let f = Hashtbl.find definitions id in
+ match f with
+ | Function f -> id,f
+ | _ -> assert false
+
+
let replace_var id var =
let var = GlobalVariable var in
Hashtbl.replace definitions id var
+let replace_fun id f =
+ let f = Function f in
+ Hashtbl.replace definitions id f
+
let gen_comp_typ sou id at =
if sou = Struct then
TStruct (id,at)
@@ -463,7 +481,7 @@ let insert_declaration dec env =
{en with enum_file_loc = Some dec.gloc; enum_enumerators = enumerator;})
| Gpragma _ -> ()
-let set_offset str field (offset,byte_size) =
+let set_member_offset str field offset byte_size =
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
@@ -472,6 +490,26 @@ let set_offset str field (offset,byte_size) =
else a) comp.ct_members in
{comp with ct_members = members;})
-let set_size comp sou size =
+let set_composite_size comp sou size =
let id = find_type (gen_comp_typ sou comp []) in
replace_composite id (fun comp -> {comp with ct_sizeof = Some size;})
+
+let atom_global_variable id atom =
+ let id,var = find_var_stamp id.stamp in
+ replace_var id ({var with gvar_atom = Some atom;});
+ Hashtbl.add atom_to_definition atom id
+
+let atom_function id atom =
+ 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
+
+let init name =
+ id := 0;
+ file_name := name;
+ Hashtbl.reset types;
+ Hashtbl.reset lookup_types;
+ Hashtbl.reset definitions;
+ Hashtbl.reset stamp_to_definition;
+ Hashtbl.reset atom_to_definition
+