This implements the documented semantics of the pragma for operators,
that is to say, introduces an implicit unchecked conversion from the
integer value to type System.Address, thus making the pragma work
on 64-bit targets as well.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-03 Eric Botcazou <ebotca...@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.--- gcc/ada/cstand.adb
+++ 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
--- gcc/ada/opt.ads
+++ 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;
--- gcc/ada/sem_ch4.adb
+++ 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;
--- gcc/ada/stand.ads
+++ 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
