MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
3b56934fb9
8sa1-gcc/gcc/ada/fmap.adb
Geert Bosch 17c5c8a5ee bindgen.adb: Minor reformatting 
* bindgen.adb: Minor reformatting

	* cstand.adb: Minor reformatting

	* fmap.adb: Minor reformatting
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fmap.ads:
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fname-uf.adb: Minor reformatting.  New names of stuff in Fmap.
	Add use clause for Fmap.

	* make.adb: Minor reformatting

	* osint.adb: Minor reformatting.  Change of names in Fmap.
	Add use clause for Fmap.

	* prj-env.adb: Minor reformatting

	* prj-env.ads: Minor reformatting

	* switch.adb: Minor reformatting.  Do proper raise of Bad_Switch if
	error found (there were odd exceptions to this general rule in
	-gnatec/-gnatem processing)

	* raise.c (__gnat_eh_personality): Exception handling personality
	routine for Ada.  Still in rough state, inspired from the C++ version
	and still containing a bunch of debugging artifacts.
	(parse_lsda_header, get_ttype_entry): Local (static) helpers, also
	inspired from the C++ library.

	* raise.c (eh_personality): Add comments. Part of work for the GCC 3
	exception handling integration.

	* Makefile.in: Remove use of 5smastop.adb which is obsolete.
	(HIE_SOURCES): Add s-secsta.ad{s,b}.
	(HIE_OBJS): Add s-fat*.o
	(RAVEN_SOURCES): Remove files that are no longer required. Add
	interrupt handling files.
	(RAVEN_MOD): Removed, no longer needed.

	* a-ngelfu.adb: Remove ??? comment for inappropriate Inline_Always
	Add 2001 to copyright date

	* g-regpat.adb: Change pragma Inline_Always to Inline. There is no
	need to force universal inlining for these cases.

	* s-taprob.adb: Minor clean ups so that this unit can be used in
	Ravenscar HI.

	* exp_ch7.adb: Allow use of secondary stack in HI mode.
	Disallow it when pragma Restrictions (No_Secondary_Stack) is specified.

	* prj-tree.ads (Project_Node_Record): Add comments for components
	Pkg_Id and Case_Insensitive.

	* g-socket.adb: Minor reformatting. Found while reading code.

	* prj-tree.ads: Minor reformatting

From-SVN: r48195
2001-12-20 07:22:43 +01:00

332 lines
10 KiB
Ada
Raw Blame History

------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- F M A P --
-- --
-- B o d y --
-- --
-- $Revision: 1.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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
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");
-- Mapping table to map unit names to file names.
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");
-- Mapping table to map file names to path names
type Header_Num is range 0 .. 1_000;
function Hash (F : Unit_Name_Type) return Header_Num;
-- Function used to compute hash of unit name
No_Entry : constant Int := -1;
-- Signals no entry in following table
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 => "=");
-- Hash table to map unit names to file names. Used in conjunction with
-- table File_Mapping above.
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 => "=");
-- Hash table to map file names to path names. Used in conjunction with
-- table Path_Mapping above.
---------------------
-- Add_To_File_Map --
---------------------
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;
----------
-- Hash --
----------
function Hash (F : Unit_Name_Type) return Header_Num is
begin
return Header_Num (Int (F) rem Header_Num'Range_Length);
end Hash;
----------------
-- Initialize --
----------------
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;
-- Remove all entries in case of incorrect mapping file
procedure Get_Line;
-- Get a line from the mapping file
procedure Report_Truncated;
-- Report a warning when the mapping file is truncated
-- (number of lines is not a multiple of 3).
------------------
-- Empty_Tables --
------------------
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;
--------------
-- Get_Line --
--------------
procedure Get_Line is
use ASCII;
begin
Deb := Fin + 1;
-- If not at the end of file, skip the end of line
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 not at the end of line, find the end of this new line
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;
----------------------
-- Report_Truncated --
----------------------
procedure Report_Truncated is
begin
Write_Str ("warning: mapping file """);
Write_Str (File_Name);
Write_Line (""" is truncated");
end Report_Truncated;
-- Start of procedure Initialize
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 the unit name
Get_Line;
-- Exit if end of file has been reached
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 the file name
Get_Line;
-- If end of line has been reached, file is truncated
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 the path name
Get_Line;
-- If end of line has been reached, file is truncated
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;
-- Check for duplicate entries
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 the mappings for this unit name
Add_To_File_Map (Uname, Fname, Pname);
end loop;
end if;
end Initialize;
----------------------
-- Mapped_File_Name --
----------------------
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;
----------------------
-- Mapped_Path_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;
Reference in New Issue View Git Blame Copy Permalink