X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Flib-util.adb;h=9047690d6637a05b770d95c241e974941418134e;hb=80de24b889871941334b6aeae5cdc103907fe92c;hp=d67b8d0bf7def8e47c07fa6454568a7eac70692b;hpb=c2052d920b49395f766c1a47448d02f8896296e2;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/lib-util.adb b/gcc/ada/lib-util.adb index d67b8d0bf7d..9047690d663 100644 --- a/gcc/ada/lib-util.adb +++ b/gcc/ada/lib-util.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, 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, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, 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. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -26,6 +25,7 @@ with Hostparm; with Osint.C; use Osint.C; +with Stringt; use Stringt; package body Lib.Util is @@ -40,8 +40,13 @@ 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 -- @@ -59,28 +64,20 @@ package body Lib.Util is -------------------------- 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 : constant 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)); @@ -123,11 +120,39 @@ package body Lib.Util is 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 -- --------------------- @@ -164,6 +189,38 @@ package body Lib.Util is 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 -- -------------------- @@ -220,7 +277,16 @@ package body Lib.Util is 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;