2014-02-06 Sergey Rybin <rybin@adacore.com frybin>

* gnat_ugn.texi, vms_data.ads: Add documentation of -j option for
	gnatelim.

2014-02-06  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat_rm.texi (Pragma Optimize_Alignment): Document the effect
	of the pragma on individual objects.

2014-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Node29 is now used as BIP_Initialization_Call.
	(BIP_Initialization_Call): New routine.
	(Set_BIP_Initialization_Call): New routine.
	(Write_Field29_Name): Add an entry for constants and variables.
	* einfo.ads Add new attribute BIP_Initialization_Call and update
	its usage in nodes.
	(BIP_Initialization_Call): New routine along with pragma Inline.
	(Set_BIP_Initialization_Call): New routine along with pragma Inline.
	* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
	Add local declaration Res_Decl. Capture the build-in-place
	initialization call when the related object declaration has
	created a transient block.
	* exp_ch7.adb (Process_Transient_Objects): Add local variable
	Fin_Insrt. Recognize a scenario where an object declaration acts
	as a transient context and is initialized by a build-in-place
	function call.

From-SVN: r207543
This commit is contained in:
Arnaud Charlet 2014-02-06 11:13:42 +01:00
parent a0367a97c5
commit 8c7ff9a02d
8 changed files with 166 additions and 39 deletions

View File

@ -1,3 +1,32 @@
2014-02-06 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation of -j option for
gnatelim.
2014-02-06 Eric Botcazou <ebotcazou@adacore.com>
* gnat_rm.texi (Pragma Optimize_Alignment): Document the effect
of the pragma on individual objects.
2014-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb Node29 is now used as BIP_Initialization_Call.
(BIP_Initialization_Call): New routine.
(Set_BIP_Initialization_Call): New routine.
(Write_Field29_Name): Add an entry for constants and variables.
* einfo.ads Add new attribute BIP_Initialization_Call and update
its usage in nodes.
(BIP_Initialization_Call): New routine along with pragma Inline.
(Set_BIP_Initialization_Call): New routine along with pragma Inline.
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration):
Add local declaration Res_Decl. Capture the build-in-place
initialization call when the related object declaration has
created a transient block.
* exp_ch7.adb (Process_Transient_Objects): Add local variable
Fin_Insrt. Recognize a scenario where an object declaration acts
as a transient context and is initialized by a build-in-place
function call.
2014-02-06 Pascal Obry <obry@adacore.com> 2014-02-06 Pascal Obry <obry@adacore.com>
* prj-util.adb (For_Interface_Sources): Fix handling of required * prj-util.adb (For_Interface_Sources): Fix handling of required

View File

@ -242,6 +242,7 @@ package body Einfo is
-- Initialization_Statements Node28 -- Initialization_Statements Node28
-- Underlying_Record_View Node28 -- Underlying_Record_View Node28
-- BIP_Initialization_Call Node29
-- Subprograms_For_Type Node29 -- Subprograms_For_Type Node29
-- Corresponding_Equality Node30 -- Corresponding_Equality Node30
@ -767,6 +768,12 @@ package body Einfo is
return Elist16 (Id); return Elist16 (Id);
end Body_References; end Body_References;
function BIP_Initialization_Call (Id : E) return N is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
return Node29 (Id);
end BIP_Initialization_Call;
function C_Pass_By_Copy (Id : E) return B is function C_Pass_By_Copy (Id : E) return B is
begin begin
pragma Assert (Is_Record_Type (Id)); pragma Assert (Is_Record_Type (Id));
@ -3434,6 +3441,12 @@ package body Einfo is
Set_Elist16 (Id, V); Set_Elist16 (Id, V);
end Set_Body_References; end Set_Body_References;
procedure Set_BIP_Initialization_Call (Id : E; V : N) is
begin
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
Set_Node29 (Id, V);
end Set_BIP_Initialization_Call;
procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is procedure Set_C_Pass_By_Copy (Id : E; V : B := True) is
begin begin
pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id));
@ -9419,6 +9432,10 @@ package body Einfo is
procedure Write_Field29_Name (Id : Entity_Id) is procedure Write_Field29_Name (Id : Entity_Id) is
begin begin
case Ekind (Id) is case Ekind (Id) is
when E_Constant |
E_Variable =>
Write_Str ("BIP_Initialization_Call");
when Type_Kind => when Type_Kind =>
Write_Str ("Subprograms_For_Type"); Write_Str ("Subprograms_For_Type");

