Commit 8e888920 by Arnaud Charlet

[multiple changes]

2014-07-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Make_Bignum_Block): Use the new secondary stack
	build routines to manage the mark.
	* exp_ch7.adb (Create_Finalizer, Expand_Cleanup_Actions):
	Use the new secodary stack build routines to manage the mark.
	(Insert_Actions_In_Scope_Around): Add new formal parameter
	Manage_SS along with comment on its usage. Code and comment
	reformatting. Mark and release the secondary stack when the
	context warrants it.
	(Make_Transient_Block): Update the call
	to Insert_Actions_In_Scope_Around to account for parameter Manage_SS.
	(Wrap_Transient_Declaration): Remove local variable
	Uses_SS. Ensure that the secondary stack is marked and released
	when the related object declaration appears in a library level
	package or package body. Code and comment reformatting.
	* exp_util.ads, exp_util.adb (Build_SS_Mark_Call): New routine.
	(Build_SS_Release_Call): New routine.

2014-07-30  Steve Baird  <baird@adacore.com>

	* exp_attr.adb: Revert previous change, not needed after all.

2014-07-30  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Queue.Insert_Project_Sources): Insert with
	Closure => True for interfaces of Stand-Alone Libraries.
	* makeutl.ads (Source_Info (Format => Gprbuild)): Add new
	Boolean component Closure, defaulted to False.

2014-07-30  Yannick Moy  <moy@adacore.com>

	* sem_res.adb: Fix typo in error message.

