1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T R A C E S . S E N D --
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 -- This version is for all targets, provided that System.IO.Put_Line is
33 -- functional. It prints debug information to Standard Output
35 with System.IO; use System.IO;
36 with System.Regpat; use System.Regpat;
42 -- Prints debug information both in a human readable form
43 -- and in the form they are sent from upper layers.
45 separate (System.Traces.Format)
46 procedure Send_Trace (Id : Trace_T; Info : String) is
56 -- Type of parameter found in the message
58 Info_Trace : String_Trace := Format_Trace (Info);
61 (Input : String_Trace;
65 -- Extract a parameter from the given input string
72 (Input : String_Trace;
77 pragma Unreferenced (How_Many);
79 Matches : Match_Array (1 .. 2);
81 -- We need comments here ???
85 Match ("/N:([\w]+)", Input, Matches);
88 Match ("/C:([\w]+)", Input, Matches);
91 Match ("/E:([\s]*) +([0-9 ,]+)", Input, Matches);
94 Match ("/T:([\s]*) +([0-9]+.[0-9]+)", Input, Matches);
96 when Acceptor_Param =>
97 Match ("/A:([\w]+)", Input, Matches);
100 Match ("/P:([\w]+)", Input, Matches);
103 Match ("/#:([\s]*) +([0-9]+)", Input, Matches);
106 if Matches (1).First < Input'First then
111 when Timeout_Param | Entry_Param | Number_Param =>
112 return Input (Matches (2).First .. Matches (2).Last);
115 return Input (Matches (1).First .. Matches (1).Last);
119 -- Start of processing for Send_Trace
123 Put_Line ("- Trace Debug Info ----------------");
124 Put ("Caught event Id : ");
127 when M_Accept_Complete => Put ("M_Accept_Complete");
129 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
130 & " completes accept on entry "
131 & Get_Param (Info_Trace, Entry_Param, 1) & " with "
132 & Get_Param (Info_Trace, Caller_Param, 1));
134 when M_Select_Else => Put ("M_Select_Else");
136 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
137 & " selects else statement");
139 when M_RDV_Complete => Put ("M_RDV_Complete");
141 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
142 & " completes rendezvous with "
143 & Get_Param (Info_Trace, Caller_Param, 1));
145 when M_Call_Complete => Put ("M_Call_Complete");
147 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
148 & " completes call");
150 when M_Delay => Put ("M_Delay");
152 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
153 & " completes delay "
154 & Get_Param (Info_Trace, Timeout_Param, 1));
156 when E_Missed => Put ("E_Missed");
158 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
159 & " got an invalid acceptor "
160 & Get_Param (Info_Trace, Acceptor_Param, 1));
162 when E_Timeout => Put ("E_Timeout");
164 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
165 & " ends select due to timeout ");
167 when E_Kill => Put ("E_Kill");
169 Put_Line ("Asynchronous Transfer of Control on task "
170 & Get_Param (Info_Trace, Name_Param, 1));
172 when W_Delay => Put ("W_Delay");
174 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
176 & Get_Param (Info_Trace, Timeout_Param, 1)
179 when WU_Delay => Put ("WU_Delay");
181 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
183 & Get_Param (Info_Trace, Timeout_Param, 1));
185 when W_Call => Put ("W_Call");
187 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
189 & Get_Param (Info_Trace, Entry_Param, 1)
190 & " of " & Get_Param (Info_Trace, Acceptor_Param, 1));
192 when W_Accept => Put ("W_Accept");
194 Put ("Task " & Get_Param (Info_Trace, Name_Param, 1)
196 & Get_Param (Info_Trace, Number_Param, 1)
198 & ", " & Get_Param (Info_Trace, Entry_Param, 1));
201 when W_Select => Put ("W_Select");
203 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
205 & Get_Param (Info_Trace, Number_Param, 1)
207 & ", " & Get_Param (Info_Trace, Entry_Param, 1));
210 when W_Completion => Put ("W_Completion");
212 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
213 & " waiting for completion ");
215 when WT_Select => Put ("WT_Select");
217 Put ("Task " & Get_Param (Info_Trace, Name_Param, 1)
218 & " waiting " & Get_Param (Info_Trace, Timeout_Param, 1)
220 & Get_Param (Info_Trace, Number_Param, 1)
223 if Get_Param (Info_Trace, Number_Param, 1) /= "" then
224 Put (", " & Get_Param (Info_Trace, Entry_Param, 1));
229 when WT_Call => Put ("WT_Call");
231 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
233 & Get_Param (Info_Trace, Entry_Param, 1)
234 & " of " & Get_Param (Info_Trace, Acceptor_Param, 1)
236 & Get_Param (Info_Trace, Timeout_Param, 1));
238 when WT_Completion => Put ("WT_Completion");
240 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
242 & Get_Param (Info_Trace, Timeout_Param, 1)
243 & " for call completion");
245 when PO_Call => Put ("PO_Call");
247 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
248 & " calling protected entry "
249 & Get_Param (Info_Trace, Entry_Param, 1));
251 when POT_Call => Put ("POT_Call");
253 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
254 & " calling protected entry "
255 & Get_Param (Info_Trace, Entry_Param, 1)
257 & Get_Param (Info_Trace, Timeout_Param, 1));
259 when PO_Run => Put ("PO_Run");
261 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
263 & Get_Param (Info_Trace, Entry_Param, 1)
265 & Get_Param (Info_Trace, Caller_Param, 1));
267 when PO_Done => Put ("PO_Done");
269 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
270 & " finished call from "
271 & Get_Param (Info_Trace, Caller_Param, 1));
273 when PO_Lock => Put ("PO_Lock");
275 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
278 when PO_Unlock => Put ("PO_Unlock");
280 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
283 when T_Create => Put ("T_Create");
285 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
288 when T_Activate => Put ("T_Activate");
290 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
293 when T_Abort => Put ("T_Abort");
295 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
297 & Get_Param (Info_Trace, Parent_Param, 1));
299 when T_Terminate => Put ("T_Terminate");
301 Put_Line ("Task " & Get_Param (Info_Trace, Name_Param, 1)
305 => Put ("Invalid Id");
308 Put_Line (" --> " & Info_Trace);
309 Put_Line ("-----------------------------------");