+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- P R J . U T I L --
--- --
--- B o d y --
--- --
--- $Revision: 1.5.12.1 $
--- --
--- Copyright (C) 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 Ada.Unchecked_Deallocation;
-
-with Namet; use Namet;
-with Osint;
-with Output; use Output;
-with Stringt; use Stringt;
-
-package body Prj.Util is
-
- procedure Free is new Ada.Unchecked_Deallocation
- (Text_File_Data, Text_File);
-
- -----------
- -- Close --
- -----------
-
- procedure Close (File : in out Text_File) is
- begin
- if File = null then
- Osint.Fail ("Close attempted on an invalid Text_File");
- end if;
-
- Close (File.FD);
- Free (File);
- end Close;
-
- -----------------
- -- End_Of_File --
- -----------------
-
- function End_Of_File (File : Text_File) return Boolean is
- begin
- if File = null then
- Osint.Fail ("End_Of_File attempted on an invalid Text_File");
- end if;
-
- return File.End_Of_File_Reached;
- end End_Of_File;
-
- --------------
- -- Get_Line --
- --------------
-
- procedure Get_Line
- (File : Text_File;
- Line : out String;
- Last : out Natural)
- is
- C : Character;
-
- procedure Advance;
-
- -------------
- -- Advance --
- -------------
-
- procedure Advance is
- begin
- if File.Cursor = File.Buffer_Len then
- File.Buffer_Len :=
- Read
- (FD => File.FD,
- A => File.Buffer'Address,
- N => File.Buffer'Length);
-
- if File.Buffer_Len = 0 then
- File.End_Of_File_Reached := True;
- return;
- else
- File.Cursor := 1;
- end if;
-
- else
- File.Cursor := File.Cursor + 1;
- end if;
- end Advance;
-
- -- Start of processing for Get_Line
-
- begin
- if File = null then
- Osint.Fail ("Get_Line attempted on an invalid Text_File");
- end if;
-
- Last := Line'First - 1;
-
- if not File.End_Of_File_Reached then
- loop
- C := File.Buffer (File.Cursor);
- exit when C = ASCII.CR or else C = ASCII.LF;
- Last := Last + 1;
- Line (Last) := C;
- Advance;
-
- if File.End_Of_File_Reached then
- return;
- end if;
-
- exit when Last = Line'Last;
- end loop;
-
- if C = ASCII.CR or else C = ASCII.LF then
- Advance;
-
- if File.End_Of_File_Reached then
- return;
- end if;
- end if;
-
- if C = ASCII.CR
- and then File.Buffer (File.Cursor) = ASCII.LF
- then
- Advance;
- end if;
- end if;
- end Get_Line;
-
- --------------
- -- Is_Valid --
- --------------
-
- function Is_Valid (File : Text_File) return Boolean is
- begin
- return File /= null;
- end Is_Valid;
-
- ----------
- -- Open --
- ----------
-
- procedure Open (File : out Text_File; Name : in String) is
- FD : File_Descriptor;
- File_Name : String (1 .. Name'Length + 1);
-
- begin
- File_Name (1 .. Name'Length) := Name;
- File_Name (File_Name'Last) := ASCII.NUL;
- FD := Open_Read (Name => File_Name'Address,
- Fmode => GNAT.OS_Lib.Text);
- if FD = Invalid_FD then
- File := null;
- else
- File := new Text_File_Data;
- File.FD := FD;
- File.Buffer_Len :=
- Read (FD => FD,
- A => File.Buffer'Address,
- N => File.Buffer'Length);
-
- if File.Buffer_Len = 0 then
- File.End_Of_File_Reached := True;
- else
- File.Cursor := 1;
- end if;
- end if;
- end Open;
-
- --------------
- -- Value_Of --
- --------------
-
- function Value_Of
- (Variable : Variable_Value;
- Default : String)
- return String
- is
- begin
- if Variable.Kind /= Single
- or else Variable.Default
- or else Variable.Value = No_String then
- return Default;
-
- else
- String_To_Name_Buffer (Variable.Value);
- return Name_Buffer (1 .. Name_Len);
- end if;
- end Value_Of;
-
- function Value_Of
- (Index : Name_Id;
- In_Array : Array_Element_Id)
- return Name_Id
- is
- Current : Array_Element_Id := In_Array;
- Element : Array_Element;
-
- begin
- while Current /= No_Array_Element loop
- Element := Array_Elements.Table (Current);
-
- if Index = Element.Index then
- exit when Element.Value.Kind /= Single;
- exit when String_Length (Element.Value.Value) = 0;
- String_To_Name_Buffer (Element.Value.Value);
- return Name_Find;
- else
- Current := Element.Next;
- end if;
- end loop;
-
- return No_Name;
- end Value_Of;
-
- function Value_Of
- (Index : Name_Id;
- In_Array : Array_Element_Id)
- return Variable_Value
- is
- Current : Array_Element_Id := In_Array;
- Element : Array_Element;
-
- begin
- while Current /= No_Array_Element loop
- Element := Array_Elements.Table (Current);
-
- if Index = Element.Index then
- return Element.Value;
- else
- Current := Element.Next;
- end if;
- end loop;
-
- return Nil_Variable_Value;
- end Value_Of;
-
- function Value_Of
- (Name : Name_Id;
- Attribute_Or_Array_Name : Name_Id;
- In_Package : Package_Id)
- return Variable_Value
- is
- The_Array : Array_Element_Id;
- The_Attribute : Variable_Value := Nil_Variable_Value;
-
- begin
- if In_Package /= No_Package then
-
- -- First, look if there is an array element that fits
-
- The_Array :=
- Value_Of
- (Name => Attribute_Or_Array_Name,
- In_Arrays => Packages.Table (In_Package).Decl.Arrays);
- The_Attribute :=
- Value_Of
- (Index => Name,
- In_Array => The_Array);
-
- -- If there is no array element, look for a variable
-
- if The_Attribute = Nil_Variable_Value then
- The_Attribute :=
- Value_Of
- (Variable_Name => Attribute_Or_Array_Name,
- In_Variables => Packages.Table (In_Package).Decl.Attributes);
- end if;
- end if;
-
- return The_Attribute;
- end Value_Of;
-
- function Value_Of
- (Index : Name_Id;
- In_Array : Name_Id;
- In_Arrays : Array_Id)
- return Name_Id
- is
- Current : Array_Id := In_Arrays;
- The_Array : Array_Data;
-
- begin
- while Current /= No_Array loop
- The_Array := Arrays.Table (Current);
- if The_Array.Name = In_Array then
- return Value_Of (Index, In_Array => The_Array.Value);
- else
- Current := The_Array.Next;
- end if;
- end loop;
-
- return No_Name;
- end Value_Of;
-
- function Value_Of
- (Name : Name_Id;
- In_Arrays : Array_Id)
- return Array_Element_Id
- is
- Current : Array_Id := In_Arrays;
- The_Array : Array_Data;
-
- begin
- while Current /= No_Array loop
- The_Array := Arrays.Table (Current);
-
- if The_Array.Name = Name then
- return The_Array.Value;
- else
- Current := The_Array.Next;
- end if;
- end loop;
-
- return No_Array_Element;
- end Value_Of;
-
- function Value_Of
- (Name : Name_Id;
- In_Packages : Package_Id)
- return Package_Id
- is
- Current : Package_Id := In_Packages;
- The_Package : Package_Element;
-
- begin
- while Current /= No_Package loop
- The_Package := Packages.Table (Current);
- exit when The_Package.Name /= No_Name
- and then The_Package.Name = Name;
- Current := The_Package.Next;
- end loop;
-
- return Current;
- end Value_Of;
-
- function Value_Of
- (Variable_Name : Name_Id;
- In_Variables : Variable_Id)
- return Variable_Value
- is
- Current : Variable_Id := In_Variables;
- The_Variable : Variable;
-
- begin
- while Current /= No_Variable loop
- The_Variable := Variable_Elements.Table (Current);
-
- if Variable_Name = The_Variable.Name then
- return The_Variable.Value;
- else
- Current := The_Variable.Next;
- end if;
- end loop;
-
- return Nil_Variable_Value;
- end Value_Of;
-
- ---------------
- -- Write_Str --
- ---------------
-
- procedure Write_Str
- (S : String;
- Max_Length : Positive;
- Separator : Character)
- is
- First : Positive := S'First;
- Last : Natural := S'Last;
-
- begin
- -- Nothing to do for empty strings
-
- if S'Length > 0 then
-
- -- Start on a new line if current line is already longer than
- -- Max_Length.
-
- if Positive (Column) >= Max_Length then
- Write_Eol;
- end if;
-
- -- If length of remainder is longer than Max_Length, we need to
- -- cut the remainder in several lines.
-
- while Positive (Column) + S'Last - First > Max_Length loop
-
- -- Try the maximum length possible
-
- Last := First + Max_Length - Positive (Column);
-
- -- Look for last Separator in the line
-
- while Last >= First and then S (Last) /= Separator loop
- Last := Last - 1;
- end loop;
-
- -- If we do not find a separator, we output the maximum length
- -- possible.
-
- if Last < First then
- Last := First + Max_Length - Positive (Column);
- end if;
-
- Write_Line (S (First .. Last));
-
- -- Set the beginning of the new remainder
-
- First := Last + 1;
- end loop;
-
- -- What is left goes to the buffer, without EOL
-
- Write_Str (S (First .. S'Last));
- end if;
- end Write_Str;
-
-end Prj.Util;
projects / msp430-gcc.git / blobdiff