OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2010-08-05  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb: Minor reformatting
	* gnat1drv.adb: Minor reformatting.
	Minor code reorganization (use Nkind_In).

2010-08-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.ads, exp_util.adb (Needs_Constant_Address): New predicate to
	determine whether the expression in an address clause for an
	initialized object must be constant. Code moved from freeze.adb.
	(Remove_Side_Effects): When the temporary is initialized with a
	reference, indicate that the temporary is a constant as done in all
	other cases.
	* freeze.adb (Check_Address_Clause): use Needs_Constant_Address.
	* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case 'Address):
	If object does not need a constant address, remove side effects from
	address expression, so it is elaborated at the point of the address
	clause and not at the freeze point of the object, so that elaboration
	order is respected.

2010-08-05  Vincent Celier  <celier@adacore.com>

	* prj.adb (Is_Compilable): Return False for header files of non Ada
	languages.

2010-08-05  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb: The Missing_Source_Files flag also considers a missing
	exec directory as a warning rather than an error.

From-SVN: r162906
This commit is contained in:
Arnaud Charlet 2010-08-05 11:18:41 +02:00
parent 676e842077
commit 0d90129062
9 changed files with 165 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/ada/ChangeLog
View File

@ -1,3 +1,34 @@
2010-08-05 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb: Minor reformatting
* gnat1drv.adb: Minor reformatting.
Minor code reorganization (use Nkind_In).
2010-08-05 Ed Schonberg <schonberg@adacore.com>
* exp_util.ads, exp_util.adb (Needs_Constant_Address): New predicate to
determine whether the expression in an address clause for an
initialized object must be constant. Code moved from freeze.adb.
(Remove_Side_Effects): When the temporary is initialized with a
reference, indicate that the temporary is a constant as done in all
other cases.
* freeze.adb (Check_Address_Clause): use Needs_Constant_Address.
* exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case 'Address):
If object does not need a constant address, remove side effects from
address expression, so it is elaborated at the point of the address
clause and not at the freeze point of the object, so that elaboration
order is respected.
2010-08-05 Vincent Celier <celier@adacore.com>
* prj.adb (Is_Compilable): Return False for header files of non Ada
languages.
2010-08-05 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb: The Missing_Source_Files flag also considers a missing
exec directory as a warning rather than an error.
2010-08-05 Thomas Quinot <quinot@adacore.com>
* sem_ch6.adb, gnat1drv.adb, exp_ch6.adb, sem_eval.adb: Minor

10
gcc/ada/exp_ch13.adb
View File

@ -127,6 +127,16 @@ package body Exp_Ch13 is
else
Set_Expression (Decl, Empty);
end if;
-- An object declaration to which an address clause applies
-- has a delayed freeze, but the address expression itself
-- must be elaborated at the point it appears. If the object
-- is controlled, additional checks apply elsewhere.
elsif Nkind (Decl) = N_Object_Declaration
and then not Needs_Constant_Address (Decl, Typ)
then
Remove_Side_Effects (Exp);
end if;
end;

44
gcc/ada/exp_ch4.adb
View File

