Commit 1b0b0f18 by Arnaud Charlet Committed by Arnaud Charlet

gnat_rm.texi, [...] (Analyze_Attribute, [...]): Add handling of Attribute_Ref.

2010-10-11  Arnaud Charlet  <charlet@adacore.com>

	* gnat_rm.texi, exp_attr.adb, sem_attr.adb, sem_attr.ads,
	snames.ads-tmpl (Analyze_Attribute, Expand_N_Attribute_Reference): Add
	handling of Attribute_Ref. Add missing blanks in some error messages.
	(Attribute_Ref, Name_Ref): Declare.
	Document 'Ref attribute.

From-SVN: r165291
parent ddc1515a
2010-10-11 Arnaud Charlet <charlet@adacore.com>
* gnat_rm.texi, exp_attr.adb, sem_attr.adb, sem_attr.ads,
snames.ads-tmpl (Analyze_Attribute, Expand_N_Attribute_Reference): Add
handling of Attribute_Ref. Add missing blanks in some error messages.
(Attribute_Ref, Name_Ref): Declare.
Document 'Ref attribute.
2010-10-11 Robert Dewar <dewar@adacore.com> 2010-10-11 Robert Dewar <dewar@adacore.com>
* sem_attr.adb: Minor reformatting. * sem_attr.adb: Minor reformatting.
......
...@@ -3792,6 +3792,12 @@ package body Exp_Attr is ...@@ -3792,6 +3792,12 @@ package body Exp_Attr is
Rewrite_Stream_Proc_Call (Pname); Rewrite_Stream_Proc_Call (Pname);
end Read; end Read;
---------
-- Ref --
---------
-- Ref is identical to To_Address, see To_Address for processing
--------------- ---------------
-- Remainder -- -- Remainder --
--------------- ---------------
...@@ -4507,10 +4513,10 @@ package body Exp_Attr is ...@@ -4507,10 +4513,10 @@ package body Exp_Attr is
-- To_Address -- -- To_Address --
---------------- ----------------
-- Transforms System'To_Address (X) into unchecked conversion -- Transforms System'To_Address (X) and System.Address'Ref (X) into
-- from (integral) type of X to type address. -- unchecked conversion from (integral) type of X to type address.
when Attribute_To_Address => when Attribute_To_Address | Attribute_Ref =>
Rewrite (N, Rewrite (N,
Unchecked_Convert_To (RTE (RE_Address), Unchecked_Convert_To (RTE (RE_Address),
Relocate_Node (First (Exprs)))); Relocate_Node (First (Exprs))));
......
...@@ -5582,6 +5582,7 @@ consideration, you should minimize the use of these attributes. ...@@ -5582,6 +5582,7 @@ consideration, you should minimize the use of these attributes.
* Passed_By_Reference:: * Passed_By_Reference::
* Pool_Address:: * Pool_Address::
* Range_Length:: * Range_Length::
* Ref::
* Result:: * Result::
* Safe_Emax:: * Safe_Emax::
* Safe_Large:: * Safe_Large::
...@@ -6234,6 +6235,16 @@ range). The result is static for static subtypes. @code{Range_Length} ...@@ -6234,6 +6235,16 @@ range). The result is static for static subtypes. @code{Range_Length}
applied to the index subtype of a one dimensional array always gives the applied to the index subtype of a one dimensional array always gives the
same result as @code{Range} applied to the array itself. same result as @code{Range} applied to the array itself.
@node Ref
@unnumberedsec Ref
@findex Ref
@noindent
The @code{System.Address'Ref}
(@code{System.Address} is the only permissible prefix)
denotes a function identical to
@code{System.Storage_Elements.To_Address} except that
it is a static attribute. See @ref{To_Address} for more details.
@node Result @node Result
@unnumberedsec Result @unnumberedsec Result
@findex Result @findex Result
......
...@@ -2989,7 +2989,7 @@ package body Sem_Attr is ...@@ -2989,7 +2989,7 @@ package body Sem_Attr is
Ekind (Entity (P)) /= E_Enumeration_Literal) Ekind (Entity (P)) /= E_Enumeration_Literal)
then then
Error_Attr_P Error_Attr_P
("prefix of %attribute must be " & ("prefix of % attribute must be " &
"discrete type/object or enum literal"); "discrete type/object or enum literal");
end if; end if;
end if; end if;
...@@ -3461,7 +3461,7 @@ package body Sem_Attr is ...@@ -3461,7 +3461,7 @@ package body Sem_Attr is
elsif UI_To_Int (Intval (E1)) > Number_Formals (Entity (P)) elsif UI_To_Int (Intval (E1)) > Number_Formals (Entity (P))
or else UI_To_Int (Intval (E1)) < 0 or else UI_To_Int (Intval (E1)) < 0
then then
Error_Attr ("invalid parameter number for %attribute", E1); Error_Attr ("invalid parameter number for % attribute", E1);
end if; end if;
end if; end if;
...@@ -4010,6 +4010,23 @@ package body Sem_Attr is ...@@ -4010,6 +4010,23 @@ package body Sem_Attr is
Resolve (N, Standard_Void_Type); Resolve (N, Standard_Void_Type);
Note_Possible_Modification (E2, Sure => True); Note_Possible_Modification (E2, Sure => True);
---------
-- Ref --
---------
when Attribute_Ref =>
Check_E1;
Analyze (P);
if Nkind (P) /= N_Expanded_Name
or else not Is_RTE (P_Type, RE_Address)
then
Error_Attr_P ("prefix of % attribute must be System.Address");
end if;
Analyze_And_Resolve (E1, Any_Integer);
Set_Etype (N, RTE (RE_Address));
--------------- ---------------
-- Remainder -- -- Remainder --
--------------- ---------------
...@@ -4405,7 +4422,7 @@ package body Sem_Attr is ...@@ -4405,7 +4422,7 @@ package body Sem_Attr is
if Nkind (P) /= N_Identifier if Nkind (P) /= N_Identifier
or else Chars (P) /= Name_System or else Chars (P) /= Name_System
then then
Error_Attr_P ("prefix of %attribute must be System"); Error_Attr_P ("prefix of % attribute must be System");
end if; end if;
Generate_Reference (RTE (RE_Address), P); Generate_Reference (RTE (RE_Address), P);
...@@ -7630,6 +7647,7 @@ package body Sem_Attr is ...@@ -7630,6 +7647,7 @@ package body Sem_Attr is
Attribute_Position | Attribute_Position |
Attribute_Priority | Attribute_Priority |
Attribute_Read | Attribute_Read |
Attribute_Ref |
Attribute_Result | Attribute_Result |
Attribute_Storage_Pool | Attribute_Storage_Pool |
Attribute_Storage_Size | Attribute_Storage_Size |
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -395,6 +395,15 @@ package Sem_Attr is ...@@ -395,6 +395,15 @@ package Sem_Attr is
-- as Range applied to the array itself. The result is of type universal -- as Range applied to the array itself. The result is of type universal
-- integer. -- integer.
---------
-- Ref --
---------
Attribute_Ref => True,
-- System.Address'Ref (Address is the only permissible prefix) is
-- equivalent to System'To_Address, provided for compatibility with
-- other compilers.
------------------ ------------------
-- Storage_Unit -- -- Storage_Unit --
------------------ ------------------
...@@ -439,7 +448,7 @@ package Sem_Attr is ...@@ -439,7 +448,7 @@ package Sem_Attr is
---------------- ----------------
Attribute_To_Address => True, Attribute_To_Address => True,
-- System'To_Address (Address is the only permissible prefix) is a -- System'To_Address (System is the only permissible prefix) is a
-- function that takes any integer value, and converts it into an -- function that takes any integer value, and converts it into an
-- address value. The semantics is to first convert the integer value to -- address value. The semantics is to first convert the integer value to
-- type Integer_Address according to normal conversion rules, and then -- type Integer_Address according to normal conversion rules, and then
......
...@@ -781,6 +781,7 @@ package Snames is ...@@ -781,6 +781,7 @@ package Snames is
Name_Priority : constant Name_Id := N + $; -- Ada 05 Name_Priority : constant Name_Id := N + $; -- Ada 05
Name_Range : constant Name_Id := N + $; Name_Range : constant Name_Id := N + $;
Name_Range_Length : constant Name_Id := N + $; -- GNAT Name_Range_Length : constant Name_Id := N + $; -- GNAT
Name_Ref : constant Name_Id := N + $; -- GNAT
Name_Result : constant Name_Id := N + $; -- GNAT Name_Result : constant Name_Id := N + $; -- GNAT
Name_Round : constant Name_Id := N + $; Name_Round : constant Name_Id := N + $;
Name_Safe_Emax : constant Name_Id := N + $; -- Ada 83 Name_Safe_Emax : constant Name_Id := N + $; -- Ada 83
...@@ -1297,6 +1298,7 @@ package Snames is ...@@ -1297,6 +1298,7 @@ package Snames is
Attribute_Priority, Attribute_Priority,
Attribute_Range, Attribute_Range,
Attribute_Range_Length, Attribute_Range_Length,
Attribute_Ref,
Attribute_Result, Attribute_Result,
Attribute_Round, Attribute_Round,
Attribute_Safe_Emax, Attribute_Safe_Emax,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment