+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.
-- --
-- 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- --
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;
---------------------------------------------------
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;
-- 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;
if Present (Tag_Assign) then
Append_Freeze_Action (E, Tag_Assign);
end if;
-
end if;
end if;
end Check_Address_Clause;
elsif Nkind (Nod) = N_Attribute_Reference then
Analyze (Prefix (Nod));
+
if Is_Entity_Name (Prefix (Nod))
and then Is_Type (Entity (Prefix (Nod)))
then
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;
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
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).
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;
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.
projects / gcc.git / commitdiff