implementation_defined_pragmas.rst (Machine_Attribute): Document additional optional parameters.

* doc/gnat_rm/implementation_defined_pragmas.rst (Machine_Attribute):
	Document additional optional parameters.
	* sem_prag.adb (Analyze_Pragma) <Pragma_Machine_Attribute>: Accept
	more than one optional parameter.
	* gcc-interface/decl.c (prepend_one_attribute_pragma): Alphabetize
	the list of supported pragmas.  Simplify the handling of parameters
	and add support for more than one optional parameter.
	* gcc-interface/utils.c (attr_cold_hot_exclusions): New constant.
	(gnat_internal_attribute_table): Add entry for no_icf, noipa, flatten,
	used, cold, hot, target and target_clones.
	(begin_subprog_body): Do not create the RTL for the subprogram here.
	(handle_noicf_attribute): New static function.
	(handle_noipa_attribute): Likewise.
	(handle_flatten_attribute): Likewise.
	(handle_used_attribute): Likewise.
	(handle_cold_attribute): Likewise.
	(handle_hot_attribute): Likewise.
	(handle_target_attribute): Likewise.
	(handle_target_clones_attribute): Likewise.

From-SVN: r271693
This commit is contained in:
Eric Botcazou 2019-05-28 08:47:33 +00:00 committed by Eric Botcazou
parent 79069232df
commit 5ca5ef6870
8 changed files with 382 additions and 67 deletions

View file

@ -1,3 +1,25 @@
2019-05-28 Eric Botcazou <ebotcazou@adacore.com>
* doc/gnat_rm/implementation_defined_pragmas.rst (Machine_Attribute):
Document additional optional parameters.
* sem_prag.adb (Analyze_Pragma) <Pragma_Machine_Attribute>: Accept
more than one optional parameter.
* gcc-interface/decl.c (prepend_one_attribute_pragma): Alphabetize
the list of supported pragmas. Simplify the handling of parameters
and add support for more than one optional parameter.
* gcc-interface/utils.c (attr_cold_hot_exclusions): New constant.
(gnat_internal_attribute_table): Add entry for no_icf, noipa, flatten,
used, cold, hot, target and target_clones.
(begin_subprog_body): Do not create the RTL for the subprogram here.
(handle_noicf_attribute): New static function.
(handle_noipa_attribute): Likewise.
(handle_flatten_attribute): Likewise.
(handle_used_attribute): Likewise.
(handle_cold_attribute): Likewise.
(handle_hot_attribute): Likewise.
(handle_target_attribute): Likewise.
(handle_target_clones_attribute): Likewise.
2019-05-28 Eric Botcazou <ebotcazou@adacore.com> 2019-05-28 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (lvalue_required_for_attribute_p): Return 0 * gcc-interface/trans.c (lvalue_required_for_attribute_p): Return 0

View file

@ -3766,18 +3766,19 @@ Syntax:
pragma Machine_Attribute ( pragma Machine_Attribute (
[Entity =>] LOCAL_NAME, [Entity =>] LOCAL_NAME,
[Attribute_Name =>] static_string_EXPRESSION [Attribute_Name =>] static_string_EXPRESSION
[, [Info =>] static_EXPRESSION] ); [, [Info =>] static_EXPRESSION {, static_EXPRESSION}] );
Machine-dependent attributes can be specified for types and/or Machine-dependent attributes can be specified for types and/or
declarations. This pragma is semantically equivalent to declarations. This pragma is semantically equivalent to
:samp:`__attribute__(({attribute_name}))` (if ``info`` is not :samp:`__attribute__(({attribute_name}))` (if ``info`` is not
specified) or :samp:`__attribute__(({attribute_name(info})))` specified) or :samp:`__attribute__(({attribute_name(info})))`
in GNU C, where *attribute_name* is recognized by the or :samp:`__attribute__(({attribute_name(info,...})))` in GNU C,
compiler middle-end or the ``TARGET_ATTRIBUTE_TABLE`` machine where *attribute_name* is recognized by the compiler middle-end
specific macro. A string literal for the optional parameter ``info`` or the ``TARGET_ATTRIBUTE_TABLE`` machine specific macro. Note
is transformed into an identifier, which may make this pragma unusable that a string literal for the optional parameter ``info`` or the
for some attributes. following ones is transformed by default into an identifier,
which may make this pragma unusable for some attributes.
For further information see :title:`GNU Compiler Collection (GCC) Internals`. For further information see :title:`GNU Compiler Collection (GCC) Internals`.
Pragma Main Pragma Main

