diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/lib-util.adb')
| -rw-r--r-- | gcc-4.7/gcc/ada/lib-util.adb | 292 |
1 files changed, 0 insertions, 292 deletions
diff --git a/gcc-4.7/gcc/ada/lib-util.adb b/gcc-4.7/gcc/ada/lib-util.adb deleted file mode 100644 index 9047690d6..000000000 --- a/gcc-4.7/gcc/ada/lib-util.adb +++ /dev/null @@ -1,292 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- L I B . U T I L -- --- -- --- B o d y -- --- -- --- 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 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 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. -- --- -- ------------------------------------------------------------------------------- - -with Hostparm; -with Osint.C; use Osint.C; -with Stringt; use Stringt; - -package body Lib.Util is - - Max_Line : constant Natural := 2 * Hostparm.Max_Name_Length + 64; - Max_Buffer : constant Natural := 1000 * Max_Line; - - Info_Buffer : String (1 .. Max_Buffer); - -- Info_Buffer used to prepare lines of library output - - Info_Buffer_Len : Natural := 0; - -- Number of characters stored in Info_Buffer - - 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. - - 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 (C : Character) is - begin - Info_Buffer_Len := Info_Buffer_Len + 1; - Info_Buffer (Info_Buffer_Len) := C; - Info_Buffer_Col := Info_Buffer_Col + 1; - end Write_Info_Char; - - -------------------------- - -- Write_Info_Char_Code -- - -------------------------- - - procedure Write_Info_Char_Code (Code : Char_Code) is - begin - -- 00 .. 7F - - if Code <= 16#7F# then - Write_Info_Char (Character'Val (Code)); - - -- 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)); - Write_Info_Hex_Byte (Natural (Code mod 256)); - end if; - end Write_Info_Char_Code; - - -------------------- - -- Write_Info_Col -- - -------------------- - - function Write_Info_Col return Positive is - begin - return Info_Buffer_Col; - end Write_Info_Col; - - -------------------- - -- Write_Info_EOL -- - -------------------- - - procedure Write_Info_EOL is - begin - if Hostparm.OpenVMS - or else Info_Buffer_Len + Max_Line + 1 > Max_Buffer - then - Write_Info_Terminate; - else - -- Delete any trailing blanks - - while Info_Buffer_Len > 0 - and then Info_Buffer (Info_Buffer_Len) = ' ' - loop - Info_Buffer_Len := Info_Buffer_Len - 1; - end loop; - - Info_Buffer_Len := Info_Buffer_Len + 1; - Info_Buffer (Info_Buffer_Len) := ASCII.LF; - Info_Buffer_Col := 1; - end if; - 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 -- - --------------------- - - procedure Write_Info_Name (Name : Name_Id) is - begin - Get_Name_String (Name); - Info_Buffer (Info_Buffer_Len + 1 .. Info_Buffer_Len + Name_Len) := - Name_Buffer (1 .. Name_Len); - Info_Buffer_Len := Info_Buffer_Len + Name_Len; - 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 -- - -------------------- - - procedure Write_Info_Nat (N : Nat) is - begin - if N > 9 then - Write_Info_Nat (N / 10); - end if; - - 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 -- - -------------------- - - procedure Write_Info_Str (Val : String) is - begin - Info_Buffer (Info_Buffer_Len + 1 .. Info_Buffer_Len + Val'Length) - := Val; - Info_Buffer_Len := Info_Buffer_Len + Val'Length; - Info_Buffer_Col := Info_Buffer_Col + Val'Length; - end Write_Info_Str; - - -------------------- - -- Write_Info_Tab -- - -------------------- - - procedure Write_Info_Tab (Col : Positive) is - Next_Tab : Positive; - - begin - if Col <= Info_Buffer_Col then - Write_Info_Str (" "); - else - loop - Next_Tab := 8 * ((Info_Buffer_Col - 1) / 8) + 8 + 1; - exit when Col < Next_Tab; - Write_Info_Char (ASCII.HT); - Info_Buffer_Col := Next_Tab; - end loop; - - while Info_Buffer_Col < Col loop - Write_Info_Char (' '); - end loop; - end if; - end Write_Info_Tab; - - -------------------------- - -- Write_Info_Terminate -- - -------------------------- - - procedure Write_Info_Terminate is - begin - -- Delete any trailing blanks - - while Info_Buffer_Len > 0 - and then Info_Buffer (Info_Buffer_Len) = ' ' - loop - Info_Buffer_Len := Info_Buffer_Len - 1; - end loop; - - -- Write_Library_Info adds the EOL - - Write_Library_Info (Info_Buffer (1 .. Info_Buffer_Len)); - - 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; |