@@ -535,7 +535,7 @@ let checkFunctionType env tres targs =
535
535
end
536
536
end
537
537
538
- let rec convertTyp env t =
538
+ let rec convertTyp env ? bitwidth t =
539
539
match t with
540
540
| C. TVoid a -> Tvoid
541
541
| C. TInt (ik , a ) ->
@@ -566,7 +566,21 @@ let rec convertTyp env t =
566
566
| C. TUnion (id , a ) ->
567
567
Tunion (intern_string id.name, convertAttr a)
568
568
| C. TEnum (id , a ) ->
569
- convertIkind Cutil. enum_ikind (convertAttr a)
569
+ let ik =
570
+ match bitwidth with
571
+ | None -> Cutil. enum_ikind
572
+ | Some w ->
573
+ let info = Env. find_enum env id in
574
+ let representable sg =
575
+ List. for_all (fun (_ , v , _ ) -> Cutil. int_representable v w sg)
576
+ info.Env. ei_members in
577
+ if representable false then
578
+ Cutil. unsigned_ikind_of Cutil. enum_ikind
579
+ else if representable true then
580
+ Cutil. signed_ikind_of Cutil. enum_ikind
581
+ else
582
+ Cutil. enum_ikind in
583
+ convertIkind ik (convertAttr a)
570
584
571
585
and convertParams env = function
572
586
| [] -> Tnil
@@ -602,9 +616,16 @@ let rec convertTypAnnotArgs env = function
602
616
convertTypAnnotArgs env el)
603
617
604
618
let convertField env f =
605
- if f.fld_bitfield <> None then
606
- unsupported " bit field in struct or union (consider adding option [-fbitfields])" ;
607
- (intern_string f.fld_name, convertTyp env f.fld_typ)
619
+ let id = intern_string f.fld_name
620
+ and ty = convertTyp env ?bitwidth: f.fld_bitfield f.fld_typ in
621
+ match f.fld_bitfield with
622
+ | None -> Member_plain (id, ty)
623
+ | Some w ->
624
+ match ty with
625
+ | Tint (sz , sg , attr ) ->
626
+ Member_bitfield (id, sz, sg, attr, Z. of_uint w, f.fld_name = " " )
627
+ | _ ->
628
+ fatal_error " bitfield must have type int"
608
629
609
630
let convertCompositedef env su id attr members =
610
631
if Cutil. find_custom_attributes [" packed" ;" __packed__" ] attr <> [] then
@@ -707,6 +728,11 @@ let convertFloat f kind =
707
728
708
729
(* * Expressions *)
709
730
731
+ let check_volatile_bitfield env e =
732
+ if Cutil. is_bitfield env e
733
+ && List. mem AVolatile (Cutil. attributes_of_type env e.etyp) then
734
+ warning Diagnostics. Unnamed " access to a volatile bit field, the 'volatile' qualifier is ignored"
735
+
710
736
let ezero = Eval (Vint (coqint_of_camlint 0l ), type_int32s)
711
737
712
738
let ewrap = function
@@ -721,6 +747,7 @@ let rec convertExpr env e =
721
747
| C. EUnop ((C. Oderef | C. Odot _| C. Oarrow _), _)
722
748
| C. EBinop (C. Oindex, _ , _ , _ ) ->
723
749
let l = convertLvalue env e in
750
+ check_volatile_bitfield env e;
724
751
ewrap (Ctyping. evalof l)
725
752
726
753
| C. EConst (C. CInt(i , k , _ )) ->
@@ -790,6 +817,7 @@ let rec convertExpr env e =
790
817
if Cutil. is_composite_type env e2.etyp
791
818
&& List. mem AVolatile (Cutil. attributes_of_type env e2.etyp) then
792
819
warning Diagnostics. Unnamed " assignment of a value of volatile composite type, the 'volatile' qualifier is ignored" ;
820
+ check_volatile_bitfield env e1;
793
821
ewrap (Ctyping. eassign e1' e2')
794
822
| C. EBinop ((C. Oadd_assign | C. Osub_assign | C. Omul_assign | C. Odiv_assign |
795
823
C. Omod_assign | C. Oand_assign | C. Oor_assign | C. Oxor_assign |
@@ -810,6 +838,7 @@ let rec convertExpr env e =
810
838
| _ -> assert false in
811
839
let e1' = convertLvalue env e1 in
812
840
let e2' = convertExpr env e2 in
841
+ check_volatile_bitfield env e1;
813
842
ewrap (Ctyping. eassignop op' e1' e2')
814
843
| C. EBinop (C. Ocomma, e1 , e2 , _ ) ->
815
844
ewrap (Ctyping. ecomma (convertExpr env e1) (convertExpr env e2))
0 commit comments