OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-stusta.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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
-- 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
 
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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.