[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

3 files changed, 97 insertions, 82 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb08e2d..1788f19 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,10 @@
-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
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index e60cb7a..9ac50fe 100644
--- a/gcc/ada/bindgen.adb
+++ b/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
 
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index dc77590..65cc8bc 100644
--- a/gcc/ada/rtsfind.adb
+++ b/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;