public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-5036] [Ada] Improve integration of strub with type systems
@ 2021-11-09 9:47 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-11-09 9:47 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d235950e83965ed6389eb94b1cffb7393dcb1984
commit r12-5036-gd235950e83965ed6389eb94b1cffb7393dcb1984
Author: Alexandre Oliva <oliva@adacore.com>
Date: Wed Oct 27 18:26:27 2021 -0300
[Ada] Improve integration of strub with type systems
gcc/ada/
* strub.adb, strub.ads: New files.
* exp_attr.adb (Access_Cases): Copy strub mode to subprogram type.
* exp_disp.adb (Expand_Dispatching_Call): Likewise.
* freeze.adb (Check_Inherited_Conditions): Check that strub modes
match overridden subprograms and interfaces.
(Freeze_All): Renaming declarations too.
* sem_attr.adb (Resolve_Attribute): Reject 'Access to
strub-annotated data object.
* sem_ch3.adb (Derive_Subprogram): Copy strub mode to
inherited subprogram.
* sem_prag.adb (Analyze_Pragma): Propagate Strub Machine_Attribute
from access-to-subprogram to subprogram type when required,
but not from access-to-data to data type. Mark the entity that
got the pragma as having a gigi rep item.
* sem_res.adb (Resolve): Reject implicit conversions that
would change strub modes.
(Resolve_Type_Conversions): Reject checked conversions
between incompatible strub modes.
* doc/gnat_rm/security_hardening_features.rst: Update.
* gnat_rm.texi: Regenerate.
* libgnat/a-except.ads (Raise_Exception): Revert strub-callable
annotation in public subprogram.
* libgnat/s-arit128.ads (Multiply_With_Ovflo_Check128): Likewise.
* libgnat/s-arit64.ads (Multiply_With_Ovflo_Check64): Likewise.
* libgnat/s-secsta.ads (SS_Allocate): Likewise.
(SS_Mark, SS_Release): Likewise.
* gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Add ada/strub.o.
Diff:
---
.../doc/gnat_rm/security_hardening_features.rst | 60 +++-
gcc/ada/exp_attr.adb | 2 +
gcc/ada/exp_disp.adb | 2 +
gcc/ada/freeze.adb | 75 ++++-
gcc/ada/gcc-interface/Make-lang.in | 1 +
gcc/ada/gnat_rm.texi | 157 ++++++++---
gcc/ada/libgnat/a-except.ads | 7 +-
gcc/ada/libgnat/s-arit128.ads | 7 -
gcc/ada/libgnat/s-arit64.ads | 7 -
gcc/ada/libgnat/s-secsta.ads | 5 -
gcc/ada/sem_attr.adb | 22 ++
gcc/ada/sem_ch3.adb | 3 +
gcc/ada/sem_prag.adb | 27 +-
gcc/ada/sem_res.adb | 43 ++-
gcc/ada/strub.adb | 301 +++++++++++++++++++++
gcc/ada/strub.ads | 115 ++++++++
16 files changed, 747 insertions(+), 87 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/security_hardening_features.rst b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
index cf76938d91d..bdcfd99ad86 100644
--- a/gcc/ada/doc/gnat_rm/security_hardening_features.rst
+++ b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
@@ -73,20 +73,52 @@ Note that Ada secondary stacks are not scrubbed. The restriction
``No_Secondary_Stack`` avoids their use, and thus their accidental
preservation of data that should be scrubbed.
-Also note that the machine attribute is not integrated in the Ada type
-system. Though it may modify subprogram and variable interfaces, it
-is not fully reflected in Ada types, ``Access`` attributes, renaming
-and overriding. Every access type, renaming, and overriding and
-overridden dispatching operations that may refer to an entity with an
-attribute-modified interface must be annotated with the same
-interface-modifying attribute, or with an interface-compatible one.
-
-Even then, the pragma is currently only functional when applied to
-subprograms and scalar variables; other uses, such as directly on
-types and subtypes, may be silently ignored. Specifically, it is not
-currently recommended to rely on any effects this pragma might be
-expected to have when calling subprograms through access-to-subprogram
-variables.
+Attributes ``Access`` and ``Unconstrained_Access`` of variables and
+constants with ``strub`` enabled require types with ``strub`` enabled;
+there is no way to express an access-to-strub type otherwise.
+``Unchecked_Access`` bypasses this constraint, but the resulting
+access type designates a non-strub type.
+
+.. code-block:: ada
+
+ VI : Integer;
+ XsVI : access Integer := VI'Access; -- Error.
+ UXsVI : access Integer := VI'Unchecked_Access; -- OK,
+ -- UXsVI.all does not enable strub in the enclosing subprogram.
+
+ type Strub_Int is new Integer;
+ pragma Machine_Attribute (Strub_Int, "strub");
+ VSI : Strub_Int;
+ XsVSI : access Strub_Int := VSI'Access; -- OK.
+ -- XsVSI.all enables strub in the enclosing subprogram.
+
+
+Every access-to-subprogram type, renaming, and overriding and
+overridden dispatching operations that may refer to a subprogram with
+an attribute-modified interface must be annotated with the same
+interface-modifying attribute. Access-to-subprogram types can be
+explicitly converted to different strub modes, as long as they are
+interface-compatible (i.e., adding or removing ``at-calls`` is not
+allowed). For example, a ``strub``-``disabled`` subprogram can be
+turned ``callable`` through such an explicit conversion:
+
+.. code-block:: ada
+
+ type TBar is access procedure;
+
+ type TBar_Callable is access procedure;
+ pragma Machine_Attribute (TBar_Callable, "strub", "callable");
+
+ Bar_Callable_Ptr : constant TBar_Callable
+ := TBar_Callable (TBar'(Bar'Access));
+
+ procedure Bar_Callable renames Bar_Callable_Ptr.all;
+ pragma Machine_Attribute (Bar_Callable, "strub", "callable");
+
+Note that the renaming declaration is expanded to a full subprogram
+body, it won't be just an alias. Only if it is inlined will it be as
+efficient as a call by dereferencing the access-to-subprogram constant
+Bar_Callable_Ptr.
.. Hardened Conditionals:
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 19d8286a759..33ac8bde635 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -67,6 +67,7 @@ with Sinfo.Utils; use Sinfo.Utils;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
+with Strub; use Strub;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
@@ -2162,6 +2163,7 @@ package body Exp_Attr is
begin
Subp_Typ := Create_Itype (E_Subprogram_Type, N);
+ Copy_Strub_Mode (Subp_Typ, Subp);
Set_Etype (Subp_Typ, Etype (Subp));
Set_Returns_By_Ref (Subp_Typ, Returns_By_Ref (Subp));
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 88f11b28dd5..de2ba7a562b 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -66,6 +66,7 @@ with Sinfo.Utils; use Sinfo.Utils;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
+with Strub; use Strub;
with SCIL_LL; use SCIL_LL;
with Tbuild; use Tbuild;
@@ -846,6 +847,7 @@ package body Exp_Disp is
end if;
Subp_Typ := Create_Itype (E_Subprogram_Type, Call_Node);
+ Copy_Strub_Mode (Subp_Typ, Subp);
Subp_Ptr_Typ := Create_Itype (E_Access_Subprogram_Type, Call_Node);
Set_Etype (Subp_Typ, Res_Typ);
Set_Returns_By_Ref (Subp_Typ, Returns_By_Ref (Subp));
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 97a51db9d4b..726e20073fc 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -69,6 +69,7 @@ with Sinfo.Utils; use Sinfo.Utils;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
+with Strub; use Strub;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
@@ -1790,6 +1791,10 @@ package body Freeze is
return Result;
end Needs_Wrapper;
+ Ifaces_List : Elist_Id;
+ Ifaces_Listed : Boolean := False;
+ -- Cache the list of interface operations inherited by R
+
-- Start of processing for Check_Inherited_Conditions
begin
@@ -1823,11 +1828,10 @@ package body Freeze is
while Present (Op_Node) loop
Prim := Node (Op_Node);
- if Present (Overridden_Operation (Prim))
+ Par_Prim := Overridden_Operation (Prim);
+ if Present (Par_Prim)
and then Comes_From_Source (Prim)
then
- Par_Prim := Overridden_Operation (Prim);
-
-- When the primitive is an LSP wrapper we climb to the parent
-- primitive that has the inherited contract.
@@ -1837,6 +1841,11 @@ package body Freeze is
Par_Prim := LSP_Subprogram (Par_Prim);
end if;
+ -- Check that overrider and overridden operations have
+ -- the same strub mode.
+
+ Check_Same_Strub_Mode (Prim, Par_Prim);
+
-- Analyze the contract items of the overridden operation, before
-- they are rewritten as pragmas.
@@ -1852,6 +1861,54 @@ package body Freeze is
end if;
end if;
+ -- Go over operations inherited from interfaces and check
+ -- them for strub mode compatibility as well.
+
+ if Has_Interfaces (R)
+ and then Is_Dispatching_Operation (Prim)
+ and then Find_Dispatching_Type (Prim) = R
+ then
+ declare
+ Elmt : Elmt_Id;
+ Iface_Elmt : Elmt_Id;
+ Iface : Entity_Id;
+ Iface_Prim : Entity_Id;
+
+ begin
+ -- Collect the interfaces only once. We haven't
+ -- finished freezing yet, so we can't use the faster
+ -- search from Sem_Disp.Covered_Interface_Primitives.
+
+ if not Ifaces_Listed then
+ Collect_Interfaces (R, Ifaces_List);
+ Ifaces_Listed := True;
+ end if;
+
+ Iface_Elmt := First_Elmt (Ifaces_List);
+ while Present (Iface_Elmt) loop
+ Iface := Node (Iface_Elmt);
+
+ Elmt := First_Elmt (Primitive_Operations (Iface));
+ while Present (Elmt) loop
+ Iface_Prim := Node (Elmt);
+
+ if Iface_Prim /= Par_Prim
+ and then Chars (Iface_Prim) = Chars (Prim)
+ and then Comes_From_Source (Iface_Prim)
+ and then (Is_Interface_Conformant
+ (R, Iface_Prim, Prim))
+ then
+ Check_Same_Strub_Mode (Prim, Iface_Prim);
+ end if;
+
+ Next_Elmt (Elmt);
+ end loop;
+
+ Next_Elmt (Iface_Elmt);
+ end loop;
+ end;
+ end if;
+
Next_Elmt (Op_Node);
end loop;
@@ -2504,6 +2561,18 @@ package body Freeze is
Process_Default_Expressions (E, After);
end if;
+ -- Check subprogram renamings for the same strub-mode.
+ -- Avoid rechecking dispatching operations, that's taken
+ -- care of in Check_Inherited_Conditions, that covers
+ -- inherited interface operations.
+
+ Item := Alias (E);
+ if Present (Item)
+ and then not Is_Dispatching_Operation (E)
+ then
+ Check_Same_Strub_Mode (E, Item);
+ end if;
+
if not Has_Completion (E) then
Decl := Unit_Declaration_Node (E);
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index ab5fb72623b..ae5158a5484 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -440,6 +440,7 @@ GNAT_ADA_OBJS = \
ada/sprint.o \
ada/stand.o \
ada/stringt.o \
+ ada/strub.o \
ada/style.o \
ada/styleg.o \
ada/stylesw.o \
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 129da895e09..a8232f2361f 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -21,7 +21,7 @@
@copying
@quotation
-GNAT Reference Manual , Oct 25, 2021
+GNAT Reference Manual , Nov 08, 2021
AdaCore
@@ -883,6 +883,7 @@ Security Hardening Features
* Register Scrubbing::
* Stack Scrubbing::
+* Hardened Conditionals::
Obsolescent Features
@@ -28864,6 +28865,7 @@ are provided by GNAT.
@menu
* Register Scrubbing::
* Stack Scrubbing::
+* Hardened Conditionals::
@end menu
@@ -28895,7 +28897,7 @@ For usage and more details on the command line option, and on the
@c Stack Scrubbing:
-@node Stack Scrubbing,,Register Scrubbing,Security Hardening Features
+@node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security Hardening Features
@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{43e}
@section Stack Scrubbing
@@ -28930,23 +28932,96 @@ Note that Ada secondary stacks are not scrubbed. The restriction
@code{No_Secondary_Stack} avoids their use, and thus their accidental
preservation of data that should be scrubbed.
-Also note that the machine attribute is not integrated in the Ada type
-system. Though it may modify subprogram and variable interfaces, it
-is not fully reflected in Ada types, @code{Access} attributes, renaming
-and overriding. Every access type, renaming, and overriding and
-overridden dispatching operations that may refer to an entity with an
-attribute-modified interface must be annotated with the same
-interface-modifying attribute, or with an interface-compatible one.
-
-Even then, the pragma is currently only functional when applied to
-subprograms and scalar variables; other uses, such as directly on
-types and subtypes, may be silently ignored. Specifically, it is not
-currently recommended to rely on any effects this pragma might be
-expected to have when calling subprograms through access-to-subprogram
-variables.
+Attributes @code{Access} and @code{Unconstrained_Access} of variables and
+constants with @code{strub} enabled require types with @code{strub} enabled;
+there is no way to express an access-to-strub type otherwise.
+@code{Unchecked_Access} bypasses this constraint, but the resulting
+access type designates a non-strub type.
+
+@example
+VI : Integer;
+XsVI : access Integer := VI'Access; -- Error.
+UXsVI : access Integer := VI'Unchecked_Access; -- OK,
+-- UXsVI.all does not enable strub in the enclosing subprogram.
+
+type Strub_Int is new Integer;
+pragma Machine_Attribute (Strub_Int, "strub");
+VSI : Strub_Int;
+XsVSI : access Strub_Int := VSI'Access; -- OK.
+-- XsVSI.all enables strub in the enclosing subprogram.
+@end example
+
+Every access-to-subprogram type, renaming, and overriding and
+overridden dispatching operations that may refer to a subprogram with
+an attribute-modified interface must be annotated with the same
+interface-modifying attribute. Access-to-subprogram types can be
+explicitly converted to different strub modes, as long as they are
+interface-compatible (i.e., adding or removing @code{at-calls} is not
+allowed). For example, a @code{strub}-@code{disabled} subprogram can be
+turned @code{callable} through such an explicit conversion:
+
+@example
+type TBar is access procedure;
+
+type TBar_Callable is access procedure;
+pragma Machine_Attribute (TBar_Callable, "strub", "callable");
+
+Bar_Callable_Ptr : constant TBar_Callable
+ := TBar_Callable (TBar'(Bar'Access));
+
+procedure Bar_Callable renames Bar_Callable_Ptr.all;
+pragma Machine_Attribute (Bar_Callable, "strub", "callable");
+@end example
+
+Note that the renaming declaration is expanded to a full subprogram
+body, it won’t be just an alias. Only if it is inlined will it be as
+efficient as a call by dereferencing the access-to-subprogram constant
+Bar_Callable_Ptr.
+
+@c Hardened Conditionals:
+
+@node Hardened Conditionals,,Stack Scrubbing,Security Hardening Features
+@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{43f}
+@section Hardened Conditionals
+
+
+GNAT can harden conditionals to protect against control flow attacks.
+
+This is accomplished by two complementary transformations, each
+activated by a separate command-line option.
+
+The option @emph{-fharden-compares} enables hardening of compares that
+compute results stored in variables, adding verification that the
+reversed compare yields the opposite result.
+
+The option @emph{-fharden-conditional-branches} enables hardening of
+compares that guard conditional branches, adding verification of the
+reversed compare to both execution paths.
+
+These transformations are introduced late in the compilation pipeline,
+long after boolean expressions are decomposed into separate compares,
+each one turned into either a conditional branch or a compare whose
+result is stored in a boolean variable or temporary. Compiler
+optimizations, if enabled, may also turn conditional branches into
+stored compares, and vice-versa, or into operations with implied
+conditionals (e.g. MIN and MAX). Conditionals may also be optimized
+out entirely, if their value can be determined at compile time, and
+occasionally multiple compares can be combined into one.
+
+It is thus difficult to predict which of these two options will affect
+a specific compare operation expressed in source code. Using both
+options ensures that every compare that is neither optimized out nor
+optimized into implied conditionals will be hardened.
+
+The addition of reversed compares can be observed by enabling the dump
+files of the corresponding passes, through command line options
+@emph{-fdump-tree-hardcmp} and @emph{-fdump-tree-hardcbr}, respectively.
+
+They are separate options, however, because of the significantly
+different performance impact of the hardening transformations.
@node Obsolescent Features,Compatibility and Porting Guide,Security Hardening Features,Top
-@anchor{gnat_rm/obsolescent_features doc}@anchor{43f}@anchor{gnat_rm/obsolescent_features id1}@anchor{440}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
+@anchor{gnat_rm/obsolescent_features doc}@anchor{440}@anchor{gnat_rm/obsolescent_features id1}@anchor{441}@anchor{gnat_rm/obsolescent_features obsolescent-features}@anchor{16}
@chapter Obsolescent Features
@@ -28965,7 +29040,7 @@ compatibility purposes.
@end menu
@node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id2}@anchor{441}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{442}
+@anchor{gnat_rm/obsolescent_features id2}@anchor{442}@anchor{gnat_rm/obsolescent_features pragma-no-run-time}@anchor{443}
@section pragma No_Run_Time
@@ -28978,7 +29053,7 @@ preferred usage is to use an appropriately configured run-time that
includes just those features that are to be made accessible.
@node pragma Ravenscar,pragma Restricted_Run_Time,pragma No_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id3}@anchor{443}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{444}
+@anchor{gnat_rm/obsolescent_features id3}@anchor{444}@anchor{gnat_rm/obsolescent_features pragma-ravenscar}@anchor{445}
@section pragma Ravenscar
@@ -28987,7 +29062,7 @@ The pragma @code{Ravenscar} has exactly the same effect as pragma
is part of the new Ada 2005 standard.
@node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id4}@anchor{445}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{446}
+@anchor{gnat_rm/obsolescent_features id4}@anchor{446}@anchor{gnat_rm/obsolescent_features pragma-restricted-run-time}@anchor{447}
@section pragma Restricted_Run_Time
@@ -28997,7 +29072,7 @@ preferred since the Ada 2005 pragma @code{Profile} is intended for
this kind of implementation dependent addition.
@node pragma Task_Info,package System Task_Info s-tasinf ads,pragma Restricted_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features id5}@anchor{447}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{448}
+@anchor{gnat_rm/obsolescent_features id5}@anchor{448}@anchor{gnat_rm/obsolescent_features pragma-task-info}@anchor{449}
@section pragma Task_Info
@@ -29023,7 +29098,7 @@ in the spec of package System.Task_Info in the runtime
library.
@node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{449}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{44a}
+@anchor{gnat_rm/obsolescent_features package-system-task-info}@anchor{44a}@anchor{gnat_rm/obsolescent_features package-system-task-info-s-tasinf-ads}@anchor{44b}
@section package System.Task_Info (@code{s-tasinf.ads})
@@ -29033,7 +29108,7 @@ to support the @code{Task_Info} pragma. The predefined Ada package
standard replacement for GNAT’s @code{Task_Info} functionality.
@node Compatibility and Porting Guide,GNU Free Documentation License,Obsolescent Features,Top
-@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{44b}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{44c}
+@anchor{gnat_rm/compatibility_and_porting_guide doc}@anchor{44c}@anchor{gnat_rm/compatibility_and_porting_guide compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide id1}@anchor{44d}
@chapter Compatibility and Porting Guide
@@ -29055,7 +29130,7 @@ applications developed in other Ada environments.
@end menu
@node Writing Portable Fixed-Point Declarations,Compatibility with Ada 83,,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{44d}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{44e}
+@anchor{gnat_rm/compatibility_and_porting_guide id2}@anchor{44e}@anchor{gnat_rm/compatibility_and_porting_guide writing-portable-fixed-point-declarations}@anchor{44f}
@section Writing Portable Fixed-Point Declarations
@@ -29177,7 +29252,7 @@ If you follow this scheme you will be guaranteed that your fixed-point
types will be portable.
@node Compatibility with Ada 83,Compatibility between Ada 95 and Ada 2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{44f}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{450}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-ada-83}@anchor{450}@anchor{gnat_rm/compatibility_and_porting_guide id3}@anchor{451}
@section Compatibility with Ada 83
@@ -29205,7 +29280,7 @@ following subsections treat the most likely issues to be encountered.
@end menu
@node Legal Ada 83 programs that are illegal in Ada 95,More deterministic semantics,,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{451}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{452}
+@anchor{gnat_rm/compatibility_and_porting_guide id4}@anchor{452}@anchor{gnat_rm/compatibility_and_porting_guide legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{453}
@subsection Legal Ada 83 programs that are illegal in Ada 95
@@ -29305,7 +29380,7 @@ the fix is usually simply to add the @code{(<>)} to the generic declaration.
@end itemize
@node More deterministic semantics,Changed semantics,Legal Ada 83 programs that are illegal in Ada 95,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{453}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{454}
+@anchor{gnat_rm/compatibility_and_porting_guide id5}@anchor{454}@anchor{gnat_rm/compatibility_and_porting_guide more-deterministic-semantics}@anchor{455}
@subsection More deterministic semantics
@@ -29333,7 +29408,7 @@ which open select branches are executed.
@end itemize
@node Changed semantics,Other language compatibility issues,More deterministic semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{455}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{456}
+@anchor{gnat_rm/compatibility_and_porting_guide changed-semantics}@anchor{456}@anchor{gnat_rm/compatibility_and_porting_guide id6}@anchor{457}
@subsection Changed semantics
@@ -29375,7 +29450,7 @@ covers only the restricted range.
@end itemize
@node Other language compatibility issues,,Changed semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{457}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{458}
+@anchor{gnat_rm/compatibility_and_porting_guide id7}@anchor{458}@anchor{gnat_rm/compatibility_and_porting_guide other-language-compatibility-issues}@anchor{459}
@subsection Other language compatibility issues
@@ -29408,7 +29483,7 @@ include @code{pragma Interface} and the floating point type attributes
@end itemize
@node Compatibility between Ada 95 and Ada 2005,Implementation-dependent characteristics,Compatibility with Ada 83,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{459}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{45a}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-between-ada-95-and-ada-2005}@anchor{45a}@anchor{gnat_rm/compatibility_and_porting_guide id8}@anchor{45b}
@section Compatibility between Ada 95 and Ada 2005
@@ -29480,7 +29555,7 @@ can declare a function returning a value from an anonymous access type.
@end itemize
@node Implementation-dependent characteristics,Compatibility with Other Ada Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{45b}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{45c}
+@anchor{gnat_rm/compatibility_and_porting_guide id9}@anchor{45c}@anchor{gnat_rm/compatibility_and_porting_guide implementation-dependent-characteristics}@anchor{45d}
@section Implementation-dependent characteristics
@@ -29503,7 +29578,7 @@ transition from certain Ada 83 compilers.
@end menu
@node Implementation-defined pragmas,Implementation-defined attributes,,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{45d}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{45e}
+@anchor{gnat_rm/compatibility_and_porting_guide id10}@anchor{45e}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-pragmas}@anchor{45f}
@subsection Implementation-defined pragmas
@@ -29525,7 +29600,7 @@ avoiding compiler rejection of units that contain such pragmas; they are not
relevant in a GNAT context and hence are not otherwise implemented.
@node Implementation-defined attributes,Libraries,Implementation-defined pragmas,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{45f}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{460}
+@anchor{gnat_rm/compatibility_and_porting_guide id11}@anchor{460}@anchor{gnat_rm/compatibility_and_porting_guide implementation-defined-attributes}@anchor{461}
@subsection Implementation-defined attributes
@@ -29539,7 +29614,7 @@ Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and
@code{Type_Class}.
@node Libraries,Elaboration order,Implementation-defined attributes,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{461}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{462}
+@anchor{gnat_rm/compatibility_and_porting_guide id12}@anchor{462}@anchor{gnat_rm/compatibility_and_porting_guide libraries}@anchor{463}
@subsection Libraries
@@ -29568,7 +29643,7 @@ be preferable to retrofit the application using modular types.
@end itemize
@node Elaboration order,Target-specific aspects,Libraries,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{463}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{464}
+@anchor{gnat_rm/compatibility_and_porting_guide elaboration-order}@anchor{464}@anchor{gnat_rm/compatibility_and_porting_guide id13}@anchor{465}
@subsection Elaboration order
@@ -29604,7 +29679,7 @@ pragmas either globally (as an effect of the @emph{-gnatE} switch) or locally
@end itemize
@node Target-specific aspects,,Elaboration order,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{465}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{466}
+@anchor{gnat_rm/compatibility_and_porting_guide id14}@anchor{466}@anchor{gnat_rm/compatibility_and_porting_guide target-specific-aspects}@anchor{467}
@subsection Target-specific aspects
@@ -29617,10 +29692,10 @@ on the robustness of the original design. Moreover, Ada 95 (and thus
Ada 2005 and Ada 2012) are sometimes
incompatible with typical Ada 83 compiler practices regarding implicit
packing, the meaning of the Size attribute, and the size of access values.
-GNAT’s approach to these issues is described in @ref{467,,Representation Clauses}.
+GNAT’s approach to these issues is described in @ref{468,,Representation Clauses}.
@node Compatibility with Other Ada Systems,Representation Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{468}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{469}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-other-ada-systems}@anchor{469}@anchor{gnat_rm/compatibility_and_porting_guide id15}@anchor{46a}
@section Compatibility with Other Ada Systems
@@ -29663,7 +29738,7 @@ far beyond this minimal set, as described in the next section.
@end itemize
@node Representation Clauses,Compatibility with HP Ada 83,Compatibility with Other Ada Systems,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{46a}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{467}
+@anchor{gnat_rm/compatibility_and_porting_guide id16}@anchor{46b}@anchor{gnat_rm/compatibility_and_porting_guide representation-clauses}@anchor{468}
@section Representation Clauses
@@ -29756,7 +29831,7 @@ with thin pointers.
@end itemize
@node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{46b}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{46c}
+@anchor{gnat_rm/compatibility_and_porting_guide compatibility-with-hp-ada-83}@anchor{46c}@anchor{gnat_rm/compatibility_and_porting_guide id17}@anchor{46d}
@section Compatibility with HP Ada 83
@@ -29786,7 +29861,7 @@ extension of package System.
@end itemize
@node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top
-@anchor{share/gnu_free_documentation_license doc}@anchor{46d}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{46e}
+@anchor{share/gnu_free_documentation_license doc}@anchor{46e}@anchor{share/gnu_free_documentation_license gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license gnu-free-documentation-license}@anchor{46f}
@chapter GNU Free Documentation License
diff --git a/gcc/ada/libgnat/a-except.ads b/gcc/ada/libgnat/a-except.ads
index 1608e79eee4..b6c8bb579d4 100644
--- a/gcc/ada/libgnat/a-except.ads
+++ b/gcc/ada/libgnat/a-except.ads
@@ -184,14 +184,9 @@ private
-- Raise_Exception_Always if it can determine this is the case. The Export
-- allows this routine to be accessed from Pure units.
- -- Make these callable from strub contexts.
pragma Machine_Attribute (Raise_Exception_Always,
"strub", "callable");
- pragma Machine_Attribute (Raise_Exception,
- "strub", "callable");
- -- This property should arguably be visible to callers, but let's
- -- keep it private for now. In practice, it doesn't matter, since
- -- it's only checked in the back end.
+ -- Make it callable from strub contexts
procedure Raise_From_Controlled_Operation (X : Exception_Occurrence);
pragma No_Return (Raise_From_Controlled_Operation);
diff --git a/gcc/ada/libgnat/s-arit128.ads b/gcc/ada/libgnat/s-arit128.ads
index fa6fedcbc11..6213cfb569a 100644
--- a/gcc/ada/libgnat/s-arit128.ads
+++ b/gcc/ada/libgnat/s-arit128.ads
@@ -81,11 +81,4 @@ package System.Arith_128 is
-- then Q is the rounded quotient. The remainder R is not affected by the
-- setting of the Round flag.
-private
- -- Make it callable from strub contexts.
- -- There is a matching setting in trans.c,
- -- for calls issued by Gigi.
- pragma Machine_Attribute (Multiply_With_Ovflo_Check128,
- "strub", "callable");
-
end System.Arith_128;
diff --git a/gcc/ada/libgnat/s-arit64.ads b/gcc/ada/libgnat/s-arit64.ads
index 68d21494809..c9141f5fe3e 100644
--- a/gcc/ada/libgnat/s-arit64.ads
+++ b/gcc/ada/libgnat/s-arit64.ads
@@ -93,11 +93,4 @@ package System.Arith_64 is
Round : Boolean) renames Double_Divide64;
-- Renamed procedure to preserve compatibility with earlier versions
-private
- -- Make it callable from strub contexts.
- -- There is a matching setting in trans.c,
- -- for calls issued by Gigi.
- pragma Machine_Attribute (Multiply_With_Ovflo_Check64,
- "strub", "callable");
-
end System.Arith_64;
diff --git a/gcc/ada/libgnat/s-secsta.ads b/gcc/ada/libgnat/s-secsta.ads
index 6648c233d4c..7d6b1b9a90e 100644
--- a/gcc/ada/libgnat/s-secsta.ads
+++ b/gcc/ada/libgnat/s-secsta.ads
@@ -440,9 +440,4 @@ private
function Get_Stack_Info (Stack : SS_Stack_Ptr) return Stack_Info;
-- Obtain the information attributes of secondary stack Stack
- pragma Machine_Attribute (SS_Allocate, "strub", "callable");
- pragma Machine_Attribute (SS_Mark, "strub", "callable");
- pragma Machine_Attribute (SS_Release, "strub", "callable");
- -- Enable these to be called from within strub contexts.
-
end System.Secondary_Stack;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index e1ee09e5500..2575ddfe86d 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -74,6 +74,7 @@ with Sinfo.Utils; use Sinfo.Utils;
with Sinput; use Sinput;
with System;
with Stringt; use Stringt;
+with Strub; use Strub;
with Style;
with Stylesw; use Stylesw;
with Targparm; use Targparm;
@@ -11294,6 +11295,27 @@ package body Sem_Attr is
Resolve (P);
end if;
+ -- Refuse to compute access to variables and constants when that
+ -- would drop the strub mode associated with them, unless they're
+ -- unchecked conversions. We don't have to do this when the types
+ -- of the data objects are annotated: then the access type
+ -- designates the annotated type, and there's no loss. Only when
+ -- the variable is annotated directly that the pragma gets
+ -- attached to the variable, rather than to its type, and then,
+ -- expressing an access-to-annotated-type type to hold the 'Access
+ -- result is not possible without resorting to that very annotated
+ -- type.
+
+ if Attr_Id /= Attribute_Unchecked_Access
+ and then Comes_From_Source (N)
+ and then Is_Entity_Name (P)
+ and then Explicit_Strub_Mode (Entity (P)) = Enabled
+ and then
+ Explicit_Strub_Mode (Designated_Type (Btyp)) = Unspecified
+ then
+ Error_Msg_F ("target access type drops `strub` mode from &", P);
+ end if;
+
-- X'Access is illegal if X denotes a constant and the access type
-- is access-to-variable. Same for 'Unchecked_Access. The rule
-- does not apply to 'Unrestricted_Access. If the reference is a
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e24ca8c6ce8..e854bb3eee9 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -79,6 +79,7 @@ with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
with Sinput; use Sinput;
with Snames; use Snames;
+with Strub; use Strub;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
@@ -16065,6 +16066,8 @@ package body Sem_Ch3 is
Set_Alias (New_Subp, Actual_Subp);
end if;
+ Copy_Strub_Mode (New_Subp, Alias (New_Subp));
+
-- Derived subprograms of a tagged type must inherit the convention
-- of the parent subprogram (a requirement of AI-117). Derived
-- subprograms of untagged types simply get convention Ada by default.
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1c048145bb4..f50f440d3a8 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -84,6 +84,7 @@ with Sinfo.Utils; use Sinfo.Utils;
with Sinfo.CN; use Sinfo.CN;
with Sinput; use Sinput;
with Stringt; use Stringt;
+with Strub; use Strub;
with Stylesw; use Stylesw;
with Table;
with Targparm; use Targparm;
@@ -19446,7 +19447,29 @@ package body Sem_Prag is
Check_Arg_Is_OK_Static_Expression (Arg2, Standard_String);
Def_Id := Entity (Get_Pragma_Arg (Arg1));
- if Is_Access_Type (Def_Id) then
+ -- Apply the pragma to the designated type, rather than to the
+ -- access type, unless it's a strub annotation. We wish to enable
+ -- objects of access type, as well as access types themselves, to
+ -- be annotated, so that reading the access objects (as oposed to
+ -- the designated data) automatically enables stack
+ -- scrubbing. That said, as in the attribute handler that
+ -- processes the pragma turned into a compiler attribute, a strub
+ -- annotation that must be associated with a subprogram type (for
+ -- holding an explicit strub mode), when applied to an
+ -- access-to-subprogram, gets promoted to the subprogram type. We
+ -- might be tempted to leave it alone here, since the C attribute
+ -- handler will adjust it, but then GNAT would convert the
+ -- annotated subprogram types to naked ones before using them,
+ -- cancelling out their intended effects.
+
+ if Is_Access_Type (Def_Id)
+ and then (not Strub_Pragma_P (N)
+ or else
+ (Present (Arg3)
+ and then
+ Ekind (Designated_Type
+ (Def_Id)) = E_Subprogram_Type))
+ then
Def_Id := Designated_Type (Def_Id);
end if;
@@ -19464,7 +19487,7 @@ package body Sem_Prag is
if Rep_Item_Too_Late (Def_Id, N) then
return;
else
- Set_Has_Gigi_Rep_Item (Entity (Get_Pragma_Arg (Arg1)));
+ Set_Has_Gigi_Rep_Item (Def_Id);
end if;
end Machine_Attribute;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 09a76f19930..ac262facfec 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -82,6 +82,7 @@ with Sinfo.CN; use Sinfo.CN;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
+with Strub; use Strub;
with Style; use Style;
with Targparm; use Targparm;
with Tbuild; use Tbuild;
@@ -3179,6 +3180,27 @@ package body Sem_Res is
-- Only one interpretation
else
+ -- Prevent implicit conversions between access-to-subprogram types
+ -- with different strub modes. Explicit conversions are acceptable in
+ -- some circumstances. We don't have to be concerned about data or
+ -- access-to-data types. Conversions between data types can safely
+ -- drop or add strub attributes from types, because strub effects are
+ -- associated with the locations rather than values. E.g., converting
+ -- a hypothetical Strub_Integer variable to Integer would load the
+ -- value from the variable, enabling stack scrabbing for the
+ -- enclosing subprogram, and then convert the value to Integer. As
+ -- for conversions between access-to-data types, that's no different
+ -- from any other case of type punning.
+
+ if Is_Access_Type (Typ)
+ and then Ekind (Designated_Type (Typ)) = E_Subprogram_Type
+ and then Is_Access_Type (Expr_Type)
+ and then Ekind (Designated_Type (Expr_Type)) = E_Subprogram_Type
+ then
+ Check_Same_Strub_Mode
+ (Designated_Type (Typ), Designated_Type (Expr_Type));
+ end if;
+
-- In Ada 2005, if we have something like "X : T := 2 + 2;", where
-- the "+" on T is abstract, and the operands are of universal type,
-- the above code will have (incorrectly) resolved the "+" to the
@@ -14154,7 +14176,15 @@ package body Sem_Res is
end;
end if;
- return True;
+ -- Check that the strub modes are compatible.
+ -- We wish to reject explicit conversions only for
+ -- incompatible modes.
+
+ return Conversion_Check
+ (Compatible_Strub_Modes
+ (Designated_Type (Target_Type),
+ Designated_Type (Opnd_Type)),
+ "incompatible `strub` modes");
-- Remote access to subprogram types
@@ -14180,7 +14210,16 @@ package body Sem_Res is
Designated_Type (Corresponding_Remote_Type (Opnd_Type)),
Err_Loc =>
N);
- return True;
+
+ -- Check that the strub modes are compatible.
+ -- We wish to reject explicit conversions only for
+ -- incompatible modes.
+
+ return Conversion_Check
+ (Compatible_Strub_Modes
+ (Designated_Type (Target_Type),
+ Designated_Type (Opnd_Type)),
+ "incompatible `strub` modes");
-- If it was legal in the generic, it's legal in the instance
diff --git a/gcc/ada/strub.adb b/gcc/ada/strub.adb
new file mode 100644
index 00000000000..84146580b02
--- /dev/null
+++ b/gcc/ada/strub.adb
@@ -0,0 +1,301 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S T R U B --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2021, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Package containing utility procedures related to Stack Scrubbing
+
+with Atree; use Atree;
+with Einfo; use Einfo;
+with Einfo.Entities; use Einfo.Entities;
+with Errout; use Errout;
+with Namet; use Namet;
+with Nlists; use Nlists;
+with Sem_Eval; use Sem_Eval;
+with Sinfo; use Sinfo;
+with Sinfo.Nodes; use Sinfo.Nodes;
+with Sinfo.Utils; use Sinfo.Utils;
+with Snames; use Snames;
+with Stringt; use Stringt;
+
+package body Strub is
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+
+ function Find_Explicit_Strub_Pragma (Id : Entity_Id) return Node_Id;
+ -- Return a pragma Machine_Attribute (Id, "strub"[, "mode"]) node
+ -- if Id has one.
+
+ function Strub_Pragma_Arg (Item : Node_Id) return Node_Id is
+ (Get_Pragma_Arg
+ (Next (Next (First (Pragma_Argument_Associations (Item))))));
+ -- Return the pragma argument holding the strub mode associated
+ -- with Item, a subprogram, variable, constant, or type. Bear in
+ -- mind that strub pragmas with an explicit strub mode argument,
+ -- naming access-to-subprogram types, are applied to the
+ -- designated subprogram type.
+
+ function Strub_Pragma_Arg_To_String (Item : Node_Id) return String is
+ (To_String (Strval (Expr_Value_S (Item))));
+ -- Extract and return as a String the strub mode held in a node
+ -- returned by Strub_Pragma_Arg.
+
+ function Strub_Pragma_Mode
+ (Id : Entity_Id;
+ Item : Node_Id) return Strub_Mode;
+ -- Return the strub mode associated with Item expressed in Id.
+ -- Strub_Pragma_P (Id) must hold.
+
+ ---------------------------
+ -- Check_Same_Strub_Mode --
+ ---------------------------
+
+ procedure Check_Same_Strub_Mode
+ (Dest, Src : Entity_Id;
+ Report : Boolean := True)
+ is
+ Src_Strub_Mode : constant Strub_Mode := Explicit_Strub_Mode (Src);
+ Dest_Strub_Mode : constant Strub_Mode := Explicit_Strub_Mode (Dest);
+
+ begin
+ if Dest_Strub_Mode = Src_Strub_Mode then
+ return;
+ end if;
+
+ -- Internal is not part of the interface, it's an *internal*
+ -- implementation detail, so consider it equivalent to unspecified here.
+ -- ??? -fstrub=relaxed|strict makes them interface-equivalent to
+ -- Callable or Disabled, respectively, but we don't look at that flag in
+ -- the front-end, and it seems undesirable for that flag to affect
+ -- whether specifications are conformant. Maybe there should be some
+ -- means to specify Callable or Disabled along with Internal?
+
+ if Dest_Strub_Mode in Unspecified | Internal
+ and then Src_Strub_Mode in Unspecified | Internal
+ then
+ return;
+ end if;
+
+ if not Report then
+ return;
+ end if;
+
+ if Src_Strub_Mode /= Unspecified then
+ Error_Msg_Sloc := Sloc (Find_Explicit_Strub_Pragma (Src));
+ else
+ Error_Msg_Sloc := Sloc (Src);
+ end if;
+ Error_Msg_Node_2 := Src;
+ Error_Msg_NE ("& requires the same `strub` mode as &#",
+ (if Dest_Strub_Mode /= Unspecified
+ then Find_Explicit_Strub_Pragma (Dest)
+ else Dest),
+ Dest);
+ end Check_Same_Strub_Mode;
+
+ ----------------------------
+ -- Compatible_Strub_Modes --
+ ----------------------------
+
+ function Compatible_Strub_Modes
+ (Dest, Src : Entity_Id) return Boolean
+ is
+ Src_Strub_Mode : constant Strub_Mode := Explicit_Strub_Mode (Src);
+ Dest_Strub_Mode : constant Strub_Mode := Explicit_Strub_Mode (Dest);
+
+ begin
+ return Src_Strub_Mode = Dest_Strub_Mode
+ or else At_Calls not in Src_Strub_Mode | Dest_Strub_Mode;
+ end Compatible_Strub_Modes;
+
+ ---------------------
+ -- Copy_Strub_Mode --
+ ---------------------
+
+ procedure Copy_Strub_Mode (Dest, Src : Entity_Id) is
+ Strub : Node_Id := Find_Explicit_Strub_Pragma (Src);
+ Src_Strub_Mode : constant Strub_Mode := Strub_Pragma_Mode (Src, Strub);
+
+ begin
+ pragma Assert (Explicit_Strub_Mode (Dest) = Unspecified);
+
+ -- Refrain from copying Internal to subprogram types.
+ -- It affects code generation for the subprogram,
+ -- but it has no effect on its type or interface.
+
+ if Src_Strub_Mode = Unspecified
+ or else (Ekind (Dest) = E_Subprogram_Type
+ and then Src_Strub_Mode = Internal)
+ then
+ return;
+ end if;
+
+ Strub := New_Copy (Strub);
+ Set_Next_Rep_Item (Strub, First_Rep_Item (Dest));
+ Set_First_Rep_Item (Dest, Strub);
+ Set_Has_Gigi_Rep_Item (Dest);
+ end Copy_Strub_Mode;
+
+ -------------------------
+ -- Explicit_Strub_Mode --
+ -------------------------
+
+ function Explicit_Strub_Mode (Id : Entity_Id) return Strub_Mode is
+ Item : constant Node_Id := Find_Explicit_Strub_Pragma (Id);
+
+ begin
+ return Strub_Pragma_Mode (Id, Item);
+ end Explicit_Strub_Mode;
+
+ --------------------------------
+ -- Find_Explicit_Strub_Pragma --
+ --------------------------------
+
+ function Find_Explicit_Strub_Pragma (Id : Entity_Id) return Node_Id is
+ Item : Node_Id;
+
+ begin
+ if not Has_Gigi_Rep_Item (Id) then
+ return Empty;
+ end if;
+
+ Item := First_Rep_Item (Id);
+ while Present (Item) loop
+ if Strub_Pragma_P (Item) then
+ return Item;
+ end if;
+ Item := Next_Rep_Item (Item);
+ end loop;
+
+ return Empty;
+ end Find_Explicit_Strub_Pragma;
+
+ -----------------------
+ -- Strub_Pragma_Mode --
+ -----------------------
+
+ function Strub_Pragma_Mode
+ (Id : Entity_Id;
+ Item : Node_Id) return Strub_Mode
+ is
+ Arg : Node_Id := Empty;
+
+ begin
+ -- ??? Enumeration literals, despite being conceptually functions, have
+ -- neither bodies nor stack frames, and it's not clear whether it would
+ -- make more sense to treat them as subprograms or as constants, but
+ -- they can be renamed as functions. Should we require all literals of
+ -- a type to have the same strub mode? Rule out their annotation?
+
+ if Ekind (Id) in E_Subprogram_Type
+ | Overloadable_Kind
+ | Generic_Subprogram_Kind
+ then
+ if Item = Empty then
+ return Unspecified;
+ end if;
+
+ Arg := Strub_Pragma_Arg (Item);
+ if Arg = Empty then
+ return At_Calls;
+ end if;
+
+ declare
+ Str : constant String := Strub_Pragma_Arg_To_String (Arg);
+ begin
+ if Str'Length /= 8 then
+ return Unspecified;
+ end if;
+
+ case Str (Str'First) is
+ when 'a' =>
+ if Str = "at-calls" then
+ return At_Calls;
+ end if;
+
+ when 'i' =>
+ if Str = "internal" then
+ return Internal;
+ end if;
+
+ when 'c' =>
+ if Str = "callable" then
+ return Callable;
+ end if;
+
+ when 'd' =>
+ if Str = "disabled" then
+ return Disabled;
+ end if;
+
+ when others =>
+ null;
+ end case;
+ return Unspecified;
+ end;
+
+ -- Access-to-subprogram types and variables can be treated just like
+ -- other access types, because the pragma logic has already promoted to
+ -- subprogram types any annotations applicable to them.
+
+ elsif Ekind (Id) in Type_Kind -- except E_Subprogram_Type, covered above
+ | Scalar_Kind
+ | Object_Kind
+ | Named_Kind
+ then
+ if Item = Empty then
+ return Unspecified;
+ end if;
+
+ Arg := Strub_Pragma_Arg (Item);
+ if Arg /= Empty then
+ -- A strub parameter is not applicable to variables,
+ -- and will be ignored.
+
+ return Unspecified;
+ end if;
+
+ return Enabled;
+
+ else
+ pragma Assert (Item = Empty);
+ return Not_Applicable;
+ end if;
+ end Strub_Pragma_Mode;
+
+ --------------------
+ -- Strub_Pragma_P --
+ --------------------
+
+ function Strub_Pragma_P
+ (Item : Node_Id) return Boolean is
+ (Nkind (Item) = N_Pragma
+ and then Pragma_Name (Item) = Name_Machine_Attribute
+ and then
+ Strub_Pragma_Arg_To_String
+ (Get_Pragma_Arg
+ (Next (First (Pragma_Argument_Associations (Item)))))
+ = "strub");
+
+end Strub;
diff --git a/gcc/ada/strub.ads b/gcc/ada/strub.ads
new file mode 100644
index 00000000000..2753dd0fa5b
--- /dev/null
+++ b/gcc/ada/strub.ads
@@ -0,0 +1,115 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S T R U B --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2021, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Package containing utility procedures related to Stack Scrubbing
+
+with Types; use Types;
+
+package Strub is
+ type Strub_Mode is
+ (Disabled, -- Subprogram cannot be called from strub contexts
+ At_Calls, -- Subprogram strubbed by caller
+ Internal, -- Subprogram strubbed by wrapper
+ Callable, -- Subprogram safe to call despite no strub
+ Unspecified, -- Subprogram or data without strub annotation
+ Enabled, -- Data (variable or constant) that enables strub
+ Not_Applicable); -- Entities that are not strub-capable
+ -- This is the type that expresses decoded strub annotations
+
+ -- We compare strub modes in the following circumstances:
+
+ -- * subprogram definition vs specification
+ -- * overriding vs overridden dispatch subprograms
+ -- * implementation vs interface dispatch subprogram
+ -- * renaming vs renamed subprogram
+ -- * type resolution
+ -- * explicit conversions
+
+ -- Explicit conversions can convert between strub modes other than
+ -- at-calls (see Compatible_Strub_Modes), but for the other cases
+ -- above, we insist on identity of the strub modes (see
+ -- Check_Same_Strub_Mode). Anything else would be
+ -- troublesome.
+
+ -- E.g., overriding a callable subprogram with a strub-disabled
+ -- implementation would enable a subprogram that's unsafe to call
+ -- in strub contexts to be called through a dispatching
+ -- interface. An explicitly strub-disabled subprogram shall not be
+ -- called from strub contexts, and a callable overriding
+ -- subprogram would still seem not-callable, so accepting
+ -- different modes would be surprising.
+
+ -- We could relax the requirement for overriders from equality to
+ -- compatibility, with the understanding that the dispatching ABI
+ -- is what prevails. For renaming, however, if we don't require
+ -- equality, it would have to encompass an implicit conversion.
+
+ procedure Check_Same_Strub_Mode
+ (Dest, Src : Entity_Id;
+ Report : Boolean := True);
+ -- Check whether Dest and Src are subprograms or subprogram types
+ -- annotated (or not) with the same strub mode. If Report is
+ -- requested, and the strub modes are not equivalent, an error
+ -- message is issued. Unspecified and Internal are considered
+ -- equivalent, because Internal is an internal implementation
+ -- detail. Unspecified decays to Disabled or Callable depending on
+ -- -fstrub=(strict|relaxed), but this procedure does not take this
+ -- decay into account, which avoids turning strub-equivalent
+ -- declarations into incompatible ones at command-line changes.
+
+ function Compatible_Strub_Modes
+ (Dest, Src : Entity_Id) return Boolean;
+ -- Return True if Dest and Src are subprograms or subprogram types
+ -- annotated (or not) with ABI-compatible strub modes. At-calls is
+ -- incompatible to other strub modes, because the back end
+ -- internally modifies the signature of such subprograms, adding
+ -- hidden parameters. Calling a subprogram through an
+ -- access-to-subprogram object converted between strub-at-calls
+ -- and other strub modes should be deemed equivalent to
+ -- dereferencing an uninitialized access-to-data object, though
+ -- one-way conversions might seem to work in some circumstances.
+ --
+ -- Unspecified, Disabled, Internal and Callable
+ -- (access-to-)subprograms, on the other hand, can be safely but
+ -- explicitly converted to each other, because these strub modes
+ -- do not require signature changes; so it is possible to alter
+ -- the caller-side stack scrubbing semantics of the call (e.g. to
+ -- call a subprogram that isn't strub-callable from within a strub
+ -- context, or to prevent it from being called through an access
+ -- object) without any incompatibilities.
+
+ procedure Copy_Strub_Mode (Dest, Src : Entity_Id);
+ -- Copy the strub mode from Src to Dest, subprograms or subprogram
+ -- types. Dest is required to not have a strub mode already set.
+
+ function Explicit_Strub_Mode (Id : Entity_Id) return Strub_Mode;
+ -- Return the strub mode associated with Id, that should refer to
+ -- a subprogram, a data object, or a type.
+
+ function Strub_Pragma_P (Item : Node_Id) return Boolean;
+ -- Return True iff Item is a strub annotation, specifically, one
+ -- introduced by pragma Machine_Attribute (Entity, "strub"[, "mode"]).
+
+end Strub;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-11-09 9:47 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-11-09 9:47 [gcc r12-5036] [Ada] Improve integration of strub with type systems Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).