First version with computation of dwarf info from debug info.

Introduced a new dwarf generation from the information collected in
the DebugInformation and removed the old CtODwarf translation.

8 files changed, 357 insertions, 617 deletions

diff --git a/debug/CtoDwarf.ml b/debug/CtoDwarf.ml
deleted file mode 100644
index 3a325665..00000000
--- a/debug/CtoDwarf.ml
+++ /dev/null
@@ -1,540 +0,0 @@
-(* *********************************************************************)
-(*                                                                     *)
-(*              The Compcert verified compiler                         *)
-(*                                                                     *)
-(*          Bernhard Schommer, AbsInt Angewandte Informatik GmbH       *)
-(*                                                                     *)
-(*  AbsInt Angewandte Informatik GmbH. All rights reserved. This file  *)
-(*  is distributed under the terms of the INRIA Non-Commercial         *)
-(*  License Agreement.                                                 *)
-(*                                                                     *)
-(* *********************************************************************)
-
-open Builtins
-open C
-open Cprint
-open Cutil
-open C2C
-open DwarfTypes
-open DwarfUtil
-open Env
-open Set
-
-(* Functions to translate a C Ast into Dwarf 2 debugging information *)
-
-(* Hashtable from type name to entry id *)
-let type_table: (string, int) Hashtbl.t = Hashtbl.create 7
-
-(* Hashtable for typedefname to entry id *)
-let typedef_table: (string, int) Hashtbl.t = Hashtbl.create 7
-
-(* Hashtable from composite table to entry id *)
-let composite_types_table: (int, int) Hashtbl.t = Hashtbl.create 7
-
-(* Hashtable from id of a defined composite types to minimal type info *)
-let composite_declarations: (int, (struct_or_union * string * location)) Hashtbl.t = Hashtbl.create 7
-
-module IntSet = Set.Make(struct type t = int let compare = compare end)
-
-(* Set of all declared composite_types *)
-let composite_defined: IntSet.t ref = ref IntSet.empty
-
-(* Helper functions for the attributes *)
-let strip_attributes typ =
-  let strip =  List.filter (fun a -> a = AConst || a = AVolatile) in 
-  match typ with
-  | TVoid at -> TVoid (strip at)
-  | TInt (k,at) ->  TInt (k,strip at)
-  | TFloat (k,at) -> TFloat(k,strip at)
-  | TPtr (t,at) -> TPtr(t,strip at)
-  | TArray (t,s,at) -> TArray(t,s,strip at)
-  | TFun (t,arg,v,at) -> TFun(t,arg,v,strip at)
-  | TNamed (n,at) -> TNamed(n,strip at)
-  | TStruct (n,at) -> TStruct(n,strip at)
-  | TUnion (n,at) -> TUnion(n,strip at)
-  | TEnum (n,at) -> TEnum(n,strip at)
-
-let strip_last_attribute typ  = 
-  let rec hd_opt l = match l with
-    [] -> None,[]
-  | AConst::rest -> Some AConst,rest
-  | AVolatile::rest -> Some AVolatile,rest 
-  | _::rest -> hd_opt rest in
-  match typ with
-  | TVoid at -> let l,r = hd_opt at in
-    l,TVoid r
-  | TInt (k,at) -> let l,r = hd_opt at in
-    l,TInt (k,r)
-  | TFloat (k,at) -> let l,r = hd_opt at in
-    l,TFloat (k,r)
-  | TPtr (t,at) -> let l,r = hd_opt at in
-    l,TPtr(t,r)
-  | TArray (t,s,at) -> let l,r = hd_opt at in
-    l,TArray(t,s,r)
-  | TFun (t,arg,v,at) -> let l,r = hd_opt at in
-    l,TFun(t,arg,v,r)
-  | TNamed (n,at) -> let l,r = hd_opt at in
-    l,TNamed(n,r)
-  | TStruct (n,at) -> let l,r = hd_opt at in
-    l,TStruct(n,r)
-  | TUnion (n,at) -> let l,r = hd_opt at in
-    l,TUnion(n,r)
-  | TEnum (n,at) -> let l,r = hd_opt at in
-    l,TEnum(n,r)
-
-(* Get the type id of a composite_type *)
-let get_composite_type (name: int): int =
-  try 
-    Hashtbl.find composite_types_table name
-  with Not_found ->
-    let id = next_id () in
-    Hashtbl.add composite_types_table name id;
-    id
-
-(* Translate a C.typ to a string needed for hashing *)
-let typ_to_string (ty: typ) =
-  let buf = Buffer.create 7 in
-  let chan = Format.formatter_of_buffer buf in
-  typ chan ty;
-  Format.pp_print_flush chan ();
-  Buffer.contents buf
-
-let rec mmap f env = function
-  | [] -> ([],env)
-  | hd :: tl ->
-      let (hd',env1) = f env hd in
-      let (tl', env2) = mmap f env1 tl in
-      (hd' :: tl', env2)
-
-
-(*  Dwarf tag for the void type*)
-let rec void_dwarf_tag =
-  let void = {
-    base_type_byte_size = 0;
-    base_type_encoding = None;
-    base_type_name = "void";
-  } in
-  DW_TAG_base_type void
-
-(* Generate a dwarf tag for the given integer type *)
-and int_to_dwarf_tag k =  
-  let encoding =
-    (match k with
-    | IBool -> DW_ATE_boolean
-    | IChar ->
-        if !Machine.config.Machine.char_signed then 
-          DW_ATE_signed_char 
-        else 
-          DW_ATE_unsigned_char
-    | ILong | ILongLong | IShort | ISChar -> DW_ATE_signed_char
-    | _ -> DW_ATE_unsigned)in
-  let int = {
-    base_type_byte_size = sizeof_ikind k;
-    base_type_encoding = Some encoding;
-    base_type_name = typ_to_string (TInt (k,[]));} in
-  DW_TAG_base_type int
-
-(* Generate a dwarf tag for the given floating point type *)
-and float_to_dwarf_tag k = 
-  let byte_size = sizeof_fkind k in
-  let float = {
-    base_type_byte_size = byte_size;
-    base_type_encoding = Some DW_ATE_float;
-    base_type_name = typ_to_string (TFloat (k,[]));
-  } in
-  DW_TAG_base_type float
-
-(* Generate a dwarf tag for the given function type *)
-and fun_to_dwarf_tag rt args =
-  let ret,et = (match rt with
-  | TVoid _ -> None,[]
-  | _ -> let ret,et = type_to_dwarf rt in
-                Some ret,et) in
-  let prototyped,children,others =
-    (match args with 
-    | None -> 
-        let u = {
-          unspecified_parameter_file_loc = None;
-          unspecified_parameter_artificial = None;
-        } in
-        let u = new_entry (DW_TAG_unspecified_parameter u) in 
-        false,[u],[]
-    | Some [] -> true,[],[]
-    | Some l ->
-        let c,e = mmap (fun acc (i,t) ->
-          let t,e = type_to_dwarf t in
-          let fp =
-            {
-             formal_parameter_id = i.stamp;
-             formal_parameter_file_loc = None;
-             formal_parameter_artificial = None;
-             formal_parameter_name = None;
-             formal_parameter_type = t;
-             formal_parameter_variable_parameter = None;
-           } in
-          let entry = new_entry (DW_TAG_formal_parameter fp) in
-          entry,(e@acc)) [] l in
-        true,c,e) in
-  let s = {
-    subroutine_type = ret;
-    subroutine_prototyped = prototyped;
-  } in
-  let s = new_entry (DW_TAG_subroutine_type s) in
-  let s = add_children s children in
-  s.id,((s::others)@et)
-
-(* Generate a dwarf tag for the given array type *)
-and array_to_dwarf_tag child size =
-  let append_opt a b =
-    match a with
-    | None -> b
-    | Some a -> a::b in
-  let size_to_subrange s =
-    match s with 
-    | None -> None
-    | Some i ->
-        let i = Int64.to_int (Int64.sub i Int64.one) in
-        let s =
-          {
-           subrange_type = None;
-           subrange_upper_bound = Some (BoundConst i);
-         } in
-        Some (new_entry (DW_TAG_subrange_type s)) in 
-  let rec aux t = 
-    (match t with
-    | TArray (child,size,_) ->
-        let sub = size_to_subrange size in
-        let t,c,e = aux child in
-        t,append_opt sub c,e
-    | _ -> let t,e = type_to_dwarf t in
-      t,[],e) in
-  let t,children,e = aux child in
-  let sub = size_to_subrange size in
-  let children = List.rev (append_opt sub children) in
-  let arr = {
-    array_type_file_loc = None;
-    array_type = t;
-  } in
-  let arr = new_entry (DW_TAG_array_type arr) in
-  let arr = add_children arr children in
-  arr.id,(arr::e)
-
-(* Translate a typ without attributes to a dwarf_tag *)
-and type_to_dwarf_entry typ typ_string=
-   let id,entries = 
-   (match typ with
-   | TVoid _ -> 
-       let e = new_entry void_dwarf_tag in
-       e.id,[e]
-   | TInt (k,_) ->
-       let e = new_entry (int_to_dwarf_tag k) in
-       e.id,[e]
-   | TFloat (k,_) ->
-       let e = new_entry (float_to_dwarf_tag k) in
-       e.id,[e]
-   | TPtr (t,_) ->
-       let t,e = type_to_dwarf t in
-       let pointer = {pointer_type = t;} in
-       let t = new_entry (DW_TAG_pointer_type pointer) in
-       t.id,t::e
-   | TFun (rt,args,_,_) -> fun_to_dwarf_tag rt args
-   | TStruct (i,_)
-   | TUnion (i,_)
-   | TEnum (i,_) ->
-       let t = get_composite_type i.stamp in
-       t,[]
-   | TNamed (i,at) ->
-       let t = Hashtbl.find typedef_table i.name in
-       t,[]
-   | TArray (child,size,_) -> array_to_dwarf_tag child size)         
-   in
-   Hashtbl.add type_table typ_string id;
-   id,entries
-
-(* Tranlate type with attributes to their corresponding dwarf represenation *)
-and attr_type_to_dwarf typ typ_string =
-  let l,t = strip_last_attribute typ in
-  match l with
-  | Some AConst -> let id,t = type_to_dwarf t in
-    let const_tag = DW_TAG_const_type ({const_type = id;}) in
-    let const_entry = new_entry const_tag in
-    let id = const_entry.id in
-    Hashtbl.add type_table typ_string id;
-    id,const_entry::t
-  | Some AVolatile -> let id,t = type_to_dwarf t in 
-    let volatile_tag = DW_TAG_volatile_type ({volatile_type = id;}) in
-    let volatile_entry = new_entry volatile_tag in
-    let id = volatile_entry.id in
-    Hashtbl.add type_table typ_string id;
-    id,volatile_entry::t
-  | Some (ARestrict|AAlignas _| Attr(_,_)) -> type_to_dwarf t (* This should not happen *)
-  | None -> type_to_dwarf_entry typ typ_string
-        
-(* Translate a given type to its dwarf representation *)
-and type_to_dwarf (typ: typ): int * dw_entry list =
-  match typ with
-   | TStruct (i,_)
-   | TUnion (i,_)
-   | TEnum (i,_) ->
-       let t = get_composite_type i.stamp in
-       t,[]
-   | _ -> 
-       let typ = strip_attributes typ in
-       let typ_string = typ_to_string typ in
-       try
-         Hashtbl.find type_table typ_string,[]
-       with Not_found ->
-         attr_type_to_dwarf typ typ_string
-
-(* Translate a typedef to its corresponding dwarf representation *)
-let typedef_to_dwarf gloc (name,t) =
-  let i,t = type_to_dwarf t in
-  let td = {
-    typedef_file_loc = gloc;
-    typedef_name = name;
-    typedef_type = i;
-  } in 
-  let td = new_entry (DW_TAG_typedef td) in
-  Hashtbl.add typedef_table name td.id;
-  td::t     
-
-(* Translate a global var to its corresponding dwarf representation *)
-let glob_var_to_dwarf (s,n,t,_) gloc =
-   let i,t = type_to_dwarf t in
-   let at_decl = (match s with
-   | Storage_extern -> true
-   | _ -> false) in
-   let ext = (match s with
-   | Storage_static -> false
-   | _ -> true) in
-   let decl = {
-     variable_id = n.stamp;
-     variable_file_loc = (Some gloc);
-     variable_declaration = Some at_decl;
-     variable_external = Some ext;
-     variable_name = n.name;
-     variable_type = i;
-   } in
-   let decl = new_entry (DW_TAG_variable decl) in
-   t,decl
-
-(* Translate a function definition to its corresponding dwarf representation *)
-let fundef_to_dwarf f gloc =
-  let ret,e = (match f.fd_ret with
-  | TVoid _ -> None,[]
-  | _ -> let i,t = type_to_dwarf f.fd_ret in
-    Some i,t) in
-  let ext = (match f.fd_storage with
-  | Storage_static -> false
-  | _ -> true) in
-  let fdef = {
-    subprogram_id = f.fd_name.stamp;
-    subprogram_file_loc = (Some gloc);
-    subprogram_external = Some ext;
-    subprogram_name = f.fd_name.name;
-    subprogram_prototyped = true;
-    subprogram_type = ret;
-  } in
-  let fp,e =  mmap (fun acc (p,t) ->
-    let t,e = type_to_dwarf t in
-    let fp =
-      {
-       formal_parameter_id = p.stamp;
-       formal_parameter_file_loc = None;
-       formal_parameter_artificial = None;
-       formal_parameter_name = (Some p.name);
-       formal_parameter_type = t;
-       formal_parameter_variable_parameter = None;
-     } in
-    let entry = new_entry (DW_TAG_formal_parameter fp) in
-    entry,(e@acc)) e f.fd_params in
-  let fdef = new_entry (DW_TAG_subprogram fdef) in
-  let fdef = add_children fdef fp in
-  e,fdef
-
-(* Translate a enum definition to its corresponding dwarf representation *)
-let enum_to_dwarf (n,at,e) gloc =
-  let enumerator_to_dwarf (i,c,_)=
-    let tag =      
-      {
-       enumerator_file_loc = None;
-       enumerator_value = Int64.to_int c;
-       enumerator_name = i.name;
-     } in
-    new_entry (DW_TAG_enumerator tag) in
-  let bs = sizeof_ikind enum_ikind in
-  let enum = {
-    enumeration_file_loc = Some gloc;
-    enumeration_byte_size = bs;
-    enumeration_declaration = Some false;
-    enumeration_name = if n.name <> "" then Some n.name else None;
-  } in
-  let id = get_composite_type n.stamp in
-  let child = List.map enumerator_to_dwarf e in
-  let enum = 
-    {
-     tag = DW_TAG_enumeration_type enum;
-     children = child;
-     id = id;
-   } in
-  [enum]
-  
-(* Translate a struct definition to its corresponding dwarf representation *)
-let struct_to_dwarf (n,at,m) env gloc =
-  let info = Env.find_struct env n in
-  let tag =DW_TAG_structure_type {
-    structure_file_loc = Some gloc;
-    structure_byte_size = info.ci_sizeof;
-    structure_declaration = Some false;
-    structure_name = if n.name <> "" then Some n.name else None;
-  } in
-  let id = get_composite_type n.stamp in
-  let rec pack acc bcc l m =
-    match m with
-    | [] -> acc,bcc,[]
-    | m::ms as ml ->
-        (match m.fld_bitfield with
-        | None -> acc,bcc,ml
-        | Some n ->
-            if n = 0 then
-              acc,bcc,ms (* bit width 0 means end of pack *)
-            else if l + n > 8 * !Machine.config.Machine.sizeof_int then
-              acc,bcc,ml (* doesn't fit in current word *)
-            else
-              let t,e = type_to_dwarf m.fld_typ in
-              let um = {
-                member_file_loc = None;
-                member_byte_size = Some !Machine.config.Machine.sizeof_int;
-                member_bit_offset = Some l;
-                member_bit_size = Some n;
-                member_data_member_location = None;
-                member_declaration = None;
-                member_name = if m.fld_name <> "" then Some m.fld_name else None;
-                member_type = t;
-              } in
-              pack ((new_entry (DW_TAG_member um))::acc) (e@bcc) (l + n) ms)
-  and translate acc bcc m =
-    match m with
-      [] -> acc,bcc
-    | m::ms as ml ->
-        (match m.fld_bitfield with
-        | None -> 
-            let t,e = type_to_dwarf m.fld_typ in
-            let um = {
-              member_file_loc = None;
-              member_byte_size = None;
-              member_bit_offset = None;
-              member_bit_size = None;
-              member_data_member_location = None;
-              member_declaration = None;
-              member_name = if m.fld_name <> "" then Some m.fld_name else None;
-              member_type = t;
-            } in
-            translate ((new_entry (DW_TAG_member um))::acc) (e@bcc) ms
-        | Some _ -> let acc,bcc,rest = pack acc bcc 0 ml in 
-          translate acc bcc rest)
-  in
-  let children,e = translate [] []  m in
-  let children,e = List.rev children,e in
-  let sou = {
-    tag = tag;
-    children = children;
-    id = id;} in
-  sou::e
-
-(* Translate a union definition to its corresponding dwarf representation *)
-let union_to_dwarf (n,at,m) env gloc = 
-  let info = Env.find_union env n in
-  let tag = DW_TAG_union_type {
-    union_file_loc = Some gloc;
-    union_byte_size = info.ci_sizeof;
-    union_declaration = Some false;
-    union_name = if n.name <> "" then Some n.name else None;
-  } in
-  let id = get_composite_type n.stamp in
-  let children,e = mmap 
-      (fun  acc f ->
-        let t,e = type_to_dwarf f.fld_typ in
-        let um = {
-          member_file_loc = None;
-          member_byte_size = None;
-          member_bit_offset = None;
-          member_bit_size = None;
-          member_data_member_location = None;
-          member_declaration = None;
-          member_name = if f.fld_name <> "" then Some f.fld_name else None;
-          member_type = t;
-        } in
-        new_entry (DW_TAG_member um),e@acc)[] m in
-  let sou = {
-    tag = tag;
-    children = children;
-    id = id;} in
-  sou::e
-
-(* Translate global declarations to there dwarf representation *)
-let globdecl_to_dwarf env (typs,decls) decl =
-  PrintAsmaux.add_file (fst decl.gloc);
-  match decl.gdesc with
-  | Gtypedef (n,t) -> let ret = typedef_to_dwarf (Some decl.gloc) (n.name,t)  in
-    typs@ret,decls
-  | Gdecl d -> let t,d = glob_var_to_dwarf d decl.gloc in
-    typs@t,d::decls
-  | Gfundef f ->   let t,d = fundef_to_dwarf f decl.gloc in
-    typs@t,d::decls
-  | Genumdef (n,at,e) ->
-      composite_defined:= IntSet.add n.stamp !composite_defined;
-      let ret = enum_to_dwarf (n,at,e) decl.gloc in
-      typs@ret,decls
-  | Gcompositedef (Struct,n,at,m) ->
-      composite_defined:= IntSet.add n.stamp !composite_defined;
-      let ret = struct_to_dwarf (n,at,m) env decl.gloc in
-      typs@ret,decls
-  | Gcompositedef (Union,n,at,m) ->
-      composite_defined:= IntSet.add n.stamp !composite_defined;
-      let ret = union_to_dwarf (n,at,m) env decl.gloc in
-      typs@ret,decls
-  | Gcompositedecl (sou,i,_) -> Hashtbl.add composite_declarations i.stamp (sou,i.name,decl.gloc);
-      typs,decls
-  | Gpragma _ -> typs,decls       
-
-let forward_declaration_to_dwarf sou name loc stamp =
-  let id = get_composite_type stamp in
-  let tag = match sou with
-  | Struct ->
-      DW_TAG_structure_type{
-      structure_file_loc = Some loc;
-      structure_byte_size = None;
-      structure_declaration = Some true;
-      structure_name = if name <> "" then Some name else None;
-    } 
-  | Union ->
-      DW_TAG_union_type {
-      union_file_loc = Some loc;
-      union_byte_size = None;
-      union_declaration = Some true;
-      union_name = if name <> "" then Some name else None;
-    } in
-  {tag = tag; children = []; id = id}
-  
-
-(* Compute the dwarf representations of global declarations. The second program argument is the 
-   program after the bitfield and packed struct transformation *)
-let program_to_dwarf prog prog1 name =
-  Hashtbl.reset type_table;
-  Hashtbl.reset composite_types_table;
-  Hashtbl.reset typedef_table;
-  let prog = cleanupGlobals (prog) in
-  let env = translEnv Env.empty prog1 in
-  reset_id ();
-  let typs = List.map (typedef_to_dwarf None) C2C.builtins.typedefs in
-  let typs = List.concat typs in
-  let typs,defs = List.fold_left (globdecl_to_dwarf env) (typs,[]) prog in
-  let typs = Hashtbl.fold (fun i (sou,name,loc) typs -> if not (IntSet.mem i !composite_defined) then
-    (forward_declaration_to_dwarf sou name loc i)::typs else typs) composite_declarations typs in
-  let defs =  typs @ defs in
-  let cp = {
-    compile_unit_name = name;
-  } in
-  let cp = new_entry (DW_TAG_compile_unit cp) in
-  add_children cp defs
diff --git a/debug/Debug.ml b/debug/Debug.ml
index ab20f630..c45fd074 100644
--- a/debug/Debug.ml
+++ b/debug/Debug.ml
@@ -12,6 +12,8 @@
 
 open C
 open Camlcoq
+open Dwarfgen
+open DwarfTypes
 
 (* Interface for generating and printing debug information *)
 
@@ -25,7 +27,9 @@ type implem =
      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 add_fun_addr: atom -> (int * int) -> unit;
+     mutable generate_debug_info: unit -> dw_entry option;
+     mutable all_files_iter: (string -> unit) -> unit;
    }
 
 let implem =
@@ -38,7 +42,9 @@ let implem =
    set_bitfield_offset = (fun _ _ _ _ _ -> ());
    insert_global_declaration = (fun _ _ -> ());
    add_fun_addr = (fun _ _ -> ());
- }
+   generate_debug_info = (fun _ -> None);
+   all_files_iter = (fun _ -> ());
+}
 
 let init () =
   if !Clflags.option_g then begin
