From: Jose Ruiz Date: Tue, 22 Jul 2025 09:22:36 +0000 (+0200) Subject: ada: Improve robustness of stack usage tracking in concurrent contexts X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=0a10fc5d72f51eec249d5ec9976089dc6211c7c3;p=thirdparty%2Fgcc.git ada: Improve robustness of stack usage tracking in concurrent contexts Enabled computation of stack usage for tasks that have already initialized their stacks with the expected fill pattern. Ensured that stack usage snapshots for tasks are taken while the runtime is locked, to maintain consistency. For the environment task, approximated the stack origin using the topmost stack known address during initialization, and take into account that the Stack_Analyzer object is not part of its ATCB. gcc/ada/ChangeLog: * libgnarl/s-stusta.adb (Report_Impl): Export a copy of the current stack usage while holding the runtime lock. (Report_For_Task): Do not compute stack usage for a task that has not yet initialized its stack with the expected pattern. (Report_For_Task): The Stack_Analyzer object for the environment task is not part of its ATCB. For the rest of the tasks wait until we have initialized the stack pattern before computing stack usage. (Report_All_Tasks, Get_All_Tasks_Usage, Get_Current_Task_Usage): Adapt to the new interface from Report_Impl. Take into account that Result_Array can be null. When we don't store stack results for a task we need to compute it when requested. (Print): Handle the case when we don't know the stack usage to be reported. * libgnat/s-stausa.adb (Initialize): For the environment task, approximate the stack origin with the topmost stack address that is known. * libgnat/s-stausa.ads: Clarify comments. --- diff --git a/gcc/ada/libgnarl/s-stusta.adb b/gcc/ada/libgnarl/s-stusta.adb index c9848a060c2..d0e8c36a102 100644 --- a/gcc/ada/libgnarl/s-stusta.adb +++ b/gcc/ada/libgnarl/s-stusta.adb @@ -51,14 +51,18 @@ package body System.Stack_Usage.Tasking is -- Compute the stack usage for a given task and saves it in the precise -- slot in System.Stack_Usage.Result_Array; - procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean); + procedure Report_Impl + (All_Tasks : Boolean; + Do_Print : Boolean; + Result_Data : out Stack_Usage_Result_Array); -- Report the stack usage of either all tasks (All_Tasks = True) or of the -- current task (All_Task = False). If Print is True, then results are - -- printed on stderr + -- printed on stderr. Otherwise, we fill the referred structure with the + -- stack information for later processing. We do this copy to avoid reading + -- System.Stack_Usage.Result_Array without locking the runtime. procedure Convert - (TS : System.Stack_Usage.Task_Result; - Res : out Stack_Usage_Result); + (TS : System.Stack_Usage.Task_Result; Res : out Stack_Usage_Result); -- Convert an object of type System.Stack_Usage in a Stack_Usage_Result ------------- @@ -66,8 +70,7 @@ package body System.Stack_Usage.Tasking is ------------- procedure Convert - (TS : System.Stack_Usage.Task_Result; - Res : out Stack_Usage_Result) is + (TS : System.Stack_Usage.Task_Result; Res : out Stack_Usage_Result) is begin Res := TS; end Convert; @@ -77,9 +80,38 @@ package body System.Stack_Usage.Tasking is --------------------- procedure Report_For_Task (Id : System.Tasking.Task_Id) is + use type System.Tasking.Task_Id; begin - System.Stack_Usage.Compute_Result (Id.Common.Analyzer); - System.Stack_Usage.Report_Result (Id.Common.Analyzer); + -- Special treatment of the environment task that uses a Stack_Analyzer + -- object that is not part of its ATCB. + if Id = System.Task_Primitives.Operations.Environment_Task then + + -- Check whether we are tracking stack usage for the environment task + if Compute_Environment_Task then + Compute_Result (Environment_Task_Analyzer); + Report_Result (Environment_Task_Analyzer); + + else + Put_Line + ("Stack usage for environment task needs GNAT_STACK_LIMIT"); + end if; + + -- Regular task + + else + declare + Name_Length : constant Natural := + Natural'Min (Id.Common.Task_Image_Len, Task_Name_Length); + begin + -- Skip the task if it hasn't initialized the stack pattern yet + if Id.Common.Task_Image (1 .. Name_Length) = + Id.Common.Analyzer.Task_Name (1 .. Name_Length) + then + System.Stack_Usage.Compute_Result (Id.Common.Analyzer); + System.Stack_Usage.Report_Result (Id.Common.Analyzer); + end if; + end; + end if; end Report_For_Task; ----------------------- @@ -104,6 +136,9 @@ package body System.Stack_Usage.Tasking is -- Calculate the task usage for a given task + -- Skip if the task is terminated because the ATCB can be already + -- destroyed. + if not System.Tasking.Stages.Terminated (Id) then Report_For_Task (Id); end if; @@ -133,10 +168,13 @@ package body System.Stack_Usage.Tasking is -- Report_Impl -- ----------------- - procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean) is + procedure Report_Impl + (All_Tasks : Boolean; + Do_Print : Boolean; + Result_Data : out Stack_Usage_Result_Array) is begin - -- Lock the runtime + -- Lock the runtime to compute and display stack usage System.Task_Primitives.Operations.Lock_RTS; @@ -148,9 +186,22 @@ package body System.Stack_Usage.Tasking is Compute_Current_Task; end if; - -- Output results + -- Output results, either printing it or in the out parameter + if Do_Print then System.Stack_Usage.Output_Results; + + else + -- Extract data from the snapshot in System.Stack_Usage.Result_Array + + pragma Assert + (System.Stack_Usage.Result_Array = null or else + (System.Stack_Usage.Result_Array'First = Result_Data'First and then + System.Stack_Usage.Result_Array'Last = Result_Data'Last)); + + for J in Result_Data'Range loop + Convert (System.Stack_Usage.Result_Array (J), Result_Data (J)); + end loop; end if; -- Unlock the runtime @@ -164,8 +215,9 @@ package body System.Stack_Usage.Tasking is ---------------------- procedure Report_All_Tasks is + Empty_Result_Array : Stack_Usage_Result_Array (1 .. 0); begin - Report_Impl (True, True); + Report_Impl (True, True, Empty_Result_Array); end Report_All_Tasks; ------------------------- @@ -185,13 +237,11 @@ package body System.Stack_Usage.Tasking is function Get_All_Tasks_Usage return Stack_Usage_Result_Array is Res : Stack_Usage_Result_Array - (1 .. System.Stack_Usage.Result_Array'Length); + (1 .. + (if System.Stack_Usage.Result_Array = null then 0 + else System.Stack_Usage.Result_Array'Length)); begin - Report_Impl (True, False); - - for J in Res'Range loop - Convert (System.Stack_Usage.Result_Array (J), Res (J)); - end loop; + Report_Impl (True, False, Res); return Res; end Get_All_Tasks_Usage; @@ -201,31 +251,70 @@ package body System.Stack_Usage.Tasking is ---------------------------- function Get_Current_Task_Usage return Stack_Usage_Result is - Res : Stack_Usage_Result; - Original : System.Stack_Usage.Task_Result; - Found : Boolean := False; - begin + use type System.Tasking.Task_Id; - Report_Impl (False, False); + Self_ID : constant System.Tasking.Task_Id := System.Tasking.Self; + Is_Env_Task : constant Boolean := + Self_ID = System.Task_Primitives.Operations.Environment_Task; - -- Look for the task info in System.Stack_Usage.Result_Array; - -- the search is based on task name + Res_Array : Stack_Usage_Result_Array + (1 .. + (if System.Stack_Usage.Result_Array = null then 0 + else System.Stack_Usage.Result_Array'Length)); + Res : Stack_Usage_Result; + Found : Boolean := False; - for T in System.Stack_Usage.Result_Array'Range loop - if System.Stack_Usage.Result_Array (T).Task_Name = - System.Tasking.Self.Common.Analyzer.Task_Name + begin + Report_Impl (False, False, Res_Array); + + -- Look for the task info in the copy of System.Stack_Usage.Result_Array + -- (the search is based on task name). + + for Stack_Usage of Res_Array loop + if Stack_Usage.Task_Name = Self_ID.Common.Analyzer.Task_Name or else + (Is_Env_Task and then + Stack_Usage.Task_Name (1 .. 16) = "ENVIRONMENT TASK") then - Original := System.Stack_Usage.Result_Array (T); + Res := Stack_Usage; Found := True; exit; end if; end loop; - -- Be sure a task has been found + if not Found then + -- Not found because the task is not part of those for which we store + -- the results. Hence we need to compute now. + + -- Environment task + if Is_Env_Task then + Res.Task_Name := + "ENVIRONMENT TASK" & (1 .. Task_Name_Length - 16 => ASCII.NUL); + + if Compute_Environment_Task then + Res.Stack_Size := Environment_Task_Analyzer.Stack_Size; + Res.Value := + Stack_Size + (To_Stack_Address + (Environment_Task_Analyzer.Topmost_Touched_Mark), + To_Stack_Address (Environment_Task_Analyzer.Stack_Base)); + else + Res.Stack_Size := 0; + Res.Value := 0; + end if; + + -- Other tasks - pragma Assert (Found); + else + Res.Task_Name := Self_ID.Common.Analyzer.Task_Name; + Res.Stack_Size := Self_ID.Common.Analyzer.Stack_Size; + Res.Value := + Stack_Size + (To_Stack_Address + (Self_ID.Common.Analyzer.Topmost_Touched_Mark), + To_Stack_Address (Self_ID.Common.Analyzer.Stack_Base)); + end if; + end if; - Convert (Original, Res); return Res; end Get_Current_Task_Usage; @@ -248,11 +337,14 @@ package body System.Stack_Usage.Tasking is declare T_Name : constant String := - Obj.Task_Name (Obj.Task_Name'First .. Pos); + Obj.Task_Name (Obj.Task_Name'First .. Pos); begin + -- Notify when we don't know stack usage Put_Line - ("| " & T_Name & " | " & Natural'Image (Obj.Stack_Size) & - Natural'Image (Obj.Value)); + ("| " & T_Name & "|" & + (if Obj.Stack_Size = 0 then " NA | NA" + else Natural'Image (Obj.Stack_Size) & " |" & + Natural'Image (Obj.Value))); end; end Print; diff --git a/gcc/ada/libgnat/s-stausa.adb b/gcc/ada/libgnat/s-stausa.adb index cbecc0bb20e..d2d9e01ce05 100644 --- a/gcc/ada/libgnat/s-stausa.adb +++ b/gcc/ada/libgnat/s-stausa.adb @@ -99,10 +99,10 @@ package body System.Stack_Usage is -- Now the implementation of the services offered by this unit, on top of -- the Stack_Slots abstraction above. - Index_Str : constant String := "Index"; - Task_Name_Str : constant String := "Task Name"; - Stack_Size_Str : constant String := "Stack Size"; - Actual_Size_Str : constant String := "Stack usage"; + Index_Str : constant String := "Index"; + Task_Name_Str : constant String := "Task Name"; + Stack_Size_Str : constant String := "Stack Size"; + Actual_Size_Str : constant String := "Stack usage"; procedure Output_Result (Result_Id : Natural; @@ -128,9 +128,7 @@ package body System.Stack_Usage is Result_Array := new Result_Array_Type (1 .. Buffer_Size); Result_Array.all := [others => - (Task_Name => [others => ASCII.NUL], - Value => 0, - Stack_Size => 0)]; + (Task_Name => [others => ASCII.NUL], Value => 0, Stack_Size => 0)]; -- Set the Is_Enabled flag to true, so that the task wrapper knows that -- it has to handle dynamic stack analysis @@ -151,11 +149,13 @@ package body System.Stack_Usage is begin My_Stack_Size := System.CRTL.atoi (Stack_Size_Chars) * 1024; + -- Approximate Stack_Base with the topmost stack address that is + -- known here. Initialize_Analyzer (Environment_Task_Analyzer, "ENVIRONMENT TASK", My_Stack_Size, - 0, + Stack_Size_Chars'Address, My_Stack_Size); Fill_Stack (Environment_Task_Analyzer); @@ -207,8 +207,8 @@ package body System.Stack_Usage is -- Reduce pattern size to prevent local frame overwrite Analyzer.Pattern_Size := - Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard - - To_Stack_Address (Analyzer.Pattern_Limit)); + Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard - + To_Stack_Address (Analyzer.Pattern_Limit)); end if; Analyzer.Pattern_Overlay_Address := Analyzer.Pattern_Limit; @@ -267,22 +267,21 @@ package body System.Stack_Usage is ------------------------- procedure Initialize_Analyzer - (Analyzer : in out Stack_Analyzer; - Task_Name : String; - Stack_Size : Natural; - Stack_Base : System.Address; - Pattern_Size : Natural; - Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#) - is + (Analyzer : in out Stack_Analyzer; + Task_Name : String; + Stack_Size : Natural; + Stack_Base : System.Address; + Pattern_Size : Natural; + Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#) is begin -- Initialize the analyzer fields - Analyzer.Stack_Base := Stack_Base; - Analyzer.Stack_Size := Stack_Size; - Analyzer.Pattern_Size := Pattern_Size; - Analyzer.Pattern := Pattern; - Analyzer.Result_Id := Next_Id; - Analyzer.Task_Name := [others => ' ']; + Analyzer.Stack_Base := Stack_Base; + Analyzer.Stack_Size := Stack_Size; + Analyzer.Pattern_Size := Pattern_Size; + Analyzer.Pattern := Pattern; + Analyzer.Result_Id := Next_Id; + Analyzer.Task_Name := [others => ' ']; -- Compute the task name, and truncate if bigger than Task_Name_Length @@ -290,10 +289,12 @@ package body System.Stack_Usage is Analyzer.Task_Name (1 .. Task_Name'Length) := Task_Name; else Analyzer.Task_Name := - Task_Name (Task_Name'First .. - Task_Name'First + Task_Name_Length - 1); + Task_Name + (Task_Name'First .. Task_Name'First + Task_Name_Length - 1); end if; + -- Next_Id does not need any explicit protection against race conditions + -- because Initialize_Analyzer is called holding the runtime lock. Next_Id := Next_Id + 1; end Initialize_Analyzer; @@ -302,9 +303,7 @@ package body System.Stack_Usage is ---------------- function Stack_Size - (SP_Low : Stack_Address; - SP_High : Stack_Address) return Natural - is + (SP_Low : Stack_Address; SP_High : Stack_Address) return Natural is begin if SP_Low > SP_High then return Natural (SP_Low - SP_High); @@ -379,16 +378,16 @@ package body System.Stack_Usage is Stack_Size_Str : constant String := Natural'Image (Result.Stack_Size); Actual_Use_Str : constant String := Natural'Image (Result.Value); - Result_Id_Blanks : constant - String (1 .. Index_Str'Length - Result_Id_Str'Length) := + Result_Id_Blanks : + constant String (1 .. Index_Str'Length - Result_Id_Str'Length) := (others => ' '); - Stack_Size_Blanks : constant - String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) := + Stack_Size_Blanks : + constant String (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) := (others => ' '); - Actual_Use_Blanks : constant - String (1 .. Max_Actual_Use_Len - Actual_Use_Str'Length) := + Actual_Use_Blanks : + constant String (1 .. Max_Actual_Use_Len - Actual_Use_Str'Length) := (others => ' '); begin @@ -412,10 +411,9 @@ package body System.Stack_Usage is Max_Stack_Usage : Natural := 0; Max_Stack_Size_Len, Max_Actual_Use_Len : Natural := 0; - Task_Name_Blanks : constant - String - (1 .. Task_Name_Length - Task_Name_Str'Length) := - (others => ' '); + Task_Name_Blanks : + constant String (1 .. Task_Name_Length - Task_Name_Str'Length) := + (others => ' '); begin Set_Output (Standard_Error); @@ -431,6 +429,7 @@ package body System.Stack_Usage is -- in order to do correct column alignment. for J in Result_Array'Range loop + -- Slots at Next_Id or higher haven't been allocated to tasks exit when J >= Next_Id; if Result_Array (J).Value > Max_Stack_Usage then @@ -450,15 +449,15 @@ package body System.Stack_Usage is -- labels if needed. declare - Stack_Size_Blanks : constant - String (1 .. Max_Stack_Size_Len - - Stack_Size_Str'Length) := - [others => ' ']; + Stack_Size_Blanks : + constant String + (1 .. Max_Stack_Size_Len - Stack_Size_Str'Length) := + [others => ' ']; - Stack_Usage_Blanks : constant - String (1 .. Max_Actual_Use_Len - - Actual_Size_Str'Length) := - [others => ' ']; + Stack_Usage_Blanks : + constant String + (1 .. Max_Actual_Use_Len - Actual_Size_Str'Length) := + [others => ' ']; begin if Stack_Size_Str'Length > Max_Stack_Size_Len then @@ -480,6 +479,7 @@ package body System.Stack_Usage is -- Now display the individual results for J in Result_Array'Range loop + -- Slots at Next_Id or higher haven't been allocated to tasks exit when J >= Next_Id; Output_Result (J, Result_Array (J), Max_Stack_Size_Len, Max_Actual_Use_Len); @@ -489,8 +489,14 @@ package body System.Stack_Usage is else Put - (Index_Str & " | " & Task_Name_Str & Task_Name_Blanks & " | " - & Stack_Size_Str & " | " & Actual_Size_Str); + (Index_Str + & " | " + & Task_Name_Str + & Task_Name_Blanks + & " | " + & Stack_Size_Str + & " | " + & Actual_Size_Str); New_Line; end if; end Output_Results; @@ -500,9 +506,10 @@ package body System.Stack_Usage is ------------------- procedure Report_Result (Analyzer : Stack_Analyzer) is - Result : Task_Result := (Task_Name => Analyzer.Task_Name, - Stack_Size => Analyzer.Stack_Size, - Value => 0); + Result : Task_Result := + (Task_Name => Analyzer.Task_Name, + Stack_Size => Analyzer.Stack_Size, + Value => 0); begin if Analyzer.Pattern_Size = 0 then @@ -513,8 +520,9 @@ package body System.Stack_Usage is else Result.Value := - Stack_Size (To_Stack_Address (Analyzer.Topmost_Touched_Mark), - To_Stack_Address (Analyzer.Stack_Base)); + Stack_Size + (To_Stack_Address (Analyzer.Topmost_Touched_Mark), + To_Stack_Address (Analyzer.Stack_Base)); end if; if Analyzer.Result_Id in Result_Array'Range then @@ -528,9 +536,9 @@ package body System.Stack_Usage is declare Result_Str_Len : constant Natural := - Natural'Image (Result.Value)'Length; + Natural'Image (Result.Value)'Length; Size_Str_Len : constant Natural := - Natural'Image (Analyzer.Stack_Size)'Length; + Natural'Image (Analyzer.Stack_Size)'Length; Max_Stack_Size_Len : Natural; Max_Actual_Use_Len : Natural; diff --git a/gcc/ada/libgnat/s-stausa.ads b/gcc/ada/libgnat/s-stausa.ads index 36cebd7cde0..5fbda041b69 100644 --- a/gcc/ada/libgnat/s-stausa.ads +++ b/gcc/ada/libgnat/s-stausa.ads @@ -41,9 +41,8 @@ package System.Stack_Usage is subtype Stack_Address is SSE.Integer_Address; -- Address on the stack - function To_Stack_Address - (Value : System.Address) return Stack_Address - renames System.Storage_Elements.To_Integer; + function To_Stack_Address (Value : System.Address) return Stack_Address + renames System.Storage_Elements.To_Integer; Task_Name_Length : constant := 32; -- The maximum length of task name displayed. @@ -85,7 +84,7 @@ package System.Stack_Usage is -- Bottom_Of_Stack : aliased Integer; -- -- Bottom_Of_Stack'Address will be used as an approximation of - -- -- the bottom of stack. A good practise is to avoid allocating + -- -- the bottom of stack. A good practice is to avoid allocating -- -- other local variables on this stack, as it would degrade -- -- the quality of this approximation. @@ -227,12 +226,12 @@ package System.Stack_Usage is -- procedure Initialize_Analyzer - (Analyzer : in out Stack_Analyzer; - Task_Name : String; - Stack_Size : Natural; - Stack_Base : System.Address; - Pattern_Size : Natural; - Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#); + (Analyzer : in out Stack_Analyzer; + Task_Name : String; + Stack_Size : Natural; + Stack_Base : System.Address; + Pattern_Size : Natural; + Pattern : Interfaces.Unsigned_32 := 16#DEAD_BEEF#); -- Should be called before any use of a Stack_Analyzer, to initialize it. -- Max_Pattern_Size is the size of the pattern zone, might be smaller than -- the full stack size Stack_Size in order to take into account e.g. the @@ -244,22 +243,16 @@ package System.Stack_Usage is -- When this flag is true, then stack analysis is enabled procedure Compute_Result (Analyzer : in out Stack_Analyzer); - -- Read the pattern zone and deduce the stack usage. It should be called - -- from the same frame as Fill_Stack. If Analyzer.Probe is not null, an - -- array of Unsigned_32 with Analyzer.Probe elements is allocated on - -- Compute_Result's stack frame. Probe can be used to detect the error: - -- "instrumentation threshold at reading". See above. After the call + -- Read the pattern zone and deduce the stack usage. After the call -- to this procedure, the memory will look like: -- -- Stack growing -- -----------------------------------------------------------------------> - -- |<---------------------->|<-------------->|<--------->|<--------->| - -- | Stack frames | Array of | used | Memory | - -- | to Compute_Result | Analyzer.Probe | during | filled | - -- | | elements | the | with | - -- | | | execution | pattern | - -- | | | - -- |<----------------------------------------------------> | + -- |<---------------------->|<-------------------->|<--------------->| + -- | Stack frame | Used during the | Memory filled | + -- | to Compute_Result | execution | with pattern | + -- | | | | + -- |<--------------------------------------------->| | -- Stack used ^ -- Pattern_Limit @@ -277,8 +270,8 @@ package System.Stack_Usage is private - package Unsigned_32_Addr is - new System.Address_To_Access_Conversions (Interfaces.Unsigned_32); + package Unsigned_32_Addr is new + System.Address_To_Access_Conversions (Interfaces.Unsigned_32); subtype Pattern_Type is Interfaces.Unsigned_32; Bytes_Per_Pattern : constant := Pattern_Type'Object_Size / Storage_Unit; @@ -320,7 +313,7 @@ private Environment_Task_Analyzer : Stack_Analyzer; - Compute_Environment_Task : Boolean; + Compute_Environment_Task : Boolean; type Result_Array_Ptr is access all Result_Array_Type; @@ -332,8 +325,7 @@ private -- Id of the next stack analyzer function Stack_Size - (SP_Low : Stack_Address; - SP_High : Stack_Address) return Natural; + (SP_Low : Stack_Address; SP_High : Stack_Address) return Natural; pragma Inline (Stack_Size); -- Return the size of a portion of stack delimited by SP_High and SP_Low -- (), i.e. the difference between SP_High and SP_Low. The storage element