diff options
-rw-r--r-- | cfrontend/C2C.ml | 20 | ||||
-rw-r--r-- | cparser/Cprint.mli | 1 | ||||
-rw-r--r-- | cparser/PackedStructs.ml | 30 |
3 files changed, 41 insertions, 10 deletions
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 1a2a453..14e345b 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -342,8 +342,6 @@ let convertTyp env t = and convertFieldList seen = function | [] -> Fnil | f :: fl -> - if f.fld_bitfield <> None then - unsupported "bit field in struct or union"; Fcons(intern_string f.fld_name, convertTyp seen f.fld_typ, convertFieldList seen fl) @@ -784,6 +782,17 @@ let convertGlobvar env (sto, id, ty, optinit) = (id', {gvar_info = ty'; gvar_init = init'; gvar_readonly = readonly; gvar_volatile = volatile}) +(** Sanity checks on composite declarations. *) + +let checkComposite env si id attr flds = + let checkField f = + if f.fld_bitfield <> None then + unsupported "bit field in struct or union"; + if Cutil.find_custom_attributes ["aligned"; "__aligned__"] + (Cutil.attributes_of_type env f.fld_typ) <> [] then + warning ("ignoring 'aligned' attribute on field " ^ f.fld_name) + in List.iter checkField flds + (** Convert a list of global declarations. Result is a pair [(funs, vars)] where [funs] are the function definitions (internal and external) @@ -812,11 +821,14 @@ let rec convertGlobdecls env funs vars gl = end | C.Gfundef fd -> convertGlobdecls env (convertFundef env fd :: funs) vars gl' - | C.Gcompositedecl _ | C.Gcompositedef _ - | C.Gtypedef _ | C.Genumdef _ -> + | C.Gcompositedecl _ | C.Gtypedef _ | C.Genumdef _ -> (* typedefs are unrolled, structs are expanded inline, and enum tags are folded. So we just skip their declarations. *) convertGlobdecls env funs vars gl' + | C.Gcompositedef(su, id, attr, flds) -> + (* sanity checks on fields *) + checkComposite env su id attr flds; + convertGlobdecls env funs vars gl' | C.Gpragma s -> if not (!process_pragma_hook s) then warning ("'#pragma " ^ s ^ "' directive ignored"); diff --git a/cparser/Cprint.mli b/cparser/Cprint.mli index ce5fb18..d63e341 100644 --- a/cparser/Cprint.mli +++ b/cparser/Cprint.mli @@ -17,6 +17,7 @@ val print_idents_in_full : bool ref val print_line_numbers : bool ref val location : Format.formatter -> C.location -> unit +val attributes : Format.formatter -> C.attributes -> unit val typ : Format.formatter -> C.typ -> unit val simple_decl : Format.formatter -> C.ident * C.typ -> unit val full_decl: Format.formatter -> C.decl -> unit diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml index ebdd86b..f926ece 100644 --- a/cparser/PackedStructs.ml +++ b/cparser/PackedStructs.ml @@ -49,7 +49,7 @@ let byte_swap_fields = ref false (* Alignment *) let is_pow2 n = - n > 0 && n land (n - 1) == 0 + n > 0 && n land (n - 1) = 0 let align x boundary = assert (is_pow2 boundary); @@ -64,6 +64,28 @@ let rec can_byte_swap env ty = | TArray(ty_elt, _, _) -> can_byte_swap env ty_elt | _ -> (false, false) +(* Compute size and alignment of a type, taking "aligned" attributes + into account *) + +let sizeof_alignof loc env ty = + match sizeof env ty, alignof env ty with + | Some sz, Some al -> + begin match find_custom_attributes ["aligned"; "__aligned__"] + (attributes_of_type env ty) with + | [] -> + (sz, al) + | [[AInt n]] when is_pow2 (Int64.to_int n) -> + let al' = max al (Int64.to_int n) in + (align sz al', al') + | _ -> + warning "%a: Warning: Ill-formed 'aligned' attribute, ignored" + formatloc loc; + (sz, al) + end + | _, _ -> + error "%a: Error: struct field has incomplete type" formatloc loc; + (0, 1) + (* Layout algorithm *) let layout_struct mfa msa swapped loc env struct_id fields = @@ -74,11 +96,7 @@ let layout_struct mfa msa swapped loc env struct_id fields = if f.fld_bitfield <> None then error "%a: Error: bitfields in packed structs not allowed" formatloc loc; - let (sz, al) = - match sizeof env f.fld_typ, alignof env f.fld_typ with - | Some s, Some a -> (s, a) - | _, _ -> error "%a: Error: struct field has incomplete type" formatloc loc; - (0, 1) in + let (sz, al) = sizeof_alignof loc env f.fld_typ in let swap = if swapped then begin let (can_swap, must_swap) = can_byte_swap env f.fld_typ in |