View file

@ -6458,25 +6458,18 @@ prepend_one_attribute (struct attrib **attr_list,
static void static void
prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma) prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma)
{ {
const Node_Id gnat_arg = Pragma_Argument_Associations (gnat_pragma); const Node_Id gnat_arg = First (Pragma_Argument_Associations (gnat_pragma));
tree gnu_arg0 = NULL_TREE, gnu_arg1 = NULL_TREE; Node_Id gnat_next_arg = Next (gnat_arg);
tree gnu_arg1 = NULL_TREE, gnu_arg_list = NULL_TREE;
enum attrib_type etype; enum attrib_type etype;
/* Map the pragma at hand. Skip if this isn't one we know how to handle. */ /* Map the pragma at hand. Skip if this isn't one we know how to handle. */
switch (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_pragma)))) switch (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_pragma))))
{ {
case Pragma_Machine_Attribute:
etype = ATTR_MACHINE_ATTRIBUTE;
break;
case Pragma_Linker_Alias: case Pragma_Linker_Alias:
etype = ATTR_LINK_ALIAS; etype = ATTR_LINK_ALIAS;
break; break;
case Pragma_Linker_Section:
etype = ATTR_LINK_SECTION;
break;
case Pragma_Linker_Constructor: case Pragma_Linker_Constructor:
etype = ATTR_LINK_CONSTRUCTOR; etype = ATTR_LINK_CONSTRUCTOR;
break; break;
@ -6485,58 +6478,58 @@ prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma)
etype = ATTR_LINK_DESTRUCTOR; etype = ATTR_LINK_DESTRUCTOR;
break; break;
case Pragma_Weak_External: case Pragma_Linker_Section:
etype = ATTR_WEAK_EXTERNAL; etype = ATTR_LINK_SECTION;
break;
case Pragma_Machine_Attribute:
etype = ATTR_MACHINE_ATTRIBUTE;
break; break;
case Pragma_Thread_Local_Storage: case Pragma_Thread_Local_Storage:
etype = ATTR_THREAD_LOCAL_STORAGE; etype = ATTR_THREAD_LOCAL_STORAGE;
break; break;
case Pragma_Weak_External:
etype = ATTR_WEAK_EXTERNAL;
break;
default: default:
return; return;
} }
/* See what arguments we have and turn them into GCC trees for attribute /* See what arguments we have and turn them into GCC trees for attribute
handlers. These expect identifier for strings. We handle at most two handlers. The first one is always expected to be a string meant to be
arguments and static expressions only. */ turned into an identifier. The next ones are all static expressions,
if (Present (gnat_arg) && Present (First (gnat_arg))) among which strings meant to be turned into an identifier, except for
a couple of specific attributes that require raw strings. */
if (Present (gnat_next_arg))
{ {
Node_Id gnat_arg0 = Next (First (gnat_arg)); gnu_arg1 = gnat_to_gnu (Expression (gnat_next_arg));
Node_Id gnat_arg1 = Empty; gcc_assert (TREE_CODE (gnu_arg1) == STRING_CST);
if (Present (gnat_arg0) const char *const p = TREE_STRING_POINTER (gnu_arg1);
&& Is_OK_Static_Expression (Expression (gnat_arg0))) const bool string_args
= strcmp (p, "target") == 0 || strcmp (p, "target_clones") == 0;
gnu_arg1 = get_identifier (p);
if (IDENTIFIER_LENGTH (gnu_arg1) == 0)
return;
gnat_next_arg = Next (gnat_next_arg);
while (Present (gnat_next_arg))
{ {
gnu_arg0 = gnat_to_gnu (Expression (gnat_arg0)); tree gnu_arg = gnat_to_gnu (Expression (gnat_next_arg));
if (TREE_CODE (gnu_arg) == STRING_CST && !string_args)
if (TREE_CODE (gnu_arg0) == STRING_CST) gnu_arg = get_identifier (TREE_STRING_POINTER (gnu_arg));
{ gnu_arg_list
gnu_arg0 = get_identifier (TREE_STRING_POINTER (gnu_arg0)); = chainon (gnu_arg_list, build_tree_list (NULL_TREE, gnu_arg));
if (IDENTIFIER_LENGTH (gnu_arg0) == 0) gnat_next_arg = Next (gnat_next_arg);
return;
}
gnat_arg1 = Next (gnat_arg0);
}
if (Present (gnat_arg1)
&& Is_OK_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. Make a list of the argument we might have, as GCC prepend_one_attribute (attr_list, etype, gnu_arg1, gnu_arg_list,
expects it. */ Present (Next (gnat_arg))
prepend_one_attribute (attr_list, etype, gnu_arg0, ? Expression (Next (gnat_arg)) : gnat_pragma);
gnu_arg1
? build_tree_list (NULL_TREE, gnu_arg1) : NULL_TREE,
Present (Next (First (gnat_arg)))
? Expression (Next (First (gnat_arg))) : gnat_pragma);
} }
/* Prepend to ATTR_LIST the list of attributes for GNAT_ENTITY, if any. */ /* Prepend to ATTR_LIST the list of attributes for GNAT_ENTITY, if any. */

View file

@ -93,13 +93,28 @@ static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *);
static tree handle_stack_protect_attribute (tree *, tree, tree, int, bool *); static tree handle_stack_protect_attribute (tree *, tree, tree, int, bool *);
static tree handle_noinline_attribute (tree *, tree, tree, int, bool *); static tree handle_noinline_attribute (tree *, tree, tree, int, bool *);
static tree handle_noclone_attribute (tree *, tree, tree, int, bool *); static tree handle_noclone_attribute (tree *, tree, tree, int, bool *);
static tree handle_noicf_attribute (tree *, tree, tree, int, bool *);
static tree handle_noipa_attribute (tree *, tree, tree, int, bool *);
static tree handle_leaf_attribute (tree *, tree, tree, int, bool *); static tree handle_leaf_attribute (tree *, tree, tree, int, bool *);
static tree handle_always_inline_attribute (tree *, tree, tree, int, bool *); static tree handle_always_inline_attribute (tree *, tree, tree, int, bool *);
static tree handle_malloc_attribute (tree *, tree, tree, int, bool *); static tree handle_malloc_attribute (tree *, tree, tree, int, bool *);
static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *); static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *);
static tree handle_flatten_attribute (tree *, tree, tree, int, bool *);
static tree handle_used_attribute (tree *, tree, tree, int, bool *);
static tree handle_cold_attribute (tree *, tree, tree, int, bool *);
static tree handle_hot_attribute (tree *, tree, tree, int, bool *);
static tree handle_target_attribute (tree *, tree, tree, int, bool *);
static tree handle_target_clones_attribute (tree *, tree, tree, int, bool *);
static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *); static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *);
static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *); static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *);
static const struct attribute_spec::exclusions attr_cold_hot_exclusions[] =
{
{ "cold", true, true, true },
{ "hot" , true, true, true },
{ NULL , false, false, false }
};
/* Fake handler for attributes we don't properly support, typically because /* Fake handler for attributes we don't properly support, typically because
they'd require dragging a lot of the common-c front-end circuitry. */ they'd require dragging a lot of the common-c front-end circuitry. */
static tree fake_attribute_handler (tree *, tree, tree, int, bool *); static tree fake_attribute_handler (tree *, tree, tree, int, bool *);
@ -130,30 +145,49 @@ const struct attribute_spec gnat_internal_attribute_table[] =
handle_noinline_attribute, NULL }, handle_noinline_attribute, NULL },
{ "noclone", 0, 0, true, false, false, false, { "noclone", 0, 0, true, false, false, false,
handle_noclone_attribute, NULL }, handle_noclone_attribute, NULL },
{ "no_icf", 0, 0, true, false, false, false,
handle_noicf_attribute, NULL },
{ "noipa", 0, 0, true, false, false, false,
handle_noipa_attribute, NULL },
{ "leaf", 0, 0, true, false, false, false, { "leaf", 0, 0, true, false, false, false,
handle_leaf_attribute, NULL }, handle_leaf_attribute, NULL },
{ "always_inline",0, 0, true, false, false, false, { "always_inline",0, 0, true, false, false, false,
handle_always_inline_attribute, NULL }, handle_always_inline_attribute, NULL },
{ "malloc", 0, 0, true, false, false, false, { "malloc", 0, 0, true, false, false, false,
handle_malloc_attribute, NULL }, handle_malloc_attribute, NULL },
{ "type generic", 0, 0, false, true, true, false, { "type generic", 0, 0, false, true, true, false,
handle_type_generic_attribute, NULL }, handle_type_generic_attribute, NULL },
{ "vector_size", 1, 1, false, true, false, false, { "flatten", 0, 0, true, false, false, false,
handle_flatten_attribute, NULL },
{ "used", 0, 0, true, false, false, false,
handle_used_attribute, NULL },
{ "cold", 0, 0, true, false, false, false,
handle_cold_attribute, attr_cold_hot_exclusions },
{ "hot", 0, 0, true, false, false, false,
handle_hot_attribute, attr_cold_hot_exclusions },
{ "target", 1, -1, true, false, false, false,
handle_target_attribute, NULL },
{ "target_clones",1, -1, true, false, false, false,
handle_target_clones_attribute, NULL },
{ "vector_size", 1, 1, false, true, false, false,
handle_vector_size_attribute, NULL }, handle_vector_size_attribute, NULL },
{ "vector_type", 0, 0, false, true, false, false, { "vector_type", 0, 0, false, true, false, false,
handle_vector_type_attribute, NULL }, handle_vector_type_attribute, NULL },
{ "may_alias", 0, 0, false, true, false, false, NULL, NULL }, { "may_alias", 0, 0, false, true, false, false,
NULL, NULL },
/* ??? format and format_arg are heavy and not supported, which actually /* ??? format and format_arg are heavy and not supported, which actually
prevents support for stdio builtins, which we however declare as part prevents support for stdio builtins, which we however declare as part
of the common builtins.def contents. */ of the common builtins.def contents. */
{ "format", 3, 3, false, true, true, false, fake_attribute_handler, { "format", 3, 3, false, true, true, false,
NULL }, fake_attribute_handler, NULL },
{ "format_arg", 1, 1, false, true, true, false, fake_attribute_handler, { "format_arg", 1, 1, false, true, true, false,
NULL }, fake_attribute_handler, NULL },
{ NULL, 0, 0, false, false, false, false, NULL, NULL } { NULL, 0, 0, false, false, false, false,
NULL, NULL }
}; };
/* Associates a GNAT tree node to a GCC tree node. It is used in /* Associates a GNAT tree node to a GCC tree node. It is used in
@ -3397,8 +3431,6 @@ begin_subprog_body (tree subprog_decl)
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl; for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = DECL_CHAIN (param_decl)) param_decl = DECL_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl; DECL_CONTEXT (param_decl) = subprog_decl;
make_decl_rtl (subprog_decl);
} }
/* Finish translating the current subprogram and set its BODY. */ /* Finish translating the current subprogram and set its BODY. */
@ -6393,6 +6425,38 @@ handle_noclone_attribute (tree *node, tree name,
return NULL_TREE; return NULL_TREE;
} }
/* Handle a "no_icf" attribute; arguments as in
struct attribute_spec.handler. */
static tree
handle_noicf_attribute (tree *node, tree name,
tree ARG_UNUSED (args),
int ARG_UNUSED (flags), bool *no_add_attrs)
{
if (TREE_CODE (*node) != FUNCTION_DECL)
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
return NULL_TREE;
}
/* Handle a "noipa" attribute; arguments as in
struct attribute_spec.handler. */
static tree
handle_noipa_attribute (tree *node, tree name, tree, int, bool *no_add_attrs)
{
if (TREE_CODE (*node) != FUNCTION_DECL)
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
return NULL_TREE;
}
/* Handle a "leaf" attribute; arguments as in /* Handle a "leaf" attribute; arguments as in
struct attribute_spec.handler. */ struct attribute_spec.handler. */
@ -6483,6 +6547,166 @@ handle_type_generic_attribute (tree *node, tree ARG_UNUSED (name),
return NULL_TREE; return NULL_TREE;
} }
/* Handle a "flatten" attribute; arguments as in
struct attribute_spec.handler. */
static tree
handle_flatten_attribute (tree *node, tree name,
tree args ATTRIBUTE_UNUSED,
int flags ATTRIBUTE_UNUSED, bool *no_add_attrs)
{
if (TREE_CODE (*node) == FUNCTION_DECL)
/* Do nothing else, just set the attribute. We'll get at
it later with lookup_attribute. */
;
else
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
return NULL_TREE;
}
/* Handle a "used" attribute; arguments as in
struct attribute_spec.handler. */
static tree
handle_used_attribute (tree *pnode, tree name, tree ARG_UNUSED (args),
int ARG_UNUSED (flags), bool *no_add_attrs)
{
tree node = *pnode;
if (TREE_CODE (node) == FUNCTION_DECL
|| (VAR_P (node) && TREE_STATIC (node))
|| (TREE_CODE (node) == TYPE_DECL))
{
TREE_USED (node) = 1;
DECL_PRESERVE_P (node) = 1;
if (VAR_P (node))
DECL_READ_P (node) = 1;
}
else
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
return NULL_TREE;
}
/* Handle a "cold" and attribute; arguments as in
struct attribute_spec.handler. */
static tree
handle_cold_attribute (tree *node, tree name, tree ARG_UNUSED (args),
int ARG_UNUSED (flags), bool *no_add_attrs)
{
if (TREE_CODE (*node) == FUNCTION_DECL
|| TREE_CODE (*node) == LABEL_DECL)
{
/* Attribute cold processing is done later with lookup_attribute. */
}
else
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
return NULL_TREE;
}
/* Handle a "hot" and attribute; arguments as in
struct attribute_spec.handler. */
static tree
handle_hot_attribute (tree *node, tree name, tree ARG_UNUSED (args),
int ARG_UNUSED (flags), bool *no_add_attrs)
{
if (TREE_CODE (*node) == FUNCTION_DECL
|| TREE_CODE (*node) == LABEL_DECL)
{
/* Attribute hot processing is done later with lookup_attribute. */
}
else
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
return NULL_TREE;
}
/* Handle a "target" attribute. */
static tree
handle_target_attribute (tree *node, tree name, tree args, int flags,
bool *no_add_attrs)
{
/* Ensure we have a function type. */
if (TREE_CODE (*node) != FUNCTION_DECL)
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
else if (lookup_attribute ("target_clones", DECL_ATTRIBUTES (*node)))
{
warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
"with %qs attribute", name, "target_clones");
*no_add_attrs = true;
}
else if (!targetm.target_option.valid_attribute_p (*node, name, args, flags))
*no_add_attrs = true;
/* Check that there's no empty string in values of the attribute. */
for (tree t = args; t != NULL_TREE; t = TREE_CHAIN (t))
{
tree value = TREE_VALUE (t);
if (TREE_CODE (value) == STRING_CST
&& TREE_STRING_LENGTH (value) == 1
&& TREE_STRING_POINTER (value)[0] == '\0')
{
warning (OPT_Wattributes, "empty string in attribute %<target%>");
*no_add_attrs = true;
}
}
return NULL_TREE;
}
/* Handle a "target_clones" attribute. */
static tree
handle_target_clones_attribute (tree *node, tree name, tree ARG_UNUSED (args),
int ARG_UNUSED (flags), bool *no_add_attrs)
{
/* Ensure we have a function type. */
if (TREE_CODE (*node) == FUNCTION_DECL)
{
if (lookup_attribute ("always_inline", DECL_ATTRIBUTES (*node)))
{
warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
"with %qs attribute", name, "always_inline");
*no_add_attrs = true;
}
else if (lookup_attribute ("target", DECL_ATTRIBUTES (*node)))
{
warning (OPT_Wattributes, "%qE attribute ignored due to conflict "
"with %qs attribute", name, "target");
*no_add_attrs = true;
}
else
/* Do not inline functions with multiple clone targets. */
DECL_UNINLINABLE (*node) = 1;
}
else
{
warning (OPT_Wattributes, "%qE attribute ignored", name);
*no_add_attrs = true;
}
return NULL_TREE;
}
/* Handle a "vector_size" attribute; arguments as in /* Handle a "vector_size" attribute; arguments as in
struct attribute_spec.handler. */ struct attribute_spec.handler. */

