Added missing functions for printing the structs and unions. Still missing printing of packed structs.

6 files changed, 149 insertions, 31 deletions

diff --git a/cparser/Parse.ml b/cparser/Parse.ml
index 59b04e7a..71c9454f 100644
--- a/cparser/Parse.ml
+++ b/cparser/Parse.ml
@@ -41,7 +41,7 @@ let parse_transformations s =
 let preprocessed_file transfs name sourcefile =
   Cerrors.reset();
   let ic = open_in sourcefile in
-  let p =
+  let p,d =
     try
       let t = parse_transformations transfs in
       let lb = Lexer.init name ic in
@@ -57,9 +57,14 @@ let preprocessed_file transfs name sourcefile =
              | Parser.Parser.Inter.Timeout_pr -> assert false
              | Parser.Parser.Inter.Parsed_pr (ast, _ ) -> ast) in
       let p1 = Timing.time "Elaboration" Elab.elab_file ast in
-      Timing.time2 "Emulations" transform_program t p1
+      let debug = 
+        if !Clflags.option_g && Configuration.advanced_debug then
+          Some (CtoDwarf.program_to_dwarf p1 name)
+        else
+          None in
+      Timing.time2 "Emulations" transform_program t p1,debug
     with
     | Cerrors.Abort ->
-        [] in
+        [],None in
   close_in ic;
-  if Cerrors.check_errors() then None else Some p
+  if Cerrors.check_errors() then None,None else Some p,d
diff --git a/cparser/Parse.mli b/cparser/Parse.mli
index 58c3cfb9..ac8feb70 100644
--- a/cparser/Parse.mli
+++ b/cparser/Parse.mli
@@ -15,7 +15,7 @@
 
 (* Entry point for the library: parse, elaborate, and transform *)
 
