[gcc(refs/users/aoliva/heads/strub)] zero-call-used-regs attr for ada

[Alexandre Oliva <aoliva@gcc.gnu.org>]

https://gcc.gnu.org/g:e26da4de2e9e4b1bdfd0fa4533bd544fd7163c3a

commit e26da4de2e9e4b1bdfd0fa4533bd544fd7163c3a
Author: Alexandre Oliva <oliva@adacore.com>
Date:   Tue Aug 10 21:14:25 2021 -0300

    zero-call-used-regs attr for ada

Diff:
---
 gcc/ada/gcc-interface/utils.c       | 59 +++++++++++++++++++++++++++++++++++++
 gcc/testsuite/gnat.dg/zcur_attr.adb |  8 +++++
 gcc/testsuite/gnat.dg/zcur_attr.ads |  4 +++
 3 files changed, 71 insertions(+)

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 0b3a18c431d..0d2d8ead496 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -38,6 +38,7 @@
 #include "attribs.h"
 #include "varasm.h"
 #include "toplev.h"
+#include "opts.h"
 #include "output.h"
 #include "debug.h"
 #include "convert.h"
@@ -110,6 +111,8 @@ 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_type_attribute (tree *, tree, tree, int, bool *);
+static tree handle_zero_call_used_regs_attribute (tree *, tree, tree, int,
+						  bool *);
 
 static const struct attribute_spec::exclusions attr_cold_hot_exclusions[] =
 {
@@ -194,6 +197,9 @@ const struct attribute_spec gnat_internal_attribute_table[] =
   { "may_alias",    0, 0,  false, true,  false, false,
     NULL, NULL },
 
+  { "zero_call_used_regs", 1, 1, true, false, false, false,
+    handle_zero_call_used_regs_attribute, NULL },
+
   /* ??? format and format_arg are heavy and not supported, which actually
      prevents support for stdio builtins, which we however declare as part
      of the common builtins.def contents.  */
@@ -7037,6 +7043,59 @@ handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
   return NULL_TREE;
 }
 
+/* Handle a "zero_call_used_regs" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_zero_call_used_regs_attribute (tree *node, tree name, tree args,
+				      int ARG_UNUSED (flags),
+				      bool *no_add_attrs)
+{
+  tree decl = *node;
+  tree id = TREE_VALUE (args);
+
+  if (TREE_CODE (decl) != FUNCTION_DECL)
+    {
+      error_at (DECL_SOURCE_LOCATION (decl),
+		"%qE attribute applies only to functions", name);
+      *no_add_attrs = true;
+      return NULL_TREE;
+    }
+
+  /* pragma Machine_Attribute turns string arguments into identifiers.
+     Reverse it.  */
+  if (TREE_CODE (id) == IDENTIFIER_NODE)
+    id = TREE_VALUE (args) = build_string
+      (IDENTIFIER_LENGTH (id), IDENTIFIER_POINTER (id));
+
+  if (TREE_CODE (id) != STRING_CST)
+    {
+      error_at (DECL_SOURCE_LOCATION (decl),
+		"%qE argument not a string", name);
+      *no_add_attrs = true;
+      return NULL_TREE;
+    }
+
+  bool found = false;
+  for (unsigned int i = 0; zero_call_used_regs_opts[i].name != NULL; ++i)
+    if (strcmp (TREE_STRING_POINTER (id),
+		zero_call_used_regs_opts[i].name) == 0)
+      {
+	found = true;
+	break;
+      }
+
+  if (!found)
+    {
+      error_at (DECL_SOURCE_LOCATION (decl),
+		"unrecognized %qE attribute argument %qs",
+		name, TREE_STRING_POINTER (id));
+      *no_add_attrs = true;
+    }
+
+  return NULL_TREE;
+}
+
 /* ----------------------------------------------------------------------- *
  *                              BUILTIN FUNCTIONS                          *
  * ----------------------------------------------------------------------- */
diff --git a/gcc/testsuite/gnat.dg/zcur_attr.adb b/gcc/testsuite/gnat.dg/zcur_attr.adb
new file mode 100644
index 00000000000..5d15f5e9d73
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/zcur_attr.adb
@@ -0,0 +1,8 @@
+--  { dg-do compile }
+--  { dg-options "-fdump-tree-optimized" }
+
+package body ZCUR_Attr is
+   function F return Integer is (0);
+end ZCUR_Attr;
+
+--  { dg-final { scan-tree-dump "zero_call_used_regs \[(\]\"all\"\[)\]" "optimized" } }
diff --git a/gcc/testsuite/gnat.dg/zcur_attr.ads b/gcc/testsuite/gnat.dg/zcur_attr.ads
new file mode 100644
index 00000000000..b756cc838b8
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/zcur_attr.ads
@@ -0,0 +1,4 @@
+package ZCUR_Attr is
+   function F return Integer;
+   pragma Machine_Attribute (F, "zero_call_used_regs", "all");
+end ZCUR_Attr;