1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T R A C E S . T A S K I N G --
9 -- Copyright (C) 2001-2009 Free Software Foundation, Inc. --
11 -- GNARL 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 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with System.Tasking; use System.Tasking;
33 with System.Soft_Links;
34 with System.Parameters;
35 with System.Traces.Format; use System.Traces.Format;
36 with System.Traces; use System.Traces;
38 package body System.Traces.Tasking is
42 package SSL renames System.Soft_Links;
44 function Extract_Accepts (Task_Name : Task_Id) return String_Trace;
45 -- This function is used to extract data joined with
46 -- W_Select, WT_Select, W_Accept events
52 procedure Send_Trace_Info (Id : Trace_T; Task_Name2 : Task_Id) is
53 Task_S : constant String := SSL.Task_Name.all;
54 Task2_S : constant String :=
55 Task_Name2.Common.Task_Image
56 (1 .. Task_Name2.Common.Task_Image_Len);
57 Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
59 L0 : constant Integer := Task_S'Length;
60 L1 : constant Integer := Task2_S'Length;
63 if Parameters.Runtime_Traces then
65 when M_RDV_Complete | PO_Done =>
66 Trace_S (1 .. 3) := "/N:";
67 Trace_S (4 .. 3 + L0) := Task_S;
68 Trace_S (4 + L0 .. 6 + L0) := "/C:";
69 Trace_S (7 + L0 .. Trace_S'Last) := Task2_S;
70 Send_Trace (Id, Trace_S);
73 Trace_S (1 .. 3) := "/N:";
74 Trace_S (4 .. 3 + L0) := Task_S;
75 Trace_S (4 + L0 .. 6 + L0) := "/A:";
76 Trace_S (7 + L0 .. Trace_S'Last) := Task2_S;
77 Send_Trace (Id, Trace_S);
80 Trace_S (1 .. 3) := "/N:";
81 Trace_S (4 .. 3 + L1) := Task2_S;
82 Trace_S (4 + L1 .. Trace_S'Last) := (others => ' ');
83 Send_Trace (Id, Trace_S);
86 Trace_S (1 .. 3) := "/N:";
87 Trace_S (4 .. 3 + L1) := Task2_S;
88 Trace_S (4 + L1 .. Trace_S'Last) := (others => ' ');
89 Send_Trace (Id, Trace_S);
93 -- should raise an exception ???
98 procedure Send_Trace_Info
100 Task_Name2 : Task_Id;
101 Entry_Number : Entry_Index)
103 Task_S : constant String := SSL.Task_Name.all;
104 Task2_S : constant String :=
105 Task_Name2.Common.Task_Image
106 (1 .. Task_Name2.Common.Task_Image_Len);
107 Entry_S : constant String := Integer'Image (Integer (Entry_Number));
108 Trace_S : String (1 .. 9 + Task_S'Length
109 + Task2_S'Length + Entry_S'Length);
111 L0 : constant Integer := Task_S'Length;
112 L1 : constant Integer := Task_S'Length + Entry_S'Length;
113 L2 : constant Integer := Task_S'Length + Task2_S'Length;
116 if Parameters.Runtime_Traces then
118 when M_Accept_Complete =>
119 Trace_S (1 .. 3) := "/N:";
120 Trace_S (4 .. 3 + L0) := Task_S;
121 Trace_S (4 + L0 .. 6 + L0) := "/E:";
122 Trace_S (7 + L0 .. 6 + L1) := Entry_S;
123 Trace_S (7 + L1 .. 9 + L1) := "/C:";
124 Trace_S (10 + L1 .. Trace_S'Last) := Task2_S;
125 Send_Trace (Id, Trace_S);
128 Trace_S (1 .. 3) := "/N:";
129 Trace_S (4 .. 3 + L0) := Task_S;
130 Trace_S (4 + L0 .. 6 + L0) := "/A:";
131 Trace_S (7 + L0 .. 6 + L2) := Task2_S;
132 Trace_S (7 + L2 .. 9 + L2) := "/C:";
133 Trace_S (10 + L2 .. Trace_S'Last) := Entry_S;
134 Send_Trace (Id, Trace_S);
138 -- should raise an exception ???
143 procedure Send_Trace_Info
146 Task_Name2 : Task_Id;
147 Entry_Number : Entry_Index)
149 Task_S : constant String :=
150 Task_Name.Common.Task_Image
151 (1 .. Task_Name.Common.Task_Image_Len);
152 Task2_S : constant String :=
153 Task_Name2.Common.Task_Image
154 (1 .. Task_Name2.Common.Task_Image_Len);
155 Entry_S : constant String := Integer'Image (Integer (Entry_Number));
156 Trace_S : String (1 .. 9 + Task_S'Length
157 + Task2_S'Length + Entry_S'Length);
159 L0 : constant Integer := Task_S'Length;
160 L1 : constant Integer := Task_S'Length + Entry_S'Length;
163 if Parameters.Runtime_Traces then
166 Trace_S (1 .. 3) := "/N:";
167 Trace_S (4 .. 3 + L0) := Task_S;
168 Trace_S (4 + L0 .. 6 + L0) := "/E:";
169 Trace_S (7 + L0 .. 6 + L1) := Entry_S;
170 Trace_S (7 + L1 .. 9 + L1) := "/C:";
171 Trace_S (10 + L1 .. Trace_S'Last) := Task2_S;
172 Send_Trace (Id, Trace_S);
176 -- should raise an exception ???
181 procedure Send_Trace_Info (Id : Trace_T; Entry_Number : Entry_Index) is
182 Task_S : constant String := SSL.Task_Name.all;
183 Entry_S : constant String := Integer'Image (Integer (Entry_Number));
184 Trace_S : String (1 .. 6 + Task_S'Length + Entry_S'Length);
186 L0 : constant Integer := Task_S'Length;
189 if Parameters.Runtime_Traces then
190 Trace_S (1 .. 3) := "/N:";
191 Trace_S (4 .. 3 + L0) := Task_S;
192 Trace_S (4 + L0 .. 6 + L0) := "/E:";
193 Trace_S (7 + L0 .. Trace_S'Last) := Entry_S;
194 Send_Trace (Id, Trace_S);
198 procedure Send_Trace_Info
201 Task_Name2 : Task_Id)
203 Task_S : constant String :=
204 Task_Name.Common.Task_Image
205 (1 .. Task_Name.Common.Task_Image_Len);
206 Task2_S : constant String :=
207 Task_Name2.Common.Task_Image
208 (1 .. Task_Name2.Common.Task_Image_Len);
209 Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
211 L0 : constant Integer := Task2_S'Length;
214 if Parameters.Runtime_Traces then
215 Trace_S (1 .. 3) := "/N:";
216 Trace_S (4 .. 3 + L0) := Task2_S;
217 Trace_S (4 + L0 .. 6 + L0) := "/P:";
218 Trace_S (7 + L0 .. Trace_S'Last) := Task_S;
219 Send_Trace (Id, Trace_S);
223 procedure Send_Trace_Info
226 Entry_Number : Entry_Index;
229 Task_S : constant String := SSL.Task_Name.all;
230 Acceptor_S : constant String :=
231 Acceptor.Common.Task_Image
232 (1 .. Acceptor.Common.Task_Image_Len);
233 Entry_S : constant String := Integer'Image (Integer (Entry_Number));
234 Timeout_S : constant String := Duration'Image (Timeout);
235 Trace_S : String (1 .. 12 + Task_S'Length + Acceptor_S'Length
236 + Entry_S'Length + Timeout_S'Length);
238 L0 : constant Integer := Task_S'Length;
239 L1 : constant Integer := Task_S'Length + Acceptor_S'Length;
240 L2 : constant Integer :=
241 Task_S'Length + Acceptor_S'Length + Entry_S'Length;
244 if Parameters.Runtime_Traces then
245 Trace_S (1 .. 3) := "/N:";
246 Trace_S (4 .. 3 + L0) := Task_S;
247 Trace_S (4 + L0 .. 6 + L0) := "/A:";
248 Trace_S (7 + L0 .. 6 + L1) := Acceptor_S;
249 Trace_S (7 + L1 .. 9 + L1) := "/E:";
250 Trace_S (10 + L1 .. 9 + L2) := Entry_S;
251 Trace_S (10 + L2 .. 12 + L2) := "/T:";
252 Trace_S (13 + L2 .. Trace_S'Last) := Timeout_S;
253 Send_Trace (Id, Trace_S);
257 procedure Send_Trace_Info
259 Entry_Number : Entry_Index;
262 Task_S : constant String := SSL.Task_Name.all;
263 Entry_S : constant String := Integer'Image (Integer (Entry_Number));
264 Timeout_S : constant String := Duration'Image (Timeout);
265 Trace_S : String (1 .. 9 + Task_S'Length
266 + Entry_S'Length + Timeout_S'Length);
268 L0 : constant Integer := Task_S'Length;
269 L1 : constant Integer := Task_S'Length + Entry_S'Length;
272 if Parameters.Runtime_Traces then
273 Trace_S (1 .. 3) := "/N:";
274 Trace_S (4 .. 3 + L0) := Task_S;
275 Trace_S (4 + L0 .. 6 + L0) := "/E:";
276 Trace_S (7 + L0 .. 6 + L1) := Entry_S;
277 Trace_S (7 + L1 .. 9 + L1) := "/T:";
278 Trace_S (10 + L1 .. Trace_S'Last) := Timeout_S;
279 Send_Trace (Id, Trace_S);
283 procedure Send_Trace_Info
288 Task_S : constant String := SSL.Task_Name.all;
289 Number_S : constant String := Integer'Image (Number);
290 Accepts_S : constant String := Extract_Accepts (Task_Name);
291 Trace_S : String (1 .. 9 + Task_S'Length
292 + Number_S'Length + Accepts_S'Length);
294 L0 : constant Integer := Task_S'Length;
295 L1 : constant Integer := Task_S'Length + Number_S'Length;
298 if Parameters.Runtime_Traces then
299 Trace_S (1 .. 3) := "/N:";
300 Trace_S (4 .. 3 + L0) := Task_S;
301 Trace_S (4 + L0 .. 6 + L0) := "/#:";
302 Trace_S (7 + L0 .. 6 + L1) := Number_S;
303 Trace_S (7 + L1 .. 9 + L1) := "/E:";
304 Trace_S (10 + L1 .. Trace_S'Last) := Accepts_S;
305 Send_Trace (Id, Trace_S);
309 procedure Send_Trace_Info
315 Task_S : constant String := SSL.Task_Name.all;
316 Timeout_S : constant String := Duration'Image (Timeout);
317 Number_S : constant String := Integer'Image (Number);
318 Accepts_S : constant String := Extract_Accepts (Task_Name);
319 Trace_S : String (1 .. 12 + Task_S'Length + Timeout_S'Length
320 + Number_S'Length + Accepts_S'Length);
322 L0 : constant Integer := Task_S'Length;
323 L1 : constant Integer := Task_S'Length + Timeout_S'Length;
324 L2 : constant Integer :=
325 Task_S'Length + Timeout_S'Length + Number_S'Length;
328 if Parameters.Runtime_Traces then
329 Trace_S (1 .. 3) := "/N:";
330 Trace_S (4 .. 3 + L0) := Task_S;
331 Trace_S (4 + L0 .. 6 + L0) := "/T:";
332 Trace_S (7 + L0 .. 6 + L1) := Timeout_S;
333 Trace_S (7 + L1 .. 9 + L1) := "/#:";
334 Trace_S (10 + L1 .. 9 + L2) := Number_S;
335 Trace_S (10 + L2 .. 12 + L2) := "/E:";
336 Trace_S (13 + L2 .. Trace_S'Last) := Accepts_S;
337 Send_Trace (Id, Trace_S);
341 ---------------------
342 -- Extract_Accepts --
343 ---------------------
345 -- This function returns a string in which all opened
346 -- Accepts or Selects are given, separated by semi-colons.
348 function Extract_Accepts (Task_Name : Task_Id) return String_Trace is
349 Info_Annex : String_Trace := (ASCII.NUL, others => ' ');
352 for J in Task_Name.Open_Accepts'First ..
353 Task_Name.Open_Accepts'Last - 1
355 Info_Annex := Append (Info_Annex, Integer'Image
356 (Integer (Task_Name.Open_Accepts (J).S)) & ",");
359 Info_Annex := Append (Info_Annex,
360 Integer'Image (Integer
361 (Task_Name.Open_Accepts
362 (Task_Name.Open_Accepts'Last).S)));
365 end System.Traces.Tasking;