2007-04-20 Vincent Celier <celier@adacore.com>

	    Robert Dewar  <dewar@adacore.com>

	* bcheck.adb, binde.adb, binderr.adb, binderr.ads, butil.adb, 
	butil.ads, erroutc.adb, erroutc.ads, errutil.adb, errutil.ads, 
	err_vars.ads, exp_tss.adb, exp_tss.ads, fmap.adb, fmap.ads, 
	fname.adb, fname.ads, fname-sf.adb, fname-uf.adb, fname-uf.ads, 
	lib-sort.adb, lib-util.adb, lib-util.ads, lib-xref.adb, makeutl.ads, 
	makeutl.adb, nmake.adt, osint.adb, osint.ads, osint-b.adb, 
	par-load.adb, prj-attr.adb, prj-dect.adb, prj-err.adb, prj-makr.adb, 
	prj-part.adb, prj-pp.adb, prj-proc.adb, prj-tree.adb, prj-tree.ads, 
	prj-util.adb, prj-util.ads, scans.adb, scans.ads, sem_ch2.adb, 
	sinput-c.adb, styleg-c.adb, tempdir.adb, tempdir.ads, uname.adb, 
	uname.ads, atree.h, atree.ads, atree.adb, ali-util.ads, ali-util.adb,
	ali.ads, ali.adb: 
	Move Name_Id, File_Name_Type and Unit_Name_Type from package Types to
	package Namet. Make File_Name_Type and Unit_Name_Type types derived from
	Mame_Id. Add new type Path_Name_Type, also derived from Name_Id.
	Use variables of types File_Name_Type and Unit_Name_Type in error
	messages.
	(Get_Name): Add parameter Ignore_Special, and set it reading file name
	(New_Copy): When debugging the compiler, call New_Node_Debugging_Output
	here.
	Define flags Flag217-Flag230 with associated subprograms
	(Flag_Word5): New record type.
	(Flag_Word5_Ptr): New access type.
	(To_Flag_Word5): New unchecked conversion.
	(To_Flag_Word5_Ptr): Likewise.
	(Flag216): New function.
	(Set_Flag216): New procedure.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125377 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 56 insertions, 55 deletions

diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb
index 37e1002d3e6..381ef27215f 100644
--- a/gcc/ada/fmap.adb
+++ b/gcc/ada/fmap.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2001-2006, Free Software Foundation, Inc.       --
+--          Copyright (C) 2001-2007, 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- --
@@ -24,12 +24,13 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-with Namet;       use Namet;
-with Opt;         use Opt;
-with Osint;       use Osint;
-with Output;      use Output;
+with Opt;    use Opt;
+with Osint;  use Osint;
+with Output; use Output;
 with Table;
+with Types;  use Types;
+
+with System.OS_Lib; use System.OS_Lib;
 
 with Unchecked_Conversion;
 
@@ -91,6 +92,9 @@ package body Fmap is
    --  Hash table to map unit names to file names. Used in conjunction with
    --  table File_Mapping above.
 
+   function Hash (F : File_Name_Type) return Header_Num;
+   --  Function used to compute hash of file name
+
    package File_Hash_Table is new GNAT.HTable.Simple_HTable (
      Header_Num => Header_Num,
      Element    => Int,
@@ -115,7 +119,7 @@ package body Fmap is
    -- Add_Forbidden_File_Name --
    -----------------------------
 
-   procedure Add_Forbidden_File_Name (Name : Name_Id) is
+   procedure Add_Forbidden_File_Name (Name : File_Name_Type) is
    begin
       Forbidden_Names.Set (Name, True);
    end Add_Forbidden_File_Name;
@@ -144,6 +148,11 @@ package body Fmap is
    -- Hash --
    ----------
 
+   function Hash (F : File_Name_Type) return Header_Num is
+   begin
+      return Header_Num (Int (F) rem Header_Num'Range_Length);
+   end Hash;
+
    function Hash (F : Unit_Name_Type) return Header_Num is
    begin
       return Header_Num (Int (F) rem Header_Num'Range_Length);
@@ -163,16 +172,20 @@ package body Fmap is
       Last  : Natural  := 0;
 
       Uname : Unit_Name_Type;
-      Fname : Name_Id;
-      Pname : Name_Id;
-
-      The_Mapping : Mapping;
+      Fname : File_Name_Type;
+      Pname : File_Name_Type;
 
-      procedure Empty_Tables (Warning : Boolean := True);
+      procedure Empty_Tables;
       --  Remove all entries in case of incorrect mapping file
 
-      function Find_Name return Name_Id;
-      --  Return Error_Name for "/", otherwise call Name_Find
+      function Find_File_Name return File_Name_Type;
+      --  Return Error_File_Name for "/", otherwise call Name_Find
+      --  What is this about, explanation required ???
+
+      function Find_Unit_Name return Unit_Name_Type;
+      --  Return Error_Unit_Name for "/", otherwise call Name_Find
+      --  Even more mysterious??? function appeared when Find_Name was split
+      --  for the two types, but this routine is definitely called!
 
       procedure Get_Line;
       --  Get a line from the mapping file
@@ -185,14 +198,8 @@ package body Fmap is
       -- Empty_Tables --
       ------------------
 
-      procedure Empty_Tables (Warning : Boolean := True) is
+      procedure Empty_Tables is
       begin
-         if Warning then
-            Write_Str ("mapping file """);
-            Write_Str (File_Name);
-            Write_Line (""" is not taken into account");
-         end if;
-
          Unit_Hash_Table.Reset;
          File_Hash_Table.Reset;
          Path_Mapping.Set_Last (0);
@@ -200,19 +207,30 @@ package body Fmap is
          Last_In_Table := 0;
       end Empty_Tables;
 
-      ---------------
-      -- Find_Name --
-      ---------------
+      --------------------
+      -- Find_File_Name --
+      --------------------
+
+      --  Why is only / illegal, why not \ on windows ???
 
-      function Find_Name return Name_Id is
+      function Find_File_Name return File_Name_Type is
       begin
          if Name_Buffer (1 .. Name_Len) = "/" then
-            return Error_Name;
-
+            return Error_File_Name;
          else
             return Name_Find;
          end if;
-      end Find_Name;
+      end Find_File_Name;
+
+      --------------------
+      -- Find_Unit_Name --
+      --------------------
+
+      function Find_Unit_Name return Unit_Name_Type is
+      begin
+         return Unit_Name_Type (Find_File_Name);
+         --  very odd ???
+      end Find_Unit_Name;
 
       --------------
       -- Get_Line --
@@ -261,10 +279,10 @@ package body Fmap is
          Write_Line (""" is truncated");
       end Report_Truncated;
 
-   --  Start of procedure Initialize
+   --  Start of processing for Initialize
 
    begin
-      Empty_Tables (Warning => False);
+      Empty_Tables;
       Name_Len := File_Name'Length;
       Name_Buffer (1 .. Name_Len) := File_Name;
       Read_Source_File (Name_Enter, 0, Hi, Src, Config);
@@ -299,7 +317,7 @@ package body Fmap is
 
             Name_Len := Last - First + 1;
             Name_Buffer (1 .. Name_Len) := SP (First .. Last);
-            Uname := Find_Name;
+            Uname := Find_Unit_Name;
 
             --  Get the file name
 
@@ -316,7 +334,7 @@ package body Fmap is
             Name_Len := Last - First + 1;
             Name_Buffer (1 .. Name_Len) := SP (First .. Last);
             Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
-            Fname := Find_Name;
+            Fname := Find_File_Name;
 
             --  Get the path name
 
@@ -332,32 +350,16 @@ package body Fmap is
 
             Name_Len := Last - First + 1;
             Name_Buffer (1 .. Name_Len) := SP (First .. Last);
-            Pname := Find_Name;
+            Pname := Find_File_Name;
 
             --  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 ("""");
-               The_Mapping := File_Mapping.Table (Unit_Hash_Table.Get (Uname));
-               Write_Line (Get_Name_String (The_Mapping.Uname));
-               Write_Line (Get_Name_String (The_Mapping.Fname));
                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 ("""");
-               The_Mapping := Path_Mapping.Table (File_Hash_Table.Get (Fname));
-               Write_Line (Get_Name_String (The_Mapping.Uname));
-               Write_Line (Get_Name_String (The_Mapping.Fname));
                Empty_Tables;
                return;
             end if;
@@ -371,7 +373,6 @@ package body Fmap is
       --  Record the length of the two mapping tables
 
       Last_In_Table := File_Mapping.Last;
-
    end Initialize;
 
    ----------------------
@@ -398,7 +399,7 @@ package body Fmap is
 
    begin
       if Forbidden_Names.Get (File) then
-         return Error_Name;
+         return Error_File_Name;
       end if;
 
       Index := File_Hash_Table.Get (File);
@@ -414,7 +415,7 @@ package body Fmap is
    -- Remove_Forbidden_File_Name --
    --------------------------------
 
-   procedure Remove_Forbidden_File_Name (Name : Name_Id) is
+   procedure Remove_Forbidden_File_Name (Name : File_Name_Type) is
    begin
       Forbidden_Names.Set (Name, False);
    end Remove_Forbidden_File_Name;
@@ -506,9 +507,9 @@ package body Fmap is
             end if;
 
             for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
-               Put_Line (File_Mapping.Table (Unit).Uname);
-               Put_Line (File_Mapping.Table (Unit).Fname);
-               Put_Line (Path_Mapping.Table (Unit).Fname);
+               Put_Line (Name_Id (File_Mapping.Table (Unit).Uname));
+               Put_Line (Name_Id (File_Mapping.Table (Unit).Fname));
+               Put_Line (Name_Id (Path_Mapping.Table (Unit).Fname));
             end loop;
 
             --  Before closing the file, write the buffer to the file.