1 ------------------------------------------------------------------------------
3 -- GNU ADA 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-2002 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 2, or (at your option) any later ver- --
14 -- sion. GNARL 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with System.Tasking; use System.Tasking;
35 with System.Soft_Links;
36 with System.Parameters;
37 with System.Traces.Format; use System.Traces.Format;
38 with System.Traces; use System.Traces;
40 package body System.Traces.Tasking is
44 use System.Traces.Format;
46 package SSL renames System.Soft_Links;
48 function Extract_Accepts (Task_Name : Task_ID) return String_Trace;
49 -- This function is used to extract data joined with
50 -- W_Select, WT_Select, W_Accept events
56 procedure Send_Trace_Info (Id : Trace_T; Task_Name2 : Task_ID) is
57 Task_S : constant String := SSL.Task_Name.all;
58 Task2_S : constant String :=
59 Task_Name2.Common.Task_Image
60 (1 .. Task_Name2.Common.Task_Image_Len);
61 Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
63 L0 : Integer := Task_S'Length;
64 L1 : Integer := Task2_S'Length;
67 if Parameters.Runtime_Traces then
69 when M_RDV_Complete | PO_Done =>
70 Trace_S (1 .. 3) := "/N:";
71 Trace_S (4 .. 3 + L0) := Task_S;
72 Trace_S (4 + L0 .. 6 + L0) := "/C:";
73 Trace_S (7 + L0 .. Trace_S'Last) := Task2_S;
74 Send_Trace (Id, Trace_S);
77 Trace_S (1 .. 3) := "/N:";
78 Trace_S (4 .. 3 + L0) := Task_S;
79 Trace_S (4 + L0 .. 6 + L0) := "/A:";
80 Trace_S (7 + L0 .. Trace_S'Last) := Task2_S;
81 Send_Trace (Id, Trace_S);
84 Trace_S (1 .. 3) := "/N:";
85 Trace_S (4 .. 3 + L1) := Task2_S;
86 Trace_S (4 + L1 .. Trace_S'Last) := (others => ' ');
87 Send_Trace (Id, Trace_S);
90 Trace_S (1 .. 3) := "/N:";
91 Trace_S (4 .. 3 + L1) := Task2_S;
92 Trace_S (4 + L1 .. Trace_S'Last) := (others => ' ');
93 Send_Trace (Id, Trace_S);
97 -- should raise an exception ???
102 procedure Send_Trace_Info
104 Task_Name2 : Task_ID;
105 Entry_Number : Entry_Index)
107 Task_S : constant String := SSL.Task_Name.all;
108 Task2_S : constant String :=
109 Task_Name2.Common.Task_Image
110 (1 .. Task_Name2.Common.Task_Image_Len);
111 Entry_S : String := Integer'Image (Integer (Entry_Number));
112 Trace_S : String (1 .. 9 + Task_S'Length
113 + Task2_S'Length + Entry_S'Length);
115 L0 : Integer := Task_S'Length;
116 L1 : Integer := Task_S'Length + Entry_S'Length;
117 L2 : Integer := Task_S'Length + Task2_S'Length;
120 if Parameters.Runtime_Traces then
122 when M_Accept_Complete =>
123 Trace_S (1 .. 3) := "/N:";
124 Trace_S (4 .. 3 + L0) := Task_S;
125 Trace_S (4 + L0 .. 6 + L0) := "/E:";
126 Trace_S (7 + L0 .. 6 + L1) := Entry_S;
127 Trace_S (7 + L1 .. 9 + L1) := "/C:";
128 Trace_S (10 + L1 .. Trace_S'Last) := Task2_S;
129 Send_Trace (Id, Trace_S);
132 Trace_S (1 .. 3) := "/N:";
133 Trace_S (4 .. 3 + L0) := Task_S;
134 Trace_S (4 + L0 .. 6 + L0) := "/A:";
135 Trace_S (7 + L0 .. 6 + L2) := Task2_S;
136 Trace_S (7 + L2 .. 9 + L2) := "/C:";
137 Trace_S (10 + L2 .. Trace_S'Last) := Entry_S;
138 Send_Trace (Id, Trace_S);
142 -- should raise an exception ???
147 procedure Send_Trace_Info
150 Task_Name2 : Task_ID;
151 Entry_Number : Entry_Index)
153 Task_S : constant String :=
154 Task_Name.Common.Task_Image
155 (1 .. Task_Name.Common.Task_Image_Len);
156 Task2_S : constant String :=
157 Task_Name2.Common.Task_Image
158 (1 .. Task_Name2.Common.Task_Image_Len);
159 Entry_S : String := Integer'Image (Integer (Entry_Number));
160 Trace_S : String (1 .. 9 + Task_S'Length
161 + Task2_S'Length + Entry_S'Length);
163 L0 : Integer := Task_S'Length;
164 L1 : Integer := Task_S'Length + Entry_S'Length;
167 if Parameters.Runtime_Traces then
170 Trace_S (1 .. 3) := "/N:";
171 Trace_S (4 .. 3 + L0) := Task_S;
172 Trace_S (4 + L0 .. 6 + L0) := "/E:";
173 Trace_S (7 + L0 .. 6 + L1) := Entry_S;
174 Trace_S (7 + L1 .. 9 + L1) := "/C:";
175 Trace_S (10 + L1 .. Trace_S'Last) := Task2_S;
176 Send_Trace (Id, Trace_S);
180 -- should raise an exception ???
185 procedure Send_Trace_Info (Id : Trace_T; Entry_Number : Entry_Index) is
186 Task_S : String := SSL.Task_Name.all;
187 Entry_S : String := Integer'Image (Integer (Entry_Number));
188 Trace_S : String (1 .. 6 + Task_S'Length + Entry_S'Length);
190 L0 : Integer := Task_S'Length;
193 if Parameters.Runtime_Traces then
194 Trace_S (1 .. 3) := "/N:";
195 Trace_S (4 .. 3 + L0) := Task_S;
196 Trace_S (4 + L0 .. 6 + L0) := "/E:";
197 Trace_S (7 + L0 .. Trace_S'Last) := Entry_S;
198 Send_Trace (Id, Trace_S);
202 procedure Send_Trace_Info
205 Task_Name2 : Task_ID)
207 Task_S : constant String :=
208 Task_Name.Common.Task_Image
209 (1 .. Task_Name.Common.Task_Image_Len);
210 Task2_S : constant String :=
211 Task_Name2.Common.Task_Image
212 (1 .. Task_Name2.Common.Task_Image_Len);
213 Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
215 L0 : Integer := Task2_S'Length;
218 if Parameters.Runtime_Traces then
219 Trace_S (1 .. 3) := "/N:";
220 Trace_S (4 .. 3 + L0) := Task2_S;
221 Trace_S (4 + L0 .. 6 + L0) := "/P:";
222 Trace_S (7 + L0 .. Trace_S'Last) := Task_S;
223 Send_Trace (Id, Trace_S);
227 procedure Send_Trace_Info
230 Entry_Number : Entry_Index;
233 Task_S : constant String := SSL.Task_Name.all;
234 Acceptor_S : constant String :=
235 Acceptor.Common.Task_Image
236 (1 .. Acceptor.Common.Task_Image_Len);
237 Entry_S : String := Integer'Image (Integer (Entry_Number));
238 Timeout_S : String := Duration'Image (Timeout);
239 Trace_S : String (1 .. 12 + Task_S'Length + Acceptor_S'Length
240 + Entry_S'Length + Timeout_S'Length);
242 L0 : Integer := Task_S'Length;
243 L1 : Integer := Task_S'Length + Acceptor_S'Length;
244 L2 : Integer := Task_S'Length + Acceptor_S'Length + Entry_S'Length;
247 if Parameters.Runtime_Traces then
248 Trace_S (1 .. 3) := "/N:";
249 Trace_S (4 .. 3 + L0) := Task_S;
250 Trace_S (4 + L0 .. 6 + L0) := "/A:";
251 Trace_S (7 + L0 .. 6 + L1) := Acceptor_S;
252 Trace_S (7 + L1 .. 9 + L1) := "/E:";
253 Trace_S (10 + L1 .. 9 + L2) := Entry_S;
254 Trace_S (10 + L2 .. 12 + L2) := "/T:";
255 Trace_S (13 + L2 .. Trace_S'Last) := Timeout_S;
256 Send_Trace (Id, Trace_S);
260 procedure Send_Trace_Info
262 Entry_Number : Entry_Index;
265 Task_S : String := SSL.Task_Name.all;
266 Entry_S : String := Integer'Image (Integer (Entry_Number));
267 Timeout_S : String := Duration'Image (Timeout);
268 Trace_S : String (1 .. 9 + Task_S'Length
269 + Entry_S'Length + Timeout_S'Length);
271 L0 : Integer := Task_S'Length;
272 L1 : Integer := Task_S'Length + Entry_S'Length;
275 if Parameters.Runtime_Traces then
276 Trace_S (1 .. 3) := "/N:";
277 Trace_S (4 .. 3 + L0) := Task_S;
278 Trace_S (4 + L0 .. 6 + L0) := "/E:";
279 Trace_S (7 + L0 .. 6 + L1) := Entry_S;
280 Trace_S (7 + L1 .. 9 + L1) := "/T:";
281 Trace_S (10 + L1 .. Trace_S'Last) := Timeout_S;
282 Send_Trace (Id, Trace_S);
286 procedure Send_Trace_Info
291 Task_S : String := SSL.Task_Name.all;
292 Number_S : String := Integer'Image (Number);
293 Accepts_S : String := Extract_Accepts (Task_Name);
294 Trace_S : String (1 .. 9 + Task_S'Length
295 + Number_S'Length + Accepts_S'Length);
297 L0 : Integer := Task_S'Length;
298 L1 : Integer := Task_S'Length + Number_S'Length;
301 if Parameters.Runtime_Traces then
302 Trace_S (1 .. 3) := "/N:";
303 Trace_S (4 .. 3 + L0) := Task_S;
304 Trace_S (4 + L0 .. 6 + L0) := "/#:";
305 Trace_S (7 + L0 .. 6 + L1) := Number_S;
306 Trace_S (7 + L1 .. 9 + L1) := "/E:";
307 Trace_S (10 + L1 .. Trace_S'Last) := Accepts_S;
308 Send_Trace (Id, Trace_S);
312 procedure Send_Trace_Info
318 Task_S : String := SSL.Task_Name.all;
319 Timeout_S : String := Duration'Image (Timeout);
320 Number_S : String := Integer'Image (Number);
321 Accepts_S : String := Extract_Accepts (Task_Name);
322 Trace_S : String (1 .. 12 + Task_S'Length + Timeout_S'Length
323 + Number_S'Length + Accepts_S'Length);
325 L0 : Integer := Task_S'Length;
326 L1 : Integer := Task_S'Length + Timeout_S'Length;
327 L2 : Integer := Task_S'Length + Timeout_S'Length + Number_S'Length;
330 if Parameters.Runtime_Traces then
331 Trace_S (1 .. 3) := "/N:";
332 Trace_S (4 .. 3 + L0) := Task_S;
333 Trace_S (4 + L0 .. 6 + L0) := "/T:";
334 Trace_S (7 + L0 .. 6 + L1) := Timeout_S;
335 Trace_S (7 + L1 .. 9 + L1) := "/#:";
336 Trace_S (10 + L1 .. 9 + L2) := Number_S;
337 Trace_S (10 + L2 .. 12 + L2) := "/E:";
338 Trace_S (13 + L2 .. Trace_S'Last) := Accepts_S;
339 Send_Trace (Id, Trace_S);
343 ---------------------
344 -- Extract_Accepts --
345 ---------------------
347 -- This function returns a string in which all opened
348 -- Accepts or Selects are given, separated by semi-colons.
350 function Extract_Accepts (Task_Name : Task_ID) return String_Trace is
351 Info_Annex : String_Trace := (ASCII.NUL, others => ' ');
354 for J in Task_Name.Open_Accepts'First ..
355 Task_Name.Open_Accepts'Last - 1
357 Info_Annex := Append (Info_Annex, Integer'Image
358 (Integer (Task_Name.Open_Accepts (J).S)) & ",");
361 Info_Annex := Append (Info_Annex,
362 Integer'Image (Integer
363 (Task_Name.Open_Accepts
364 (Task_Name.Open_Accepts'Last).S)));
367 end System.Traces.Tasking;