Skip to content

R
riscv-gcc-1
Commit 94bbf008 by Arnaud Charlet
Options

[multiple changes] 

2011-09-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Write_Field28_Name): Update the choices for
	Extra_Formals.
	* einfo.ads: Update the use of Extra_Formals in various entities.
	* exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Code
	reformatting. Handle the case where the function call returns
	an incomplete type coming from a limited with context. Generate
	a reference to the _master when the master id is associated
	with an access type.
	(Is_Build_In_Place_Function_Call): Code
	reformatting. The Alfa mode case must appear first since otherwise
	we will carry out the function name retrieval regardless of the
	compilation mode.
	(Make_Build_In_Place_Call_In_Allocator): Code
	reformatting. Handle the case where the function call returns
	an incomplete type coming from a limited with context. Remove
	the reference creation when adding the task-related actuals,
	this is now done in Add_Task_Actuals_To_Build_In_Place_Call.
	* exp_ch7.adb (Make_Set_Finalize_Address_Call): Remove local
	variable Call. Remove the useless wrapping of Set_Finalize_Address
	when the finalization master is a build-in-place extra formal. The
	whole mechanism of controlled allocation in a build-in-place
	context is already protected by an if statement.
	* sem_aux.adb (Is_Immutably_Limited_Type): Handle the case
	where the type might be related to a function which returns an
	incomplete type coming from a limited with.
	* sem_ch6.adb (Create_Extra_Formals): Comment
	reformatting. Handle the case where the function returns an
	incomplete type coming from a limited with context.

2011-09-05  Johannes Kanig  <kanig@adacore.com>

	* lib-xref-alfa.adb (Is_Alfa_Reference): Improve test for constant
	objects and rewrite case statement as /if/elsif/endif.

2011-09-05  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb, sem_ch4.adb: Minor reformatting.

