Introduce strub: machine-independent stack scrubbing

This patch adds the strub attribute for function and variable types,
command-line options, passes and adjustments to implement it,
documentation, and tests.

Stack scrubbing is implemented in a machine-independent way: functions
with strub enabled are modified so that they take an extra stack
watermark argument, that they update with their stack use, and the
caller can then zero it out once it regains control, whether by return
or exception.  There are two ways to go about it: at-calls, that
modifies the visible interface (signature) of the function, and
internal, in which the body is moved to a clone, the clone undergoes
the interface change, and the function becomes a wrapper, preserving
its original interface, that calls the clone and then clears the stack
used by it.

Variables can also be annotated with the strub attribute, so that
functions that read from them get stack scrubbing enabled implicitly,
whether at-calls, for functions only usable within a translation unit,
or internal, for functions whose interfaces must not be modified.

There is a strict mode, in which functions that have their stack
scrubbed can only call other functions with stack-scrubbing
interfaces, or those explicitly marked as callable from strub
contexts, so that an entire call chain gets scrubbing, at once or
piecemeal depending on optimization levels.  In the default mode,
relaxed, this requirement is not enforced by the compiler.

The implementation adds two IPA passes, one that assigns strub modes
early on, another that modifies interfaces and adds calls to the
builtins that jointly implement stack scrubbing.  Another builtin,
that obtains the stack pointer, is added for use in the implementation
of the builtins, whether expanded inline or called in libgcc.

There are new command-line options to change operation modes and to
force the feature disabled; it is enabled by default, but it has no
effect and is implicitly disabled if the strub attribute is never
used.  There are also options meant to use for testing the feature,
enabling different strubbing modes for all (viable) functions.


for  gcc/ChangeLog

	* Makefile.in (OBJS): Add ipa-strub.o.
	(GTFILES): Add ipa-strub.cc.
	* builtins.def (BUILT_IN_STACK_ADDRESS): New.
	(BUILT_IN___STRUB_ENTER): New.
	(BUILT_IN___STRUB_UPDATE): New.
	(BUILT_IN___STRUB_LEAVE): New.
	* builtins.cc: Include ipa-strub.h.
	(STACK_STOPS, STACK_UNSIGNED): Define.
	(expand_builtin_stack_address): New.
	(expand_builtin_strub_enter): New.
	(expand_builtin_strub_update): New.
	(expand_builtin_strub_leave): New.
	(expand_builtin): Call them.
	* common.opt (fstrub=*): New options.
	* doc/extend.texi (strub): New type attribute.
	(__builtin_stack_address): New function.
	(Stack Scrubbing): New section.
	* doc/invoke.texi (-fstrub=*): New options.
	(-fdump-ipa-*): New passes.
	* gengtype-lex.l: Ignore multi-line pp-directives.
	* ipa-inline.cc: Include ipa-strub.h.
	(can_inline_edge_p): Test strub_inlinable_to_p.
	* ipa-split.cc: Include ipa-strub.h.
	(execute_split_functions): Test strub_splittable_p.
	* ipa-strub.cc, ipa-strub.h: New.
	* passes.def: Add strub_mode and strub passes.
	* tree-cfg.cc (gimple_verify_flow_info): Note on debug stmts.
	* tree-pass.h (make_pass_ipa_strub_mode): Declare.
	(make_pass_ipa_strub): Declare.
	(make_pass_ipa_function_and_variable_visibility): Fix
	formatting.
	* tree-ssa-ccp.cc (optimize_stack_restore): Keep restores
	before strub leave.
	* attribs.cc: Include ipa-strub.h.
	(decl_attributes): Support applying attributes to function
	type, rather than pointer type, at handler's request.
	(comp_type_attributes): Combine strub_comptypes and target
	comp_type results.
	* doc/tm.texi.in (TARGET_STRUB_USE_DYNAMIC_ARRAY): New.
	(TARGET_STRUB_MAY_USE_MEMSET): New.
	* doc/tm.texi: Rebuilt.
	* cgraph.h (symtab_node::reset): Add preserve_comdat_group
	param, with a default.
	* cgraphunit.cc (symtab_node::reset): Use it.

for  gcc/c-family/ChangeLog

	* c-attribs.cc: Include ipa-strub.h.
	(handle_strub_attribute): New.
	(c_common_attribute_table): Add strub.

for  gcc/ada/ChangeLog

	* gcc-interface/trans.cc: Include ipa-strub.h.
	(gigi): Make internal decls for targets of compiler-generated
	calls strub-callable too.
	(build_raise_check): Likewise.
	* gcc-interface/utils.cc: Include ipa-strub.h.
	(handle_strub_attribute): New.
	(gnat_internal_attribute_table): Add strub.

