diff options
author | Bernhard Schommer <bernhardschommer@gmail.com> | 2015-03-26 15:28:16 +0100 |
---|---|---|
committer | Bernhard Schommer <bernhardschommer@gmail.com> | 2015-03-26 15:28:16 +0100 |
commit | 56c5da69f66d097dde1ca50ec777df9953eb1952 (patch) | |
tree | 2866b88eb8f99828c8ec275d3d35563379c2bac2 | |
parent | 4c81d739be2a2e409c7e76bac3e616c4415a1efd (diff) | |
download | compcert-56c5da69f66d097dde1ca50ec777df9953eb1952.tar.gz compcert-56c5da69f66d097dde1ca50ec777df9953eb1952.zip |
Compute the size of structs using the result of the packing and bitfield transformations.
-rw-r--r-- | cparser/Parse.ml | 20 | ||||
-rw-r--r-- | debug/CtoDwarf.ml | 25 | ||||
-rw-r--r-- | debug/DwarfUtil.ml | 9 |
3 files changed, 36 insertions, 18 deletions
diff --git a/cparser/Parse.ml b/cparser/Parse.ml index 71c9454f..645465c3 100644 --- a/cparser/Parse.ml +++ b/cparser/Parse.ml @@ -17,14 +17,19 @@ module CharSet = Set.Make(struct type t = char let compare = compare end) -let transform_program t p = +let transform_program t p name = let run_pass pass flag p = if CharSet.mem flag t then pass p else p in - Rename.program - (run_pass StructReturn.program 's' + let p1 = (run_pass StructReturn.program 's' (run_pass PackedStructs.program 'p' (run_pass Bitfields.program 'f' (run_pass Unblock.program 'b' - p)))) + p)))) in + let debug = + if !Clflags.option_g && Configuration.advanced_debug then + Some (CtoDwarf.program_to_dwarf p p1 name) + else + None in + (Rename.program p1),debug let parse_transformations s = let t = ref CharSet.empty in @@ -57,12 +62,7 @@ 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 - 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 + Timing.time2 "Emulations" transform_program t p1 name with | Cerrors.Abort -> [],None in diff --git a/debug/CtoDwarf.ml b/debug/CtoDwarf.ml index 4fea8f21..481221dd 100644 --- a/debug/CtoDwarf.ml +++ b/debug/CtoDwarf.ml @@ -275,23 +275,21 @@ let rec globdecl_to_dwarf env decl = 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 -> + 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 dec; + 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 dec; + union_declaration = Some false; union_name = n.name; }) in let id = get_composite_type n.name in @@ -368,12 +366,23 @@ let rec globdecl_to_dwarf env decl = | Gcompositedecl _ | Gpragma _ -> [] -let program_to_dwarf prog name = +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 + +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 prog in + let env = translEnv Env.empty prog1 in reset_id (); let defs = List.concat (List.map (globdecl_to_dwarf env) prog) in let cp = { diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml index 7b81be4c..fe4a0f7b 100644 --- a/debug/DwarfUtil.ml +++ b/debug/DwarfUtil.ml @@ -63,6 +63,15 @@ let rec entry_fold f acc entry = let acc = f acc entry.tag in List.fold_left (entry_fold f) acc entry.children +let rec entry_map f entry = + let t = f entry.tag in + let children = List.map (entry_map f) entry.children in + { + entry with + tag = t; + children = children; + } + (* Attribute form encoding *) let dw_form_addr = 0x01 let dw_form_block2 = 0x03 |