sem_prag.adb (Check_No_Link_Name): New procedure.

2011-08-01  Geert Bosch  <bosch@adacore.com>

	* 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

 2011-08-01  Geert Bosch  <bosch@adacore.com>
 
+	* 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  <bosch@adacore.com>
+
 	* cstand.adb: Fix comments.
 	* sem_prag.adb (Analyze_Pragma): Use List_Length instead of explicit
 	count of arguments.

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");
 

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;
 

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                        --
--- <http://www.gnu.org/licenses/>.                                          --
+-- 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 --

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

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 --
    ---------------------------------

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.

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);