Refactored code, added comments and changed handling of types with attributes to avoid duplications.

1 files changed, 417 insertions, 316 deletions

diff --git a/debug/CtoDwarf.ml b/debug/CtoDwarf.ml
index 481221dd..b723a559 100644
--- a/debug/CtoDwarf.ml
+++ b/debug/CtoDwarf.ml
@@ -30,6 +30,7 @@ let typedef_table: (string, int) Hashtbl.t = Hashtbl.create 7
 (* Hashtable from composite table to entry id *)
 let composite_types_table: (string, int) Hashtbl.t = Hashtbl.create 7
 
+(* Get the type id of a composite_type *)
 let get_composite_type (name: string): int =
   try 
     Hashtbl.find composite_types_table name
@@ -38,7 +39,7 @@ let get_composite_type (name: string): int =
     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
@@ -53,330 +54,429 @@ let rec mmap f env = function
       let (tl', env2) = mmap f env1 tl in
       (hd' :: tl', env2)
 
-let attr_to_dw attr_list id entries =
-  List.fold_left (fun (id,entry) attr ->
-    match attr with
-    | AConst -> let const_tag = DW_TAG_const_type ({const_type = id;}) in
-      let const_entry = new_entry const_tag in
-      const_entry.id,const_entry::entry
-    | AVolatile ->  let volatile_tag = DW_TAG_volatile_type ({volatile_type = id;}) in
-      let volatile_entry = new_entry volatile_tag in
-      volatile_entry.id,volatile_entry::entry
-    | ARestrict 
-    | AAlignas _
-    | Attr _ -> id,entry) (id,entries) (List.rev attr_list)
-let attr_to_dw_tag attr_list tag =
-  let entry = new_entry tag in
-  attr_to_dw attr_list entry.id [entry]
 
+(* 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)
+
+(*  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
 
-let rec type_to_dwarf (typ: typ): int * dw_entry list =
+(* 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 (_,t) ->
+          let t,e = type_to_dwarf t in
+          let fp =
+            {
+             formal_parameter_file_loc = None;
+             formal_parameter_artificial = None;
+             formal_parameter_location = None;
+             formal_parameter_name = None;
+             formal_parameter_segment = 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 size_to_subrange s =
+    let b = (match s with 
+    | None -> None
+    | Some i ->
+        let i = Int64.to_int i in
+        Some (BoundConst i)) in
+    let s = {
+      subrange_type = None;
+      subrange_upper_bound = b;
+    } in
+    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,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 (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.name 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 =
+  let typ = strip_attributes typ in
   let typ_string = typ_to_string typ in
   try
     Hashtbl.find type_table typ_string,[]
   with Not_found ->
-    let id,entries = 
-      match typ with
-      | TVoid at -> let void = {
-          base_type_byte_size = 0;
-          base_type_encoding = None;
-          base_type_name = "void";
-        } in
-        attr_to_dw_tag at (DW_TAG_base_type void)
-      | TInt (k,at) ->
-          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_string;} in
-          attr_to_dw_tag at (DW_TAG_base_type int)
-      | TFloat (k,at) ->
-          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_string;
-          } in
-          attr_to_dw_tag at (DW_TAG_base_type float)
-      | TPtr (t,at) ->
-          let t,e = type_to_dwarf t in
-          let pointer = {pointer_type = t;} in
-          let t,e2 = attr_to_dw_tag at (DW_TAG_pointer_type pointer) in
-          t,e2@e
-      | TFun (rt,args,_,at) ->
-          let ret,et = (match rt with
-          | TVoid _ -> None,[] (* Void return *)
-          | _ -> 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 (_,t) ->
-                  let t,e = type_to_dwarf t in
-                  let fp =
-                    {
-                     formal_parameter_file_loc = None;
-                     formal_parameter_artificial = None;
-                     formal_parameter_location = None;
-                     formal_parameter_name = None;
-                     formal_parameter_segment = 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
-          attr_to_dw at s.id ((s::others)@et)
-      | TStruct (i,at)
-      | TUnion (i,at)
-      | TEnum (i,at) ->
-          let t = get_composite_type i.name in
-          attr_to_dw at t []
-      | TNamed (i,at) ->
-          let t = Hashtbl.find typedef_table i.name in
-          attr_to_dw at t []
-      | TArray (child,size,at) ->
-          let size_to_subrange s =
-            let b = (match s with 
-            | None -> None
-            | Some i ->
-                let i = Int64.to_int i in
-                Some (BoundConst i)) in
-            let s = {
-              subrange_type = None;
-              subrange_upper_bound = b;
+    attr_type_to_dwarf typ typ_string
+
+(* Translate a typedef to its corresponding dwarf representation *)
+let typedef_to_dwarf (n,t) gloc =
+  let i,t = type_to_dwarf t in
+  Hashtbl.add typedef_table n.name i;
+  let td = {
+    typedef_file_loc = Some (gloc);
+    typedef_name = n.name;
+    typedef_type = i;
+  } in 
+  let td = new_entry (DW_TAG_typedef td) in
+  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_file_loc = (Some gloc);
+     variable_declaration = Some at_decl;
+     variable_external = Some ext;
+     variable_location = None;
+     variable_name = n.name;
+     variable_segment = None;
+     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_file_loc = (Some gloc);
+    subprogram_external = Some ext;
+    subprogram_frame_base = None;
+    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_file_loc = None;
+       formal_parameter_artificial = None;
+       formal_parameter_location = None;
+       formal_parameter_name = (Some p.name);
+       formal_parameter_segment = None;
+       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 = n.name;
+  } in
+  let id = get_composite_type n.name 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 = n.name;
+  } in
+  let id = get_composite_type n.name 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 = m.fld_name;
+                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 = m.fld_name;
+              member_type = t;
             } in
-            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,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 (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
-          attr_to_dw at arr.id (arr::e)          
-    in
-    Hashtbl.add type_table typ_string id;
-    id,entries
-        
-let rec globdecl_to_dwarf env decl =
+            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 = n.name;
+  } in
+  let id = get_composite_type n.name 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 = f.fld_name;
+          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 =
   match decl.gdesc with
-  | Gtypedef (n,t) ->
-      let i,t = type_to_dwarf t in
-      Hashtbl.add typedef_table n.name i;
-      let td = {
-        typedef_file_loc = Some (decl.gloc);
-        typedef_name = n.name;
-        typedef_type = i;
-      } in 
-      let td = new_entry (DW_TAG_typedef td) in
-      td::t     
-  | Gdecl (s,n,t,_) ->
-      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_file_loc = (Some decl.gloc);
-        variable_declaration = Some at_decl;
-        variable_external = Some ext;
-        variable_location = None;
-        variable_name = n.name;
-        variable_segment = None;
-        variable_type = i;
-      } in
-      let decl = new_entry (DW_TAG_variable decl) in
-      decl::t
-  | Gfundef f -> 
-      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_file_loc = (Some decl.gloc);
-        subprogram_external = Some ext;
-        subprogram_frame_base = None;
-        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_file_loc = None;
-           formal_parameter_artificial = None;
-           formal_parameter_location = None;
-           formal_parameter_name = (Some p.name);
-           formal_parameter_segment = None;
-           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
-      fdef::e
-  | Genumdef (n,at,e) -> 
-      let bs = sizeof_ikind enum_ikind in
-      let enum = {
-        enumeration_file_loc = Some decl.gloc;
-        enumeration_byte_size = bs;
-        enumeration_declaration = Some false;
-        enumeration_name = n.name;
-      } in
-      let id = get_composite_type n.name in
-      let child = List.map (fun (i,c,_) ->
-        new_entry (DW_TAG_enumerator (
-                   {
-                    enumerator_file_loc = None;
-                    enumerator_value = Int64.to_int c;
-                    enumerator_name = i.name;
-                  }))) e in
-      let enum = 
-        {
-         tag = DW_TAG_enumeration_type enum;
-         children = child;
-         id = id;} in
-      [enum]
-  | Gcompositedef (sou,n,at,m) ->
-      let tag = (match sou with
-      | Struct ->
-          let info = Env.find_struct env n in
-          DW_TAG_structure_type {
-          structure_file_loc = Some decl.gloc;
-          structure_byte_size = info.ci_sizeof;
-          structure_declaration = Some false;
-          structure_name = n.name;
-        }
-      | Union ->
-          let info = Env.find_union env n in
-          DW_TAG_union_type {
-          union_file_loc = Some decl.gloc;
-          union_byte_size = info.ci_sizeof;
-          union_declaration = Some false;
-          union_name = n.name;
-        }) in
-      let id = get_composite_type n.name in
-      let children,e = 
-        (match sou with
-        | Struct -> 
-            (* This is the same layout used in Cutil *)
-            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 = m.fld_name;
-                        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 = m.fld_name;
-                        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
-            List.rev children,e
-        | Union -> 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 = f.fld_name;
-                  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
+  | Gtypedef (n,t) -> let ret = typedef_to_dwarf (n,t) decl.gloc 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) ->let ret = enum_to_dwarf (n,at,e) decl.gloc in
+    typs@ret,decls
+  | Gcompositedef (Struct,n,at,m) -> let ret = struct_to_dwarf (n,at,m) env decl.gloc in
+    typs@ret,decls
+  | Gcompositedef (Union,n,at,m) -> let ret = union_to_dwarf (n,at,m) env decl.gloc in
+    typs@ret,decls
   | Gcompositedecl _
-  | Gpragma _ -> []       
-
-let add_size prog debug =
-  let env = translEnv Env.empty prog in
-  entry_map (function
-    | DW_TAG_structure_type s ->
-        let _,info = Env.lookup_struct env s.structure_name in
-        DW_TAG_structure_type {s with structure_byte_size = info.ci_sizeof;}
-    | DW_TAG_union_type u ->
-        let _,info = Env.lookup_union env u.union_name in
-        DW_TAG_union_type {u with union_byte_size = info.ci_sizeof;}
-    | e -> e) debug
+  | Gpragma _ -> typs,decls       
 
+(* 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;
@@ -384,7 +484,8 @@ let program_to_dwarf prog prog1 name =
   let prog = cleanupGlobals (prog) in
   let env = translEnv Env.empty prog1 in
   reset_id ();
-  let defs = List.concat (List.map (globdecl_to_dwarf env) prog) in
+  let typs,defs = List.fold_left (globdecl_to_dwarf env) ([],[]) prog in
+  let defs = typs @ defs in
   let cp = {
     compile_unit_name = name;
   } in