FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2014-08-04  Thomas Quinot  <quinot@adacore.com>

	* s-fatgen.ads, s-fatgen.adb (S, P): New visible type declarations
	(Unaligned_Valid): Remove now unused subprogram.
	* exp_attr.adb (Expand_N_Attribute_Reference, case
	Attribute_Valid): If the prefix is in reverse SSO or potentially
	unaligned, copy it using a byte copy operation to a temporary
	variable.
	* einfo.adb: Minor comment fix.

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb (Freeze_Entity): Do not freeze formal subprograms.

From-SVN: r213540
This commit is contained in:
Arnaud Charlet 2014-08-04 10:11:06 +02:00
parent 8616baee3a
commit 8575023cdc
6 changed files with 117 additions and 71 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gcc/ada/ChangeLog
View file

@ -1,3 +1,17 @@
2014-08-04 Thomas Quinot <quinot@adacore.com>
* s-fatgen.ads, s-fatgen.adb (S, P): New visible type declarations
(Unaligned_Valid): Remove now unused subprogram.
* exp_attr.adb (Expand_N_Attribute_Reference, case
Attribute_Valid): If the prefix is in reverse SSO or potentially
unaligned, copy it using a byte copy operation to a temporary
variable.
* einfo.adb: Minor comment fix.
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb (Freeze_Entity): Do not freeze formal subprograms.
2014-08-04 Robert Dewar <dewar@adacore.com> 2014-08-04 Robert Dewar <dewar@adacore.com>
* s-imgrea.adb (Image_Floating_Point): Don't add space before +Inf. * s-imgrea.adb (Image_Floating_Point): Don't add space before +Inf.

2
gcc/ada/einfo.adb
View file

@ -563,7 +563,7 @@ package body Einfo is
-- (Has_Protected) Flag271 -- (Has_Protected) Flag271
-- (SSO_Set_Low_By_Default) Flag272 -- (SSO_Set_Low_By_Default) Flag272
-- (SSO_Set_Low_By_Default) Flag273 -- (SSO_Set_High_By_Default) Flag273
-- Is_Generic_Actual_Subprogram Flag274 -- Is_Generic_Actual_Subprogram Flag274
-- No_Predicate_On_Actual Flag275 -- No_Predicate_On_Actual Flag275

110
gcc/ada/exp_attr.adb
View file

@ -23,6 +23,7 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Aspects; use Aspects;
with Atree; use Atree; with Atree; use Atree;
with Checks; use Checks; with Checks; use Checks;
with Einfo; use Einfo; with Einfo; use Einfo;
@ -6406,6 +6407,23 @@ package body Exp_Attr is
Pkg : RE_Id; Pkg : RE_Id;
Ftp : Entity_Id; Ftp : Entity_Id;
function Get_Fat_Entity (Nam : Name_Id) return Entity_Id;
-- Return entity for Pkg.Nam
--------------------
-- Get_Fat_Entity --
--------------------
function Get_Fat_Entity (Nam : Name_Id) return Entity_Id is
Exp_Name : constant Node_Id :=
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (RTE (Pkg), Loc),
Selector_Name => Make_Identifier (Loc, Nam));
begin
Find_Selected_Component (Exp_Name);
return Entity (Exp_Name);
end Get_Fat_Entity;
begin begin
case Float_Rep (Btyp) is case Float_Rep (Btyp) is
@ -6419,34 +6437,76 @@ package body Exp_Attr is
when IEEE_Binary => when IEEE_Binary =>
Find_Fat_Info (Ptyp, Ftp, Pkg); Find_Fat_Info (Ptyp, Ftp, Pkg);
-- If the floating-point object might be unaligned, we -- If the prefix is a reverse SSO component, or is
-- need to call the special routine Unaligned_Valid, -- possibly unaligned, first create a temporary copy
-- which makes the needed copy, being careful not to -- that is in native SSO, and properly aligned. Make it
-- load the value into any floating-point register. -- Volatile to prevent folding in the back-end. Note
-- The argument in this case is obj'Address (see -- that we use an intermediate constrained string type
-- Unaligned_Valid routine in Fat_Gen). -- to initialize the temporary, as the value at hand
-- might be invalid, and in that case it cannot be copied
-- using a floating point register.
if Is_Possibly_Unaligned_Object (Pref) then if In_Reverse_Storage_Order_Object (Pref)
Expand_Fpt_Attribute or else
(N, Pkg, Name_Unaligned_Valid, Is_Possibly_Unaligned_Object (Pref)
New_List ( then
Make_Attribute_Reference (Loc, declare
Prefix => Relocate_Node (Pref), Temp : constant Entity_Id :=
Attribute_Name => Name_Address))); Make_Temporary (Loc, 'F');
-- In the normal case where we are sure the object is Fat_S : constant Entity_Id :=
-- aligned, we generate a call to Valid, and the argument Get_Fat_Entity (Name_S);
-- in this case is obj'Unrestricted_Access (after -- Constrained string subtype of appropriate size
-- converting obj to the right floating-point type).
else Fat_P : constant Entity_Id :=
Expand_Fpt_Attribute Get_Fat_Entity (Name_P);
(N, Pkg, Name_Valid, -- Access to Fat_S
New_List (
Make_Attribute_Reference (Loc, Decl : constant Node_Id :=
Prefix => Unchecked_Convert_To (Ftp, Pref), Make_Object_Declaration (Loc,
Attribute_Name => Name_Unrestricted_Access))); Defining_Identifier => Temp,
Aliased_Present => True,
Object_Definition =>
New_Occurrence_Of (Ptyp, Loc));
begin
Set_Aspect_Specifications (Decl, New_List (
Make_Aspect_Specification (Loc,
Identifier =>
Make_Identifier (Loc, Name_Volatile))));
Insert_Actions (N,
New_List (
Decl,
Make_Assignment_Statement (Loc,
Name =>
Make_Explicit_Dereference (Loc,
Prefix =>
Unchecked_Convert_To (Fat_P,
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Temp, Loc),
Attribute_Name =>
Name_Unrestricted_Access))),
Expression =>
Unchecked_Convert_To (Fat_S,
Relocate_Node (Pref)))),
Suppress => All_Checks);
Rewrite (Pref, New_Occurrence_Of (Temp, Loc));
end;
end if; end if;
-- We now have an object of the proper endianness and
-- alignment, and can call the Valid runtime routine.
Expand_Fpt_Attribute
(N, Pkg, Name_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Unchecked_Convert_To (Ftp, Pref),
Attribute_Name => Name_Unrestricted_Access)));
end case; end case;
-- One more task, we still need a range check. Required -- One more task, we still need a range check. Required
@ -6462,7 +6522,7 @@ package body Exp_Attr is
Left_Opnd => Relocate_Node (N), Left_Opnd => Relocate_Node (N),
Right_Opnd => Right_Opnd =>
Make_In (Loc, Make_In (Loc,
Left_Opnd => Convert_To (Btyp, Pref), Left_Opnd => Convert_To (Btyp, Pref),
Right_Opnd => New_Occurrence_Of (Ptyp, Loc)))); Right_Opnd => New_Occurrence_Of (Ptyp, Loc))));
end if; end if;
end; end;

