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-2018, 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-- 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
32with System.Stack_Usage;
33
34--  This is why this package is part of GNARL:
35
36with System.Tasking.Debug;
37with System.Task_Primitives.Operations;
38
39with System.IO;
40
41package 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
258end System.Stack_Usage.Tasking;
259