for  gcc/testsuite/ChangeLog

	* c-c++-common/strub-O0.c: New.
	* c-c++-common/strub-O1.c: New.
	* c-c++-common/strub-O2.c: New.
	* c-c++-common/strub-O2fni.c: New.
	* c-c++-common/strub-O3.c: New.
	* c-c++-common/strub-O3fni.c: New.
	* c-c++-common/strub-Og.c: New.
	* c-c++-common/strub-Os.c: New.
	* c-c++-common/strub-all1.c: New.
	* c-c++-common/strub-all2.c: New.
	* c-c++-common/strub-apply1.c: New.
	* c-c++-common/strub-apply2.c: New.
	* c-c++-common/strub-apply3.c: New.
	* c-c++-common/strub-apply4.c: New.
	* c-c++-common/strub-at-calls1.c: New.
	* c-c++-common/strub-at-calls2.c: New.
	* c-c++-common/strub-defer-O1.c: New.
	* c-c++-common/strub-defer-O2.c: New.
	* c-c++-common/strub-defer-O3.c: New.
	* c-c++-common/strub-defer-Os.c: New.
	* c-c++-common/strub-internal1.c: New.
	* c-c++-common/strub-internal2.c: New.
	* c-c++-common/strub-parms1.c: New.
	* c-c++-common/strub-parms2.c: New.
	* c-c++-common/strub-parms3.c: New.
	* c-c++-common/strub-relaxed1.c: New.
	* c-c++-common/strub-relaxed2.c: New.
	* c-c++-common/strub-short-O0-exc.c: New.
	* c-c++-common/strub-short-O0.c: New.
	* c-c++-common/strub-short-O1.c: New.
	* c-c++-common/strub-short-O2.c: New.
	* c-c++-common/strub-short-O3.c: New.
	* c-c++-common/strub-short-Os.c: New.
	* c-c++-common/strub-strict1.c: New.
	* c-c++-common/strub-strict2.c: New.
	* c-c++-common/strub-tail-O1.c: New.
	* c-c++-common/strub-tail-O2.c: New.
	* c-c++-common/torture/strub-callable1.c: New.
	* c-c++-common/torture/strub-callable2.c: New.
	* c-c++-common/torture/strub-const1.c: New.
	* c-c++-common/torture/strub-const2.c: New.
	* c-c++-common/torture/strub-const3.c: New.
	* c-c++-common/torture/strub-const4.c: New.
	* c-c++-common/torture/strub-data1.c: New.
	* c-c++-common/torture/strub-data2.c: New.
	* c-c++-common/torture/strub-data3.c: New.
	* c-c++-common/torture/strub-data4.c: New.
	* c-c++-common/torture/strub-data5.c: New.
	* c-c++-common/torture/strub-indcall1.c: New.
	* c-c++-common/torture/strub-indcall2.c: New.
	* c-c++-common/torture/strub-indcall3.c: New.
	* c-c++-common/torture/strub-inlinable1.c: New.
	* c-c++-common/torture/strub-inlinable2.c: New.
	* c-c++-common/torture/strub-ptrfn1.c: New.
	* c-c++-common/torture/strub-ptrfn2.c: New.
	* c-c++-common/torture/strub-ptrfn3.c: New.
	* c-c++-common/torture/strub-ptrfn4.c: New.
	* c-c++-common/torture/strub-pure1.c: New.
	* c-c++-common/torture/strub-pure2.c: New.
	* c-c++-common/torture/strub-pure3.c: New.
	* c-c++-common/torture/strub-pure4.c: New.
	* c-c++-common/torture/strub-run1.c: New.
	* c-c++-common/torture/strub-run2.c: New.
	* c-c++-common/torture/strub-run3.c: New.
	* c-c++-common/torture/strub-run4.c: New.
	* c-c++-common/torture/strub-run4c.c: New.
	* c-c++-common/torture/strub-run4d.c: New.
	* c-c++-common/torture/strub-run4i.c: New.
	* g++.dg/strub-run1.C: New.
	* g++.dg/torture/strub-init1.C: New.
	* g++.dg/torture/strub-init2.C: New.
	* g++.dg/torture/strub-init3.C: New.
	* gnat.dg/strub_attr.adb, gnat.dg/strub_attr.ads: New.
	* gnat.dg/strub_ind.adb, gnat.dg/strub_ind.ads: New.

for  libgcc/ChangeLog

	* Makefile.in (LIB2ADD): Add strub.c.
	* libgcc2.h (__strub_enter, __strub_update, __strub_leave):
	Declare.
	* strub.c: New.
	* libgcc-std.ver.in (__strub_enter): Add to GCC_14.0.0.
	(__strub_update, __strub_leave): Likewise.