View File

@ -499,6 +499,14 @@ package Einfo is
-- defines the related state. If the body refines the said state, all -- defines the related state. If the body refines the said state, all
-- references on this list are illegal due to the visible refinement. -- references on this list are illegal due to the visible refinement.
-- BIP_Initialization_Call (Node29)
-- Defined in constants and variables whose corresponding declaration
-- is wrapped in a transient block and the inital value is provided by
-- a build-in-place function call. Contains the relocated build-in-place
-- call after the expansion has decoupled the call from the object. This
-- attribute is used by the finalization machinery to insert cleanup code
-- for all additional transient variables found in the transient block.
-- C_Pass_By_Copy (Flag125) [implementation base type only] -- C_Pass_By_Copy (Flag125) [implementation base type only]
-- Defined in record types. Set if a pragma Convention for the record -- Defined in record types. Set if a pragma Convention for the record
-- type specifies convention C_Pass_By_Copy. This convention name is -- type specifies convention C_Pass_By_Copy. This convention name is
@ -5307,6 +5315,7 @@ package Einfo is
-- Interface_Name (Node21) (constants only) -- Interface_Name (Node21) (constants only)
-- Related_Type (Node27) (constants only) -- Related_Type (Node27) (constants only)
-- Initialization_Statements (Node28) -- Initialization_Statements (Node28)
-- BIP_Initialization_Call (Node29)
-- Linker_Section_Pragma (Node33) -- Linker_Section_Pragma (Node33)
-- Has_Alignment_Clause (Flag46) -- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86) -- Has_Atomic_Components (Flag86)
@ -6013,6 +6022,7 @@ package Einfo is
-- Last_Assignment (Node26) -- Last_Assignment (Node26)
-- Related_Type (Node27) -- Related_Type (Node27)
-- Initialization_Statements (Node28) -- Initialization_Statements (Node28)
-- BIP_Initialization_Call (Node29)
-- Linker_Section_Pragma (Node33) -- Linker_Section_Pragma (Node33)
-- Contract (Node34) -- Contract (Node34)
-- Has_Alignment_Clause (Flag46) -- Has_Alignment_Clause (Flag46)
@ -6290,6 +6300,7 @@ package Einfo is
function Body_Entity (Id : E) return E; function Body_Entity (Id : E) return E;
function Body_Needed_For_SAL (Id : E) return B; function Body_Needed_For_SAL (Id : E) return B;
function Body_References (Id : E) return L; function Body_References (Id : E) return L;
function BIP_Initialization_Call (Id : E) return N;
function CR_Discriminant (Id : E) return E; function CR_Discriminant (Id : E) return E;
function C_Pass_By_Copy (Id : E) return B; function C_Pass_By_Copy (Id : E) return B;
function Can_Never_Be_Null (Id : E) return B; function Can_Never_Be_Null (Id : E) return B;
@ -6913,6 +6924,7 @@ package Einfo is
procedure Set_Body_Entity (Id : E; V : E); procedure Set_Body_Entity (Id : E; V : E);
procedure Set_Body_Needed_For_SAL (Id : E; V : B := True); procedure Set_Body_Needed_For_SAL (Id : E; V : B := True);
procedure Set_Body_References (Id : E; V : L); procedure Set_Body_References (Id : E; V : L);
procedure Set_BIP_Initialization_Call (Id : E; V : N);
procedure Set_CR_Discriminant (Id : E; V : E); procedure Set_CR_Discriminant (Id : E; V : E);
procedure Set_C_Pass_By_Copy (Id : E; V : B := True); procedure Set_C_Pass_By_Copy (Id : E; V : B := True);
procedure Set_Can_Never_Be_Null (Id : E; V : B := True); procedure Set_Can_Never_Be_Null (Id : E; V : B := True);
@ -7650,6 +7662,7 @@ package Einfo is
pragma Inline (Body_Entity); pragma Inline (Body_Entity);
pragma Inline (Body_Needed_For_SAL); pragma Inline (Body_Needed_For_SAL);
pragma Inline (Body_References); pragma Inline (Body_References);
pragma Inline (BIP_Initialization_Call);
pragma Inline (CR_Discriminant); pragma Inline (CR_Discriminant);
pragma Inline (C_Pass_By_Copy); pragma Inline (C_Pass_By_Copy);
pragma Inline (Can_Never_Be_Null); pragma Inline (Can_Never_Be_Null);
@ -8121,6 +8134,7 @@ package Einfo is
pragma Inline (Set_Body_Entity); pragma Inline (Set_Body_Entity);
pragma Inline (Set_Body_Needed_For_SAL); pragma Inline (Set_Body_Needed_For_SAL);
pragma Inline (Set_Body_References); pragma Inline (Set_Body_References);
pragma Inline (Set_BIP_Initialization_Call);
pragma Inline (Set_CR_Discriminant); pragma Inline (Set_CR_Discriminant);
pragma Inline (Set_C_Pass_By_Copy); pragma Inline (Set_C_Pass_By_Copy);
pragma Inline (Set_Can_Never_Be_Null); pragma Inline (Set_Can_Never_Be_Null);

