-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
Pkg : RE_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
case Float_Rep (Btyp) is
when IEEE_Binary =>
Find_Fat_Info (Ptyp, Ftp, Pkg);
- -- If the floating-point object might be unaligned, we
- -- need to call the special routine Unaligned_Valid,
- -- which makes the needed copy, being careful not to
- -- load the value into any floating-point register.
- -- The argument in this case is obj'Address (see
- -- Unaligned_Valid routine in Fat_Gen).
-
- if Is_Possibly_Unaligned_Object (Pref) then
- Expand_Fpt_Attribute
- (N, Pkg, Name_Unaligned_Valid,
- New_List (
- Make_Attribute_Reference (Loc,
- Prefix => Relocate_Node (Pref),
- Attribute_Name => Name_Address)));
-
- -- In the normal case where we are sure the object is
- -- aligned, we generate a call to Valid, and the argument
- -- in this case is obj'Unrestricted_Access (after
- -- converting obj to the right floating-point type).
+ -- 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');
- else
- Expand_Fpt_Attribute
- (N, Pkg, Name_Valid,
- New_List (
- Make_Attribute_Reference (Loc,
- Prefix => Unchecked_Convert_To (Ftp, Pref),
- Attribute_Name => Name_Unrestricted_Access)));
+ 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 :=
+ 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
+ -- 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;
-- One more task, we still need a range check. Required
Left_Opnd => Relocate_Node (N),
Right_Opnd =>
Make_In (Loc,
- Left_Opnd => Convert_To (Btyp, Pref),
+ Left_Opnd => Convert_To (Btyp, Pref),
Right_Opnd => New_Occurrence_Of (Ptyp, Loc))));
end if;
end;
-- be an abnormal value that cannot be passed in a floating-point
-- register, and the whole point of 'Valid is to prevent exceptions.
-- Note that the object of type T must have the natural alignment
- -- for type T. See Unaligned_Valid for further discussion.
-
- function Unaligned_Valid (A : System.Address) return Boolean;
- -- This version of Valid is used if the floating-point value to
- -- be checked is not known to be aligned (for example it appears
- -- in a packed record). In this case, we cannot call Valid since
- -- Valid assumes proper full alignment. Instead Unaligned_Valid
- -- performs the same processing for a possibly unaligned float,
- -- by first doing a copy and then calling Valid. One might think
- -- that the front end could simply do a copy to an aligned temp,
- -- but remember that we may have an abnormal value that cannot
- -- be copied into a floating-point register, so things are a bit
- -- 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.
+ -- for type T.
+
+ type S is new String (1 .. T'Size / Character'Size);
+ type P is access all S with Storage_Size => 0;
+ -- Buffer and access types used to initialize temporaries for validity
+ -- checks, if the value to be checked has reverse scalar storage order, or
+ -- is not known to be properly aligned (for example it appears in a packed
+ -- record). In this case, we cannot call Valid since Valid assumes proper
+ -- full alignment. Instead, we copy the value to a temporary location using
+ -- type S (we cannot simply do a copy of a T value, because the value might
+ -- be invalid, in which case it might not be possible to copy it through a
+ -- floating point register).
private
pragma Inline (Machine);