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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-tratas-default.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 . T R A C E S . T A S K I N G                --
6
--                                                                          --
7
--                                  B o d y                                 --
8
--                                                                          --
9
--           Copyright (C) 2001-2009 Free Software Foundation, Inc.         --
10
--                                                                          --
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.                                     --
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
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
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;
37
 
38
package body System.Traces.Tasking is
39
 
40
   use System.Traces;
41
 
42
   package SSL renames System.Soft_Links;
43
 
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
47
 
48
   ---------------------
49
   -- Send_Trace_Info --
50
   ---------------------
51
 
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);
58
 
59
      L0 : constant Integer := Task_S'Length;
60
      L1 : constant Integer := Task2_S'Length;
61
 
62
   begin
63
      if Parameters.Runtime_Traces then
64
         case Id is
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);
71
 
72
            when E_Missed =>
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);
78
 
79
            when E_Kill =>
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);
84
 
85
            when T_Create =>
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);
90
 
91
            when others =>
92
               null;
93
               --  should raise an exception ???
94
         end case;
95
      end if;
96
   end Send_Trace_Info;
97
 
98
   procedure Send_Trace_Info
99
     (Id           : Trace_T;
100
      Task_Name2   : Task_Id;
101
      Entry_Number : Entry_Index)
102
   is
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);
110
 
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;
114
 
115
   begin
116
      if Parameters.Runtime_Traces then
117
         case Id is
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);
126
 
127
            when W_Call =>
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);
135
 
136
            when others =>
137
               null;
138
               --  should raise an exception ???
139
         end case;
140
      end if;
141
   end Send_Trace_Info;
142
 
143
   procedure Send_Trace_Info
144
     (Id           : Trace_T;
145
      Task_Name    : Task_Id;
146
      Task_Name2   : Task_Id;
147
      Entry_Number : Entry_Index)
148
   is
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);
158
 
159
      L0 : constant Integer := Task_S'Length;
160
      L1 : constant Integer := Task_S'Length + Entry_S'Length;
161
 
162
   begin
163
      if Parameters.Runtime_Traces then
164
         case Id is
165
            when PO_Run =>
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);
173
 
174
            when others =>
175
               null;
176
               --  should raise an exception ???
177
         end case;
178
      end if;
179
   end Send_Trace_Info;
180
 
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);
185
 
186
      L0 : constant Integer := Task_S'Length;
187
 
188
   begin
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);
195
      end if;
196
   end Send_Trace_Info;
197
 
198
   procedure Send_Trace_Info
199
     (Id         : Trace_T;
200
      Task_Name  : Task_Id;
201
      Task_Name2 : Task_Id)
202
   is
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);
210
 
211
      L0 : constant Integer := Task2_S'Length;
212
 
213
   begin
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);
220
      end if;
221
   end Send_Trace_Info;
222
 
223
   procedure Send_Trace_Info
224
     (Id           : Trace_T;
225
      Acceptor     : Task_Id;
226
      Entry_Number : Entry_Index;
227
      Timeout      : Duration)
228
   is
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);
237
 
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;
242
 
243
   begin
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);
254
      end if;
255
   end Send_Trace_Info;
256
 
257
   procedure Send_Trace_Info
258
     (Id           : Trace_T;
259
      Entry_Number : Entry_Index;
260
      Timeout      : Duration)
261
   is
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);
267
 
268
      L0 : constant Integer := Task_S'Length;
269
      L1 : constant Integer := Task_S'Length + Entry_S'Length;
270
 
271
   begin
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);
280
      end if;
281
   end Send_Trace_Info;
282
 
283
   procedure Send_Trace_Info
284
     (Id        : Trace_T;
285
      Task_Name : Task_Id;
286
      Number    : Integer)
287
   is
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);
293
 
294
      L0 : constant Integer := Task_S'Length;
295
      L1 : constant Integer := Task_S'Length + Number_S'Length;
296
 
297
   begin
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);
306
      end if;
307
   end Send_Trace_Info;
308
 
309
   procedure Send_Trace_Info
310
     (Id        : Trace_T;
311
      Task_Name : Task_Id;
312
      Number    : Integer;
313
      Timeout   : Duration)
314
   is
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);
321
 
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;
326
 
327
   begin
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);
338
      end if;
339
   end Send_Trace_Info;
340
 
341
   ---------------------
342
   -- Extract_Accepts --
343
   ---------------------
344
 
345
   --  This function returns a string in which all opened
346
   --  Accepts or Selects are given, separated by semi-colons.
347
 
348
   function Extract_Accepts (Task_Name : Task_Id) return String_Trace is
349
      Info_Annex : String_Trace := (ASCII.NUL, others => ' ');
350
 
351
   begin
352
      for J in Task_Name.Open_Accepts'First ..
353
        Task_Name.Open_Accepts'Last - 1
354
      loop
355
         Info_Annex := Append (Info_Annex, Integer'Image
356
                               (Integer (Task_Name.Open_Accepts (J).S)) & ",");
357
      end loop;
358
 
359
      Info_Annex := Append (Info_Annex,
360
                            Integer'Image (Integer
361
                                           (Task_Name.Open_Accepts
362
                                            (Task_Name.Open_Accepts'Last).S)));
363
      return Info_Annex;
364
   end Extract_Accepts;
365
end System.Traces.Tasking;

powered by: WebSVN 2.1.0

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