View File

@ -10466,6 +10466,7 @@ package body Exp_Ch6 is
Pass_Caller_Acc : Boolean := False; Pass_Caller_Acc : Boolean := False;
New_Expr : Node_Id; New_Expr : Node_Id;
Ref_Type : Entity_Id; Ref_Type : Entity_Id;
Res_Decl : Node_Id;
Result_Subt : Entity_Id; Result_Subt : Entity_Id;
begin begin
@ -10678,11 +10679,12 @@ package body Exp_Ch6 is
Set_Etype (Def_Id, Ref_Type); Set_Etype (Def_Id, Ref_Type);
Set_Is_Known_Non_Null (Def_Id); Set_Is_Known_Non_Null (Def_Id);
Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id, Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Ref_Type, Loc), Object_Definition => New_Reference_To (Ref_Type, Loc),
Expression => New_Expr)); Expression => New_Expr);
Insert_After_And_Analyze (Ptr_Typ_Decl, Res_Decl);
-- If the result subtype of the called function is constrained and -- If the result subtype of the called function is constrained and
-- is not itself the return expression of an enclosing BIP function, -- is not itself the return expression of an enclosing BIP function,
@ -10691,6 +10693,24 @@ package body Exp_Ch6 is
if Is_Constrained (Underlying_Type (Result_Subt)) if Is_Constrained (Underlying_Type (Result_Subt))
and then not Is_Return_Object (Defining_Identifier (Object_Decl)) and then not Is_Return_Object (Defining_Identifier (Object_Decl))
then then
-- The related object declaration is encased in a transient block
-- because the build-in-place function call contains at least one
-- nested function call that produces a controlled transient
-- temporary:
-- Obj : ... := BIP_Func_Call (Ctrl_Func_Call);
-- Since the build-in-place expansion decouples the call from the
-- object declaration, the finalization machinery lacks the context
-- which prompted the generation of the transient block. To resolve
-- this scenario, store the build-in-place call.
if Scope_Is_Transient
and then Node_To_Be_Wrapped = Object_Decl
then
Set_BIP_Initialization_Call (Obj_Def_Id, Res_Decl);
end if;
Set_Expression (Object_Decl, Empty); Set_Expression (Object_Decl, Empty);
Set_No_Initialization (Object_Decl); Set_No_Initialization (Object_Decl);
@ -10790,9 +10810,9 @@ package body Exp_Ch6 is
begin begin
pragma Assert (Nkind (Allocator) = N_Allocator pragma Assert (Nkind (Allocator) = N_Allocator
and then Nkind (Function_Call) = N_Function_Call); and then Nkind (Function_Call) = N_Function_Call);
pragma Assert (Convention (Function_Id) = Convention_CPP pragma Assert (Convention (Function_Id) = Convention_CPP
and then Is_Constructor (Function_Id)); and then Is_Constructor (Function_Id));
pragma Assert (Is_Constrained (Underlying_Type (Result_Subt))); pragma Assert (Is_Constrained (Underlying_Type (Result_Subt)));
-- Replace the initialized allocator of form "new T'(Func (...))" with -- Replace the initialized allocator of form "new T'(Func (...))" with

View File

