1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
30 with Namet
; use Namet
;
31 with Osint
; use Osint
;
33 package body Lib
.Util
is
35 Max_Line
: constant Natural := 2 * Hostparm
.Max_Name_Length
+ 64;
36 Max_Buffer
: constant Natural := 1000 * Max_Line
;
38 Info_Buffer
: String (1 .. Max_Buffer
);
39 -- Info_Buffer used to prepare lines of library output
41 Info_Buffer_Len
: Natural := 0;
42 -- Number of characters stored in Info_Buffer
44 Info_Buffer_Col
: Natural := 1;
45 -- Column number of next character to be written.
46 -- Can be different from Info_Buffer_Len + 1
47 -- because of tab characters written by Write_Info_Tab.
53 procedure Write_Info_Char
(C
: Character) is
55 Info_Buffer_Len
:= Info_Buffer_Len
+ 1;
56 Info_Buffer
(Info_Buffer_Len
) := C
;
57 Info_Buffer_Col
:= Info_Buffer_Col
+ 1;
60 --------------------------
61 -- Write_Info_Char_Code --
62 --------------------------
64 procedure Write_Info_Char_Code
(Code
: Char_Code
) is
66 procedure Write_Info_Hex_Byte
(J
: Natural);
67 -- Write single hex digit
69 procedure Write_Info_Hex_Byte
(J
: Natural) is
70 Hexd
: String := "0123456789abcdef";
73 Write_Info_Char
(Hexd
(J
/ 16 + 1));
74 Write_Info_Char
(Hexd
(J
mod 16 + 1));
75 end Write_Info_Hex_Byte
;
77 -- Start of processing for Write_Info_Char_Code
80 if Code
in 16#
00#
.. 16#
7F#
then
81 Write_Info_Char
(Character'Val (Code
));
83 elsif Code
in 16#
80#
.. 16#FF#
then
84 Write_Info_Char
('U');
85 Write_Info_Hex_Byte
(Natural (Code
));
88 Write_Info_Char
('W');
89 Write_Info_Hex_Byte
(Natural (Code
/ 256));
90 Write_Info_Hex_Byte
(Natural (Code
mod 256));
92 end Write_Info_Char_Code
;
98 function Write_Info_Col
return Positive is
100 return Info_Buffer_Col
;
107 procedure Write_Info_EOL
is
110 or else Info_Buffer_Len
+ Max_Line
+ 1 > Max_Buffer
112 Write_Info_Terminate
;
114 -- Delete any trailing blanks
116 while Info_Buffer_Len
> 0
117 and then Info_Buffer
(Info_Buffer_Len
) = ' '
119 Info_Buffer_Len
:= Info_Buffer_Len
- 1;
122 Info_Buffer_Len
:= Info_Buffer_Len
+ 1;
123 Info_Buffer
(Info_Buffer_Len
) := ASCII
.LF
;
124 Info_Buffer_Col
:= 1;
128 -------------------------
129 -- Write_Info_Initiate --
130 -------------------------
132 procedure Write_Info_Initiate
(Key
: Character) renames Write_Info_Char
;
134 ---------------------
135 -- Write_Info_Name --
136 ---------------------
138 procedure Write_Info_Name
(Name
: Name_Id
) is
140 Get_Name_String
(Name
);
141 Info_Buffer
(Info_Buffer_Len
+ 1 .. Info_Buffer_Len
+ Name_Len
) :=
142 Name_Buffer
(1 .. Name_Len
);
143 Info_Buffer_Len
:= Info_Buffer_Len
+ Name_Len
;
144 Info_Buffer_Col
:= Info_Buffer_Col
+ Name_Len
;
151 procedure Write_Info_Nat
(N
: Nat
) is
154 Write_Info_Nat
(N
/ 10);
157 Write_Info_Char
(Character'Val (N
mod 10 + Character'Pos ('0')));
164 procedure Write_Info_Str
(Val
: String) is
166 Info_Buffer
(Info_Buffer_Len
+ 1 .. Info_Buffer_Len
+ Val
'Length)
168 Info_Buffer_Len
:= Info_Buffer_Len
+ Val
'Length;
169 Info_Buffer_Col
:= Info_Buffer_Col
+ Val
'Length;
176 procedure Write_Info_Tab
(Col
: Positive) is
180 if Col
<= Info_Buffer_Col
then
181 Write_Info_Str
(" ");
184 Next_Tab
:= 8 * ((Info_Buffer_Col
- 1) / 8) + 8 + 1;
185 exit when Col
< Next_Tab
;
186 Write_Info_Char
(ASCII
.HT
);
187 Info_Buffer_Col
:= Next_Tab
;
190 while Info_Buffer_Col
< Col
loop
191 Write_Info_Char
(' ');
196 --------------------------
197 -- Write_Info_Terminate --
198 --------------------------
200 procedure Write_Info_Terminate
is
202 -- Delete any trailing blanks
204 while Info_Buffer_Len
> 0
205 and then Info_Buffer
(Info_Buffer_Len
) = ' '
207 Info_Buffer_Len
:= Info_Buffer_Len
- 1;
210 -- Write_Library_Info adds the EOL
212 Write_Library_Info
(Info_Buffer
(1 .. Info_Buffer_Len
));
214 Info_Buffer_Len
:= 0;
215 Info_Buffer_Col
:= 1;
217 end Write_Info_Terminate
;