with Namet; use Namet;
with Osint; use Osint;
with Output; use Output;
with Table;
with Unchecked_Conversion;
with GNAT.HTable;
package body Fmap is
subtype Big_String is String (Positive);
type Big_String_Ptr is access all Big_String;
function To_Big_String_Ptr is new Unchecked_Conversion
(Source_Buffer_Ptr, Big_String_Ptr);
package File_Mapping is new Table.Table (
Table_Component_Type => File_Name_Type,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 1_000,
Table_Increment => 1_000,
Table_Name => "Fmap.File_Mapping");
package Path_Mapping is new Table.Table (
Table_Component_Type => File_Name_Type,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 1_000,
Table_Increment => 1_000,
Table_Name => "Fmap.Path_Mapping");
type Header_Num is range 0 .. 1_000;
function Hash (F : Unit_Name_Type) return Header_Num;
No_Entry : constant Int := -1;
package Unit_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => Header_Num,
Element => Int,
No_Element => No_Entry,
Key => Unit_Name_Type,
Hash => Hash,
Equal => "=");
package File_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => Header_Num,
Element => Int,
No_Element => No_Entry,
Key => File_Name_Type,
Hash => Hash,
Equal => "=");
procedure Add_To_File_Map
(Unit_Name : Unit_Name_Type;
File_Name : File_Name_Type;
Path_Name : File_Name_Type)
is
begin
File_Mapping.Increment_Last;
Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
File_Mapping.Table (File_Mapping.Last) := File_Name;
Path_Mapping.Increment_Last;
File_Hash_Table.Set (File_Name, Path_Mapping.Last);
Path_Mapping.Table (Path_Mapping.Last) := Path_Name;
end Add_To_File_Map;
function Hash (F : Unit_Name_Type) return Header_Num is
begin
return Header_Num (Int (F) rem Header_Num'Range_Length);
end Hash;
procedure Initialize (File_Name : String) is
Src : Source_Buffer_Ptr;
Hi : Source_Ptr;
BS : Big_String_Ptr;
SP : String_Ptr;
Deb : Positive := 1;
Fin : Natural := 0;
Uname : Unit_Name_Type;
Fname : Name_Id;
Pname : Name_Id;
procedure Empty_Tables;
procedure Get_Line;
procedure Report_Truncated;
procedure Empty_Tables is
begin
Unit_Hash_Table.Reset;
File_Hash_Table.Reset;
Path_Mapping.Set_Last (0);
File_Mapping.Set_Last (0);
end Empty_Tables;
procedure Get_Line is
use ASCII;
begin
Deb := Fin + 1;
while Deb < SP'Last
and then (SP (Deb) = CR
or else SP (Deb) = LF
or else SP (Deb) = EOF)
loop
Deb := Deb + 1;
end loop;
if Deb < SP'Last and then SP (Deb) /= EOF then
Fin := Deb;
while Fin < SP'Last
and then SP (Fin + 1) /= CR
and then SP (Fin + 1) /= LF
and then SP (Fin + 1) /= EOF
loop
Fin := Fin + 1;
end loop;
end if;
end Get_Line;
procedure Report_Truncated is
begin
Write_Str ("warning: mapping file """);
Write_Str (File_Name);
Write_Line (""" is truncated");
end Report_Truncated;
begin
Name_Len := File_Name'Length;
Name_Buffer (1 .. Name_Len) := File_Name;
Read_Source_File (Name_Enter, 0, Hi, Src, Config);
if Src = null then
Write_Str ("warning: could not read mapping file """);
Write_Str (File_Name);
Write_Line ("""");
else
BS := To_Big_String_Ptr (Src);
SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
loop
Get_Line;
exit when Deb > Fin;
pragma Assert (Fin >= Deb + 2);
pragma Assert (SP (Fin - 1) = '%');
pragma Assert (SP (Fin) = 's' or else SP (Fin) = 'b');
Name_Len := Fin - Deb + 1;
Name_Buffer (1 .. Name_Len) := SP (Deb .. Fin);
Uname := Name_Find;
Get_Line;
if Deb > Fin then
Report_Truncated;
Empty_Tables;
return;
end if;
Name_Len := Fin - Deb + 1;
Name_Buffer (1 .. Name_Len) := SP (Deb .. Fin);
Fname := Name_Find;
Get_Line;
if Deb > Fin then
Report_Truncated;
Empty_Tables;
return;
end if;
Name_Len := Fin - Deb + 1;
Name_Buffer (1 .. Name_Len) := SP (Deb .. Fin);
Pname := Name_Find;
if Unit_Hash_Table.Get (Uname) /= No_Entry then
Write_Str ("warning: duplicate entry """);
Write_Str (Get_Name_String (Uname));
Write_Str (""" in mapping file """);
Write_Str (File_Name);
Write_Line ("""");
Empty_Tables;
return;
end if;
if File_Hash_Table.Get (Fname) /= No_Entry then
Write_Str ("warning: duplicate entry """);
Write_Str (Get_Name_String (Fname));
Write_Str (""" in mapping file """);
Write_Str (File_Name);
Write_Line ("""");
Empty_Tables;
return;
end if;
Add_To_File_Map (Uname, Fname, Pname);
end loop;
end if;
end Initialize;
function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
The_Index : constant Int := Unit_Hash_Table.Get (Unit);
begin
if The_Index = No_Entry then
return No_File;
else
return File_Mapping.Table (The_Index);
end if;
end Mapped_File_Name;
function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
Index : Int := No_Entry;
begin
Index := File_Hash_Table.Get (File);
if Index = No_Entry then
return No_File;
else
return Path_Mapping.Table (Index);
end if;
end Mapped_Path_Name;
end Fmap;