Skip to content

R
riscv-gcc-1
Commit 92219bab by Patrick Bernardi Committed by Pierre-Marie de Rodat
Options

[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
Showing with 98 additions and 83 deletions
gcc/ada/ChangeLog
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 * bindgen.adb (System_Secondary_Stack_Package_In_Closure):
test, just like in a recent commit we simplified a similar test Renamed flag System_Secondary_Stack_Used to be clearer of what
for Depends contract. it represents.
\ No newline at end of file (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
gcc/ada/bindgen.adb
...@@ -81,7 +81,7 @@ package body Bindgen is ...@@ -81,7 +81,7 @@ package body Bindgen is
-- domains just before calling the main procedure from the environment -- domains just before calling the main procedure from the environment
-- task. -- 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 -- Flag indicating whether the unit System.Secondary_Stack is in the
-- closure of the partition. This is set by Resolve_Binder_Options, and -- 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 -- is used to initialize the package in cases where the run-time brings
...@@ -585,29 +585,33 @@ package body Bindgen is ...@@ -585,29 +585,33 @@ package body Bindgen is
WBI (""); WBI ("");
end if; end if;
-- A restricted run-time may attempt to initialize the main task's if System_Secondary_Stack_Package_In_Closure then
-- secondary stack even if the stack is not used. Consequently, -- System.Secondary_Stack is in the closure of the program
-- the binder needs to initialize Binder_Sec_Stacks_Count anytime -- because the program uses the secondary stack or the restricted
-- System.Secondary_Stack is in the enclosure of the partition. -- 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 (" Binder_Sec_Stacks_Count : Natural;");
WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " & WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " &
"""__gnat_binder_ss_count"");"); """__gnat_binder_ss_count"");");
WBI (""); WBI ("");
end if;
if Sec_Stack_Used then -- Import secondary stack pool variables if the secondary stack
WBI (" Default_Secondary_Stack_Size : " & -- used. They are not referenced otherwise.
"System.Parameters.Size_Type;");
WBI (" pragma Import (C, Default_Secondary_Stack_Size, " &
"""__gnat_default_ss_size"");");
WBI (" Default_Sized_SS_Pool : System.Address;"); if Sec_Stack_Used then
WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " & WBI (" Default_Secondary_Stack_Size : " &
"""__gnat_default_ss_pool"");"); "System.Parameters.Size_Type;");
WBI (" pragma Import (C, Default_Secondary_Stack_Size, " &
"""__gnat_default_ss_size"");");
WBI (""); WBI (" Default_Sized_SS_Pool : System.Address;");
WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " &
"""__gnat_default_ss_pool"");");
WBI ("");
end if;
end if; end if;
WBI (" begin"); WBI (" begin");
...@@ -642,48 +646,49 @@ package body Bindgen is ...@@ -642,48 +646,49 @@ package body Bindgen is
WBI (" null;"); WBI (" null;");
end if; end if;
-- Generate default-sized secondary stack pool and set secondary -- Generate the default-sized secondary stack pool if the secondary
-- stack globals. -- stack is used by the program.
if Sec_Stack_Used then
-- Elaborate the body of the binder to initialize the default- if System_Secondary_Stack_Package_In_Closure then
-- sized secondary stack pool. if Sec_Stack_Used then
-- Elaborate the body of the binder to initialize the default-
-- sized secondary stack pool.
WBI (""); WBI ("");
WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); WBI (" " & Get_Ada_Main_Name & "'Elab_Body;");
-- Generate the default-sized secondary stack pool and set the -- Generate the default-sized secondary stack pool and set the
-- related secondary stack globals. -- related secondary stack globals.
Set_String (" Default_Secondary_Stack_Size := "); Set_String (" Default_Secondary_Stack_Size := ");
if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then
Set_Int (Opt.Default_Sec_Stack_Size); Set_Int (Opt.Default_Sec_Stack_Size);
else else
Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); Set_String
end if; ("System.Parameters.Runtime_Default_Sec_Stack_Size");
end if;
Set_Char (';'); Set_Char (';');
Write_Statement_Buffer; Write_Statement_Buffer;
Set_String (" Binder_Sec_Stacks_Count := "); Set_String (" Binder_Sec_Stacks_Count := ");
Set_Int (Num_Sec_Stacks); Set_Int (Num_Sec_Stacks);
Set_Char (';'); Set_Char (';');
Write_Statement_Buffer; Write_Statement_Buffer;
WBI (" Default_Sized_SS_Pool := " & WBI (" Default_Sized_SS_Pool := " &
"Sec_Default_Sized_Stacks'Address;"); "Sec_Default_Sized_Stacks'Address;");
WBI (""); WBI ("");
-- When a restricted run-time initializes the main task's secondary else
-- stack but the program does not use it, no secondary stack is -- The presence of System.Secondary_Stack in the closure of the
-- generated. Binder_Sec_Stacks_Count is set to zero so the run-time -- program implies the restricted run-time is unconditionally
-- is aware that the lack of pre-allocated secondary stack is -- calling SS_Init. Let SS_Init know that no stacks were
-- expected. -- created.
elsif System_Secondary_Stack_Used then WBI (" Binder_Sec_Stacks_Count := 0;");
WBI (" Binder_Sec_Stacks_Count := 0;"); end if;
end if; end if;
-- Normal case (standard library not suppressed). Set all global values -- Normal case (standard library not suppressed). Set all global values
...@@ -3086,7 +3091,8 @@ package body Bindgen is ...@@ -3086,7 +3091,8 @@ package body Bindgen is
-- Ditto for the use of System.Secondary_Stack -- Ditto for the use of System.Secondary_Stack
Check_Package 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 -- Ditto for use of an SMP bareboard runtime
......
gcc/ada/rtsfind.adb
...@@ -949,22 +949,16 @@ package body Rtsfind is ...@@ -949,22 +949,16 @@ package body Rtsfind is
Install_Ghost_Region (None, Empty); Install_Ghost_Region (None, Empty);
Install_SPARK_Mode (None, Empty); Install_SPARK_Mode (None, Empty);
-- Note if secondary stack is used -- Otherwise we need to load the unit, First build unit name from the
-- enumeration literal name in type RTU_Id.
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.
U.Uname := Get_Unit_Name (U_Id); U.Uname := Get_Unit_Name (U_Id);
U.First_Implicit_With := Empty; U.First_Implicit_With := Empty;
-- Now do the load call, note that setting Error_Node to Empty is -- Now do the load call, note that setting Error_Node to Empty is a
-- a signal to Load_Unit that we will regard a failure to find the -- signal to Load_Unit that we will regard a failure to find the file as
-- file as a fatal error, and that it should not output any kind -- a fatal error, and that it should not output any kind of diagnostics,
-- of diagnostics, since we will take care of it here. -- since we will take care of it here.
-- We save style checking switches and turn off style checking for -- We save style checking switches and turn off style checking for
-- loading the unit, since we don't want any style checking. -- loading the unit, since we don't want any style checking.
...@@ -1245,21 +1239,6 @@ package body Rtsfind is ...@@ -1245,21 +1239,6 @@ package body Rtsfind is
--------- ---------
function RTE (E : RE_Id) return Entity_Id 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; procedure Check_RPC;
-- Reject programs that make use of distribution features not supported -- Reject programs that make use of distribution features not supported
-- on the current target. Also check that the PCS is compatible with the -- on the current target. Also check that the PCS is compatible with the
...@@ -1351,6 +1330,22 @@ package body Rtsfind is ...@@ -1351,6 +1330,22 @@ package body Rtsfind is
return Ent; return Ent;
end Find_Local_Entity; 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 -- Start of processing for RTE
begin begin
...@@ -1372,7 +1367,6 @@ package body Rtsfind is ...@@ -1372,7 +1367,6 @@ package body Rtsfind is
return Check_CRT (E, Find_Local_Entity (E)); return Check_CRT (E, Find_Local_Entity (E));
end if; end if;
Save_Front_End_Inlining := Front_End_Inlining;
Front_End_Inlining := False; Front_End_Inlining := False;
-- Load unit if unit not previously loaded -- Load unit if unit not previously loaded
...@@ -1435,9 +1429,19 @@ package body Rtsfind is ...@@ -1435,9 +1429,19 @@ package body Rtsfind is
end if; end if;
<<Found>> <<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; Front_End_Inlining := Save_Front_End_Inlining;
return Check_CRT (E, RE_Table (E)); return Check_CRT (E, RE_Table (E));
end RTE; 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