Correct an issue where ghost code will set the flag Sec_Stack_Used even
though the code will be eliminated and result in the program not using
the secondary stack. This could confuse the binder into importing
objects from System.Secondary_Stack even though that package is not in
the program's closure.
The setting of Sec_Stack_Used has moved from Load_RTU to RTE to cover
the case that if the ignored ghost code is the first to call Load_RTU,
the flag may never be set.
The secondary stack code in the binder has also been refactored to make
its intentions clearer.
Running this command:
gprbuild --RTS=zfp main.adb
On the following sources:
procedure Main is
function Mk_Test return String with Ghost;
function Mk_Test return String is ("test");
begin
null;
end Main;
Should execute silently.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-10-10 Patrick Bernardi <berna...@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.--- gcc/ada/bindgen.adb
+++ gcc/ada/bindgen.adb
@@ -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,29 +585,33 @@ 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;
- if Sec_Stack_Used then
- WBI (" Default_Secondary_Stack_Size : " &
- "System.Parameters.Size_Type;");
- WBI (" pragma Import (C, Default_Secondary_Stack_Size, " &
- """__gnat_default_ss_size"");");
+ -- Import secondary stack pool variables if the secondary stack
+ -- used. They are not referenced otherwise.
- WBI (" Default_Sized_SS_Pool : System.Address;");
- WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " &
- """__gnat_default_ss_pool"");");
+ if Sec_Stack_Used then
+ WBI (" Default_Secondary_Stack_Size : " &
+ "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;
WBI (" begin");
@@ -642,48 +646,49 @@ package body Bindgen is
WBI (" null;");
end if;
- -- Generate default-sized secondary stack pool and set secondary
- -- stack globals.
-
- if Sec_Stack_Used then
+ -- Generate the default-sized secondary stack pool if the secondary
+ -- stack is used by the program.
- -- Elaborate the body of the binder to initialize the default-
- -- sized secondary stack pool.
+ 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.
- WBI ("");
- WBI (" " & Get_Ada_Main_Name & "'Elab_Body;");
+ WBI ("");
+ WBI (" " & Get_Ada_Main_Name & "'Elab_Body;");
- -- Generate the default-sized secondary stack pool and set the
- -- related secondary stack globals.
+ -- Generate the default-sized secondary stack pool and set the
+ -- 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
- Set_Int (Opt.Default_Sec_Stack_Size);
- else
- Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size");
- end if;
+ 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");
+ end if;
- Set_Char (';');
- Write_Statement_Buffer;
+ Set_Char (';');
+ Write_Statement_Buffer;
- Set_String (" Binder_Sec_Stacks_Count := ");
- Set_Int (Num_Sec_Stacks);
- Set_Char (';');
- Write_Statement_Buffer;
+ Set_String (" Binder_Sec_Stacks_Count := ");
+ Set_Int (Num_Sec_Stacks);
+ Set_Char (';');
+ Write_Statement_Buffer;
- WBI (" Default_Sized_SS_Pool := " &
- "Sec_Default_Sized_Stacks'Address;");
- WBI ("");
+ WBI (" Default_Sized_SS_Pool := " &
+ "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;");
+ WBI (" Binder_Sec_Stacks_Count := 0;");
+ end if;
end if;
-- Normal case (standard library not suppressed). Set all global values
@@ -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
--- gcc/ada/rtsfind.adb
+++ gcc/ada/rtsfind.adb
@@ -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;
