File : s-stusta.adb
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 -- --
9 -- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
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 -- --
19 -- --
20 -- --
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
161 ---------------------
162 -- Report_All_Task --
163 ---------------------
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;