|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S Y S T E M . S T A C K _ U S A G E . T A S K I N G --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2009-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
17 -- --
|
|
|
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. --
|
|
|
21 -- --
|
|
|
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/>. --
|
|
|
26 -- --
|
|
|
27 -- GNARL was developed by the GNARL team at Florida State University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with System.Stack_Usage;
|
|
|
33
|
|
|
34 -- This is why this package is part of GNARL:
|
|
|
35
|
|
|
36 with System.Tasking.Debug;
|
|
|
37 with System.Task_Primitives.Operations;
|
|
|
38
|
|
|
39 with System.IO;
|
|
|
40
|
|
|
41 package body System.Stack_Usage.Tasking is
|
|
|
42 use System.IO;
|
|
|
43
|
|
|
44 procedure Report_For_Task (Id : System.Tasking.Task_Id);
|
|
|
45 -- A generic procedure calculating stack usage for a given task
|
|
|
46
|
|
|
47 procedure Compute_All_Tasks;
|
|
|
48 -- Compute the stack usage for all tasks and saves it in
|
|
|
49 -- System.Stack_Usage.Result_Array
|
|
|
50
|
|
|
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;
|
|
|
54
|
|
|
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
|
|
|
58 -- printed on stderr
|
|
|
59
|
|
|
60 procedure Convert
|
|
|
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
|
|
|
64
|
|
|
65 -------------
|
|
|
66 -- Convert --
|
|
|
67 -------------
|
|
|
68
|
|
|
69 procedure Convert
|
|
|
70 (TS : System.Stack_Usage.Task_Result;
|
|
|
71 Res : out Stack_Usage_Result) is
|
|
|
72 begin
|
|
|
73 Res := TS;
|
|
|
74 end Convert;
|
|
|
75
|
|
|
76 ---------------------
|
|
|
77 -- Report_For_Task --
|
|
|
78 ---------------------
|
|
|
79
|
|
|
80 procedure Report_For_Task (Id : System.Tasking.Task_Id) is
|
|
|
81 begin
|
|
|
82 System.Stack_Usage.Compute_Result (Id.Common.Analyzer);
|
|
|
83 System.Stack_Usage.Report_Result (Id.Common.Analyzer);
|
|
|
84 end Report_For_Task;
|
|
|
85
|
|
|
86 -----------------------
|
|
|
87 -- Compute_All_Tasks --
|
|
|
88 -----------------------
|
|
|
89
|
|
|
90 procedure Compute_All_Tasks is
|
|
|
91 Id : System.Tasking.Task_Id;
|
|
|
92 use type System.Tasking.Task_Id;
|
|
|
93 begin
|
|
|
94 if not System.Stack_Usage.Is_Enabled then
|
|
|
95 Put_Line ("Stack Usage not enabled: bind with -uNNN switch");
|
|
|
96 else
|
|
|
97
|
|
|
98 -- Loop over all tasks
|
|
|
99
|
|
|
100 for J in System.Tasking.Debug.Known_Tasks'First + 1
|
|
|
101 .. System.Tasking.Debug.Known_Tasks'Last
|
|
|
102 loop
|
|
|
103 Id := System.Tasking.Debug.Known_Tasks (J);
|
|
|
104 exit when Id = null;
|
|
|
105
|
|
|
106 -- Calculate the task usage for a given task
|
|
|
107
|
|
|
108 Report_For_Task (Id);
|
|
|
109 end loop;
|
|
|
110
|
|
|
111 end if;
|
|
|
112 end Compute_All_Tasks;
|
|
|
113
|
|
|
114 --------------------------
|
|
|
115 -- Compute_Current_Task --
|
|
|
116 --------------------------
|
|
|
117
|
|
|
118 procedure Compute_Current_Task is
|
|
|
119 begin
|
|
|
120 if not System.Stack_Usage.Is_Enabled then
|
|
|
121 Put_Line ("Stack Usage not enabled: bind with -uNNN switch");
|
|
|
122 else
|
|
|
123
|
|
|
124 -- The current task
|
|
|
125
|
|
|
126 Report_For_Task (System.Tasking.Self);
|
|
|
127
|
|
|
128 end if;
|
|
|
129 end Compute_Current_Task;
|
|
|
130
|
|
|
131 -----------------
|
|
|
132 -- Report_Impl --
|
|
|
133 -----------------
|
|
|
134
|
|
|
135 procedure Report_Impl (All_Tasks : Boolean; Do_Print : Boolean) is
|
|
|
136 begin
|
|
|
137
|
|
|
138 -- Lock the runtime
|
|
|
139
|
|
|
140 System.Task_Primitives.Operations.Lock_RTS;
|
|
|
141
|
|
|
142 -- Calculate results
|
|
|
143
|
|
|
144 if All_Tasks then
|
|
|
145 Compute_All_Tasks;
|
|
|
146 else
|
|
|
147 Compute_Current_Task;
|
|
|
148 end if;
|
|
|
149
|
|
|
150 -- Output results
|
|
|
151 if Do_Print then
|
|
|
152 System.Stack_Usage.Output_Results;
|
|
|
153 end if;
|
|
|
154
|
|
|
155 -- Unlock the runtime
|
|
|
156
|
|
|
157 System.Task_Primitives.Operations.Unlock_RTS;
|
|
|
158
|
|
|
159 end Report_Impl;
|
|
|
160
|
|
131
|
161 ----------------------
|
|
|
162 -- Report_All_Tasks --
|
|
|
163 ----------------------
|
|
111
|
164
|
|
|
165 procedure Report_All_Tasks is
|
|
|
166 begin
|
|
|
167 Report_Impl (True, True);
|
|
|
168 end Report_All_Tasks;
|
|
|
169
|
|
|
170 -------------------------
|
|
|
171 -- Report_Current_Task --
|
|
|
172 -------------------------
|
|
|
173
|
|
|
174 procedure Report_Current_Task is
|
|
|
175 Res : Stack_Usage_Result;
|
|
|
176 begin
|
|
|
177 Res := Get_Current_Task_Usage;
|
|
|
178 Print (Res);
|
|
|
179 end Report_Current_Task;
|
|
|
180
|
|
|
181 -------------------------
|
|
|
182 -- Get_All_Tasks_Usage --
|
|
|
183 -------------------------
|
|
|
184
|
|
|
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);
|
|
|
188 begin
|
|
|
189 Report_Impl (True, False);
|
|
|
190
|
|
|
191 for J in Res'Range loop
|
|
|
192 Convert (System.Stack_Usage.Result_Array (J), Res (J));
|
|
|
193 end loop;
|
|
|
194
|
|
|
195 return Res;
|
|
|
196 end Get_All_Tasks_Usage;
|
|
|
197
|
|
|
198 ----------------------------
|
|
|
199 -- Get_Current_Task_Usage --
|
|
|
200 ----------------------------
|
|
|
201
|
|
|
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;
|
|
|
206 begin
|
|
|
207
|
|
|
208 Report_Impl (False, False);
|
|
|
209
|
|
|
210 -- Look for the task info in System.Stack_Usage.Result_Array;
|
|
|
211 -- the search is based on task name
|
|
|
212
|
|
|
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
|
|
|
216 then
|
|
|
217 Original := System.Stack_Usage.Result_Array (T);
|
|
|
218 Found := True;
|
|
|
219 exit;
|
|
|
220 end if;
|
|
|
221 end loop;
|
|
|
222
|
|
|
223 -- Be sure a task has been found
|
|
|
224
|
|
|
225 pragma Assert (Found);
|
|
|
226
|
|
|
227 Convert (Original, Res);
|
|
|
228 return Res;
|
|
|
229 end Get_Current_Task_Usage;
|
|
|
230
|
|
|
231 -----------
|
|
|
232 -- Print --
|
|
|
233 -----------
|
|
|
234
|
|
|
235 procedure Print (Obj : Stack_Usage_Result) is
|
|
|
236 Pos : Positive := Obj.Task_Name'Last;
|
|
|
237
|
|
|
238 begin
|
|
|
239 -- Simply trim the string containing the task name
|
|
|
240
|
|
|
241 for S in Obj.Task_Name'Range loop
|
|
|
242 if Obj.Task_Name (S) = ' ' then
|
|
|
243 Pos := S;
|
|
|
244 exit;
|
|
|
245 end if;
|
|
|
246 end loop;
|
|
|
247
|
|
|
248 declare
|
|
|
249 T_Name : constant String :=
|
|
|
250 Obj.Task_Name (Obj.Task_Name'First .. Pos);
|
|
|
251 begin
|
|
|
252 Put_Line
|
|
|
253 ("| " & T_Name & " | " & Natural'Image (Obj.Stack_Size) &
|
|
|
254 Natural'Image (Obj.Value));
|
|
|
255 end;
|
|
|
256 end Print;
|
|
|
257
|
|
|
258 end System.Stack_Usage.Tasking;
|
