-- --
-- B o d y --
-- --
--- $Revision: 1.7 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Hostparm;
-with Namet; use Namet;
-with Osint; use Osint;
+with Osint.C; use Osint.C;
+with Stringt; use Stringt;
package body Lib.Util is
Info_Buffer_Col : Natural := 1;
-- Column number of next character to be written.
- -- Can be different from Info_Buffer_Len + 1
- -- because of tab characters written by Write_Info_Tab.
+ -- Can be different from Info_Buffer_Len + 1 because of tab characters
+ -- written by Write_Info_Tab.
+
+ procedure Write_Info_Hex_Byte (J : Natural);
+ -- Place two hex digits representing the value J (which is in the range
+ -- 0-255) in Info_Buffer, incrementing Info_Buffer_Len by 2. The digits
+ -- are output using lower case letters.
---------------------
-- Write_Info_Char --
--------------------------
procedure Write_Info_Char_Code (Code : Char_Code) is
-
- procedure Write_Info_Hex_Byte (J : Natural);
- -- Write single hex digit
-
- procedure Write_Info_Hex_Byte (J : Natural) is
- Hexd : String := "0123456789abcdef";
-
- begin
- Write_Info_Char (Hexd (J / 16 + 1));
- Write_Info_Char (Hexd (J mod 16 + 1));
- end Write_Info_Hex_Byte;
-
- -- Start of processing for Write_Info_Char_Code
-
begin
- if Code in 16#00# .. 16#7F# then
+ -- 00 .. 7F
+
+ if Code <= 16#7F# then
Write_Info_Char (Character'Val (Code));
- elsif Code in 16#80# .. 16#FF# then
+ -- 80 .. FF
+
+ elsif Code <= 16#FF# then
Write_Info_Char ('U');
Write_Info_Hex_Byte (Natural (Code));
+ -- 0100 .. FFFF
+
else
Write_Info_Char ('W');
Write_Info_Hex_Byte (Natural (Code / 256));
end Write_Info_EOL;
-------------------------
+ -- Write_Info_Hex_Byte --
+ -------------------------
+
+ procedure Write_Info_Hex_Byte (J : Natural) is
+ Hexd : constant array (0 .. 15) of Character := "0123456789abcdef";
+ begin
+ Write_Info_Char (Hexd (J / 16));
+ Write_Info_Char (Hexd (J mod 16));
+ end Write_Info_Hex_Byte;
+
+ -------------------------
-- Write_Info_Initiate --
-------------------------
procedure Write_Info_Initiate (Key : Character) renames Write_Info_Char;
+ --------------------
+ -- Write_Info_Int --
+ --------------------
+
+ procedure Write_Info_Int (N : Int) is
+ begin
+ if N >= 0 then
+ Write_Info_Nat (N);
+
+ -- Negative numbers, use Write_Info_Uint to avoid problems with largest
+ -- negative number.
+
+ else
+ Write_Info_Uint (UI_From_Int (N));
+ end if;
+ end Write_Info_Int;
+
---------------------
-- Write_Info_Name --
---------------------
Info_Buffer_Col := Info_Buffer_Col + Name_Len;
end Write_Info_Name;
+ procedure Write_Info_Name (Name : File_Name_Type) is
+ begin
+ Write_Info_Name (Name_Id (Name));
+ end Write_Info_Name;
+
+ procedure Write_Info_Name (Name : Unit_Name_Type) is
+ begin
+ Write_Info_Name (Name_Id (Name));
+ end Write_Info_Name;
+
--------------------
-- Write_Info_Nat --
--------------------
Write_Info_Char (Character'Val (N mod 10 + Character'Pos ('0')));
end Write_Info_Nat;
+ ---------------------
+ -- Write_Info_Slit --
+ ---------------------
+
+ procedure Write_Info_Slit (S : String_Id) is
+ C : Character;
+
+ begin
+ Write_Info_Str ("""");
+
+ for J in 1 .. String_Length (S) loop
+ C := Get_Character (Get_String_Char (S, J));
+
+ if C in Character'Val (16#20#) .. Character'Val (16#7E#)
+ and then C /= '{'
+ then
+ Write_Info_Char (C);
+
+ if C = '"' then
+ Write_Info_Char (C);
+ end if;
+
+ else
+ Write_Info_Char ('{');
+ Write_Info_Hex_Byte (Character'Pos (C));
+ Write_Info_Char ('}');
+ end if;
+ end loop;
+
+ Write_Info_Char ('"');
+ end Write_Info_Slit;
+
--------------------
-- Write_Info_Str --
--------------------
Info_Buffer_Len := 0;
Info_Buffer_Col := 1;
-
end Write_Info_Terminate;
+ ---------------------
+ -- Write_Info_Uint --
+ ---------------------
+
+ procedure Write_Info_Uint (N : Uint) is
+ begin
+ UI_Image (N, Decimal);
+ Write_Info_Str (UI_Image_Buffer (1 .. UI_Image_Length));
+ end Write_Info_Uint;
+
end Lib.Util;
OSDN Git Service