20 files changed, 743 insertions, 0 deletions

diff --git a/gcc/testsuite/gnat.dg/strub_access.adb b/gcc/testsuite/gnat.dg/strub_access.adb
new file mode 100644
index 0000000..29e6996
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_access.adb
@@ -0,0 +1,21 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=relaxed -fdump-ipa-strubm" }
+
+--  The main subprogram doesn't read from the automatic variable, but
+--  being an automatic variable, its presence should be enough for the
+--  procedure to get strub enabled.
+
+procedure Strub_Access is
+   type Strub_Int is new Integer;
+   pragma Machine_Attribute (Strub_Int, "strub");
+   
+   X : aliased Strub_Int := 0;
+
+   function F (P : access Strub_Int) return Strub_Int is (P.all);
+
+begin
+   X := F (X'Access);
+end Strub_Access;
+
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]internal\[)\]\[)\]" 1 "strubm" } }
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]at-calls-opt\[)\]\[)\]" 1 "strubm" } }
diff --git a/gcc/testsuite/gnat.dg/strub_access1.adb b/gcc/testsuite/gnat.dg/strub_access1.adb
new file mode 100644
index 0000000..dae4706
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_access1.adb
@@ -0,0 +1,16 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=relaxed" }
+
+--  Check that we reject 'Access of a strub variable whose type does
+--  not carry a strub modifier.
+
+procedure Strub_Access1 is
+   X : aliased Integer := 0;
+   pragma Machine_Attribute (X, "strub");
+
+   function F (P : access Integer) return Integer is (P.all);
+   
+begin
+   X := F (X'Unchecked_access); -- OK.
+   X := F (X'Access); -- { dg-error "target access type drops .strub. mode" }
+end Strub_Access1;
diff --git a/gcc/testsuite/gnat.dg/strub_attr.adb b/gcc/testsuite/gnat.dg/strub_attr.adb
new file mode 100644
index 0000000..10445d7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_attr.adb
@@ -0,0 +1,37 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=strict -fdump-ipa-strubm -fdump-ipa-strub" }
+
+package body Strub_Attr is
+   E : exception;
+
+   procedure P (X : Integer) is
+   begin
+      raise E;
+   end;
+   
+   function F (X : Integer) return Integer is
+   begin
+      return X * X;
+   end;
+   
+   function G return Integer is (F (X));
+   --  function G return Integer is (FP (X));
+   --  Calling G would likely raise an exception, because although FP
+   --  carries the strub at-calls attribute needed to call F, the
+   --  attribute is dropped from the type used for the call proper.
+end Strub_Attr;
+
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]internal\[)\]\[)\]" 2 "strubm" } }
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]at-calls\[)\]\[)\]" 0 "strubm" } }
+--  { dg-final { scan-ipa-dump-times "\[(\]strub\[)\]" 1 "strubm" } }
+
+--  { dg-final { scan-ipa-dump-times "strub.watermark_ptr" 6 "strub" } }
+--  We have 1 at-calls subprogram (F) and 2 wrapped (P and G).
+--  For each of them, there's one match for the wrapped signature, 
+--  and one for the update call.
+
+--  { dg-final { scan-ipa-dump-times "strub.watermark" 27 "strub" } }
+--  The 6 matches above, plus:
+--  5*2: wm var decl, enter, call, leave and clobber for each wrapper;
+--  2*1: an extra leave and clobber for the exception paths in the wrappers.
+--  7*1: for the F call in G, including EH path.
diff --git a/gcc/testsuite/gnat.dg/strub_attr.ads b/gcc/testsuite/gnat.dg/strub_attr.ads
new file mode 100644
index 0000000..a94c23b
--- /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", "internal");
+
+   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;
diff --git a/gcc/testsuite/gnat.dg/strub_disp.adb b/gcc/testsuite/gnat.dg/strub_disp.adb
new file mode 100644
index 0000000..3dbcc4a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_disp.adb
@@ -0,0 +1,64 @@
+--  { dg-do compile }
+
+procedure Strub_Disp is
+   package Foo is
+      type A is tagged null record;
+
+      procedure P (I : Integer; X : A);
+      pragma Machine_Attribute (P, "strub", "at-calls");
+      
+      function F (X : access A) return Integer;
+
+      type B is new A with null record;
+      
+      overriding
+      procedure P (I : Integer; X : B); -- { dg-error "requires the same .strub. mode" }
+
+      overriding
+      function F (X : access B) return Integer;
+      pragma Machine_Attribute (F, "strub", "at-calls"); -- { dg-error "requires the same .strub. mode" }
+
+   end Foo;
+
+   package body Foo is
+      procedure P (I : Integer; X : A) is
+      begin
+	 null;
+      end;
+      
+      function F (X : access A) return Integer is (0);
+
+      overriding
+      procedure P (I : Integer; X : B) is
+      begin
+	 P (I, A (X));
+      end;
+      
+      overriding
+      function F (X : access B) return Integer is (1);
+   end Foo;
+
+   use Foo;
+
+   procedure Q (X : A'Class) is
+   begin
+      P (-1, X);
+   end;
+
+   XA : aliased A;
+   XB : aliased B;
+   I : Integer := 0;
+   XC : access A'Class;
+begin
+   Q (XA);
+   Q (XB);
+   
+   I := I + F (XA'Access);
+   I := I + F (XB'Access);
+
+   XC := XA'Access;
+   I := I + F (XC);
+
+   XC := XB'Access;
+   I := I + F (XC);
+end Strub_Disp;
diff --git a/gcc/testsuite/gnat.dg/strub_disp1.adb b/gcc/testsuite/gnat.dg/strub_disp1.adb
new file mode 100644
index 0000000..09756a7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_disp1.adb
@@ -0,0 +1,79 @@
+--  { dg-do compile }
+--  { dg-options "-fdump-ipa-strub" }
+
+-- Check that at-calls dispatching calls are transformed.
+
+procedure Strub_Disp1 is
+   package Foo is
+      type A is tagged null record;
+
+      procedure P (I : Integer; X : A);
+      pragma Machine_Attribute (P, "strub", "at-calls");
+      
+      function F (X : access A) return Integer;
+      pragma Machine_Attribute (F, "strub", "at-calls");
+
+      type B is new A with null record;
+      
+      overriding
+      procedure P (I : Integer; X : B);
+      pragma Machine_Attribute (P, "strub", "at-calls");
+
+      overriding
+      function F (X : access B) return Integer;
+      pragma Machine_Attribute (F, "strub", "at-calls");
+
+   end Foo;
+
+   package body Foo is
+      procedure P (I : Integer; X : A) is
+      begin
+	 null;
+      end;
+      
+      function F (X : access A) return Integer is (0);
+
+      overriding
+      procedure P (I : Integer; X : B) is
+      begin
+	 P (I, A (X)); -- strub-at-calls non-dispatching call
+      end;
+      
+      overriding
+      function F (X : access B) return Integer is (1);
+   end Foo;
+
+   use Foo;
+
+   procedure Q (X : A'Class) is
+   begin
+      P (-1, X); -- strub-at-calls dispatching call.
+   end;
+
+   XA : aliased A;
+   XB : aliased B;
+   I : Integer := 0;
+   XC : access A'Class;
+begin
+   Q (XA);
+   Q (XB);
+   
+   I := I + F (XA'Access); -- strub-at-calls non-dispatching call
+   I := I + F (XB'Access); -- strub-at-calls non-dispatching call
+
+   XC := XA'Access;
+   I := I + F (XC); -- strub-at-calls dispatching call.
+
+   XC := XB'Access;
+   I := I + F (XC); -- strub-at-calls dispatching call.
+end Strub_Disp1;
+
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]at-calls\[)\]\[)\]" 4 "strub" } }
+
+--  Count the strub-at-calls non-dispatching calls 
+--  (+ 2 each, for the matching prototypes)
+--  { dg-final { scan-ipa-dump-times "foo\.p \[(\]\[^\n\]*watermark" 3 "strub" } }
+--  { dg-final { scan-ipa-dump-times "foo\.f \[(\]\[^\n\]*watermark" 4 "strub" } }
+
+--  Count the strub-at-calls dispatching calls.
+--  { dg-final { scan-ipa-dump-times "_\[0-9\]* \[(\]\[^\n\]*watermark" 3 "strub" } }
diff --git a/gcc/testsuite/gnat.dg/strub_ind.adb b/gcc/testsuite/gnat.dg/strub_ind.adb
new file mode 100644
index 0000000..da56aca
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_ind.adb
@@ -0,0 +1,33 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=strict" }
+
+--  This is essentially the same test as strub_attr.adb, 
+--  but applying attributes to access types as well.
+--  That doesn't quite work yet, so we get an error we shouldn't get.
+
+package body Strub_Ind is
+   E : exception;
+
+   function G return Integer;
+
+   procedure P (X : Integer) is
+   begin
+      raise E;
+   end;
+   
+   function F (X : Integer) return Integer is
+   begin
+      return X * X;
+   end;
+   
+   function G return Integer is (FP (X));
+
+   type GT is access function return Integer;
+
+   type GT_SAC is access function return Integer;
+   pragma Machine_Attribute (GT_SAC, "strub", "at-calls");
+
+   GP : GT_SAC := GT_SAC (GT'(G'Access)); -- { dg-error "incompatible" }
+   -- pragma Machine_Attribute (GP, "strub", "at-calls");
+
+end Strub_Ind;
diff --git a/gcc/testsuite/gnat.dg/strub_ind.ads b/gcc/testsuite/gnat.dg/strub_ind.ads
new file mode 100644
index 0000000..99a65fc
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_ind.ads
@@ -0,0 +1,17 @@
+package Strub_Ind is
+   procedure P (X : Integer);
+   pragma Machine_Attribute (P, "strub", "internal");
+
+   function F (X : Integer) return Integer;
+   pragma Machine_Attribute (F, "strub");
+
+   X : Integer := 0;
+   pragma Machine_Attribute (X, "strub");
+
+   type FT is access function (X : Integer) return Integer;
+   pragma Machine_Attribute (FT, "strub", "at-calls");
+
+   FP : FT := F'Access;
+   -- pragma Machine_Attribute (FP, "strub", "at-calls"); -- not needed
+
+end Strub_Ind;
diff --git a/gcc/testsuite/gnat.dg/strub_ind1.adb b/gcc/testsuite/gnat.dg/strub_ind1.adb
new file mode 100644
index 0000000..825e395
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_ind1.adb
@@ -0,0 +1,41 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=strict -fdump-ipa-strubm" }
+
+--  This is essentially the same test as strub_attr.adb, 
+--  but with an explicit conversion.
+
+package body Strub_Ind1 is
+   E : exception;
+
+   type Strub_Int is New Integer;
+   pragma Machine_Attribute (Strub_Int, "strub");
+
+   function G return Integer;
+   pragma Machine_Attribute (G, "strub", "disabled");
+
+   procedure P (X : Integer) is
+   begin
+      raise E;
+   end;
+   
+   function G return Integer is (FP (X));
+
+   type GT is access function return Integer;
+   pragma Machine_Attribute (GT, "strub", "disabled");
+
+   type GT_SC is access function return Integer;
+   pragma Machine_Attribute (GT_SC, "strub", "callable");
+
+   GP : GT_SC := GT_SC (GT'(G'Access));
+   --  pragma Machine_Attribute (GP, "strub", "callable"); -- not needed.
+
+   function F (X : Integer) return Integer is
+   begin
+      return X * GP.all;
+   end;
+   
+end Strub_Ind1;
+
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]disabled\[)\]\[)\]" 1 "strubm" } }
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]internal\[)\]\[)\]" 1 "strubm" } }
+--  { dg-final { scan-ipa-dump-times "\[(\]strub\[)\]" 1 "strubm" } }
diff --git a/gcc/testsuite/gnat.dg/strub_ind1.ads b/gcc/testsuite/gnat.dg/strub_ind1.ads
new file mode 100644
index 0000000..d3f1273
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_ind1.ads
@@ -0,0 +1,17 @@
+package Strub_Ind1 is
+   procedure P (X : Integer);
+   pragma Machine_Attribute (P, "strub", "internal");
+
+   function F (X : Integer) return Integer;
+   pragma Machine_Attribute (F, "strub");
+
+   X : aliased Integer := 0;
+   pragma Machine_Attribute (X, "strub");
+
+   type FT is access function (X : Integer) return Integer;
+   pragma Machine_Attribute (FT, "strub", "at-calls");
+
+   FP : FT := F'Access;
+   pragma Machine_Attribute (FP, "strub", "at-calls");
+
+end Strub_Ind1;
diff --git a/gcc/testsuite/gnat.dg/strub_ind2.adb b/gcc/testsuite/gnat.dg/strub_ind2.adb
new file mode 100644
index 0000000..e918b39
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_ind2.adb
@@ -0,0 +1,34 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=strict" }
+
+--  This is essentially the same test as strub_attr.adb, 
+--  but with an explicit conversion.
+
+package body Strub_Ind2 is
+   E : exception;
+
+   function G return Integer;
+   pragma Machine_Attribute (G, "strub", "callable");
+
+   procedure P (X : Integer) is
+   begin
+      raise E;
+   end;
+   
+   function G return Integer is (FP (X));
+
+   type GT is access function return Integer;
+   pragma Machine_Attribute (GT, "strub", "callable");
+
+   type GT_SD is access function return Integer;
+   pragma Machine_Attribute (GT_SD, "strub", "disabled");
+
+   GP : GT_SD := GT_SD (GT'(G'Access));
+   --  pragma Machine_Attribute (GP, "strub", "disabled"); -- not needed.
+
+   function F (X : Integer) return Integer is
+   begin
+      return X * GP.all; --  { dg-error "using non-.strub. type" }
+   end;
+   
+end Strub_Ind2;
diff --git a/gcc/testsuite/gnat.dg/strub_ind2.ads b/gcc/testsuite/gnat.dg/strub_ind2.ads
new file mode 100644
index 0000000..e13865e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_ind2.ads
@@ -0,0 +1,17 @@
+package Strub_Ind2 is
+   procedure P (X : Integer);
+   pragma Machine_Attribute (P, "strub", "internal");
+
+   function F (X : Integer) return Integer;
+   pragma Machine_Attribute (F, "strub");
+
+   X : Integer := 0;
+   pragma Machine_Attribute (X, "strub");
+
+   type FT is access function (X : Integer) return Integer;
+   pragma Machine_Attribute (FT, "strub", "at-calls");
+
+   FP : FT := F'Access;
+   pragma Machine_Attribute (FP, "strub", "at-calls");
+
+end Strub_Ind2;
diff --git a/gcc/testsuite/gnat.dg/strub_intf.adb b/gcc/testsuite/gnat.dg/strub_intf.adb
new file mode 100644
index 0000000..8f0212a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_intf.adb
@@ -0,0 +1,93 @@
+--  { dg-do compile }
+
+--  Check that strub mode mismatches between overrider and overridden
+--  subprograms are reported.
+
+procedure Strub_Intf is
+   package Foo is
+      type TP is interface;
+      procedure P (I : Integer; X : TP) is abstract;
+      pragma Machine_Attribute (P, "strub", "at-calls"); -- { dg-error "requires the same .strub. mode" }
+
+      type TF is interface;
+      function F (X : access TF) return Integer is abstract;
+
+      type TX is interface;
+      procedure P (I : Integer; X : TX) is abstract;
+
+      type TI is interface and TP and TF and TX;
+      --  When we freeze TI, we detect the mismatch between the
+      --  inherited P and another parent's P.  Because TP appears
+      --  before TX, we inherit P from TP, and report the mismatch at
+      --  the pragma inherited from TP against TX's P.  In contrast,
+      --  when we freeze TII below, since TX appears before TP, we
+      --  report the error at the line in which the inherited
+      --  subprogram is synthesized, namely the line below, against
+      --  the line of the pragma.
+
+      type TII is interface and TX and TP and TF; -- { dg-error "requires the same .strub. mode" }
+
+      function F (X : access TI) return Integer is abstract;
+      pragma Machine_Attribute (F, "strub", "at-calls"); -- { dg-error "requires the same .strub. mode" }
+
+      type A is new TI with null record;
+
+      procedure P (I : Integer; X : A);
+      pragma Machine_Attribute (P, "strub", "at-calls"); -- { dg-error "requires the same .strub. mode" }
+      
+      function F (X : access A) return Integer; -- { dg-error "requires the same .strub. mode" }
+
+      type B is new TI with null record;
+      
+      overriding
+      procedure P (I : Integer; X : B); -- { dg-error "requires the same .strub. mode" }
+
+      overriding
+      function F (X : access B) return Integer;
+      pragma Machine_Attribute (F, "strub", "at-calls"); -- { dg-error "requires the same .strub. mode" }
+
+   end Foo;
+
+   package body Foo is
+      procedure P (I : Integer; X : A) is
+      begin
+	 null;
+      end;
+      
+      function F (X : access A) return Integer is (0);
+
+      overriding
+      procedure P (I : Integer; X : B) is
+      begin
+	 null;
+      end;
+      
+      overriding
+      function F (X : access B) return Integer is (1);
+
+   end Foo;
+
+   use Foo;
+
+   procedure Q (X : TX'Class) is
+   begin
+      P (-1, X);
+   end;
+
+   XA : aliased A;
+   XB : aliased B;
+   I : Integer := 0;
+   XC : access TI'Class;
+begin
+   Q (XA);
+   Q (XB);
+   
+   I := I + F (XA'Access);
+   I := I + F (XB'Access);
+
+   XC := XA'Access;
+   I := I + F (XC);
+
+   XC := XB'Access;
+   I := I + F (XC);
+end Strub_Intf;
diff --git a/gcc/testsuite/gnat.dg/strub_intf1.adb b/gcc/testsuite/gnat.dg/strub_intf1.adb
new file mode 100644
index 0000000..bf77321
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_intf1.adb
@@ -0,0 +1,86 @@
+--  { dg-do compile }
+--  { dg-options "-fdump-ipa-strub" }
+
+-- Check that at-calls dispatching calls to interfaces are transformed.
+
+procedure Strub_Intf1 is
+   package Foo is
+      type TX is Interface;
+      procedure P (I : Integer; X : TX) is abstract;
+      pragma Machine_Attribute (P, "strub", "at-calls");
+      function F (X : access TX) return Integer is abstract;
+      pragma Machine_Attribute (F, "strub", "at-calls");
+
+      type A is new TX with null record;
+
+      procedure P (I : Integer; X : A);
+      pragma Machine_Attribute (P, "strub", "at-calls");
+      
+      function F (X : access A) return Integer;
+      pragma Machine_Attribute (F, "strub", "at-calls");
+
+      type B is new TX with null record;
+      
+      overriding
+      procedure P (I : Integer; X : B);
+      pragma Machine_Attribute (P, "strub", "at-calls");
+
+      overriding
+      function F (X : access B) return Integer;
+      pragma Machine_Attribute (F, "strub", "at-calls");
+
+   end Foo;
+
+   package body Foo is
+      procedure P (I : Integer; X : A) is
+      begin
+	 null;
+      end;
+      
+      function F (X : access A) return Integer is (0);
+
+      overriding
+      procedure P (I : Integer; X : B) is
+      begin
+	 null;
+      end;
+      
+      overriding
+      function F (X : access B) return Integer is (1);
+
+   end Foo;
+
+   use Foo;
+
+   procedure Q (X : TX'Class) is
+   begin
+      P (-1, X);
+   end;
+
+   XA : aliased A;
+   XB : aliased B;
+   I : Integer := 0;
+   XC : access TX'Class;
+begin
+   Q (XA);
+   Q (XB);
+   
+   I := I + F (XA'Access);
+   I := I + F (XB'Access);
+
+   XC := XA'Access;
+   I := I + F (XC);
+
+   XC := XB'Access;
+   I := I + F (XC);
+end Strub_Intf1;
+
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]at-calls\[)\]\[)\]" 4 "strub" } }
+
+--  Count the strub-at-calls non-dispatching calls 
+--  (+ 2 each, for the matching prototypes)
+--  { dg-final { scan-ipa-dump-times "foo\.p \[(\]\[^\n\]*watermark" 2 "strub" } }
+--  { dg-final { scan-ipa-dump-times "foo\.f \[(\]\[^\n\]*watermark" 4 "strub" } }
+
+--  Count the strub-at-calls dispatching calls.
+--  { dg-final { scan-ipa-dump-times "_\[0-9\]* \[(\]\[^\n\]*watermark" 3 "strub" } }
diff --git a/gcc/testsuite/gnat.dg/strub_intf2.adb b/gcc/testsuite/gnat.dg/strub_intf2.adb
new file mode 100644
index 0000000..e8880db
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_intf2.adb
@@ -0,0 +1,55 @@
+--  { dg-do compile }
+
+--  Check that strub mode mismatches between overrider and overridden
+--  subprograms are reported even when the overriders for an
+--  interface's subprograms are inherited from a type that is not a
+--  descendent of the interface.
+
+procedure Strub_Intf2 is
+   package Foo is
+      type A is tagged null record;
+
+      procedure P (I : Integer; X : A);
+      pragma Machine_Attribute (P, "strub", "at-calls"); -- { dg-error "requires the same .strub. mode" }
+      
+      function F (X : access A) return Integer;
+
+      type TX is Interface;
+
+      procedure P (I : Integer; X : TX) is abstract; 
+
+      function F (X : access TX) return Integer is abstract;
+      pragma Machine_Attribute (F, "strub", "at-calls");
+
+      type B is new A and TX with null record; -- { dg-error "requires the same .strub. mode" }
+
+   end Foo;
+
+   package body Foo is
+      procedure P (I : Integer; X : A) is
+      begin
+	 null;
+      end;
+      
+      function F (X : access A) return Integer is (0);
+
+   end Foo;
+
+   use Foo;
+
+   procedure Q (X : TX'Class) is
+   begin
+      P (-1, X);
+   end;
+
+   XB : aliased B;
+   I : Integer := 0;
+   XC : access TX'Class;
+begin
+   Q (XB);
+   
+   I := I + F (XB'Access);
+
+   XC := XB'Access;
+   I := I + F (XC);
+end Strub_Intf2;
diff --git a/gcc/testsuite/gnat.dg/strub_renm.adb b/gcc/testsuite/gnat.dg/strub_renm.adb
new file mode 100644
index 0000000..217367e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_renm.adb
@@ -0,0 +1,21 @@
+--  { dg-do compile }
+
+procedure Strub_Renm is
+   procedure P (X : Integer);
+   pragma Machine_Attribute (P, "strub", "at-calls");
+
+   function F return Integer;
+   pragma Machine_Attribute (F, "strub", "internal");
+
+   procedure Q (X : Integer) renames P; -- { dg-error "requires the same .strub. mode" }
+
+   function G return Integer renames F;
+   pragma Machine_Attribute (G, "strub", "callable"); -- { dg-error "requires the same .strub. mode" }
+
+   procedure P (X : Integer) is null;
+   function F return Integer is (0);
+
+begin
+   P (F);
+   Q (G);
+end Strub_Renm;
diff --git a/gcc/testsuite/gnat.dg/strub_renm1.adb b/gcc/testsuite/gnat.dg/strub_renm1.adb
new file mode 100644
index 0000000..a11adbf
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_renm1.adb
@@ -0,0 +1,32 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=relaxed -fdump-ipa-strub" }
+
+procedure Strub_Renm1 is
+   V : Integer := 0;
+   pragma Machine_Attribute (V, "strub");
+
+   procedure P (X : Integer);
+   pragma Machine_Attribute (P, "strub", "at-calls");
+
+   function F return Integer;
+
+   procedure Q (X : Integer) renames P;
+   pragma Machine_Attribute (Q, "strub", "at-calls");
+
+   function G return Integer renames F;
+   pragma Machine_Attribute (G, "strub", "internal");
+
+   procedure P (X : Integer) is null;
+   function F return Integer is (0);
+
+begin
+   P (F);
+   Q (G);
+end Strub_Renm1;
+
+--  This is for P; Q is an alias.
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]at-calls\[)\]\[)\]" 1 "strub" } }
+
+--  This is *not* for G, but for Strub_Renm1.
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]wrapped\[)\]\[)\]" 1 "strub" } }
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]wrapper\[)\]\[)\]" 1 "strub" } }
diff --git a/gcc/testsuite/gnat.dg/strub_renm2.adb b/gcc/testsuite/gnat.dg/strub_renm2.adb
new file mode 100644
index 0000000..c488c20
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_renm2.adb
@@ -0,0 +1,32 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=strict -fdump-ipa-strub" }
+
+procedure Strub_Renm2 is
+   V : Integer := 0;
+   pragma Machine_Attribute (V, "strub");
+
+   procedure P (X : Integer);
+   pragma Machine_Attribute (P, "strub", "at-calls");
+
+   function F return Integer;
+
+   procedure Q (X : Integer) renames P;
+   pragma Machine_Attribute (Q, "strub", "at-calls");
+
+   type T is access function return Integer;
+
+   type TC is access function return Integer;
+   pragma Machine_Attribute (TC, "strub", "callable");
+
+   FCptr : constant TC := TC (T'(F'Access));
+
+   function G return Integer renames FCptr.all;
+   pragma Machine_Attribute (G, "strub", "callable");
+
+   procedure P (X : Integer) is null;
+   function F return Integer is (0);
+
+begin
+   P (F);  -- { dg-error "calling non-.strub." }
+   Q (G);  -- ok, G is callable.
+end Strub_Renm2;
diff --git a/gcc/testsuite/gnat.dg/strub_var.adb b/gcc/testsuite/gnat.dg/strub_var.adb
new file mode 100644
index 0000000..3d158de
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_var.adb
@@ -0,0 +1,16 @@
+--  { dg-do compile }
+--  { dg-options "-fstrub=strict -fdump-ipa-strubm" }
+
+-- We don't read from the automatic variable, but being an automatic
+--  variable, its presence should be enough for the procedure to get
+--  strub enabled.
+
+with Strub_Attr;
+procedure Strub_Var is
+   X : Integer := 0;
+   pragma Machine_Attribute (X, "strub");
+begin
+   X := Strub_Attr.F (0);
+end Strub_Var;
+
+--  { dg-final { scan-ipa-dump-times "\[(\]strub \[(\]internal\[)\]\[)\]" 1 "strubm" } }
diff --git a/gcc/testsuite/gnat.dg/strub_var1.adb b/gcc/testsuite/gnat.dg/strub_var1.adb
new file mode 100644
index 0000000..6a504e0
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/strub_var1.adb
@@ -0,0 +1,20 @@
+--  { dg-do compile }
+
+with Strub_Attr;
+procedure Strub_Var1 is
+   type TA  -- { dg-warning "does not apply to elements" }
+      is array (1..2) of Integer;
+   pragma Machine_Attribute (TA, "strub");
+   
+   A : TA := (0, 0);  -- { dg-warning "does not apply to elements" }
+   
+   type TR is record  -- { dg-warning "does not apply to fields" }
+      M, N : Integer;
+   end record;
+   pragma Machine_Attribute (TR, "strub");
+   
+   R : TR := (0, 0);
+
+begin
+   A(2) := Strub_Attr.F (A(1));
+end Strub_Var1;