From: Alexandre Oliva <ol...@adacore.com>
Mark exception-raising subprograms with expected_throw attribute.
Document the use of the attribute in Control Flow Redundancy.
Enable marking subprograms as expected_throw with Machine_Attribute
pragmas.
gcc/ada/
* libgnat/a-except.ads (Raise_Exception): Mark expected_throw.
(Reraise_Occurrence): Likewise.
(Raise_Exception_Always): Likewise.
(Raise_From_Controlled_Operation): Likewise.
(Reraise_Occurrence_Always): Likewise.
(Reraise_Occurrence_No_Defer): Likewise.
* libgnat/a-except.adb
(Exception_Propagation.Propagate_Exception): Likewise.
(Complete_And_Propagate_Occurrence): Likewise.
(Raise_Exception_No_Defer): Likewise.
(Raise_From_Signal_Handler): Likewise.
(Raise_With_Msg): Likewise.
(Raise_With_Location_And_Msg): Likewise.
(Raise_Constraint_Error): Likewise.
(Raise_Constraint_Error_Msg): Likewise.
(Raise_Program_Error): Likewise.
(Raise_Program_Error_Msg): Likewise.
(Raise_Storage_Error): Likewise.
(Raise_Storage_Error_Msg): Likewise.
(Reraise, Rcheck_*): Likewise.
* doc/gnat_rm/security_hardening_features.rst (Control Flow
Hardening): Note the influence of expected_throw.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
* gcc-interface/utils.cc (handle_expected_throw_attribute): New.
(gnat_internal_attribute_table): Add expected_throw.
Tested on x86_64-pc-linux-gnu, committed on master.
---
.../gnat_rm/security_hardening_features.rst | 4 +-
gcc/ada/gcc-interface/utils.cc | 19 ++++
gcc/ada/gnat_rm.texi | 6 +-
gcc/ada/gnat_ugn.texi | 4 +-
gcc/ada/libgnat/a-except.adb | 104 ++++++++++++++++++
gcc/ada/libgnat/a-except.ads | 14 +++
6 files changed, 146 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/security_hardening_features.rst
b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
index e057af2ea12..015b9ce3533 100644
--- a/gcc/ada/doc/gnat_rm/security_hardening_features.rst
+++ b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
@@ -500,7 +500,9 @@ gets modified as follows:
Verification may also be performed before No_Return calls, whether all
of them, with :switch:`-fhardcfr-check-noreturn-calls=always`; all but
-internal subprograms involved in exception-raising or -reraising, with
+internal subprograms involved in exception-raising or -reraising or
+subprograms explicitly marked with both :samp:`No_Return` and
+:samp:`Machine_Attribute` :samp:`expected_throw` pragmas, with
:switch:`-fhardcfr-check-noreturn-calls=no-xthrow` (default); only
nothrow ones, with :switch:`-fhardcfr-check-noreturn-calls=nothrow`;
or none, with :switch:`-fhardcfr-check-noreturn-calls=never`.
diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc
index 8f1861b848e..d0a13d2af33 100644
--- a/gcc/ada/gcc-interface/utils.cc
+++ b/gcc/ada/gcc-interface/utils.cc
@@ -87,6 +87,7 @@ tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
/* Forward declarations for handlers of attributes. */
static tree handle_const_attribute (tree *, tree, tree, int, bool *);
static tree handle_nothrow_attribute (tree *, tree, tree, int, bool *);
+static tree handle_expected_throw_attribute (tree *, tree, tree, int, bool *);
static tree handle_pure_attribute (tree *, tree, tree, int, bool *);
static tree handle_novops_attribute (tree *, tree, tree, int, bool *);
static tree handle_nonnull_attribute (tree *, tree, tree, int, bool *);
@@ -143,6 +144,8 @@ const struct attribute_spec gnat_internal_attribute_table[]
=
handle_const_attribute, NULL },
{ "nothrow", 0, 0, true, false, false, false,
handle_nothrow_attribute, NULL },
+ { "expected_throw", 0, 0, true, false, false, false,
+ handle_expected_throw_attribute, NULL },
{ "pure", 0, 0, true, false, false, false,
handle_pure_attribute, NULL },
{ "no vops", 0, 0, true, false, false, false,
@@ -6379,6 +6382,22 @@ handle_nothrow_attribute (tree *node, tree ARG_UNUSED
(name),
return NULL_TREE;
}
+/* Handle a "expected_throw" attribute; arguments as in
+ struct attribute_spec.handler. */
+
+static tree
+handle_expected_throw_attribute (tree *node, tree ARG_UNUSED (name),
+ tree ARG_UNUSED (args), int ARG_UNUSED (flags),
+ bool *no_add_attrs)
+{
+ if (TREE_CODE (*node) == FUNCTION_DECL)
+ /* No flag to set here. */;
+ else
+ *no_add_attrs = true;
+
+ return NULL_TREE;
+}
+
/* Handle a "pure" attribute; arguments as in
struct attribute_spec.handler. */
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 066c066d19d..b7e098331e9 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Reference Manual , Jul 10, 2023
+GNAT Reference Manual , Jul 17, 2023
AdaCore
@@ -29666,7 +29666,9 @@ end;
Verification may also be performed before No_Return calls, whether all
of them, with @code{-fhardcfr-check-noreturn-calls=always}; all but
-internal subprograms involved in exception-raising or -reraising, with
+internal subprograms involved in exception-raising or -reraising or
+subprograms explicitly marked with both @code{No_Return} and
+@code{Machine_Attribute} @code{expected_throw} pragmas, with
@code{-fhardcfr-check-noreturn-calls=no-xthrow} (default); only
nothrow ones, with @code{-fhardcfr-check-noreturn-calls=nothrow};
or none, with @code{-fhardcfr-check-noreturn-calls=never}.
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 2721251c4e4..78f9b87a82e 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT User's Guide for Native Platforms , Jul 10, 2023
+GNAT User's Guide for Native Platforms , Jul 17, 2023
AdaCore
@@ -29531,8 +29531,8 @@ to permit their use in free software.
@printindex ge
-@anchor{d1}@w{ }
@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{
}
+@anchor{d1}@w{ }
@c %**end of body
@bye
diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb
index 20a773661ae..dd5edaf1a9c 100644
--- a/gcc/ada/libgnat/a-except.adb
+++ b/gcc/ada/libgnat/a-except.adb
@@ -229,6 +229,7 @@ package body Ada.Exceptions is
procedure Propagate_Exception (Excep : Exception_Occurrence);
pragma No_Return (Propagate_Exception);
+ pragma Machine_Attribute (Propagate_Exception, "expected_throw");
-- This procedure propagates the exception represented by Excep
end Exception_Propagation;
@@ -256,6 +257,8 @@ package body Ada.Exceptions is
procedure Complete_And_Propagate_Occurrence (X : EOA);
pragma No_Return (Complete_And_Propagate_Occurrence);
+ pragma Machine_Attribute (Complete_And_Propagate_Occurrence,
+ "expected_throw");
-- This is a simple wrapper to Complete_Occurrence and
-- Exception_Propagation.Propagate_Exception.
@@ -280,6 +283,7 @@ package body Ada.Exceptions is
(Ada, Raise_Exception_No_Defer,
"ada__exceptions__raise_exception_no_defer");
pragma No_Return (Raise_Exception_No_Defer);
+ pragma Machine_Attribute (Raise_Exception_No_Defer, "expected_throw");
-- Similar to Raise_Exception, but with no abort deferral
procedure Raise_From_Signal_Handler
@@ -288,6 +292,7 @@ package body Ada.Exceptions is
pragma Export
(C, Raise_From_Signal_Handler, "__gnat_raise_from_signal_handler");
pragma No_Return (Raise_From_Signal_Handler);
+ pragma Machine_Attribute (Raise_From_Signal_Handler, "expected_throw");
-- This routine is used to raise an exception from a signal handler. The
-- signal handler has already stored the machine state (i.e. the state that
-- corresponds to the location at which the signal was raised). E is the
@@ -301,6 +306,7 @@ package body Ada.Exceptions is
procedure Raise_With_Msg (E : Exception_Id);
pragma No_Return (Raise_With_Msg);
+ pragma Machine_Attribute (Raise_With_Msg, "expected_throw");
pragma Export (C, Raise_With_Msg, "__gnat_raise_with_msg");
-- Raises an exception with given exception id value. A message
-- is associated with the raise, and has already been stored in the
@@ -314,6 +320,7 @@ package body Ada.Exceptions is
C : Integer := 0;
M : System.Address := System.Null_Address);
pragma No_Return (Raise_With_Location_And_Msg);
+ pragma Machine_Attribute (Raise_With_Location_And_Msg, "expected_throw");
-- Raise an exception with given exception id value. A filename and line
-- number is associated with the raise and is stored in the exception
-- occurrence and in addition a column and a string message M may be
@@ -321,6 +328,7 @@ package body Ada.Exceptions is
procedure Raise_Constraint_Error (File : System.Address; Line : Integer);
pragma No_Return (Raise_Constraint_Error);
+ pragma Machine_Attribute (Raise_Constraint_Error, "expected_throw");
pragma Export (C, Raise_Constraint_Error, "__gnat_raise_constraint_error");
-- Raise constraint error with file:line information
@@ -330,12 +338,14 @@ package body Ada.Exceptions is
Column : Integer;
Msg : System.Address);
pragma No_Return (Raise_Constraint_Error_Msg);
+ pragma Machine_Attribute (Raise_Constraint_Error_Msg, "expected_throw");
pragma Export
(C, Raise_Constraint_Error_Msg, "__gnat_raise_constraint_error_msg");
-- Raise constraint error with file:line:col + msg information
procedure Raise_Program_Error (File : System.Address; Line : Integer);
pragma No_Return (Raise_Program_Error);
+ pragma Machine_Attribute (Raise_Program_Error, "expected_throw");
pragma Export (C, Raise_Program_Error, "__gnat_raise_program_error");
-- Raise program error with file:line information
@@ -344,12 +354,14 @@ package body Ada.Exceptions is
Line : Integer;
Msg : System.Address);
pragma No_Return (Raise_Program_Error_Msg);
+ pragma Machine_Attribute (Raise_Program_Error_Msg, "expected_throw");
pragma Export
(C, Raise_Program_Error_Msg, "__gnat_raise_program_error_msg");
-- Raise program error with file:line + msg information
procedure Raise_Storage_Error (File : System.Address; Line : Integer);
pragma No_Return (Raise_Storage_Error);
+ pragma Machine_Attribute (Raise_Storage_Error, "expected_throw");
pragma Export (C, Raise_Storage_Error, "__gnat_raise_storage_error");
-- Raise storage error with file:line information
@@ -358,6 +370,7 @@ package body Ada.Exceptions is
Line : Integer;
Msg : System.Address);
pragma No_Return (Raise_Storage_Error_Msg);
+ pragma Machine_Attribute (Raise_Storage_Error_Msg, "expected_throw");
pragma Export
(C, Raise_Storage_Error_Msg, "__gnat_raise_storage_error_msg");
-- Raise storage error with file:line + reason msg information
@@ -385,6 +398,7 @@ package body Ada.Exceptions is
procedure Reraise;
pragma No_Return (Reraise);
+ pragma Machine_Attribute (Reraise, "expected_throw");
pragma Export (C, Reraise, "__gnat_reraise");
-- Reraises the exception referenced by the Current_Excep field
-- of the TSD (all fields of this exception occurrence are set).
@@ -632,6 +646,96 @@ package body Ada.Exceptions is
pragma No_Return (Rcheck_CE_Invalid_Data_Ext);
pragma No_Return (Rcheck_CE_Range_Check_Ext);
+ -- These procedures are all expected to raise an exception.
+ -- These attributes are not visible to callers; they are made
+ -- visible in trans.c:build_raise_check.
+
+ pragma Machine_Attribute (Rcheck_CE_Access_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Null_Access_Parameter,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Discriminant_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Divide_By_Zero,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Explicit_Raise,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Index_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Invalid_Data,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Length_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Null_Exception_Id,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Null_Not_Allowed,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Overflow_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Partition_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Range_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Tag_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Access_Before_Elaboration,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Accessibility_Check,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Address_Of_Intrinsic,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Aliased_Parameters,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_All_Guards_Closed,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Bad_Predicated_Generic_Type,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Build_In_Place_Mismatch,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Current_Task_In_Entry_Body,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Duplicated_Entry_Address,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Explicit_Raise,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Implicit_Return,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Misaligned_Address_Value,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Missing_Return,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Non_Transportable_Actual,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Overlaid_Controlled_Object,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Potentially_Blocking_Operation,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Stream_Operation_Not_Allowed,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Stubbed_Subprogram_Called,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Unchecked_Union_Restriction,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_PE_Finalize_Raised_Exception,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_SE_Empty_Storage_Pool,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_SE_Explicit_Raise,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_SE_Infinite_Recursion,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_SE_Object_Too_Large,
+ "expected_throw");
+
+ pragma Machine_Attribute (Rcheck_CE_Access_Check_Ext,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Index_Check_Ext,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Invalid_Data_Ext,
+ "expected_throw");
+ pragma Machine_Attribute (Rcheck_CE_Range_Check_Ext,
+ "expected_throw");
+
-- Make all of these procedures callable from strub contexts.
-- These attributes are not visible to callers; they are made
-- visible in trans.c:build_raise_check.
diff --git a/gcc/ada/libgnat/a-except.ads b/gcc/ada/libgnat/a-except.ads
index 7949b5907b6..5583bf5504d 100644
--- a/gcc/ada/libgnat/a-except.ads
+++ b/gcc/ada/libgnat/a-except.ads
@@ -163,6 +163,14 @@ private
Null_Id : constant Exception_Id := null;
+ pragma Machine_Attribute (Raise_Exception, "expected_throw");
+ pragma Machine_Attribute (Reraise_Occurrence, "expected_throw");
+ -- Tell the compiler that an exception is likely after calling
+ -- these subprograms. This could eventually be used for hot/cold
+ -- partitioning. For now, this only enables the control flow
+ -- redundancy to avoid duplicating a check before the No_Return
+ -- call and in the exception handler for the call.
+
-------------------------
-- Private Subprograms --
-------------------------
@@ -177,6 +185,7 @@ private
procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
pragma No_Return (Raise_Exception_Always);
+ pragma Machine_Attribute (Raise_Exception_Always, "expected_throw");
pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");
-- This differs from Raise_Exception only in that the caller has determined
-- that for sure the parameter E is not null, and that therefore no check
@@ -195,6 +204,9 @@ private
"__gnat_raise_from_controlled_operation");
-- Raise Program_Error, providing information about X (an exception raised
-- during a controlled operation) in the exception message.
+ pragma Machine_Attribute (Raise_From_Controlled_Operation,
+ "expected_throw");
+ -- Mark it like internal exception-raising subprograms
procedure Reraise_Library_Exception_If_Any;
pragma Export
@@ -205,6 +217,7 @@ private
procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
pragma No_Return (Reraise_Occurrence_Always);
+ pragma Machine_Attribute (Reraise_Occurrence_Always, "expected_throw");
-- This differs from Raise_Occurrence only in that the caller guarantees
-- that for sure the parameter X is not the null occurrence, and that
-- therefore this procedure cannot return. The expander uses this routine
@@ -212,6 +225,7 @@ private
procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence);
pragma No_Return (Reraise_Occurrence_No_Defer);
+ pragma Machine_Attribute (Reraise_Occurrence_No_Defer, "expected_throw");
-- Exactly like Reraise_Occurrence, except that abort is not deferred
-- before the call and the parameter X is known not to be the null
-- occurrence. This is used in generated code when it is known that abort
--
2.40.0
