committed: Ada updates

Arnaud Charlet charlet@ACT-Europe.FR
Thu Nov 20 10:28:00 GMT 2003


Various Ada 0Y docs
Project file improvements
Incorporate FreeBSD configuration

Tested on x86-linux

--
2003-11-19  Arnaud Charlet  <charlet@act-europe.fr>

	* gnatmem.adb: Clean up verbose output.

	* gprcmd.adb: Change copyright to FSF.

2003-11-19  Vincent Celier  <celier@gnat.com>

	* symbols.adb: (Initialize): New parameters Reference, Symbol_Policy
	and Version (ignored).

	* symbols.ads: (Policy): New type
	(Initialize): New parameter Reference, Symbol_Policy and
	Library_Version.
	Remove parameter Force.
	Minor reformatting.

	* snames.ads, snames.adb: New standard names
	Library_Reference_Symbol_File and Library_Symbol_Policy

	* mlib-prj.adb: 
	(Build_Library): Call Build_Dinamic_Library with the Symbol_Data of the
	project.

	* mlib-tgt.adb: 
	(Build_Dynamic_Library): New parameter Symbol_Data (ignored)

	* mlib-tgt.ads: (Build_Dynamic_Library): New parameter Symbol_Data

	* prj.adb: (Project_Empty): New component Symbol_Data

	* prj.ads: (Policy, Symbol_Record): New types
	(Project_Data): New component Symbol_Data

	* prj-attr.adb: 
	New attributes Library_Symbol_File, Library_Symbol_Policy and
	Library_Reference_Symbol_File.

	* prj-nmsc.adb: 
	(Ada_Check): When project is a Stand-Alone library project, process
	attribute Library_Symbol_File, Library_Symbol_Policy and
	Library_Reference_Symbol_File.

	* 5aml-tgt.adb, 5bml-tgt.adb, 5gml-tgt.adb, 5hml-tgt.adb,
	5wml-tgt.adb, 5zml-tgt.adb, 5lml-tgt.adb,
	5sml-tgt.adb (Build_Dynamic_Library): New parameter
	Symbol_Data (ignored).

	* 5vml-tgt.adb (VMS_Options): Remove --for-linker=gsmatch=equal,1,0
	(Build_Dynamic_Library): New parameter Symbol_Data. New internal
	functions Option_File_Name and Version_String. Set new options of
	gnatsym related to symbol file, symbol policy and reference symbol
	file.

	* 5vsymbol.adb: 
	Extensive modifications to take into account the reference symbol file,
	the symbol policy, the library version and to put in the symbol file the
	minor and major IDs.

	* bld.adb (Process_Declarative_Items): Put second argument of
	gprcmd to_absolute between single quotes, to avoid problems with
	Windows.

	* bld-io.adb: Update Copyright notice.
	(Flush): Remove last character of a line, if it is a back slash, to
	avoid make problems.

	* gnatsym.adb: 
	Implement new scheme with reference symbol file and symbol policy.

	* g-os_lib.ads: (Is_Directory): Clarify comment

2003-11-19  Robert Dewar  <dewar@gnat.com>

	* atree.adb: Move New_Copy_Tree global variables to head of package

	* errout.adb: Minor reformatting

2003-11-19  Javier Miranda  <miranda@gnat.com>

	* sem_ch4.adb: (Diagnose_Call): Improve error message.
	Add reference to Ada0Y (AI-50217)

	* sem_ch6.adb, sem_ch8.adb, sem_type.adb,
	sem_util.adb: Add reference to AI-50217

	* sinfo.ads: (N_With_Clause): Document fields referred to AI-50217

	* sprint.adb: Add reference to Ada0Y (AI-50217, AI-287)

	* sem_aggr.adb: Complete documentation of AI-287 changes

	* par-ch4.adb: Document previous changes.

	* lib-load.adb, lib-writ.adb, einfo.ads, par-ch10.adb,
	sem_cat.adb, sem_ch3.adb, sem_ch10.adb, sem_ch12.adb: Add references to
	Ada0Y (AI-50217)

	* exp_aggr.adb: Add references to AI-287 in previous changes

2003-11-19  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb: 
	(Add_Call_By_Copy_Node): Do not original node of rewritten expression
	in the rewriting is the result of an inlined call.

	* exp_ch6.adb (Add_Call_By_Copy_Node): If actual for (in-)out
	parameter is a type conversion, use original node to construct the
	post-call assignment, because expression may have been rewritten, e.g.
	if it is a packed array.

	* sem_attr.adb: 
	(Resolve_Attribute, case 'Constrained): Attribute is legal in an inlined
	body, just as it is in an instance.
	Categorization routines

	* sem_ch12.adb (Analyze_Association, Instantiate_Formal_Subprogram,
	Instantiate_Object): Set proper sloc reference for message on missing
	actual.

2003-11-19  Thomas Quinot  <quinot@act-europe.fr>

	* Makefile.in: Add FreeBSD libgnat pairs.

	* usage.adb: Fix typo in usage message.

2003-11-19  Jerome Guitton  <guitton@act-europe.fr>

	* Makefile.in: On powerpc-wrs-vxworksae: Add s-thread.ad?,
	s-thrini.ad? and s-tiitho.adb to the full runtime, to support the
	pragma Thread_Body.
	Remove i-vthrea.ad? and s-tpae65.ad?, not needed anymore.

	* s-thread.adb: This file is now a dummy implementation of
	System.Thread.

2003-11-19  Sergey Rybin  <rybin@act-europe.fr>

	* rtsfind.adb (Initialize): Add initialization for RTE_Is_Available

2003-11-19  Emmanuel Briot  <briot@act-europe.fr>

	* xref_lib.adb (Parse_Identifier_Info): Add handling of generic
	instanciation references in the parent type description.
--
Index: 5aml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5aml-tgt.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5aml-tgt.adb
--- 5aml-tgt.adb	21 Oct 2003 13:41:51 -0000	1.1
+++ 5aml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -108,6 +108,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -117,6 +118,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Relocatable);
 
Index: 5bml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5bml-tgt.adb,v
retrieving revision 1.2
diff -u -p -r1.2 5bml-tgt.adb
--- 5bml-tgt.adb	14 Nov 2003 10:24:42 -0000	1.2
+++ 5bml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -120,6 +120,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -129,6 +130,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Lib_Version);
       pragma Unreferenced (Relocatable);
Index: 5gml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5gml-tgt.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5gml-tgt.adb
--- 5gml-tgt.adb	21 Oct 2003 13:41:51 -0000	1.1
+++ 5gml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -103,6 +103,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -112,6 +113,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Relocatable);
 
Index: 5hml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5hml-tgt.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5hml-tgt.adb
--- 5hml-tgt.adb	21 Oct 2003 13:41:52 -0000	1.1
+++ 5hml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -102,6 +102,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -111,6 +112,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Relocatable);
 
Index: 5lml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5lml-tgt.adb,v
retrieving revision 1.5
diff -u -p -r1.5 5lml-tgt.adb
--- 5lml-tgt.adb	21 Oct 2003 13:41:52 -0000	1.5
+++ 5lml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -106,6 +106,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -115,6 +116,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Relocatable);
 
Index: 5sml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5sml-tgt.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5sml-tgt.adb
--- 5sml-tgt.adb	21 Oct 2003 13:41:52 -0000	1.1
+++ 5sml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -100,6 +100,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -109,6 +110,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Relocatable);
 
Index: 5vml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5vml-tgt.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5vml-tgt.adb
--- 5vml-tgt.adb	21 Oct 2003 13:41:52 -0000	1.1
+++ 5vml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -59,13 +59,9 @@ package body MLib.Tgt is
    --  Options to use when invoking gcc to build the dynamic library
 
    No_Start_Files : aliased String := "-nostartfiles";
-   For_Linker_Opt : aliased String := "--for-linker=symvec.opt";
-   Gsmatch        : aliased String := "--for-linker=gsmatch=equal,1,0";
 
