This patch allows the use of static expressions, including most
importantly literals that accomodate the full range of positive
values for the Address, up to 2**a-1, where a is the size of
address values (most typically 32 or 64).
The following is compiled on a 32-bit machine:
1. with System; use System;
2. package BadAddr is
3. Bar : Integer;
4. for Bar'Address use -- OK on 64 bits, ERROR on 32 bits
5. System'To_Address (16#ffff_ffff_ffff_1000#);
|
>>> address value out of range for "To_Address" attribute
6.
7. Bar1 : Integer;
8. for Bar1'Address use -- OK on 64 bits, OK on 32 bits
9. System'To_Address (16#FFFF_FFFF#);
10.
11. Bar2 : Integer;
12. for Bar2'Address use -- ERROR on 64 bits, ERROR on 32 bits
13. System'To_Address (16#1_0000_0000_0000_0000#);
|
>>> address value out of range for "To_Address" attribute
14.
15. Bar3_Addr : Integer := 22;
16. Bar3 : Integer;
17. for Bar3'Address use -- OK on 64 bits, OK on 32 bits
18. System'To_Address (Bar3_Addr);
19.
20. Bar4 : Integer;
21. for Bar4'Address use -- OK on 64 bits, OK on 32 bits
22. System'To_Address (-1);
23.
24. Bar5 : Integer;
25. for Bar5'Address use -- OK on 64 bits, error on 32 bits
26. System'To_Address (-(2**32));
|
>>> address value out of range for "To_Address" attribute
27.
28. Bar6 : Integer;
29. for Bar5'Address use -- OK on 64 bits, error on 32 bits
30. System'To_Address (-(2**64));
|
>>> address value out of range for "To_Address" attribute
31.
32. end BadAddr;
On a 64-bit machine, the errors on line 5 and line 26 do not appear.
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-10-10 Robert Dewar <de...@adacore.com>
* cstand.adb (Standard_Unsigned_64): New internal type.
* gnat_rm.texi: Update documentation on To_Address.
* sem_attr.adb (Analyze_Attribute, case To_Address): Fix
problem with out of range static values given as literals or
named numbers.
* stand.ads (Standard_Unsigned_64): New internal type.
* stand.adb: Minor reformatting.
Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi (revision 203343)
+++ gnat_rm.texi (working copy)
@@ -8665,12 +8665,15 @@
@code{System.Storage_Elements.To_Address} except that
it is a static attribute. This means that if its argument is
a static expression, then the result of the attribute is a
-static expression. The result is that such an expression can be
+static expression. This means that such an expression can be
used in contexts (e.g.@: preelaborable packages) which require a
static expression and where the function call could not be used
(since the function call is always non-static, even if its
-argument is static). The argument must be in the range 0 .. 2**m-1,
-where m is the memory size (typically 32 or 64).
+argument is static). The argument must be in the range
+-(2**(m-1) .. 2**m-1, where m is the memory size
+(typically 32 or 64). Negative values are intepreted in a
+modular manner (e.g. -1 means the same as 16#FFFF_FFFF# on
+a 32 bits machine).
@node Attribute Type_Class
@unnumberedsec Attribute Type_Class
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 203342)
+++ sem_attr.adb (working copy)
@@ -5439,7 +5439,10 @@
-- To_Address --
----------------
- when Attribute_To_Address =>
+ when Attribute_To_Address => To_Address : declare
+ Val : Uint;
+
+ begin
Check_E1;
Analyze (P);
@@ -5451,6 +5454,31 @@
Analyze_And_Resolve (E1, Any_Integer);
Set_Etype (N, RTE (RE_Address));
+ -- Static expression case, check range and set appropriate type
+
+ if Is_OK_Static_Expression (E1) then
+ Val := Expr_Value (E1);
+
+ if Val < -(2 ** UI_From_Int (Standard'Address_Size - 1))
+ or else
+ Val > 2 ** UI_From_Int (Standard'Address_Size) - 1
+ then
+ Error_Attr ("address value out of range for % attribute", E1);
+ end if;
+
+ -- Set type to universal integer if negative
+
+ if Val < 0 then
+ Set_Etype (E1, Universal_Integer);
+
+ -- Otherwise set type to Unsigned_64 to accomodate max values
+
+ else
+ Set_Etype (E1, Standard_Unsigned_64);
+ end if;
+ end if;
+ end To_Address;
+
------------
-- To_Any --
------------
Index: cstand.adb
===================================================================
--- cstand.adb (revision 203342)
+++ cstand.adb (working copy)
@@ -1305,6 +1305,9 @@
Set_Scope (Standard_Integer_64, Standard_Standard);
Build_Signed_Integer_Type (Standard_Integer_64, 64);
+ -- Standard_Unsigned is not user visible, but is used internally. It
+ -- is an unsigned type with the same length as Standard.Integer.
+
Standard_Unsigned := New_Standard_Entity;
Decl := New_Node (N_Full_Type_Declaration, Stloc);
Set_Defining_Identifier (Decl, Standard_Unsigned);
@@ -1329,6 +1332,32 @@
Set_Etype (High_Bound (R_Node), Standard_Unsigned);
Set_Scalar_Range (Standard_Unsigned, R_Node);
+ -- 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.
+
+ Standard_Unsigned_64 := New_Standard_Entity;
+ Decl := New_Node (N_Full_Type_Declaration, Stloc);
+ Set_Defining_Identifier (Decl, Standard_Unsigned_64);
+ Make_Name (Standard_Unsigned_64, "unsigned_64");
+
+ Set_Ekind (Standard_Unsigned_64, E_Modular_Integer_Type);
+ Set_Scope (Standard_Unsigned_64, Standard_Standard);
+ Set_Etype (Standard_Unsigned_64, Standard_Unsigned_64);
+ Init_Size (Standard_Unsigned_64, 64);
+ Set_Elem_Alignment (Standard_Unsigned_64);
+ Set_Modulus (Standard_Unsigned_64, Uint_2 ** 64);
+ Set_Is_Unsigned_Type (Standard_Unsigned_64);
+ Set_Size_Known_At_Compile_Time
+ (Standard_Unsigned_64);
+ Set_Is_Known_Valid (Standard_Unsigned_64, True);
+
+ R_Node := New_Node (N_Range, Stloc);
+ Set_Low_Bound (R_Node, Make_Integer (Uint_0));
+ Set_High_Bound (R_Node, Make_Integer (Uint_2 ** 64 - 1));
+ Set_Etype (Low_Bound (R_Node), Standard_Unsigned_64);
+ Set_Etype (High_Bound (R_Node), Standard_Unsigned_64);
+ Set_Scalar_Range (Standard_Unsigned_64, R_Node);
+
-- 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
Index: stand.adb
===================================================================
--- stand.adb (revision 203342)
+++ stand.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992,1993,1994,1995,2009 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -76,7 +76,6 @@
Tree_Read_Int (Int (Standard_Op_Shift_Left));
Tree_Read_Int (Int (Standard_Op_Shift_Right));
Tree_Read_Int (Int (Standard_Op_Shift_Right_Arithmetic));
-
end Tree_Read;
----------------
@@ -121,7 +120,6 @@
Tree_Write_Int (Int (Standard_Op_Shift_Left));
Tree_Write_Int (Int (Standard_Op_Shift_Right));
Tree_Write_Int (Int (Standard_Op_Shift_Right_Arithmetic));
-
end Tree_Write;
end Stand;
Index: stand.ads
===================================================================
--- stand.ads (revision 203342)
+++ stand.ads (working copy)
@@ -451,13 +451,15 @@
Standard_Integer_16 : Entity_Id;
Standard_Integer_32 : Entity_Id;
Standard_Integer_64 : Entity_Id;
- -- These are signed integer types with the indicated sizes, They are used
- -- for the underlying implementation types for fixed-point and enumeration
- -- types.
+ -- These are signed integer types with the indicated sizes. Used for the
+ -- underlying implementation types for fixed-point and enumeration types.
Standard_Unsigned : Entity_Id;
-- An unsigned type of the same size as Standard_Integer
+ Standard_Unsigned_64 : Entity_Id;
+ -- An unsigned type, mod 2 ** 64, size of 64 bits.
+
Abort_Signal : Entity_Id;
-- Entity for abort signal exception
