From 415c22da949f15a18c914588e4796b218ccf0db5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 15 Jan 2020 11:03:14 +0100 Subject: [PATCH] [Ada] Support pragma Allow_Integer_Address on 64-bit targets 2020-06-03 Eric Botcazou 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 | 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 -- 2.30.2