@ -6917,8 +6917,8 @@ package body Exp_Ch4 is
Rtyp := Typ;
end if;
-- The proper unsigned type must have a size compatible with
-- the operand, to prevent misalignment..
-- The proper unsigned type must have a size compatible with the
-- operand, to prevent misalignment.
if RM_Size (Rtyp) <= 8 then
Utyp := RTE (RE_Unsigned_8);
@ -6995,16 +6995,12 @@ package body Exp_Ch4 is
begin
if Safe_In_Place_Array_Op (Lhs, Op1, Op2) then
if N = Op1
and then Nkind (Op2) = N_Op_Not
then
if N = Op1 and then Nkind (Op2) = N_Op_Not then
-- (not A) op (not B) can be reduced to a single call
return;
elsif N = Op2
and then Nkind (Parent (N)) = N_Op_Xor
then
elsif N = Op2 and then Nkind (Parent (N)) = N_Op_Xor then
-- A xor (not B) can also be special-cased
return;
@ -7035,10 +7031,10 @@ package body Exp_Ch4 is
Make_Iteration_Scheme (Loc,
Loop_Parameter_Specification =>
Make_Loop_Parameter_Specification (Loc,
Defining_Identifier => J,
Defining_Identifier => J,
Discrete_Subtype_Definition =>
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Chars (A)),
Prefix => Make_Identifier (Loc, Chars (A)),
Attribute_Name => Name_Range))),
Statements => New_List (
@ -7070,12 +7066,11 @@ package body Exp_Ch4 is
Statements => New_List (
Loop_Statement,
Make_Simple_Return_Statement (Loc,
Expression =>
Make_Identifier (Loc, Chars (B)))))));
Expression => Make_Identifier (Loc, Chars (B)))))));
Rewrite (N,
Make_Function_Call (Loc,
Name => New_Reference_To (Func_Name, Loc),
Name => New_Reference_To (Func_Name, Loc),
Parameter_Associations => New_List (Opnd)));
Analyze_And_Resolve (N, Typ);
@ -7096,9 +7091,9 @@ package body Exp_Ch4 is
elsif Is_Boolean_Type (Etype (N)) then
-- Replace OR by OR ELSE if Short_Circuit_And_Or active and the
-- type is standard Boolean (do not mess with AND that uses a non-
-- standard Boolean type, because something strange is going on).
-- Replace OR by OR ELSE if Short_Circuit_And_Or active and the type
-- is standard Boolean (do not mess with AND that uses a non-standard
-- Boolean type, because something strange is going on).
if Short_Circuit_And_Or and then Typ = Standard_Boolean then
Rewrite (N,
@ -7198,10 +7193,9 @@ package body Exp_Ch4 is
Make_Conditional_Expression (Loc,
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => Duplicate_Subexpr (Right),
Left_Opnd => Duplicate_Subexpr (Right),
Right_Opnd =>
Unchecked_Convert_To (Typ,
Make_Integer_Literal (Loc, -1))),
Unchecked_Convert_To (Typ, Make_Integer_Literal (Loc, -1))),
Unchecked_Convert_To (Typ,
Make_Integer_Literal (Loc, Uint_0)),
@ -7280,12 +7274,10 @@ package body Exp_Ch4 is
-- Arithmetic overflow checks for signed integer/fixed point types
if Is_Signed_Integer_Type (Typ)
or else Is_Fixed_Point_Type (Typ)
then
if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then
Apply_Arithmetic_Overflow_Check (N);
-- Vax floating-point types case
-- VAX floating-point types case
elsif Vax_Float (Typ) then
Expand_Vax_Arith (N);
@ -7457,9 +7449,9 @@ package body Exp_Ch4 is
null;
-- Don't do this on the left hand of an assignment statement.
-- Normally one would think that references like this would
-- not occur, but they do in generated code, and mean that
-- we really do want to assign the discriminant!
-- Normally one would think that references like this would not
-- occur, but they do in generated code, and mean that we really
-- do want to assign the discriminant!
elsif Nkind (Par) = N_Assignment_Statement
and then Name (Par) = N

56
gcc/ada/exp_util.adb
View File

@ -4158,6 +4158,61 @@ package body Exp_Util is
end if;
end May_Generate_Large_Temp;
----------------------------
-- Needs_Constant_Address --
----------------------------
function Needs_Constant_Address
(Decl : Node_Id;
Typ : Entity_Id) return Boolean
is
begin
-- If we have no initialization of any kind, then we don't need to
-- place any restrictions on the address clause, because the object
-- will be elaborated after the address clause is evaluated. This
-- happens if the declaration has no initial expression, or the type
-- has no implicit initialization, or the object is imported.
-- The same holds for all initialized scalar types and all access
-- types. Packed bit arrays of size up to 64 are represented using a
-- modular type with an initialization (to zero) and can be processed
-- like other initialized scalar types.
-- If the type is controlled, code to attach the object to a
-- finalization chain is generated at the point of declaration,
-- and therefore the elaboration of the object cannot be delayed:
-- the address expression must be a constant.
if No (Expression (Decl))
and then not Needs_Finalization (Typ)
and then
(not Has_Non_Null_Base_Init_Proc (Typ)
or else Is_Imported (Defining_Identifier (Decl)))
then
return False;
elsif (Present (Expression (Decl)) and then Is_Scalar_Type (Typ))
or else Is_Access_Type (Typ)
or else
(Is_Bit_Packed_Array (Typ)
and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
then
return False;
else
-- Otherwise, we require the address clause to be constant because
-- the call to the initialization procedure (or the attach code) has
-- to happen at the point of the declaration.
-- Actually the IP call has been moved to the freeze actions
-- anyway, so maybe we can relax this restriction???
return True;
end if;
end Needs_Constant_Address;
----------------------------
-- New_Class_Wide_Subtype --
----------------------------
@ -4946,6 +5001,7 @@ package body Exp_Util is
Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Ref_Type, Loc),
Constant_Present => True,
Expression => New_Exp));
end if;