8
gcc/ada/freeze.adb
View file

@ -3818,8 +3818,12 @@ package body Freeze is
then then
return No_List; return No_List;
-- Generic types need no freeze node and have no delayed semantic -- Formal subprograms are never frozen
-- checks.
elsif Is_Formal_Subprogram (E) then
return No_List;
-- Generic types are never frozen as they lack delayed semantic checks
elsif Is_Generic_Type (E) then elsif Is_Generic_Type (E) then
return No_List; return No_List;

26
gcc/ada/s-fatgen.adb
View file

@ -918,30 +918,4 @@ package body System.Fat_Gen is
((E = IEEE_Emin - 1) and then abs To_Float (SR) = 1.0); ((E = IEEE_Emin - 1) and then abs To_Float (SR) = 1.0);
end Valid; end Valid;
---------------------
-- Unaligned_Valid --
---------------------
function Unaligned_Valid (A : System.Address) return Boolean is
subtype FS is String (1 .. T'Size / Character'Size);
type FSP is access FS;
function To_FSP is new Ada.Unchecked_Conversion (Address, FSP);
Local_T : aliased T;
begin
-- Note that we have to be sure that we do not load the value into a
-- floating-point register, since a signalling NaN may cause a trap.
-- The following assignment is what does the actual alignment, since
-- we know that the target Local_T is aligned.
To_FSP (Local_T'Address).all := To_FSP (A).all;
-- Now that we have an aligned value, we can use the normal aligned
-- version of Valid to obtain the required result.
return Valid (Local_T'Access);
end Unaligned_Valid;
end System.Fat_Gen; end System.Fat_Gen;

28
gcc/ada/s-fatgen.ads
View file

@ -94,24 +94,18 @@ package System.Fat_Gen is
-- be an abnormal value that cannot be passed in a floating-point -- be an abnormal value that cannot be passed in a floating-point
-- register, and the whole point of 'Valid is to prevent exceptions. -- register, and the whole point of 'Valid is to prevent exceptions.
-- Note that the object of type T must have the natural alignment -- Note that the object of type T must have the natural alignment
-- for type T. See Unaligned_Valid for further discussion. -- for type T.
function Unaligned_Valid (A : System.Address) return Boolean; type S is new String (1 .. T'Size / Character'Size);
-- This version of Valid is used if the floating-point value to type P is access all S with Storage_Size => 0;
-- be checked is not known to be aligned (for example it appears -- Buffer and access types used to initialize temporaries for validity
-- in a packed record). In this case, we cannot call Valid since -- checks, if the value to be checked has reverse scalar storage order, or
-- Valid assumes proper full alignment. Instead Unaligned_Valid -- is not known to be properly aligned (for example it appears in a packed
-- performs the same processing for a possibly unaligned float, -- record). In this case, we cannot call Valid since Valid assumes proper
-- by first doing a copy and then calling Valid. One might think -- full alignment. Instead, we copy the value to a temporary location using
-- that the front end could simply do a copy to an aligned temp, -- type S (we cannot simply do a copy of a T value, because the value might
-- but remember that we may have an abnormal value that cannot -- be invalid, in which case it might not be possible to copy it through a
-- be copied into a floating-point register, so things are a bit -- floating point register).
-- trickier than one might expect.
--
-- Note: Unaligned_Valid is never called for a target which does
-- not require strict alignment (e.g. the ia32/x86), since on a
-- target not requiring strict alignment, it is fine to pass a
-- non-aligned value to the standard Valid routine.
private private
pragma Inline (Machine); pragma Inline (Machine);