+2009-06-16 Robert Dewar <dewar@adacore.com>
+ Olivier Hainque <hainque@adacore.com>
+
+ Relax constraints on Machine_Attribute argument types:
+ * sem_prag.adb (Check_Arg_Is_Static_Expression): Allow for
+ missing type.
+ (Analyze_Attribute, case Machine_Attribute): Allow any type for arg 3.
+ * gcc-interface/decl.c (prepend_attributes): Accept static
+ expressions of any type as attribute arguments, not only string
+ literals.
+ * gnat_rm.texi (pragma Machine_Attribute section): Adjust to reflect
+ the relaxation of the restriction on the Info argument type.
+
2009-06-13 Aldy Hernandez <aldyh@redhat.com>
* gcc-interface/utils.c (record_builtin_type): Pass location
{
Node_Id gnat_temp;
+ /* Attributes are stored as Representation Item pragmas. */
+
for (gnat_temp = First_Rep_Item (gnat_entity); Present (gnat_temp);
gnat_temp = Next_Rep_Item (gnat_temp))
if (Nkind (gnat_temp) == N_Pragma)
Node_Id gnat_assoc = Pragma_Argument_Associations (gnat_temp);
enum attr_type etype;
- if (Present (gnat_assoc) && Present (First (gnat_assoc))
- && Present (Next (First (gnat_assoc)))
- && (Nkind (Expression (Next (First (gnat_assoc))))
- == N_String_Literal))
- {
- gnu_arg0 = get_identifier (TREE_STRING_POINTER
- (gnat_to_gnu
- (Expression (Next
- (First (gnat_assoc))))));
- if (Present (Next (Next (First (gnat_assoc))))
- && (Nkind (Expression (Next (Next (First (gnat_assoc)))))
- == N_String_Literal))
- gnu_arg1 = get_identifier (TREE_STRING_POINTER
- (gnat_to_gnu
- (Expression
- (Next (Next
- (First (gnat_assoc)))))));
- }
+ /* Map the kind of pragma at hand. Skip if this is not one
+ we know how to handle. */
switch (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_temp))))
{
continue;
}
+ /* See what arguments we have and turn them into GCC trees for
+ attribute handlers. These expect identifier for strings. We
+ handle at most two arguments, static expressions only. */
+
+ if (Present (gnat_assoc) && Present (First (gnat_assoc)))
+ {
+ Node_Id gnat_arg0 = Next (First (gnat_assoc));
+ Node_Id gnat_arg1 = Empty;
+
+ if (Present (gnat_arg0)
+ && Is_Static_Expression (Expression (gnat_arg0)))
+ {
+ gnu_arg0 = gnat_to_gnu (Expression (gnat_arg0));
+
+ if (TREE_CODE (gnu_arg0) == STRING_CST)
+ gnu_arg0 = get_identifier (TREE_STRING_POINTER (gnu_arg0));
+
+ gnat_arg1 = Next (gnat_arg0);
+ }
+
+ if (Present (gnat_arg1)
+ && Is_Static_Expression (Expression (gnat_arg1)))
+ {
+ gnu_arg1 = gnat_to_gnu (Expression (gnat_arg1));
+
+ if (TREE_CODE (gnu_arg1) == STRING_CST)
+ gnu_arg1 = get_identifier (TREE_STRING_POINTER (gnu_arg1));
+ }
+ }
/* Prepend to the list now. Make a list of the argument we might
have, as GCC expects it. */
pragma Machine_Attribute (
[Entity =>] LOCAL_NAME,
[Attribute_Name =>] static_string_EXPRESSION
- [, [Info =>] static_string_EXPRESSION] );
+ [, [Info =>] static_EXPRESSION] );
@end smallexample
@noindent
@code{__attribute__((@var{attribute_name}))} (if @var{info} is not
specified) or @code{__attribute__((@var{attribute_name}(@var{info})))}
in GNU C, where @code{@var{attribute_name}} is recognized by the
-target macro @code{TARGET_ATTRIBUTE_TABLE} which is defined for each
-machine. The optional parameter @var{info} is transformed into an
-identifier, which may make this pragma unusable for some attributes
-(parameter of some attributes must be a number or a string).
-@xref{Target Attributes,, Defining target-specific uses of
-@code{__attribute__}, gccint, GNU Compiler Colletion (GCC) Internals},
-further information. It is not possible to specify
-attributes defined by other languages, only attributes defined by the
-machine the code is intended to run on.
+compiler middle-end or the @code{TARGET_ATTRIBUTE_TABLE} machine
+specific macro. A string literal for the optional parameter @var{info}
+is transformed into an identifier, which may make this pragma unusable
+for some attributes. @xref{Target Attributes,, Defining target-specific
+uses of @code{__attribute__}, gccint, GNU Compiler Collection (GCC)
+Internals}, further information.
@node Pragma Main
@unnumberedsec Pragma Main
procedure Check_Arg_Is_Static_Expression
(Arg : Node_Id;
- Typ : Entity_Id);
+ Typ : Entity_Id := Empty);
-- Check the specified argument Arg to make sure that it is a static
-- expression of the given type (i.e. it will be analyzed and resolved
-- using this type, which can be any valid argument to Resolve, e.g.
- -- Any_Integer is OK). If not, given error and raise Pragma_Exit.
+ -- Any_Integer is OK). If not, given error and raise Pragma_Exit. If
+ -- Typ is left Empty, then any static expression is allowed.
procedure Check_Arg_Is_String_Literal (Arg : Node_Id);
-- Check the specified argument Arg to make sure that it is a string
procedure Check_Arg_Is_Static_Expression
(Arg : Node_Id;
- Typ : Entity_Id)
+ Typ : Entity_Id := Empty)
is
Argx : constant Node_Id := Get_Pragma_Arg (Arg);
begin
- Analyze_And_Resolve (Argx, Typ);
+ if Present (Typ) then
+ Analyze_And_Resolve (Argx, Typ);
+ else
+ Analyze_And_Resolve (Argx);
+ end if;
if Is_OK_Static_Expression (Argx) then
return;
-- pragma Machine_Attribute (
-- [Entity =>] LOCAL_NAME,
-- [Attribute_Name =>] static_string_EXPRESSION
- -- [, [Info =>] static_string_EXPRESSION] );
+ -- [, [Info =>] static_EXPRESSION] );
when Pragma_Machine_Attribute => Machine_Attribute : declare
Def_Id : Entity_Id;
if Arg_Count = 3 then
Check_Optional_Identifier (Arg3, Name_Info);
- Check_Arg_Is_Static_Expression (Arg3, Standard_String);
+ Check_Arg_Is_Static_Expression (Arg3);
else
Check_Arg_Count (2);
end if;
OSDN Git Service