From-SVN: r213291
parent 63a4aa43
2014-07-30 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Make_Bignum_Block): Use the new secondary stack
build routines to manage the mark.
* exp_ch7.adb (Create_Finalizer, Expand_Cleanup_Actions):
Use the new secodary stack build routines to manage the mark.
(Insert_Actions_In_Scope_Around): Add new formal parameter
Manage_SS along with comment on its usage. Code and comment
reformatting. Mark and release the secondary stack when the
context warrants it.
(Make_Transient_Block): Update the call
to Insert_Actions_In_Scope_Around to account for parameter Manage_SS.
(Wrap_Transient_Declaration): Remove local variable
Uses_SS. Ensure that the secondary stack is marked and released
when the related object declaration appears in a library level
package or package body. Code and comment reformatting.
* exp_util.ads, exp_util.adb (Build_SS_Mark_Call): New routine.
(Build_SS_Release_Call): New routine.
2014-07-30 Steve Baird <baird@adacore.com>
* exp_attr.adb: Revert previous change, not needed after all.
2014-07-30 Vincent Celier <celier@adacore.com>
* makeutl.adb (Queue.Insert_Project_Sources): Insert with
Closure => True for interfaces of Stand-Alone Libraries.
* makeutl.ads (Source_Info (Format => Gprbuild)): Add new
Boolean component Closure, defaulted to False.
2014-07-30 Yannick Moy <moy@adacore.com>
* sem_res.adb: Fix typo in error message.
2014-07-30 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb (Process_Range_Expr_In_Decl): Use _FIRST/_LAST
......
......@@ -7477,22 +7477,12 @@ package body Checks is
begin
return
Make_Block_Statement (Loc,
Declarations => New_List (
Make_Object_Declaration (Loc,
Defining_Identifier => M,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Mark_Id), Loc),
Expression =>
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc)))),
Declarations =>
New_List (Build_SS_Mark_Call (Loc, M)),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_SS_Release), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (M, Loc))))));
Statements => New_List (Build_SS_Release_Call (Loc, M))));
end Make_Bignum_Block;
----------------------------------
......
......@@ -2884,11 +2884,9 @@ package body Exp_Attr is
-- For scalar type, if low bound is a reference to an entity, just
-- replace with a direct reference. Note that we can only have a
-- reference to a constant entity at this stage, anything else would
-- have already been rewritten. We do not do this rewriting if we
-- are in CodePeer mode, since CodePeer prefers to see the explicit
-- First attribute reference.
-- have already been rewritten.
elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
elsif Is_Scalar_Type (Ptyp) then
declare
Lo : constant Node_Id := Type_Low_Bound (Ptyp);
begin
......@@ -3562,11 +3560,9 @@ package body Exp_Attr is
-- For scalar type, if low bound is a reference to an entity, just
-- replace with a direct reference. Note that we can only have a
-- reference to a constant entity at this stage, anything else would
-- have already been rewritten. We do not do this rewriting if we
-- are in CodePeer mode, since CodePeer prefers to see the explicit
-- Last attribute reference.
-- have already been rewritten.
elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
elsif Is_Scalar_Type (Ptyp) then
declare
Hi : constant Node_Id := Type_High_Bound (Ptyp);
begin
......
......@@ -1013,6 +1013,49 @@ package body Exp_Util is
end if;
end Build_Runtime_Call;
------------------------
-- Build_SS_Mark_Call --
------------------------
function Build_SS_Mark_Call
(Loc : Source_Ptr;
Mark : Entity_Id) return Node_Id
is
begin
-- Generate:
-- Mark : constant Mark_Id := SS_Mark;
return
Make_Object_Declaration (Loc,
Defining_Identifier => Mark,
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Mark_Id), Loc),
Expression =>
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc)));
end Build_SS_Mark_Call;
---------------------------
-- Build_SS_Release_Call --
---------------------------
function Build_SS_Release_Call
(Loc : Source_Ptr;
Mark : Entity_Id) return Node_Id
is
begin
-- Generate:
-- SS_Release (Mark);
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_SS_Release), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Mark, Loc)));
end Build_SS_Release_Call;
----------------------------
-- Build_Task_Array_Image --
----------------------------
......
......@@ -244,6 +244,18 @@ package Exp_Util is
-- information for the tree and for error messages. The call node is not
-- analyzed on return, the caller is responsible for analyzing it.
function Build_SS_Mark_Call
(Loc : Source_Ptr;
Mark : Entity_Id) return Node_Id;
-- Build a call to routine System.Secondary_Stack.Mark. Mark denotes the
-- entity of the secondary stack mark.
function Build_SS_Release_Call
(Loc : Source_Ptr;
Mark : Entity_Id) return Node_Id;
-- Build a call to routine System.Secondary_Stack.Release. Mark denotes the
-- entity of the secondary stack mark.
function Build_Task_Image_Decls
(Loc : Source_Ptr;
Id_Ref : Node_Id;
......
......@@ -2754,9 +2754,10 @@ package body Makeutl is
Debug_Output
(" -> ", Name_Id (Root_Source.Display_File));
Dummy := Queue.Insert_No_Roots
(Source => (Format => Format_Gprbuild,
Tree => Source.Tree,
Id => Root_Source));
(Source => (Format => Format_Gprbuild,
Tree => Source.Tree,
Id => Root_Source,
Closure => False));
Initialize_Source_Record (Root_Source);
......@@ -2926,8 +2927,10 @@ package body Makeutl is
-- False, put the Ada sources only when they are in a library
-- project.
Iter : Source_Iterator;
Source : Prj.Source_Id;
Iter : Source_Iterator;
Source : Prj.Source_Id;
OK : Boolean;
Closure : Boolean;
begin
-- Nothing to do when "-u" was specified and some files were
......@@ -2971,10 +2974,46 @@ package body Makeutl is
or else Source.Project.Library)
and then not Is_Subunit (Source)
then
Queue.Insert
(Source => (Format => Format_Gprbuild,
Tree => Tree,
Id => Source));
OK := True;
Closure := False;
if Source.Unit /= No_Unit_Index
and then Source.Project.Library
and then Source.Project.Standalone_Library /= No
then
-- Check if the unit is in the interface
OK := False;
declare
List : String_List_Id :=
Source.Project.Lib_Interface_ALIs;
Element : String_Element;
begin
while List /= Nil_String loop
Element :=
Project_Tree.Shared.String_Elements.Table
(List);
if Element.Value = Name_Id (Source.Dep_Name)
then
OK := True;
Closure := True;
exit;
end if;
List := Element.Next;
end loop;
end;
end if;
if OK then
Queue.Insert
(Source => (Format => Format_Gprbuild,
Tree => Tree,
Id => Source,
Closure => Closure));
end if;
end if;
end if;
end if;
......@@ -3064,9 +3103,10 @@ package body Makeutl is
or else Src_Id.Project.Library_Kind = Static)
then
Queue.Insert
(Source => (Format => Format_Gprbuild,
Tree => Project_Tree,
Id => Src_Id));
(Source => (Format => Format_Gprbuild,
Tree => Project_Tree,
Id => Src_Id,
Closure => True));
end if;
end if;
end loop;
......@@ -3151,7 +3191,11 @@ package body Makeutl is
Data.Need_Linking := False;
else
Data.Closure_Needed := Has_Mains;
Data.Closure_Needed :=
Has_Mains
or else
(Root_Project.Library
and then Root_Project.Standalone_Library /= No);
Data.Need_Compilation := All_Phases or Option_Compile_Only;
Data.Need_Binding := All_Phases or Option_Bind_Only;
Data.Need_Linking := (All_Phases or Option_Link_Only)
......
......@@ -489,8 +489,9 @@ package Makeutl is
record
case Format is
when Format_Gprbuild =>
Tree : Project_Tree_Ref := No_Project_Tree;
Id : Source_Id := No_Source;
Tree : Project_Tree_Ref := No_Project_Tree;
Id : Source_Id := No_Source;
Closure : Boolean := False;
when Format_Gnatmake =>
File : File_Name_Type := No_File;
......@@ -504,7 +505,8 @@ package Makeutl is
-- depends on the builder, and in particular whether it only supports
-- project-based files (in which case we have a full Source_Id record).
No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
No_Source_Info : constant Source_Info :=
(Format_Gprbuild, null, null, False);
procedure Initialize
(Queue_Per_Obj_Dir : Boolean;
......
......@@ -6262,7 +6262,7 @@ package body Sem_Res is
-- expressions, that are not handled by GNATprove.
elsif Is_Potentially_Unevaluated (N) then
Error_Msg_NE ("?no contextual anlysis of &", N, Nam);
Error_Msg_NE ("?no contextual analysis of &", N, Nam);
Error_Msg_N
("\call appears in potentially unevaluated context", N);
Set_Is_Inlined_Always (Nam_UA, False);
......
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