This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Reflect ACT changes of 2001-11-09


2001-12-19  Robert Dewar <dewar@gnat.com>

	* 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)
	
2001-12-19  Olivier Hainque <hainque@gnat.com>

	* 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.
	
2001-12-19  Arnaud Charlet <charlet@gnat.com>

	* 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.
	
2001-12-19  Robert Dewar <dewar@gnat.com>

	* 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.
	
2001-12-19  Arnaud Charlet <charlet@gnat.com>

	* 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.
	
2001-12-19  Vincent Celier <celier@gnat.com>

	* prj-tree.ads (Project_Node_Record): Add comments for components 
	Pkg_Id and Case_Insensitive.
	
2001-12-19  Pascal Obry <obry@gnat.com>

	* g-socket.adb: Minor reformatting. Found while reading code.
	
2001-12-19  Robert Dewar <dewar@gnat.com>

	* prj-tree.ads: Minor reformatting

*** bindgen.adb	2001/11/08 17:45:38	1.206
--- bindgen.adb	2001/11/09 02:23:43	1.207
***************
*** 343,359 ****
  
        Write_Statement_Buffer;
  
!       --  Normal case (no pragma No_Run_Time). The global values are
        --  assigned using the runtime routine Set_Globals (we have to use
        --  the routine call, rather than define the globals in the binder
        --  file to deal with cross-library calls in some systems.
  
        if No_Run_Time_Specified then
-          --  Case of pragma No_Run_Time present. The only global variable
-          --  that might be needed (by the Ravenscar profile) is
-          --  the environment task's priority. Also no exception tables are
-          --  needed.
  
           if Main_Priority /= No_Main_Priority then
              WBI ("      Main_Priority : Integer;");
              WBI ("      pragma Import (C, Main_Priority," &
--- 343,359 ----
  
        Write_Statement_Buffer;
  
!       --  Normal case (not No_Run_Time mode). The global values are
        --  assigned using the runtime routine Set_Globals (we have to use
        --  the routine call, rather than define the globals in the binder
        --  file to deal with cross-library calls in some systems.
  
        if No_Run_Time_Specified then
  
+          --  Case of No_Run_Time mode. The only global variable that might
+          --  be needed (by the Ravenscar profile) is the priority of the
+          --  environment. Also no exception tables are needed.
+ 
           if Main_Priority /= No_Main_Priority then
              WBI ("      Main_Priority : Integer;");
              WBI ("      pragma Import (C, Main_Priority," &
***************
*** 513,520 ****
        Write_Statement_Buffer;
  
        if No_Run_Time_Specified then
!          --  Case where No_Run_Time pragma is present.
!          --  Set __gl_main_priority if needed for the Ravenscar profile.
  
           if Main_Priority /= No_Main_Priority then
              Set_String ("   extern int __gl_main_priority = ");
--- 513,521 ----
        Write_Statement_Buffer;
  
        if No_Run_Time_Specified then
! 
!          --  Case of No_Run_Time mode. Set __gl_main_priority if needed
!          --  for the Ravenscar profile.
  
           if Main_Priority /= No_Main_Priority then
              Set_String ("   extern int __gl_main_priority = ");
***************
*** 524,530 ****
           end if;
  
        else
!          --  Code for normal case (no pragma No_Run_Time in use)
  
           Gen_Exception_Table_C;
  
--- 525,531 ----
           end if;
  
        else
!          --  Code for normal case (not in No_Run_Time mode)
  
           Gen_Exception_Table_C;
  

*** cstand.adb	2001/11/08 17:47:15	1.215
--- cstand.adb	2001/11/09 02:27:38	1.216
***************
*** 1001,1023 ****
        Set_Size_Known_At_Compile_Time
                             (Universal_Fixed);
  
!       --  Create type declaration for Duration, using a 64-bit size.
!       --  Delta is 1 nanosecond.
!       --  Except on 32 bits machine in No_Run_Time mode, in which case Duration
!       --  is a 32 bits value whose delta is 10E-4 seconds.
  
        Build_Duration : declare
           Dlo         : Uint;
           Dhi         : Uint;
           Delta_Val   : Ureal;
           Use_32_Bits : constant Boolean :=
!            No_Run_Time and then System_Word_Size = 32;
  
        begin
           if Use_32_Bits then
              Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
              Dhi := Intval (Type_High_Bound (Standard_Integer_32));
              Delta_Val := UR_From_Components (Uint_1, Uint_4, 10);
           else
              Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
              Dhi := Intval (Type_High_Bound (Standard_Integer_64));
--- 1001,1028 ----
        Set_Size_Known_At_Compile_Time
                             (Universal_Fixed);
  
!       --  Create type declaration for Duration, using a 64-bit size. The
!       --  delta value depends on the mode we are running in:
  
+       --     Normal mode or No_Run_Time mode when word size is 64 bits:
+       --       10**(-9) seconds, size is 64 bits
+ 
+       --     No_Run_Time mode when word size is 32 bits:
+       --       10**(-4) seconds, oize is 32 bits
+ 
        Build_Duration : declare
           Dlo         : Uint;
           Dhi         : Uint;
           Delta_Val   : Ureal;
           Use_32_Bits : constant Boolean :=
!                          No_Run_Time and then System_Word_Size = 32;
  
        begin
           if Use_32_Bits then
              Dlo := Intval (Type_Low_Bound (Standard_Integer_32));
              Dhi := Intval (Type_High_Bound (Standard_Integer_32));
              Delta_Val := UR_From_Components (Uint_1, Uint_4, 10);
+ 
           else
              Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
              Dhi := Intval (Type_High_Bound (Standard_Integer_64));

*** fmap.adb	2001/11/08 20:03:27	1.1
--- fmap.adb	2001/11/09 04:59:34	1.2
***************
*** 8,14 ****
  --                                                                          --
  --                            $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- --
--- 8,14 ----
  --                                                                          --
  --                            $Revision$
  --                                                                          --
! --            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- --
***************
*** 26,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! 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);
--- 26,40 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! 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);
***************
*** 63,68 ****
--- 64,70 ----
     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
***************
*** 87,100 ****
     --  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);
--- 89,103 ----
     --  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);
***************
*** 102,125 ****
        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 --
     ----------
--- 105,112 ----
        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 --
     ----------
***************
*** 174,183 ****
--- 161,172 ----
  
        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
