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);
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;
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;
procedure Get_Line
(File : Text_File;
Line : out String;
Last : out Natural)
is
C : Character;
procedure 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;
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;
function Is_Valid (File : Text_File) return Boolean is
begin
return File /= null;
end Is_Valid;
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;
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
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 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;
procedure Write_Str
(S : String;
Max_Length : Positive;
Separator : Character)
is
First : Positive := S'First;
Last : Natural := S'Last;
begin
if S'Length > 0 then
if Positive (Column) >= Max_Length then
Write_Eol;
end if;
while Positive (Column) + S'Last - First > Max_Length loop
Last := First + Max_Length - Positive (Column);
while Last >= First and then S (Last) /= Separator loop
Last := Last - 1;
end loop;
if Last < First then
Last := First + Max_Length - Positive (Column);
end if;
Write_Line (S (First .. Last));
First := Last + 1;
end loop;
Write_Str (S (First .. S'Last));
end if;
end Write_Str;
end Prj.Util;