@ -4487,6 +4487,7 @@ package body Exp_Ch7 is
Fin_Block : Node_Id; Fin_Block : Node_Id;
Fin_Data : Finalization_Exception_Data; Fin_Data : Finalization_Exception_Data;
Fin_Decls : List_Id; Fin_Decls : List_Id;
Fin_Insrt : Node_Id;
Last_Fin : Node_Id := Empty; Last_Fin : Node_Id := Empty;
Loc : Source_Ptr; Loc : Source_Ptr;
Obj_Id : Entity_Id; Obj_Id : Entity_Id;
@ -4502,11 +4503,34 @@ package body Exp_Ch7 is
-- Start of processing for Process_Transient_Objects -- Start of processing for Process_Transient_Objects
begin begin
-- Recognize a scenario where the transient context is an object
-- declaration initialized by a build-in-place function call:
-- Obj : ... := BIP_Function_Call (Ctrl_Func_Call);
-- The rough expansion of the above is:
-- Temp : ... := Ctrl_Func_Call;
-- Obj : ...;
-- Res : ... := BIP_Func_Call (..., Obj, ...);
-- The finalization of any controlled transient must happen after
-- the build-in-place function call is executed.
if Nkind (N) = N_Object_Declaration
and then Present (BIP_Initialization_Call (Defining_Identifier (N)))
then
Must_Hook := True;
Fin_Insrt := BIP_Initialization_Call (Defining_Identifier (N));
-- Search the context for at least one subprogram call. If found, the -- Search the context for at least one subprogram call. If found, the
-- machinery exports all transient objects to the enclosing finalizer -- machinery exports all transient objects to the enclosing finalizer
-- due to the possibility of abnormal call termination. -- due to the possibility of abnormal call termination.
Detect_Subprogram_Call (N); else
Detect_Subprogram_Call (N);
Fin_Insrt := Last_Object;
end if;
-- Examine all objects in the list First_Object .. Last_Object -- Examine all objects in the list First_Object .. Last_Object
@ -4689,7 +4713,7 @@ package body Exp_Ch7 is
if Present (Prev_Fin) then if Present (Prev_Fin) then
Insert_Before_And_Analyze (Prev_Fin, Fin_Block); Insert_Before_And_Analyze (Prev_Fin, Fin_Block);
else else
Insert_After_And_Analyze (Last_Object, Insert_After_And_Analyze (Fin_Insrt,
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
Declarations => Fin_Decls, Declarations => Fin_Decls,
Handled_Statement_Sequence => Handled_Statement_Sequence =>
@ -4717,9 +4741,7 @@ package body Exp_Ch7 is
-- Raise_From_Controlled_Operation (E); -- Raise_From_Controlled_Operation (E);
-- end if; -- end if;
if Built if Built and then Present (Last_Fin) then
and then Present (Last_Fin)
then
Insert_After_And_Analyze (Last_Fin, Insert_After_And_Analyze (Last_Fin,
Build_Raise_Statement (Fin_Data)); Build_Raise_Statement (Fin_Data));
end if; end if;

View File

@ -4812,13 +4812,14 @@ pragma Optimize_Alignment (TIME | SPACE | OFF);
@noindent @noindent
This is a configuration pragma which affects the choice of default alignments This is a configuration pragma which affects the choice of default alignments
for types where no alignment is explicitly specified. There is a time/space for types and objects where no alignment is explicitly specified. There is a
trade-off in the selection of these values. Large alignments result in more time/space trade-off in the selection of these values. Large alignments result
efficient code, at the expense of larger data space, since sizes have to be in more efficient code, at the expense of larger data space, since sizes have
increased to match these alignments. Smaller alignments save space, but the to be increased to match these alignments. Smaller alignments save space, but
access code is slower. The normal choice of default alignments (which is what the access code is slower. The normal choice of default alignments for types
you get if you do not use this pragma, or if you use an argument of OFF), and individual alignment promotions for objects (which is what you get if you
tries to balance these two requirements. do not use this pragma, or if you use an argument of OFF), tries to balance
these two requirements.
Specifying SPACE causes smaller default alignments to be chosen in two cases. Specifying SPACE causes smaller default alignments to be chosen in two cases.
First any packed record is given an alignment of 1. Second, if a size is given First any packed record is given an alignment of 1. Second, if a size is given
@ -4848,6 +4849,10 @@ whose length depends on a discriminant), has a pragma Pack, then it is not
in general possible to set the alignment of such a record to one, so the in general possible to set the alignment of such a record to one, so the
pragma is ignored in this case (with a warning). pragma is ignored in this case (with a warning).
Specifying SPACE also disables individual alignment promotions for objects,
which occur when the compiler increases the alignment of a specific object
without changing the alignment of its type.
Specifying TIME causes larger default alignments to be chosen in the case of Specifying TIME causes larger default alignments to be chosen in the case of
small types with sizes that are not a power of 2. For example, consider: small types with sizes that are not a power of 2. For example, consider:

View File

@ -11300,6 +11300,13 @@ Put @command{gnatelim} output into a specified file. If this file already exists
it is overridden. If this switch is not used, @command{gnatelim} outputs its results it is overridden. If this switch is not used, @command{gnatelim} outputs its results
into @file{stderr} into @file{stderr}
@item ^-j^/PROCESSES=^@var{n}
@cindex @option{^-j^/PROCESSES^} (@command{gnatelim})
Use @var{n} processes to carry out the tree creations (internal representations
of the argument sources). On a multiprocessor machine this speeds up processing
of big sets of argument sources. If @var{n} is 0, then the maximum number of
parallel tree creations is the number of core processors on the platform.
@item ^-q^/QUIET^ @item ^-q^/QUIET^
@cindex @option{^-q^/QUIET^} (@command{gnatelim}) @cindex @option{^-q^/QUIET^} (@command{gnatelim})
Quiet mode: by default @code{gnatelim} outputs to the standard error Quiet mode: by default @code{gnatelim} outputs to the standard error

View File

@ -4010,6 +4010,18 @@ package VMS_Data is
-- Do not generate pragmas for subprograms declared in the sources -- Do not generate pragmas for subprograms declared in the sources
-- listed in a specified file -- listed in a specified file
S_Elim_Processes : aliased constant S := "/PROCESSES=#" &
"-j#";
-- /NOPROCESSES (D)
-- /PROCESSES=NNN
--
-- Use NNN processes to carry out the tree creations (internal
-- representations of the argument sources). On a multiprocessor machine
-- this speeds up processing of big sets of argument sources. If NNN is 0,
-- then the maximum number of parallel tree creations is the number of
-- core processors on the platform.
S_Elim_Project : aliased constant S := "/PROJECT_FILE=<" & S_Elim_Project : aliased constant S := "/PROJECT_FILE=<" &
"-P>"; "-P>";
-- /PROJECT_FILE=filename -- /PROJECT_FILE=filename
@ -4108,29 +4120,30 @@ package VMS_Data is
-- QUIET Some warning messages are suppressed -- QUIET Some warning messages are suppressed
Elim_Switches : aliased constant Switches := Elim_Switches : aliased constant Switches :=
(S_Elim_Add 'Access, (S_Elim_Add 'Access,
S_Elim_All 'Access, S_Elim_All 'Access,
S_Elim_Bind 'Access, S_Elim_Bind 'Access,
S_Elim_Comp 'Access, S_Elim_Comp 'Access,
S_Elim_Config 'Access, S_Elim_Config 'Access,
S_Elim_Current 'Access, S_Elim_Current 'Access,
S_Elim_Ext 'Access, S_Elim_Ext 'Access,
S_Elim_Files 'Access, S_Elim_Files 'Access,
S_Elim_Follow 'Access, S_Elim_Follow 'Access,
S_Elim_GNATMAKE'Access, S_Elim_GNATMAKE 'Access,
S_Elim_Log 'Access, S_Elim_Log 'Access,
S_Elim_Logfile 'Access, S_Elim_Logfile 'Access,
S_Elim_Main 'Access, S_Elim_Main 'Access,
S_Elim_Mess 'Access, S_Elim_Mess 'Access,
S_Elim_Nodisp 'Access, S_Elim_Nodisp 'Access,
S_Elim_Out 'Access, S_Elim_Out 'Access,
S_Elim_Project 'Access, S_Elim_Processes'Access,
S_Elim_Quiet 'Access, S_Elim_Project 'Access,
S_Elim_Search 'Access, S_Elim_Quiet 'Access,
S_Elim_Subdirs 'Access, S_Elim_Search 'Access,
S_Elim_Time 'Access, S_Elim_Subdirs 'Access,
S_Elim_Verb 'Access, S_Elim_Time 'Access,
S_Elim_Warn 'Access); S_Elim_Verb 'Access,
S_Elim_Warn 'Access);
---------------------------- ----------------------------
-- Switches for GNAT FIND -- -- Switches for GNAT FIND --