OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Geert Bosch 2011-08-01 12:41:48 +00:00 committed by Arnaud Charlet
parent 655b30bfde
commit 9eea4346af
8 changed files with 72 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
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.

3
gcc/ada/cstand.adb
View File

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

1
gcc/ada/einfo.adb
View File

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

29
gcc/ada/exp_attr.adb
View File

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

12
gcc/ada/exp_strm.adb
View File

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

19
gcc/ada/exp_util.adb
View File

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

4
gcc/ada/exp_util.ads
View File

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

34
gcc/ada/sem_prag.adb
View File

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