[gcc(refs/users/aoliva/heads/strub)] strub attr for ada

[gcc(refs/users/aoliva/heads/strub)] strub attr for ada

[Alexandre Oliva]

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

commit d9a243945c71c8ff4757908d1b71d748b597e65a
Author: Alexandre Oliva <oliva@adacore.com>
Date:   Tue Aug 10 20:19:10 2021 -0300

    strub attr for ada

Diff:
---
 gcc/ada/gcc-interface/utils.c        | 53 ++++++++++++++++++++++++++++++++++++
 gcc/testsuite/gnat.dg/strub_attr.adb | 19 +++++++++++++
 gcc/testsuite/gnat.dg/strub_attr.ads | 12 ++++++++
 3 files changed, 84 insertions(+)

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 846d20a8be7..0b3a18c431d 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -93,6 +93,7 @@ static tree handle_sentinel_attribute (tree *, tree, tree, int, bool *);
 static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *);
 static tree handle_stack_protect_attribute (tree *, tree, tree, int, bool *);
 static tree handle_no_stack_protector_attribute (tree *, tree, tree, int, bool *);
+static tree handle_strub_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_noicf_attribute (tree *, tree, tree, int, bool *);
@@ -154,6 +155,8 @@ const struct attribute_spec gnat_internal_attribute_table[] =
   { "no_stack_protector",0, 0, true,  false, false, false,
     handle_no_stack_protector_attribute,
     attr_stack_protect_exclusions },
+  { "strub",	    0, 1, false, true, false, true,
+    handle_strub_attribute, NULL },
   { "noinline",     0, 0,  true,  false, false, false,
     handle_noinline_attribute, NULL },
   { "noclone",      0, 0,  true,  false, false, false,
@@ -6594,6 +6597,56 @@ handle_no_stack_protector_attribute (tree *node, tree name, tree, int,
 }
 
 
+/* Handle a "strub" attribute; arguments as in
+   struct attribute_spec.handler.  */
+
+static tree
+handle_strub_attribute (tree *node, tree name,
+			tree args,
+			int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+  bool enable = true;
+
+  if (args
+      && (TREE_CODE (*node) == FUNCTION_TYPE
+	  || TREE_CODE (*node) == METHOD_TYPE))
+    {
+      /* Check that the supplied arg is acceptable.  */
+      if (TREE_CODE (TREE_VALUE (args)) != INTEGER_CST
+	  || !tree_fits_shwi_p (TREE_VALUE (args))
+	  /* Do not allow explicit -1 (STRUB_WRAPPED).  */
+	  || tree_to_shwi (TREE_VALUE (args)) < 0
+	  || tree_to_shwi (TREE_VALUE (args)) > 3)
+	{
+	  warning (OPT_Wattributes,
+		   "%qE attribute ignored because of argument %qE",
+		   name, TREE_VALUE (args));
+	  *no_add_attrs = true;
+	  enable = false;
+	}
+      /* STRUB_DISABLED and STRUB_CALLABLE do not cause strub to be enabled.  */
+      else if (integer_zerop (TREE_VALUE (args))
+	       || tree_to_shwi (TREE_VALUE (args)) == 3)
+	enable = false;
+
+      args = TREE_CHAIN (args);
+    }
+
+  if (args)
+    warning (OPT_Wattributes,
+	     "ignoring excess %qE attribute arguments starting at %qE",
+	     name, TREE_VALUE (args));
+
+  /* If we see a strub-enabling attribute, and we're at the default setting,
+     implicitly or explicitly, note that the attribute was seen, so that we can
+     reduce the compile-time overhead to nearly zero when the strub feature is
+     not used.  */
+  if (enable && flag_strub == -2)
+    flag_strub = -1;
+
+  return NULL_TREE;
+}
+
 /* Handle a "noinline" attribute; arguments as in
    struct attribute_spec.handler.  */
 
diff --git a/gcc/testsuite/gnat.dg/strub_attr.adb b/gcc/testsuite/gnat.dg/strub_attr.adb
new file mode 100644
index 00000000000..c75c1a7038f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_attr.adb
@@ -0,0 +1,19 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=default -fdump-ipa-strubm" }
+
+package body Strub_Attr is
+   procedure P (X : Integer) is
+   begin
+      null;
+   end;
+   
+   function F (X : Integer) return Integer is
+   begin
+      return X;
+   end;
+   
+   function G return Integer is (X);
+end Strub_Attr;
+
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]2\[)\]\[)\]" 1 "strubm" } }
+--  { dg-final { scan-ipa-dump-times "\[(\]strub\[)\]" 2 "strubm" } }
diff --git a/gcc/testsuite/gnat.dg/strub_attr.ads b/gcc/testsuite/gnat.dg/strub_attr.ads
new file mode 100644
index 00000000000..4ab96aa3b05
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_attr.ads
@@ -0,0 +1,12 @@
+package Strub_Attr is
+   procedure P (X : Integer);
+   pragma Machine_Attribute (P, "strub");
+
+   function F (X : Integer) return Integer;
+   pragma Machine_Attribute (F, "strub");
+
+   X : Integer := 0;
+   pragma Machine_Attribute (X, "strub");
+
+   function G return Integer;
+end Strub_Attr;