@@ -50,6 +56,8 @@ let init () =
     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 <- (fun () -> Some (Dwarfgen.gen_debug_info ()));
+    implem.all_files_iter <- (fun f -> DebugInformation.StringSet.iter f !DebugInformation.all_files);
   end else begin
     implem.init <- (fun _ -> ());
     implem.atom_function <- (fun _ _ -> ());
@@ -58,7 +66,9 @@ let init () =
     implem.set_member_offset <- (fun _ _ _ -> ());
     implem.set_bitfield_offset <- (fun _ _ _ _ _ -> ());
     implem.insert_global_declaration <- (fun _ _ -> ());
-    implem.add_fun_addr <- (fun _ _ -> ())
+    implem.add_fun_addr <- (fun _ _ -> ());
+    implem.generate_debug_info <- (fun _ -> None);
+    implem.all_files_iter <- (fun _ -> ());
   end
 
 let init_compile_unit name = implem.init name
@@ -69,3 +79,5 @@ 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 () = implem.generate_debug_info ()
+let all_files_iter f = implem.all_files_iter f
diff --git a/debug/Debug.mli b/debug/Debug.mli
index ae32af5b..e712874c 100644
--- a/debug/Debug.mli
+++ b/debug/Debug.mli
@@ -12,6 +12,7 @@
 
 open C
 open Camlcoq