-val preprocessed_file: string -> string -> string -> C.program option
+val preprocessed_file: string -> string -> string -> C.program option * DwarfTypes.dw_entry option
 
 (* first arg: desired transformations
    second arg: source file name before preprocessing
diff --git a/debug/CtoDwarf.ml b/debug/CtoDwarf.ml
index 01a34829..4fea8f21 100644
--- a/debug/CtoDwarf.ml
+++ b/debug/CtoDwarf.ml
@@ -13,8 +13,10 @@
 open C
 open Cprint
 open Cutil
+open C2C
 open DwarfTypes
 open DwarfUtil
+open Env
 
 (* Functions to translate a C Ast into Dwarf 2 debugging information *)
 
@@ -147,7 +149,7 @@ let rec type_to_dwarf (typ: typ): int * dw_entry list =
       | TStruct (i,at)
       | TUnion (i,at)
       | TEnum (i,at) ->
-          let t = Hashtbl.find composite_types_table i.name in
+          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
@@ -186,7 +188,7 @@ let rec type_to_dwarf (typ: typ): int * dw_entry list =
     Hashtbl.add type_table typ_string id;
     id,entries
         
-let rec globdecl_to_dwarf decl =
+let rec globdecl_to_dwarf env decl =
   match decl.gdesc with
   | Gtypedef (n,t) ->
       let i,t = type_to_dwarf t in
@@ -250,17 +252,130 @@ let rec globdecl_to_dwarf decl =
       let fdef = new_entry (DW_TAG_subprogram fdef) in
       let fdef = add_children fdef fp in
       fdef::e
-  | Genumdef _
-  | Gcompositedef _
-  | Gpragma _ 
-  | Gcompositedecl _ -> []
+  | 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 info = composite_info_def env sou at m in
+      let dec = (match info.ci_sizeof with 
+      | Some _ -> false 
+      | None ->  true) in
+      let tag = (match sou with
+      | Struct ->
+          DW_TAG_structure_type {
+          structure_file_loc = Some decl.gloc;
+          structure_byte_size = info.ci_sizeof;
+          structure_declaration = Some dec;
+          structure_name = n.name;
+        }
+      | Union ->
+          DW_TAG_union_type {
+          union_file_loc = Some decl.gloc;
+          union_byte_size = info.ci_sizeof;
+          union_declaration = Some dec;
+          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
+  | Gcompositedecl _
+  | Gpragma _ -> []       
 
 let program_to_dwarf prog name =
   Hashtbl.reset type_table;
   Hashtbl.reset composite_types_table;
   Hashtbl.reset typedef_table;
+  let prog = cleanupGlobals (prog) in
+  let env = translEnv Env.empty prog in
   reset_id ();
-  let defs = List.concat (List.map globdecl_to_dwarf prog) in
+  let defs = List.concat (List.map (globdecl_to_dwarf env) prog) in
   let cp = {
     compile_unit_name = name;
   } in
diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index 9ed70089..1cda1334 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -151,8 +151,8 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
           prologue 0x4;
           add_attr_some e.enumeration_file_loc add_file_loc;
           add_byte_size buf;
-          add_name buf;
-          add_attr_some e.enumeration_declaration add_declaration
+          add_attr_some e.enumeration_declaration add_declaration;
+          add_name buf
       | DW_TAG_enumerator e ->
           prologue 0x28;
           add_attr_some e.enumerator_file_loc add_file_loc;
@@ -191,7 +191,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       | DW_TAG_structure_type e ->
           prologue 0x13;
           add_attr_some e.structure_file_loc add_file_loc;
-          add_byte_size buf;
+          add_attr_some e.structure_byte_size add_byte_size;
           add_attr_some e.structure_declaration add_declaration;
           add_name buf
       | DW_TAG_subprogram e ->
@@ -221,7 +221,8 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       | DW_TAG_union_type e ->
           prologue 0x17;
           add_attr_some e.union_file_loc add_file_loc;
-          add_byte_size buf;
+          add_attr_some e.union_byte_size add_byte_size;
+          add_attr_some e.union_declaration add_declaration;
           add_name buf
       | DW_TAG_unspecified_parameter e ->
           prologue 0x18;
@@ -415,7 +416,7 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
 
     let print_structure oc st =
       print_file_loc oc st.structure_file_loc;
-      print_uleb128 oc st.structure_byte_size;
+      print_opt_value oc st.structure_byte_size print_uleb128;
       print_opt_value oc st.structure_declaration print_flag;
       print_string oc st.structure_name
 
@@ -443,10 +444,10 @@ module DwarfPrinter(Target: DWARF_TARGET)(DwarfAbbrevs:DWARF_ABBREVS):
       print_string oc td.typedef_name;
       print_ref oc td.typedef_type
 
-
     let print_union_type oc ut =
       print_file_loc oc ut.union_file_loc;
-      print_uleb128 oc ut.union_byte_size;
+      print_opt_value oc ut.union_byte_size print_uleb128;
+      print_opt_value oc ut.union_declaration print_flag;
       print_string oc ut.union_name
 
     let print_unspecified_parameter oc up =
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index 22f88a12..d4fb0df9 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -133,7 +133,7 @@ type dw_tag_pointer_type =
 type dw_tag_structure_type =
     {
      structure_file_loc:    file_loc option;
-     structure_byte_size:   constant;
+     structure_byte_size:   constant option;
      structure_declaration: flag     option;
      structure_name:        string;
    }
@@ -169,9 +169,10 @@ type dw_tag_typedef =
 
 type dw_tag_union_type =
     {
-     union_file_loc:  file_loc  option;
-     union_byte_size: constant;
-     union_name:      string;
+     union_file_loc:    file_loc option;
+     union_byte_size:   constant option;
+     union_declaration: flag     option;
+     union_name:        string;
    }
 
 type dw_tag_unspecified_parameter =
diff --git a/driver/Driver.ml b/driver/Driver.ml
index 80a5891c..1191982d 100644
--- a/driver/Driver.ml
+++ b/driver/Driver.ml
@@ -15,7 +15,6 @@ open Commandline
 open Camlcoq
 open Clflags
 open Timing
-open CtoDwarf
 
 (* Location of the compatibility library *)
 
@@ -118,20 +117,17 @@ let parse_c_file sourcename ifile =
   ^ (if !option_fpacked_structs then "p" else "")
   in
   (* Parsing and production of a simplified C AST *)
-  let ast =
+  let ast,debug =
     match Parse.preprocessed_file simplifs sourcename ifile with
-    | None -> exit 2
-    | Some p -> p in
+    | None,_ -> exit 2
+    | Some p,d -> p,d in
   (* Save C AST if requested *)
   if !option_dparse then begin
     let ofile = output_filename sourcename ".c" ".parsed.c" in
     let oc = open_out ofile in
     Cprint.program (Format.formatter_of_out_channel oc) ast;
     close_out oc
-  end;
-  let debug = if !option_g && Configuration.advanced_debug then
-    Some (program_to_dwarf ast sourcename) 
-  else None in
+  end; 
   (* Conversion to Csyntax *)
   let csyntax =
     match Timing.time "CompCert C generation" C2C.convertProgram ast with