diff options
| -rw-r--r-- | cparser/Cutil.ml | 13 | ||||
| -rw-r--r-- | cparser/Cutil.mli | 4 | ||||
| -rw-r--r-- | cparser/Elab.ml | 17 |
3 files changed, 34 insertions, 0 deletions
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 846010b3..221bd7cc 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -574,6 +574,19 @@ let is_function_type env t = | TFun _ -> true | _ -> false +(* Find the info for a field access *) + +let field_of_dot_access env t m = + match unroll env t with + | TStruct(id, _) -> Env.find_struct_member env (id, m) + | TUnion(id, _) -> Env.find_union_member env (id, m) + | _ -> assert false + +let field_of_arrow_access env t m = + match unroll env t with + | TPtr(t, _) | TArray(t, _, _) -> field_of_dot_access env t m + | _ -> assert false + (* Ranking of integer kinds *) let integer_rank = function diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli index 9d41f8fa..b1f77944 100644 --- a/cparser/Cutil.mli +++ b/cparser/Cutil.mli @@ -195,6 +195,10 @@ val fundef_typ: fundef -> typ val int_representable: int64 -> int -> bool -> bool (* Is the given int64 representable with the given number of bits and signedness? *) +val field_of_dot_access: Env.t -> typ -> string -> field + (* Return the field info for a [x.field] access *) +val field_of_arrow_access: Env.t -> typ -> string -> field + (* Return the field info for a [x->field] access *) (* Constructors *) diff --git a/cparser/Elab.ml b/cparser/Elab.ml index a1dd552b..ae0ba17b 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -1406,6 +1406,23 @@ let elab_expr loc env a = let b1 = elab a1 in if not (is_lvalue b1 || is_function_type env b1.etyp) then err "argument of '&' is not an l-value"; + begin match b1.edesc with + | EVar id -> + begin match wrap Env.find_ident loc env id with + | Env.II_ident(Storage_register, _) -> + err "address of register variable '%s' requested" id.name + | _ -> () + end + | EUnop(Odot f, b2) -> + let fld = wrap2 field_of_dot_access loc env b2.etyp f in + if fld.fld_bitfield <> None then + err "address of bit-field '%s' requested" f + | EUnop(Oarrow f, b2) -> + let fld = wrap2 field_of_arrow_access loc env b2.etyp f in + if fld.fld_bitfield <> None then + err "address of bit-field '%s' requested" f + | _ -> () + end; { edesc = EUnop(Oaddrof, b1); etyp = TPtr(b1.etyp, []) } | UNARY(MEMOF, a1) -> |