Skip to content

R
riscv-gcc-1
Commit 99bba92c by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r247468
parent bae8f156
Showing with 169 additions and 59 deletions
gcc/ada/ChangeLog
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.
......
gcc/ada/checks.adb
......@@ -1355,8 +1355,13 @@ package body Checks is
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;
......
gcc/ada/exp_attr.adb
......@@ -83,6 +83,9 @@ package body Exp_Attr is
-- 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;
......@@ -354,6 +357,23 @@ package body Exp_Attr is
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 --
--------------------------
......@@ -2469,6 +2489,7 @@ package body Exp_Attr is
-- 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));
......@@ -2478,29 +2499,18 @@ package body Exp_Attr is
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);
......@@ -3581,17 +3591,9 @@ package body Exp_Attr is
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,
......@@ -6278,25 +6280,15 @@ package body Exp_Attr is
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,
......
gcc/ada/exp_ch4.adb
......@@ -8926,6 +8926,9 @@ package body Exp_Ch4 is
-- 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);
......@@ -8941,7 +8944,14 @@ package body Exp_Ch4 is
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));
......@@ -8958,7 +8968,12 @@ package body Exp_Ch4 is
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;
---------------------
......
gcc/ada/exp_fixd.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -2008,6 +2008,31 @@ package body Exp_Fixd is
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;
......
gcc/ada/exp_spark.adb
......@@ -26,6 +26,7 @@
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;
......@@ -62,6 +63,9 @@ package body Exp_SPARK is
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 --
------------------
......@@ -125,6 +129,9 @@ package body Exp_SPARK is
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));
......@@ -291,6 +298,26 @@ package body Exp_SPARK is
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 --
-------------------------------------
......
gcc/ada/opt.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -219,11 +219,11 @@ package body Opt is
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.
......@@ -293,7 +293,6 @@ package body Opt is
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;
......
gcc/ada/opt.ads
......@@ -1194,10 +1194,12 @@ package Opt is
-- 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
......@@ -1213,10 +1215,12 @@ package Opt is
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.
......
gcc/ada/sem_ch3.adb
......@@ -19316,6 +19316,11 @@ package body Sem_Ch3 is
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 =>
......
gcc/ada/sem_ch6.adb
......@@ -5996,9 +5996,11 @@ package body Sem_Ch6 is
& "(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;
......
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