+open DwarfTypes
 
 
 val init: unit -> unit
@@ -23,3 +24,5 @@ val set_member_offset: ident -> string -> int -> unit
 val set_bitfield_offset: ident -> string -> int -> string -> int -> unit
 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
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 53f73115..100f37e2 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -30,6 +30,11 @@ let reset_id () =
 (* The name of the current compilation unit *)
 let file_name: string ref = ref ""
 
+(** All files used in the debug entries *)
+module StringSet = Set.Make(String)
+let all_files : StringSet.t ref = ref StringSet.empty
+let add_file file =
+  all_files := StringSet.add file !all_files
 
 (* Types for the information of type info *)
 type composite_field =
@@ -45,11 +50,12 @@ type composite_field =
 
 type composite_type =
     {
-     ct_name:     string;
-     ct_sou:      struct_or_union;
-     ct_file_loc: location option;
-     ct_members:  composite_field list;
-     ct_sizeof:   int option;
+     ct_name:        string;
+     ct_sou:         struct_or_union;
+     ct_file_loc:    location option;
+     ct_members:     composite_field list;
+     ct_sizeof:      int option;
+     ct_declaration: bool;
    }
 
 type ptr_type = {
@@ -57,22 +63,23 @@ type ptr_type = {
   }
 
 type const_type = {
-    const_type: int
+    cst_type: int
   }
 
 type volatile_type = {
-    volatile_type: int
+    vol_type: int
   }
 
 
 type array_type = {
     arr_type: int;
-    arr_size: int64 option;
+    arr_size: int64 option list;
   }
 
 type typedef = {
-    typedef_name: string;
-    typ:          int option;
+    typedef_file_loc: location option;
+    typedef_name:     string;
+    typ:              int option;
   }
 
 type enumerator = {
@@ -101,7 +108,7 @@ type parameter_type = {
   }
 
 type function_type = {
-    fun_return_type: int;
+    fun_return_type: int option;
     fun_prototyped:  bool;
     fun_params:      parameter_type list;
   }
@@ -215,6 +222,11 @@ let insert_type (ty: typ) =
               let id = attr_aux t in
               PointerType ({pts = id})
           | TArray (t,s,_) ->
+              let rec size acc t = (match t with
+              | TArray (child,s,_) ->
+                  size (s::acc) child
+              | _ -> t,List.rev acc) in
+              let t,s = size [s] t in
               let id = attr_aux t in
               let arr = {
                 arr_type = id;
@@ -229,7 +241,9 @@ let insert_type (ty: typ) =
                  param_type = t;
                  param_name = i.name;               
                }) p,true) in
