From d966e01ea011fa66d5a5a7f9ffce4344e415981a Mon Sep 17 00:00:00 2001 From: xleroy Date: Fri, 9 Apr 2010 12:25:03 +0000 Subject: 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 --- cparser/Bitfields.ml | 2 +- cparser/Cutil.ml | 65 +++++++++++++++++++++---------------------------- cparser/Cutil.mli | 5 ++++ cparser/Elab.ml | 11 ++++----- cparser/Env.ml | 5 ++-- cparser/Env.mli | 7 +++--- cparser/StructAssign.ml | 2 +- cparser/Transform.ml | 7 +++--- 8 files changed, 50 insertions(+), 54 deletions(-) (limited to 'cparser') 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) -- cgit