1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . S T A C K _ U S A G E . T A S K I N G --
9 -- Copyright (C) 2009-2020, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 with System
.Stack_Usage
;
34 -- This is why this package is part of GNARL:
36 with System
.Tasking
.Debug
;
37 with System
.Task_Primitives
.Operations
;
41 package body System
.Stack_Usage
.Tasking
is
44 procedure Report_For_Task
(Id
: System
.Tasking
.Task_Id
);
45 -- A generic procedure calculating stack usage for a given task
47 procedure Compute_All_Tasks
;
48 -- Compute the stack usage for all tasks and saves it in
49 -- System.Stack_Usage.Result_Array
51 procedure Compute_Current_Task
;
52 -- Compute the stack usage for a given task and saves it in the precise
53 -- slot in System.Stack_Usage.Result_Array;
55 procedure Report_Impl
(All_Tasks
: Boolean; Do_Print
: Boolean);
56 -- Report the stack usage of either all tasks (All_Tasks = True) or of the
57 -- current task (All_Task = False). If Print is True, then results are
61 (TS
: System
.Stack_Usage
.Task_Result
;
62 Res
: out Stack_Usage_Result
);
63 -- Convert an object of type System.Stack_Usage in a Stack_Usage_Result
70 (TS
: System
.Stack_Usage
.Task_Result
;
71 Res
: out Stack_Usage_Result
) is
80 procedure Report_For_Task
(Id
: System
.Tasking
.Task_Id
) is
82 System
.Stack_Usage
.Compute_Result
(Id
.Common
.Analyzer
);
83 System
.Stack_Usage
.Report_Result
(Id
.Common
.Analyzer
);
86 -----------------------
87 -- Compute_All_Tasks --
88 -----------------------
90 procedure Compute_All_Tasks
is
91 Id
: System
.Tasking
.Task_Id
;
92 use type System
.Tasking
.Task_Id
;
94 if not System
.Stack_Usage
.Is_Enabled
then
95 Put_Line
("Stack Usage not enabled: bind with -uNNN switch");
98 -- Loop over all tasks
100 for J
in System
.Tasking
.Debug
.Known_Tasks
'First + 1
101 .. System
.Tasking
.Debug
.Known_Tasks
'Last
103 Id
:= System
.Tasking
.Debug
.Known_Tasks
(J
);
106 -- Calculate the task usage for a given task
108 Report_For_Task
(Id
);
112 end Compute_All_Tasks
;
114 --------------------------
115 -- Compute_Current_Task --
116 --------------------------
118 procedure Compute_Current_Task
is
120 if not System
.Stack_Usage
.Is_Enabled
then
121 Put_Line
("Stack Usage not enabled: bind with -uNNN switch");
126 Report_For_Task
(System
.Tasking
.Self
);
129 end Compute_Current_Task
;
135 procedure Report_Impl
(All_Tasks
: Boolean; Do_Print
: Boolean) is
140 System
.Task_Primitives
.Operations
.Lock_RTS
;
147 Compute_Current_Task
;
152 System
.Stack_Usage
.Output_Results
;
155 -- Unlock the runtime
157 System
.Task_Primitives
.Operations
.Unlock_RTS
;
161 ----------------------
162 -- Report_All_Tasks --
163 ----------------------
165 procedure Report_All_Tasks
is
167 Report_Impl
(True, True);
168 end Report_All_Tasks
;
170 -------------------------
171 -- Report_Current_Task --
172 -------------------------
174 procedure Report_Current_Task
is
175 Res
: Stack_Usage_Result
;
177 Res
:= Get_Current_Task_Usage
;
179 end Report_Current_Task
;
181 -------------------------
182 -- Get_All_Tasks_Usage --
183 -------------------------
185 function Get_All_Tasks_Usage
return Stack_Usage_Result_Array
is
186 Res
: Stack_Usage_Result_Array
187 (1 .. System
.Stack_Usage
.Result_Array
'Length);
189 Report_Impl
(True, False);
191 for J
in Res
'Range loop
192 Convert
(System
.Stack_Usage
.Result_Array
(J
), Res
(J
));
196 end Get_All_Tasks_Usage
;
198 ----------------------------
199 -- Get_Current_Task_Usage --
200 ----------------------------
202 function Get_Current_Task_Usage
return Stack_Usage_Result
is
203 Res
: Stack_Usage_Result
;
204 Original
: System
.Stack_Usage
.Task_Result
;
205 Found
: Boolean := False;
208 Report_Impl
(False, False);
210 -- Look for the task info in System.Stack_Usage.Result_Array;
211 -- the search is based on task name
213 for T
in System
.Stack_Usage
.Result_Array
'Range loop
214 if System
.Stack_Usage
.Result_Array
(T
).Task_Name
=
215 System
.Tasking
.Self
.Common
.Analyzer
.Task_Name
217 Original
:= System
.Stack_Usage
.Result_Array
(T
);
223 -- Be sure a task has been found
225 pragma Assert
(Found
);
227 Convert
(Original
, Res
);
229 end Get_Current_Task_Usage
;
235 procedure Print
(Obj
: Stack_Usage_Result
) is
236 Pos
: Positive := Obj
.Task_Name
'Last;
239 -- Simply trim the string containing the task name
241 for S
in Obj
.Task_Name
'Range loop
242 if Obj
.Task_Name
(S
) = ' ' then
249 T_Name
: constant String :=
250 Obj
.Task_Name
(Obj
.Task_Name
'First .. Pos
);
253 ("| " & T_Name
& " | " & Natural'Image (Obj
.Stack_Size
) &
254 Natural'Image (Obj
.Value
));
258 end System
.Stack_Usage
.Tasking
;