-              let ret = attr_aux t in
+              let ret = (match t with 
+              | TVoid _ -> None
+              | _ -> Some (attr_aux t)) in
               let ftype = {
                 fun_return_type = ret;
                 fun_prototyped = prot;
@@ -238,6 +252,7 @@ let insert_type (ty: typ) =
               FunctionType ftype
           | TNamed (id,_) ->
               let t = {
+                typedef_file_loc = None;
                 typedef_name = id.name;
                 typ = None;
               } in
@@ -249,6 +264,7 @@ let insert_type (ty: typ) =
                  ct_sou = Struct;
                  ct_file_loc = None;
                  ct_members = [];
+                 ct_declaration = false;
                  ct_sizeof = None;
                } in
               CompositeType str
@@ -259,6 +275,7 @@ let insert_type (ty: typ) =
                  ct_sou = Union;
                  ct_file_loc = None;
                  ct_members = [];
+                 ct_declaration = false;
                  ct_sizeof = None;
                } in
               CompositeType union
@@ -280,11 +297,11 @@ let insert_type (ty: typ) =
         match strip_last_attribute ty with
         | Some AConst,t -> 
             let id = attr_aux t in
-            let const = { const_type = id} in
+            let const = { cst_type = id} in
             insert (ConstType const) ty
         | Some AVolatile,t ->
             let id = attr_aux t in
