Commit 88438c0e by Arnaud Charlet Committed by Arnaud Charlet

exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]): Disable expansion…

exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]): Disable expansion when generating C code.

2016-04-20  Arnaud Charlet  <charlet@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]):
	Disable expansion when generating C code.
	* sinfo.ads, inline.ads: Minor editing.

From-SVN: r235247
parent c37e6613
2016-04-20 Arnaud Charlet <charlet@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference [Attribute_Valid]):
Disable expansion when generating C code.
* sinfo.ads, inline.ads: Minor editing.
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com> 2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_util.adb, contracts.adb, ghost.adb, exp_ch6.adb: Minor * sem_util.adb, contracts.adb, ghost.adb, exp_ch6.adb: Minor
......
...@@ -6352,96 +6352,93 @@ package body Exp_Attr is ...@@ -6352,96 +6352,93 @@ package body Exp_Attr is
-- Start of processing for Float_Valid -- Start of processing for Float_Valid
begin begin
case Float_Rep (Btyp) is -- The C and AAMP back-ends handle Valid for fpt types
-- The AAMP back end handles Valid for floating-point types
when AAMP =>
Analyze_And_Resolve (Pref, Ptyp);
Set_Etype (N, Standard_Boolean);
Set_Analyzed (N);
when IEEE_Binary =>
Find_Fat_Info (Ptyp, Ftp, Pkg);
-- If the prefix is a reverse SSO component, or is
-- possibly unaligned, first create a temporary copy
-- that is in native SSO, and properly aligned. Make it
-- Volatile to prevent folding in the back-end. Note
-- that we use an intermediate constrained string type
-- 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 In_Reverse_Storage_Order_Object (Pref)
or else
Is_Possibly_Unaligned_Object (Pref)
then
declare
Temp : constant Entity_Id :=
Make_Temporary (Loc, 'F');
Fat_S : constant Entity_Id :=
Get_Fat_Entity (Name_S);
-- Constrained string subtype of appropriate size
Fat_P : constant Entity_Id :=
Get_Fat_Entity (Name_P);
-- Access to Fat_S
Decl : constant Node_Id := if Generate_C_Code or else Float_Rep (Btyp) = AAMP then
Make_Object_Declaration (Loc, Analyze_And_Resolve (Pref, Ptyp);
Defining_Identifier => Temp, Set_Etype (N, Standard_Boolean);
Aliased_Present => True, Set_Analyzed (N);
Object_Definition =>
New_Occurrence_Of (Ptyp, Loc));
begin else
Set_Aspect_Specifications (Decl, New_List ( Find_Fat_Info (Ptyp, Ftp, Pkg);
Make_Aspect_Specification (Loc,
Identifier => -- If the prefix is a reverse SSO component, or is possibly
Make_Identifier (Loc, Name_Volatile)))); -- unaligned, first create a temporary copy that is in
-- native SSO, and properly aligned. Make it Volatile to
Insert_Actions (N, -- prevent folding in the back-end. Note that we use an
New_List ( -- intermediate constrained string type to initialize the
Decl, -- temporary, as the value at hand might be invalid, and in
-- that case it cannot be copied using a floating point
Make_Assignment_Statement (Loc, -- register.
Name =>
Make_Explicit_Dereference (Loc, if In_Reverse_Storage_Order_Object (Pref)
Prefix => or else Is_Possibly_Unaligned_Object (Pref)
Unchecked_Convert_To (Fat_P, then
Make_Attribute_Reference (Loc, declare
Prefix => Temp : constant Entity_Id :=
New_Occurrence_Of (Temp, Loc), Make_Temporary (Loc, 'F');
Attribute_Name =>
Name_Unrestricted_Access))), Fat_S : constant Entity_Id :=
Expression => Get_Fat_Entity (Name_S);
Unchecked_Convert_To (Fat_S, -- Constrained string subtype of appropriate size
Relocate_Node (Pref)))),
Fat_P : constant Entity_Id :=
Suppress => All_Checks); Get_Fat_Entity (Name_P);
-- Access to Fat_S
Rewrite (Pref, New_Occurrence_Of (Temp, Loc));
end; Decl : constant Node_Id :=
end if; Make_Object_Declaration (Loc,
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;
-- We now have an object of the proper endianness and -- We now have an object of the proper endianness and
-- alignment, and can construct a Valid attribute. -- alignment, and can construct a Valid attribute.
-- We make sure the prefix of this valid attribute is -- We make sure the prefix of this valid attribute is
-- marked as not coming from source, to avoid losing -- marked as not coming from source, to avoid losing
-- warnings from 'Valid looking like a possible update. -- warnings from 'Valid looking like a possible update.
Set_Comes_From_Source (Pref, False); Set_Comes_From_Source (Pref, False);
Expand_Fpt_Attribute Expand_Fpt_Attribute
(N, Pkg, Name_Valid, (N, Pkg, Name_Valid,
New_List ( New_List (
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Unchecked_Convert_To (Ftp, Pref), Prefix => Unchecked_Convert_To (Ftp, Pref),
Attribute_Name => Name_Unrestricted_Access))); Attribute_Name => Name_Unrestricted_Access)));
end case; end if;
-- One more task, we still need a range check. Required -- One more task, we still need a range check. Required
-- only if we have a constraint, since the Valid routine -- only if we have a constraint, since the Valid routine
......
...@@ -74,9 +74,9 @@ package Inline is ...@@ -74,9 +74,9 @@ package Inline is
-- must be inhibited. -- must be inhibited.
Current_Sem_Unit : Unit_Number_Type; Current_Sem_Unit : Unit_Number_Type;
-- The semantic unit within which the instantiation is found. Must -- The semantic unit within which the instantiation is found. Must be
-- be restored when compiling the body, to insure that internal enti- -- restored when compiling the body, to insure that internal entities
-- ties use the same counter and are unique over spec and body. -- use the same counter and are unique over spec and body.
Scope_Suppress : Suppress_Record; Scope_Suppress : Suppress_Record;
Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr; Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
......
...@@ -879,9 +879,9 @@ package Sinfo is ...@@ -879,9 +879,9 @@ package Sinfo is
-- Present in subprogram declarations. Denotes analyzed but unexpanded -- Present in subprogram declarations. Denotes analyzed but unexpanded
-- body of subprogram, to be used when inlining calls. Present when the -- body of subprogram, to be used when inlining calls. Present when the
-- subprogram has an Inline pragma and inlining is enabled. If the -- subprogram has an Inline pragma and inlining is enabled. If the
-- declaration is completed by a renaming_as_body, and the renamed en- -- declaration is completed by a renaming_as_body, and the renamed entity
-- tity is a subprogram, the Body_To_Inline is the name of that entity, -- is a subprogram, the Body_To_Inline is the name of that entity, which
-- which is used directly in later calls to the original subprogram. -- is used directly in later calls to the original subprogram.
-- Body_Required (Flag13-Sem) -- Body_Required (Flag13-Sem)
-- A flag that appears in the N_Compilation_Unit node indicating that -- A flag that appears in the N_Compilation_Unit node indicating that
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment