File : s-trafor-default.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . T R A C E S . F O R M A T --
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 -- --
19 -- --
20 -- --
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.Parameters;
33
34 package body System.Traces.Format is
35
36 procedure Send_Trace (Id : Trace_T; Info : String) is separate;
37
38 ------------------
39 -- Format_Trace --
40 ------------------
41
42 function Format_Trace (Source : String) return String_Trace is
43 Length : constant Integer := Source'Length;
44 Result : String_Trace := (others => ' ');
45
46 begin
47 -- If run-time tracing active, then fill the string
48
49 if Parameters.Runtime_Traces then
50 if Max_Size - Length > 0 then
51 Result (1 .. Length) := Source (1 .. Length);
52 Result (Length + 1 .. Max_Size) := (others => ' ');
53 Result (Length + 1) := ASCII.NUL;
54 else
55 Result (1 .. Max_Size - 1) :=
56 Source (Source'First .. Source'First - 1 + Max_Size - 1);
57 Result (Max_Size) := ASCII.NUL;
58 end if;
59 end if;
60
61 return Result;
62 end Format_Trace;
63
64 ------------
65 -- Append --
66 ------------
67
68 function Append
69 (Source : String_Trace;
70 Annex : String) return String_Trace
71 is
72 Result : String_Trace := (others => ' ');
73 Annex_Length : constant Integer := Annex'Length;
74 Source_Length : Integer;
75
76 begin
77 if Parameters.Runtime_Traces then
78
79 -- First we determine the size used, without the spaces at the end,
80 -- if a String_Trace is present. Look at System.Traces.Tasking for
81 -- examples.
82
83 Source_Length := 1;
84 while Source (Source_Length) /= ASCII.NUL loop
85 Source_Length := Source_Length + 1;
86 end loop;
87
88 -- Then we fill the string
89
90 if Source_Length - 1 + Annex_Length <= Max_Size then
91 Result (1 .. Source_Length - 1) :=
92 Source (1 .. Source_Length - 1);
93
94 Result (Source_Length .. Source_Length - 1 + Annex_Length) :=
95 Annex (1 .. Annex_Length);
96
97 Result (Source_Length + Annex_Length) := ASCII.NUL;
98
99 Result (Source_Length + Annex_Length + 1 .. Max_Size) :=
100 (others => ' ');
101
102 else
103 Result (1 .. Source_Length - 1) := Source (1 .. Source_Length - 1);
104 Result (Source_Length .. Max_Size - 1) :=
105 Annex (1 .. Max_Size - Source_Length);
106 Result (Max_Size) := ASCII.NUL;
107 end if;
108 end if;
109
110 return Result;
111 end Append;
112
113 end System.Traces.Format;