+2017-05-02 Eric Botcazou <ebotcazou@adacore.com>
+
+ * opt.ads: Add missing GNAT markers in comments.
+ * opt.adb (Set_Opt_Config_Switches): Do not override earlier
+ settings of Optimize_Alignment at the end.
+
+2017-05-02 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * checks.adb (Apply_Constraint_Check): Do not apply
+ a discriminant check when the associated type is a constrained
+ subtype created for an unconstrained nominal type.
+ * exp_attr.adb: Minor reformatting.
+
+2017-05-02 Bob Duff <duff@adacore.com>
+
+ * sem_ch3.adb (OK_For_Limited_Init_In_05): Handle correctly
+ the N_Raise_Expression case.
+ * sem_ch6.adb (Check_Limited_Return): Minor: clarify comment,
+ and add assertions.
+
+2017-05-02 Yannick Moy <moy@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Op_Ne): Do not bump parenthese level and
+ optimize length comparison in GNATprove mode.
+ * exp_spark.adb (Expand_SPARK_Op_Ne): New function to rewrite
+ operator /= into negation of operator = when needed.
+ (Expand_SPARK): Call new
+ function to expand operator /=.
+
+2017-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_fixd.adb (Expand_Divide_Fixed_By_Fixed_Giving_Fixed):
+ Simplify the expression for a fixed-fixed division to remove
+ divisions by constants whenever possible, as an optimization
+ for restricted targets.
+
2017-05-02 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb, sem_ch3.adb, sem_ch6.adb: Minor reformatting.
Apply_Range_Check (N, Typ);
+ -- Do not install a discriminant check for a constrained subtype
+ -- created for an unconstrained nominal type because the subtype
+ -- has the correct constraints by construction.
+
elsif Has_Discriminants (Base_Type (Desig_Typ))
- and then Is_Constrained (Desig_Typ)
+ and then Is_Constrained (Desig_Typ)
+ and then not Is_Constr_Subt_For_U_Nominal (Desig_Typ)
then
Apply_Discriminant_Check (N, Typ);
end if;
-- value returned is the entity of the constructed function body. We do not
-- bother to generate a separate spec for this subprogram.
+ function Build_Disp_Get_Task_Id_Call (Actual : Node_Id) return Node_Id;
+ -- Build a call to Disp_Get_Task_Id, passing Actual as actual parameter
+
function Build_Record_VS_Func
(R_Type : Entity_Id;
Nod : Node_Id) return Entity_Id;
return Func_Id;
end Build_Array_VS_Func;
+ ---------------------------------
+ -- Build_Disp_Get_Task_Id_Call --
+ ---------------------------------
+
+ function Build_Disp_Get_Task_Id_Call (Actual : Node_Id) return Node_Id is
+ Typ : constant Entity_Id := Etype (Actual);
+ Id : constant Node_Id :=
+ New_Occurrence_Of
+ (Find_Prim_Op (Typ, Name_uDisp_Get_Task_Id), Sloc (Actual));
+ Result : constant Node_Id :=
+ Make_Function_Call (Sloc (Actual),
+ Name => Id,
+ Parameter_Associations => New_List (Actual));
+ begin
+ return Result;
+ end Build_Disp_Get_Task_Id_Call;
+
--------------------------
-- Build_Record_VS_Func --
--------------------------
-- Transforms 'Callable attribute into a call to the Callable function
when Attribute_Callable =>
+
-- We have an object of a task interface class-wide type as a prefix
-- to Callable. Generate:
-- callable (Task_Id (Pref._disp_get_task_id));
and then Is_Interface (Ptyp)
and then Is_Task_Interface (Ptyp)
then
- declare
- Id : constant Node_Id :=
- New_Occurrence_Of
- (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
- Call : constant Node_Id :=
- Make_Function_Call (Loc,
- Name => Id,
- Parameter_Associations => New_List (Pref));
- begin
- Rewrite (N,
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Callable), Loc),
- Parameter_Associations => New_List (
- Make_Unchecked_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
- Expression => Call))));
- end;
+ Rewrite (N,
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Callable), Loc),
+ Parameter_Associations => New_List (
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
+ Expression => Build_Disp_Get_Task_Id_Call (Pref)))));
else
- Rewrite (N,
- Build_Call_With_Task (Pref, RTE (RE_Callable)));
+ Rewrite (N, Build_Call_With_Task (Pref, RTE (RE_Callable)));
end if;
Analyze_And_Resolve (N, Standard_Boolean);
and then Is_Interface (Ptyp)
and then Is_Task_Interface (Ptyp)
then
- declare
- Id : constant Node_Id :=
- New_Occurrence_Of
- (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
- Call : constant Node_Id :=
- Make_Function_Call (Loc,
- Name => Id,
- Parameter_Associations => New_List (Pref));
- begin
- Rewrite (N, Unchecked_Convert_To (Id_Kind, Call));
- end;
+ Rewrite
+ (N, Unchecked_Convert_To
+ (Id_Kind, Build_Disp_Get_Task_Id_Call (Pref)));
else
Rewrite (N,
and then Is_Interface (Ptyp)
and then Is_Task_Interface (Ptyp)
then
- declare
- Id : constant Node_Id :=
- New_Occurrence_Of
- (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
- Call : constant Node_Id :=
- Make_Function_Call (Loc,
- Name => Id,
- Parameter_Associations => New_List (Pref));
- begin
- Rewrite (N,
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Terminated), Loc),
- Parameter_Associations => New_List (
- Make_Unchecked_Type_Conversion (Loc,
- Subtype_Mark =>
- New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
- Expression => Call))));
- end;
+ Rewrite (N,
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Terminated), Loc),
+ Parameter_Associations => New_List (
+ Make_Unchecked_Type_Conversion (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
+ Expression => Build_Disp_Get_Task_Id_Call (Pref)))));
elsif Restricted_Profile then
Rewrite (N,
-- the same visibility as in the generic unit. This avoids duplicating
-- or factoring the complex code for record/array equality tests etc.
+ -- This case is also used for the minimal expansion performed in
+ -- GNATprove mode.
+
else
declare
Loc : constant Source_Ptr := Sloc (N);
Make_Op_Eq (Loc,
Left_Opnd => Left_Opnd (N),
Right_Opnd => Right_Opnd (N)));
- Set_Paren_Count (Right_Opnd (Neg), 1);
+
+ -- The level of parentheses is useless in GNATprove mode, and
+ -- bumping its level here leads to wrong columns being used in
+ -- check messages, hence skip it in this mode.
+
+ if not GNATprove_Mode then
+ Set_Paren_Count (Right_Opnd (Neg), 1);
+ end if;
if Scope (Ne) /= Standard_Standard then
Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
end;
end if;
- Optimize_Length_Comparison (N);
+ -- No need for optimization in GNATprove mode, where we would rather see
+ -- the original source expression.
+
+ if not GNATprove_Mode then
+ Optimize_Length_Comparison (N);
+ end if;
end Expand_N_Op_Ne;
---------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, 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- --
else
Do_Divide_Fixed_Fixed (N);
+
+ -- A focused optimization: if after constant folding the
+ -- expression is of the form: T ((Exp * D) / D), where D is
+ -- a static constant, return T (Exp). This form will show up
+ -- when D is the denominator of the static expression for the
+ -- 'small of fixed-point types involved. This transformation
+ -- removes a division that may be expensive on some targets.
+
+ if Nkind (N) = N_Type_Conversion
+ and then Nkind (Expression (N)) = N_Op_Divide
+ then
+ declare
+ Num : constant Node_Id := Left_Opnd (Expression (N));
+ Den : constant Node_Id := Right_Opnd (Expression (N));
+
+ begin
+ if Nkind (Den) = N_Integer_Literal
+ and then Nkind (Num) = N_Op_Multiply
+ and then Nkind (Right_Opnd (Num)) = N_Integer_Literal
+ and then Intval (Den) = Intval (Right_Opnd (Num))
+ then
+ Rewrite (Expression (N), Left_Opnd (Num));
+ end if;
+ end;
+ end if;
end if;
end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
+with Exp_Ch4;
with Exp_Ch5; use Exp_Ch5;
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
procedure Expand_SPARK_N_Object_Renaming_Declaration (N : Node_Id);
-- Perform name evaluation for a renamed object
+ procedure Expand_SPARK_Op_Ne (N : Node_Id);
+ -- Rewrite operator /= based on operator = when defined explicitly
+
------------------
-- Expand_SPARK --
------------------
when N_Object_Renaming_Declaration =>
Expand_SPARK_N_Object_Renaming_Declaration (N);
+ when N_Op_Ne =>
+ Expand_SPARK_Op_Ne (N);
+
when N_Freeze_Entity =>
if Is_Type (Entity (N)) then
Expand_SPARK_Freeze_Type (Entity (N));
Evaluate_Name (Name (N));
end Expand_SPARK_N_Object_Renaming_Declaration;
+ ------------------------
+ -- Expand_SPARK_Op_Ne --
+ ------------------------
+
+ procedure Expand_SPARK_Op_Ne (N : Node_Id) is
+ Typ : constant Entity_Id := Etype (Left_Opnd (N));
+
+ begin
+ -- Case of elementary type with standard operator
+
+ if Is_Elementary_Type (Typ)
+ and then Sloc (Entity (N)) = Standard_Location
+ then
+ null;
+
+ else
+ Exp_Ch4.Expand_N_Op_Ne (N);
+ end if;
+ end Expand_SPARK_Op_Ne;
+
-------------------------------------
-- Expand_SPARK_Potential_Renaming --
-------------------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, 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- --
External_Name_Exp_Casing := As_Is;
External_Name_Imp_Casing := Lowercase;
Optimize_Alignment := 'O';
+ Optimize_Alignment_Local := True;
Persistent_BSS_Mode := False;
Prefix_Exception_Messages := True;
Uneval_Old := 'E';
Use_VADS_Size := False;
- Optimize_Alignment_Local := True;
-- Note: we do not need to worry about Warnings_As_Errors_Count since
-- we do not expect to get any warnings from compiling such a unit.
Default_Pool := Default_Pool_Config;
Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
Fast_Math := Fast_Math_Config;
- Optimize_Alignment := Optimize_Alignment_Config;
Polling_Required := Polling_Required_Config;
end Set_Opt_Config_Switches;
-- type with the semantics that each value does more than the previous one.
Optimize_Alignment : Character := 'O';
+ -- GNAT
-- Setting of Optimize_Alignment, set to T/S/O for time/space/off. Can
-- be modified by use of pragma Optimize_Alignment.
Optimize_Alignment_Local : Boolean := False;
+ -- GNAT
-- Set True if Optimize_Alignment mode is set by a local configuration
-- pragma that overrides the gnat.adc (or other configuration file) default
-- so that the unit is not dependent on the default setting. Also always
Optimization_Level : Int;
pragma Import (C, Optimization_Level, "optimize");
+ -- GNAT
-- Constant reflecting the optimization level (0,1,2,3 for -O0,-O1,-O2,-O3)
Optimize_Size : Int;
pragma Import (C, Optimize_Size, "optimize_size");
+ -- GNAT
-- Constant reflecting setting of -Os (optimize for size). Set to nonzero
-- in -Os mode and set to zero otherwise.
when N_Attribute_Reference =>
return Attribute_Name (Original_Node (Exp)) = Name_Input;
+ -- "return raise ..." is OK
+
+ when N_Raise_Expression =>
+ return True;
+
-- For a case expression, all dependent expressions must be legal
when N_Case_Expression =>
& "(RM-2005 6.5(5.5/2))?y?", Expr);
end if;
- -- Ada 95 mode, compatibility warnings disabled
+ -- Ada 95 mode, and compatibility warnings disabled
else
+ pragma Assert (Ada_Version <= Ada_95);
+ pragma Assert (not (Warn_On_Ada_2005_Compatibility or GNAT_Mode));
return; -- skip continuation messages below
end if;
projects / gcc.git / commitdiff