-   VMS_Options : constant Argument_List :=
-     (No_Start_Files'Access, For_Linker_Opt'Access, Gsmatch'Access);
-
---   Command : String_Access;
+   VMS_Options : Argument_List :=
+     (No_Start_Files'Access, null);
 
    Gnatsym_Name : constant String := "gnatsym";
 
@@ -134,6 +130,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -143,10 +140,9 @@ package body MLib.Tgt is
       pragma Unreferenced (Foreign);
       pragma Unreferenced (Afiles);
       pragma Unreferenced (Lib_Address);
-      pragma Unreferenced (Lib_Version);
       pragma Unreferenced (Relocatable);
 
-      Opt_File_Name : constant String := "symvec.opt";
+
 
       Lib_File : constant String :=
                    Lib_Dir & Directory_Separator & "lib" &
@@ -163,6 +159,13 @@ package body MLib.Tgt is
       --  file name of an interface of the SAL.
       --  For other libraries, always return True.
 
+      function Option_File_Name return String;
+      --  Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
+
+      function Version_String return String;
+      --  Returns Lib_Version if not empty, otherwise returns "1".
+      --  Fails gnatmake if Lib_Version is not the image of a positive number.
+
       ------------------
       -- Is_Interface --
       ------------------
@@ -192,7 +195,57 @@ package body MLib.Tgt is
          end if;
       end Is_Interface;
 
+      ----------------------
+      -- Option_File_Name --
+      ----------------------
+
+      function Option_File_Name return String is
+      begin
+         if Symbol_Data.Symbol_File = No_Name then
+            return "symvec.opt";
+
+         else
+            return Get_Name_String (Symbol_Data.Symbol_File);
+         end if;
+      end Option_File_Name;
+
+      --------------------
+      -- Version_String --
+      --------------------
+
+      function Version_String return String is
+         Version : Integer := 0;
+      begin
+         if Lib_Version = "" then
+            return "1";
+
+         else
+            begin
+               Version := Integer'Value (Lib_Version);
+
+               if Version <= 0 then
+                  raise Constraint_Error;
+               end if;
+
+               return Lib_Version;
+
+            exception
+               when Constraint_Error =>
+                  Fail ("illegal version """, Lib_Version,
+                        """ (on VMS version must be a positive number)");
+                  return "";
+            end;
+         end if;
+      end Version_String;
+
+      Opt_File_Name  : constant String := Option_File_Name;
+      For_Linker_Opt : constant String_Access :=
+                         new String'("--for-linker=" & Opt_File_Name);
+      Version : constant String := Version_String;
+
    begin
+      VMS_Options (VMS_Options'First + 1) := For_Linker_Opt;
+
       for J in Inter'Range loop
          To_Lower (Inter (J).all);
       end loop;
@@ -288,18 +341,60 @@ package body MLib.Tgt is
          end;
       end if;
 
-      --  Allocate the argument list and put the symbol file name
+      --  Allocate the argument list and put the symbol file name, the
+      --  reference (if any) and the policy (if not autonomous).
 
-      Arguments := new Argument_List (1 .. Ofiles'Length + 2);
+      Arguments := new Argument_List (1 .. Ofiles'Length + 8);
 
-      Last_Argument := 1;
+      Last_Argument := 0;
+
+      --  Verbosity
 
       if Verbose_Mode then
+         Last_Argument := Last_Argument + 1;
          Arguments (Last_Argument) := new String'("-v");
+      end if;
+
+      --  Version number (major ID)
+
+      if Lib_Version /= "" then
          Last_Argument := Last_Argument + 1;
+         Arguments (Last_Argument) := new String'("-V");
+         Last_Argument := Last_Argument + 1;
+         Arguments (Last_Argument) := new String'(Version);
       end if;
 
+      --  Symbol file
+
+      Last_Argument := Last_Argument + 1;
+      Arguments (Last_Argument) := new String'("-s");
+      Last_Argument := Last_Argument + 1;
       Arguments (Last_Argument) := new String'(Opt_File_Name);
+
+      --  Reference Symbol File
+
+      if Symbol_Data.Reference /= No_Name then
+         Last_Argument := Last_Argument + 1;
+         Arguments (Last_Argument) := new String'("-r");
+         Last_Argument := Last_Argument + 1;
+         Arguments (Last_Argument) :=
+           new String'(Get_Name_String (Symbol_Data.Reference));
+      end if;
+
+      --  Policy
+
+      case Symbol_Data.Symbol_Policy is
+         when Autonomous =>
+            null;
+
+         when Compliant =>
+            Last_Argument := Last_Argument + 1;
+            Arguments (Last_Argument) := new String'("-c");
+
+         when Controlled =>
+            Last_Argument := Last_Argument + 1;
+            Arguments (Last_Argument) := new String'("-C");
+      end case;
 
       --  Add each relevant object file
 
Index: 5vsymbol.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5vsymbol.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5vsymbol.adb
--- 5vsymbol.adb	21 Oct 2003 13:41:52 -0000	1.1
+++ 5vsymbol.adb	20 Nov 2003 09:48:28 -0000
@@ -36,10 +36,32 @@ package body Symbols is
    Symbol_Vector   : constant String := "SYMBOL_VECTOR=(";
    Equal_Data      : constant String := "=DATA)";
    Equal_Procedure : constant String := "=PROCEDURE)";
+   Gsmatch         : constant String := "gsmatch=equal,";
 
    Symbol_File_Name : String_Access := null;
    --  Name of the symbol file
 
+   Sym_Policy : Policy := Autonomous;
+   --  The symbol policy. Set by Initialize
+
+   Major_ID : Integer := 1;
+   --  The Major ID. May be modified by Initialize if Library_Version is
+   --  specified or if it is read from the reference symbol file.
+
+   Soft_Major_ID : Boolean := True;
+   --  False if library version is specified in procedure Initialize.
+   --  When True, Major_ID may be modified if found in the reference symbol
+   --  file.
+
+   Minor_ID : Natural := 0;
+   --  The Minor ID. May be modified if read from the reference symbol file
+
+   Soft_Minor_ID : Boolean := True;
+   --  False if symbol policy is Autonomous, if library version is specified
+   --  in procedure Initialize and is not the same as the major ID read from
+   --  the reference symbol file. When True, Minor_ID may be increased in
+   --  Compliant symbol policy.
+
    subtype Byte is Character;
    --  Object files are stream of bytes, but some of these bytes, those for
    --  the names of the symbols, are ASCII characters.
@@ -67,6 +89,9 @@ package body Symbols is
    Number_Of_Characters : Natural := 0;
    --  The number of characters of each section
 
+   --  The following variables are used by procedure Process when reading an
+   --  object file.
+
    Code   : Number := 0;
    Length : Natural := 0;
 
@@ -87,6 +112,10 @@ package body Symbols is
    procedure Get (N : out Natural);
    --  Read two bytes from the object file, LSByte first, as a Natural
 
+
+   function Image (N : Integer) return String;
+   --  Returns the image of N, without the initial space
+
    -----------
    -- Equal --
    -----------
@@ -121,15 +150,32 @@ package body Symbols is
       N := Natural (Result);
    end Get;
 
+   -----------
+   -- Image --
+   -----------
+
+   function Image (N : Integer) return String is
+      Result : constant String := N'Img;
+   begin
+      if Result (Result'First) = ' ' then
+         return Result (Result'First + 1 .. Result'Last);
+
+      else
+         return Result;
+      end if;
+   end Image;
+
    ----------------
    -- Initialize --
    ----------------
 
    procedure Initialize
-     (Symbol_File : String;
-      Force       : Boolean;
-      Quiet       : Boolean;
-      Success     : out Boolean)
+     (Symbol_File   : String;
+      Reference     : String;
+      Symbol_Policy : Policy;
+      Quiet         : Boolean;
+      Version       : String;
+      Success       : out Boolean)
    is
       File : Ada.Text_IO.File_Type;
       Line : String (1 .. 1_000);
@@ -140,6 +186,40 @@ package body Symbols is
 
       Symbol_File_Name := new String'(Symbol_File);
 
+      --  Record the policy
+
+      Sym_Policy := Symbol_Policy;
+
+      --  Record the version (Major ID)
+
+      if Version = "" then
+         Major_ID := 1;
+         Soft_Major_ID := True;
+
+      else
+         begin
+            Major_ID := Integer'Value (Version);
+            Soft_Major_ID := False;
+
+            if Major_ID <= 0 then
+               raise Constraint_Error;
+            end if;
+
+         exception
+            when Constraint_Error =>
+               if not Quiet then
+                  Put_Line ("Version """ & Version & """ is illegal.");
+                  Put_Line ("On VMS, version must be a positive number");
+               end if;
+
+               Success := False;
+               return;
+         end;
+      end if;
+
+      Minor_ID := 0;
+      Soft_Minor_ID := Sym_Policy /= Autonomous;
+
       --  Empty the symbol tables
 
       Symbol_Table.Set_Last (Original_Symbols, 0);
@@ -149,11 +229,11 @@ package body Symbols is
 
       Success := True;
 
-      --  If Force is not set, attempt to read the symbol file
+      --  If policy is not autonomous, attempt to read the reference file
 
-      if not Force then
+      if Sym_Policy /= Autonomous then
          begin
-            Open (File, In_File, Symbol_File);
+            Open (File, In_File, Reference);
 
          exception
             when Ada.Text_IO.Name_Error =>
@@ -161,7 +241,7 @@ package body Symbols is
 
             when X : others =>
                if not Quiet then
-                  Put_Line ("could not open """ & Symbol_File & """");
+                  Put_Line ("could not open """ & Reference & """");
                   Put_Line (Exception_Message (X));
                end if;
 
@@ -169,20 +249,31 @@ package body Symbols is
                return;
          end;
 
+         --  Read line by line
+
          while not End_Of_File (File) loop
             Get_Line (File, Line, Last);
 
+            --  Ignore empty lines
+
             if Last = 0 then
                null;
 
+            --  Ignore lines starting with "case_sensitive="
+
             elsif Last > Case_Sensitive'Length
               and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
             then
                null;
 
+            --  Line starting with "SYMBOL_VECTOR=("
+
             elsif Last > Symbol_Vector'Length
               and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
             then
+
+               --  SYMBOL_VECTOR=(<symbol>=DATA)
+
                if Last > Symbol_Vector'Length + Equal_Data'Length and then
                  Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
                then
@@ -195,6 +286,8 @@ package body Symbols is
                        Kind => Data,
                        Present => True);
 
+               --  SYMBOL_VECTOR=(<symbol>=PROCEDURE)
+
                elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
                  and then
                   Line (Last - Equal_Procedure'Length + 1 .. Last) =
@@ -209,9 +302,11 @@ package body Symbols is
                      Kind => Proc,
                      Present => True);
 
+               --  Anything else is incorrectly formatted
+
                else
                   if not Quiet then
-                     Put_Line ("symbol file """ & Symbol_File &
+                     Put_Line ("symbol file """ & Reference &
                                """ is incorrectly formatted:");
                      Put_Line ("""" & Line (1 .. Last) & """");
                   end if;
@@ -221,10 +316,95 @@ package body Symbols is
                   return;
                end if;
 
+            --  Lines with "gsmatch=equal,<Major_ID>,<Minor_Id>
+
+            elsif Last > Gsmatch'Length
+              and then Line (1 .. Gsmatch'Length) = Gsmatch
+            then
+               declare
+                  Start  : Positive := Gsmatch'Length + 1;
+                  Finish : Positive := Start;
+                  OK     : Boolean  := True;
+                  ID     : Integer;
+
+               begin
+                  loop
+                     if Line (Finish) not in '0' .. '9'
+                       or else Finish >= Last - 1
+                     then
+                        OK := False;
+                        exit;
+                     end if;
+
+                     exit when Line (Finish + 1) = ',';
+
+                     Finish := Finish + 1;
+                  end loop;
+
+                  if OK then
+                     ID := Integer'Value (Line (Start .. Finish));
+                     OK := ID /= 0;
+
+                     --  If Soft_Major_ID is True, it means that
+                     --  Library_Version was not specified.
+
+                     if Soft_Major_ID then
+                        Major_ID := ID;
+
+                     --  If the Major ID in the reference file is different
+                     --  from the Library_Version, then the Minor ID will be 0
+                     --  because there is no point in taking the Minor ID in
+                     --  the reference file, or incrementing it. So, we set
+                     --  Soft_Minor_ID to False, so that we don't modify
+                     --  the Minor_ID later.
+
+                     elsif Major_ID /= ID then
+                        Soft_Minor_ID := False;
+                     end if;
+
+                     Start := Finish + 2;
+                     Finish := Start;
+
+                     loop
+                        if Line (Finish) not in '0' .. '9' then
+                           OK := False;
+                           exit;
+                        end if;
+
+                        exit when Finish = Last;
+
+                        Finish := Finish + 1;
+                     end loop;
+
+                     --  Only set Minor_ID if Soft_Minor_ID is True (see above)
+
+                     if OK and then Soft_Minor_ID then
+                        Minor_ID := Integer'Value (Line (Start .. Finish));
+                     end if;
+                  end if;
+
+                  --  If OK is not True, that means the line is not correctly
+                  --  formatted.
+
+                  if not OK then
+                     if not Quiet then
+                        Put_Line ("symbol file """ & Reference &
+                                  """ is incorrectly formatted");
+                        Put_Line ("""" & Line (1 .. Last) & """");
+                     end if;
+
+                     Close (File);
+                     Success := False;
+                     return;
+                  end if;
+               end;
+
+            --  Anything else is incorrectly formatted
+
             else
                if not Quiet then
                   Put_Line ("unexpected line in symbol file """ &
-                            Symbol_File & """");
+                            Reference & """");
                   Put_Line ("""" & Line (1 .. Last) & """");
                end if;
 
@@ -247,7 +427,8 @@ package body Symbols is
       Success     : out Boolean)
    is
    begin
-      --  Open the object file. Return with Success = False if this fails.
+      --  Open the object file with Byte_IO. Return with Success = False if
+      --  this fails.
 
       begin
          Open (File, In_File, Object_File);
@@ -410,8 +591,9 @@ package body Symbols is
 
       else
 
-         --  First find if the symbols in the symbol file are also in the
-         --  object files.
+         --  First find if the symbols in the reference symbol file are also
+         --  in the object files. Note that this is not done if the policy is
+         --  Autonomous, because no reference symbol file has been read.
 
          --  Expect the first symbol in the symbol file to also be the first
          --  in Complete_Symbols.
@@ -450,13 +632,27 @@ package body Symbols is
             --  If the symbol is not found, mark it as such in the table
 
             if not Found then
-               if not Quiet then
+               if (not Quiet) or else Sym_Policy = Controlled then
                   Put_Line ("symbol """ & S_Data.Name.all &
                             """ is no longer present in the object files");
                end if;
 
+               if Sym_Policy = Controlled then
+                  Success := False;
+                  return;
+
+               elsif Soft_Minor_ID then
+                  Minor_ID := Minor_ID + 1;
+                  Soft_Minor_ID := False;
+               end if;
+
                Original_Symbols.Table (Index_1).Present := False;
                Free (Original_Symbols.Table (Index_1).Name);
+
+               if Soft_Minor_ID then
+                  Minor_ID := Minor_ID + 1;
+                  Soft_Minor_ID := False;
+               end if;
             end if;
          end loop;
 
@@ -466,6 +662,18 @@ package body Symbols is
             S_Data := Complete_Symbols.Table (Index);
 
             if S_Data.Present then
+
+               if Sym_Policy = Controlled then
+                  Put_Line ("symbol """ & S_Data.Name.all &
+                            """ is not in the reference symbol file");
+                  Success := False;
+                  return;
+
+               elsif Soft_Minor_ID then
+                  Minor_ID := Minor_ID + 1;
+                  Soft_Minor_ID := False;
+               end if;
+
                Symbol_Table.Increment_Last (Original_Symbols);
                Original_Symbols.Table (Symbol_Table.Last (Original_Symbols)) :=
                  S_Data;
@@ -500,6 +708,13 @@ package body Symbols is
 
          Put (File, Case_Sensitive);
          Put_Line (File, "NO");
+
+         --  Put the version IDs
+
+         Put (File, Gsmatch);
+         Put (File, Image (Major_ID));
+         Put (File, ',');
+         Put_Line  (File, Image (Minor_ID));
 
          --  And we are done
 
Index: 5wml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5wml-tgt.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5wml-tgt.adb
--- 5wml-tgt.adb	21 Oct 2003 13:41:52 -0000	1.1
+++ 5wml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -91,6 +91,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -99,6 +100,7 @@ package body MLib.Tgt is
    is
       pragma Unreferenced (Ofiles);
       pragma Unreferenced (Interfaces);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Driver_Name);
       pragma Unreferenced (Lib_Version);
       pragma Unreferenced (Auto_Init);
Index: 5zml-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/5zml-tgt.adb,v
retrieving revision 1.1
diff -u -p -r1.1 5zml-tgt.adb
--- 5zml-tgt.adb	21 Oct 2003 13:41:52 -0000	1.1
+++ 5zml-tgt.adb	20 Nov 2003 09:48:28 -0000
@@ -93,6 +93,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -106,6 +107,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Interfaces);
       pragma Unreferenced (Lib_Filename);
       pragma Unreferenced (Lib_Dir);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Driver_Name);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Lib_Version);
Index: atree.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/atree.adb,v
retrieving revision 1.8
diff -u -p -r1.8 atree.adb
--- atree.adb	29 Oct 2003 10:26:12 -0000	1.8
+++ atree.adb	20 Nov 2003 09:48:28 -0000
@@ -347,6 +347,35 @@ package body Atree is
       Table_Increment      => Alloc.Orig_Nodes_Increment,
       Table_Name           => "Orig_Nodes");
 
+   ----------------------------------------
+   -- Global_Variables for New_Copy_Tree --
+   ----------------------------------------
+
+   --  These global variables are used by New_Copy_Tree. See description
+   --  of the body of this subprogram for details. Global variables can be
+   --  safely used by New_Copy_Tree, since there is no case of a recursive
+   --  call from the processing inside New_Copy_Tree.
+
+   NCT_Hash_Threshhold : constant := 20;
+   --  If there are more than this number of pairs of entries in the
+   --  map, then Hash_Tables_Used will be set, and the hash tables will
+   --  be initialized and used for the searches.
+
+   NCT_Hash_Tables_Used : Boolean := False;
+   --  Set to True if hash tables are in use
+
+   NCT_Table_Entries : Nat;
+   --  Count entries in table to see if threshhold is reached
+
+   NCT_Hash_Table_Setup : Boolean := False;
+   --  Set to True if hash table contains data. We set this True if we
+   --  setup the hash table with data, and leave it set permanently
+   --  from then on, this is a signal that second and subsequent users
+   --  of the hash table must clear the old entries before reuse.
+
+   subtype NCT_Header_Num is Int range 0 .. 511;
+   --  Defines range of headers in hash tables (512 headers)
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -958,29 +987,6 @@ package body Atree is
    --  there are fewer entries, then the map is searched sequentially
    --  (because setting up a hash table for only a few entries takes
    --  more time than it saves.
-
-   --  Global variables are safe for this purpose, since there is no case
-   --  of a recursive call from the processing inside New_Copy_Tree.
-
-   NCT_Hash_Threshhold : constant := 20;
-   --  If there are more than this number of pairs of entries in the
-   --  map, then Hash_Tables_Used will be set, and the hash tables will
-   --  be initialized and used for the searches.
-
-   NCT_Hash_Tables_Used : Boolean := False;
-   --  Set to True if hash tables are in use
-
-   NCT_Table_Entries : Nat;
-   --  Count entries in table to see if threshhold is reached
-
-   NCT_Hash_Table_Setup : Boolean := False;
-   --  Set to True if hash table contains data. We set this True if we
-   --  setup the hash table with data, and leave it set permanently
-   --  from then on, this is a signal that second and subsequent users
-   --  of the hash table must clear the old entries before reuse.
-
-   subtype NCT_Header_Num is Int range 0 .. 511;
-   --  Defines range of headers in hash tables (512 headers)
 
    function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
    --  Hash function used for hash operations
Index: bld.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/bld.adb,v
retrieving revision 1.2
diff -u -p -r1.2 bld.adb
--- bld.adb	10 Nov 2003 17:29:58 -0000	1.2
+++ bld.adb	20 Nov 2003 09:48:28 -0000
@@ -40,7 +40,7 @@ with GNAT.OS_Lib;               use GNAT
 
 with Erroutc;  use Erroutc;
 with Err_Vars; use Err_Vars;
-with Gnatvsn;
+with Gnatvsn;  use Gnatvsn;
 with Namet;    use Namet;
 with Opt;      use Opt;
 with Output;   use Output;
@@ -1559,9 +1559,9 @@ package body Bld is
                            Put ("src.list_file:=" &
                                 "$(strip $(shell gprcmd to_absolute $(");
                            Put (Project_Name);
-                           Put (".base_dir) $(");
+                           Put (".base_dir) '$(");
                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
-                           Put_Line (")))");
+                           Put_Line (")'))");
 
                            if In_Case then
                               if Source_List_File_Declaration = False then
@@ -1595,9 +1595,9 @@ package body Bld is
                            Put (".obj_dir:=" &
                                 "$(strip $(shell gprcmd to_absolute $(");
                            Put (Project_Name);
-                           Put (".base_dir) $(");
+                           Put (".base_dir) '$(");
                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
-                           Put_Line (")))");
+                           Put_Line (")'))");
 
                         elsif Item_Name = Snames.Name_Exec_Dir then
 
@@ -1611,9 +1611,9 @@ package body Bld is
                            Put ("EXEC_DIR:=" &
                                 "$(strip $(shell gprcmd to_absolute $(");
                            Put (Project_Name);
-                           Put (".base_dir) $(");
+                           Put (".base_dir) '$(");
                            Put_Attribute (Project, Pkg, Item_Name, No_Name);
-                           Put_Line (")))");
+                           Put_Line (")'))");
 
                         elsif Item_Name = Snames.Name_Main then
 
Index: bld-io.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/bld-io.adb,v
retrieving revision 1.1
diff -u -p -r1.1 bld-io.adb
--- bld-io.adb	21 Oct 2003 13:41:58 -0000	1.1
+++ bld-io.adb	20 Nov 2003 09:48:28 -0000
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---        Copyright (C) 2002 Free Software Foundation, Inc.                 --
+--        Copyright (C) 2002-2003 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- --
@@ -132,6 +132,7 @@ package body Bld.IO is
    -----------
 
    procedure Flush is
+      Last : Natural;
    begin
       if Lines (Current).Length /= 0 then
          Osint.Fail ("INTERNAL ERROR: flushing before end of line: """ &
@@ -141,7 +142,18 @@ package body Bld.IO is
 
       for J in 1 .. Current - 1 loop
          if not Lines (J).Suppressed then
-            Text_IO.Put_Line (File, Lines (J).Value (1 .. Lines (J).Length));
+            Last := Lines (J).Length;
+
+            --  The last character of a line cannot be a back slash ('\'),
+            --  otherwise make has a problem. The only real place were it
+            --  should happen is for directory names on Windows, and then
+            --  this terminal back slash is not needed.
+
+            if Last > 0 and then Lines (J).Value (Last) = '\' then
+               Last := Last - 1;
+            end if;
+
+            Text_IO.Put_Line (File, Lines (J).Value (1 .. Last));
          end if;
       end loop;
 
Index: einfo.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/einfo.ads,v
retrieving revision 1.16
diff -u -p -r1.16 einfo.ads
--- einfo.ads	17 Nov 2003 14:58:14 -0000	1.16
+++ einfo.ads	20 Nov 2003 09:48:29 -0000
@@ -1162,6 +1162,9 @@ package Einfo is
 --       types, i.e. record types (Java classes) that hold pointers to each
 --       other. If such a type is an access type, it has no explicit freeze
 --       node, so that the back-end does not attempt to elaborate it.
+--       Currently this flag is also used to implement Ada0Y (AI-50217).
+--       It will be renamed to From_Limited_With after removal of the current
+--       GNAT with_type clause???
 
 --    Full_View (Node11)
 --       Present in all type and subtype entities and in deferred constants.
@@ -2385,7 +2388,7 @@ package Einfo is
 --       Present in non-generic package entities that are not instances.
 --       The elements of this list are the shadow entities created for the
 --       types and local packages that are declared in a package that appears
---       in a limited_with clause.
+--       in a limited_with clause (Ada0Y: AI-50217)
 
 --    Lit_Indexes (Node15)
 --       Present in enumeration types and subtypes. Non-empty only for the
@@ -2554,9 +2557,9 @@ package Einfo is
 --       is other than a power of 2.
 
 --    Non_Limited_View (Node17)
---       Present in incomplete types that are the shadow entities
---       created when analyzing a limited_with_clause. Points to the
---       definining entity in the original declaration.
+--       Present in incomplete types that are the shadow entities created
+--       when analyzing a limited_with_clause (Ada0Y: AI-50217). Points to
+--       the defining entity in the original declaration.
 
 --    Nonzero_Is_True (Flag162) [base type only]
 --       Present in enumeration types. True if any non-zero value is to be
Index: errout.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/errout.adb,v
retrieving revision 1.11
diff -u -p -r1.11 errout.adb
--- errout.adb	17 Nov 2003 14:58:14 -0000	1.11
+++ errout.adb	20 Nov 2003 09:48:29 -0000
@@ -1409,11 +1409,11 @@ package body Errout is
          Warnings.Table (Warnings.Last).Stop  := Source_Ptr'Last;
       end if;
 
-      --  Set all (???) the error nodes to Empty:
+      --  Set the error nodes to Empty to avoid uninitialized variable
+      --  references for saves/restores/moves.
 
       Error_Msg_Node_1 := Empty;
       Error_Msg_Node_2 := Empty;
-
    end Initialize;
 
    -----------------
Index: exp_aggr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_aggr.adb,v
retrieving revision 1.9
diff -u -p -r1.9 exp_aggr.adb
--- exp_aggr.adb	17 Nov 2003 14:58:14 -0000	1.9
+++ exp_aggr.adb	20 Nov 2003 09:48:29 -0000
@@ -71,8 +71,8 @@ package body Exp_Aggr is
    --  sorted order.
 
    function Has_Default_Init_Comps (N : Node_Id) return Boolean;
-   --  N is an aggregate (record or array). Checks the presence of
-   --  default initialization (<>) in any component.
+   --  N is an aggregate (record or array). Checks the presence of default
+   --  initialization (<>) in any component (Ada0Y: AI-287)
 
    ------------------------------------------------------
    -- Local subprograms for Record Aggregate Expansion --
@@ -1540,8 +1540,8 @@ package body Exp_Aggr is
              Selector_Name => Make_Identifier (Loc, Name_uController));
          Set_Assignment_OK (Ref);
 
-         --  Give support to default initialization of limited types and
-         --  components
+         --  Ada0Y (AI-287): Give support to default initialization of limited
+         --  types and components
 
          if (Nkind (Target) = N_Identifier
              and then Is_Limited_Type (Etype (Target)))
@@ -1678,8 +1678,8 @@ package body Exp_Aggr is
                   Check_Ancestor_Discriminants (Entity (A));
                end if;
 
-            --  If the ancestor part is a limited type, a recursive call
-            --  expands the ancestor.
+            --  Ada0Y (AI-287): If the ancestor part is a limited type, a
+            --  recursive call expands the ancestor.
 
             elsif Is_Limited_Type (Etype (A)) then
                Ancestor_Is_Expression := True;
@@ -4144,6 +4144,9 @@ package body Exp_Aggr is
         or else Has_Controlled_Component (Base_Type (Typ))
       then
          Convert_To_Assignments (N, Typ);
+
+      --  Ada0Y (AI-287): In case of default initialized components we convert
+      --  the aggregate into assignments.
 
       elsif Has_Default_Init_Comps (N) then
          Convert_To_Assignments (N, Typ);
Index: exp_ch6.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch6.adb,v
retrieving revision 1.11
diff -u -p -r1.11 exp_ch6.adb
--- exp_ch6.adb	10 Nov 2003 17:29:58 -0000	1.11
+++ exp_ch6.adb	20 Nov 2003 09:48:29 -0000
@@ -541,7 +541,28 @@ package body Exp_Ch6 is
 
          if Nkind (Actual) = N_Type_Conversion then
             V_Typ := Etype (Expression (Actual));
-            Var   := Make_Var (Expression (Actual));
+
+            --  If the formal is an (in-)out parameter, capture the name
+            --  of the variable in order to build the post-call assignment.
+            --  The variable itself may have been expanded, for example if
+            --  it is a complex bit-packed array, so we need to recover the
+            --  original to ensure that we have the proper target for the
+            --  assignment. Examine the slocs of the two nodes to determine
+            --  whether the rewriting is an expansion, or a substitution done
+            --  on an inlined body, in which case it must be respected.
+
+            declare
+               Orig : constant Node_Id := Original_Node (Expression (Actual));
+            begin
+               if Orig /= Expression (Actual)
+                 and then Sloc (Orig) = Sloc (Expression (Actual))
+               then
+                  Var := Make_Var (Orig);
+               else
+                  Var := Make_Var (Expression (Actual));
+               end if;
+            end;
+
             Crep  := not Same_Representation
                        (Etype (Formal), Etype (Expression (Actual)));
          else
Index: gnatmem.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatmem.adb,v
retrieving revision 1.9
diff -u -p -r1.9 gnatmem.adb
--- gnatmem.adb	21 Oct 2003 13:42:08 -0000	1.9
+++ gnatmem.adb	20 Nov 2003 09:48:29 -0000
@@ -228,7 +228,7 @@ procedure Gnatmem is
    procedure Usage is
    begin
       New_Line;
-      Put ("GNATMEM Pro ");
+      Put ("GNATMEM ");
       Put (Gnat_Version_String);
       Put_Line (" Copyright 1997-2003 Free Software Foundation, Inc.");
       New_Line;
Index: gnatsym.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gnatsym.adb,v
retrieving revision 1.1
diff -u -p -r1.1 gnatsym.adb
--- gnatsym.adb	21 Oct 2003 13:42:08 -0000	1.1
+++ gnatsym.adb	20 Nov 2003 09:48:29 -0000
@@ -37,7 +37,9 @@
 --  only on OpenVMS.
 
 --  gnatsym takes as parameters:
---    - the name of the symbol file to create or update
+--    - the name of the symbol file to create
+--    - (optional) the policy to create the symbol file
+--    - (optional) the name of the reference symbol file
 --    - the names of one or more object files where the symbols are found
 
 with GNAT.Command_Line; use GNAT.Command_Line;
@@ -52,13 +54,16 @@ with Table;
 
 procedure Gnatsym is
 
+   Empty_String : aliased String := "";
+   Empty : constant String_Access := Empty_String'Unchecked_Access;
+   --  To initialize variables Reference and Version_String
+
    Copyright_Displayed : Boolean := False;
    --  A flag to prevent multiple display of the Copyright notice
 
    Success : Boolean := True;
 
-   Force : Boolean := False;
-   --  True when -f switcxh is used
+   Symbol_Policy : Policy := Autonomous;
 
    Verbose : Boolean := False;
    --  True when -v switch is used
@@ -66,9 +71,15 @@ procedure Gnatsym is
    Quiet : Boolean := False;
    --  True when -q switch is used
 
-   Symbol_File_Name : String_Access;
+   Symbol_File_Name : String_Access := null;
    --  The name of the symbol file
 
+   Reference_Symbol_File_Name : String_Access := Empty;
+   --  The name of the reference symbol file
+
+   Version_String : String_Access := Empty;
+   --  The version of the library. Used on VMS.
+
    package Object_Files is new Table.Table
      (Table_Component_Type => String_Access,
       Table_Index_Type     => Natural,
@@ -113,19 +124,32 @@ procedure Gnatsym is
    procedure Parse_Cmd_Line is
    begin
       loop
-         case GNAT.Command_Line.Getopt ("f q v") is
+         case GNAT.Command_Line.Getopt ("c C q r: s: v V:") is
             when ASCII.NUL =>
                exit;
 
-            when 'f' =>
-               Force := True;
+            when 'c' =>
+               Symbol_Policy := Compliant;
+
+            when 'C' =>
+               Symbol_Policy := Controlled;
 
             when 'q' =>
                Quiet := True;
 
+            when 'r' =>
+               Reference_Symbol_File_Name :=
+                 new String'(GNAT.Command_Line.Parameter);
+
+            when 's' =>
+               Symbol_File_Name := new String'(GNAT.Command_Line.Parameter);
+
             when 'v' =>
                Verbose := True;
 
+            when 'V' =>
+               Version_String := new String'(GNAT.Command_Line.Parameter);
+
             when others =>
                Fail ("invalid switch: ", Full_Switch);
          end case;
@@ -141,13 +165,8 @@ procedure Gnatsym is
          begin
             exit when S'Length = 0;
 
-            if Symbol_File_Name = null then
-               Symbol_File_Name := S;
-
-            else
-               Object_Files.Increment_Last;
-               Object_Files.Table (Object_Files.Last) := S;
-            end if;
+            Object_Files.Increment_Last;
+            Object_Files.Table (Object_Files.Last) := S;
          end;
       end loop;
    exception
@@ -162,11 +181,17 @@ procedure Gnatsym is
 
    procedure Usage is
    begin
-      Write_Line ("gnatsym [options] sym_file object_file {object_file}");
+      Write_Line ("gnatsym [options] object_file {object_file}");
       Write_Eol;
-      Write_Line ("   -f  Force generation of symbol file");
-      Write_Line ("   -q  Quiet mode");
-      Write_Line ("   -v  Verbose mode");
+      Write_Line ("   -c       Compliant policy");
+      Write_Line ("   -C       Controlled policy");
+      Write_Line ("   -q       Quiet mode");
+      Write_Line ("   -r<ref>  Reference symbol file name");
+      Write_Line ("   -s<sym>  Symbol file name");
+      Write_Line ("   -v       Verbose mode");
+      Write_Line ("   -V<ver>  Version");
+      Write_Eol;
+      Write_Line ("Specifying a symbol file with -s<sym> is compulsory");
       Write_Eol;
    end Usage;
 
@@ -188,7 +213,7 @@ begin
    --  If there is no symbol file or no object files on the command line,
    --  display the usage and exit with an error status.
 
-   if Object_Files.Last = 0 then
+   if Symbol_File_Name = null or else Object_Files.Last = 0 then
       Usage;
       OS_Exit (1);
 
@@ -199,9 +224,16 @@ begin
          Write_Line ("""");
       end if;
 
-      --  Initialize the symbol file
+      --  Initialize the symbol file and, if specified, read the reference
+      --  file.
 
-      Symbols.Initialize (Symbol_File_Name.all, Force, Quiet, Success);
+      Symbols.Initialize
+        (Symbol_File   => Symbol_File_Name.all,
+         Reference     => Reference_Symbol_File_Name.all,
+         Symbol_Policy => Symbol_Policy,
+         Quiet         => Quiet,
+         Version       => Version_String.all,
+         Success       => Success);
 
       --  Process the object files in order. Stop as soon as there is
       --  something wrong.
@@ -231,6 +263,8 @@ begin
 
          Finalize (Quiet, Success);
       end if;
+
+      --  Fail if there was anything wrong
 
       if not Success then
          Fail ("unable to build symbol file");
Index: g-os_lib.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/g-os_lib.ads,v
retrieving revision 1.7
diff -u -p -r1.7 g-os_lib.ads
--- g-os_lib.ads	21 Oct 2003 13:42:04 -0000	1.7
+++ g-os_lib.ads	20 Nov 2003 09:48:29 -0000
@@ -416,15 +416,21 @@ pragma Elaborate_Body (OS_Lib);
 
    function Is_Absolute_Path (Name : String) return Boolean;
    --  Returns True if Name is an absolute path name, i.e. it designates
-   --  a directory absolutely, rather than relative to another directory.
+   --  a file or a directory absolutely, rather than relative to another
+   --  directory.
 
    function Is_Regular_File (Name : String) return Boolean;
    --  Determines if the given string, Name, is the name of an existing
-   --  regular file. Returns True if so, False otherwise.
+   --  regular file. Returns True if so, False otherwise. Name may be an
+   --  absolute path name or a relative path name, including a simple file
+   --  name. If it is a relative path name, it is relative to the current
+   --  working directory.
 
    function Is_Directory (Name : String) return Boolean;
    --  Determines if the given string, Name, is the name of a directory.
-   --  Returns True if so, False otherwise.
+   --  Returns True if so, False otherwise. Name may be an absolute path
+   --  name or a relative path name, including a simple file name. If it is
+   --  a relative path name, it is relative to the current working directory.
 
    function Is_Readable_File (Name : String) return Boolean;
    --  Determines if the given string, Name, is the name of an existing
Index: gprcmd.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/gprcmd.adb,v
retrieving revision 1.2
diff -u -p -r1.2 gprcmd.adb
--- gprcmd.adb	10 Nov 2003 17:29:59 -0000	1.2
+++ gprcmd.adb	20 Nov 2003 09:48:29 -0000
@@ -55,7 +55,7 @@ procedure Gprcmd is
 
    Version : constant String :=
                "GPRCMD " & Gnatvsn.Gnat_Version_String &
-               " Copyright 2002-2003, Ada Core Technologies Inc.";
+               " Copyright 2002-2003, Free Software Fundation, Inc.";
 
    procedure Cat (File : String);
    --  Print the contents of file on standard output.
Index: lib-load.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/lib-load.adb,v
retrieving revision 1.7
diff -u -p -r1.7 lib-load.adb
--- lib-load.adb	10 Nov 2003 17:29:59 -0000	1.7
+++ lib-load.adb	20 Nov 2003 09:48:29 -0000
@@ -519,8 +519,8 @@ package body Lib.Load is
          --  legitimately occurs (e.g. two package bodies that contain
          --  inlined subprogram referenced by the other).
 
-         --  We also ignore limited_with clauses, because their purpose is
-         --  precisely to create legal circular structures.
+         --  Ada0Y (AI-50217): We also ignore limited_with clauses, because
+         --  their purpose is precisely to create legal circular structures.
 
          if Loading (Unum)
            and then (Is_Spec_Name (Units.Table (Unum).Unit_Name)
Index: lib-writ.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/lib-writ.adb,v
retrieving revision 1.9
diff -u -p -r1.9 lib-writ.adb
--- lib-writ.adb	14 Nov 2003 10:24:43 -0000	1.9
+++ lib-writ.adb	20 Nov 2003 09:48:29 -0000
@@ -214,7 +214,8 @@ package body Lib.Writ is
          Item := First (Context_Items (Cunit));
          while Present (Item) loop
 
-            --  limited_with_clauses do not create dependencies.
+            --  Ada0Y (AI-50217): limited with_clauses do not create
+            --  dependencies
 
             if Nkind (Item) = N_With_Clause
                and then not (Limited_Present (Item))
Index: mlib-prj.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/mlib-prj.adb,v
retrieving revision 1.4
diff -u -p -r1.4 mlib-prj.adb
--- mlib-prj.adb	21 Oct 2003 13:42:09 -0000	1.4
+++ mlib-prj.adb	20 Nov 2003 09:48:29 -0000
@@ -1313,6 +1313,7 @@ package body MLib.Prj is
                   Interfaces    => Arguments (1 .. Argument_Number),
                   Lib_Filename  => Lib_Filename.all,
                   Lib_Dir       => Lib_Dirpath.all,
+                  Symbol_Data   => Data.Symbol_Data,
                   Driver_Name   => Driver_Name,
                   Lib_Address   => DLL_Address.all,
                   Lib_Version   => Lib_Version.all,
Index: mlib-tgt.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/mlib-tgt.adb,v
retrieving revision 1.5
diff -u -p -r1.5 mlib-tgt.adb
--- mlib-tgt.adb	21 Oct 2003 13:42:09 -0000	1.5
+++ mlib-tgt.adb	20 Nov 2003 09:48:30 -0000
@@ -79,6 +79,7 @@ package body MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -92,6 +93,7 @@ package body MLib.Tgt is
       pragma Unreferenced (Interfaces);
       pragma Unreferenced (Lib_Filename);
       pragma Unreferenced (Lib_Dir);
+      pragma Unreferenced (Symbol_Data);
       pragma Unreferenced (Driver_Name);
       pragma Unreferenced (Lib_Address);
       pragma Unreferenced (Lib_Version);
Index: mlib-tgt.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/mlib-tgt.ads,v
retrieving revision 1.4
diff -u -p -r1.4 mlib-tgt.ads
--- mlib-tgt.ads	21 Oct 2003 13:42:10 -0000	1.4
+++ mlib-tgt.ads	20 Nov 2003 09:48:30 -0000
@@ -113,6 +113,7 @@ package MLib.Tgt is
       Interfaces   : Argument_List;
       Lib_Filename : String;
       Lib_Dir      : String;
+      Symbol_Data  : Symbol_Record;
       Driver_Name  : Name_Id := No_Name;
       Lib_Address  : String  := "";
       Lib_Version  : String  := "";
@@ -125,23 +126,33 @@ package MLib.Tgt is
    --  Afiles is the list of ALI files for the Ada object files.
    --  Options is a list of options to be passed to the tool (gcc or other)
    --  that effectively builds the dynamic library.
+   --
    --  Interfaces is the list of ALI files for the interfaces of a SAL.
    --  It is empty if the library is not a SAL.
+   --
    --  Lib_Filename is the name of the library, without any prefix or
    --  extension. For example, on Unix, if Lib_Filename is "toto", the name of
    --  the library file will be "libtoto.so".
+   --
    --  Lib_Dir is the directory path where the library will be located.
+   --
    --  Lib_Address is the base address of the library for a non relocatable
    --  library, given as an hexadecimal string.
-   --  For OSes that support symbolic links, Lib_Version, if non null, is
-   --  the actual file name of the library. For example on Unix,
-   --  if Lib_Filename is "toto" and Lib_Version is "libtoto.so.2.1",
-   --  "libtoto.so" will be a symbolic link to "libtoto.so.2.1" which will
-   --  be the actual library file.
+   --
+   --  For OSes that support symbolic links, Lib_Version, if non null,
+   --  is the actual file name of the library. For example on Unix, if
+   --  Lib_Filename is "toto" and Lib_Version is "libtoto.so.2.1",
+   --  "libtoto.so" will be a symbolic link to "libtoto.so.2.1" which
+   --  will be the actual library file.
+   --
    --  Relocatable indicates if the library should be relocatable or not,
    --  for those OSes that actually support non relocatable dynamic libraries.
    --  Relocatable indicates that automatic elaboration/finalization must be
    --  indicated to the linker, if possible.
+   --
+   --  Symbol_Data is used for some patforms, including VMS, to generate
+   --  the symbols to be exported by the library.
+   --
    --  Note: Depending on the OS, some of the parameters may not be taken
    --  into account. For example, on Linux, Foreign, Afiles Lib_Address and
    --  Relocatable are ignored.
Index: par-ch10.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch10.adb,v
retrieving revision 1.6
diff -u -p -r1.6 par-ch10.adb
--- par-ch10.adb	17 Nov 2003 14:58:15 -0000	1.6
+++ par-ch10.adb	20 Nov 2003 09:48:30 -0000
@@ -782,7 +782,7 @@ package body Ch10 is
 
          --  Processing for WITH clause
 
-         --  First check for LIMITED WITH
+         --  Ada0Y (AI-50217): First check for LIMITED WITH
 
          if Token = Tok_Limited then
             Has_Limited := True;
Index: par-ch4.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch4.adb,v
retrieving revision 1.8
diff -u -p -r1.8 par-ch4.adb
--- par-ch4.adb	17 Nov 2003 14:58:16 -0000	1.8
+++ par-ch4.adb	20 Nov 2003 09:48:30 -0000
@@ -1127,6 +1127,9 @@ package body Ch4 is
 
    --  Error recovery: can raise Error_Resync
 
+   --  Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support
+   --        to Ada0Y limited aggregates (AI-287)
+
    function P_Aggregate_Or_Paren_Expr return Node_Id is
       Aggregate_Node : Node_Id;
       Expr_List      : List_Id;
@@ -1372,6 +1375,10 @@ package body Ch4 is
    --  been handled directly.
 
    --  Error recovery: can raise Error_Resync
+
+   --  Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION
+   --        rules have been extended to give support to Ada0Y limited
+   --        aggregates (AI-287)
 
    function P_Record_Or_Array_Component_Association return Node_Id is
       Assoc_Node : Node_Id;
Index: prj.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj.adb,v
retrieving revision 1.12
diff -u -p -r1.12 prj.adb
--- prj.adb	17 Nov 2003 14:58:16 -0000	1.12
+++ prj.adb	20 Nov 2003 09:48:30 -0000
@@ -96,6 +96,7 @@ package body Prj is
       Standalone_Library             => False,
       Lib_Interface_ALIs             => Nil_String,
       Lib_Auto_Init                  => False,
+      Symbol_Data                    => No_Symbols,
       Sources_Present                => True,
       Sources                        => Nil_String,
       Source_Dirs                    => Nil_String,
Index: prj.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj.ads,v
retrieving revision 1.14
diff -u -p -r1.14 prj.ads
--- prj.ads	17 Nov 2003 14:58:16 -0000	1.14
+++ prj.ads	20 Nov 2003 09:48:30 -0000
@@ -75,6 +75,21 @@ package Prj is
 
    type Lib_Kind is (Static, Dynamic, Relocatable);
 
+   type Policy is (Autonomous, Compliant, Controlled);
+   --  See explaination about this type in package Symbol
+
+   type Symbol_Record is record
+      Symbol_File   : Name_Id := No_Name;
+      Reference     : Name_Id := No_Name;
+      Symbol_Policy : Policy  := Autonomous;
+   end record;
+   --  Type to keep the symbol data to be used when building a shared library
+
+   No_Symbols : Symbol_Record :=
+     (Symbol_File   => No_Name,
+      Reference     => No_Name,
+      Symbol_Policy => Autonomous);
+
    function Empty_String return Name_Id;
 
    type Project_Id is new Nat;
@@ -417,6 +432,9 @@ package Prj is
       Lib_Auto_Init  : Boolean := False;
       --  For non static Standalone Library Project Files, indicate if
       --  the library initialisation should be automatic.
+
+      Symbol_Data : Symbol_Record := No_Symbols;
+      --  Symbol file name, reference symbol file name, symbol policy
 
       Sources_Present : Boolean := True;
       --  A flag that indicates if there are sources in this project file.
Index: prj-attr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-attr.adb,v
retrieving revision 1.10
diff -u -p -r1.10 prj-attr.adb
--- prj-attr.adb	21 Oct 2003 13:42:12 -0000	1.10
+++ prj-attr.adb	20 Nov 2003 09:48:30 -0000
@@ -69,6 +69,9 @@ package body Prj.Attr is
      "LVlibrary_options#" &
      "SVlibrary_src_dir#" &
      "SVlibrary_gcc#" &
+     "SVlibrary_symbol_file#" &
+     "SVlibrary_symbol_policy#" &
+     "SVlibrary_reference_symbol_file#" &
      "LVmain#" &
      "LVlanguages#" &
      "SVmain_language#" &
Index: prj-nmsc.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-nmsc.adb,v
retrieving revision 1.14
diff -u -p -r1.14 prj-nmsc.adb
--- prj-nmsc.adb	17 Nov 2003 14:58:16 -0000	1.14
+++ prj-nmsc.adb	20 Nov 2003 09:48:30 -0000
@@ -1350,16 +1350,32 @@ package body Prj.Nmsc is
                               (Snames.Name_Library_Src_Dir,
                                Data.Decl.Attributes);
 
-            Auto_Init_Supported
-                           : constant Boolean :=
-                               MLib.Tgt.
-                                 Standalone_Library_Auto_Init_Is_Supported;
+            Lib_Symbol_File : constant Prj.Variable_Value :=
+                                Prj.Util.Value_Of
+                                  (Snames.Name_Library_Symbol_File,
+                                   Data.Decl.Attributes);
+
+            Lib_Symbol_Policy : constant Prj.Variable_Value :=
+                                  Prj.Util.Value_Of
+                                    (Snames.Name_Library_Symbol_Policy,
+                                     Data.Decl.Attributes);
+
+            Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
+                                  Prj.Util.Value_Of
+                                    (Snames.Name_Library_Reference_Symbol_File,
+                                     Data.Decl.Attributes);
+
+            Auto_Init_Supported : constant Boolean :=
+                                    MLib.Tgt.
+                                     Standalone_Library_Auto_Init_Is_Supported;
+
+            OK : Boolean := True;
 
          begin
             pragma Assert (Lib_Interfaces.Kind = List);
 
-            --  It is a library project file if attribute Library_Interface
-            --  is defined.
+            --  It is a stand-alone library project file if attribute
+            --  Library_Interface is defined.
 
             if not Lib_Interfaces.Default then
                declare
@@ -1566,102 +1582,257 @@ package body Prj.Nmsc is
                            Lib_Auto_Init.Location);
                      end if;
                   end if;
+               end;
 
-                  if Lib_Src_Dir.Value /= Empty_String then
-                     declare
-                        Dir_Id : constant Name_Id := Lib_Src_Dir.Value;
+               --  If attribute Library_Src_Dir is defined and not the
+               --  empty string, check if the directory exist and is not
+               --  the object directory or one of the source directories.
+               --  This is the directory where copies of the interface
+               --  sources will be copied. Note that this directory may be
+               --  the library directory.
+
+               if Lib_Src_Dir.Value /= Empty_String then
+                  declare
+                     Dir_Id : constant Name_Id := Lib_Src_Dir.Value;
 
-                     begin
-                        Locate_Directory
-                          (Dir_Id, Data.Display_Directory,
-                           Data.Library_Src_Dir,
-                           Data.Display_Library_Src_Dir);
-
-                        --  Comment needed here ???
-
-                        if Data.Library_Src_Dir = No_Name then
-
-                           --  Get the absolute name of the library directory
-                           --  that does not exist, to report an error.
-
-                           declare
-                              Dir_Name : constant String :=
-                                           Get_Name_String (Dir_Id);
-                           begin
-                              if Is_Absolute_Path (Dir_Name) then
-                                 Err_Vars.Error_Msg_Name_1 := Dir_Id;
+                  begin
+                     Locate_Directory
+                       (Dir_Id, Data.Display_Directory,
+                        Data.Library_Src_Dir,
+                        Data.Display_Library_Src_Dir);
 
-                              else
-                                 Get_Name_String (Data.Directory);
+                     --  If directory does not exist, report an error
 
-                                 if Name_Buffer (Name_Len) /=
-                                    Directory_Separator
-                                 then
-                                    Name_Len := Name_Len + 1;
-                                    Name_Buffer (Name_Len) :=
-                                      Directory_Separator;
-                                 end if;
+                     if Data.Library_Src_Dir = No_Name then
 
-                                 Name_Buffer
-                                   (Name_Len + 1 ..
-                                      Name_Len + Dir_Name'Length) :=
-                                   Dir_Name;
-                                 Name_Len := Name_Len + Dir_Name'Length;
-                                 Err_Vars.Error_Msg_Name_1 := Name_Find;
-                              end if;
+                        --  Get the absolute name of the library directory
+                        --  that does not exist, to report an error.
 
-                              --  Report the error
+                        declare
+                           Dir_Name : constant String :=
+                                        Get_Name_String (Dir_Id);
 
-                              Error_Msg
-                                (Project,
-                                 "Directory { does not exist",
-                                 Lib_Src_Dir.Location);
-                           end;
+                        begin
+                           if Is_Absolute_Path (Dir_Name) then
+                              Err_Vars.Error_Msg_Name_1 := Dir_Id;
 
-                        --  And comment needed here ???
+                           else
+                              Get_Name_String (Data.Directory);
+
+                              if Name_Buffer (Name_Len) /=
+                                Directory_Separator
+                              then
+                                 Name_Len := Name_Len + 1;
+                                 Name_Buffer (Name_Len) :=
+                                   Directory_Separator;
+                              end if;
+
+                              Name_Buffer
+                                (Name_Len + 1 ..
+                                   Name_Len + Dir_Name'Length) :=
+                                  Dir_Name;
+                              Name_Len := Name_Len + Dir_Name'Length;
+                              Err_Vars.Error_Msg_Name_1 := Name_Find;
+                           end if;
+
+                           --  Report the error
 
-                        elsif Data.Library_Src_Dir = Data.Object_Directory then
                            Error_Msg
                              (Project,
-                              "directory to copy interfaces cannot be " &
-                              "the object directory",
+                              "Directory { does not exist",
                               Lib_Src_Dir.Location);
-                           Data.Library_Src_Dir := No_Name;
+                        end;
 
-                        --  And comment needed here ???
+                     --  Report an error if it is the same as the object
+                     --  directory.
 
-                        else
-                           declare
-                              Src_Dirs : String_List_Id := Data.Source_Dirs;
-                              Src_Dir : String_Element;
-                           begin
-                              while Src_Dirs /= Nil_String loop
-                                 Src_Dir := String_Elements.Table (Src_Dirs);
-                                 Src_Dirs := Src_Dir.Next;
-
-                                 if Data.Library_Src_Dir = Src_Dir.Value then
-                                    Error_Msg
-                                      (Project,
-                                       "directory to copy interfaces cannot " &
-                                       "be one of the source directories",
-                                       Lib_Src_Dir.Location);
-                                    Data.Library_Src_Dir := No_Name;
-                                    exit;
-                                 end if;
-                              end loop;
-                           end;
+                     elsif Data.Library_Src_Dir = Data.Object_Directory then
+                        Error_Msg
+                          (Project,
+                           "directory to copy interfaces cannot be " &
+                           "the object directory",
+                           Lib_Src_Dir.Location);
+                        Data.Library_Src_Dir := No_Name;
 
-                           if Data.Library_Src_Dir /= No_Name
-                             and then Current_Verbosity = High
+                     --  Check if it is the same as one of the source
+                     --  directories.
+
+                     else
+                        declare
+                           Src_Dirs : String_List_Id := Data.Source_Dirs;
+                           Src_Dir  : String_Element;
+
+                        begin
+                           while Src_Dirs /= Nil_String loop
+                              Src_Dir := String_Elements.Table (Src_Dirs);
+                              Src_Dirs := Src_Dir.Next;
+
+                              --  Report an error if it is one of the
+                              --  source directories.
+
+                              if Data.Library_Src_Dir = Src_Dir.Value then
+                                 Error_Msg
+                                   (Project,
+                                    "directory to copy interfaces cannot " &
+                                    "be one of the source directories",
+                                    Lib_Src_Dir.Location);
+                                 Data.Library_Src_Dir := No_Name;
+                                 exit;
+                              end if;
+                           end loop;
+                        end;
+
+                        if Data.Library_Src_Dir /= No_Name
+                          and then Current_Verbosity = High
+                        then
+                           Write_Str ("Directory to copy interfaces =""");
+                           Write_Str (Get_Name_String (Data.Library_Dir));
+                           Write_Line ("""");
+                        end if;
+                     end if;
+                  end;
+               end if;
+
+               if not Lib_Symbol_File.Default then
+                  Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value;
+
+                  Get_Name_String (Lib_Symbol_File.Value);
+
+                  if Name_Len = 0 then
+                     Error_Msg
+                       (Project,
+                        "symbol file name cannot be an empty string",
+                        Lib_Symbol_File.Location);
+
+                  else
+                     OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
+
+                     if OK then
+                        for J in 1 .. Name_Len loop
+                           if Name_Buffer (J) = '/'
+                             or else Name_Buffer (J) = Directory_Separator
                            then
-                              Write_Str ("Directory to copy interfaces =""");
-                              Write_Str (Get_Name_String (Data.Library_Dir));
-                              Write_Line ("""");
+                              OK := False;
+                              exit;
                            end if;
-                        end if;
-                     end;
+                        end loop;
+                     end if;
+
+                     if not OK then
+                        Error_Msg_Name_1 := Lib_Symbol_File.Value;
+                        Error_Msg
+                          (Project,
+                           "symbol file name { is illegal. " &
+                           "Name canot include directory info.",
+                           Lib_Symbol_File.Location);
+                     end if;
                   end if;
-               end;
+               end if;
+
+               if not Lib_Symbol_Policy.Default then
+                  declare
+                     Value : constant String :=
+                               To_Lower
+                                 (Get_Name_String (Lib_Symbol_Policy.Value));
+
+                  begin
+                     if Value = "autonomous" or else Value = "default" then
+                        Data.Symbol_Data.Symbol_Policy := Autonomous;
+
+                     elsif Value = "compliant" then
+                        Data.Symbol_Data.Symbol_Policy := Compliant;
+
+                     elsif Value = "controlled" then
+                        Data.Symbol_Data.Symbol_Policy := Controlled;
+
+                     else
+                        Error_Msg
+                          (Project,
+                           "illegal value for Library_Symbol_Policy",
+                           Lib_Symbol_Policy.Location);
+                     end if;
+                  end;
+               end if;
+
+               if Lib_Ref_Symbol_File.Default then
+                  if Data.Symbol_Data.Symbol_Policy /= Autonomous then
+                     Error_Msg
+                       (Project,
+                        "a reference symbol file need to be defined",
+                        Lib_Symbol_Policy.Location);
+                  end if;
+
+               else
+                  Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value;
+
+                  Get_Name_String (Lib_Symbol_File.Value);
+
+                  if Name_Len = 0 then
+                     Error_Msg
+                       (Project,
+                        "reference symbol file name cannot be an empty string",
+                        Lib_Symbol_File.Location);
+
+                  else
+                     OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
+
+                     if OK then
+                        for J in 1 .. Name_Len loop
+                           if Name_Buffer (J) = '/'
+                             or else Name_Buffer (J) = Directory_Separator
+                           then
+                              OK := False;
+                              exit;
+                           end if;
+                        end loop;
+                     end if;
+
+                     if not OK then
+                        Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
+                        Error_Msg
+                          (Project,
+                           "reference symbol file { name is illegal. " &
+                           "Name canot include directory info.",
+                           Lib_Ref_Symbol_File.Location);
+                     end if;
+
+                     if not Is_Regular_File
+                       (Get_Name_String (Data.Object_Directory) &
+                        Directory_Separator &
+                        Get_Name_String (Lib_Ref_Symbol_File.Value))
+                     then
+                        Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
+                        Error_Msg
+                          (Project,
+                           "library reference symbol file { does not exist",
+                           Lib_Ref_Symbol_File.Location);
+                     end if;
+
+                     if Data.Symbol_Data.Symbol_File /= No_Name then
+                        declare
+                           Symbol : String :=
+                                      Get_Name_String
+                                        (Data.Symbol_Data.Symbol_File);
+
+                           Reference : String :=
+                                         Get_Name_String
+                                           (Data.Symbol_Data.Reference);
+
+                        begin
+                           Canonical_Case_File_Name (Symbol);
+                           Canonical_Case_File_Name (Reference);
+
+                           if Symbol = Reference then
+                              Error_Msg
+                                (Project,
+                                 "reference symbol file and symbol file " &
+                                 "cannot be the same file",
+                                 Lib_Ref_Symbol_File.Location);
+                           end if;
+                        end;
+                     end if;
+                  end if;
+               end if;
             end if;
          end Standalone_Library;
       end if;
Index: rtsfind.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/rtsfind.adb,v
retrieving revision 1.8
diff -u -p -r1.8 rtsfind.adb
--- rtsfind.adb	21 Oct 2003 13:42:13 -0000	1.8
+++ rtsfind.adb	20 Nov 2003 09:48:30 -0000
@@ -258,6 +258,8 @@ package body Rtsfind is
       for J in RE_Id loop
          RE_Table (J) := Empty;
       end loop;
+
+      RTE_Is_Available := False;
    end Initialize;
 
    ------------
Index: sem_aggr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_aggr.adb,v
retrieving revision 1.10
diff -u -p -r1.10 sem_aggr.adb
--- sem_aggr.adb	17 Nov 2003 14:58:16 -0000	1.10
+++ sem_aggr.adb	20 Nov 2003 09:48:30 -0000
@@ -866,6 +866,8 @@ package body Sem_Aggr is
          Error_Msg_N ("aggregate type cannot have limited component", N);
          Explain_Limited_Type (Typ, N);
 
+      --  Ada0Y (AI-287): Limited aggregates allowed
+
       elsif Is_Limited_Type (Typ)
         and not Extensions_Allowed
       then
@@ -1915,12 +1917,17 @@ package body Sem_Aggr is
          Error_Msg_N ("type of extension aggregate must be tagged", N);
          return;
 
-      elsif Is_Limited_Type (Typ)
-        and not Extensions_Allowed
-      then
-         Error_Msg_N ("aggregate type cannot be limited", N);
-         Explain_Limited_Type (Typ, N);
-         return;
+      elsif Is_Limited_Type (Typ) then
+
+         --  Ada0Y (AI-287): Limited aggregates are allowed
+
+         if Extensions_Allowed then
+            null;
+         else
+            Error_Msg_N ("aggregate type cannot be limited", N);
+            Explain_Limited_Type (Typ, N);
+            return;
+         end if;
 
       elsif Is_Class_Wide_Type (Typ) then
          Error_Msg_N ("aggregate cannot be of a class-wide type", N);
@@ -2023,12 +2030,12 @@ package body Sem_Aggr is
 
       Mbox_Present : Boolean := False;
       Others_Mbox  : Boolean := False;
-      --  Variables used in case of default initialization to provide a
-      --  functionality similar to Others_Etype. Mbox_Present indicates
-      --  that the component takes its default initialization; Others_Mbox
-      --  indicates that at least one component takes its default initiali-
-      --  zation. Similar to Others_Etype, they are also updated as a side
-      --  effect of function Get_Value.
+      --  Ada0Y (AI-287): Variables used in case of default initialization to
+      --  provide a functionality similar to Others_Etype. Mbox_Present
+      --  indicates that the component takes its default initialization;
+      --  Others_Mbox indicates that at least one component takes its default
+      --  initialization. Similar to Others_Etype, they are also updated as a
+      --  side effect of function Get_Value.
 
       procedure Add_Association
         (Component   : Entity_Id;
@@ -2212,6 +2219,7 @@ package body Sem_Aggr is
                and then Comes_From_Source (Compon)
                and then not In_Instance_Body
             then
+               --  Ada0Y (AI-287): Limited aggregates are allowed
 
                if Extensions_Allowed
                  and then Present (Expression (Assoc))
@@ -2251,6 +2259,10 @@ package body Sem_Aggr is
                      --  indispensable otherwise, because each one must be
                      --  expanded individually to preserve side-effects.
 
+                     --  Ada0Y (AI-287): In case of default initialization of
+                     --  components, we duplicate the corresponding default
+                     --  expression (from the record type declaration).
+
                      if Box_Present (Assoc) then
                         Others_Mbox  := True;
                         Mbox_Present := True;
@@ -2845,9 +2857,10 @@ package body Sem_Aggr is
 
          if Mbox_Present and then Is_Limited_Type (Etype (Component)) then
 
-            --  In case of default initialization of a limited component we
-            --  pass the limited component to the expander. The expander will
-            --  generate calls to the corresponding initialization subprograms.
+            --  Ada0Y (AI-287): In case of default initialization of a limited
+            --  component we pass the limited component to the expander. The
+            --  expander will generate calls to the corresponding initiali-
+            --  zation subprograms.
 
             Add_Association
               (Component   => Component,
@@ -2884,6 +2897,9 @@ package body Sem_Aggr is
             Typech := Empty;
 
             if Nkind (Selectr) = N_Others_Choice then
+
+               --  Ada0Y (AI-287):  others choice may have expression or mbox
+
                if No (Others_Etype)
                   and then not Others_Mbox
                then
Index: sem_attr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_attr.adb,v
retrieving revision 1.14
diff -u -p -r1.14 sem_attr.adb
--- sem_attr.adb	4 Nov 2003 12:51:46 -0000	1.14
+++ sem_attr.adb	20 Nov 2003 09:48:30 -0000
@@ -2184,9 +2184,12 @@ package body Sem_Attr is
          if Is_Entity_Name (P) and then Is_Type (Entity (P)) then
 
             --  If we are within an instance, the attribute must be legal
-            --  because it was valid in the generic unit.
+            --  because it was valid in the generic unit. Ditto if this is
+            --  an inlining of a function declared in an instance.
 
-            if In_Instance then
+            if In_Instance
+              or else In_Inlined_Body
+            then
                return;
 
             --  For sure OK if we have a real private type itself, but must
Index: sem_cat.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_cat.adb,v
retrieving revision 1.5
diff -u -p -r1.5 sem_cat.adb
--- sem_cat.adb	21 Oct 2003 13:42:18 -0000	1.5
+++ sem_cat.adb	20 Nov 2003 09:48:30 -0000
@@ -761,7 +761,7 @@ package body Sem_Cat is
          return;
       end if;
 
-      --  Process explicit with_clauses that are not limited.
+      --  Ada0Y (AI-50217): Process explicit with_clauses that are not limited
 
       declare
          Item             : Node_Id;
Index: sem_ch10.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch10.adb,v
retrieving revision 1.12
diff -u -p -r1.12 sem_ch10.adb
--- sem_ch10.adb	10 Nov 2003 17:29:59 -0000	1.12
+++ sem_ch10.adb	20 Nov 2003 09:48:30 -0000
@@ -77,6 +77,7 @@ package body Sem_Ch10 is
    --  in a limited_with clause. If the package was not previously analyzed
    --  then it also performs a basic decoration of the real entities; this
    --  is required to do not pass non-decorated entities to the back-end.
+   --  Implements Ada0Y (AI-50217).
 
    procedure Check_Body_Needed_For_SAL (Unit_Name : Entity_Id);
    --  Check whether the source for the body of a compilation unit must
@@ -95,11 +96,12 @@ package body Sem_Ch10 is
    --  and not in an inner frame.
 
    procedure Expand_Limited_With_Clause (Nam : Node_Id; N : Node_Id);
-   --  if a child unit appears in a limited_with clause, there are implicit
+   --  If a child unit appears in a limited_with clause, there are implicit
    --  limited_with clauses on all parents that are not already visible
    --  through a regular with clause. This procedure creates the implicit
    --  limited with_clauses for the parents and loads the corresponding units.
    --  The shadow entities are created when the inserted clause is analyzed.
+   --  Implements Ada0Y (AI-50217).
 
    procedure Expand_With_Clause (Nam : Node_Id; N : Node_Id);
    --  When a child unit appears in a context clause, the implicit withs on
@@ -127,11 +129,11 @@ package body Sem_Ch10 is
 
    procedure Install_Limited_Context_Clauses (N : Node_Id);
    --  Subsidiary to Install_Context. Process only limited with_clauses
-   --  for current unit.
+   --  for current unit. Implements Ada0Y (AI-50217).
 
    procedure Install_Limited_Withed_Unit (N : Node_Id);
    --  Place shadow entities for a limited_with package in the visibility
-   --  structures for the current compilation.
+   --  structures for the current compilation. Implements Ada0Y (AI-50217).
 
    procedure Install_Withed_Unit (With_Clause : Node_Id);
    --  If the unit is not a child unit, make unit immediately visible.
@@ -174,7 +176,7 @@ package body Sem_Ch10 is
 
    procedure Remove_Limited_With_Clause (N : Node_Id);
    --  Remove from visibility the shadow entities introduced for a package
-   --  mentioned in a limited_with clause.
+   --  mentioned in a limited_with clause. Implements Ada0Y (AI-50217).
 
    procedure Remove_Parents (Lib_Unit : Node_Id);
    --  Remove_Parents checks if Lib_Unit is a child spec. If so then the parent
@@ -611,6 +613,9 @@ package body Sem_Ch10 is
          begin
             Item := First (Context_Items (N));
             while Present (Item) loop
+
+               --  Ada0Y (AI-50217): Do not consider limited-withed units
+
                if Nkind (Item) = N_With_Clause
                   and then not Implicit_With (Item)
                   and then not Limited_Present (Item)
@@ -788,8 +793,8 @@ package body Sem_Ch10 is
       --  Loop through context items. This is done is three passes:
       --  a) The first pass analyze non-limited with-clauses.
       --  b) The second pass add implicit limited_with clauses for
-      --     the parents of child units.
-      --  c) The third pass analyzes limited_with clauses.
+      --     the parents of child units (Ada0Y: AI-50217)
+      --  c) The third pass analyzes limited_with clauses (Ada0Y: AI-50217)
 
       Item := First (Context_Items (N));
       while Present (Item) loop
@@ -1590,8 +1595,8 @@ package body Sem_Ch10 is
 
    begin
       if Limited_Present (N) then
-
-         --  Build visibility structures but do not analyze unit
+         --  Ada0Y (AI-50217): Build visibility structures but do not
+         --  analyze unit
 
          Build_Limited_Views (N);
          return;
@@ -4006,8 +4011,9 @@ package body Sem_Ch10 is
       Unit_Name : Entity_Id;
 
    begin
-      --  We remove the context clauses in two phases: limited-views first
-      --  and regular-views later (to maintain the stack model).
+      --  Ada0Y (AI-50217): We remove the context clauses in two phases:
+      --  limited-views first and regular-views later (to maintain the
+      --  stack model).
 
       --  First Phase: Remove limited_with context clauses
 
Index: sem_ch12.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch12.adb,v
retrieving revision 1.27
diff -u -p -r1.27 sem_ch12.adb
--- sem_ch12.adb	17 Nov 2003 14:58:16 -0000	1.27
+++ sem_ch12.adb	20 Nov 2003 09:48:31 -0000
@@ -987,6 +987,7 @@ package body Sem_Ch12 is
                       Defining_Identifier (Analyzed_Formal));
 
                   if No (Match) then
+                     Error_Msg_Sloc := Sloc (Gen_Unit);
                      Error_Msg_NE
                        ("missing actual&",
                          Instantiation_Node, Defining_Identifier (Formal));
@@ -1075,6 +1076,7 @@ package body Sem_Ch12 is
                       Defining_Identifier (Original_Node (Analyzed_Formal)));
 
                   if No (Match) then
+                     Error_Msg_Sloc := Sloc (Gen_Unit);
                      Error_Msg_NE
                        ("missing actual&",
                          Instantiation_Node, Defining_Identifier (Formal));
@@ -1111,6 +1113,8 @@ package body Sem_Ch12 is
          end loop;
 
          if Num_Actuals > Num_Matched then
+            Error_Msg_Sloc := Sloc (Gen_Unit);
+
             if Present (Selector_Name (Actual)) then
                Error_Msg_NE
                  ("unmatched actual&",
@@ -2348,6 +2352,8 @@ package body Sem_Ch12 is
 
       elsif Ekind (Gen_Unit) /= E_Generic_Package then
 
+         --  Ada0Y (AI-50217): Instance can not be used in limited with_clause
+
          if From_With_Type (Gen_Unit) then
             Error_Msg_N
               ("cannot instantiate a limited withed package", Gen_Id);
@@ -6620,6 +6626,7 @@ package body Sem_Ch12 is
          end if;
 
       else
+         Error_Msg_Sloc := Sloc (Scope (Analyzed_S));
          Error_Msg_NE
            ("missing actual&", Instantiation_Node, Formal_Sub);
          Error_Msg_NE
@@ -6746,6 +6753,9 @@ package body Sem_Ch12 is
       Subt_Decl : Node_Id := Empty;
 
    begin
+      --  Sloc for error message on missing actual.
+      Error_Msg_Sloc := Sloc (Scope (Defining_Identifier (Analyzed_Formal)));
+
       if Get_Instance_Of (Formal_Id) /= Formal_Id then
          Error_Msg_N ("duplicate instantiation of generic parameter", Actual);
       end if;
Index: sem_ch3.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch3.adb,v
retrieving revision 1.21
diff -u -p -r1.21 sem_ch3.adb
--- sem_ch3.adb	14 Nov 2003 10:24:43 -0000	1.21
+++ sem_ch3.adb	20 Nov 2003 09:48:31 -0000
@@ -690,6 +690,10 @@ package body Sem_Ch3 is
       --  if the designated type is.
 
       Set_Is_Public          (Anon_Type, Is_Public (Scope (Anon_Type)));
+
+      --  Ada0Y (AI-50217): Propagate the attribute that indicates that the
+      --  designated type comes from the limited view (for back-end purposes).
+
       Set_From_With_Type     (Anon_Type, From_With_Type (Desig_Type));
 
       --  The context is either a subprogram declaration or an access
@@ -857,9 +861,9 @@ package body Sem_Ch3 is
       --  access type is also imported, and therefore restricted in its use.
       --  The access type may already be imported, so keep setting otherwise.
 
-      --  If the non-limited view of the designated type is available, use
-      --  it as the designated type of the access type, so that the back-end
-      --  gets a usable entity.
+      --  Ada0Y (AI-50217): If the non-limited view of the designated type is
+      --  available, use it as the designated type of the access type, so that
+      --  the back-end gets a usable entity.
 
       if From_With_Type (Desig) then
          Set_From_With_Type (T);
@@ -2448,9 +2452,11 @@ package body Sem_Ch3 is
    begin
       Prev := Find_Type_Name (N);
 
-      --  The full view, if present, now points to the current type. If the
-      --  type was previously decorated when imported through a LIMITED WITH
-      --  clause, it appears as incomplete but has no full view.
+      --  The full view, if present, now points to the current type
+
+      --  Ada0Y (AI-50217): If the type was previously decorated when imported
+      --  through a LIMITED WITH clause, it appears as incomplete but has no
+      --  full view.
 
       if Ekind (Prev) = E_Incomplete_Type
         and then Present (Full_View (Prev))
@@ -6234,8 +6240,8 @@ package body Sem_Ch3 is
            or else Is_Limited_Composite (T))
         and then not In_Instance
       then
-         --  Relax the strictness of the front-end in case of limited
-         --  aggregates and extension aggregates.
+         --  Ada0Y (AI-287): Relax the strictness of the front-end in case of
+         --  limited aggregates and extension aggregates.
 
          if Extensions_Allowed
            and then (Nkind (Exp) = N_Aggregate
Index: sem_ch4.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch4.adb,v
retrieving revision 1.9
diff -u -p -r1.9 sem_ch4.adb
--- sem_ch4.adb	17 Nov 2003 14:58:16 -0000	1.9
+++ sem_ch4.adb	20 Nov 2003 09:48:31 -0000
@@ -342,6 +342,10 @@ package body Sem_Ch4 is
            and then Comes_From_Source (N)
            and then not In_Instance_Body
          then
+            --  Ada0Y (AI-287): Do not post an error if the expression corres-
+            --  ponds to a limited aggregate. Limited aggregates are checked in
+            --  sem_aggr in a per-component manner (cf. Get_Value subprogram).
+
             if Extensions_Allowed
               and then Nkind (Expression (E)) = N_Aggregate
             then
@@ -3442,6 +3446,9 @@ package body Sem_Ch4 is
          Actual := First_Actual (N);
 
          while Present (Actual) loop
+            --  Ada0Y (AI-50217): Post an error in case of premature usage of
+            --  an entity from the limited view.
+
             if not Analyzed (Etype (Actual))
              and then From_With_Type (Etype (Actual))
             then
Index: sem_ch6.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch6.adb,v
retrieving revision 1.10
diff -u -p -r1.10 sem_ch6.adb
--- sem_ch6.adb	17 Nov 2003 14:58:17 -0000	1.10
+++ sem_ch6.adb	20 Nov 2003 09:48:31 -0000
@@ -4840,9 +4840,9 @@ package body Sem_Ch6 is
                         and then Ekind (Root_Type (Formal_Type)) =
                                                          E_Incomplete_Type)
             then
-
-               --  Incomplete tagged types that are made visible through
-               --  a limited with_clause are valid formal types.
+               --  Ada0Y (AI-50217): Incomplete tagged types that are made
+               --  visible through a limited with_clause are valid formal
+               --  types.
 
                if From_With_Type (Formal_Type)
                  and then Is_Tagged_Type (Formal_Type)
Index: sem_ch8.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch8.adb,v
retrieving revision 1.13
diff -u -p -r1.13 sem_ch8.adb
--- sem_ch8.adb	14 Nov 2003 10:24:43 -0000	1.13
+++ sem_ch8.adb	20 Nov 2003 09:48:32 -0000
@@ -792,6 +792,8 @@ package body Sem_Ch8 is
          Error_Msg_N
            ("expect package name in renaming", Name (N));
 
+      --  Ada0Y (AI-50217): Limited withed packages can not be renamed
+
       elsif Ekind (Old_P) = E_Package
         and then From_With_Type (Old_P)
       then
@@ -3389,6 +3391,8 @@ package body Sem_Ch8 is
          Set_Chars (Selector, Chars (Id));
       end if;
 
+      --  Ada0Y (AI-50217): Check usage of entities in limited withed units
+
       if Ekind (P_Name) = E_Package
         and then From_With_Type (P_Name)
       then
@@ -5293,6 +5297,8 @@ package body Sem_Ch8 is
       end if;
 
       Set_In_Use (P);
+
+      --  Ada0Y (AI-50217): Check restriction.
 
       if From_With_Type (P) then
          Error_Msg_N ("limited withed package cannot appear in use clause", N);
Index: sem_type.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_type.adb,v
retrieving revision 1.9
diff -u -p -r1.9 sem_type.adb
--- sem_type.adb	29 Oct 2003 10:26:15 -0000	1.9
+++ sem_type.adb	20 Nov 2003 09:48:32 -0000
@@ -824,6 +824,9 @@ package body Sem_Type is
       then
          return True;
 
+      --  Ada0Y (AI-50217): Additional branches to make the shadow entity
+      --  compatible with its real entity.
+
       elsif From_With_Type (T1) then
 
          --  If the expected type is the non-limited view of a type, the
Index: sem_util.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_util.adb,v
retrieving revision 1.14
diff -u -p -r1.14 sem_util.adb
--- sem_util.adb	22 Oct 2003 09:28:08 -0000	1.14
+++ sem_util.adb	20 Nov 2003 09:48:32 -0000
@@ -818,8 +818,8 @@ package body Sem_Util is
    begin
       if Ekind (T) = E_Incomplete_Type then
 
-         --  If the type is available through a limited_with_clause,
-         --  verify that its full view has been analyzed.
+         --  Ada0Y (AI-50217): If the type is available through a limited
+         --  with_clause, verify that its full view has been analyzed.
 
          if From_With_Type (T)
            and then Present (Non_Limited_View (T))
Index: sinfo.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sinfo.ads,v
retrieving revision 1.14
diff -u -p -r1.14 sinfo.ads
--- sinfo.ads	14 Nov 2003 10:24:43 -0000	1.14
+++ sinfo.ads	20 Nov 2003 09:48:32 -0000
@@ -3015,7 +3015,8 @@ package Sinfo is
       --  separable by the parser. The choices list may represent either a
       --  list of selector names in the record aggregate case, or a list of
       --  discrete choices in the array aggregate case or an N_Others_Choice
-      --  node (which appears as a singleton list).
+      --  node (which appears as a singleton list). Box_Present gives support
+      --  to Ada0Y (AI-287).
 
       ------------------------------------
       --  4.3.1  Commponent Choice List --
@@ -5089,6 +5090,9 @@ package Sinfo is
       --  Limited_View_Installed (Flag18-Sem)
       --  Unreferenced_In_Spec (Flag7-Sem)
       --  No_Entities_Ref_In_Spec (Flag8-Sem)
+
+      --  Note: Limited_Present and Limited_View_Installed give support to
+      --        Ada0Y (AI-50217).
 
       ----------------------
       -- With_Type clause --
Index: snames.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/snames.adb,v
retrieving revision 1.13
diff -u -p -r1.13 snames.adb
--- snames.adb	4 Nov 2003 12:56:59 -0000	1.13
+++ snames.adb	20 Nov 2003 09:48:32 -0000
@@ -618,8 +618,10 @@ package body Snames is
      "library_kind#" &
      "library_name#" &
      "library_options#" &
+     "library_reference_symbol_file#" &
      "library_src_dir#" &
      "library_symbol_file#" &
+     "library_symbol_policy#" &
      "library_version#" &
      "linker#" &
      "local_configuration_pragmas#" &
Index: snames.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/snames.ads,v
retrieving revision 1.14
diff -u -p -r1.14 snames.ads
--- snames.ads	4 Nov 2003 12:56:59 -0000	1.14
+++ snames.ads	20 Nov 2003 09:48:32 -0000
@@ -902,33 +902,35 @@ package Snames is
    Name_Library_Kind                   : constant Name_Id := N + 558;
    Name_Library_Name                   : constant Name_Id := N + 559;
    Name_Library_Options                : constant Name_Id := N + 560;
-   Name_Library_Src_Dir                : constant Name_Id := N + 561;
-   Name_Library_Symbol_File            : constant Name_Id := N + 562;
-   Name_Library_Version                : constant Name_Id := N + 563;
-   Name_Linker                         : constant Name_Id := N + 564;
-   Name_Local_Configuration_Pragmas    : constant Name_Id := N + 565;
-   Name_Locally_Removed_Files          : constant Name_Id := N + 566;
-   Name_Naming                         : constant Name_Id := N + 567;
-   Name_Object_Dir                     : constant Name_Id := N + 568;
-   Name_Pretty_Printer                 : constant Name_Id := N + 569;
-   Name_Project                        : constant Name_Id := N + 570;
-   Name_Separate_Suffix                : constant Name_Id := N + 571;
-   Name_Source_Dirs                    : constant Name_Id := N + 572;
-   Name_Source_Files                   : constant Name_Id := N + 573;
-   Name_Source_List_File               : constant Name_Id := N + 574;
-   Name_Spec                           : constant Name_Id := N + 575;
-   Name_Spec_Suffix                    : constant Name_Id := N + 576;
-   Name_Specification                  : constant Name_Id := N + 577;
-   Name_Specification_Exceptions       : constant Name_Id := N + 578;
-   Name_Specification_Suffix           : constant Name_Id := N + 579;
-   Name_Switches                       : constant Name_Id := N + 580;
+   Name_Library_Reference_Symbol_File  : constant Name_Id := N + 561;
+   Name_Library_Src_Dir                : constant Name_Id := N + 562;
+   Name_Library_Symbol_File            : constant Name_Id := N + 563;
+   Name_Library_Symbol_Policy          : constant Name_Id := N + 564;
+   Name_Library_Version                : constant Name_Id := N + 565;
+   Name_Linker                         : constant Name_Id := N + 566;
+   Name_Local_Configuration_Pragmas    : constant Name_Id := N + 567;
+   Name_Locally_Removed_Files          : constant Name_Id := N + 568;
+   Name_Naming                         : constant Name_Id := N + 569;
+   Name_Object_Dir                     : constant Name_Id := N + 570;
+   Name_Pretty_Printer                 : constant Name_Id := N + 571;
+   Name_Project                        : constant Name_Id := N + 572;
+   Name_Separate_Suffix                : constant Name_Id := N + 573;
+   Name_Source_Dirs                    : constant Name_Id := N + 574;
+   Name_Source_Files                   : constant Name_Id := N + 575;
+   Name_Source_List_File               : constant Name_Id := N + 576;
+   Name_Spec                           : constant Name_Id := N + 577;
+   Name_Spec_Suffix                    : constant Name_Id := N + 578;
+   Name_Specification                  : constant Name_Id := N + 579;
+   Name_Specification_Exceptions       : constant Name_Id := N + 580;
+   Name_Specification_Suffix           : constant Name_Id := N + 581;
+   Name_Switches                       : constant Name_Id := N + 582;
    --  Other miscellaneous names used in front end
 
-   Name_Unaligned_Valid                : constant Name_Id := N + 581;
+   Name_Unaligned_Valid                : constant Name_Id := N + 583;
 
    --  Mark last defined name for consistency check in Snames body
 
-   Last_Predefined_Name                : constant Name_Id := N + 581;
+   Last_Predefined_Name                : constant Name_Id := N + 583;
 
    subtype Any_Operator_Name is Name_Id range
      First_Operator_Name .. Last_Operator_Name;
Index: sprint.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sprint.adb,v
retrieving revision 1.11
diff -u -p -r1.11 sprint.adb
--- sprint.adb	17 Nov 2003 14:58:17 -0000	1.11
+++ sprint.adb	20 Nov 2003 09:48:32 -0000
@@ -929,6 +929,8 @@ package body Sprint is
             Sprint_Bar_List (Choices (Node));
             Write_Str (" => ");
 
+            --  Ada0Y (AI-287): Print the mbox if present
+
             if Box_Present (Node) then
                Write_Str_With_Col_Check ("<>");
             else
@@ -2495,6 +2497,9 @@ package body Sprint is
 
             else
                if First_Name (Node) or else not Dump_Original_Only then
+
+                  --  Ada0Y (AI-50217): Print limited with_clauses
+
                   if Limited_Present (Node) then
                      Write_Indent_Str ("limited with ");
                   else
@@ -2513,7 +2518,6 @@ package body Sprint is
             end if;
 
          when N_With_Type_Clause =>
-
             Write_Indent_Str ("with type ");
             Sprint_Node_Sloc (Name (Node));
 
Index: s-thread.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/s-thread.adb,v
retrieving revision 1.5
diff -u -p -r1.5 s-thread.adb
--- s-thread.adb	17 Nov 2003 14:58:17 -0000	1.5
+++ s-thread.adb	20 Nov 2003 09:48:32 -0000
@@ -31,14 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the VxWorks version of this package
-
-pragma Restrictions (No_Tasking);
---  The VxWorks version of this package is intended only for programs
---  which do not use Ada tasking. This restriction ensures that this
---  will be checked by the binder.
-
-with System.Secondary_Stack;
+--  This is a dummy version of this package.
 
 with Unchecked_Conversion;
 
@@ -46,29 +39,13 @@ with System.Threads.Initialization;
 
 package body System.Threads is
 
-   package SSS renames System.Secondary_Stack;
-
-   Current_ATSD  : aliased System.Address := System.Null_Address;
-   pragma Export (C, Current_ATSD, "__gnat_current_atsd");
-
-   function From_Address is
-      new Unchecked_Conversion (Address, ATSD_Access);
-
-   procedure Init_Float;
-   pragma Import (C, Init_Float, "__gnat_init_float");
-
-   procedure Install_Handler;
-   pragma Import (C, Install_Handler, "__gnat_install_handler");
-
    -----------------------
    -- Get_Current_Excep --
    -----------------------
 
    function Get_Current_Excep return EOA is
-      CTSD : ATSD_Access := From_Address (Current_ATSD);
    begin
-      pragma Assert (Current_ATSD /= System.Null_Address);
-      return CTSD.Current_Excep'Access;
+      return null;
    end Get_Current_Excep;
 
    ------------------------
@@ -76,10 +53,8 @@ package body System.Threads is
    ------------------------
 
    function  Get_Jmpbuf_Address return  Address is
-      CTSD : ATSD_Access := From_Address (Current_ATSD);
    begin
-      pragma Assert (Current_ATSD /= System.Null_Address);
-      return CTSD.Jmpbuf_Address;
+      return Null_Address;
    end Get_Jmpbuf_Address;
 
    ------------------------
@@ -87,10 +62,8 @@ package body System.Threads is
    ------------------------
 
    function  Get_Sec_Stack_Addr return  Address is
-      CTSD : ATSD_Access := From_Address (Current_ATSD);
    begin
-      pragma Assert (Current_ATSD /= System.Null_Address);
-      return CTSD.Sec_Stack_Addr;
+      return Null_Address;
    end Get_Sec_Stack_Addr;
 
    ------------------------
@@ -98,10 +71,9 @@ package body System.Threads is
    ------------------------
 
    procedure Set_Jmpbuf_Address (Addr : Address) is
-      CTSD : ATSD_Access := From_Address (Current_ATSD);
+      pragma Unreferenced (Addr);
    begin
-      pragma Assert (Current_ATSD /= System.Null_Address);
-      CTSD.Jmpbuf_Address := Addr;
+      null;
    end Set_Jmpbuf_Address;
 
    ------------------------
@@ -109,10 +81,9 @@ package body System.Threads is
    ------------------------
 
    procedure Set_Sec_Stack_Addr (Addr : Address) is
-      CTSD : ATSD_Access := From_Address (Current_ATSD);
+      pragma Unreferenced (Addr);
    begin
-      pragma Assert (Current_ATSD /= System.Null_Address);
-      CTSD.Sec_Stack_Addr := Addr;
+      null;
    end Set_Sec_Stack_Addr;
 
    -----------------------
@@ -124,18 +95,11 @@ package body System.Threads is
       Sec_Stack_Size       : Natural;
       Process_ATSD_Address : System.Address)
    is
-      --  Current_ATSD must already be a taskVar of taskIdSelf.
-      --  No assertion because taskVarGet is not available on VxWorks/CERT
-
-      TSD : ATSD_Access := From_Address (Process_ATSD_Address);
-
+      pragma Unreferenced (Sec_Stack_Address);
+      pragma Unreferenced (Sec_Stack_Size);
+      pragma Unreferenced (Process_ATSD_Address);
    begin
-      TSD.Sec_Stack_Addr := Sec_Stack_Address;
-      SSS.SS_Init (TSD.Sec_Stack_Addr, Sec_Stack_Size);
-      Current_ATSD := Process_ATSD_Address;
-
-      Install_Handler;
-      Init_Float;
+      null;
    end Thread_Body_Enter;
 
    ----------------------------------
@@ -147,8 +111,6 @@ package body System.Threads is
    is
       pragma Unreferenced (EO);
    begin
-      --  No action for this target
-
       null;
    end Thread_Body_Exceptional_Exit;
 
@@ -158,11 +120,7 @@ package body System.Threads is
 
    procedure Thread_Body_Leave is
    begin
-      --  No action for this target
-
       null;
    end Thread_Body_Leave;
 
-begin
-   System.Threads.Initialization.Init_RTS;
 end System.Threads;
Index: symbols.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/symbols.adb,v
retrieving revision 1.1
diff -u -p -r1.1 symbols.adb
--- symbols.adb	21 Oct 2003 13:42:22 -0000	1.1
+++ symbols.adb	20 Nov 2003 09:48:32 -0000
@@ -36,14 +36,18 @@ package body Symbols is
    ----------------
 
    procedure Initialize
-     (Symbol_File : String;
-      Force       : Boolean;
-      Quiet       : Boolean;
-      Success     : out Boolean)
+     (Symbol_File   : String;
+      Reference     : String;
+      Symbol_Policy : Policy;
+      Quiet         : Boolean;
+      Version       : String;
+      Success       : out Boolean)
    is
       pragma Unreferenced (Symbol_File);
-      pragma Unreferenced (Force);
+      pragma Unreferenced (Reference);
+      pragma Unreferenced (Symbol_Policy);
       pragma Unreferenced (Quiet);
+      pragma Unreferenced (Version);
    begin
       Put_Line
         ("creation of symbol files are not supported on this platform");
Index: symbols.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/symbols.ads,v
retrieving revision 1.1
diff -u -p -r1.1 symbols.ads
--- symbols.ads	21 Oct 2003 13:42:22 -0000	1.1
+++ symbols.ads	20 Nov 2003 09:48:32 -0000
@@ -33,6 +33,20 @@ with GNAT.OS_Lib;         use GNAT.OS_Li
 
 package Symbols is
 
+   type Policy is
+   --  Symbol policy:
+
+     (Autonomous,
+      --  Create a symbol file without considering any reference
+
+      Compliant,
+      --  Either create a symbol file with the same major and minor IDs if
+      --  all symbols are already found in the reference file or with an
+      --  incremented minor ID, if not.
+
+       Controlled);
+      --  Fail if symbols are not the same as those in the reference file
+
    type Symbol_Kind is (Data, Proc);
    --  To distinguish between the different kinds of symbols
 
@@ -52,16 +66,18 @@ package Symbols is
    --  The symbol tables
 
    Original_Symbols : Symbol_Table.Instance;
-   --  The symbols, if any, found in the original symbol table
+   --  The symbols, if any, found in the reference symbol table
 
    Complete_Symbols : Symbol_Table.Instance;
    --  The symbols, if any, found in the objects files
 
    procedure Initialize
-     (Symbol_File : String;
-      Force       : Boolean;
-      Quiet       : Boolean;
-      Success     : out Boolean);
+     (Symbol_File   : String;
+      Reference     : String;
+      Symbol_Policy : Policy;
+      Quiet         : Boolean;
+      Version       : String;
+      Success       : out Boolean);
    --  Initialize a symbol file. This procedure must be called before
    --  Processing any object file. Depending on the platforms and the
    --  circumstances, additional messages may be issued if Quiet is False.
Index: usage.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/usage.adb,v
retrieving revision 1.11
diff -u -p -r1.11 usage.adb
--- usage.adb	10 Nov 2003 17:30:00 -0000	1.11
+++ usage.adb	20 Nov 2003 09:48:32 -0000
@@ -235,7 +235,7 @@ begin
    --  Line for -gnatN switch
 
    Write_Switch_Char ("N");
-   Write_Line ("Full (frontend) inlining of subprograqms");
+   Write_Line ("Full (frontend) inlining of subprograms");
 
    --  Line for -gnato switch
 
Index: xref_lib.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/xref_lib.adb,v
retrieving revision 1.6
diff -u -p -r1.6 xref_lib.adb
--- xref_lib.adb	21 Oct 2003 13:42:23 -0000	1.6
+++ xref_lib.adb	20 Nov 2003 09:48:32 -0000
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2003 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- --
@@ -359,10 +359,7 @@ package body Xref_Lib is
    -- Default_Project_File --
    --------------------------
 
-   function Default_Project_File
-     (Dir_Name : String)
-      return     String
-   is
+   function Default_Project_File (Dir_Name : String) return String is
       My_Dir  : Dir_Type;
       Dir_Ent : File_Name_String;
       Last    : Natural;
@@ -396,8 +393,7 @@ package body Xref_Lib is
 
    function File_Name
      (File : ALI_File;
-      Num  : Positive)
-      return File_Reference
+      Num  : Positive) return File_Reference
    is
    begin
       return File.Dep.Table (Num);
@@ -876,6 +872,9 @@ package body Xref_Lib is
          --  unit number is optional. It is specified only if the parent type
          --  is not defined in the current unit.
 
+         --  We also have the format for generic instantiations, as in
+         --  7a5*Uid(3|5I8[4|2]) 2|4r74
+
          --  We could also have something like
          --  16I9*I<integer>
          --  that indicates that I derives from the predefined type integer.
@@ -918,6 +917,25 @@ package body Xref_Lib is
                Ptr := Ptr + 1;
                Parse_Number (Ali, Ptr, P_Column);
 
+               --  Skip the information for generics instantiations
+
+               if Ali (Ptr) = '[' then
+                  declare
+                     Num_Brackets : Natural := 1;
+                  begin
+                     while Num_Brackets /= 0 loop
+                        Ptr := Ptr + 1;
+                        if Ali (Ptr) = '[' then
+                           Num_Brackets := Num_Brackets + 1;
+                        elsif Ali (Ptr) = ']' then
+                           Num_Brackets := Num_Brackets - 1;
+                        end if;
+                     end loop;
+
+                     Ptr := Ptr + 1;
+                  end;
+               end if;
+
                --  Skip '>', or ')' or '>'
 
                Ptr := Ptr + 1;
@@ -928,8 +946,7 @@ package body Xref_Lib is
                if Der_Info or else Type_Tree then
                   declare
                      Symbol : constant String :=
-                       Get_Symbol_Name (P_Eun, P_Line, P_Column);
-
+                                Get_Symbol_Name (P_Eun, P_Line, P_Column);
                   begin
                      if Symbol /= "???" then
                         Add_Parent
Index: Makefile.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.in,v
retrieving revision 1.53
diff -u -r1.53 Makefile.in
--- Makefile.in	14 Nov 2003 13:56:34 -0000	1.53
+++ Makefile.in	20 Nov 2003 09:53:21 -0000
@@ -626,6 +626,10 @@
   s-parame.ads<5yparame.ads \
   s-taprop.adb<5ztaprop.adb \
   s-taspri.ads<5ztaspri.ads \
+  s-thread.adb<5zthread.adb \
+  s-thrini.ads<2sthrini.ads \
+  s-thrini.adb<5zthrini.adb \
+  s-tiitho.adb<5ytiitho.adb \
   s-tpopsp.adb<5ztpopsp.adb \
   s-vxwork.ads<5pvxwork.ads \
   g-soccon.ads<3zsoccon.ads \
@@ -640,8 +644,8 @@
 
   EXTRA_RAVEN_SOURCES=i-vxwork.ads s-vxwork.ads
   EXTRA_RAVEN_OBJS=i-vxwork.o s-vxwork.o
-  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
-  EXTRA_GNATRTL_TASKING_OBJS=i-vthrea.o s-tpae65.o s-vxwork.o
+  EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o s-thrini.o
+  EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
   HIE_RAVEN_TARGET_PAIRS=\
   $(HIE_NONE_TARGET_PAIRS) \
   a-reatim.ads<1areatim.ads \
@@ -688,6 +692,7 @@
   s-soflin.ads<2ssoflin.ads \
   s-stalib.adb<1sstalib.adb \
   s-stalib.ads<1sstalib.ads \
+  s-thrini.adb<5zthrini.adb \
   s-thrini.ads<2sthrini.ads \
   s-thrini.adb<5zthrini.adb \
   s-tiitho.adb<5ytiitho.adb \
@@ -964,6 +969,25 @@
 
     THREADSLIB = -lgthreads -lmalloc
   endif
+endif
+
+ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
+  LIBGNAT_TARGET_PAIRS = \
+  a-intnam.ads<45intnam.ads \
+  g-soccon.ads<35soccon.ads \
+  s-inmaop.adb<7sinmaop.adb \
+  s-intman.adb<7sintman.adb \
+  s-mastop.adb<5omastop.adb \
+  s-osinte.adb<55osinte.adb \
+  s-osinte.ads<55osinte.ads \
+  s-osprim.adb<7sosprim.adb \
+  s-taprop.adb<7staprop.adb \
+  s-taspri.ads<7staspri.ads \
+  s-tpopsp.adb<7stpopsp.adb \
+  system.ads<56system.ads
+
+  THREADSLIB=
+  LIBRARY_VERSION := $(strip $(shell grep Library_Version $(fsrcpfx)gnatvsn.ads | sed -e 's/.*GNAT Lib v\(.*\)[ "].*/\1/'))
 endif
 
 ifeq ($(strip $(filter-out mips sgi irix%,$(targ))),)



More information about the Gcc-patches mailing list