+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- L I B . U T I L --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.1 $
--- --
--- Copyright (C) 1992-2001 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- --
--- 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. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Hostparm;
-with Namet; use Namet;
-with Osint; use Osint;
-
-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.
-
- ---------------------
- -- 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
-
- 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
- Write_Info_Char (Character'Val (Code));
-
- elsif Code in 16#80# .. 16#FF# then
- Write_Info_Char ('U');
- Write_Info_Hex_Byte (Natural (Code));
-
- 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_Initiate --
- -------------------------
-
- procedure Write_Info_Initiate (Key : Character) renames Write_Info_Char;
-
- ---------------------
- -- 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;
-
- --------------------
- -- 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_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;
-
-end Lib.Util;
projects / msp430-gcc.git / blobdiff