------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- L I B . U T I L -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2013, 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_Name_May_Be_Quoted -- ----------------------------------- procedure Write_Info_Name_May_Be_Quoted (Name : File_Name_Type) is Quoted : Boolean := False; Cur : Positive; begin Get_Name_String (Name); -- The file/path name is quoted only if it includes spaces for J in 1 .. Name_Len loop if Name_Buffer (J) = ' ' then Quoted := True; exit; end if; end loop; -- Deal with quoting string if needed if Quoted then Insert_Str_In_Name_Buffer ("""", 1); Add_Char_To_Name_Buffer ('"'); -- Any character '"' is doubled Cur := 2; while Cur < Name_Len loop if Name_Buffer (Cur) = '"' then Insert_Str_In_Name_Buffer ("""", Cur); Cur := Cur + 2; else Cur := Cur + 1; end if; end loop; end if; 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_May_Be_Quoted; -------------------- -- 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;