-            let volatile = {volatile_type = id} in
+            let volatile = {vol_type = id} in
             insert (VolatileType volatile) ty
         | Some (ARestrict|AAlignas _| Attr(_,_)),t ->
             attr_aux t
@@ -398,6 +415,7 @@ let gen_comp_typ sou id at =
     TUnion (id,at)
 
 let insert_global_declaration env dec=
+  add_file (fst dec.gloc);
   let insert d_dec stamp =
     let id = next_id () in
     Hashtbl.add definitions id d_dec;
@@ -463,23 +481,24 @@ let insert_global_declaration env dec=
   | Gcompositedef (sou,id,at,fi) -> 
       ignore (insert_type (gen_comp_typ sou id at));
       let id = find_type (gen_comp_typ sou id []) in
+      let fi = List.filter (fun f -> f.fld_name <> "") fi in (* Fields without names need no info *)
       let fields = List.map (fun f ->
         {
          cfd_name = f.fld_name;
          cfd_typ = insert_type f.fld_typ;
-         cfd_bit_size = None;
-         cfd_bit_offset = f.fld_bitfield;
+         cfd_bit_size = f.fld_bitfield;
+         cfd_bit_offset = None;
          cfd_byte_offset = None;
          cfd_byte_size = None;
          cfd_bitfield = None;
        }) fi in
       replace_composite id (fun comp ->
         let loc = if comp.ct_file_loc = None then Some dec.gloc else comp.ct_file_loc in
-        {comp with ct_file_loc = loc; ct_members = fields;})
+        {comp with ct_file_loc = loc; ct_members = fields; ct_declaration = true;})
   | Gtypedef (id,t) -> 
       let id = insert_type (TNamed (id,[])) in
       let tid = insert_type t in
-      replace_typedef id (fun typ -> {typ with typ = Some tid;});
+      replace_typedef id (fun typ -> {typ with typedef_file_loc = Some dec.gloc; typ = Some tid;});
   | Genumdef (n,at,e) -> 
       ignore(insert_type (TEnum (n,at)));
       let id = find_type (TEnum (n,[])) in
@@ -516,18 +535,25 @@ let set_bitfield_offset str field offset underlying size =
     {comp with ct_members = members;})
 
 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
