Bug fix: infinite loop in cparser/ on bit field of size 32 bits.

Algorithmic efficiency: in cparser/, precompute sizeof and alignof of composites.
Code cleanup: introduced Cutil.composite_info_{def,decl}


git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1312 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

8 files changed, 50 insertions, 54 deletions

diff --git a/cparser/Bitfields.ml b/cparser/Bitfields.ml
index 27d58957..dea1862c 100644
--- a/cparser/Bitfields.ml
+++ b/cparser/Bitfields.ml
@@ -64,7 +64,7 @@ let pack_bitfields env id ml =
       | Some n ->
           if n = 0 then
             (pos, accu, ms) (* bit width 0 means end of pack *)
-          else if pos + n >= 8 * !config.sizeof_int then
+          else if pos + n > 8 * !config.sizeof_int then
             (pos, accu, ml) (* doesn't fit in current word *)
           else begin
             let signed =
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index c0c26e5f..49b25a25 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -210,7 +210,7 @@ let pack_bitfields ml =
       | Some n ->
           if n = 0 then
             (nbits, ms) (* bit width 0 means end of pack *)
-          else if nbits + n >= 8 * !config.sizeof_int then
+          else if nbits + n > 8 * !config.sizeof_int then
             (nbits, ml) (* doesn't fit in current word *)
           else
             pack (nbits + n) ms (* add to current word *)
@@ -249,24 +249,13 @@ let rec alignof env t =
   | TFun(_, _, _, _) -> !config.alignof_fun
   | TNamed(_, _) -> alignof env (unroll env t)
   | TStruct(name, _) ->
-      let ci = Env.find_struct env name in
-      if ci.ci_incomplete
-      then None
-      else alignof_struct_union
-             (Env.add_composite env name {ci with ci_incomplete = true})
-             ci.ci_members
+      let ci = Env.find_struct env name in ci.ci_alignof
   | TUnion(name, _) ->
-      let ci = Env.find_union env name in
-      if ci.ci_incomplete
-      then None
-      else alignof_struct_union
-             (Env.add_composite env name {ci with ci_incomplete = true})
-             ci.ci_members
+      let ci = Env.find_union env name in ci.ci_alignof
 
-(* We set ci_incomplete to true before recursing so that we stop and
-   return None on ill-formed structs such as struct a { struct a x; }. *)
+(* Compute the natural alignment of a struct or union. *)
 
-and alignof_struct_union env members =
+let alignof_struct_union env members =
   let rec align_rec al = function
   | [] -> Some al
   | m :: rem as ml ->
@@ -326,27 +315,15 @@ let rec sizeof env t =
   | TFun(_, _, _, _) -> !config.sizeof_fun
   | TNamed(_, _) -> sizeof env (unroll env t)
   | TStruct(name, _) ->
-      let ci = Env.find_struct env name in
-      if ci.ci_incomplete
-      then None
-      else sizeof_struct
-             (Env.add_composite env name {ci with ci_incomplete = true})
-             ci.ci_members
+      let ci = Env.find_struct env name in ci.ci_sizeof
   | TUnion(name, _) ->
-      let ci = Env.find_union env name in
-      if ci.ci_incomplete
-      then None
-      else sizeof_union
-             (Env.add_composite env name {ci with ci_incomplete = true})
-             ci.ci_members
+      let ci = Env.find_union env name in ci.ci_sizeof
 
-(* We set ci_incomplete to true before recursing so that we stop and
-   return None on ill-formed structs such as struct a { struct a x; }. *)
+(* Compute the size of a union.
+   It is the size is the max of the sizes of fields, rounded up to the
+   natural alignment. *)
 
-(* For a union, the size is the max of the sizes of fields,
-   rounded up to the natural alignment. *)
-
-and sizeof_union env members =
+let sizeof_union env members =
   let rec sizeof_rec sz = function
   | [] ->
       begin match alignof_struct_union env members with
@@ -360,10 +337,11 @@ and sizeof_union env members =
       end
   in sizeof_rec 0 members
 
-(* For a struct, we lay out fields consecutively, inserting padding
-   to preserve their natural alignment. *)
+(* Compute the size of a struct.
+   We lay out fields consecutively, inserting padding to preserve
+   their natural alignment. *)
 
-and sizeof_struct env members =
+let sizeof_struct env members =
   let rec sizeof_rec ofs = function
   | [] | [ { fld_typ = TArray(_, None, _) } ] ->
       (* C99: ty[] allowed as last field *)
@@ -387,6 +365,19 @@ and sizeof_struct env members =
 let incomplete_type env t =
   match sizeof env t with None -> true | Some _ -> false
 
+(* Computing composite_info records *)
+
+let composite_info_decl env su =
+  { ci_kind = su; ci_members = []; ci_alignof = None; ci_sizeof = None }
+
+let composite_info_def env su m =
+  { ci_kind = su; ci_members = m;
+    ci_alignof = alignof_struct_union env m;
+    ci_sizeof =
+      match su with
+      | Struct -> sizeof_struct env m
+      | Union -> sizeof_union env m }
+
 (* Type of a function definition *)
 
 let fundef_typ fd =
diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli
index de32a21c..9587c57b 100644
--- a/cparser/Cutil.mli
+++ b/cparser/Cutil.mli
@@ -64,6 +64,11 @@ val incomplete_type : Env.t -> typ -> bool
   (* Return true if the given type is incomplete, e.g.
      declared but not defined struct or union, or array type  without a size. *)
 
+(* Computing composite_info records *)
+
+val composite_info_decl: Env.t -> struct_or_union -> Env.composite_info
+val composite_info_def: Env.t -> struct_or_union -> field list -> Env.composite_info
+
 (* Type classification functions *)
 
 val is_void_type : Env.t -> typ -> bool
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index 5971d4d4..72045086 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -565,8 +565,7 @@ and elab_struct_or_union_info kind loc env members =
         error loc "member '%s' has incomplete type" fld.fld_name;
       check_incomplete rem in
   check_incomplete m;
-  ({ ci_kind = kind; ci_incomplete = false; ci_members = m },
-   env')
+  (composite_info_def env' kind m, env')
 
 (* Elaboration of a struct or union *)
 
@@ -582,7 +581,7 @@ and elab_struct_or_union only kind loc tag optmembers env =
          create a new incomplete composite instead via the case
          "_, None" below. *)
       (tag', env)
-  | Some(tag', ({ci_incomplete = true} as ci)), Some members
+  | Some(tag', ({ci_sizeof = None} as ci)), Some members
     when Env.in_current_scope env tag' ->
       if ci.ci_kind <> kind then
         error loc "struct/union mismatch on tag '%s'" tag;
@@ -593,7 +592,7 @@ and elab_struct_or_union only kind loc tag optmembers env =
                 (Gcompositedef(kind, tag', ci'.ci_members));
       (* Replace infos but keep same ident *)
       (tag', Env.add_composite env' tag' ci')
-  | Some(tag', {ci_incomplete = false}), Some _
+  | Some(tag', {ci_sizeof = Some _}), Some _
     when Env.in_current_scope env tag' ->
       error loc "redefinition of struct or union '%s'" tag;
       (tag', env)
@@ -601,7 +600,7 @@ and elab_struct_or_union only kind loc tag optmembers env =
       (* declaration of an incomplete struct or union *)
       if tag = "" then
         error loc "anonymous, incomplete struct or union";
-      let ci = { ci_kind = kind; ci_incomplete = true; ci_members = [] } in
+      let ci = composite_info_decl env kind in
       (* enter it with a new name *)
       let (tag', env') = Env.enter_composite env tag ci in
       (* emit it *)
@@ -610,7 +609,7 @@ and elab_struct_or_union only kind loc tag optmembers env =
       (tag', env')
   | _, Some members ->
       (* definition of a complete struct or union *)
-      let ci1 = { ci_kind = kind; ci_incomplete = true; ci_members = [] } in
+      let ci1 = composite_info_decl env kind in
       (* enter it, incomplete, with a new name *)
       let (tag', env') = Env.enter_composite env tag ci1 in
       (* emit a declaration so that inner structs and unions can refer to it *)
diff --git a/cparser/Env.ml b/cparser/Env.ml
index 43ba4c38..777b3e12 100644
--- a/cparser/Env.ml
+++ b/cparser/Env.ml
@@ -62,8 +62,9 @@ let fresh_ident s = incr gensym; { name = s; stamp = !gensym }
 
 type composite_info = {
   ci_kind: struct_or_union;
-  ci_incomplete: bool;                  (* incompletely defined? *)
-  ci_members: field list                (* members, in order *)
+  ci_members: field list;               (* members, in order *)
+  ci_alignof: int option;               (* alignment; None if incomplete *)
+  ci_sizeof: int option;                (* size; None if incomplete *)
 }
 
 (* Infos associated with an ordinary identifier *)
diff --git a/cparser/Env.mli b/cparser/Env.mli
index be9d6e85..e7a74af1 100644
--- a/cparser/Env.mli
+++ b/cparser/Env.mli
@@ -25,9 +25,10 @@ exception Error of error
 val fresh_ident : string -> C.ident
 
 type composite_info = {
-  ci_kind : C.struct_or_union;
-  ci_incomplete : bool;
-  ci_members : C.field list;
+  ci_kind: C.struct_or_union;
+  ci_members: C.field list;             (* members, in order *)
+  ci_alignof: int option;               (* alignment; None if incomplete *)
+  ci_sizeof: int option;                (* size; None if incomplete *)
 }
 
 type ident_info = II_ident of C.storage * C.typ | II_enum of int64
diff --git a/cparser/StructAssign.ml b/cparser/StructAssign.ml
index bdaa2f58..f5cecfc5 100644
--- a/cparser/StructAssign.ml
+++ b/cparser/StructAssign.ml
@@ -57,7 +57,7 @@ let transf_assign env loc lhs rhs =
     match unroll env l.etyp with
     | TStruct(id, attr) ->
         let ci = Env.find_struct env id in
-        if ci.ci_incomplete then 
+        if ci.ci_sizeof = None then
           error "%a: Error: incomplete struct '%s'" formatloc loc id.name;
         transf_struct l r ci.ci_members
     | TUnion(id, attr) ->
diff --git a/cparser/Transform.ml b/cparser/Transform.ml
index 637e9a8e..b7f57f39 100644
--- a/cparser/Transform.ml
+++ b/cparser/Transform.ml
@@ -64,12 +64,11 @@ let program
            (Gfundef(fundef env f),
             Env.add_ident env f.fd_name f.fd_storage (fundef_typ f))
         | Gcompositedecl(su, id) ->
-            let ci = {ci_kind = su; ci_incomplete = true; ci_members = []} in
-            (Gcompositedecl(su, id), Env.add_composite env id ci)
+            (Gcompositedecl(su, id),
+             Env.add_composite env id (composite_info_decl env su))
         | Gcompositedef(su, id, fl) ->
-            let ci = {ci_kind = su; ci_incomplete = false; ci_members = fl} in
             (Gcompositedef(su, id, composite env su id fl),
-             Env.add_composite env id ci)
+             Env.add_composite env id (composite_info_def env su fl))
         | Gtypedef(id, ty) ->
             (Gtypedef(id, typedef env id ty), Env.add_typedef env id ty)
         | Genumdef _ as gd -> (gd, env)