aboutsummaryrefslogtreecommitdiffstats
path: root/cparser
diff options
context:
space:
mode:
authorBernhard Schommer <bernhardschommer@gmail.com>2015-09-17 18:57:38 +0200
committerBernhard Schommer <bernhardschommer@gmail.com>2015-09-17 18:57:38 +0200
commitb24913a4ad1014b7da42bdb1deb8f3cc05b0ed8d (patch)
treea5a916bfbe6d4b95cf64c8611ae1fb1de214765b /cparser
parentd35426083623b2cb659d977f3c7f73dd6de4e383 (diff)
downloadcompcert-b24913a4ad1014b7da42bdb1deb8f3cc05b0ed8d.tar.gz
compcert-b24913a4ad1014b7da42bdb1deb8f3cc05b0ed8d.zip
Added support for bitfields in unions.
The transformation is the same as the one used for structs but packing always stops after each member.
Diffstat (limited to 'cparser')
-rw-r--r--cparser/Bitfields.ml48
1 files changed, 42 insertions, 6 deletions
diff --git a/cparser/Bitfields.ml b/cparser/Bitfields.ml
index 6569bb4c..fbf57082 100644
--- a/cparser/Bitfields.ml
+++ b/cparser/Bitfields.ml
@@ -111,16 +111,16 @@ let pack_bitfields env sid ml =
end
in pack [] 0 ml
-let rec transf_members env id count = function
+let rec transf_struct_members env id count = function
| [] -> []
| m :: ms as ml ->
if m.fld_bitfield = None then
- m :: transf_members env id count ms
+ m :: transf_struct_members env id count ms
else begin
let (nbits, bitfields, ml') = pack_bitfields env id ml in
if nbits = 0 then
(* Lone zero-size bitfield: just ignore *)
- transf_members env id count ml'
+ transf_struct_members env id count ml'
else begin
(* Create integer field of sufficient size for this bitfield group *)
let carrier = sprintf "__bf%d" count in
@@ -143,14 +143,49 @@ let rec transf_members env id count = function
end)
bitfields;
{ fld_name = carrier; fld_typ = carrier_typ; fld_bitfield = None}
- :: transf_members env id (count + 1) ml'
+ :: transf_struct_members env id (count + 1) ml'
end
end
+let rec transf_union_members env id count = function
+ [] -> []
+ | m :: ms ->
+ (match m.fld_bitfield with
+ | None -> m::transf_union_members env id count ms
+ | Some nbits ->
+ let carrier = sprintf "__bf%d" count in
+ let carrier_ikind = unsigned_ikind_for_carrier nbits in
+ let carrier_typ = TInt(carrier_ikind, []) in
+ let signed =
+ match unroll env m.fld_typ with
+ | TInt(ik, _) -> is_signed_ikind ik
+ | TEnum(eid, _) -> is_signed_enum_bitfield env id m.fld_name eid nbits
+ | _ -> assert false (* should never happen, checked in Elab *) in
+ let signed2 =
+ match unroll env (type_of_member env m) with
+ | TInt(ik, _) -> is_signed_ikind ik
+ | _ -> assert false (* should never happen, checked in Elab *) in
+ let pos' =
+ if !config.bitfields_msb_first
+ then sizeof_ikind carrier_ikind * 8 - nbits
+ else 0 in
+ let is_bool =
+ match unroll env m.fld_typ with
+ | TInt(IBool, _) -> true
+ | _ -> false in
+ Hashtbl.add bitfield_table
+ (id, m.fld_name)
+ {bf_carrier = carrier; bf_carrier_typ = carrier_typ;
+ bf_pos = pos'; bf_size = nbits;
+ bf_signed = signed; bf_signed_res = signed2;
+ bf_bool = is_bool};
+ { fld_name = carrier; fld_typ = carrier_typ; fld_bitfield = None}
+ :: transf_struct_members env id (count + 1) ms)
+
let transf_composite env su id attr ml =
match su with
- | Struct -> (attr, transf_members env id 1 ml)
- | Union -> (attr, ml)
+ | Struct -> (attr, transf_struct_members env id 1 ml)
+ | Union -> (attr, transf_union_members env id 1 ml)
(* Bitfield manipulation expressions *)
@@ -317,6 +352,7 @@ let rec is_bitfield_access env e =
match e.edesc with
| EUnop(Odot fieldname, e1) ->
begin match unroll env e1.etyp with
+ | TUnion (id,_)
| TStruct(id, _) ->
(try Some(e1, Hashtbl.find bitfield_table (id, fieldname))
with Not_found -> None)