From 92219babbb18f8ee2590fe9e1040b0cc09d16b45 Mon Sep 17 00:00:00 2001 From: Patrick Bernardi Date: Thu, 10 Oct 2019 15:22:55 +0000 Subject: [PATCH] [Ada] Flag Sec_Stack_Used incorrectly set by ghost code 2019-10-10 Patrick Bernardi 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 --- gcc/ada/ChangeLog | 13 ++++-- gcc/ada/bindgen.adb | 104 +++++++++++++++++++++++--------------------- gcc/ada/rtsfind.adb | 62 ++++++++++++++------------ 3 files changed, 97 insertions(+), 82 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bb08e2df092..1788f19293e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ -2019-10-10 Piotr Trojanek +2019-10-10 Patrick Bernardi - * 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 e60cb7a7590..9ac50fe35ef 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 dc77590a9e8..65cc8bc3853 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; <> - 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; -- 2.30.2