Commit 92219bab by Patrick Bernardi Committed by Pierre-Marie de Rodat

[Ada] Flag Sec_Stack_Used incorrectly set by ghost code

2019-10-10  Patrick Bernardi  <bernardi@adacore.com>

gcc/ada/

	* bindgen.adb (System_Secondary_Stack_Package_In_Closure):
	Renamed flag System_Secondary_Stack_Used to be clearer of what
	it represents.
	(Gen_Adainit): Refactor secondary stack related code to make it
	clearer.
	* rtsfind.adb (Load_RTU): Don't set Sec_Stack_Used flag here
	(RTE): Set Sec_Stack_Used if the System.Secondary_Stack is
	referenced, but not if we're ignoring ghost code.

From-SVN: r276811
parent f4f50084
2019-10-10 Piotr Trojanek <trojanek@adacore.com>
2019-10-10 Patrick Bernardi <bernardi@adacore.com>
* sem_prag.adb (Analyze_Global_In_Decl_Part): Simplify previous
test, just like in a recent commit we simplified a similar test
for Depends contract.
\ No newline at end of file
* bindgen.adb (System_Secondary_Stack_Package_In_Closure):
Renamed flag System_Secondary_Stack_Used to be clearer of what
it represents.
(Gen_Adainit): Refactor secondary stack related code to make it
clearer.
* rtsfind.adb (Load_RTU): Don't set Sec_Stack_Used flag here
(RTE): Set Sec_Stack_Used if the System.Secondary_Stack is
referenced, but not if we're ignoring ghost code.
\ No newline at end of file
......@@ -81,7 +81,7 @@ package body Bindgen is
-- domains just before calling the main procedure from the environment
-- task.
System_Secondary_Stack_Used : Boolean := False;
System_Secondary_Stack_Package_In_Closure : Boolean := False;
-- Flag indicating whether the unit System.Secondary_Stack is in the
-- closure of the partition. This is set by Resolve_Binder_Options, and
-- is used to initialize the package in cases where the run-time brings
......@@ -585,17 +585,20 @@ package body Bindgen is
WBI ("");
end if;
-- A restricted run-time may attempt to initialize the main task's
-- secondary stack even if the stack is not used. Consequently,
-- the binder needs to initialize Binder_Sec_Stacks_Count anytime
-- System.Secondary_Stack is in the enclosure of the partition.
if System_Secondary_Stack_Package_In_Closure then
-- System.Secondary_Stack is in the closure of the program
-- because the program uses the secondary stack or the restricted
-- run-time is unconditionally calling SS_Init. In both cases,
-- SS_Init needs to know the number of secondary stacks created by
-- the binder.
if System_Secondary_Stack_Used then
WBI (" Binder_Sec_Stacks_Count : Natural;");
WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " &
"""__gnat_binder_ss_count"");");
WBI ("");
end if;
-- Import secondary stack pool variables if the secondary stack
-- used. They are not referenced otherwise.
if Sec_Stack_Used then
WBI (" Default_Secondary_Stack_Size : " &
......@@ -609,6 +612,7 @@ package body Bindgen is
WBI ("");
end if;
end if;
WBI (" begin");
......@@ -642,11 +646,11 @@ package body Bindgen is
WBI (" null;");
end if;
-- Generate default-sized secondary stack pool and set secondary
-- stack globals.
-- Generate the default-sized secondary stack pool if the secondary
-- stack is used by the program.
if System_Secondary_Stack_Package_In_Closure then
if Sec_Stack_Used then
-- Elaborate the body of the binder to initialize the default-
-- sized secondary stack pool.
......@@ -661,7 +665,8 @@ package body Bindgen is
if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then
Set_Int (Opt.Default_Sec_Stack_Size);
else
Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size");
Set_String
("System.Parameters.Runtime_Default_Sec_Stack_Size");
end if;
Set_Char (';');
......@@ -676,15 +681,15 @@ package body Bindgen is
"Sec_Default_Sized_Stacks'Address;");
WBI ("");
-- When a restricted run-time initializes the main task's secondary
-- stack but the program does not use it, no secondary stack is
-- generated. Binder_Sec_Stacks_Count is set to zero so the run-time
-- is aware that the lack of pre-allocated secondary stack is
-- expected.
else
-- The presence of System.Secondary_Stack in the closure of the
-- program implies the restricted run-time is unconditionally
-- calling SS_Init. Let SS_Init know that no stacks were
-- created.
elsif System_Secondary_Stack_Used then
WBI (" Binder_Sec_Stacks_Count := 0;");
end if;
end if;
-- Normal case (standard library not suppressed). Set all global values
-- used by the run time.
......@@ -3086,7 +3091,8 @@ package body Bindgen is
-- Ditto for the use of System.Secondary_Stack
Check_Package
(System_Secondary_Stack_Used, "system.secondary_stack%s");
(System_Secondary_Stack_Package_In_Closure,
"system.secondary_stack%s");
-- Ditto for use of an SMP bareboard runtime
......
......@@ -949,22 +949,16 @@ package body Rtsfind is
Install_Ghost_Region (None, Empty);
Install_SPARK_Mode (None, Empty);
-- Note if secondary stack is used
if U_Id = System_Secondary_Stack then
Opt.Sec_Stack_Used := True;
end if;
-- Otherwise we need to load the unit, First build unit name
-- from the enumeration literal name in type RTU_Id.
-- Otherwise we need to load the unit, First build unit name from the
-- enumeration literal name in type RTU_Id.
U.Uname := Get_Unit_Name (U_Id);
U.First_Implicit_With := Empty;
-- Now do the load call, note that setting Error_Node to Empty is
-- a signal to Load_Unit that we will regard a failure to find the
-- file as a fatal error, and that it should not output any kind
-- of diagnostics, since we will take care of it here.
-- Now do the load call, note that setting Error_Node to Empty is a
-- signal to Load_Unit that we will regard a failure to find the file as
-- a fatal error, and that it should not output any kind of diagnostics,
-- since we will take care of it here.
-- We save style checking switches and turn off style checking for
-- loading the unit, since we don't want any style checking.
......@@ -1245,21 +1239,6 @@ package body Rtsfind is
---------
function RTE (E : RE_Id) return Entity_Id is
U_Id : constant RTU_Id := RE_Unit_Table (E);
U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id);
Lib_Unit : Node_Id;
Pkg_Ent : Entity_Id;
Ename : Name_Id;
-- The following flag is used to disable front-end inlining when RTE
-- is invoked. This prevents the analysis of other runtime bodies when
-- a particular spec is loaded through Rtsfind. This is both efficient,
-- and it prevents spurious visibility conflicts between use-visible
-- user entities, and entities in run-time packages.
Save_Front_End_Inlining : Boolean;
procedure Check_RPC;
-- Reject programs that make use of distribution features not supported
-- on the current target. Also check that the PCS is compatible with the
......@@ -1351,6 +1330,22 @@ package body Rtsfind is
return Ent;
end Find_Local_Entity;
-- Local variables
U_Id : constant RTU_Id := RE_Unit_Table (E);
U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id);
Ename : Name_Id;
Lib_Unit : Node_Id;
Pkg_Ent : Entity_Id;
Save_Front_End_Inlining : constant Boolean := Front_End_Inlining;
-- This flag is used to disable front-end inlining when RTE is invoked.
-- This prevents the analysis of other runtime bodies when a particular
-- spec is loaded through Rtsfind. This is both efficient, and prevents
-- spurious visibility conflicts between use-visible user entities, and
-- entities in run-time packages.
-- Start of processing for RTE
begin
......@@ -1372,7 +1367,6 @@ package body Rtsfind is
return Check_CRT (E, Find_Local_Entity (E));
end if;
Save_Front_End_Inlining := Front_End_Inlining;
Front_End_Inlining := False;
-- Load unit if unit not previously loaded
......@@ -1435,9 +1429,19 @@ package body Rtsfind is
end if;
<<Found>>
Maybe_Add_With (U);
-- Record whether the secondary stack is in use in order to generate
-- the proper binder code. No action is taken when the secondary stack
-- is pulled within an ignored Ghost context because all this code will
-- disappear.
if U_Id = System_Secondary_Stack and then Ghost_Mode /= Ignore then
Sec_Stack_Used := True;
end if;
Maybe_Add_With (U);
Front_End_Inlining := Save_Front_End_Inlining;
return Check_CRT (E, RE_Table (E));
end RTE;
......
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