9
gcc/ada/exp_util.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -575,6 +575,13 @@ package Exp_Util is
-- caller has to check whether stack checking is actually enabled in order
-- to guide the expansion (typically of a function call).
function Needs_Constant_Address
(Decl : Node_Id;
Typ : Entity_Id) return Boolean;
-- Check whether the expression in an address clause is restricted to
-- consist of constants, when the object has a non-trivial initialization
-- or is controlled.
function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id;
-- An anonymous access type may designate a limited view. Check whether
-- non-limited view is available during expansion, to examine components

37
gcc/ada/freeze.adb
View File

@ -544,42 +544,7 @@ package body Freeze is
if Present (Addr) then
Expr := Expression (Addr);
-- If we have no initialization of any kind, then we don't need to
-- place any restrictions on the address clause, because the object
-- will be elaborated after the address clause is evaluated. This
-- happens if the declaration has no initial expression, or the type
-- has no implicit initialization, or the object is imported.
-- The same holds for all initialized scalar types and all access
-- types. Packed bit arrays of size up to 64 are represented using a
-- modular type with an initialization (to zero) and can be processed
-- like other initialized scalar types.
-- If the type is controlled, code to attach the object to a
-- finalization chain is generated at the point of declaration,
-- and therefore the elaboration of the object cannot be delayed:
-- the address expression must be a constant.
if (No (Expression (Decl))
and then not Needs_Finalization (Typ)
and then (not Has_Non_Null_Base_Init_Proc (Typ)
or else Is_Imported (E)))
or else (Present (Expression (Decl)) and then Is_Scalar_Type (Typ))
or else Is_Access_Type (Typ)
or else
(Is_Bit_Packed_Array (Typ)
and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
then
null;
-- Otherwise, we require the address clause to be constant because
-- the call to the initialization procedure (or the attach code) has
-- to happen at the point of the declaration.
-- Actually the IP call has been moved to the freeze actions
-- anyway, so maybe we can relax this restriction???
else
if Needs_Constant_Address (Decl, Typ) then
Check_Constant_Address_Clause (Expr, E);
-- Has_Delayed_Freeze was set on E when the address clause was

68
gcc/ada/gnat1drv.adb
View File

@ -151,7 +151,7 @@ procedure Gnat1drv is
Front_End_Inlining := False;
end if;
-- Tune settings for optimal SCIL generation in CodePeer_Mode
-- Tune settings for optimal SCIL generation in CodePeer mode
if CodePeer_Mode then
@ -172,11 +172,11 @@ procedure Gnat1drv is
-- Enable some restrictions systematically to simplify the generated
-- code (and ease analysis). Note that restriction checks are also
-- disabled in CodePeer_Mode, see Restrict.Check_Restriction
-- disabled in CodePeer mode, see Restrict.Check_Restriction
Restrict.Restrictions.Set (No_Task_Hierarchy) := True;
Restrict.Restrictions.Set (No_Abort_Statements) := True;
Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True;
Restrict.Restrictions.Set (No_Task_Hierarchy) := True;
Restrict.Restrictions.Set (No_Abort_Statements) := True;
Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True;
Restrict.Restrictions.Value (Max_Asynchronous_Select_Nesting) := 0;
-- Suppress overflow, division by zero and access checks since they
@ -205,7 +205,7 @@ procedure Gnat1drv is
Debug_Generated_Code := False;
-- Turn cross-referencing on in case it was disabled (by e.g. -gnatD)
-- Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
-- Do we really need to spend time generating xref in CodePeer
-- mode??? Consider setting Xref_Active to False.
@ -215,8 +215,8 @@ procedure Gnat1drv is
Polling_Required := False;
-- Set operating mode to Generate_Code to benefit from full
-- front-end expansion (e.g. generics).
-- Set operating mode to Generate_Code to benefit from full front-end
-- expansion (e.g. generics).
Operating_Mode := Generate_Code;
@ -227,8 +227,8 @@ procedure Gnat1drv is
-- Enable assertions and debug pragmas, since they give CodePeer
-- valuable extra information.
Assertions_Enabled := True;
Debug_Pragmas_Enabled := True;
Assertions_Enabled := True;
Debug_Pragmas_Enabled := True;
-- Suppress compiler warnings, since what we are interested in here
-- is what CodePeer can find out. Also disable all simple value
@ -320,10 +320,10 @@ procedure Gnat1drv is
end if;
end if;
-- Set proper status for overflow checks. We turn on overflow checks
-- if -gnatp was not specified, and either -gnato is set or the back
-- end takes care of overflow checks. Otherwise we suppress overflow
-- checks by default (since front end checks are expensive).
-- Set proper status for overflow checks. We turn on overflow checks if
-- -gnatp was not specified, and either -gnato is set or the back-end
-- takes care of overflow checks. Otherwise we suppress overflow checks
-- by default (since front end checks are expensive).
if not Opt.Suppress_Checks
and then (Opt.Enable_Overflow_Checks
@ -408,7 +408,7 @@ procedure Gnat1drv is
Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node);
end Bad_Body_Error;
-- Start of processing for Check_Bad_Body
-- Start of processing for Check_Bad_Body
begin
-- Nothing to do if we are only checking syntax, because we don't know
@ -432,7 +432,7 @@ procedure Gnat1drv is
Sname := Unit_Name (Main_Unit);
-- If we do not already have a body name, then get the body name
-- (but how can we have a body name here ???)
-- (but how can we have a body name here???)
if not Is_Body_Name (Sname) then
Sname := Get_Body_Name (Sname);
@ -665,9 +665,8 @@ begin
Write_Str ("GNAT ");
Write_Str (Gnat_Version_String);
Write_Eol;
Write_Str ("Copyright 1992-" &
Current_Year &
", Free Software Foundation, Inc.");
Write_Str ("Copyright 1992-" & Current_Year
& ", Free Software Foundation, Inc.");
Write_Eol;
end if;
@ -727,9 +726,9 @@ begin
Set_Generate_Code (Main_Unit);
-- If we have a corresponding spec, and it comes from source
-- or it is not a generated spec for a child subprogram body,
-- then we need object code for the spec unit as well.
-- If we have a corresponding spec, and it comes from source or it is
-- not a generated spec for a child subprogram body, then we need object
-- code for the spec unit as well.
if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body
and then not Acts_As_Spec (Main_Unit_Node)
@ -763,8 +762,8 @@ begin
Back_End_Mode := Declarations_Only;
-- All remaining cases are cases in which the user requested that code
-- be generated (i.e. no -gnatc or -gnats switch was used). Check if
-- we can in fact satisfy this request.
-- be generated (i.e. no -gnatc or -gnats switch was used). Check if we
-- can in fact satisfy this request.
-- Cannot generate code if someone has turned off code generation for
-- any reason at all. We will try to figure out a reason below.
@ -789,9 +788,9 @@ begin
-- We can generate code for a package declaration or a subprogram
-- declaration only if it does not required a body.
elsif (Main_Kind = N_Package_Declaration
or else
Main_Kind = N_Subprogram_Declaration)
elsif Nkind_In (Main_Kind,
N_Package_Declaration,
N_Subprogram_Declaration)
and then
(not Body_Required (Main_Unit_Node)
or else
@ -802,18 +801,19 @@ begin
-- We can generate code for a generic package declaration of a generic
-- subprogram declaration only if does not require a body.
elsif (Main_Kind = N_Generic_Package_Declaration
or else
Main_Kind = N_Generic_Subprogram_Declaration)
elsif Nkind_In (Main_Kind,
N_Generic_Package_Declaration,
N_Generic_Subprogram_Declaration)
and then not Body_Required (Main_Unit_Node)
then
Back_End_Mode := Generate_Object;
-- Compilation units that are renamings do not require bodies,
-- so we can generate code for them.
-- Compilation units that are renamings do not require bodies, so we can
-- generate code for them.
elsif Main_Kind = N_Package_Renaming_Declaration
or else Main_Kind = N_Subprogram_Renaming_Declaration
elsif Nkind_In (Main_Kind,
N_Package_Renaming_Declaration,
N_Subprogram_Renaming_Declaration)
then
Back_End_Mode := Generate_Object;

7
gcc/ada/prj-nmsc.adb
View File

@ -5379,10 +5379,9 @@ package body Prj.Nmsc is
if not Dir_Exists then
Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
Error_Msg
(Data.Flags,
"exec directory { not found",
Project.Location, Project);
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"exec directory { not found", Project.Location, Project);
end if;
end if;
end if;

5
gcc/ada/prj.adb
View File

@ -1153,7 +1153,10 @@ package body Prj is
begin
return Source.Language.Config.Compiler_Driver /= No_File
and then Length_Of_Name (Source.Language.Config.Compiler_Driver) /= 0
and then not Source.Locally_Removed;
and then not Source.Locally_Removed
and then (Source.Language.Config.Kind /= File_Based
or else
Source.Kind /= Spec);
end Is_Compilable;
------------------------------