diff options
author | Xavier Leroy <xavierleroy@users.noreply.github.com> | 2017-02-01 12:59:55 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2017-02-01 12:59:55 +0100 |
commit | 31f86965bf172fb32f9cca99a292ebdf6cea57b9 (patch) | |
tree | ef78d97a02e2dad0e39ccd345288adf3545bb05e /cparser/Elab.ml | |
parent | 71fa5147139f85cb0d14ded74b04b39dd52f776b (diff) | |
parent | ed55884ea9749f93ffd67f0734da0907fe338102 (diff) | |
download | compcert-31f86965bf172fb32f9cca99a292ebdf6cea57b9.tar.gz compcert-31f86965bf172fb32f9cca99a292ebdf6cea57b9.zip |
Merge pull request #159 from AbsInt/builtin_offsetof
Implement offsetof via builtin
Diffstat (limited to 'cparser/Elab.ml')
-rw-r--r-- | cparser/Elab.ml | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/cparser/Elab.ml b/cparser/Elab.ml index 1bfc2d11..61f51520 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -1642,6 +1642,45 @@ let elab_expr vararg loc env a = error "invalid application of 'alignof' to an incomplete type %a" (print_typ env) ty; { edesc = EAlignof ty; etyp = TInt(size_t_ikind(), []) },env' + | BUILTIN_OFFSETOF ((spec,dcl), mem) -> + let (ty,env) = elab_type loc env spec dcl in + if Cutil.incomplete_type env ty then + error "offsetof of incomplete type %a" (print_typ env) ty; + let members env ty mem = + match ty with + | TStruct (id,_) -> wrap Env.find_struct_member loc env (id,mem) + | TUnion (id,_) -> wrap Env.find_union_member loc env (id,mem) + | _ -> error "request for member '%s' in something not a structure or union" mem in + let rec offset_of_list acc env ty = function + | [] -> acc,ty + | fld::rest -> let off = Cutil.offsetof env ty fld in + offset_of_list (acc+off) env fld.fld_typ rest in + let offset_of_member (env,off_accu,ty) mem = + match mem,unroll env ty with + | INFIELD_INIT mem,ty -> + let flds = members env ty mem in + let flds = List.rev flds in + let off,ty = offset_of_list 0 env ty flds in + env,off_accu + off,ty + | ATINDEX_INIT e,TArray (sub_ty,_,_) -> + let e,env = elab env e in + let e = match Ceval.integer_expr env e with + | None -> error "array element designator for is not an integer constant expression" + | Some n-> n in + let size = match sizeof env sub_ty with + | None -> assert false (* We expect only complete types *) + | Some s -> s in + let off_accu = match cautious_mul e size with + | None -> error "'offsetof' overflows" + | Some s -> off_accu + s in + env,off_accu,sub_ty + | ATINDEX_INIT _,_ -> error "subscripted value is not an array" in + let env,offset,_ = List.fold_left offset_of_member (env,0,ty) mem in + let size_t = size_t_ikind () in + let offset = Ceval.normalize_int (Int64.of_int offset) size_t in + let offsetof_const = EConst (CInt(offset,size_t,"")) in + { edesc = offsetof_const; etyp = TInt(size_t, []) },env + | UNARY(PLUS, a1) -> let b1,env = elab env a1 in if not (is_arith_type env b1.etyp) then |