From 3babd253e1d194549294c282e1b0c60097b26b07 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Fri, 3 Feb 2017 14:12:32 +0100 Subject: Refactor the classification of attributes Introduce Cutil.class_of_attribute to return the class of the given attribute: one among Attr_type attribute related to types (e.g. "aligned") Attr_struct attribute related to struct/union/enum types (e.g. "packed") Attr_function attribute related to function types (e.g. "noreturn") Attr_name attribute related to variable and function declarations (e.g. "section") Attr_unknown attribute was not declared Cutil.declare_attribute is used to associate a class to a custom attribute. Standard attributes (const, volatile, _Alignas, etc) are Attr_type. cfronted/C2C.ml: declare the few attributes that CompCert honors currently. cparser/GCC.ml: a bigger list of attributes taken from GCC, for reference only. --- cfrontend/C2C.ml | 13 +++++++++++++ cparser/Cutil.ml | 44 ++++++++++++++++++++++++++++++++------------ cparser/Cutil.mli | 23 +++++++++++++++++++---- cparser/Elab.ml | 16 +++++++++++----- cparser/GCC.ml | 24 +++++++++++++++++++++++- cparser/GCC.mli | 3 ++- driver/Driver.ml | 1 + 7 files changed, 101 insertions(+), 23 deletions(-) diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index b7fe5fb0..183af347 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -267,6 +267,19 @@ let builtins = { typedefs = builtins_generic.typedefs @ CBuiltins.builtins.typedefs; functions = builtins_generic.functions @ CBuiltins.builtins.functions } +(** ** The known attributes *) + +let attributes = [ + (* type-related *) + ("aligned", Cutil.Attr_type); + (* struct-related *) + ("packed", Cutil.Attr_struct); + (* function-related (currently none) *) + (* name-related *) + ("section", Cutil.Attr_name) +] + + (** ** Functions used to handle string literals *) let stringNum = ref 0 (* number of next global for string literals *) diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 21e6f71e..44d16ea1 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -37,6 +37,15 @@ module IdentMap = Map.Make(Ident) (* Operations on attributes *) +(* Normalize the name of an attribute, removing starting and trailing '__' *) + +let re_normalize_attrname = Str.regexp "^__\\(.*\\)__$" + +let normalize_attrname a = + if Str.string_match re_normalize_attrname a 0 + then Str.matched_group 1 a + else a + (* Lists of attributes are kept sorted in increasing order *) let rec add_attributes (al1: attributes) (al2: attributes) = @@ -83,23 +92,34 @@ let rec remove_custom_attributes (names: string list) (al: attributes) = | a :: tl -> a :: remove_custom_attributes names tl -(* Is an attribute a ISO C standard attribute? *) +(* Classification of attributes *) -let attr_is_standard = function - | AConst | AVolatile | ARestrict -> true - | AAlignas _ | Attr _ -> false +type attribute_class = + | Attr_name (* Attribute applies to the names being declared *) + | Attr_type (* Attribute applies to types *) + | Attr_struct (* Attribute applies to struct, union and enum *) + | Attr_function (* Attribute applies to function types and decls *) + | Attr_unknown (* Unknown attribute *) + +let attr_class : (string, attribute_class) Hashtbl.t = Hashtbl.create 32 -(* Is an attribute type-related (true) or variable-related (false)? *) +let declare_attribute name cls = + Hashtbl.replace attr_class (normalize_attrname name) cls -let attr_is_type_related = function - | AConst | AVolatile | ARestrict | AAlignas _ -> true - | Attr(_, _) -> false +let declare_attributes l = + List.iter (fun (n,c) -> declare_attribute n c) l -(* Is an attribute related to structs, unions and enum (true) or not (false)? *) +let class_of_attribute = function + | AConst | AVolatile | ARestrict | AAlignas _ -> Attr_type + | Attr(name, args) -> + try Hashtbl.find attr_class (normalize_attrname name) + with Not_found -> Attr_unknown -let attr_is_struct_related = function - | Attr(("packed" | "__packed__"), _) -> true - | _ -> false +(* Is an attribute a ISO C standard attribute? *) + +let attr_is_standard = function + | AConst | AVolatile | ARestrict -> true + | AAlignas _ | Attr _ -> false (* Is an attribute applicable to a whole array (true) or only to array elements (false)? *) diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli index 4906a8a8..4e62879b 100644 --- a/cparser/Cutil.mli +++ b/cparser/Cutil.mli @@ -52,17 +52,32 @@ val erase_attributes_type : Env.t -> typ -> typ (* Erase the attributes of the given type. *) val change_attributes_type : Env.t -> (attributes -> attributes) -> typ -> typ (* Apply the given function to the top-level attributes of the given type *) -val attr_is_type_related: attribute -> bool - (* Is an attribute type-related (true) or variable-related (false)? *) -val attr_is_struct_related: attribute -> bool - (* Is an attribute related to structs, unions and enum (true) or not (false)? *) + +type attribute_class = + | Attr_name (* Attribute applies to the names being declared *) + | Attr_type (* Attribute applies to types *) + | Attr_struct (* Attribute applies to struct, union and enum *) + | Attr_function (* Attribute applies to function types and decls *) + | Attr_unknown (* Not a declared attribute *) + +val declare_attribute: string -> attribute_class -> unit +val declare_attributes: (string * attribute_class) list -> unit + (* Register the given custom attribute names with the given classes. *) +val class_of_attribute: attribute -> attribute_class + (* Return the class of the given attribute. Standard attributes + have class [Attr_type]. Custom attributes have the class that + was given to them using [declare_attribute], or [Attr_unknown] + if not declared. *) val attr_inherited_by_members: attribute -> bool (* Is an attribute of a composite inherited by members of the composite? *) + + val strip_attributes_type: typ -> attribute list -> typ (* Remove all attributes from the given type that are not contained in the list *) val strip_last_attribute: typ -> attribute option * typ (* Remove the last top level attribute and return it *) + (* Type compatibility *) type attr_handling = diff --git a/cparser/Elab.ml b/cparser/Elab.ml index cc66f04b..5d2a5cfe 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -478,12 +478,17 @@ let typespec_rank = function (* Don't change this *) let typespec_order t1 t2 = compare (typespec_rank t1) (typespec_rank t2) (* Auxiliary for type declarator elaboration. Remove the non-type-related - attributes from the given type and return those attributes separately. *) + attributes from the given type and return those attributes separately. + If the type is a function type, keep function-related attributes + attached to the type. *) let get_nontype_attrs env ty = - let nta = - List.filter (fun a -> not (attr_is_type_related a)) - (attributes_of_type env ty) in + let to_be_removed a = + match class_of_attribute a with + | Attr_type -> false + | Attr_function -> not (is_function_type env ty) + | _ -> true in + let nta = List.filter to_be_removed (attributes_of_type env ty) in (remove_attributes_type env nta ty, nta) (* Is a specifier an anonymous struct/union in the sense of ISO C2011? *) @@ -544,7 +549,8 @@ let rec elab_specifier keep_ty ?(only = false) loc env specifier = The leftover non-struct-related attributes will be applied to the variable being defined. *) let get_struct_attrs () = - let (ta, nta) = List.partition attr_is_struct_related !attr in + let (ta, nta) = + List.partition (fun a -> class_of_attribute a = Attr_struct) !attr in attr := nta; ta in diff --git a/cparser/GCC.ml b/cparser/GCC.ml index f7f64a4e..010d12f3 100644 --- a/cparser/GCC.ml +++ b/cparser/GCC.ml @@ -13,7 +13,7 @@ (* *) (* *********************************************************************) -(* GCC built-ins *) +(* GCC built-ins and attributes *) open C open Cutil @@ -221,3 +221,25 @@ let builtins = { "__builtin_va_copy", (voidType, [ voidPtrType; voidPtrType ], false) ] } + +let attributes = [ (* a subset of those of GCC 5 *) + (* type-related *) + ("aligned", Attr_type); ("may_alias", Attr_type); ("visibility", Attr_type); + (* struct-related *) + ("packed", Attr_struct); ("designated_init", Attr_struct); + (* function-related *) + ("cdecl", Attr_function); ("stdcall", Attr_function); + ("fastcall", Attr_function); ("thiscall", Attr_function); + ("const", Attr_function); ("noreturn", Attr_name); + (* name-related *) + ("cleanup", Attr_name); ("common", Attr_name); ("nocommon", Attr_name); + ("deprecated", Attr_name); ("section", Attr_name); + ("shared", Attr_name); ("tls_model", Attr_name); ("unused", Attr_name); + ("used", Attr_name); ("weak", Attr_name); + ("dllimport", Attr_name); ("dllexport", Attr_name); + ("alway_inline", Attr_name); ("gnu_inline", Attr_name); + ("artificial", Attr_name); ("flatten", Attr_name); + ("error", Attr_name); ("warning", Attr_name); + ("constructor", Attr_name); ("destructor", Attr_name); + ("externally_visible", Attr_name); ("interrupt", Attr_name) +] diff --git a/cparser/GCC.mli b/cparser/GCC.mli index 76f40372..f26d12df 100644 --- a/cparser/GCC.mli +++ b/cparser/GCC.mli @@ -13,6 +13,7 @@ (* *) (* *********************************************************************) -(* GCC built-ins *) +(* GCC built-ins and attributes *) val builtins: Builtins.t +val attributes: (string * Cutil.attribute_class) list diff --git a/driver/Driver.ml b/driver/Driver.ml index 3219b7b7..9d5ed3b3 100755 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -540,6 +540,7 @@ let _ = | _ -> assert false end; Builtins.set C2C.builtins; + Cutil.declare_attributes C2C.attributes; CPragmas.initialize(); parse_cmdline cmdline_actions; DebugInit.init (); (* Initialize the debug functions *) -- cgit