This is necessary for vector builtins, which are picky about the signedness of
the element type.
Tested on x86-64/Linux, applied on the mainline.
2021-09-14 Eric Botcazou <ebotca...@adacore.com>
* libgnat/s-atopri.ads (bool): Delete.
(Atomic_Test_And_Set): Replace bool with Boolean.
(Atomic_Always_Lock_Free): Likewise.
* libgnat/s-aoinar.adb (Is_Lock_Free): Adjust.
* libgnat/s-aomoar.adb (Is_Lock_Free): Likewise.
* libgnat/s-aotase.adb (Atomic_Test_And_Set): Likewise.
* libgnat/s-atopex.adb (Atomic_Compare_And_Exchange): Likewise.
* gcc-interface/decl.c: Include gimple-expr.h.
(intrin_types_incompatible_p): Delete.
(intrin_arglists_compatible_p): Call types_compatible_p.
(intrin_return_compatible_p): Likewise.
--
Eric Botcazoudiff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index d37ed3d1b52..38a8bda02ce 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -28,6 +28,7 @@
#include "coretypes.h"
#include "target.h"
#include "tree.h"
+#include "gimple-expr.h"
#include "stringpool.h"
#include "diagnostic-core.h"
#include "alias.h"
@@ -9492,46 +9493,6 @@ check_ok_for_atomic_type (tree type, Entity_Id gnat_entity, bool component_p)
gnat_error_point, gnat_entity);
}
-
-/* Helper for the intrin compatibility checks family. Evaluate whether
- two types are definitely incompatible. */
-
-static bool
-intrin_types_incompatible_p (tree t1, tree t2)
-{
- enum tree_code code;
-
- if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2))
- return false;
-
- if (TYPE_MODE (t1) != TYPE_MODE (t2))
- return true;
-
- if (TREE_CODE (t1) != TREE_CODE (t2))
- return true;
-
- code = TREE_CODE (t1);
-
- switch (code)
- {
- case INTEGER_TYPE:
- case REAL_TYPE:
- return TYPE_PRECISION (t1) != TYPE_PRECISION (t2);
-
- case POINTER_TYPE:
- case REFERENCE_TYPE:
- /* Assume designated types are ok. We'd need to account for char * and
- void * variants to do better, which could rapidly get messy and isn't
- clearly worth the effort. */
- return false;
-
- default:
- break;
- }
-
- return false;
-}
-
/* Helper for intrin_profiles_compatible_p, to perform compatibility checks
on the Ada/builtin argument lists for the INB binding. */
@@ -9577,8 +9538,8 @@ intrin_arglists_compatible_p (intrin_binding_t * inb)
}
/* Otherwise, check that types match for the current argument. */
- argpos ++;
- if (intrin_types_incompatible_p (ada_type, btin_type))
+ argpos++;
+ if (!types_compatible_p (ada_type, btin_type))
{
post_error_ne_num ("??intrinsic binding type mismatch on argument ^!",
inb->gnat_entity, inb->gnat_entity, argpos);
@@ -9609,7 +9570,7 @@ intrin_return_compatible_p (intrin_binding_t * inb)
/* Check return types compatibility otherwise. Note that this
handles void/void as well. */
- if (intrin_types_incompatible_p (btin_return_type, ada_return_type))
+ if (!types_compatible_p (btin_return_type, ada_return_type))
{
post_error ("??intrinsic binding type mismatch on return value!",
inb->gnat_entity);
diff --git a/gcc/ada/libgnat/s-aoinar.adb b/gcc/ada/libgnat/s-aoinar.adb
index df12b16b9e5..2f430ed4efe 100644
--- a/gcc/ada/libgnat/s-aoinar.adb
+++ b/gcc/ada/libgnat/s-aoinar.adb
@@ -203,7 +203,7 @@ package body System.Atomic_Operations.Integer_Arithmetic is
pragma Unreferenced (Item);
use type Interfaces.C.size_t;
begin
- return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+ return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
end Is_Lock_Free;
end System.Atomic_Operations.Integer_Arithmetic;
diff --git a/gcc/ada/libgnat/s-aomoar.adb b/gcc/ada/libgnat/s-aomoar.adb
index c955623897d..a6f4b0e61e8 100644
--- a/gcc/ada/libgnat/s-aomoar.adb
+++ b/gcc/ada/libgnat/s-aomoar.adb
@@ -209,7 +209,7 @@ package body System.Atomic_Operations.Modular_Arithmetic is
pragma Unreferenced (Item);
use type Interfaces.C.size_t;
begin
- return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+ return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
end Is_Lock_Free;
end System.Atomic_Operations.Modular_Arithmetic;
diff --git a/gcc/ada/libgnat/s-aotase.adb b/gcc/ada/libgnat/s-aotase.adb
index 53178892621..94b28dfa410 100644
--- a/gcc/ada/libgnat/s-aotase.adb
+++ b/gcc/ada/libgnat/s-aotase.adb
@@ -40,7 +40,7 @@ package body System.Atomic_Operations.Test_And_Set is
function Atomic_Test_And_Set
(Item : aliased in out Test_And_Set_Flag) return Boolean is
begin
- return Boolean (Atomic_Test_And_Set (Item'Address));
+ return Atomic_Test_And_Set (Item'Address);
end Atomic_Test_And_Set;
------------------
diff --git a/gcc/ada/libgnat/s-atopex.adb b/gcc/ada/libgnat/s-atopex.adb
index 501254e4f5f..b0aa9e593d1 100644
--- a/gcc/ada/libgnat/s-atopex.adb
+++ b/gcc/ada/libgnat/s-atopex.adb
@@ -89,36 +89,36 @@ package body System.Atomic_Operations.Exchange is
(Ptr : System.Address;
Expected : System.Address;
Desired : Atomic_Type;
- Weak : bool := False;
+ Weak : Boolean := False;
Success_Model : Mem_Model := Seq_Cst;
- Failure_Model : Mem_Model := Seq_Cst) return bool;
+ Failure_Model : Mem_Model := Seq_Cst) return Boolean;
pragma Import
(Intrinsic, Atomic_Compare_Exchange_1, "__atomic_compare_exchange_1");
function Atomic_Compare_Exchange_2
(Ptr : System.Address;
Expected : System.Address;
Desired : Atomic_Type;
- Weak : bool := False;
+ Weak : Boolean := False;
Success_Model : Mem_Model := Seq_Cst;
- Failure_Model : Mem_Model := Seq_Cst) return bool;
+ Failure_Model : Mem_Model := Seq_Cst) return Boolean;
pragma Import
(Intrinsic, Atomic_Compare_Exchange_2, "__atomic_compare_exchange_2");
function Atomic_Compare_Exchange_4
(Ptr : System.Address;
Expected : System.Address;
Desired : Atomic_Type;
- Weak : bool := False;
+ Weak : Boolean := False;
Success_Model : Mem_Model := Seq_Cst;
- Failure_Model : Mem_Model := Seq_Cst) return bool;
+ Failure_Model : Mem_Model := Seq_Cst) return Boolean;
pragma Import
(Intrinsic, Atomic_Compare_Exchange_4, "__atomic_compare_exchange_4");
function Atomic_Compare_Exchange_8
(Ptr : System.Address;
Expected : System.Address;
Desired : Atomic_Type;
- Weak : bool := False;
+ Weak : Boolean := False;
Success_Model : Mem_Model := Seq_Cst;
- Failure_Model : Mem_Model := Seq_Cst) return bool;
+ Failure_Model : Mem_Model := Seq_Cst) return Boolean;
pragma Import
(Intrinsic, Atomic_Compare_Exchange_8, "__atomic_compare_exchange_8");
pragma Warnings (On);
@@ -126,21 +126,17 @@ package body System.Atomic_Operations.Exchange is
begin
case Atomic_Type'Object_Size is
when 8 =>
- return Boolean
- (Atomic_Compare_Exchange_1
- (Item'Address, Prior'Address, Desired));
+ return
+ Atomic_Compare_Exchange_1 (Item'Address, Prior'Address, Desired);
when 16 =>
- return Boolean
- (Atomic_Compare_Exchange_2
- (Item'Address, Prior'Address, Desired));
+ return
+ Atomic_Compare_Exchange_2 (Item'Address, Prior'Address, Desired);
when 32 =>
- return Boolean
- (Atomic_Compare_Exchange_4
- (Item'Address, Prior'Address, Desired));
+ return
+ Atomic_Compare_Exchange_4 (Item'Address, Prior'Address, Desired);
when 64 =>
- return Boolean
- (Atomic_Compare_Exchange_8
- (Item'Address, Prior'Address, Desired));
+ return
+ Atomic_Compare_Exchange_8 (Item'Address, Prior'Address, Desired);
when others =>
raise Program_Error;
end case;
@@ -154,7 +150,7 @@ package body System.Atomic_Operations.Exchange is
pragma Unreferenced (Item);
use type Interfaces.C.size_t;
begin
- return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8));
+ return Atomic_Always_Lock_Free (Atomic_Type'Object_Size / 8);
end Is_Lock_Free;
end System.Atomic_Operations.Exchange;
diff --git a/gcc/ada/libgnat/s-atopri.ads b/gcc/ada/libgnat/s-atopri.ads
index 2a5ffe59803..891b2edf061 100644
--- a/gcc/ada/libgnat/s-atopri.ads
+++ b/gcc/ada/libgnat/s-atopri.ads
@@ -62,9 +62,6 @@ package System.Atomic_Primitives is
subtype Mem_Model is Integer range Relaxed .. Last;
- type bool is new Boolean;
- pragma Convention (C, bool);
-
------------------------------------
-- GCC built-in atomic primitives --
------------------------------------
@@ -137,7 +134,7 @@ package System.Atomic_Primitives is
function Atomic_Test_And_Set
(Ptr : System.Address;
- Model : Mem_Model := Seq_Cst) return bool;
+ Model : Mem_Model := Seq_Cst) return Boolean;
pragma Import (Intrinsic, Atomic_Test_And_Set, "__atomic_test_and_set");
procedure Atomic_Clear
@@ -147,7 +144,7 @@ package System.Atomic_Primitives is
function Atomic_Always_Lock_Free
(Size : Interfaces.C.size_t;
- Ptr : System.Address := System.Null_Address) return bool;
+ Ptr : System.Address := System.Null_Address) return Boolean;
pragma Import
(Intrinsic, Atomic_Always_Lock_Free, "__atomic_always_lock_free");