View file

@ -19349,20 +19349,25 @@ package body Sem_Prag is
----------------------- -----------------------
-- pragma Machine_Attribute ( -- pragma Machine_Attribute (
-- [Entity =>] LOCAL_NAME, -- [Entity =>] LOCAL_NAME,
-- [Attribute_Name =>] static_string_EXPRESSION -- [Attribute_Name =>] static_string_EXPRESSION
-- [, [Info =>] static_EXPRESSION] ); -- [, [Info =>] static_EXPRESSION {, static_EXPRESSION}] );
when Pragma_Machine_Attribute => Machine_Attribute : declare when Pragma_Machine_Attribute => Machine_Attribute : declare
Arg : Node_Id;
Def_Id : Entity_Id; Def_Id : Entity_Id;
begin begin
GNAT_Pragma; GNAT_Pragma;
Check_Arg_Order ((Name_Entity, Name_Attribute_Name, Name_Info)); Check_Arg_Order ((Name_Entity, Name_Attribute_Name, Name_Info));
if Arg_Count = 3 then if Arg_Count >= 3 then
Check_Optional_Identifier (Arg3, Name_Info); Check_Optional_Identifier (Arg3, Name_Info);
Check_Arg_Is_OK_Static_Expression (Arg3); Arg := Arg3;
while Present (Arg) loop
Check_Arg_Is_OK_Static_Expression (Arg);
Arg := Next (Arg);
end loop;
else else
Check_Arg_Count (2); Check_Arg_Count (2);
end if; end if;

