diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 |
6 files changed, 62 insertions, 8 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7e347b9..be1da2d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +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> * sem_attr.adb: Minor reformatting. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 18864c0..7b29d7a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3792,6 +3792,12 @@ package body Exp_Attr is Rewrite_Stream_Proc_Call (Pname); end Read; + --------- + -- Ref -- + --------- + + -- Ref is identical to To_Address, see To_Address for processing + --------------- -- Remainder -- --------------- @@ -4507,10 +4513,10 @@ package body Exp_Attr is -- To_Address -- ---------------- - -- Transforms System'To_Address (X) into unchecked conversion - -- from (integral) type of X to type address. + -- Transforms System'To_Address (X) and System.Address'Ref (X) into + -- unchecked conversion from (integral) type of X to type address. - when Attribute_To_Address => + when Attribute_To_Address | Attribute_Ref => Rewrite (N, Unchecked_Convert_To (RTE (RE_Address), Relocate_Node (First (Exprs)))); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 77f27c7..0e61132 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -5582,6 +5582,7 @@ consideration, you should minimize the use of these attributes. * Passed_By_Reference:: * Pool_Address:: * Range_Length:: +* Ref:: * Result:: * Safe_Emax:: * Safe_Large:: @@ -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 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 @unnumberedsec Result @findex Result diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index bfddc14..75cc2db 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -2989,7 +2989,7 @@ package body Sem_Attr is Ekind (Entity (P)) /= E_Enumeration_Literal) then Error_Attr_P - ("prefix of %attribute must be " & + ("prefix of % attribute must be " & "discrete type/object or enum literal"); end if; end if; @@ -3461,7 +3461,7 @@ package body Sem_Attr is elsif UI_To_Int (Intval (E1)) > Number_Formals (Entity (P)) or else UI_To_Int (Intval (E1)) < 0 then - Error_Attr ("invalid parameter number for %attribute", E1); + Error_Attr ("invalid parameter number for % attribute", E1); end if; end if; @@ -4010,6 +4010,23 @@ package body Sem_Attr is Resolve (N, Standard_Void_Type); 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 -- --------------- @@ -4405,7 +4422,7 @@ package body Sem_Attr is if Nkind (P) /= N_Identifier or else Chars (P) /= Name_System then - Error_Attr_P ("prefix of %attribute must be System"); + Error_Attr_P ("prefix of % attribute must be System"); end if; Generate_Reference (RTE (RE_Address), P); @@ -7630,6 +7647,7 @@ package body Sem_Attr is Attribute_Position | Attribute_Priority | Attribute_Read | + Attribute_Ref | Attribute_Result | Attribute_Storage_Pool | Attribute_Storage_Size | diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index 5865d83..b1a6150 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -6,7 +6,7 @@ -- -- -- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -395,6 +395,15 @@ package Sem_Attr is -- as Range applied to the array itself. The result is of type universal -- 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 -- ------------------ @@ -439,7 +448,7 @@ package Sem_Attr is ---------------- 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 -- address value. The semantics is to first convert the integer value to -- type Integer_Address according to normal conversion rules, and then diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 94e1ba2..18357cc 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -781,6 +781,7 @@ package Snames is Name_Priority : constant Name_Id := N + $; -- Ada 05 Name_Range : constant Name_Id := N + $; Name_Range_Length : constant Name_Id := N + $; -- GNAT + Name_Ref : constant Name_Id := N + $; -- GNAT Name_Result : constant Name_Id := N + $; -- GNAT Name_Round : constant Name_Id := N + $; Name_Safe_Emax : constant Name_Id := N + $; -- Ada 83 @@ -1297,6 +1298,7 @@ package Snames is Attribute_Priority, Attribute_Range, Attribute_Range_Length, + Attribute_Ref, Attribute_Result, Attribute_Round, Attribute_Safe_Emax, |