From-SVN: r178537
parent aeae67ed
Showing with 69 additions and 82 deletions
gcc/ada/einfo.adb
......@@ -8686,9 +8686,12 @@ package body Einfo is
procedure Write_Field28_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when E_Procedure |
when E_Entry |
E_Entry_Family |
E_Function |
E_Entry =>
E_Procedure |
E_Subprogram_Body |
E_Subprogram_Type =>
Write_Str ("Extra_Formals");
when E_Record_Type =>
......
gcc/ada/einfo.ads
......@@ -5137,6 +5137,7 @@ package Einfo is
-- Protection_Object (Node23) (protected kind)
-- Contract (Node24) (for entry only)
-- PPC_Wrapper (Node25)
-- Extra_Formals (Node28)
-- Default_Expressions_Processed (Flag108)
-- Entry_Accepted (Flag152)
-- Is_AST_Entry (Flag132) (for entry only)
......@@ -5670,10 +5671,12 @@ package Einfo is
-- Corresponding_Protected_Entry (Node18)
-- Last_Entity (Node20)
-- Scope_Depth_Value (Uint22)
-- Extra_Formals (Node28)
-- Scope_Depth (synth)
-- E_Subprogram_Type
-- Directly_Designated_Type (Node20)
-- Extra_Formals (Node28)
-- First_Formal (synth)
-- First_Formal_With_Extras (synth)
-- Last_Formal (synth)
......
gcc/ada/exp_ch6.adb
......@@ -469,7 +469,7 @@ package body Exp_Ch6 is
begin
-- No such extra parameters are needed if there are no tasks
if not Has_Task (Etype (Function_Id)) then
if not Has_Task (Available_View (Etype (Function_Id))) then
return;
end if;
......@@ -477,6 +477,12 @@ package body Exp_Ch6 is
if Restriction_Active (No_Task_Hierarchy) then
Actual := New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc);
-- In the case where we use the master associated with an access type,
-- the actual is an entity and requires an explicit reference.
elsif Nkind (Actual) = N_Defining_Identifier then
Actual := New_Reference_To (Actual, Loc);
end if;
-- The master
......@@ -493,8 +499,7 @@ package body Exp_Ch6 is
-- Build the parameter association for the new actual and add it to
-- the end of the function's actuals.
Add_Extra_Actual_To_Call
(Function_Call, Master_Formal, Actual);
Add_Extra_Actual_To_Call (Function_Call, Master_Formal, Actual);
end;
-- The activation chain
......@@ -506,8 +511,8 @@ package body Exp_Ch6 is
begin
-- Locate implicit activation chain parameter in the called function
Activation_Chain_Formal := Build_In_Place_Formal
(Function_Id, BIP_Activation_Chain);
Activation_Chain_Formal :=
Build_In_Place_Formal (Function_Id, BIP_Activation_Chain);
-- Create the actual which is a pointer to the current activation
-- chain
......@@ -6814,8 +6819,8 @@ package body Exp_Ch6 is
-- Step past qualification or unchecked conversion (the latter can occur
-- in cases of calls to 'Input).
if Nkind_In
(Exp_Node, N_Qualified_Expression, N_Unchecked_Type_Conversion)
if Nkind_In (Exp_Node, N_Qualified_Expression,
N_Unchecked_Type_Conversion)
then
Exp_Node := Expression (N);
end if;
......@@ -6824,19 +6829,22 @@ package body Exp_Ch6 is
return False;
else
if Is_Entity_Name (Name (Exp_Node)) then
-- In Alfa mode, build-in-place calls are not expanded, so that we
-- may end up with a call that is neither resolved to an entity, nor
-- an indirect call.
if Alfa_Mode then
return False;
elsif Is_Entity_Name (Name (Exp_Node)) then
Function_Id := Entity (Name (Exp_Node));
-- In the case of an explicitly dereferenced call, use the subprogram
-- type generated for the dereference.
elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
Function_Id := Etype (Name (Exp_Node));
-- In Alfa mode, protected subprogram calls are not expanded, so that
-- we may end up with a call that is neither resolved to an entity,
-- nor an indirect call.
elsif Alfa_Mode then
return False;
else
raise Program_Error;
end if;
......@@ -7092,11 +7100,11 @@ package body Exp_Ch6 is
(Allocator : Node_Id;
Function_Call : Node_Id)
is
Acc_Type : constant Entity_Id := Etype (Allocator);
Loc : Source_Ptr;
Func_Call : Node_Id := Function_Call;
Function_Id : Entity_Id;
Result_Subt : Entity_Id;
Acc_Type : constant Entity_Id := Etype (Allocator);
New_Allocator : Node_Id;
Return_Obj_Access : Entity_Id;
......@@ -7135,7 +7143,7 @@ package body Exp_Ch6 is
raise Program_Error;
end if;
Result_Subt := Etype (Function_Id);
Result_Subt := Available_View (Etype (Function_Id));
-- Check whether return type includes tasks. This may not have been done
-- previously, if the type was a limited view.
......@@ -7236,17 +7244,8 @@ package body Exp_Ch6 is
Add_Finalization_Master_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Acc_Type);
-- If access type has a master entity, pass a reference to it
if Present (Master_Id (Acc_Type)) then
Add_Task_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id,
Master_Actual =>
New_Occurrence_Of (Master_Id (Acc_Type), Loc));
else
Add_Task_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Empty);
end if;
Add_Task_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Master_Actual => Master_Id (Acc_Type));
-- The caller does not provide the return object in this case, so we
-- have to pass null for the object access actual.
......
gcc/ada/exp_ch7.adb
......@@ -7461,7 +7461,6 @@ package body Exp_Ch7 is
Desig_Typ : constant Entity_Id :=
Available_View (Designated_Type (Ptr_Typ));
Fin_Mas_Id : constant Entity_Id := Finalization_Master (Ptr_Typ);
Call : Node_Id;
Fin_Mas_Ref : Node_Id;
Utyp : Entity_Id;
......@@ -7526,7 +7525,7 @@ package body Exp_Ch7 is
-- Generate:
-- Set_Finalize_Address (<Ptr_Typ>FM, <Utyp>FD'Unrestricted_Access);
Call :=
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Set_Finalize_Address), Loc),
......@@ -7536,25 +7535,6 @@ package body Exp_Ch7 is
Prefix =>
New_Reference_To (TSS (Utyp, TSS_Finalize_Address), Loc),
Attribute_Name => Name_Unrestricted_Access)));
-- In the case of build-in-place functions, protect the call to ensure
-- we have a master at run time. Generate:
-- if <Ptr_Typ>FM /= null then
-- <Call>;
-- end if;
if Is_Access_Type (Etype (Fin_Mas_Id)) then
Call :=
Make_If_Statement (Loc,
Condition =>
Make_Op_Ne (Loc,
Left_Opnd => New_Reference_To (Fin_Mas_Id, Loc),
Right_Opnd => Make_Null (Loc)),
Then_Statements => New_List (Call));
end if;
return Call;
end Make_Set_Finalize_Address_Call;
--------------------------
......
gcc/ada/lib-xref-alfa.adb
......@@ -604,38 +604,36 @@ package body Alfa is
Typ : Character) return Boolean
is
begin
-- The only references of interest on callable entities are calls.
-- On non-callable entities, the only references of interest are
-- reads and writes.
case Ekind (E) is
when Overloadable_Kind =>
return Typ = 's';
if Ekind (E) in Overloadable_Kind then
-- References to IN parameters and constants are not
-- considered in Alfa section, as these will be translated
-- as constants in the intermediate language for formal
-- verification, and should therefore never appear in frame
-- conditions.
-- The only references of interest on callable entities are
-- calls. On non-callable entities, the only references of
-- interest are reads and writes.
-- What about E_Loop_Parameter???
return Typ = 's';
elsif Is_Constant_Object (E) then
-- References to constant objects are not considered in Alfa
-- section, as these will be translated as constants in the
-- intermediate language for formal verification, and should
-- therefore never appear in frame conditions.
when E_In_Parameter | E_Constant =>
return False;
when others =>
elsif Present (Etype (E)) and then
Ekind (Etype (E)) in Concurrent_Kind then
-- Objects of Task type or protected type are not Alfa
-- references.
-- Objects of Task type or protected type are not Alfa
-- references.
if Present (Etype (E))
and then Ekind (Etype (E)) in Concurrent_Kind
then
return False;
end if;
return False;
return Typ = 'r' or else Typ = 'm';
end case;
else
return Typ = 'r' or else Typ = 'm';
end if;
end Is_Alfa_Reference;
-------------------
......
gcc/ada/sem_aux.adb
......@@ -597,7 +597,7 @@ package body Sem_Aux is
-------------------------------
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is
Btype : constant Entity_Id := Base_Type (Ent);
Btype : constant Entity_Id := Available_View (Base_Type (Ent));
begin
if Is_Limited_Record (Btype) then
......@@ -607,9 +607,8 @@ package body Sem_Aux is
and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
then
return not In_Package_Body (Scope ((Btype)));
end if;
if Is_Private_Type (Btype) then
elsif Is_Private_Type (Btype) then
-- AI05-0063: A type derived from a limited private formal type is
-- not immutably limited in a generic body.
......
gcc/ada/sem_ch3.adb
......@@ -15061,6 +15061,7 @@ package body Sem_Ch3 is
Tag_Mismatch;
end if;
end if;
if Present (Prev)
and then Nkind (Parent (Prev)) = N_Incomplete_Type_Declaration
and then Present (Premature_Use (Parent (Prev)))
......
gcc/ada/sem_ch4.adb
......@@ -4322,7 +4322,7 @@ package body Sem_Ch4 is
Error_Msg_Node_2 := First_Subtype (Prefix_Type);
Error_Msg_NE ("no selector& for}", N, Sel);
-- If prefix is incomplete, add information
-- Add information in the case of an incomplete prefix
if Is_Incomplete_Type (Type_To_Use) then
declare
......@@ -4340,6 +4340,10 @@ package body Sem_Ch4 is
if Nkind (Parent (Inc)) =
N_Incomplete_Type_Declaration
then
-- Record location of premature use in entity so that
-- a continuation message is generated when the
-- completion is seen.
Set_Premature_Use (Parent (Inc), N);
end if;
end if;
......
gcc/ada/sem_ch6.adb
......@@ -6371,11 +6371,11 @@ package body Sem_Ch6 is
E, BIP_Formal_Suffix (BIP_Finalization_Master));
end if;
-- If the result type contains tasks, we have two extra formals:
-- the master of the tasks to be created, and the caller's
-- activation chain.
-- When the result type contains tasks, add two extra formals: the
-- master of the tasks to be created, and the caller's activation
-- chain.
if Has_Task (Result_Subt) then
if Has_Task (Available_View (Result_Subt)) then
Discard :=
Add_Extra_Formal
(E, RTE (RE_Master_Id),
......
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