***************
*** 213,219 ****
           Write_Line (""" is truncated");
        end Report_Truncated;
  
!    --  start of procedure Initialize
  
     begin
        Name_Len := File_Name'Length;
--- 202,208 ----
           Write_Line (""" is truncated");
        end Report_Truncated;
  
!    --  Start of procedure Initialize
  
     begin
        Name_Len := File_Name'Length;
***************
*** 230,236 ****
           SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
  
           loop
- 
              --  Get the unit name
  
              Get_Line;
--- 219,224 ----
***************
*** 303,332 ****
  
              --  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;
--- 291,331 ----
  
              --  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;

*** fmap.ads	2001/11/08 20:03:28	1.1
--- fmap.ads	2001/11/09 04:59:40	1.2
***************
*** 8,14 ****
  --                                                                          --
  --                            $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- --
--- 8,14 ----
  --                                                                          --
  --                            $Revision$
  --                                                                          --
! --            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- --
***************
*** 38,52 ****
     --  If the mapping file is incorrect (non existent file, truncated file,
     --  duplicate entries), output a warning and do not initialize the mappings.
  
!    function Path_Name_Of (File : File_Name_Type) return File_Name_Type;
     --  Return the path name mapped to the file name File.
     --  Return No_File if File is not mapped.
  
!    function File_Name_Of (Unit : Unit_Name_Type) return File_Name_Type;
     --  Return the file name mapped to the unit name Unit.
     --  Return No_File if Unit is not mapped.
  
!    procedure Add
       (Unit_Name : Unit_Name_Type;
        File_Name : File_Name_Type;
        Path_Name : File_Name_Type);
--- 38,52 ----
     --  If the mapping file is incorrect (non existent file, truncated file,
     --  duplicate entries), output a warning and do not initialize the mappings.
  
!    function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type;
     --  Return the path name mapped to the file name File.
     --  Return No_File if File is not mapped.
  
!    function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type;
     --  Return the file name mapped to the unit name Unit.
     --  Return No_File if Unit is not mapped.
  
!    procedure Add_To_File_Map
       (Unit_Name : Unit_Name_Type;
        File_Name : File_Name_Type;
        Path_Name : File_Name_Type);

*** fname-uf.adb	2001/11/08 20:03:31	1.7
--- fname-uf.adb	2001/11/09 05:00:05	1.8
***************
*** 28,34 ****
  
  with Alloc;
  with Debug;    use Debug;
! with Fmap;
  with Krunch;
  with Namet;    use Namet;
  with Opt;      use Opt;
--- 28,34 ----
  
  with Alloc;
  with Debug;    use Debug;
! with Fmap;     use Fmap;
  with Krunch;
  with Namet;    use Namet;
  with Opt;      use Opt;
***************
*** 140,145 ****
--- 140,146 ----
  
        Pname : File_Name_Type := No_File;
        Fname : File_Name_Type := No_File;
+       --  Path name and File name for mapping
  
     begin
        --  Null or error name means that some previous error occured
***************
*** 149,160 ****
           raise Unrecoverable_Error;
        end if;
  
!       --  Look into the mapping from unit names to file names
  
!       Fname := Fmap.File_Name_Of (Uname);
  
        --  If the unit name is already mapped, return the corresponding
!       --  file name.
  
        if Fname /= No_File then
           return Fname;
--- 150,161 ----
           raise Unrecoverable_Error;
        end if;
  
!       --  Look in the map from unit names to file names
  
!       Fname := Mapped_File_Name (Uname);
  
        --  If the unit name is already mapped, return the corresponding
!       --  file name from the map.
  
        if Fname /= No_File then
           return Fname;
***************
*** 394,400 ****
                          --  Add to mapping, so that we don't do another
                          --  path search in Find_File for this file name
  
!                         Fmap.Add (Get_File_Name.Uname, Fnam, Pname);
                          return Fnam;
  
                       --  This entry does not match after all, because this is
--- 395,401 ----
                          --  Add to mapping, so that we don't do another
                          --  path search in Find_File for this file name
  
!                         Add_To_File_Map (Get_File_Name.Uname, Fnam, Pname);
                          return Fnam;
  
                       --  This entry does not match after all, because this is

*** make.adb	2001/11/08 20:03:35	1.179
--- make.adb	2001/11/09 05:00:17	1.180
***************
*** 3501,3507 ****
           begin
              Delete_File (Name => Mapping_File_Name, Success => Success);
           end;
- 
        end if;
  
        Exit_Program (E_Success);
--- 3501,3506 ----

*** osint.adb	2001/11/08 20:03:39	1.264
--- osint.adb	2001/11/09 05:00:31	1.265
***************
*** 26,32 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Fmap;
  with Hostparm;
  with Namet;    use Namet;
  with Opt;      use Opt;
--- 26,32 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Fmap;     use Fmap;
  with Hostparm;
  with Namet;    use Namet;
  with Opt;      use Opt;
***************
*** 996,1011 ****
           --  directory where the user said it was.
  
           elsif Look_In_Primary_Directory_For_Current_Main
!            and then Current_Main = N then
              return Locate_File (N, T, Primary_Directory, File_Name);
  
           --  Otherwise do standard search for source file
  
           else
- 
              --  Check the mapping of this file name
  
!             File := Fmap.Path_Name_Of (N);
  
              --  If the file name is mapped to a path name, return the
              --  corresponding path name
--- 996,1011 ----
           --  directory where the user said it was.
  
           elsif Look_In_Primary_Directory_For_Current_Main
!            and then Current_Main = N
!          then
              return Locate_File (N, T, Primary_Directory, File_Name);
  
           --  Otherwise do standard search for source file
  
           else
              --  Check the mapping of this file name
  
!             File := Mapped_Path_Name (N);
  
              --  If the file name is mapped to a path name, return the
              --  corresponding path name

*** prj-env.adb	2001/11/08 20:03:41	1.20
--- prj-env.adb	2001/11/09 05:00:49	1.21
***************
*** 804,809 ****
--- 804,813 ----
        --  Put the mapping of the spec or body contained in Data in the file
        --  (3 lines).
  
+       ---------
+       -- Put --
+       ---------
+ 
        procedure Put (S : String) is
           Last : Natural;
  
***************
*** 813,821 ****
           if Last /= S'Length then
              Osint.Fail ("Disk full");
           end if;
- 
        end Put;
  
        procedure Put_Data (Spec : Boolean) is
        begin
           Put (Get_Name_String (The_Unit_Data.Name));
--- 817,828 ----
           if Last /= S'Length then
              Osint.Fail ("Disk full");
           end if;
        end Put;
  
+       --------------
+       -- Put_Data --
+       --------------
+ 
        procedure Put_Data (Spec : Boolean) is
        begin
           Put (Get_Name_String (The_Unit_Data.Name));
***************
*** 833,838 ****
--- 840,847 ----
           Put (S => (1 => ASCII.LF));
        end Put_Data;
  
+    --  Start of processing for Create_Mapping_File
+ 
     begin
        GNAT.OS_Lib.Create_Temp_File (File, Name => Name);
  
***************
*** 938,944 ****
        for Current in reverse Units.First .. Units.Last loop
           Unit := Units.Table (Current);
  
!          --  If it is a unit of the same project
  
           if Unit.File_Names (Body_Part).Project = Project then
              declare
--- 947,953 ----
        for Current in reverse Units.First .. Units.Last loop
           Unit := Units.Table (Current);
  
!          --  Case of unit of the same project
  
           if Unit.File_Names (Body_Part).Project = Project then
              declare
***************
*** 946,952 ****
                                  Unit.File_Names (Body_Part).Name;
  
              begin
!                --  If there is a body
  
                 if Current_Name /= No_Name then
                    if Current_Verbosity = High then
--- 955,961 ----
                                  Unit.File_Names (Body_Part).Name;
  
              begin
!                --  Case of a body present
  
                 if Current_Name /= No_Name then
                    if Current_Verbosity = High then
***************
*** 987,993 ****
              end;
           end if;
  
!          --  If it is a unit of the same project
  
           if Units.Table (Current).File_Names (Specification).Project =
                                                                   Project
--- 996,1002 ----
              end;
           end if;
  
!          --  Case of a unit of the same project
  
           if Units.Table (Current).File_Names (Specification).Project =
                                                                   Project
***************
*** 997,1003 ****
                                  Unit.File_Names (Specification).Name;
  
              begin
!                --  If there is a spec
  
                 if Current_Name /= No_Name then
                    if Current_Verbosity = High then
--- 1006,1012 ----
                                  Unit.File_Names (Specification).Name;
  
              begin
!                --  Case of spec present
  
                 if Current_Name /= No_Name then
                    if Current_Verbosity = High then
***************
*** 1007,1014 ****
                       Write_Eol;
                    end if;
  
!                   --  If it has the same name as the original name,
!                   --  return the original name
  
                    if Unit.Name = The_Original_Name
                      or else Current_Name = The_Original_Name
--- 1016,1022 ----
                       Write_Eol;
                    end if;
  
!                   --  If name same as the original name, return original name
  
                    if Unit.Name = The_Original_Name
                      or else Current_Name = The_Original_Name
***************
*** 1020,1026 ****
                       return Get_Name_String (Current_Name);
  
                    --  If it has the same name as the extended spec name,
!                   --  return the extended spec name
  
                    elsif Current_Name = The_Spec_Name then
                       if Current_Verbosity = High then
--- 1028,1034 ----
                       return Get_Name_String (Current_Name);
  
                    --  If it has the same name as the extended spec name,
!                   --  return the extended spec name.
  
                    elsif Current_Name = The_Spec_Name then
                       if Current_Verbosity = High then

*** prj-env.ads	2001/11/08 20:03:43	1.11
--- prj-env.ads	2001/11/09 05:00:53	1.12
***************
*** 40,48 ****
     --  Output the list of sources, after Project files have been scanned
  
     procedure Create_Mapping_File (Name : in out Temp_File_Name);
!    --  Create a temporary mapping file.
!    --  For each unit, put the mapping of its spec and or body to its
!    --  file name and path name in this file.
  
     procedure Create_Config_Pragmas_File
       (For_Project  : Project_Id;
--- 40,47 ----
     --  Output the list of sources, after Project files have been scanned
  
     procedure Create_Mapping_File (Name : in out Temp_File_Name);
!    --  Create a temporary mapping file. For each unit, put the mapping of
!    --  its spec and or body to its file name and path name in this file.
  
     procedure Create_Config_Pragmas_File
       (For_Project  : Project_Id;

*** switch.adb	2001/11/08 20:03:45	1.198
--- switch.adb	2001/11/09 05:01:12	1.199
***************
*** 610,617 ****
  
                    when 'c' =>
                       Ptr := Ptr + 1;
                       if Ptr > Max then
!                         Osint.Fail ("Invalid switch: ", "ec");
                       end if;
  
                       Config_File_Name :=
--- 610,618 ----
  
                    when 'c' =>
                       Ptr := Ptr + 1;
+ 
                       if Ptr > Max then
!                         raise Bad_Switch;
                       end if;
  
                       Config_File_Name :=
***************
*** 623,640 ****
  
                    when 'm' =>
                       Ptr := Ptr + 1;
                       if Ptr > Max then
!                         Osint.Fail ("Invalid switch: ", "em");
                       end if;
  
                       Mapping_File_Name :=
                         new String'(Switch_Chars (Ptr .. Max));
- 
                       return;
  
                    when others =>
!                      Osint.Fail ("Invalid switch: ",
!                                    (1 => 'e', 2 => Switch_Chars (Ptr)));
                 end case;
  
              --  Processing for E switch
--- 624,640 ----
  
                    when 'm' =>
                       Ptr := Ptr + 1;
+ 
                       if Ptr > Max then
!                         raise Bad_Switch;
                       end if;
  
                       Mapping_File_Name :=
                         new String'(Switch_Chars (Ptr .. Max));
                       return;
  
                    when others =>
!                      raise Bad_Switch;
                 end case;
  
              --  Processing for E switch

*** raise.c	2001/09/08 13:44:36	1.1
--- raise.c	2001/11/09 08:12:03	1.2
***************
*** 84,86 ****
--- 84,597 ----
      __gnat_os_exit (1);
  #endif
  }
+ 
+ /* Below is the eh personality routine for Ada to be called when the GCC
+    mechanism is used.
+ 
+    ??? It is currently inspired from the one for C++, needs cleanups and
+    additional comments. It also contains a big bunch of debugging code that
+    we shall get rid of at some point.  */
+ 
+ #ifdef IN_RTS   /* For eh personality routine */
+ 
+ /* ??? Does it make any sense to leave this for the compiler ?   */
+ 
+ #include "dwarf2.h"
+ #include "unwind.h"
+ #include "unwind-dw2-fde.h"
+ #include "unwind-pe.h"
+ 
+ /* First define a set of useful structures and helper routines.  */
+ 
+ typedef struct _Unwind_Context _Unwind_Context;
+ 
+ struct lsda_header_info
+ {
+   _Unwind_Ptr Start;
+   _Unwind_Ptr LPStart;
+   _Unwind_Ptr ttype_base;
+   const unsigned char *TType;
+   const unsigned char *action_table;
+   unsigned char ttype_encoding;
+   unsigned char call_site_encoding;
+ };
+ 
+ typedef struct lsda_header_info lsda_header_info;
+ 
+ typedef enum {false = 0, true = 1} bool;
+ 
+ static const unsigned char *
+ parse_lsda_header (_Unwind_Context *context, const unsigned char *p,
+ 		   lsda_header_info *info)
+ {
+   _Unwind_Ptr tmp;
+   unsigned char lpstart_encoding;
+ 
+   info->Start = (context ? _Unwind_GetRegionStart (context) : 0);
+ 
+   /* Find @LPStart, the base to which landing pad offsets are relative.  */
+   lpstart_encoding = *p++;
+   if (lpstart_encoding != DW_EH_PE_omit)
+     p = read_encoded_value (context, lpstart_encoding, p, &info->LPStart);
+   else
+     info->LPStart = info->Start;
+   
+   /* Find @TType, the base of the handler and exception spec type data.  */
+   info->ttype_encoding = *p++;
+   if (info->ttype_encoding != DW_EH_PE_omit)
+     {
+       p = read_uleb128 (p, &tmp);
+       info->TType = p + tmp;
+     }
+   else
+     info->TType = 0;
+ 
+   /* The encoding and length of the call-site table; the action table
+      immediately follows.  */
+   info->call_site_encoding = *p++;
+   p = read_uleb128 (p, &tmp);
+   info->action_table = p + tmp;
+ 
+   return p;
+ }
+ 
+ 
+ static const _Unwind_Ptr
+ get_ttype_entry (_Unwind_Context *context, lsda_header_info *info, long i)
+ {
+   _Unwind_Ptr ptr;
+ 
+   i *= size_of_encoded_value (info->ttype_encoding);
+   read_encoded_value (context, info->ttype_encoding, info->TType - i, &ptr);
+ 
+   return ptr;
+ }
+ 
+ struct _GNAT_Exception {
+   struct _Unwind_Exception common;
+ 
+   _Unwind_Ptr id;
+ 
+   char handled_by_others;
+   char has_cleanup;
+   char select_cleanups;
+ };
+ 
+ 
+ #define GNAT_OTHERS_ID      ((_Unwind_Ptr) 0x0)
+ #define GNAT_ALL_OTHERS_ID  ((_Unwind_Ptr) 0x1)
+ 
+ #define DB_PHASES     0x1
+ #define DB_SEARCH     0x2
+ #define DB_ECLASS     0x4
+ #define DB_MATCH      0x8
+ #define DB_SAW        0x10
+ #define DB_FOUND      0x20
+ #define DB_INSTALL    0x40
+ #define DB_CALLS      0x80
+ 
+ #define AEHP_DB_SPECS \
+ (DB_PHASES | DB_SEARCH | DB_SAW | DB_FOUND | DB_INSTALL | DB_CALLS | DB_MATCH)
+ 
+ #undef AEHP_DB_SPECS
+ 
+ #ifdef AEHP_DB_SPECS
+ static int db_specs = AEHP_DB_SPECS;
+ #else
+ static int db_specs = 0;
+ #endif
+ 
+ #define START_DB(what) do { if (what & db_specs) {
+ #define END_DB(what)        } \
+                            } while (0);
+ 
+ typedef struct {
+   _Unwind_Action action;
+   char * description;
+ }  action_description_t;
+ 
+ action_description_t action_descriptions [] = {
+   { _UA_SEARCH_PHASE,  "SEARCH_PHASE" },
+   { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
+   { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
+   { _UA_FORCE_UNWIND,  "FORCE_UNWIND" },
+   { -1, (char *)0 }
+ };
+ 
+ static void
+ decode_actions (actions)
+      _Unwind_Action actions;
+ {
+   int i;
+ 
+   action_description_t * a = action_descriptions;
+ 
+   printf ("\n");
+   while (a->description != (char *)0)
+     {
+       if (actions & a->action)
+ 	{
+ 	  printf ("%s ", a->description);
+ 	}
+ 
+       a ++;
+     }
+ 
+   printf (" : ");
+ }
+ 
+ /* The following is defined from a-except.adb. It's purpose is to enable
+    automatic backtraces upon exception raise, as provided through the 
+    GNAT.Traceback facilities.  */
+ extern void
+ __gnat_notify_handled_exception (void * handler, bool others, bool db_notify);
+ 
+ /* Below is the eh personality routine per se.  */
+ 
+ _Unwind_Reason_Code
+ __gnat_eh_personality (int version,
+ 		       _Unwind_Action actions,
+ 		       _Unwind_Exception_Class exception_class,
+ 		       struct _Unwind_Exception *ue_header,
+ 		       struct _Unwind_Context *context)
+ {
+   enum found_handler_type
+   {
+     found_nothing,
+     found_terminate,
+     found_cleanup,
+     found_handler
+   } found_type;
+ 
+   lsda_header_info info;
+   const unsigned char *language_specific_data;
+   const unsigned char *action_record;
+   const unsigned char *p;
+   _Unwind_Ptr landing_pad, ip;
+   int handler_switch_value;
+ 
+   bool hit_others_handler;
+ 
+   struct _GNAT_Exception * gnat_exception;
+ 
+   if (version != 1)
+     return _URC_FATAL_PHASE1_ERROR;
+ 
+   START_DB (DB_PHASES);
+   decode_actions (actions);
+   END_DB (DB_PHASES);
+  
+   if (strcmp ( ((char *)&exception_class), "GNU") != 0
+       || strcmp ( ((char *)&exception_class)+4, "Ada") != 0)
+     {
+       START_DB (DB_SEARCH);
+       printf ("              Exception Class doesn't match for ip = %p\n", ip);
+       END_DB (DB_SEARCH);
+       START_DB (DB_FOUND);
+       printf ("              => FOUND nothing\n");
+       END_DB (DB_FOUND);
+       return _URC_CONTINUE_UNWIND;
+     }
+ 
+   gnat_exception = (struct _GNAT_Exception *) ue_header;
+ 
+   START_DB (DB_PHASES);
+   if (gnat_exception->select_cleanups)
+     {
+       printf ("(select_cleanups) :\n");
+     }
+   else
+     {
+       printf (" :\n");
+     }
+   END_DB (DB_PHASES);
+ 
+   language_specific_data = (const unsigned char *)
+     _Unwind_GetLanguageSpecificData (context);
+ 
+   /* If no LSDA, then there are no handlers or cleanups.  */
+   if (! language_specific_data)
+     {
+       ip = _Unwind_GetIP (context) - 1;
+ 
+       START_DB (DB_SEARCH);
+       printf ("              No Language Specific Data for ip = %p\n", ip);
+       END_DB (DB_SEARCH);
+       START_DB (DB_FOUND);
+       printf ("              => FOUND nothing\n");
+       END_DB (DB_FOUND);
+       return _URC_CONTINUE_UNWIND;
+     }
+   
+   /* Parse the LSDA header.  */
+   p = parse_lsda_header (context, language_specific_data, &info);
+   info.ttype_base = base_of_encoded_value (info.ttype_encoding, context);
+   ip = _Unwind_GetIP (context) - 1;
+   landing_pad = 0;
+   action_record = 0;
+   handler_switch_value = 0;
+ 
+   /* Search the call-site table for the action associated with this IP.  */
+   while (p < info.action_table)
+     {
+       _Unwind_Ptr cs_start, cs_len, cs_lp, cs_action;
+ 
+       /* Note that all call-site encodings are "absolute" displacements.  */
+       p = read_encoded_value (0, info.call_site_encoding, p, &cs_start);
+       p = read_encoded_value (0, info.call_site_encoding, p, &cs_len);
+       p = read_encoded_value (0, info.call_site_encoding, p, &cs_lp);
+       p = read_uleb128 (p, &cs_action);
+ 
+       /* The table is sorted, so if we've passed the ip, stop.  */
+       if (ip < info.Start + cs_start)
+  	p = info.action_table;
+       else if (ip < info.Start + cs_start + cs_len)
+ 	{
+ 	  if (cs_lp)
+ 	    landing_pad = info.LPStart + cs_lp;
+ 	  if (cs_action)
+ 	    action_record = info.action_table + cs_action - 1;
+ 	  goto found_something;
+ 	}
+     }
+ 
+   START_DB (DB_SEARCH);
+   printf ("              No Action entry for ip = %p\n", ip);
+   END_DB (DB_SEARCH);
+ 
+   /* If ip is not present in the table, call terminate.  This is for
+      a destructor inside a cleanup, or a library routine the compiler
+      was not expecting to throw.
+      
+      found_type = 
+      (actions & _UA_FORCE_UNWIND ? found_nothing : found_terminate);
+   
+      ??? Does this have a mapping in Ada semantics ?  */
+ 
+   found_type = found_nothing;
+ 
+   goto do_something;
+ 
+  found_something:
+ 
+   found_type = found_nothing;
+   
+   if (landing_pad == 0)
+     {
+       /* If ip is present, and has a null landing pad, there are
+ 	 no cleanups or handlers to be run.  */
+       START_DB (DB_SEARCH);
+       printf ("              No Landing Pad for ip = %p\n", ip);
+       END_DB (DB_SEARCH);
+     }
+   else if (action_record == 0)
+     {
+       START_DB (DB_SEARCH);
+       printf ("              Null Action Record for ip = %p <===\n", ip);
+       END_DB (DB_SEARCH);
+     }
+   else
+     {
+       signed long ar_filter, ar_disp;
+ 
+       signed long cleanup_filter = 0;
+       signed long handler_filter = 0;
+ 
+       START_DB (DB_SEARCH);
+       printf ("              Landing Pad + Action Record for ip = %p\n", ip);
+       END_DB (DB_SEARCH);
+ 
+       START_DB (DB_MATCH);
+       printf ("              => Search for exception matching id %p\n", 
+ 	      gnat_exception->id);
+       END_DB (DB_MATCH);
+ 
+       /* Otherwise we have a catch handler or exception specification.  */
+ 
+       while (1)
+ 	{
+ 	  _Unwind_Ptr tmp;
+ 
+ 	  p = action_record;
+ 	  p = read_sleb128 (p, &tmp); ar_filter = tmp;
+ 	  read_sleb128 (p, &tmp); ar_disp = tmp;
+ 
+ 	  START_DB (DB_MATCH);
+ 	  printf ("ar_filter  %d\n", ar_filter);
+ 	  END_DB (DB_MATCH);
+ 
+ 	  if (ar_filter == 0)
+ 	    {
+ 	      /* Zero filter values are cleanups. We should not be seeing
+ 		 this for GNU-Ada though
+ 		 saw_cleanup = true;  */
+ 	      START_DB (DB_SEARCH);
+ 	      printf ("              Null Filter for ip = %p <===\n", ip);
+ 	      END_DB (DB_SEARCH);
+ 	    }
+ 	  else if (ar_filter > 0)
+ 	    {
+ 	      _Unwind_Ptr lp_id = get_ttype_entry (context, &info, ar_filter);
+ 	      
+ 	      START_DB (DB_MATCH);
+ 	      printf ("catch_type ");
+ 	      
+ 	      switch (lp_id)
+ 		{
+ 		case GNAT_ALL_OTHERS_ID:
+ 		  printf ("GNAT_ALL_OTHERS_ID\n");		
+ 		  break;
+ 		  
+ 		case GNAT_OTHERS_ID:
+ 		  printf ("GNAT_OTHERS_ID\n");
+ 		  break;
+ 		  
+ 		default:
+ 		  printf ("%p\n", lp_id);
+ 		  break;
+ 		}
+ 
+ 	      END_DB (DB_MATCH);
+ 
+ 	      if (lp_id == GNAT_ALL_OTHERS_ID)
+ 		{
+ 		  START_DB (DB_SAW);
+ 		  printf ("              => SAW cleanup\n");
+ 		  END_DB (DB_SAW);
+ 
+ 		  cleanup_filter = ar_filter;
+ 		  gnat_exception->has_cleanup = true;
+ 		}
+ 
+ 	      hit_others_handler = 
+ 		(lp_id == GNAT_OTHERS_ID && gnat_exception->handled_by_others);
+ 
+ 	      if (hit_others_handler || lp_id == gnat_exception->id)
+ 		{
+ 		  START_DB (DB_SAW);
+ 		  printf ("              => SAW handler\n");
+ 		  END_DB (DB_SAW);
+ 
+ 		  handler_filter = ar_filter;     
+ 		}
+ 	    }
+ 	  else
+ 	    {
+ 	      /* Negative filter values are for C++ exception specifications.
+ 		 Should not be there for Ada :/  */
+ 	    }
+ 
+ 	  if (actions & _UA_SEARCH_PHASE)
+ 	    {
+ 	      if (handler_filter)
+ 		{
+ 		  found_type = found_handler;
+ 		  handler_switch_value = handler_filter;
+ 		  break;
+ 		}
+ 
+ 	      if (cleanup_filter)
+ 		{
+ 		  found_type = found_cleanup;
+ 		}
+ 	    }
+ 
+ 	  if (actions & _UA_CLEANUP_PHASE)
+ 	    {
+ 	      if (handler_filter)
+ 		{
+ 		  found_type = found_handler;
+ 		  handler_switch_value = handler_filter;
+ 		  break;
+ 		}
+ 		
+ 	      if (cleanup_filter)
+ 		{
+ 		  found_type = found_cleanup;
+ 		  handler_switch_value = cleanup_filter;
+ 		  break;
+ 		}
+ 	    }
+ 
+ 	  if (ar_disp == 0)
+ 	    break;
+ 	  action_record = p + ar_disp;
+ 	}
+     }
+ 
+  do_something:
+   if (found_type == found_nothing) {
+     START_DB (DB_FOUND);
+     printf ("              => FOUND nothing\n");
+     END_DB (DB_FOUND);
+ 
+     return _URC_CONTINUE_UNWIND;
+   }
+ 
+    if (actions & _UA_SEARCH_PHASE)
+     {
+       START_DB (DB_FOUND);
+       printf ("              => Computing return for SEARCH\n");
+       END_DB (DB_FOUND);
+ 
+       if (found_type == found_cleanup
+ 	  && !gnat_exception->select_cleanups)
+ 	{
+ 	  START_DB (DB_FOUND);
+ 	  printf ("              => FOUND cleanup\n");
+ 	  END_DB (DB_FOUND);
+ 
+ 	  return _URC_CONTINUE_UNWIND;
+ 	}
+ 
+       START_DB (DB_FOUND);
+       printf ("              => FOUND handler\n");
+       END_DB (DB_FOUND);
+ 
+       return _URC_HANDLER_FOUND;
+     }
+ 
+  install_context:
+    
+    START_DB (DB_INSTALL);
+    printf ("              => INSTALLING context for filter %d\n",
+ 	   handler_switch_value);
+    END_DB (DB_INSTALL);
+ 
+    if (found_type == found_terminate)
+      {
+        /* Should not have this for Ada ?  */
+        START_DB (DB_INSTALL);
+        printf ("              => FOUND terminate <===\n");
+        END_DB (DB_INSTALL);
+      }
+ 
+    
+    /* Signal that we are going to enter a handler, which will typically
+       enable the debugger to take control and possibly output an automatic
+       backtrace. Note that we are supposed to provide the handler's entry
+       point here but we don't have it.
+     */
+    __gnat_notify_handled_exception
+      ((void *)landing_pad, hit_others_handler, true);
+       
+ 
+    /* The GNU-Ada exception handlers know how to find the exception
+       occurrence without having to pass it as an argument so there
+       is no need to feed any specific register with this information.
+ 	 
+       This is why the two following lines are commented out.  */
+ 
+    /* _Unwind_SetGR (context, __builtin_eh_return_data_regno (0),
+       (_Unwind_Ptr) &xh->unwindHeader);  */
+ 
+   _Unwind_SetGR (context, __builtin_eh_return_data_regno (1),
+ 		 handler_switch_value);
+ 
+   _Unwind_SetIP (context, landing_pad);
+ 
+   return _URC_INSTALL_CONTEXT;
+ }
+ 
+ 
+ #endif   /* IN_RTS - For eh personality routine   */

*** raise.c	2001/11/09 08:12:03	1.2
--- raise.c	2001/11/09 08:27:17	1.3
***************
*** 167,172 ****
--- 167,176 ----
    return ptr;
  }
  
+ /* This is the structure of exception objects as built by the GNAT runtime
+    library (a-except.adb). The layouts should exactly match, and the "common"
+    header is mandated by the exception handling ABI.  */
+ 
  struct _GNAT_Exception {
    struct _Unwind_Exception common;
  
***************
*** 178,186 ****
--- 182,197 ----
  };
  
  
+ /* The two constants below are specific ttype identifiers for special
+    exception ids. Their value is currently hardcoded at the gigi level
+    (see N_Exception_Handler).  */
+ 
  #define GNAT_OTHERS_ID      ((_Unwind_Ptr) 0x0)
  #define GNAT_ALL_OTHERS_ID  ((_Unwind_Ptr) 0x1)
  
+ 
+ /* The DB stuff below is there for debugging purposes only.  */
+ 
  #define DB_PHASES     0x1
  #define DB_SEARCH     0x2
  #define DB_ECLASS     0x4
***************
*** 204,209 ****
--- 215,222 ----
  #define START_DB(what) do { if (what & db_specs) {
  #define END_DB(what)        } \
                             } while (0);
+ 
+ /* The "action" stuff below if also there for debugging purposes only.  */
  
  typedef struct {
    _Unwind_Action action;

*** Makefile.in	2001/11/09 04:20:14	1.1425
--- Makefile.in	2001/11/09 09:52:03	1.1426
***************
*** 1059,1065 ****
    a-intnam.ads<4sintnam.ads \
    s-inmaop.adb<7sinmaop.adb \
    s-intman.adb<5sintman.adb \
-   s-mastop.adb<5smastop.adb \
    s-osinte.adb<5sosinte.adb \
    s-osinte.ads<5sosinte.ads \
    s-osprim.adb<5posprim.adb \
--- 1059,1064 ----
***************
*** 1085,1091 ****
      a-intnam.ads<4sintnam.ads \
      s-inmaop.adb<7sinmaop.adb \
      s-intman.adb<5sintman.adb \
-     s-mastop.adb<5smastop.adb \
      s-osinte.adb<7sosinte.adb \
      s-osinte.ads<5tosinte.ads \
      s-osprim.adb<5posprim.adb \
--- 1084,1089 ----
***************
*** 1104,1110 ****
      a-intnam.ads<4sintnam.ads \
      s-inmaop.adb<7sinmaop.adb \
      s-intman.adb<7sintman.adb \
-     s-mastop.adb<5smastop.adb \
      s-osinte.adb<5iosinte.adb \
      s-osinte.ads<54osinte.ads \
      s-osprim.adb<5posprim.adb \
--- 1102,1107 ----
***************
*** 1909,1914 ****
--- 1906,1913 ----
   s-fatlfl.ads \
   s-fatllf.ads \
   s-fatsfl.ads \
+  s-secsta.ads \
+  s-secsta.adb \
   a-tags.ads   \
   a-tags.adb $(EXTRA_HIE_SOURCES)
  
***************
*** 1923,1945 ****
   s-stoele.o \
   s-maccod.o \
   s-unstyp.o \
   a-tags.o $(EXTRA_HIE_OBJS)
  
  # Files which are needed in ravenscar mode
  
  RAVEN_SOURCES = \
   $(HIE_SOURCES) \
-  s-arit64.ads \
-  s-arit64.adb \
   s-parame.ads \
   s-parame.adb \
   g-except.ads \
-  s-stalib.ads \
-  s-stalib.adb \
-  s-soflin.ads \
-  s-soflin.adb \
-  s-secsta.ads \
-  s-secsta.adb \
   s-osinte.ads \
   s-osinte.adb \
   s-tasinf.ads \
--- 1922,1940 ----
   s-stoele.o \
   s-maccod.o \
   s-unstyp.o \
+  s-fatflt.o \
+  s-fatlfl.o \
+  s-fatllf.o \
+  s-secsta.o \
   a-tags.o $(EXTRA_HIE_OBJS)
  
  # Files which are needed in ravenscar mode
  
  RAVEN_SOURCES = \
   $(HIE_SOURCES) \
   s-parame.ads \
   s-parame.adb \
   g-except.ads \
   s-osinte.ads \
   s-osinte.adb \
   s-tasinf.ads \
***************
*** 1948,1956 ****
   s-taprop.ads \
   s-taprop.adb \
   s-taskin.ads \
   s-interr.ads \
   s-interr.adb \
!  s-taskin.adb \
   a-reatim.ads \
   a-reatim.adb \
   a-retide.ads \
--- 1943,1954 ----
   s-taprop.ads \
   s-taprop.adb \
   s-taskin.ads \
+  s-taskin.adb \
   s-interr.ads \
   s-interr.adb \
!  a-interr.ads \
!  a-interr.adb \
!  a-intnam.ads \
   a-reatim.ads \
   a-reatim.adb \
   a-retide.ads \
***************
*** 1963,1995 ****
   s-tarest.ads \
   s-tarest.adb $(EXTRA_RAVEN_SOURCES)
  
- # Files that need to be preprocessed before inclusion in a ravenscar run time
- 
- RAVEN_MOD = \
-  s-tposen.adb \
-  s-tarest.adb
- 
  # Objects to generate for the ravenscar run time
  
  RAVEN_OBJS = \
   $(HIE_OBJS) \
-  g-except.o  \
-  s-stalib.o  \
-  s-arit64.o  \
   s-parame.o  \
!  s-soflin.o  \
!  s-secsta.o  \
!  s-tasinf.o  \
   s-osinte.o  \
   s-taspri.o  \
   s-taprop.o  \
   s-taskin.o  \
-  s-taprob.o  \
-  s-tposen.o  \
   s-interr.o  \
   a-interr.o  \
   a-reatim.o  \
   a-retide.o  \
   s-tasres.o  \
   s-tarest.o  $(EXTRA_RAVEN_OBJS)
  
--- 1961,1984 ----
   s-tarest.ads \
   s-tarest.adb $(EXTRA_RAVEN_SOURCES)
  
  # Objects to generate for the ravenscar run time
  
  RAVEN_OBJS = \
   $(HIE_OBJS) \
   s-parame.o  \
!  g-except.o  \
   s-osinte.o  \
+  s-tasinf.o  \
   s-taspri.o  \
   s-taprop.o  \
   s-taskin.o  \
   s-interr.o  \
   a-interr.o  \
+  a-intnam.o  \
   a-reatim.o  \
   a-retide.o  \
+  s-taprob.o  \
+  s-tposen.o  \
   s-tasres.o  \
   s-tarest.o  $(EXTRA_RAVEN_OBJS)
  
*** a-ngelfu.adb	2000/08/28 11:35:03	1.44
--- a-ngelfu.adb	2001/11/09 13:39:30	1.45
***************
*** 8,14 ****
  --                                                                          --
  --                            $Revision$
  --                                                                          --
! --          Copyright (C) 1992-2000, 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- --
--- 8,14 ----
  --                                                                          --
  --                            $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- --
***************
*** 52,62 ****
     Log_Two  : constant := 0.69314_71805_59945_30941_72321_21458_17656_80755;
     Half_Log_Two : constant := Log_Two / 2;
  
- 
     subtype T is Float_Type'Base;
     subtype Double is Aux.Double;
  
- 
     Two_Pi     : constant T := 2.0 * Pi;
     Half_Pi    : constant T := Pi / 2.0;
     Fourth_Pi  : constant T := Pi / 4.0;
--- 52,60 ----
***************
*** 68,74 ****
     Log_Inverse_Epsilon : constant T := T (T'Model_Mantissa - 1) * Log_Two;
     Sqrt_Epsilon        : constant T := Sqrt_Two ** (1 - T'Model_Mantissa);
  
- 
     DEpsilon    : constant Double := Double (Epsilon);
     DIEpsilon   : constant Double := Double (IEpsilon);
  
--- 66,71 ----
***************
*** 558,564 ****
        --  Just reuse the code for Sin. The potential small
        --  loss of speed is negligible with proper (front-end) inlining.
  
-       --  ??? Add pragma Inline_Always in spec when this is supported
        return -Sin (abs X - Cycle * 0.25, Cycle);
     end Cos;
  
--- 555,560 ----
***************
*** 716,722 ****
        Q := ((Q3 * Z + Q2) * Z + Q1) * Z + Q0;
        R := 0.5 + P / (Q - P);
  
- 
        R := Float_Type'Base'Scaling (R, Integer (XN) + 1);
  
        --  Deal with case of Exp returning IEEE infinity. If Machine_Overflows
--- 712,717 ----
***************
*** 731,737 ****
        end if;
  
     end Exp_Strict;
- 
  
     ----------------
     -- Local_Atan --
--- 726,731 ----

*** g-regpat.adb	2001/10/31 09:44:18	1.32
--- g-regpat.adb	2001/11/09 13:42:45	1.33
***************
*** 245,253 ****
     procedure Reset_Class (Bitmap : in out Character_Class);
     --  Clear all the entries in the class Bitmap.
  
!    pragma Inline_Always (Set_In_Class);
!    pragma Inline_Always (Get_From_Class);
!    pragma Inline_Always (Reset_Class);
  
     -----------------------
     -- Local Subprograms --
--- 245,253 ----
     procedure Reset_Class (Bitmap : in out Character_Class);
     --  Clear all the entries in the class Bitmap.
  
!    pragma Inline (Set_In_Class);
!    pragma Inline (Get_From_Class);
!    pragma Inline (Reset_Class);
  
     -----------------------
     -- Local Subprograms --
***************
*** 512,520 ****
        --  Parse a posic character class, like [:alpha:] or [:^alpha:].
        --  The called is suppoed to absorbe the opening [.
  
!       pragma Inline_Always (Is_Mult);
!       pragma Inline_Always (Emit_Natural);
!       pragma Inline_Always (Parse_Character_Class); --  since used only once
  
        ---------------
        -- Case_Emit --
--- 512,520 ----
        --  Parse a posic character class, like [:alpha:] or [:^alpha:].
        --  The called is suppoed to absorbe the opening [.
  
!       pragma Inline (Is_Mult);
!       pragma Inline (Emit_Natural);
!       pragma Inline (Parse_Character_Class); --  since used only once
  
        ---------------
        -- Case_Emit --
***************
*** 2401,2412 ****
           return   Boolean;
        --  Return True it the simple operator (possibly non-greedy) matches
  
!       pragma Inline_Always (Index);
!       pragma Inline_Always (Repeat);
  
        --  These are two complex functions, but used only once.
!       pragma Inline_Always (Match_Whilem);
!       pragma Inline_Always (Match_Simple_Operator);
  
        -----------
        -- Index --
--- 2401,2413 ----
           return   Boolean;
        --  Return True it the simple operator (possibly non-greedy) matches
  
!       pragma Inline (Index);
!       pragma Inline (Repeat);
  
        --  These are two complex functions, but used only once.
! 
!       pragma Inline (Match_Whilem);
!       pragma Inline (Match_Simple_Operator);
  
        -----------
        -- Index --

*** s-taprob.adb	2001/02/11 14:52:58	1.79
--- s-taprob.adb	2001/11/09 14:44:04	1.80
***************
*** 42,53 ****
  --  used for Write_Lock
  --           Unlock
  
- with Ada.Exceptions;
- --  used for Raise_Exception
- 
  package body System.Tasking.Protected_Objects is
  
-    use Ada.Exceptions;
     use System.Task_Primitives.Operations;
  
     -------------------------
--- 42,49 ----
***************
*** 97,103 ****
        Write_Lock (Object.L'Access, Ceiling_Violation);
  
        if Ceiling_Violation then
!          Raise_Exception (Program_Error'Identity, "Ceiling Violation");
        end if;
     end Lock;
  
--- 93,99 ----
        Write_Lock (Object.L'Access, Ceiling_Violation);
  
        if Ceiling_Violation then
!          raise Program_Error;
        end if;
     end Lock;
  
***************
*** 111,117 ****
        Read_Lock (Object.L'Access, Ceiling_Violation);
  
        if Ceiling_Violation then
!          Raise_Exception (Program_Error'Identity, "Ceiling Violation");
        end if;
     end Lock_Read_Only;
  
--- 107,113 ----
        Read_Lock (Object.L'Access, Ceiling_Violation);
  
        if Ceiling_Violation then
!          raise Program_Error;
        end if;
     end Lock_Read_Only;
  

*** exp_ch7.adb	2001/09/29 12:16:59	1.247
--- exp_ch7.adb	2001/11/09 14:46:03	1.248
***************
*** 601,607 ****
  
           if Sec_Stk then
              Set_Uses_Sec_Stack (Current_Scope);
!             Disallow_In_No_Run_Time_Mode (N);
           end if;
  
           Set_Etype (Current_Scope, Standard_Void_Type);
--- 601,607 ----
  
           if Sec_Stk then
              Set_Uses_Sec_Stack (Current_Scope);
!             Check_Restriction (No_Secondary_Stack, N);
           end if;
  
           Set_Etype (Current_Scope, Standard_Void_Type);
***************
*** 2449,2455 ****
                    if not Requires_Transient_Scope (Etype (S)) then
                       if not Functions_Return_By_DSP_On_Target then
                          Set_Uses_Sec_Stack (S, True);
!                         Disallow_In_No_Run_Time_Mode (Action);
                       end if;
                    end if;
  
--- 2449,2455 ----
                    if not Requires_Transient_Scope (Etype (S)) then
                       if not Functions_Return_By_DSP_On_Target then
                          Set_Uses_Sec_Stack (S, True);
!                         Check_Restriction (No_Secondary_Stack, Action);
                       end if;
                    end if;
  
***************
*** 2470,2476 ****
                 then
                    if not Functions_Return_By_DSP_On_Target then
                       Set_Uses_Sec_Stack (S, True);
!                      Disallow_In_No_Run_Time_Mode (Action);
                    end if;
  
                    Set_Uses_Sec_Stack (Current_Scope, False);
--- 2470,2476 ----
                 then
                    if not Functions_Return_By_DSP_On_Target then
                       Set_Uses_Sec_Stack (S, True);
!                      Check_Restriction (No_Secondary_Stack, Action);
                    end if;
  
                    Set_Uses_Sec_Stack (Current_Scope, False);
***************
*** 2703,2709 ****
              null;
           else
              Set_Uses_Sec_Stack (S);
!             Disallow_In_No_Run_Time_Mode (N);
           end if;
        end if;
     end Wrap_Transient_Declaration;
--- 2703,2709 ----
              null;
           else
              Set_Uses_Sec_Stack (S);
!             Check_Restriction (No_Secondary_Stack, N);
           end if;
        end if;
     end Wrap_Transient_Declaration;

*** prj-tree.ads	2001/11/08 14:57:39	1.11
--- prj-tree.ads	2001/11/09 18:41:35	1.12
***************
*** 516,522 ****
           --  First package declaration in a project
  
           Pkg_Id           : Package_Node_Id := Empty_Package;
!          --  Only use in Package_Declaration
  
           Name             : Name_Id         := No_Name;
           --  See below for what Project_Node_Kind it is used
--- 516,528 ----
           --  First package declaration in a project
  
           Pkg_Id           : Package_Node_Id := Empty_Package;
!          --  Only used for N_Package_Declaration
!          --  The component Pkg_Id is an entry into the table Package_Attributes
!          --  (in Prj.Attr). It is used to indicate all the attributes of the
!          --  package with their characteristics.
!          --  The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
!          --  are built once and for all through a call (from Prj.Initialize)
!          --  to procedure Prj.Attr.Initialize. It is never modified after that.
  
           Name             : Name_Id         := No_Name;
           --  See below for what Project_Node_Kind it is used
***************
*** 537,542 ****
--- 543,549 ----
           --  See below the meaning for each Project_Node_Kind
  
           Case_Insensitive : Boolean         := False;
+          --  Significant only for N_Attribute_Declaration
           --  Indicates, for an associative array attribute, that the
           --  index is case insensitive.
  

*** g-socket.adb	2001/11/05 18:09:48	1.23
--- g-socket.adb	2001/11/09 21:36:09	1.24
***************
*** 166,177 ****
  
     --  Types needed for Datagram_Socket_Stream_Type
  
!    type Datagram_Socket_Stream_Type is new Root_Stream_Type with
!       record
!          Socket : Socket_Type;
!          To     : Sock_Addr_Type;
!          From   : Sock_Addr_Type;
!       end record;
  
     type Datagram_Socket_Stream_Access is
       access all Datagram_Socket_Stream_Type;
--- 166,176 ----
  
     --  Types needed for Datagram_Socket_Stream_Type
  
!    type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
!       Socket : Socket_Type;
!       To     : Sock_Addr_Type;
!       From   : Sock_Addr_Type;
!    end record;
  
     type Datagram_Socket_Stream_Access is
       access all Datagram_Socket_Stream_Type;
***************
*** 187,196 ****
  
     --  Types needed for Stream_Socket_Stream_Type
  
!    type Stream_Socket_Stream_Type is new Root_Stream_Type with
!       record
!          Socket : Socket_Type;
!       end record;
  
     type Stream_Socket_Stream_Access is
       access all Stream_Socket_Stream_Type;
--- 186,194 ----
  
     --  Types needed for Stream_Socket_Stream_Type
  
!    type Stream_Socket_Stream_Type is new Root_Stream_Type with record
!       Socket : Socket_Type;
!    end record;
  
     type Stream_Socket_Stream_Access is
       access all Stream_Socket_Stream_Type;

*** prj-tree.ads	2001/11/09 18:41:35	1.12
--- prj-tree.ads	2001/11/09 23:27:54	1.13
***************
*** 38,64 ****
  package Prj.Tree is
  
     Project_Nodes_Initial   : constant := 1_000;
-    --  Initial number of nodes in table Tree_Private_Part.Project_Nodes
     Project_Nodes_Increment : constant := 100;
  
     Project_Node_Low_Bound  : constant := 0;
!    Project_Node_High_Bound : constant := 099_999_999; -- In practice, infinite
  
     type Project_Node_Id is range
       Project_Node_Low_Bound .. Project_Node_High_Bound;
     --  The index of table Tree_Private_Part.Project_Nodes
  
!    Empty_Node    : constant Project_Node_Id := Project_Node_Low_Bound;
     --  Designates no node in table Project_Nodes
     First_Node_Id : constant Project_Node_Id := Project_Node_Low_Bound;
  
!    subtype Variable_Node_Id       is Project_Node_Id;
!    --  Used to designate a node whose expected kind is
     --  N_Typed_Variable_Declaration, N_Variable_Declaration or
     --  N_Variable_Reference.
     subtype Package_Declaration_Id is Project_Node_Id;
!    --  Used to designate a node whose expected kind is
!    --  N_Project_Declaration.
  
     type Project_Node_Kind is
       (N_Project,
--- 38,67 ----
  package Prj.Tree is
  
     Project_Nodes_Initial   : constant := 1_000;
     Project_Nodes_Increment : constant := 100;
+    --  Allocation parameters for initializing and extending number
+    --  of nodes in table Tree_Private_Part.Project_Nodes
  
     Project_Node_Low_Bound  : constant := 0;
!    Project_Node_High_Bound : constant := 099_999_999;
!    --  Range of values for project node id's (in practice infinite)
  
     type Project_Node_Id is range
       Project_Node_Low_Bound .. Project_Node_High_Bound;
     --  The index of table Tree_Private_Part.Project_Nodes
  
!    Empty_Node : constant Project_Node_Id := Project_Node_Low_Bound;
     --  Designates no node in table Project_Nodes
+ 
     First_Node_Id : constant Project_Node_Id := Project_Node_Low_Bound;
  
!    subtype Variable_Node_Id is Project_Node_Id;
!    --  Used to designate a node whose expected kind is one of
     --  N_Typed_Variable_Declaration, N_Variable_Declaration or
     --  N_Variable_Reference.
+ 
     subtype Package_Declaration_Id is Project_Node_Id;
!    --  Used to designate a node whose expected kind is N_Proect_Declaration
  
     type Project_Node_Kind is
       (N_Project,
***************
*** 90,96 ****
     function Default_Project_Node
       (Of_Kind       : Project_Node_Kind;
        And_Expr_Kind : Variable_Kind := Undefined)
!      return Project_Node_Id;
     --  Returns a Project_Node_Record with the specified Kind and
     --  Expr_Kind; all the other components have default nil values.
  
--- 93,99 ----
     function Default_Project_Node
       (Of_Kind       : Project_Node_Kind;
        And_Expr_Kind : Variable_Kind := Undefined)
!       return          Project_Node_Id;
     --  Returns a Project_Node_Record with the specified Kind and
     --  Expr_Kind; all the other components have default nil values.
  
***************
*** 121,127 ****
  
     function First_Variable_Of
       (Node  : Project_Node_Id)
!       return Variable_Node_Id;
     --  Only valid for N_Project or N_Package_Declaration nodes
  
     function First_Package_Of
--- 124,130 ----
  
     function First_Variable_Of
       (Node  : Project_Node_Id)
!       return  Variable_Node_Id;
     --  Only valid for N_Project or N_Package_Declaration nodes
  
     function First_Package_Of
***************
*** 499,548 ****
  
        type Project_Node_Record is record
  
!          Kind             : Project_Node_Kind;
  
!          Location         : Source_Ptr    := No_Location;
  
!          Directory        : Name_Id       := No_Name;
           --  Only for N_Project
  
!          Expr_Kind        : Variable_Kind := Undefined;
           --  See below for what Project_Node_Kind it is used
  
!          Variables        : Variable_Node_Id := Empty_Node;
           --  First variable in a project or a package
  
!          Packages         : Package_Declaration_Id := Empty_Node;
           --  First package declaration in a project
  
!          Pkg_Id           : Package_Node_Id := Empty_Package;
           --  Only used for N_Package_Declaration
           --  The component Pkg_Id is an entry into the table Package_Attributes
           --  (in Prj.Attr). It is used to indicate all the attributes of the
           --  package with their characteristics.
           --  The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
           --  are built once and for all through a call (from Prj.Initialize)
           --  to procedure Prj.Attr.Initialize. It is never modified after that.
  
!          Name             : Name_Id         := No_Name;
           --  See below for what Project_Node_Kind it is used
  
!          Path_Name        : Name_Id         := No_Name;
           --  See below for what Project_Node_Kind it is used
  
!          Value            : String_Id       := No_String;
           --  See below for what Project_Node_Kind it is used
  
!          Field1           : Project_Node_Id := Empty_Node;
           --  See below the meaning for each Project_Node_Kind
  
!          Field2           : Project_Node_Id := Empty_Node;
           --  See below the meaning for each Project_Node_Kind
  
!          Field3           : Project_Node_Id := Empty_Node;
           --  See below the meaning for each Project_Node_Kind
  
!          Case_Insensitive : Boolean         := False;
           --  Significant only for N_Attribute_Declaration
           --  Indicates, for an associative array attribute, that the
           --  index is case insensitive.
--- 502,552 ----
  
        type Project_Node_Record is record
  
!          Kind : Project_Node_Kind;
  
!          Location : Source_Ptr := No_Location;
  
!          Directory : Name_Id       := No_Name;
           --  Only for N_Project
  
!          Expr_Kind : Variable_Kind := Undefined;
           --  See below for what Project_Node_Kind it is used
  
!          Variables : Variable_Node_Id := Empty_Node;
           --  First variable in a project or a package
  
!          Packages : Package_Declaration_Id := Empty_Node;
           --  First package declaration in a project
  
!          Pkg_Id : Package_Node_Id := Empty_Package;
           --  Only used for N_Package_Declaration
           --  The component Pkg_Id is an entry into the table Package_Attributes
           --  (in Prj.Attr). It is used to indicate all the attributes of the
           --  package with their characteristics.
+          --
           --  The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
           --  are built once and for all through a call (from Prj.Initialize)
           --  to procedure Prj.Attr.Initialize. It is never modified after that.
  
!          Name : Name_Id := No_Name;
           --  See below for what Project_Node_Kind it is used
  
!          Path_Name : Name_Id := No_Name;
           --  See below for what Project_Node_Kind it is used
  
!          Value : String_Id := No_String;
           --  See below for what Project_Node_Kind it is used
  
!          Field1 : Project_Node_Id := Empty_Node;
           --  See below the meaning for each Project_Node_Kind
  
!          Field2 : Project_Node_Id := Empty_Node;
           --  See below the meaning for each Project_Node_Kind
  
!          Field3 : Project_Node_Id := Empty_Node;
           --  See below the meaning for each Project_Node_Kind
  
!          Case_Insensitive : Boolean := False;
           --  Significant only for N_Attribute_Declaration
           --  Indicates, for an associative array attribute, that the
           --  index is case insensitive.
***************
*** 733,742 ****
        --  from project files.
  
        type Project_Name_And_Node is record
!          Name     : Name_Id;
           --  Name of the project
!          Node     : Project_Node_Id;
           --  Node of the project in table Project_Nodes
           Modified : Boolean;
           --  True when the project is being modified by another project
        end record;
--- 737,748 ----
        --  from project files.
  
        type Project_Name_And_Node is record
!          Name : Name_Id;
           --  Name of the project
! 
!          Node : Project_Node_Id;
           --  Node of the project in table Project_Nodes
+ 
           Modified : Boolean;
           --  True when the project is being modified by another project
        end record;


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]