* sem_res.adb (Resolve_Selected_Component): do not generate a

	discriminant check if the selected component is a component of
	the argument of an initialization procedure.

	* trans.c (tree_transform, case of arithmetic operators): If result
	type is private, the gnu_type is the base type of the full view,
	given that the full view itself may be a subtype.

	* sem_res.adb: Minor reformatting

	* trans.c (tree_transform, case N_Real_Literal): Add missing third
	parameter in call to Machine (unknown horrible effects from this
	omission).

	* urealp.h: Add definition of Round_Even for call to Machine
	Add third parameter for Machine

	* sem_warn.adb (Check_One_Unit): Suppress warnings completely on
	predefined units in No_Run_Time mode.

	* misc.c (insn-codes.h): Now include.

	* a-except.adb: Preparation work for future integration of the GCC 3
	exception handling mechanism
	(Notify_Handled_Exception, Notify_Unhandled_Exception): New routines
	to factorize previous code sequences and make them externally callable,
	e.g. for the Ada personality routine when the GCC 3 mechanism is used.
	(Propagate_Exception, Raise_Current_Excep, Raise_From_Signal_Handler):
	Use the new notification routines.

	* prj-tree.ads (First_Choice_Of): Document the when others case

	* bindgen.adb (Gen_Ada_Init_*): Set priority of environment task in
	HI-E mode, in order to support Ravenscar profile properly.

	* cstand.adb (Create_Standard): Duration is a 32 bit type in HI-E
	mode on 32 bits targets.

	* fmap.adb: Initial version.

	* fmap.ads: Initial version.

	* fname-uf.adb (Get_File_Name): Use mapping if unit name mapped.
	If search is successfully done, add to mapping.

	* frontend.adb: Initialize the mapping if a -gnatem switch was used.

	* make.adb:
	(Gnatmake): Add new local variable Mapping_File_Name.
	 Create mapping file when using project file(s).
	 Delete mapping file before exiting.

	* opt.ads (Mapping_File_Name): New variable

	* osint.adb (Find_File): Use path name found in mapping, if any.

	* prj-env.adb (Create_Mapping_File): New procedure

	* prj-env.ads (Create_Mapping_File): New procedure.

	* switch.adb (Scan_Front_End_Switches): Add processing for -gnatem
	(Mapping_File)

	* usage.adb: Add entry for new switch -gnatem.

	* Makefile.in: Add dependencies for fmap.o.

	* sem_ch10.adb (Analyze_With_Clause): Retrieve proper entity when unit
	is a package instantiation rewritten as a package body.
	(Install_Withed_Unit): Undo previous change, now redundant.

	* layout.adb:
	(Compute_Length): Move conversion to Unsigned to callers.
	(Get_Max_Size): Convert Len expression to Unsigned after calls to
	Compute_Length and Determine_Range.
	(Layout_Array_Type): Convert Len expression to Unsigned after calls to
	Compute_Length and Determine_Range.
	Above changes fix problem with length computation for supernull arrays
	where Max (Len, 0) wasn't getting applied due to the Unsigned
	conversion used by Compute_Length.

	* rtsfind.ads:
	(OK_To_Use_In_No_Run_Time_Mode): Allow Ada.Exceptions and
	 System.Secondary_Stack.
	(OK_To_Use_In_Ravenscar_Mode): New table needed to implement Ravenscar
	 in HI-E mode.
	Remove unused entity RE_Exception_Data.

	* rtsfind.adb (RTE): Allow Ravenscar Profile in HI mode.

	* rident.ads (No_Secondary_Stack): New restriction.


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

1 files changed, 332 insertions, 0 deletions

diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb
new file mode 100644
index 00000000000..89b3fd810f7
--- /dev/null
+++ b/gcc/ada/fmap.adb
@@ -0,0 +1,332 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                                 F M A P                                  --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 1992-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 GNAT.HTable;
+with Namet;          use Namet;
+with Osint;          use Osint;
+with Output;         use Output;
+with Table;
+
+with Unchecked_Conversion;
+
+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;
+
+   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 --
+   ---------
+
+   procedure Add
+     (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;
+
+   ------------------
+   -- File_Name_Of --
+   ------------------
+
+   function File_Name_Of (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 File_Name_Of;
+
+   ----------
+   -- 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 (Uname, Fname, Pname);
+
+         end loop;
+
+      end if;
+
+   end Initialize;
+
+   ------------------
+   -- Path_Name_Of --
+   ------------------
+
+   function Path_Name_Of (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 Path_Name_Of;
+
+end Fmap;