[gcc(refs/users/aoliva/heads/testbase)] [Ada] Support pragma Allow_Integer_Address on 64-bit targets
Alexandre Oliva
aoliva@gcc.gnu.org
Thu Jun 4 07:33:28 GMT 2020
https://gcc.gnu.org/g:415c22da949f15a18c914588e4796b218ccf0db5
commit 415c22da949f15a18c914588e4796b218ccf0db5
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Wed Jan 15 11:03:14 2020 +0100
[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:
---
gcc/ada/cstand.adb | 9 ++++++++-
gcc/ada/opt.ads | 2 +-
gcc/ada/sem_ch4.adb | 27 +++++++++++++++++++--------
gcc/ada/stand.ads | 6 +++++-
4 files changed, 33 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index 3122e243787..dcdfe736d77 100644
--- 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 ebd5a78bb1b..f3488bb44d9 100644
--- 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 7b8548f32ac..0b04c42aacc 100644
--- 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 43b876ab379..f3f7eb512d5 100644
--- 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
More information about the Gcc-cvs
mailing list