+  try
+    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 
+  with Not_found -> ()
     
 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
-
+  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
+  with Not_found -> ()
+    
 let add_fun_addr atom (high,low) =
-  let id,f = find_fun_atom atom in
-  replace_fun id ({f with fun_high_pc = Some high; fun_low_pc = Some 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); ()
 
 let init name =
   id := 0;
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index 09cf72eb..a0b16463 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -62,11 +62,6 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
 
     let add_low_pc = add_abbr_entry (0x11,low_pc_type_abbr)
 
-    let add_fun_pc sp buf =
-      match get_fun_addr sp.subprogram_name with
-      | None ->()
-      | Some (a,b) -> add_high_pc buf; add_low_pc buf
-
     let add_declaration = add_abbr_entry (0x3c,declaration_type_abbr)
 
     let add_location loc buf =
@@ -128,7 +123,6 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
           prologue 0x5;
           add_attr_some e.formal_parameter_file_loc add_file_loc;
           add_attr_some e.formal_parameter_artificial (add_abbr_entry (0x34,artificial_type_abbr));
-          add_location  (get_location e.formal_parameter_id) buf;
           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))
@@ -144,15 +138,15 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
           prologue 0xd;
           add_attr_some e.member_file_loc add_file_loc;
           add_attr_some e.member_byte_size add_byte_size;
-          add_attr_some e.member_bit_offset (add_abbr_entry (0xd,bit_offset_type_abbr));
-          add_attr_some e.member_bit_size (add_abbr_entry (0xc,bit_size_type_abbr));
+          add_attr_some e.member_bit_offset (add_abbr_entry (0xc,bit_offset_type_abbr));
+          add_attr_some e.member_bit_size (add_abbr_entry (0xd,bit_size_type_abbr));
+          add_attr_some e.member_declaration add_declaration;
+          add_attr_some e.member_name add_name;
+          add_type buf;
           (match e.member_data_member_location with
           | None -> ()
           | Some (DataLocBlock __) -> add_abbr_entry (0x38,data_location_block_type_abbr) buf
-          | Some (DataLocRef _) -> add_abbr_entry (0x38,data_location_ref_type_abbr) buf);
-          add_attr_some e.member_declaration add_declaration;
-          add_attr_some e.member_name add_name;
-          add_type buf
+          | Some (DataLocRef _) -> add_abbr_entry (0x38,data_location_ref_type_abbr) buf)
       | DW_TAG_pointer_type _ ->
           prologue 0xf;
           add_type buf
@@ -164,10 +158,10 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
           add_attr_some e.structure_name add_name
       | DW_TAG_subprogram e ->
           prologue 0x2e;
-          add_attr_some e.subprogram_file_loc add_file_loc;
+          add_file_loc buf;
           add_attr_some e.subprogram_external (add_abbr_entry (0x3f,external_type_abbr));
-          add_high_pc buf;
-          add_low_pc buf;
+          add_attr_some e.subprogram_high_pc add_high_pc;
+          add_attr_some e.subprogram_low_pc add_low_pc;
           add_name buf;
           add_abbr_entry (0x27,prototyped_type_abbr) buf;
           add_attr_some e.subprogram_type add_type;
@@ -199,10 +193,10 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
           add_attr_some e.unspecified_parameter_artificial (add_abbr_entry (0x34,artificial_type_abbr))
       | DW_TAG_variable e ->
           prologue 0x34;
-          add_attr_some e.variable_file_loc add_file_loc;
+          add_file_loc buf;
           add_attr_some e.variable_declaration add_declaration;
           add_attr_some e.variable_external (add_abbr_entry (0x3f,external_type_abbr));
-          add_location  (get_location e.variable_id) buf;
+          add_location  e.variable_location buf;
           add_name buf;
           add_type buf
       | DW_TAG_volatile_type _ ->
@@ -301,7 +295,12 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       | _ ->   ()
 
     let print_data_location oc dl =
-      ()
+      match dl with
+      | DataLocBlock [DW_OP_plus_uconst i] ->
+          fprintf oc "	.sleb128	2\n";
+          fprintf oc "	.byte		0x23\n";
+          fprintf oc "	.byte		%d\n" i
+      | _ -> ()
 
     let print_ref oc r =
       let ref = entry_to_label r in
@@ -363,7 +362,6 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
     let print_formal_parameter oc fp =
       print_file_loc oc fp.formal_parameter_file_loc;
       print_opt_value oc fp.formal_parameter_artificial print_flag;
-      print_opt_value oc (get_location fp.formal_parameter_id) print_loc;
       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
@@ -381,10 +379,11 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       print_opt_value oc mb.member_byte_size print_byte;
       print_opt_value oc mb.member_bit_offset print_byte;
       print_opt_value oc mb.member_bit_size print_byte;
-      print_opt_value oc mb.member_data_member_location print_data_location;
       print_opt_value oc mb.member_declaration print_flag;
       print_opt_value oc mb.member_name print_string;
-      print_ref oc mb.member_type
+      print_ref oc mb.member_type;
+      print_opt_value oc mb.member_data_member_location print_data_location
+
 
     let print_pointer oc pt =
       print_ref oc pt.pointer_type
@@ -400,11 +399,10 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       fprintf oc "	.4byte		%a\n" label s
      
     let print_subprogram oc sp =
-      let addr = get_fun_addr sp.subprogram_name  in
-      print_file_loc oc sp.subprogram_file_loc;
+      print_file_loc oc (Some sp.subprogram_file_loc);
       print_opt_value oc sp.subprogram_external print_flag;
-      print_opt_value oc (get_frame_base sp.subprogram_id) print_loc;
-      print_opt_value oc addr print_subprogram_addr;
+      print_opt_value oc sp.subprogram_high_pc print_addr;
+      print_opt_value oc sp.subprogram_low_pc print_addr;
       print_string oc sp.subprogram_name;
       print_flag oc sp.subprogram_prototyped;
       print_opt_value oc sp.subprogram_type print_ref
