[Ada] Support pragma Allow_Integer_Address on 64-bit targets

2020-06-03  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* opt.ads (Allow_Integer_Address): Fix typo in comment.
	* stand.ads (Standard_Address): New entity.
	* cstand.adb (Create_Standard): Create it.
	* sem_ch4.adb (Operator_Check): Convert the operands of an
	operation with addresses and integers to Standard_Address
	if pragma Allow_Integer_Address is in effect.

diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index 3122e24378797aaf40cafc426cd200fedcf56e00..dcdfe736d77dfc6bab02ad979f64e353d6f5c205 100644 (file)
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -1372,11 +1372,18 @@ package body CStand is
          "long_long_unsigned");
 
       --  Standard_Unsigned_64 is not user visible, but is used internally. It
-      --  is an unsigned type mod 2**64, 64-bits unsigned, size is 64.
+      --  is an unsigned type mod 2**64 with 64 bits size.
 
       Standard_Unsigned_64 := New_Standard_Entity;
       Build_Unsigned_Integer_Type (Standard_Unsigned_64, 64, "unsigned_64");
 
+      --  Standard_Address is not user visible, but is used internally. It is
+      --  an unsigned type mod 2**System_Address_Size with System.Address size.
+
+      Standard_Address := New_Standard_Entity;
+      Build_Unsigned_Integer_Type
+        (Standard_Address, System_Address_Size, "standard_address");
+
       --  Note: universal integer and universal real are constructed as fully
       --  formed signed numeric types, with parameters corresponding to the
       --  longest runtime types (Long_Long_Integer and Long_Long_Float). This

diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index ebd5a78bb1bdc7ec376b5e73ae5f2622d6d3dbc6..f3488bb44d9e246774ecada20d181c5247a2de37 100644 (file)
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -210,7 +210,7 @@ package Opt is
    Allow_Integer_Address : Boolean := False;
    --  GNAT
    --  Allow use of integer expression in a context requiring System.Address.
-   --  Set by the use of configuration pragma Allow_Integer_Address Also set
+   --  Set by the use of configuration pragma Allow_Integer_Address. Also set
    --  in relaxed semantics mode for use by CodePeer or when -gnatd.M is used.
 
    All_Sources : Boolean := False;

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 7b8548f32ac6dc134fd7eaa94a527a3242387686..0b04c42aacc2d2250f506ecf7ccc1cf0a6aead11 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -7168,9 +7168,8 @@ package body Sem_Ch4 is
                                N_Op_Divide,
                                N_Op_Ge,
                                N_Op_Gt,
-                               N_Op_Le)
-              or else
-                  Nkind_In (N, N_Op_Lt,
+                               N_Op_Le,
+                               N_Op_Lt,
                                N_Op_Mod,
                                N_Op_Multiply,
                                N_Op_Rem,
@@ -7183,8 +7182,12 @@ package body Sem_Ch4 is
                  and then not Is_Numeric_Type (Etype (R))
                then
                   if Address_Integer_Convert_OK (Etype (R), Etype (L)) then
+                     Rewrite (L,
+                       Unchecked_Convert_To (
+                         Standard_Address, Relocate_Node (L)));
                      Rewrite (R,
-                       Unchecked_Convert_To (Etype (L), Relocate_Node (R)));
+                       Unchecked_Convert_To (
+                         Standard_Address, Relocate_Node (R)));
 
                      if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then
                         Analyze_Comparison_Op (N);
@@ -7202,7 +7205,11 @@ package body Sem_Ch4 is
                then
                   if Address_Integer_Convert_OK (Etype (L), Etype (R)) then
                      Rewrite (L,
-                       Unchecked_Convert_To (Etype (R), Relocate_Node (L)));
+                       Unchecked_Convert_To (
+                         Standard_Address, Relocate_Node (L)));
+                     Rewrite (R,
+                       Unchecked_Convert_To (
+                         Standard_Address, Relocate_Node (R)));
 
                      if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then
                         Analyze_Comparison_Op (N);
@@ -7229,10 +7236,10 @@ package body Sem_Ch4 is
                   begin
                      Rewrite (L,
                        Unchecked_Convert_To (
-                         Standard_Integer, Relocate_Node (L)));
+                         Standard_Address, Relocate_Node (L)));
                      Rewrite (R,
                        Unchecked_Convert_To (
-                         Standard_Integer, Relocate_Node (R)));
+                         Standard_Address, Relocate_Node (R)));
 
                      if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then
                         Analyze_Comparison_Op (N);
@@ -7330,8 +7337,12 @@ package body Sem_Ch4 is
 
             elsif Nkind_In (N, N_Op_Eq, N_Op_Ne) then
                if Address_Integer_Convert_OK (Etype (R), Etype (L)) then
+                  Rewrite (L,
+                    Unchecked_Convert_To (
+                      Standard_Address, Relocate_Node (L)));
                   Rewrite (R,
-                    Unchecked_Convert_To (Etype (L), Relocate_Node (R)));
+                    Unchecked_Convert_To (
+                      Standard_Address, Relocate_Node (R)));
                   Analyze_Equality_Op (N);
                   return;
 

diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads
index 43b876ab37906176532e4629dd167a16d325b5ab..f3f7eb512d5b5c1f29169bbb12a5a6f50c763d68 100644 (file)
--- a/gcc/ada/stand.ads
+++ b/gcc/ada/stand.ads
@@ -468,7 +468,11 @@ package Stand is
    --  Unsigned types with same Esize as corresponding signed integer types
 
    Standard_Unsigned_64 : Entity_Id;
-   --  An unsigned type, mod 2 ** 64, size of 64 bits.
+   --  Entity for an unsigned type mod 2 ** 64, size of 64 bits.
+
+   Standard_Address : Entity_Id;
+   --  Entity for an unsigned type mod 2 ** System_Address_Size, size of
+   --  System_Address_Size bits. Used for implementing Allow_Integer_Address.
 
    Abort_Signal : Entity_Id;
    --  Entity for abort signal exception