View file

@ -1,3 +1,7 @@
2019-05-28 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/machine_attr1.ad[sb]: New test.
2019-05-28 Eric Botcazou <ebotcazou@adacore.com> 2019-05-28 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/opt79.ad[sb]: New test. * gnat.dg/opt79.ad[sb]: New test.

View file

@ -0,0 +1,41 @@
-- { dg-do compile { target i?86-*-linux* x86_64-*-linux* } }
-- { dg-options "-O3 -gnatp" }
package body Machine_Attr1 is
procedure Proc1 is
begin
Proc3;
Proc4;
end;
procedure Proc2 is
begin
Proc1;
end;
procedure Proc3 is
begin
A (1) := 0;
end;
procedure Proc4 is
begin
A (2) := 0;
end;
procedure Proc5 is
begin
for I in A'Range loop
A(I) := B(I) + C(I);
end loop;
end;
procedure Proc6 is
begin
for I in A'Range loop
A(I) := B(I) + C(I);
end loop;
end;
end Machine_Attr1;

View file

@ -0,0 +1,25 @@
package Machine_Attr1 is
type Arr is array (1 .. 256) of Integer;
A, B, C : Arr;
procedure Proc1;
pragma Machine_Attribute (Proc1, "flatten");
procedure Proc2;
pragma Machine_Attribute (Proc2, "used");
procedure Proc3;
pragma Machine_Attribute (Proc3, "cold");
procedure Proc4;
pragma Machine_Attribute (Proc4, "hot");
procedure Proc5;
pragma Machine_Attribute (Proc5, "target", "avx");
procedure Proc6;
pragma Machine_Attribute (Proc6, "target_clones", "avx", "avx2", "default");
end Machine_Attr1;