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-- 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
32with System.Parameters;
33
34package 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
113end System.Traces.Format;
114