@@ -433,10 +431,10 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       print_opt_value oc up.unspecified_parameter_artificial print_flag
 
     let print_variable oc var =
-      print_file_loc oc var.variable_file_loc;
+      print_file_loc oc (Some var.variable_file_loc);
       print_opt_value oc var.variable_declaration print_flag;
       print_opt_value oc var.variable_external print_flag;
-      print_opt_value oc (get_location var.variable_id) print_loc;
+      print_opt_value oc var.variable_location print_loc;
       print_string oc var.variable_name;
       print_ref oc var.variable_type
 
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index b852d1f4..eb7d4060 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -37,13 +37,18 @@ type address = int
 
 type block = string
 
+type location_expression =
+  | DW_OP_plus_uconst of constant
+  | DW_OP
+
+
 type location_value =
   | LocSymbol of atom
   | LocConst of constant
   | LocBlock of block
 
 type data_location_value =
-  | DataLocBlock of block
+  | DataLocBlock of location_expression list
   | DataLocRef of reference
 
 type bound_value =
@@ -94,7 +99,6 @@ type dw_tag_enumerator =
 
 type dw_tag_formal_parameter =
     {
-     formal_parameter_id:                 int;
      formal_parameter_file_loc:           file_loc       option;
      formal_parameter_artificial:         flag           option;
      formal_parameter_name:               string         option;
@@ -141,12 +145,13 @@ type dw_tag_structure_type =
 
 type dw_tag_subprogram =
     {
-     subprogram_id:         int;
-     subprogram_file_loc:   file_loc       option;
-     subprogram_external:   flag           option;
+     subprogram_file_loc:   file_loc;
+     subprogram_external:   flag      option;
      subprogram_name:       string;
      subprogram_prototyped: flag;
-     subprogram_type:       reference      option;
+     subprogram_type:       reference option;
+     subprogram_high_pc:    reference option;
+     subprogram_low_pc:     reference option;
    }
 
 type dw_tag_subrange_type =
@@ -184,12 +189,12 @@ type dw_tag_unspecified_parameter =
 
 type dw_tag_variable =
     {
-     variable_id:          int;
-     variable_file_loc:    file_loc       option;
+     variable_file_loc:    file_loc;
      variable_declaration: flag           option;
      variable_external:    flag           option;
      variable_name:        string;
      variable_type:        reference;
+     variable_location:    location_value option;
    }
 
 type dw_tag_volatile_type =
@@ -268,7 +273,6 @@ module type DWARF_TARGET=
     val get_end_addr: unit -> int
     val get_stmt_list_addr: unit -> int    
     val name_of_section: section_name -> string
-    val get_fun_addr: string -> (int * int) option
     val get_location: int -> location_value option
     val get_frame_base: int -> location_value option
     val symbol: out_channel -> atom -> unit
diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml
index e2c87a9d..d5e72adb 100644
--- a/debug/DwarfUtil.ml
+++ b/debug/DwarfUtil.ml
@@ -14,18 +14,8 @@
 
 open DwarfTypes
 
-let id = ref 0
-
-let next_id () =
-  let nid = !id in
-  incr id; nid
-
-let reset_id () =
-  id := 0
-
 (* Generate a new entry from a given tag *)
-let new_entry tag =
-  let id = next_id () in
+let new_entry id tag =
   {
    tag = tag;
    children = [];
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
new file mode 100644
index 00000000..0acab05a
--- /dev/null
+++ b/debug/Dwarfgen.ml
@@ -0,0 +1,247 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Bernhard Schommer, AbsInt Angewandte Informatik GmbH       *)
+(*                                                                     *)
+(*  AbsInt Angewandte Informatik GmbH. All rights reserved. This file  *)
+(*  is distributed under the terms of the INRIA Non-Commercial         *)
+(*  License Agreement.                                                 *)
+(*                                                                     *)
+(* *********************************************************************)
+
+open C
+open Cutil
+open DebugInformation
+open DwarfTypes
+open DwarfUtil
+(* Generate the dwarf DIE's from the information collected in DebugInformation *)
+
+(* Helper function to get values that must be set. *)
+let get_opt_val = function
+  | Some a -> a
+  | None -> assert false
+
+(* Functions to translate the basetypes. *)
+let int_type_to_entry id i =
+   let encoding =
+    (match i.int_kind with
+    | IBool -> DW_ATE_boolean
+    | IChar ->
+        if !Machine.config.Machine.char_signed then 
+          DW_ATE_signed_char 
+        else 
+          DW_ATE_unsigned_char
+    | IInt | ILong | ILongLong | IShort | ISChar -> DW_ATE_signed
+    | _ -> DW_ATE_unsigned)in
+  let int = {
+    base_type_byte_size = sizeof_ikind i.int_kind;
+    base_type_encoding = Some encoding;
+    base_type_name = typ_to_string (TInt (i.int_kind,[]));} in
+  new_entry id (DW_TAG_base_type int)
+
+let float_type_to_entry id f = 
+  let byte_size = sizeof_fkind f.float_kind in
+  let float = {
+    base_type_byte_size = byte_size;
+    base_type_encoding = Some DW_ATE_float;
+    base_type_name = typ_to_string (TFloat (f.float_kind,[]));
+  } in
+  new_entry id (DW_TAG_base_type float)
+
+let void_to_entry id =
+  let void = {
+    base_type_byte_size = 0;
+    base_type_encoding = None;
+    base_type_name = "void";
+  } in
+  new_entry id (DW_TAG_base_type void)
+
+let typedef_to_entry id t =
+  let i = get_opt_val t.typ in
+  let td = {
+    typedef_file_loc = t.typedef_file_loc;
+    typedef_name = t.typedef_name;
+    typedef_type = i;
+  } in
+  new_entry id (DW_TAG_typedef td) 
+
+let pointer_to_entry id p =
+  let p = {pointer_type = p.pts} in
+  new_entry id (DW_TAG_pointer_type p)
+
+let array_to_entry id arr =
+  let arr_tag = {
+    array_type_file_loc = None;
+    array_type = arr.arr_type;
+  } in
+  let arr_entry = new_entry id (DW_TAG_array_type arr_tag) in
+  let children = List.map (fun a ->
+    let r = match a with
+    | None -> None
+    | Some i ->
+        let bound = Int64.to_int (Int64.sub i Int64.one) in
+        Some (BoundConst bound) in
+    let s = {
+       subrange_type = None;
+       subrange_upper_bound = r;
+    } in
+    new_entry (next_id ()) (DW_TAG_subrange_type s)) arr.arr_size in
+  add_children arr_entry children
+
+let const_to_entry id c =
+  new_entry id (DW_TAG_const_type ({const_type = c.cst_type}))
+
+let volatile_to_entry id v =
+  new_entry id (DW_TAG_volatile_type ({volatile_type = v.vol_type}))
+
+let enum_to_entry id e =
+  let enumerator_to_entry e =
+    let tag =
+      {
+       enumerator_file_loc = None;
+       enumerator_value = Int64.to_int (e.enumerator_const);
+       enumerator_name = e.enumerator_name;
+     } in
+    new_entry (next_id ()) (DW_TAG_enumerator tag) in
+  let bs = sizeof_ikind enum_ikind in
+  let enum = {
+    enumeration_file_loc = e.enum_file_loc;
+    enumeration_byte_size = bs;
+    enumeration_declaration = Some false;
+    enumeration_name = Some e.enum_name;
+  } in
+  let enum = new_entry id (DW_TAG_enumeration_type enum) in
+  let child = List.map enumerator_to_entry e.enum_enumerators in
+  add_children enum child
+
+let fun_type_to_entry id f =
+  let children = if f.fun_prototyped then
+    let u = {
+      unspecified_parameter_file_loc = None;
+      unspecified_parameter_artificial = None;
+    } in
+    [new_entry (next_id ()) (DW_TAG_unspecified_parameter u)]
+  else
+    List.map (fun p ->
+      let fp = {
+        formal_parameter_file_loc = None;
+        formal_parameter_artificial = None;
+        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;
+      } in
+      new_entry (next_id ()) (DW_TAG_formal_parameter fp)) f.fun_params;
+  in
+  let s = {
+    subroutine_type = f.fun_return_type;
+    subroutine_prototyped = f.fun_prototyped
+  } in
+  let s = new_entry id (DW_TAG_subroutine_type s) in
+  add_children s children
+
+let member_to_entry mem =
+  let mem = {
+    member_file_loc = None;
+    member_byte_size = mem.cfd_byte_size;
+    member_bit_offset = mem.cfd_bit_offset;
+    member_bit_size = mem.cfd_bit_size;
+    member_data_member_location = Some (DataLocBlock [DW_OP_plus_uconst (get_opt_val mem.cfd_byte_offset)]);
+    member_declaration = None;
+    member_name = Some (mem.cfd_name);
+    member_type = mem.cfd_typ;
+  } in
+  new_entry (next_id ()) (DW_TAG_member mem)
+
+let struct_to_entry id s =
+  let tag = {
+     structure_file_loc = s.ct_file_loc;
+     structure_byte_size = s.ct_sizeof;
+     structure_declaration = Some s.ct_declaration;
+     structure_name = if s.ct_name <> "" then Some s.ct_name else None;
+  } in
+  let entry = new_entry id (DW_TAG_structure_type tag) in
+  let child = List.map member_to_entry s.ct_members in
+  add_children entry child
+
+let union_to_entry id s =
+  let tag = {
+    union_file_loc = s.ct_file_loc;
+    union_byte_size = s.ct_sizeof;
+    union_declaration = Some s.ct_declaration;
+    union_name = if s.ct_name <> "" then Some s.ct_name else None;
+  } in
+  let entry = new_entry id (DW_TAG_union_type tag) in
+  let child = List.map member_to_entry s.ct_members in
+  add_children entry child
+
+let composite_to_entry id s =
+  match s.ct_sou with
+  | Struct -> struct_to_entry id s
+  | Union -> union_to_entry id s
+
+let infotype_to_entry id = function
+  | IntegerType i -> int_type_to_entry id i
+  | FloatType f -> float_type_to_entry id f
+  | PointerType p -> pointer_to_entry id p
+  | ArrayType arr -> array_to_entry id arr
+  | CompositeType c -> composite_to_entry id c
+  | EnumType e -> enum_to_entry id e
+  | FunctionType f -> fun_type_to_entry id f
+  | Typedef t -> typedef_to_entry id t
+  | ConstType c -> const_to_entry id c
+  | VolatileType v -> volatile_to_entry id v
+  | Void -> void_to_entry id
+
+let gen_types () =
+  List.rev (Hashtbl.fold (fun id t acc -> (infotype_to_entry id t)::acc) types [])
+
+let global_variable_to_entry id v =
+  let var = {
+    variable_file_loc = v.gvar_file_loc;
+    variable_declaration = Some v.gvar_declaration;
+    variable_external = Some v.gvar_external;
+    variable_name = v.gvar_name;
+    variable_type = v.gvar_type;
+    variable_location = match v.gvar_atom with Some a -> Some (LocSymbol a) | None -> None;
+  } in
+  new_entry id (DW_TAG_variable var)
+
+let function_parameter_to_entry 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)
+
+let function_to_entry id f =
+  let f_tag = {
+    subprogram_file_loc = f.fun_file_loc;
+    subprogram_external = Some f.fun_external;
+    subprogram_name = f.fun_name;
+    subprogram_prototyped = true;
+    subprogram_type = f.fun_return_type;
+    subprogram_high_pc = f.fun_high_pc;
+    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 definition_to_entry id t =
+  match t with
+  | GlobalVariable g -> global_variable_to_entry id g
+  | Function f -> function_to_entry id f
+
+let gen_defs () =
+  List.rev (Hashtbl.fold (fun id t acc -> (definition_to_entry id t)::acc) definitions [])
+
+let gen_debug_info () =
+  let cp =  {
+    compile_unit_name = !file_name;
+  } in
+  let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in
+  add_children cp ((gen_types ()) @ (gen_defs ()))