diff options
Diffstat (limited to 'cparser')
-rw-r--r-- | cparser/Cabs.v | 2 | ||||
-rw-r--r-- | cparser/Cutil.ml | 13 | ||||
-rw-r--r-- | cparser/Cutil.mli | 2 | ||||
-rw-r--r-- | cparser/Elab.ml | 41 | ||||
-rw-r--r-- | cparser/Env.ml | 2 | ||||
-rw-r--r-- | cparser/Parser.vy | 4 | ||||
-rw-r--r-- | cparser/pre_parser.mly | 2 |
7 files changed, 45 insertions, 21 deletions
diff --git a/cparser/Cabs.v b/cparser/Cabs.v index 355c748e..b3e4ffda 100644 --- a/cparser/Cabs.v +++ b/cparser/Cabs.v @@ -142,7 +142,7 @@ with expression := (* Non-standard *) | EXPR_ALIGNOF : expression -> expression | TYPE_ALIGNOF : (list spec_elem * decl_type) -> expression - | BUILTIN_OFFSETOF : (list spec_elem * decl_type) -> string -> expression + | BUILTIN_OFFSETOF : (list spec_elem * decl_type) -> list initwhat -> expression with constant := (* The string is the textual representation of the constant in diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 30f7294b..f55c1703 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -534,26 +534,23 @@ let sizeof_struct env members = in sizeof_rec 0 members (* Compute the offset of a struct member *) -let offsetof env ty fields = +let offsetof env ty field = let rec sub acc name = function | [] -> List.rev acc | m::rem -> if m.fld_name = name then List.rev acc else sub (m::acc) name rem in - let offset (ofs,ty) field = - match unroll env ty with + match unroll env ty with | TStruct (id,_) -> let str = Env.find_struct env id in let pre = sub [] field.fld_name str.ci_members in begin match sizeof_struct env pre ,alignof env field.fld_typ with | Some s, Some a -> - (ofs + align s a),field.fld_typ + align s a | _ -> assert false end - | _ -> ofs,field.fld_typ - in - let fields = List.rev fields in - fst (List.fold_left offset (0,ty) fields) + | TUnion _ -> 0 + | _ -> assert false (* Simplified version to compute offsets on structs without bitfields *) let struct_layout env members = diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli index c5a074c5..a849d1fe 100644 --- a/cparser/Cutil.mli +++ b/cparser/Cutil.mli @@ -112,7 +112,7 @@ val composite_info_def: val struct_layout: Env.t -> field list -> (string * int) list val offsetof: - Env.t -> typ -> field list -> int + Env.t -> typ -> field -> int (* Compute the offset of a struct member *) (* Type classification functions *) diff --git a/cparser/Elab.ml b/cparser/Elab.ml index 6256bf1f..68dd1b76 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -1646,14 +1646,39 @@ let elab_expr vararg loc env a = 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 fld = match unroll env 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 offsetof for member '%s' in something not a structure" mem in - if List.exists (fun fld -> fld.fld_bitfield <> None) fld then - error "cannot compute the offset of bitfield '%s" mem; - let offset = Cutil.offsetof env ty fld in + 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,b,_) -> + let e,env = elab env e in + let e = + begin match Ceval.integer_expr env e,b with + | None,_ -> + error "array element designator for is not an integer constant expression" + | Some n,Some b -> if n >= b then + error "array index %Ld exceeds array bounds" n; + n + | Some n,None -> assert false + end in + let size = match sizeof env sub_ty with + | None -> assert false (* We expect only complete types *) + | Some s -> s in + env,off_accu + size * (Int64.to_int e),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 offsetof_const = EConst (CInt(Int64.of_int offset,size_t_ikind (),"")) in { edesc = offsetof_const; etyp = TInt(size_t_ikind(), []) },env diff --git a/cparser/Env.ml b/cparser/Env.ml index 5fa4571a..27d17a93 100644 --- a/cparser/Env.ml +++ b/cparser/Env.ml @@ -220,6 +220,8 @@ let find_union_member env (id, m) = with Not_found -> raise(Error(No_member(id.name, "union", m))) + + let find_typedef env id = try IdentMap.find id env.env_typedef diff --git a/cparser/Parser.vy b/cparser/Parser.vy index fb0b7444..f6bd6a7e 100644 --- a/cparser/Parser.vy +++ b/cparser/Parser.vy @@ -145,8 +145,8 @@ postfix_expression: { (CAST typ (COMPOUND_INIT (rev' init)), loc) } | loc = LPAREN typ = type_name RPAREN LBRACE init = initializer_list COMMA RBRACE { (CAST typ (COMPOUND_INIT (rev' init)), loc) } -| loc = BUILTIN_OFFSETOF LPAREN typ = type_name COMMA mem = OTHER_NAME RPAREN - { (BUILTIN_OFFSETOF typ (fst mem), loc) } +| loc = BUILTIN_OFFSETOF LPAREN typ = type_name COMMA mem = designator_list RPAREN + { (BUILTIN_OFFSETOF typ (rev mem), loc) } (* Semantic value is in reverse order. *) argument_expression_list: diff --git a/cparser/pre_parser.mly b/cparser/pre_parser.mly index 1c917b23..dc9c5319 100644 --- a/cparser/pre_parser.mly +++ b/cparser/pre_parser.mly @@ -254,7 +254,7 @@ postfix_expression: | postfix_expression LBRACK expression RBRACK | postfix_expression LPAREN argument_expression_list? RPAREN | BUILTIN_VA_ARG LPAREN assignment_expression COMMA type_name RPAREN -| BUILTIN_OFFSETOF LPAREN type_name COMMA other_identifier RPAREN +| BUILTIN_OFFSETOF LPAREN type_name COMMA designator_list RPAREN | postfix_expression DOT other_identifier | postfix_expression PTR other_identifier | postfix_expression INC |