-- 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
-------------
-------------
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;
---------------------
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;
-----------------------
-- 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;
-- 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;
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
----------------------
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;
-------------------------
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;
----------------------------
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;
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;
-- 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;
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
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);
-- 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;
-------------------------
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
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;
----------------
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);
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
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);
-- 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
-- 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
-- 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);
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;
-------------------
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
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
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;
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.
-- 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.
--
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
-- 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
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;
Environment_Task_Analyzer : Stack_Analyzer;
- Compute_Environment_Task : Boolean;
+ Compute_Environment_Task : Boolean;
type Result_Array_Ptr is access all Result_Array_Type;
-- 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
projects / thirdparty / gcc.git / commitdiff
