From 9eea4346af869733ba91b92d40a78de3541d3be0 Mon Sep 17 00:00:00 2001 From: Geert Bosch Date: Mon, 1 Aug 2011 12:41:48 +0000 Subject: [PATCH] sem_prag.adb (Check_No_Link_Name): New procedure. 2011-08-01 Geert Bosch * sem_prag.adb (Check_No_Link_Name): New procedure. (Process_Import_Or_Interface): Use Check_No_Link_Name. * cstand.adb (Create_Standard): Use Esize (Standard_Long_Long_Float) instead of Standard_Long_Long_Float_Size global. Preparation for eventual removal of per type constants. * exp_util.ads (Get_Stream_Size): New function returning the stream size value of subtype E. * exp_util.adb (Get_Stream_Size): Implement new function. * exp_strm.adb (Build_Elementary_Input_Call): Use Get_Stream_Size function. * exp_attr.adb (Attribute_Stream_Size): Use Get_Stream_Size * einfo.adb: (Machine_Mantissa_Value): Handle 128-bit quad precision IEEE floats From-SVN: r177026 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/cstand.adb | 3 ++- gcc/ada/einfo.adb | 1 + gcc/ada/exp_attr.adb | 29 +++++++---------------------- gcc/ada/exp_strm.adb | 12 ++---------- gcc/ada/exp_util.adb | 19 ++++++++++++++++++- gcc/ada/exp_util.ads | 4 ++++ gcc/ada/sem_prag.adb | 34 ++++++++++++++++++++++------------ 8 files changed, 72 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0dc1c4ac653..463108ab831 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2011-08-01 Geert Bosch + + * sem_prag.adb (Check_No_Link_Name): New procedure. + (Process_Import_Or_Interface): Use Check_No_Link_Name. + * cstand.adb (Create_Standard): Use Esize (Standard_Long_Long_Float) + instead of Standard_Long_Long_Float_Size global. Preparation for + eventual removal of per type constants. + * exp_util.ads (Get_Stream_Size): New function returning the stream + size value of subtype E. + * exp_util.adb (Get_Stream_Size): Implement new function. + * exp_strm.adb (Build_Elementary_Input_Call): Use Get_Stream_Size + function. + * exp_attr.adb (Attribute_Stream_Size): Use Get_Stream_Size + * einfo.adb: + (Machine_Mantissa_Value): Handle 128-bit quad precision IEEE floats + 2011-08-01 Geert Bosch * cstand.adb: Fix comments. diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 5b95a7ca8bb..8d9d798e9ae 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -1105,7 +1105,8 @@ package body CStand is Set_Ekind (Any_Real, E_Floating_Point_Type); Set_Scope (Any_Real, Standard_Standard); Set_Etype (Any_Real, Standard_Long_Long_Float); - Init_Size (Any_Real, Standard_Long_Long_Float_Size); + Init_Size (Any_Real, + UI_To_Int (Esize (Standard_Long_Long_Float))); Set_Elem_Alignment (Any_Real); Make_Name (Any_Real, "a real type"); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index deb0093de52..5e9731cc96c 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -6561,6 +6561,7 @@ package body Einfo is when 1 .. 6 => return Uint_24; when 7 .. 15 => return UI_From_Int (53); when 16 .. 18 => return Uint_64; + when 19 .. 33 => return UI_From_Int (113); when others => return No_Uint; end case; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index fe92f98cb1b..56ca1ae00ca 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -13,11 +13,10 @@ -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- You should have received a copy of the GNU General Public License along -- --- with this program; see file COPYING3. If not see -- --- . -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -4282,24 +4281,10 @@ package body Exp_Attr is -- Stream_Size -- ----------------- - when Attribute_Stream_Size => Stream_Size : declare - Size : Int; - - begin - -- If we have a Stream_Size clause for this type use it, otherwise - -- the Stream_Size if the size of the type. - - if Has_Stream_Size_Clause (Ptyp) then - Size := - UI_To_Int - (Static_Integer (Expression (Stream_Size_Clause (Ptyp)))); - else - Size := UI_To_Int (Esize (Ptyp)); - end if; - - Rewrite (N, Make_Integer_Literal (Loc, Intval => Size)); + when Attribute_Stream_Size => + Rewrite (N, + Make_Integer_Literal (Loc, Intval => Get_Stream_Size (Ptyp))); Analyze_And_Resolve (N, Typ); - end Stream_Size; ---------- -- Succ -- diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 0a22b0117e0..f9b62941757 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -25,6 +25,7 @@ with Atree; use Atree; with Einfo; use Einfo; +with Exp_Util; use Exp_Util; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -452,22 +453,13 @@ package body Exp_Strm is FST : constant Entity_Id := First_Subtype (U_Type); Strm : constant Node_Id := First (Expressions (N)); Targ : constant Node_Id := Next (Strm); - P_Size : Uint; + P_Size : constant Uint := Get_Stream_Size (FST); Res : Node_Id; Lib_RE : RE_Id; begin Check_Restriction (No_Default_Stream_Attributes, N); - -- Compute the size of the stream element. This is either the size of - -- the first subtype or if given the size of the Stream_Size attribute. - - if Has_Stream_Size_Clause (FST) then - P_Size := Static_Integer (Expression (Stream_Size_Clause (FST))); - else - P_Size := Esize (FST); - end if; - -- Check first for Boolean and Character. These are enumeration types, -- but we treat them specially, since they may require special handling -- in the transfer protocol. However, this special handling only applies diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2740bd12467..57f67e4c705 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -55,7 +55,6 @@ with Stringt; use Stringt; with Targparm; use Targparm; with Tbuild; use Tbuild; with Ttypes; use Ttypes; -with Uintp; use Uintp; with Urealp; use Urealp; with Validsw; use Validsw; @@ -2165,6 +2164,24 @@ package body Exp_Util is end; end Get_Current_Value_Condition; + --------------------- + -- Get_Stream_Size -- + --------------------- + + function Get_Stream_Size (E : Entity_Id) return Uint is + begin + -- If we have a Stream_Size clause for this type use it + + if Has_Stream_Size_Clause (E) then + return Static_Integer (Expression (Stream_Size_Clause (E))); + + -- Otherwise the Stream_Size if the size of the type + + else + return Esize (E); + end if; + end Get_Stream_Size; + --------------------------------- -- Has_Controlled_Coextensions -- --------------------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 4dee22950f1..5ef792b85aa 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -30,6 +30,7 @@ with Namet; use Namet; with Rtsfind; use Rtsfind; with Sinfo; use Sinfo; with Types; use Types; +with Uintp; use Uintp; package Exp_Util is @@ -444,6 +445,9 @@ package Exp_Util is -- N_Op_Eq), or to determine the result of some other test in other cases -- (e.g. no access check required if N_Op_Ne Null). + function Get_Stream_Size (E : Entity_Id) return Uint; + -- Return the stream size value of the subtype E + function Has_Controlled_Coextensions (Typ : Entity_Id) return Boolean; -- Determine whether a record type has anonymous access discriminants with -- a controlled designated type. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 540cb372b31..585981a87b5 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -436,6 +436,9 @@ package body Sem_Prag is -- If any argument has an identifier, then an error message is issued, -- and Pragma_Exit is raised. + procedure Check_No_Link_Name; + -- Checks that no link name is specified + procedure Check_Optional_Identifier (Arg : Node_Id; Id : Name_Id); -- Checks if the given argument has an identifier, and if so, requires -- it to match the given identifier name. If there is a non-matching @@ -1513,6 +1516,24 @@ package body Sem_Prag is end if; end Check_No_Identifiers; + ------------------------ + -- Check_No_Link_Name -- + ------------------------ + + procedure Check_No_Link_Name is + begin + if Present (Arg3) + and then Chars (Arg3) = Name_Link_Name + then + Arg4 := Arg3; + end if; + + if Present (Arg4) then + Error_Pragma_Arg + ("Link_Name argument not allowed for Import Intrinsic", Arg4); + end if; + end Check_No_Link_Name; + ------------------------------- -- Check_Optional_Identifier -- ------------------------------- @@ -3964,18 +3985,7 @@ package body Sem_Prag is -- Link_Name argument not allowed for intrinsic - if Present (Arg3) - and then Chars (Arg3) = Name_Link_Name - then - Arg4 := Arg3; - end if; - - if Present (Arg4) then - Error_Pragma_Arg - ("Link_Name argument not allowed for " & - "Import Intrinsic", - Arg4); - end if; + Check_No_Link_Name; Set_Is_Intrinsic_Subprogram (Def_Id); -- 2.30.2