* 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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177026
138bc75d-0d04-0410-961f-
82ee72b054a4
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.
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");
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;
-- 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. --
-- 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 --
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;
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
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
-with Uintp; use Uintp;
with Urealp; use Urealp;
with Validsw; use Validsw;
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 --
---------------------------------
with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo;
with Types; use Types;
+with Uintp; use Uintp;
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.
-- 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
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 --
-------------------------------
-- 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);
OSDN Git Service
