[multiple changes]
2014-11-07 Ed Schonberg <schonberg@adacore.com> * exp_fixd.adb (Expand_Multiply_Fixed_By_Fixed_Giving_Integer): If the restriction No_Floating_Point is in effect, and the operands have the same type, introduce a temporary to hold the fixed point result, to prevent the use of floating-point operations at run-time. 2014-11-07 Robert Dewar <dewar@adacore.com> * freeze.adb (Check_Address_Clause): Minor reformatting (Find_Constant): Minor reformatting. (Freeze_Array_Type): Modify check for packed declarations. (Freeze_Entity): Minor reformatting. From-SVN: r217223
This commit is contained in:
Arnaud Charlet
parent
d862b3439d
commit
e8de1a820f
|
|
@ -1,3 +1,18 @@
|
|||
2014-11-07 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_fixd.adb (Expand_Multiply_Fixed_By_Fixed_Giving_Integer):
|
||||
If the restriction No_Floating_Point is in effect, and the
|
||||
operands have the same type, introduce a temporary to hold
|
||||
the fixed point result, to prevent the use of floating-point
|
||||
operations at run-time.
|
||||
|
||||
2014-11-07 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* freeze.adb (Check_Address_Clause): Minor reformatting
|
||||
(Find_Constant): Minor reformatting.
|
||||
(Freeze_Array_Type): Modify check for packed declarations.
|
||||
(Freeze_Entity): Minor reformatting.
|
||||
|
||||
2014-11-05 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnatvsn.ads (Library_Version): Bump to 5.0.
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -29,6 +29,8 @@ with Einfo; use Einfo;
|
|||
with Exp_Util; use Exp_Util;
|
||||
with Nlists; use Nlists;
|
||||
with Nmake; use Nmake;
|
||||
with Restrict; use Restrict;
|
||||
with Rident; use Rident;
|
||||
with Rtsfind; use Rtsfind;
|
||||
with Sem; use Sem;
|
||||
with Sem_Eval; use Sem_Eval;
|
||||
|
|
@ -2214,13 +2216,41 @@ package body Exp_Fixd is
|
|||
---------------------------------------------------
|
||||
|
||||
procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
|
||||
Left : constant Node_Id := Left_Opnd (N);
|
||||
Right : constant Node_Id := Right_Opnd (N);
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Left : constant Node_Id := Left_Opnd (N);
|
||||
Right : constant Node_Id := Right_Opnd (N);
|
||||
|
||||
begin
|
||||
if Etype (Left) = Universal_Real then
|
||||
Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
|
||||
|
||||
elsif Etype (Right) = Universal_Real then
|
||||
Do_Multiply_Fixed_Universal (N, Left, Right);
|
||||
|
||||
-- If both types are equal and we need to avoid floating point
|
||||
-- instructions, it's worth introducing a temporary with the
|
||||
-- common type, because it may be evaluated more simply without
|
||||
-- the need for run-time use of floating point.
|
||||
|
||||
elsif Etype (Right) = Etype (Left)
|
||||
and then Restriction_Active (No_Floating_Point)
|
||||
then
|
||||
declare
|
||||
Temp : constant Entity_Id := Make_Temporary (Loc, 'F');
|
||||
Mult : constant Node_Id := Make_Op_Multiply (Loc, Left, Right);
|
||||
Decl : constant Node_Id :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Temp,
|
||||
Object_Definition => New_Occurrence_Of (Etype (Right), Loc),
|
||||
Expression => Mult);
|
||||
|
||||
begin
|
||||
Insert_Action (N, Decl);
|
||||
Rewrite (N,
|
||||
OK_Convert_To (Etype (N), New_Occurrence_Of (Temp, Loc)));
|
||||
Analyze_And_Resolve (N, Standard_Integer);
|
||||
end;
|
||||
|
||||
else
|
||||
Do_Multiply_Fixed_Fixed (N);
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -111,7 +111,7 @@ package body Freeze is
|
|||
-- itself is frozen. Check that the expression does not include references
|
||||
-- to deferred constants without completion. We report this at the freeze
|
||||
-- point of the function, to provide a better error message.
|
||||
|
||||
--
|
||||
-- In most cases the expression itself is frozen by the time the function
|
||||
-- itself is frozen, because the formals will be frozen by then. However,
|
||||
-- Attribute references to outer types are freeze points for those types;
|
||||
|
|
@ -664,7 +664,6 @@ package body Freeze is
|
|||
if Present (Tag_Assign) then
|
||||
Append_Freeze_Action (E, Tag_Assign);
|
||||
end if;
|
||||
|
||||
end if;
|
||||
end if;
|
||||
end Check_Address_Clause;
|
||||
|
|
@ -1295,6 +1294,7 @@ package body Freeze is
|
|||
|
||||
elsif Nkind (Nod) = N_Attribute_Reference then
|
||||
Analyze (Prefix (Nod));
|
||||
|
||||
if Is_Entity_Name (Prefix (Nod))
|
||||
and then Is_Type (Entity (Prefix (Nod)))
|
||||
then
|
||||
|
|
@ -2398,24 +2398,6 @@ package body Freeze is
|
|||
Set_Has_Non_Standard_Rep (Base_Type (Arr), True);
|
||||
Set_Is_Bit_Packed_Array (Base_Type (Arr), True);
|
||||
Set_Is_Packed (Base_Type (Arr), True);
|
||||
|
||||
-- Make sure that we have the necessary routines to
|
||||
-- implement the packing, and complain now if not.
|
||||
|
||||
declare
|
||||
CS : constant Int := UI_To_Int (Csiz);
|
||||
RE : constant RE_Id := Get_Id (CS);
|
||||
|
||||
begin
|
||||
if RE /= RE_Null
|
||||
and then not RTE_Available (RE)
|
||||
then
|
||||
Error_Msg_CRT
|
||||
("packing of " & UI_Image (Csiz)
|
||||
& "-bit components",
|
||||
First_Subtype (Etype (Arr)));
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
|
@ -2668,6 +2650,37 @@ package body Freeze is
|
|||
Create_Packed_Array_Impl_Type (Arr);
|
||||
Freeze_And_Append (Packed_Array_Impl_Type (Arr), N, Result);
|
||||
|
||||
-- Make sure that we have the necessary routines to implement the
|
||||
-- packing, and complain now if not. Note that we only test this
|
||||
-- for constrained array types.
|
||||
|
||||
if Is_Constrained (Arr)
|
||||
and then Is_Bit_Packed_Array (Arr)
|
||||
and then Present (Packed_Array_Impl_Type (Arr))
|
||||
and then Is_Array_Type (Packed_Array_Impl_Type (Arr))
|
||||
then
|
||||
declare
|
||||
CS : constant Uint := Component_Size (Arr);
|
||||
RE : constant RE_Id := Get_Id (UI_To_Int (CS));
|
||||
|
||||
begin
|
||||
if RE /= RE_Null
|
||||
and then not RTE_Available (RE)
|
||||
then
|
||||
Error_Msg_CRT
|
||||
("packing of " & UI_Image (CS) & "-bit components",
|
||||
First_Subtype (Etype (Arr)));
|
||||
|
||||
-- Cancel the packing
|
||||
|
||||
Set_Is_Packed (Base_Type (Arr), False);
|
||||
Set_Is_Bit_Packed_Array (Base_Type (Arr), False);
|
||||
Set_Packed_Array_Impl_Type (Arr, Empty);
|
||||
goto Skip_Packed;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Size information of packed array type is copied to the array
|
||||
-- type, since this is really the representation. But do not
|
||||
-- override explicit existing size values. If the ancestor subtype
|
||||
|
|
@ -2689,6 +2702,8 @@ package body Freeze is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
<<Skip_Packed>>
|
||||
|
||||
-- For non-packed arrays set the alignment of the array to the
|
||||
-- alignment of the component type if it is unknown. Skip this
|
||||
-- in atomic case (atomic arrays may need larger alignments).
|
||||
|
|
@ -4561,12 +4576,12 @@ package body Freeze is
|
|||
if Is_CPP_Class (Etype (E)) then
|
||||
Error_Msg_NE
|
||||
("\} may need a cpp_constructor",
|
||||
Object_Definition (Parent (E)), Etype (E));
|
||||
Object_Definition (Parent (E)), Etype (E));
|
||||
|
||||
elsif Present (Expression (Parent (E))) then
|
||||
Error_Msg_N -- CODEFIX
|
||||
("\maybe a class-wide type was meant",
|
||||
Object_Definition (Parent (E)));
|
||||
Object_Definition (Parent (E)));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
|
@ -5432,7 +5447,7 @@ package body Freeze is
|
|||
Check_Suspicious_Modulus (E);
|
||||
end if;
|
||||
|
||||
-- the pool applies to named and anonymous access types, but not
|
||||
-- The pool applies to named and anonymous access types, but not
|
||||
-- to subprogram and to internal types generated for 'Access
|
||||
-- references.
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue